{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LINE 1 "Quipper/Algorithms/QLS/CircLiftingImport.hs" #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

-- | This module contains definitions to work with Template Haskell. All
-- the definitions in this module are used by Template Haskell in
-- "Quipper.Algorithms.QLS.TemplateOracle" and "Quipper.Algorithms.QLS.RealFunc".
module Quipper.Algorithms.QLS.CircLiftingImport where

import Data.Typeable

import Quipper
import Quipper.Internal

import Quipper.Libraries.Arith
import Quipper.Libraries.Decompose

import Quipper.Algorithms.QLS.QDouble
import Quipper.Algorithms.QLS.QSignedInt
import Quipper.Algorithms.QLS.Utils

-- * Utility function

-- | @'grepn' /regexp/ /list/@: Counts how many times /regexp/ is a
-- sublist of /list/.
grepn :: (Eq a) => [a] -> [a] -> Int
grepn regexp l = 
      if (length regexp > length l) then 0
      else if ((take (length regexp) l) == regexp) then 1 + (grepn regexp $ tail l)
      else grepn regexp $ tail l




-- * Lifting of ordering operators.


-- | Template version of '/='.
template_symb_slash_symb_equal_ :: (Typeable qa, QOrd qa) => Circ (qa -> Circ (qa -> Circ Qubit))
template_symb_slash_symb_equal_ = return $ \x -> return $ \y -> do
            (_,_,r) <- box "/=" (decompose_generic Toffoli $ uncurry q_is_not_equal) (x,y)
            return r

-- | Template version of '<'.
template_symb_oangle_ :: (Typeable qa, QOrd qa) => Circ (qa -> Circ (qa -> Circ Qubit))
template_symb_oangle_ = return $ \x -> return $ \y -> box "<" (uncurry q_less) (x,y)

-- | Template version of '<='.
template_symb_oangle_symb_equal_ :: (Typeable qa, QOrd qa) => Circ (qa -> Circ (qa -> Circ Qubit))
template_symb_oangle_symb_equal_ = return $ \x -> return $ \y -> box "<=" (uncurry q_leq) (x,y)

-- | Template version of '>'.
template_symb_cangle_ :: (Typeable qa, QOrd qa) => Circ (qa -> Circ (qa -> Circ Qubit))
template_symb_cangle_ = return $ \x -> return $ \y -> box ">" (uncurry q_greater) (x,y)

-- | Template version of '>='.
template_symb_cangle_symb_equal_ :: (Typeable qa, QOrd qa) => Circ (qa -> Circ (qa -> Circ Qubit))
template_symb_cangle_symb_equal_ = return $ \x -> return $ \y -> box ">=" (uncurry q_geq) (x,y)




-- * Lifting of arithmetic operators

-- | Template version of '-'.
template_symb_minus_ :: (Typeable qa, QNum qa) => Circ (qa -> Circ (qa -> Circ qa))
template_symb_minus_ = return $ \qx -> return $ \qy -> do (qx,qy,qz) <- box "-" (uncurry q_sub) (qx,qy); return qz

-- | Template version of '+'.
template_symb_plus_ :: (Typeable qa, QNum qa) => Circ (qa -> Circ (qa -> Circ qa))
template_symb_plus_ = return $ \qx -> return $ \qy -> do (qx,qy,qz) <- box "+" (uncurry q_add) (qx,qy); return qz

-- | Template version of '*'.
template_symb_star_ :: (Typeable qa, QNum qa) => Circ (qa -> Circ (qa -> Circ qa))
template_symb_star_ = return $ \qx -> return $ \qy -> do (qx,qy,qz) <- box "*" (uncurry q_mult) (qx,qy); return qz

-- | Template version of 'negate'.
template_negate :: (Typeable qa, QNum qa) => Circ (qa -> Circ qa)
template_negate = return $ \qx -> do (_,qz) <- box "neg" q_negate qx; return qz

-- | Template version of 'abs'.
template_abs :: (Typeable qa, QNum qa) => Circ (qa -> Circ qa)
template_abs = return $ \x -> do
                  (_,r) <- box "abs" q_abs x
                  return r

-- | Template version of 'mod'
template_mod :: Circ (QSignedInt -> Circ (QSignedInt -> Circ QSignedInt))
template_mod = return $ \x -> return $ \y -> box "mod" (decompose_generic Toffoli $ uncurry q_mod) (x,y)


-- * Operations on 'QDouble'

-- | Template version of '/' on 'Fractional'.
template_symb_slash_:: Circ (QDouble -> Circ (QDouble -> Circ QDouble))
template_symb_slash_ = return $ \x -> return $ \y -> box "/" (decompose_generic Toffoli $ uncurry q_div_real) (x,y)

-- | The constant 'pi' as an 'FDouble'.
local_pi :: FDouble
local_pi =  fdouble pi

-- | Template version of 'local_pi'.
template_local_pi :: Circ QDouble
template_local_pi = qinit (fdouble pi)

-- | The identity function of type 'FDouble'. This is used to help the
-- type checker work around a problem in GHC 8.0, where types of
-- overloaded operations sometimes require disambiguation.
id_fdouble :: FDouble -> FDouble
id_fdouble x = x

-- | Template version of 'id_fdouble'.
template_id_fdouble :: Circ (QDouble -> Circ QDouble)
template_id_fdouble = return $ \x -> return x

-- * Relation between 'QDouble' and 'QSignedInt'.

-- | Template version of 'floor'.
template_floor :: Circ (QDouble -> Circ QSignedInt)
template_floor = return $ \(XDouble k (SInt x b)) -> 
      return $ SInt (reverse . drop k . reverse $ x) b

-- | Template version of 'ceiling'.
template_ceiling :: Circ (QDouble -> Circ QSignedInt)
template_ceiling = return $ \x -> q_ceiling x

-- | Template version of 'fromIntegral'.
template_fromIntegral :: Circ (QSignedInt -> Circ QDouble)
template_fromIntegral = return $ \x -> q_fromIntegral x



-- * Dealing with parameters.


-- | Lift a real number to 'QDouble'.
template_rational :: Double -> Circ QDouble
template_rational x = qinit $ fdouble x

-- | Lift an integer to 'QSignedInt'.
template_integer :: Int -> Circ QSignedInt
template_integer x = qinit $ fromIntegral x


-- | Make a parameter 'Int' as a regular 'Int' that can be lifted.
getIntFromParam :: Int -> Int
getIntFromParam x = fromIntegral x

-- | Template version of 'getIntFromParam'.
template_getIntFromParam :: Circ (Int -> Circ QSignedInt)
template_getIntFromParam = return $ \x -> qinit $ fromIntegral x

-- | Parameter integer of value '0'.
paramZero :: Int
paramZero = 0

-- | Template version of 'paramZero'.
template_paramZero :: Circ Int
template_paramZero = return 0

-- | Parameter integer of value '10'.
paramTen :: Int
paramTen = 10

-- | Template version of 'paramTen'.
template_paramTen :: Circ Int
template_paramTen = return paramTen

-- | Successor function acting on parameter 'Int'.
paramSucc :: Int -> Int
paramSucc x = x+1

-- | Template version of 'paramSucc'.
template_paramSucc :: Circ (Int -> Circ Int)
template_paramSucc = return $ \x -> return (x+1)

-- | Predecessor function acting on parameter 'Int'.
paramPred :: Int -> Int
paramPred x = x - 1

-- | Template version of 'paramPred'.
template_paramPred :: Circ (Int -> Circ Int)
template_paramPred = return $ \x -> return (x-1)



-- | Subtraction of parameter integers.
paramMinus :: Int -> Int -> Int
paramMinus x y = x - y

-- | Template version of 'paramMinus'.
template_paramMinus :: Circ (Int -> Circ (Int -> Circ Int))
template_paramMinus = return $ \x -> return $ \y -> return (x-y)



-- * Miscellaneous operations.

-- | Lifted version of @'length'@.
template_length :: Circ ([a] -> Circ QSignedInt)
template_length = return $ \l -> qinit $ fromIntegral $ length l

-- | Return the first half of the input list.
take_half :: [a] -> [a]
take_half l = take (1 + (length l) `div` 2) l

-- | Lifted version of @'take_half'@.
template_take_half :: Circ ([a] -> Circ [a])
template_take_half = return $ \l -> return $ take_half l