{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE UndecidableInstances #-}

-- | C code generation for imperative commands

module Language.Embedded.Imperative.Backend.C where



#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Monad.State
import Data.Proxy
import Data.Loc

import Language.C.Quote.GCC
import qualified Language.C.Syntax as C

import Control.Monad.Operational.Higher
import Language.C.Monad
import Language.Embedded.Expression
import Language.Embedded.Imperative.CMD
import Language.Embedded.Imperative.Frontend.General
import Language.Embedded.Backend.C



-- | Compile `RefCMD`
compRefCMD :: (CompExp exp, CompTypeClass ct) =>
    RefCMD (Param3 prog exp ct) a -> CGen a
compRefCMD :: RefCMD (Param3 prog exp ct) a -> CGen a
compRefCMD cmd :: RefCMD (Param3 prog exp ct) a
cmd@(NewRef String
base) = do
    Type
t <- Proxy ct -> Proxy a -> CGenT Identity Type
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (RefCMD (Param3 prog exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred RefCMD (Param3 prog exp ct) a
cmd) (RefCMD (Param3 prog exp ct) (Ref a) -> Proxy a
forall k1 k2 (proxy1 :: k1 -> *) (proxy2 :: k2 -> k1) (a :: k2).
proxy1 (proxy2 a) -> Proxy a
proxyArg RefCMD (Param3 prog exp ct) a
RefCMD (Param3 prog exp ct) (Ref a)
cmd)
    Ref a
r <- String -> Ref a
forall a. String -> Ref a
RefComp (String -> Ref a)
-> CGenT Identity String -> CGenT Identity (Ref a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> CGenT Identity String
forall (m :: * -> *). MonadC m => String -> m String
gensym String
base
    InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal (InitGroup -> CGenT Identity ()) -> InitGroup -> CGenT Identity ()
forall a b. (a -> b) -> a -> b
$ case Type
t of
      C.Type DeclSpec
_ C.Ptr{} SrcLoc
_ -> [cdecl| $ty:t $id:r = NULL; |]
      Type
_                  -> [cdecl| $ty:t $id:r; |]
    Ref a -> CGenT Identity (Ref a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ref a
r
compRefCMD cmd :: RefCMD (Param3 prog exp ct) a
cmd@(InitRef String
base exp a
exp) = do
    Type
t <- Proxy ct -> exp a -> CGenT Identity Type
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (RefCMD (Param3 prog exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred RefCMD (Param3 prog exp ct) a
cmd) exp a
exp
    Ref a
r <- String -> Ref a
forall a. String -> Ref a
RefComp (String -> Ref a)
-> CGenT Identity String -> CGenT Identity (Ref a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> CGenT Identity String
forall (m :: * -> *). MonadC m => String -> m String
gensym String
base
    Exp
e <- exp a -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp a
exp
    InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal [cdecl| $ty:t $id:r; |]
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm   [cstm| $id:r = $e; |]
    Ref a -> CGenT Identity (Ref a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ref a
r
compRefCMD cmd :: RefCMD (Param3 prog exp ct) a
cmd@(GetRef Ref a
ref) = do
    Val a
v <- Proxy ct -> CGenT Identity (Val a)
forall (m :: * -> *) (ct :: * -> Constraint)
       (proxy :: (* -> Constraint) -> *) a.
(MonadC m, CompTypeClass ct, ct a) =>
proxy ct -> m (Val a)
freshVar (RefCMD (Param3 prog exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred RefCMD (Param3 prog exp ct) a
cmd)
    Ref a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Ref a
ref
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| $id:v = $id:ref; |]
    Val a -> CGenT Identity (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
v
compRefCMD (SetRef Ref a
ref exp a
exp) = do
    Exp
v <- exp a -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp a
exp
    Ref a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Ref a
ref
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| $id:ref = $v; |]
compRefCMD (UnsafeFreezeRef (RefComp String
v)) = Val a -> CGenT Identity (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Val a -> CGenT Identity (Val a))
-> Val a -> CGenT Identity (Val a)
forall a b. (a -> b) -> a -> b
$ String -> Val a
forall a. String -> Val a
ValComp String
v

-- The `IsPointer` instance for `Arr` demands that arrays are represented as
-- pointers in C (because `IsPointer` enables use of `SwapPtr`). As explained
-- [here](http://stackoverflow.com/questions/3393518/swap-arrays-by-using-pointers-in-c),
-- arrays in C are *not* pointers in the sense that they can be redirected. Here
-- "arrays" means variables declared as e.g. `int arr[10];`. This is why we
-- declare a supplementary pointer for such arrays; e.g:
--
--     int _a[] = {0,1,2,3,4,5,6,7,8,9};
--     int * a = _a;
--
-- The declaration of a variable-sized array could only be done where its size
-- expression can be evaluated. This is why the declaration of variable-sized
-- arrays is done with `addItem` insted of `addLocal`: it preserves the position
-- of the declaration in the block, as it would be a statement.
--
-- Pointers that are used between multiple functions will be lifted to shared globals.
-- To ensure the correctness of the resulting program the underlying arrays must also
-- be lifted, hence the extra `touchVar` application on their symbols.

-- | Generates the symbol name as an identifier for a given array.
newtype BaseArrOf i a = BaseArrOf (Arr i a)

instance ToIdent (BaseArrOf i a)
  where toIdent :: BaseArrOf i a -> SrcLoc -> Id
toIdent (BaseArrOf (ArrComp String
sym)) = String -> SrcLoc -> Id
forall a. ToIdent a => a -> SrcLoc -> Id
toIdent (String -> SrcLoc -> Id) -> String -> SrcLoc -> Id
forall a b. (a -> b) -> a -> b
$ Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:String
sym

-- | Compile `ArrCMD`
compArrCMD :: forall exp ct a. (CompExp exp, CompTypeClass ct) =>
    ArrCMD (Param3 CGen exp ct) a -> CGen a
compArrCMD :: ArrCMD (Param3 CGen exp ct) a -> CGen a
compArrCMD cmd :: ArrCMD (Param3 CGen exp ct) a
cmd@(NewArr String
base exp i
size) = C_CMD (Param3 CGen exp ct) a -> CGen a
forall (exp :: * -> *) (ct :: * -> Constraint) a.
(CompExp exp, CompTypeClass ct) =>
C_CMD (Param3 CGen exp ct) a -> CGen a
compC_CMD (String -> Maybe i -> exp i -> C_CMD (Param3 CGen exp ct) (Arr i a)
forall (pred :: * -> Constraint) a i (exp :: * -> *)
       (prog :: * -> *).
(pred a, pred i, Integral i, Ix i) =>
String
-> Maybe i -> exp i -> C_CMD (Param3 prog exp pred) (Arr i a)
NewCArr String
base Maybe i
forall a. Maybe a
Nothing exp i
size :: C_CMD (Param3 CGen exp ct) a)
compArrCMD cmd :: ArrCMD (Param3 CGen exp ct) a
cmd@(ConstArr String
base [a]
as) = C_CMD (Param3 CGen exp ct) a -> CGen a
forall (exp :: * -> *) (ct :: * -> Constraint) a.
(CompExp exp, CompTypeClass ct) =>
C_CMD (Param3 CGen exp ct) a -> CGen a
compC_CMD (String -> Maybe i -> [a] -> C_CMD (Param3 CGen exp ct) (Arr i a)
forall (pred :: * -> Constraint) a i (prog :: * -> *)
       (exp :: * -> *).
(pred a, pred i, Integral i, Ix i) =>
String -> Maybe i -> [a] -> C_CMD (Param3 prog exp pred) (Arr i a)
ConstCArr String
base Maybe i
forall a. Maybe a
Nothing [a]
as :: C_CMD (Param3 CGen exp ct) a)
compArrCMD cmd :: ArrCMD (Param3 CGen exp ct) a
cmd@(GetArr Arr i a
arr exp i
expi) = do
    Val a
v <- Proxy ct -> CGenT Identity (Val a)
forall (m :: * -> *) (ct :: * -> Constraint)
       (proxy :: (* -> Constraint) -> *) a.
(MonadC m, CompTypeClass ct, ct a) =>
proxy ct -> m (Val a)
freshVar (ArrCMD (Param3 CGen exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred ArrCMD (Param3 CGen exp ct) a
cmd)
    Exp
i <- exp i -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp i
expi
    BaseArrOf i a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar (BaseArrOf i a -> CGenT Identity ())
-> BaseArrOf i a -> CGenT Identity ()
forall a b. (a -> b) -> a -> b
$ Arr i a -> BaseArrOf i a
forall i a. Arr i a -> BaseArrOf i a
BaseArrOf Arr i a
arr  -- explanation above
    Arr i a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Arr i a
arr
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| $id:v = $id:arr[ $i ]; |]
    Val a -> CGenT Identity (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
v
compArrCMD (SetArr Arr i a
arr exp i
expi exp a
expv) = do
    Exp
v <- exp a -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp a
expv
    Exp
i <- exp i -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp i
expi
    BaseArrOf i a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar (BaseArrOf i a -> CGenT Identity ())
-> BaseArrOf i a -> CGenT Identity ()
forall a b. (a -> b) -> a -> b
$ Arr i a -> BaseArrOf i a
forall i a. Arr i a -> BaseArrOf i a
BaseArrOf Arr i a
arr  -- explanation above
    Arr i a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Arr i a
arr
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| $id:arr[ $i ] = $v; |]
compArrCMD cmd :: ArrCMD (Param3 CGen exp ct) a
cmd@(CopyArr (Arr i a
arr1,exp i
expo1) (Arr i a
arr2,exp i
expo2) exp i
expl) = do
    String -> CGenT Identity ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<string.h>"
    (BaseArrOf i a -> CGenT Identity ())
-> [BaseArrOf i a] -> CGenT Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ BaseArrOf i a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar [Arr i a -> BaseArrOf i a
forall i a. Arr i a -> BaseArrOf i a
BaseArrOf Arr i a
arr1, Arr i a -> BaseArrOf i a
forall i a. Arr i a -> BaseArrOf i a
BaseArrOf Arr i a
arr2]  -- explanation above
    (Arr i a -> CGenT Identity ()) -> [Arr i a] -> CGenT Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Arr i a -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar [Arr i a
arr1,Arr i a
arr2]
    Exp
o1 <- exp i -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp i
expo1
    Exp
o2 <- exp i -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp i
expo2
    Exp
l  <- exp i -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp i
expl
    Type
t  <- Proxy ct -> Arr i a -> CGenT Identity Type
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (ArrCMD (Param3 CGen exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred ArrCMD (Param3 CGen exp ct) a
cmd) Arr i a
arr1
    let a1 :: Exp
a1 = case Exp
o1 of
          C.Const (C.IntConst String
_ Signed
_ Integer
0 SrcLoc
_) SrcLoc
_ -> [cexp| $id:arr1 |]
          Exp
_ -> [cexp| $id:arr1 + $o1 |]
    let a2 :: Exp
a2 = case Exp
o2 of
          C.Const (C.IntConst String
_ Signed
_ Integer
0 SrcLoc
_) SrcLoc
_ -> [cexp| $id:arr2 |]
          Exp
_ -> [cexp| $id:arr2 + $o2 |]
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| memcpy($a1, $a2, $l * sizeof($ty:t)); |]
compArrCMD (UnsafeFreezeArr (ArrComp String
arr)) = IArr i a -> CGenT Identity (IArr i a)
forall (m :: * -> *) a. Monad m => a -> m a
return (IArr i a -> CGenT Identity (IArr i a))
-> IArr i a -> CGenT Identity (IArr i a)
forall a b. (a -> b) -> a -> b
$ String -> IArr i a
forall i a. String -> IArr i a
IArrComp String
arr
compArrCMD (UnsafeThawArr (IArrComp String
arr))  = Arr i a -> CGenT Identity (Arr i a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Arr i a -> CGenT Identity (Arr i a))
-> Arr i a -> CGenT Identity (Arr i a)
forall a b. (a -> b) -> a -> b
$ String -> Arr i a
forall i a. String -> Arr i a
ArrComp String
arr


-- | Compile `ControlCMD`
compControlCMD :: (CompExp exp, CompTypeClass ct) =>
    ControlCMD (Param3 CGen exp ct) a -> CGen a
compControlCMD :: ControlCMD (Param3 CGen exp ct) a -> CGen a
compControlCMD (If exp Bool
c prog ()
t prog ()
f) = do
    Exp
cc <- exp Bool -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp Bool
c
    case Exp
cc of
      C.Var (C.Id String
"true"  SrcLoc
_) SrcLoc
_  -> prog ()
CGen a
t
      C.Var (C.Id String
"false"  SrcLoc
_) SrcLoc
_ -> prog ()
CGen a
f
      Exp
_ -> do
        [BlockItem]
ct <- prog () -> prog [BlockItem]
forall (m :: * -> *) a. MonadC m => m a -> m [BlockItem]
inNewBlock_ prog ()
t
        [BlockItem]
cf <- prog () -> prog [BlockItem]
forall (m :: * -> *) a. MonadC m => m a -> m [BlockItem]
inNewBlock_ prog ()
f
        case ([BlockItem]
ct, [BlockItem]
cf) of
          ([],[]) -> () -> CGenT Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          ([BlockItem]
_ ,[]) -> Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| if (   $cc) {$items:ct} |]
          ([],[BlockItem]
_ ) -> Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| if ( ! $cc) {$items:cf} |]
          ([BlockItem]
_ ,[BlockItem]
_ ) -> Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| if (   $cc) {$items:ct} else {$items:cf} |]
compControlCMD (While prog (exp Bool)
cont prog ()
body) = do
    CEnv
s <- CGenT Identity CEnv
forall s (m :: * -> *). MonadState s m => m s
get
    Bool
noop <- do
        exp Bool
conte <- prog (exp Bool)
CGen (exp Bool)
cont
        Exp
contc <- exp Bool -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp Bool
conte
        case Exp
contc of
          C.Var (C.Id String
"false"  SrcLoc
_) SrcLoc
_ -> Bool -> CGenT Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          Exp
_ -> Bool -> CGenT Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    CEnv -> CGenT Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CEnv
s
    [BlockItem]
bodyc <- prog () -> prog [BlockItem]
forall (m :: * -> *) a. MonadC m => m a -> m [BlockItem]
inNewBlock_ (prog () -> prog [BlockItem]) -> prog () -> prog [BlockItem]
forall a b. (a -> b) -> a -> b
$ do
        exp Bool
conte <- prog (exp Bool)
cont
        Exp
contc <- exp Bool -> prog Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp Bool
conte
        case Exp
contc of
          C.Var (C.Id String
"true"  SrcLoc
_) SrcLoc
_ -> () -> prog ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Exp
_ -> case Exp -> Maybe Exp
viewNotExp Exp
contc of
              Just Exp
a -> Stm -> prog ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| if ($a) {break;} |]
              Maybe Exp
_      -> Stm -> prog ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| if (! $contc) {break;} |]
        prog ()
body
    Bool -> CGenT Identity () -> CGenT Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
noop) (CGenT Identity () -> CGenT Identity ())
-> CGenT Identity () -> CGenT Identity ()
forall a b. (a -> b) -> a -> b
$ Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| while (1) {$items:bodyc} |]
compControlCMD cmd :: ControlCMD (Param3 CGen exp ct) a
cmd@(For (exp i
lo,Int
step,Border (exp i)
hi) Val i -> prog ()
body) = do
    Exp
loe <- exp i -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp i
lo
    Exp
hie <- exp i -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp (exp i -> CGenT Identity Exp) -> exp i -> CGenT Identity Exp
forall a b. (a -> b) -> a -> b
$ Border (exp i) -> exp i
forall i. Border i -> i
borderVal Border (exp i)
hi
    Val i
i   <- Proxy ct -> CGenT Identity (Val i)
forall (m :: * -> *) (ct :: * -> Constraint)
       (proxy :: (* -> Constraint) -> *) a.
(MonadC m, CompTypeClass ct, ct a) =>
proxy ct -> m (Val a)
freshVar (ControlCMD (Param3 CGen exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred ControlCMD (Param3 CGen exp ct) a
cmd)
    [BlockItem]
bodyc <- prog () -> prog [BlockItem]
forall (m :: * -> *) a. MonadC m => m a -> m [BlockItem]
inNewBlock_ (Val i -> prog ()
body Val i
i)
    let incl :: Bool
incl = Border (exp i) -> Bool
forall i. Border i -> Bool
borderIncl Border (exp i)
hi
    let conte :: Exp
conte
          | Bool
incl Bool -> Bool -> Bool
&& (Int
stepInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>=Int
0) = [cexp| $id:i<=$hie |]
          | Bool
incl Bool -> Bool -> Bool
&& (Int
stepInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0)  = [cexp| $id:i>=$hie |]
          | Int
step Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0         = [cexp| $id:i< $hie |]
          | Int
step Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0          = [cexp| $id:i> $hie |]
    let stepe :: Exp
stepe
          | Int
step Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1    = [cexp| $id:i++ |]
          | Int
step Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (-Int
1) = [cexp| $id:i-- |]
          | Int
step Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = [cexp| 0 |]
          | Int
step Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
0    = [cexp| $id:i = $id:i + $step |]
          | Int
step Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  Int
0    = [cexp| $id:i = $id:i - $(negate step) |]
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| for ($id:i=$loe; $conte; $stepe) {$items:bodyc} |]
compControlCMD ControlCMD (Param3 CGen exp ct) a
Break = Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| break; |]
compControlCMD (Assert exp Bool
cond String
msg) = do
    String -> CGenT Identity ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<assert.h>"
    Exp
c <- exp Bool -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp Bool
cond
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| assert($c && $msg); |]
compControlCMD (Hint exp a
_) = () -> CGenT Identity ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
compControlCMD (Comment String
msg) = do
  Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm (String -> SrcLoc -> Stm
C.EscStm (String
"/* " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" */") SrcLoc
forall a. IsLocation a => a
noLoc)
      
compPtrCMD :: PtrCMD (Param3 prog exp pred) a -> CGen a
compPtrCMD :: PtrCMD (Param3 prog exp pred) a -> CGen a
compPtrCMD (SwapPtr Ptr a
a Ptr a
b) = do
    let swap_ptr :: String
swap_ptr =
          String
"#define swap_ptr(a,b) do {void* TmP=a; a=b; b=TmP;} while (0)"
      -- See this solution on the use of `do{}while(0)`:
      -- <http://stackoverflow.com/a/3982397/1105347>
      --
      -- The name "TmP" is to make it very unlikely to have the same name as `a`
      -- or `b`.
    Definition -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal [cedecl| $esc:swap_ptr |]
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| swap_ptr($id:a, $id:b); |]
compPtrCMD (SwapArr Arr i a
a Arr i a
b) = do
    let swap_arr :: String
swap_arr =
          String
"#define swap_arr(a,b) do {void* TmP=a; a=b; b=TmP;} while (0)"
      -- See this solution on the use of `do{}while(0)`:
      -- <http://stackoverflow.com/a/3982397/1105347>
      --
      -- The name "TmP" is to make it very unlikely to have the same name as `a`
      -- or `b`.
    Definition -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal [cedecl| $esc:swap_arr |]
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| swap_arr($id:a, $id:b); |]

compIOMode :: IOMode -> String
compIOMode :: IOMode -> String
compIOMode IOMode
ReadMode      = String
"r"
compIOMode IOMode
WriteMode     = String
"w"
compIOMode IOMode
AppendMode    = String
"a"
compIOMode IOMode
ReadWriteMode = String
"r+"

-- | Compile `FileCMD`
compFileCMD :: (CompExp exp, CompTypeClass ct, ct Bool) =>
    FileCMD (Param3 prog exp ct) a -> CGen a
compFileCMD :: FileCMD (Param3 prog exp ct) a -> CGen a
compFileCMD (FOpen String
path IOMode
mode) = do
    String -> CGenT Identity ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdio.h>"
    String -> CGenT Identity ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdlib.h>"
    String
sym <- String -> CGenT Identity String
forall (m :: * -> *). MonadC m => String -> m String
gensym String
"f"
    InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal [cdecl| typename FILE * $id:sym; |]
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm   [cstm| $id:sym = fopen($id:path',$string:mode'); |]
    Handle -> CGenT Identity Handle
forall (m :: * -> *) a. Monad m => a -> m a
return (Handle -> CGenT Identity Handle)
-> Handle -> CGenT Identity Handle
forall a b. (a -> b) -> a -> b
$ String -> Handle
HandleComp String
sym
  where
    path' :: String
path' = String -> String
forall a. Show a => a -> String
show String
path
    mode' :: String
mode' = IOMode -> String
compIOMode IOMode
mode
compFileCMD (FClose Handle
h) = do
    String -> CGenT Identity ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdio.h>"
    Handle -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Handle
h
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| fclose($id:h); |]
compFileCMD (FPrintf Handle
h String
form [PrintfArg exp pred]
as) = do
    String -> CGenT Identity ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdio.h>"
    Handle -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Handle
h
    let h' :: Exp
h'     = [cexp| $id:h |]
        form' :: String
form'  = String -> String
forall a. Show a => a -> String
show String
form
        form'' :: Exp
form'' = [cexp| $id:form' |]
    [Exp]
as' <- ([Exp] -> [Exp]) -> CGenT Identity [Exp] -> CGenT Identity [Exp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Exp
h',Exp
form''][Exp] -> [Exp] -> [Exp]
forall a. [a] -> [a] -> [a]
++) (CGenT Identity [Exp] -> CGenT Identity [Exp])
-> CGenT Identity [Exp] -> CGenT Identity [Exp]
forall a b. (a -> b) -> a -> b
$ [CGenT Identity Exp] -> CGenT Identity [Exp]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [exp a -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp a
a | PrintfArg exp a
a <- [PrintfArg exp pred]
as]
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| fprintf($args:as'); |]
compFileCMD cmd :: FileCMD (Param3 prog exp ct) a
cmd@(FGet Handle
h) = do
    String -> CGenT Identity ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdio.h>"
    Val a
v <- Proxy ct -> CGenT Identity (Val a)
forall (m :: * -> *) (ct :: * -> Constraint)
       (proxy :: (* -> Constraint) -> *) a.
(MonadC m, CompTypeClass ct, ct a) =>
proxy ct -> m (Val a)
freshVar (FileCMD (Param3 prog exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred FileCMD (Param3 prog exp ct) a
cmd)
    Handle -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Handle
h
    let mkProxy :: FileCMD (Param3 prog exp pred) (Val a) -> Proxy a
mkProxy = (\FileCMD (Param3 prog exp pred) (Val a)
_ -> Proxy a
forall k (t :: k). Proxy t
Proxy) :: FileCMD (Param3 prog exp pred) (Val a) -> Proxy a
        form :: String
form    = Proxy a -> String
forall a. Formattable a => Proxy a -> String
formatSpecScan (FileCMD (Param3 prog exp ct) (Val a) -> Proxy a
forall k (prog :: k) (exp :: * -> *) (pred :: * -> Constraint) a.
FileCMD (Param3 prog exp pred) (Val a) -> Proxy a
mkProxy FileCMD (Param3 prog exp ct) a
FileCMD (Param3 prog exp ct) (Val a)
cmd)
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| fscanf($id:h, $string:form, &$id:v); |]
    Val a -> CGenT Identity (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
v
compFileCMD cmd :: FileCMD (Param3 prog exp ct) a
cmd@(FEof Handle
h) = do
    String -> CGenT Identity ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdbool.h>"
    String -> CGenT Identity ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stdio.h>"
    Val Bool
v <- Proxy ct -> CGenT Identity (Val Bool)
forall (m :: * -> *) (ct :: * -> Constraint)
       (proxy :: (* -> Constraint) -> *) a.
(MonadC m, CompTypeClass ct, ct a) =>
proxy ct -> m (Val a)
freshVar (FileCMD (Param3 prog exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred FileCMD (Param3 prog exp ct) a
cmd)
    Handle -> CGenT Identity ()
forall (m :: * -> *) v. (MonadC m, ToIdent v) => v -> m ()
touchVar Handle
h
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| $id:v = feof($id:h); |]
    Val Bool -> CGenT Identity (Val Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Val Bool
v

compC_CMD :: (CompExp exp, CompTypeClass ct) =>
    C_CMD (Param3 CGen exp ct) a -> CGen a
compC_CMD :: C_CMD (Param3 CGen exp ct) a -> CGen a
compC_CMD cmd :: C_CMD (Param3 CGen exp ct) a
cmd@(NewCArr String
base Maybe i
align exp i
size) = do
    String
sym <- String -> CGenT Identity String
forall (m :: * -> *). MonadC m => String -> m String
gensym String
base
    let sym' :: String
sym' = Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:String
sym
    Exp
n <- exp i -> CGenT Identity Exp
forall (exp :: * -> *) (m :: * -> *) a.
(CompExp exp, MonadC m) =>
exp a -> m Exp
compExp exp i
size
    Type
t <- Proxy ct -> Proxy a -> CGenT Identity Type
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (C_CMD (Param3 CGen exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred C_CMD (Param3 CGen exp ct) a
cmd) (C_CMD (Param3 CGen exp ct) (Arr i a) -> Proxy a
forall k1 k2 (proxy1 :: k1 -> *) (proxy2 :: k2 -> k1) (a :: k2).
proxy1 (proxy2 a) -> Proxy a
proxyArg C_CMD (Param3 CGen exp ct) a
C_CMD (Param3 CGen exp ct) (Arr i a)
cmd)
    case Exp
n of
      C.Const Const
_ SrcLoc
_ -> do
        case Maybe i
align of
          Just i
a -> do
            let a' :: Int
a' = i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
a :: Int
            InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal [cdecl| $ty:t $id:sym'[ $n ] __attribute__((aligned($a'))); |]
          Maybe i
_ -> InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal [cdecl| $ty:t $id:sym'[ $n ]; |]
        InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal [cdecl| $ty:t * $id:sym = $id:sym'; |]  -- explanation at 'compArrCMD'
      Exp
_ -> do
        case Maybe i
align of
          Just i
a -> do
            let a' :: Int
a' = i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
a :: Int
            BlockItem -> CGenT Identity ()
forall (m :: * -> *). MonadC m => BlockItem -> m ()
addItem [citem| $ty:t $id:sym'[ $n ] __attribute__((aligned($a'))); |]
          Maybe i
_ -> BlockItem -> CGenT Identity ()
forall (m :: * -> *). MonadC m => BlockItem -> m ()
addItem [citem| $ty:t $id:sym'[ $n ]; |]
        BlockItem -> CGenT Identity ()
forall (m :: * -> *). MonadC m => BlockItem -> m ()
addItem [citem| $ty:t * $id:sym = $id:sym'; |]  -- explanation at 'compArrCMD'
    Arr i a -> CGenT Identity (Arr i a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Arr i a -> CGenT Identity (Arr i a))
-> Arr i a -> CGenT Identity (Arr i a)
forall a b. (a -> b) -> a -> b
$ String -> Arr i a
forall i a. String -> Arr i a
ArrComp String
sym
compC_CMD cmd :: C_CMD (Param3 CGen exp ct) a
cmd@(ConstCArr String
base Maybe i
align [a]
as) = do
    String
sym <- String -> CGenT Identity String
forall (m :: * -> *). MonadC m => String -> m String
gensym String
base
    let sym' :: String
sym' = Char
'_'Char -> String -> String
forall a. a -> [a] -> [a]
:String
sym
    Type
t   <- Proxy ct -> Proxy a -> CGenT Identity Type
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (C_CMD (Param3 CGen exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred C_CMD (Param3 CGen exp ct) a
cmd) (C_CMD (Param3 CGen exp ct) (Arr i a) -> Proxy a
forall k1 k2 (proxy1 :: k1 -> *) (proxy2 :: k2 -> k1) (a :: k2).
proxy1 (proxy2 a) -> Proxy a
proxyArg C_CMD (Param3 CGen exp ct) a
C_CMD (Param3 CGen exp ct) (Arr i a)
cmd)
    [Exp]
as' <- (a -> CGenT Identity Exp) -> [a] -> CGenT Identity [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Proxy ct -> a -> CGenT Identity Exp
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy :: (* -> Constraint) -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy ct -> a -> m Exp
compLit (C_CMD (Param3 CGen exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred C_CMD (Param3 CGen exp ct) a
cmd)) [a]
as
    case Maybe i
align of
      Just i
a -> do
        let a' :: Int
a' = i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
a :: Int
        InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal [cdecl| $ty:t $id:sym'[] __attribute__((aligned($a'))) = $init:(arrayInit as'); |]
      Maybe i
_ -> InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal [cdecl| $ty:t $id:sym'[] = $init:(arrayInit as');|]
    InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal [cdecl| $ty:t * $id:sym = $id:sym'; |]  -- explanation at 'compArrCMD'
    Arr i a -> CGenT Identity (Arr i a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Arr i a -> CGenT Identity (Arr i a))
-> Arr i a -> CGenT Identity (Arr i a)
forall a b. (a -> b) -> a -> b
$ String -> Arr i a
forall i a. String -> Arr i a
ArrComp String
sym
compC_CMD cmd :: C_CMD (Param3 CGen exp ct) a
cmd@(NewPtr String
base) = do
    String -> CGenT Identity ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
"<stddef.h>"
    Ptr a
p <- String -> Ptr a
forall a. String -> Ptr a
PtrComp (String -> Ptr a)
-> CGenT Identity String -> CGenT Identity (Ptr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> CGenT Identity String
forall (m :: * -> *). MonadC m => String -> m String
gensym String
base
    Type
t <- Proxy ct -> Proxy a -> CGenT Identity Type
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (C_CMD (Param3 CGen exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred C_CMD (Param3 CGen exp ct) a
cmd) (C_CMD (Param3 CGen exp ct) (Ptr a) -> Proxy a
forall k1 k2 (proxy1 :: k1 -> *) (proxy2 :: k2 -> k1) (a :: k2).
proxy1 (proxy2 a) -> Proxy a
proxyArg C_CMD (Param3 CGen exp ct) a
C_CMD (Param3 CGen exp ct) (Ptr a)
cmd)
    InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal [cdecl| $ty:t * $id:p = NULL; |]
    Ptr a -> CGenT Identity (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
p
compC_CMD (PtrToArr (PtrComp String
p)) = Arr i a -> CGenT Identity (Arr i a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Arr i a -> CGenT Identity (Arr i a))
-> Arr i a -> CGenT Identity (Arr i a)
forall a b. (a -> b) -> a -> b
$ String -> Arr i a
forall i a. String -> Arr i a
ArrComp String
p
compC_CMD (NewObject String
base String
t Bool
pointed) = do
    Object
o <- Bool -> String -> String -> Object
Object Bool
pointed String
t (String -> Object)
-> CGenT Identity String -> CGenT Identity Object
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> CGenT Identity String
forall (m :: * -> *). MonadC m => String -> m String
gensym String
base
    let t' :: Type
t' = String -> Type
namedType String
t
    if Bool
pointed
      then InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal [cdecl| $ty:t' * $id:o; |]
      else InitGroup -> CGenT Identity ()
forall (m :: * -> *). MonadC m => InitGroup -> m ()
addLocal [cdecl| $ty:t' $id:o; |]
    Object -> CGenT Identity Object
forall (m :: * -> *) a. Monad m => a -> m a
return Object
o
compC_CMD (AddInclude String
inc)    = String -> CGenT Identity ()
forall (m :: * -> *). MonadC m => String -> m ()
addInclude String
inc
compC_CMD (AddDefinition Definition
def) = Definition -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal Definition
def
compC_CMD cmd :: C_CMD (Param3 CGen exp ct) a
cmd@(AddExternFun String
fun proxy res
res [FunArg exp pred]
args) = do
    Type
tres  <- Proxy ct -> proxy res -> CGenT Identity Type
forall (ct :: * -> Constraint) a (m :: * -> *)
       (proxy1 :: (* -> Constraint) -> *) (proxy2 :: * -> *).
(CompTypeClass ct, ct a, MonadC m) =>
proxy1 ct -> proxy2 a -> m Type
compType (C_CMD (Param3 CGen exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred C_CMD (Param3 CGen exp ct) a
cmd) proxy res
res
    [Param]
targs <- (FunArg exp pred -> CGenT Identity Param)
-> [FunArg exp pred] -> CGenT Identity [Param]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunArg exp pred -> CGenT Identity Param
forall k (arg :: k -> *) (pred :: k).
Arg arg pred =>
arg pred -> CGenT Identity Param
mkParam [FunArg exp pred]
args
    Definition -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal [cedecl| extern $ty:tres $id:fun($params:targs); |]
compC_CMD (AddExternProc String
proc [FunArg exp pred]
args) = do
    [Param]
targs <- (FunArg exp pred -> CGenT Identity Param)
-> [FunArg exp pred] -> CGenT Identity [Param]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunArg exp pred -> CGenT Identity Param
forall k (arg :: k -> *) (pred :: k).
Arg arg pred =>
arg pred -> CGenT Identity Param
mkParam [FunArg exp pred]
args
    Definition -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Definition -> m ()
addGlobal [cedecl| extern void $id:proc($params:targs); |]
compC_CMD cmd :: C_CMD (Param3 CGen exp ct) a
cmd@(CallFun String
fun [FunArg exp pred]
as) = do
    [Exp]
as' <- (FunArg exp pred -> CGenT Identity Exp)
-> [FunArg exp pred] -> CGenT Identity [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunArg exp pred -> CGenT Identity Exp
forall k (arg :: k -> *) (pred :: k).
Arg arg pred =>
arg pred -> CGenT Identity Exp
mkArg [FunArg exp pred]
as
    Val a
v   <- Proxy ct -> CGenT Identity (Val a)
forall (m :: * -> *) (ct :: * -> Constraint)
       (proxy :: (* -> Constraint) -> *) a.
(MonadC m, CompTypeClass ct, ct a) =>
proxy ct -> m (Val a)
freshVar (C_CMD (Param3 CGen exp ct) a -> Proxy ct
forall k1 k2 k3 k4 (cmd :: (k1, (k2, (k3, *))) -> k4 -> *)
       (p :: k1) (e :: k2) (pred :: k3) (a :: k4).
cmd (Param3 p e pred) a -> Proxy pred
proxyPred C_CMD (Param3 CGen exp ct) a
cmd)
    Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| $id:v = $id:fun($args:as'); |]
    Val a -> CGenT Identity (Val a)
forall (m :: * -> *) a. Monad m => a -> m a
return Val a
v
compC_CMD (CallProc Maybe obj
obj String
fun [FunArg exp pred]
as) = do
    [Exp]
as' <- (FunArg exp pred -> CGenT Identity Exp)
-> [FunArg exp pred] -> CGenT Identity [Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FunArg exp pred -> CGenT Identity Exp
forall k (arg :: k -> *) (pred :: k).
Arg arg pred =>
arg pred -> CGenT Identity Exp
mkArg [FunArg exp pred]
as
    case Maybe obj
obj of
      Maybe obj
Nothing -> Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| $id:fun($args:as'); |]
      Just obj
o  -> Stm -> CGenT Identity ()
forall (m :: * -> *). MonadC m => Stm -> m ()
addStm [cstm| $id:o = $id:fun($args:as'); |]
compC_CMD (InModule String
mod prog ()
prog) = String -> prog () -> prog ()
forall (m :: * -> *) a. MonadC m => String -> m a -> m a
inModule String
mod prog ()
prog

instance (CompExp exp, CompTypeClass ct)          => Interp RefCMD     CGen (Param2 exp ct) where interp :: RefCMD '(CGen, Param2 exp ct) a -> CGen a
interp = RefCMD '(CGen, Param2 exp ct) a -> CGen a
forall k (exp :: * -> *) (ct :: * -> Constraint) (prog :: k) a.
(CompExp exp, CompTypeClass ct) =>
RefCMD (Param3 prog exp ct) a -> CGen a
compRefCMD
instance (CompExp exp, CompTypeClass ct)          => Interp ArrCMD     CGen (Param2 exp ct) where interp :: ArrCMD '(CGen, Param2 exp ct) a -> CGen a
interp = ArrCMD '(CGen, Param2 exp ct) a -> CGen a
forall (exp :: * -> *) (ct :: * -> Constraint) a.
(CompExp exp, CompTypeClass ct) =>
ArrCMD (Param3 CGen exp ct) a -> CGen a
compArrCMD
instance (CompExp exp, CompTypeClass ct)          => Interp ControlCMD CGen (Param2 exp ct) where interp :: ControlCMD '(CGen, Param2 exp ct) a -> CGen a
interp = ControlCMD '(CGen, Param2 exp ct) a -> CGen a
forall (exp :: * -> *) (ct :: * -> Constraint) a.
(CompExp exp, CompTypeClass ct) =>
ControlCMD (Param3 CGen exp ct) a -> CGen a
compControlCMD
instance                                             Interp PtrCMD     CGen (Param2 exp ct) where interp :: PtrCMD '(CGen, Param2 exp ct) a -> CGen a
interp = PtrCMD '(CGen, Param2 exp ct) a -> CGen a
forall k k1 (prog :: k) (exp :: k1) (pred :: * -> Constraint) a.
PtrCMD (Param3 prog exp pred) a -> CGen a
compPtrCMD
instance (CompExp exp, CompTypeClass ct, ct Bool) => Interp FileCMD    CGen (Param2 exp ct) where interp :: FileCMD '(CGen, Param2 exp ct) a -> CGen a
interp = FileCMD '(CGen, Param2 exp ct) a -> CGen a
forall k (exp :: * -> *) (ct :: * -> Constraint) (prog :: k) a.
(CompExp exp, CompTypeClass ct, ct Bool) =>
FileCMD (Param3 prog exp ct) a -> CGen a
compFileCMD
instance (CompExp exp, CompTypeClass ct)          => Interp C_CMD      CGen (Param2 exp ct) where interp :: C_CMD '(CGen, Param2 exp ct) a -> CGen a
interp = C_CMD '(CGen, Param2 exp ct) a -> CGen a
forall (exp :: * -> *) (ct :: * -> Constraint) a.
(CompExp exp, CompTypeClass ct) =>
C_CMD (Param3 CGen exp ct) a -> CGen a
compC_CMD