Lots of stuff; can compile simple single-generate program

5 files changed, 244 insertions, 38 deletions

diff --git a/SC/Acc.hs b/SC/Acc.hs
index b50bf24..5ae2532 100644
--- a/SC/Acc.hs
+++ b/SC/Acc.hs
@@ -100,7 +100,8 @@ compilePAcc' aenv destnames = \case
           CompiledFun funFD funArgbuilder usedAfun <- compileFun aenv fun
           tempnames <- genVars restype
           loops <- enumShapeNested destshnames $ \idxnames linidxexpr -> concat
-                       [[C.SCall (C.fundefName funFD)
+                       [[C.SDecl t n Nothing | TypedName t n <- itupList tempnames]
+                       ,[C.SCall (C.fundefName funFD)
                                  (funArgbuilder (itupEvars (fromShNames idxnames)) tempnames)]
                        ,[C.SStore arrname linidxexpr (C.EVar tempname)
                         | (arrname, tempname) <- zipDestSrcNamesAE destarrnames tempnames]]
@@ -108,42 +109,46 @@ compilePAcc' aenv destnames = \case
               [[CChunk [sheFD]
                        [C.SCall (C.fundefName sheFD)
                                 (sheArgbuilder ITupIgnore (fromShNames destshnames))]
-                       (map (\(TypedAName _ n) -> n) usedAshe)]
+                       (concatMap (\(SomeArray _ ans) ->
+                                       map (\(TypedAName _ n) -> n) (itupList ans))
+                                  usedAshe)]
               ,[CAlloc [] eltty n (C.StExpr [] (computeSize destshnames))
                | TypedAName arrty n <- itupList destarrnames
                , let C.TPtr eltty = arrty]
               ,[CChunk [funFD]
                        loops
-                       (map (\(TypedAName _ n) -> n) (itupList destarrnames ++ usedAfun))]]
+                       (map (\(TypedAName _ n) -> n)
+                            (itupList destarrnames
+                               ++ concatMap (\(SomeArray _ ans) -> itupList ans) usedAfun))]]
 
     _ -> throw "Unsupported Acc constructor"
 
 -- | Returns an expression of type int64_t
 computeSize :: ShNames sh -> C.Expr
 computeSize ShZ = C.ELit "1LL"
-computeSize (ShS n ShZ) = C.EVar n
-computeSize (ShS n ns) = C.EOp (C.EVar n) "*" (computeSize ns)
+computeSize (ShS ShZ n) = C.EVar n
+computeSize (ShS ns n) = C.EOp (computeSize ns) "*" (C.EVar n)
 
 -- | Given size variables and index variables, returns an expression of type int64_t
 linearIndexExpr :: ShNames sh -> ShNames sh -> C.Expr
 linearIndexExpr ShZ ShZ = C.ELit "1LL"
-linearIndexExpr (ShS _ ShZ) (ShS i ShZ) = C.EVar i
-linearIndexExpr (ShS n ns) (ShS i is) =
+linearIndexExpr (ShS ShZ _) (ShS ShZ i) = C.EVar i
+linearIndexExpr (ShS ns n) (ShS is i) =
     C.EOp (C.EOp (linearIndexExpr ns is) "*" (C.EVar n)) "+" (C.EVar i)
 
-zipDestSrcNames :: ITup C.Name e -> ITup C.Name e -> [(C.Name, C.Name)]
+zipDestSrcNames :: ITup C.Name t -> ITup C.Name t -> [(C.Name, C.Name)]
 zipDestSrcNames ITupIgnore _ = []
 zipDestSrcNames _ ITupIgnore = error "Ignore in source names but not in destination names"
 zipDestSrcNames (ITupSingle n) (ITupSingle n') = [(n, n')]
 zipDestSrcNames (ITupPair a b) (ITupPair a' b') = zipDestSrcNames a a' ++ zipDestSrcNames b b'
 zipDestSrcNames _ _ = error "wat"
 
-zipDestSrcNamesAA :: ANames e -> ANames e -> [(C.Name, C.Name)]
+zipDestSrcNamesAA :: ANames t -> ANames t -> [(C.Name, C.Name)]
 zipDestSrcNamesAA ns1 ns2 =
     zipDestSrcNames (itupmap (\(TypedAName _ n) -> n) ns1)
                     (itupmap (\(TypedAName _ n) -> n) ns2)
 
-zipDestSrcNamesAE :: ANames e -> Names e -> [(C.Name, C.Name)]
+zipDestSrcNamesAE :: ANames t -> Names t -> [(C.Name, C.Name)]
 zipDestSrcNamesAE ns1 ns2 =
     zipDestSrcNames (itupmap (\(TypedAName _ n) -> n) ns1)
                     (itupmap (\(TypedName _ n) -> n) ns2)
@@ -159,7 +164,7 @@ enumShapeNested sizenames fun = do
     idxnames <- genShNames (shNamesShape sizenames)
     let makeLoops :: ShNames sh -> ShNames sh -> [C.Stmt] -> [C.Stmt]
         makeLoops ShZ ShZ body = body
-        makeLoops (ShS n ns) (ShS i is) body =
+        makeLoops (ShS ns n) (ShS is i) body =
             makeLoops ns is [C.SFor (C.TInt C.B64) i (C.ELit "0") (C.EVar n) body]
     return (makeLoops sizenames idxnames (fun idxnames (linearIndexExpr sizenames idxnames)))
 
@@ -174,6 +179,11 @@ genVarsAEnv (LeftHandSidePair lhs1 lhs2) env = do
     (n2, env2) <- genVarsAEnv lhs2 env1
     return (ANPair n1 n2, env2)
 
+genAVarsTup :: ArraysR t -> SC (TupANames t)
+genAVarsTup TupRunit = return ANIgnore
+genAVarsTup (TupRsingle (ArrayR sht ty)) = ANArray <$> genShNames sht <*> genAVars ty
+genAVarsTup (TupRpair t1 t2) = ANPair <$> genAVarsTup t1 <*> genAVarsTup t2
+
 genAVars :: TypeR t -> SC (ANames t)
 genAVars TupRunit = return ITupIgnore
 genAVars (TupRsingle ty) = genAVar ty
@@ -182,9 +192,9 @@ genAVars (TupRpair t1 t2) = ITupPair <$> genAVars t1 <*> genAVars t2
 genShNames :: ShapeR sh -> SC (ShNames sh)
 genShNames ShapeRz = return ShZ
 genShNames (ShapeRsnoc sht) = do
-    name <- genName "n"
     names <- genShNames sht
-    return (ShS name names)
+    name <- genName "n"
+    return (ShS names name)
 
 genAVar :: ScalarType t -> SC (ANames t)
-genAVar ty = ITupSingle <$> (TypedAName <$> cvtType ty <*> genName "a")
+genAVar ty = ITupSingle <$> (TypedAName <$> fmap C.TPtr (cvtType ty) <*> genName "a")
diff --git a/SC/Afun.hs b/SC/Afun.hs
new file mode 100644
index 0000000..3379cc6
--- /dev/null
+++ b/SC/Afun.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE StandaloneDeriving #-}
+module SC.Afun where
+
+import qualified Data.Array.Accelerate.AST as A
+import Data.Array.Accelerate.AST.LeftHandSide
+import Data.Array.Accelerate.Representation.Array
+import Data.Array.Accelerate.Representation.Type
+
+import qualified Language.C as C
+import SC.Acc
+import SC.Defs
+import SC.Monad
+
+
+-- | Variable names for a tuple of arrays. Each array is represented in
+-- struct-of-arrays form. For example: the type
+-- @(Scalar Double, Matrix (Int, Float))@, which is internally represented as
+-- @(Array () Double, Array (((), Int), Int) (Int, Float))@, would be
+-- described as follows: (the variable names will differ)
+--
+-- > CATNPair (CATNArray CSNNil
+-- >                     (CANName TDouble (Name "a")))
+-- >          (CATNArray (CSNSnoc (CSNSnoc CSNNil (Name "n1")) (Name "n2"))
+-- >                     (CANPair (CANName (TInt B64) (Name "b"))
+-- >                              (CANName TFloat (Name "c"))))
+--
+-- Suppose that the Accelerate function in question has return type
+-- @Vector Double@, which is to say @Array ((), Int) Double@, with description:
+--
+-- > CATNArray (CSNSnoc CSNNil (Name "m"))
+-- >           (CANName TDouble (Name "r"))
+--
+-- Then its C function definition would look as follows:
+--
+-- > void function(double *a,
+-- >               int64_t n1, int64_t n2, int64_t *b, int64_t *c,
+-- >               int64_t m, double **r);
+--
+-- Note that the first input array array here has zero shape arguments because
+-- it is zero-dimensional.
+data CArrTupNames a where
+    CATNPair :: CArrTupNames a -> CArrTupNames b -> CArrTupNames (a, b)
+    CATNArray :: CShNames sh -> CArrNames sh a -> CArrTupNames (Array sh a)
+    CATNNil :: CArrTupNames ()
+deriving instance Show (CArrTupNames a)
+
+-- | Names for the shape of an array. See 'CArrTupNames' for more information.
+--
+-- Note that the names in this structure are are to be interpreted as variables
+-- of type @int64_t@.
+data CShNames sh where
+    CSNSnoc :: CShNames sh -> C.Name -> CShNames (sh, Int)
+    CSNNil :: CShNames ()
+deriving instance Show (CShNames a)
+
+-- | Names for a single array. See 'CArrTupNames' for more information.
+--
+-- Note that the 'C.Type' in 'CANName' is the /element/ type of the array.
+data CArrNames sh a where
+    CANPair :: CArrNames sh a -> CArrNames sh b -> CArrNames sh (a, b)
+    CANName :: C.Type -> C.Name -> CArrNames sh a
+    CANNil :: CArrNames sh ()
+deriving instance Show (CArrNames sh a)
+
+-- | The function passed should have exactly one argument (that may consist of
+-- multiple arrays in a tuple, of course).
+--
+-- The result consists of:
+-- 1. An array of auxiliary function definitions that the program needs, on top
+--    of the prelude.
+-- 2. The function that implements the top-level Accelerate array function.
+-- 3. The variable names corresponding to the components of the argument.
+-- 4. The variable names corresponding to the components of the result. These
+--    are double-pointer arguments to the function in (2.).
+--
+-- For an example, see the documentation of 'CArrTupNames'.
+compileAfun1 :: C.Name
+             -> A.Afun (a -> b)
+             -> SC ([C.FunDef], C.FunDef, CArrTupNames a, CArrTupNames b)
+compileAfun1 procname (A.Alam lhs (A.Abody acc)) = do
+    (argnames, aenv) <- genVarsAEnv lhs AVENil
+    destnames <- genAVarsTup (A.arraysR acc)
+    let destShapeDeclSts = [C.SDecl t n Nothing
+                           | TypedName t n <- fst (tupanamesList destnames)]
+    outnames <- genAVarsTup (A.arraysR acc)
+    (auxdefs, stmts) <- compileCommands <$> compileAcc' aenv destnames acc
+    return (auxdefs
+           ,C.ProcDef procname
+                      (map (\case Left (TypedName t n) -> (t, n)
+                                  Right (TypedAName t n) -> (t, n))
+                           (tupanamesList' argnames)
+                       ++
+                       map (\case Left (TypedName t n) -> (C.TPtr t, n)
+                                  Right (TypedAName t n) -> (C.TPtr t, n))
+                           (tupanamesList' outnames))
+                      (destShapeDeclSts ++
+                        stmts ++
+                        [C.SStore outn (C.ELit "0") (C.EVar destn)
+                        | (outn, destn) <- zipOutSrcNamesT outnames destnames])
+           ,makeCArrTupNames (lhsToTupR lhs) (\(C.TPtr t) -> t) argnames
+           ,makeCArrTupNames (A.arraysR acc) (\(C.TPtr t) -> t) outnames)
+  where
+    makeCArrTupNames :: ArraysR a -> (C.Type -> C.Type) -> TupANames a -> CArrTupNames a
+    makeCArrTupNames (TupRpair t1 t2) typefun (ANPair an1 an2) =
+        CATNPair (makeCArrTupNames t1 typefun an1) (makeCArrTupNames t2 typefun an2)
+    makeCArrTupNames (TupRsingle (ArrayR _ t)) typefun (ANArray shn ans) =
+        CATNArray (makeCShNames shn) (makeCArrNames t typefun ans)
+    makeCArrTupNames TupRunit _ ANIgnore = CATNNil
+    makeCArrTupNames _ _ ANIgnore = error "Ignore of non-nil element in generated names"
+
+    makeCShNames :: ShNames sh -> CShNames sh
+    makeCShNames ShZ = CSNNil
+    makeCShNames (ShS ns n) = CSNSnoc (makeCShNames ns) n
+
+    makeCArrNames :: TypeR a -> (C.Type -> C.Type) -> ANames a -> CArrNames sh a
+    makeCArrNames (TupRpair t1 t2) typefun (ITupPair an1 an2) =
+        CANPair (makeCArrNames t1 typefun an1) (makeCArrNames t2 typefun an2)
+    makeCArrNames (TupRsingle _) typefun (ITupSingle (TypedAName ty n)) =
+        CANName (typefun ty) n
+    makeCArrNames TupRunit _ ITupIgnore = CANNil
+    makeCArrNames _ _ ITupIgnore = error "Ignore of non-nil element in generated names"
+    makeCArrNames _ _ _ = error "Invalid GADTs"
+
+    zipOutSrcNamesT :: TupANames t -> TupANames t -> [(C.Name, C.Name)]
+    zipOutSrcNamesT ANIgnore _ = []
+    zipOutSrcNamesT _ ANIgnore = error "Ignore in source names but not in out names"
+    zipOutSrcNamesT (ANArray shn ns) (ANArray shn' ns') =
+        zipWith (\(TypedName _ n) (TypedName _ n') -> (n, n'))
+                (shnamesList shn) (shnamesList shn')
+           ++ zipOutSrcNames ns ns'
+    zipOutSrcNamesT (ANPair a b) (ANPair a' b') = zipOutSrcNamesT a a' ++ zipOutSrcNamesT b b'
+
+    zipOutSrcNames :: ANames t -> ANames t -> [(C.Name, C.Name)]
+    zipOutSrcNames ITupIgnore _ = []
+    zipOutSrcNames _ ITupIgnore = error "Ignore in source names but not in out names"
+    zipOutSrcNames (ITupPair a b) (ITupPair a' b') = zipOutSrcNames a a' ++ zipOutSrcNames b b'
+    zipOutSrcNames (ITupSingle (TypedAName _ n)) (ITupSingle (TypedAName _ n')) = [(n, n')]
+    zipOutSrcNames _ _ = error "Invalid GADTs"
+compileAfun1 _ _ = throw "Not an array function with exactly one argument"
diff --git a/SC/Defs.hs b/SC/Defs.hs
index fac4e33..0ecf9cd 100644
--- a/SC/Defs.hs
+++ b/SC/Defs.hs
@@ -1,11 +1,13 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE StandaloneDeriving #-}
 module SC.Defs where
 
 import Data.Array.Accelerate.AST.Idx
 import Data.Array.Accelerate.Representation.Array
 import Data.Array.Accelerate.Representation.Shape
 import Data.Array.Accelerate.Type
+import Data.Either (lefts, rights)
 
 import qualified Language.C as C
 import Language.C (Name(..))
@@ -68,39 +70,44 @@ data TypedAName = TypedAName C.Type Name
 
 data TupANames t where
     ANPair :: TupANames a -> TupANames b -> TupANames (a, b)
-    ANArray :: ShNames sh -> ITup TypedAName t -> TupANames (Array sh t)
+    ANArray :: ShNames sh -> ANames t -> TupANames (Array sh t)
     ANIgnore :: TupANames a
 
 -- Shape names and data array names
 tupanamesList :: TupANames t -> ([TypedName], [TypedAName])
-tupanamesList (ANPair a b) =
-    let (shn1, an1) = tupanamesList a
-        (shn2, an2) = tupanamesList b
-    in (shn1 ++ shn2, an1 ++ an2)
-tupanamesList (ANArray shn ns) = (shnamesList shn, itupList ns)
-tupanamesList ANIgnore = ([], [])
+tupanamesList an = let l = tupanamesList' an in (lefts l, rights l)
+
+tupanamesList' :: TupANames t -> [Either TypedName TypedAName]
+tupanamesList' (ANPair a b) = tupanamesList' a ++ tupanamesList' b
+tupanamesList' (ANArray shn ns) =
+    map Left (shnamesList shn) ++ map Right (itupList ns)
+tupanamesList' ANIgnore = []
 
 data ShNames sh where
     ShZ :: ShNames ()
-    ShS :: Name -> ShNames sh -> ShNames (sh, Int)
+    ShS :: ShNames sh -> Name -> ShNames (sh, Int)
+deriving instance Show (ShNames sh)
 
 shnamesList :: ShNames sh -> [TypedName]
-shnamesList ShZ = []
-shnamesList (ShS n shns) = TypedName (C.TInt C.B64) n : shnamesList shns
+shnamesList = reverse . go
+  where
+    go :: ShNames sh -> [TypedName]
+    go ShZ = []
+    go (ShS shns n) = TypedName (C.TInt C.B64) n : go shns
 
 makeShNames :: ShapeR sh -> ITup TypedName sh -> ShNames sh
 makeShNames ShapeRz ITupIgnore = ShZ
 makeShNames (ShapeRsnoc sht) (ITupPair ns (ITupSingle (TypedName _ n))) =
-    ShS n (makeShNames sht ns)
+    ShS (makeShNames sht ns) n
 makeShNames _ _ = error "wat"
 
 fromShNames :: ShNames sh -> ITup TypedName sh
 fromShNames ShZ = ITupIgnore
-fromShNames (ShS n ns) = ITupPair (fromShNames ns) (ITupSingle (TypedName (C.TInt C.B64) n))
+fromShNames (ShS ns n) = ITupPair (fromShNames ns) (ITupSingle (TypedName (C.TInt C.B64) n))
 
 shNamesShape :: ShNames sh -> ShapeR sh
 shNamesShape ShZ = ShapeRz
-shNamesShape (ShS _ ns) = ShapeRsnoc (shNamesShape ns)
+shNamesShape (ShS ns _) = ShapeRsnoc (shNamesShape ns)
 
 
 -- GENERATING VARIABLE NAMES
diff --git a/SC/Exp.hs b/SC/Exp.hs
index 2bd2b37..5ddd4bf 100644
--- a/SC/Exp.hs
+++ b/SC/Exp.hs
@@ -27,9 +27,13 @@ data CompiledFun aenv t1 t2 =
             --   the given names.
             --   The arguments will refer to array variable names found in the
             --   original array environment.
-        [TypedAName]
+        [SomeArray]
             -- ^ Arrays that the constructed arguments use from the environment
 
+-- | The variable names corresponding to a single source-level array (before
+-- SoA conversion).
+data SomeArray = forall sh t. SomeArray (ShNames sh) (ANames t)
+
 -- | The function must be single-argument. Uncurry if necessary (e.g. for zipWith).
 compileFun :: AVarEnv aenv -> A.Fun aenv (t1 -> t2) -> SC (CompiledFun aenv t1 t2)
 compileFun aenv (A.Lam lhs (A.Body body)) = do
@@ -40,14 +44,19 @@ compileFun aenv (A.Lam lhs (A.Body body)) = do
     (usedA, res) <- compileExp' aenv env body
     (sts1, retexprs) <- toStExprs (A.expType body) res
     let sts2 = genoutstores outnames retexprs
+        arrayarguments =
+            concatMap (\(SomeArray shn ans) ->
+                          map (\(TypedName t n) -> (t, n)) (shnamesList shn)
+                            ++ map (\(TypedAName t n) -> (t, n)) (itupList ans))
+                      usedA
         arguments =
-            map (\(TypedAName t n) -> (t, n)) usedA
+            arrayarguments
             ++ map (\(TypedName t n) -> (t, n)) (itupList argnames)
             ++ map (\(TypedName t n) -> (t, n)) (itupList outnames)
     return $ CompiledFun
         (C.ProcDef funname arguments (sts1 ++ sts2))
         (\argexprs destnames ->
-            map (\(TypedAName _ n) -> C.EVar n) usedA
+            map (C.EVar . snd) arrayarguments
             ++ itupList argexprs
             ++ map (\(TypedName _ n) -> C.EPtrTo (C.EVar n)) (itupList destnames))
         usedA
@@ -63,7 +72,7 @@ compileExp :: AVarEnv aenv -> A.Exp aenv t -> SC (CompiledFun aenv () t)
 compileExp aenv expr = compileFun aenv (A.Lam (LeftHandSideWildcard TupRunit) (A.Body expr))
 
 compileExp' :: AVarEnv aenv -> VarEnv env -> A.OpenExp env aenv t
-            -> SC ([TypedAName], Either (Names t -> [C.Stmt]) ([C.Stmt], Exprs t))
+            -> SC ([SomeArray], Either (Names t -> [C.Stmt]) ([C.Stmt], Exprs t))
 compileExp' aenv env = \case
     A.Let lhs rhs body -> do
         (names, env') <- genVarsEnv lhs env
@@ -76,6 +85,9 @@ compileExp' aenv env = \case
     A.Evar (Var _ idx) ->
         return ([], Right ([], ITupSingle (C.EVar (veprj env idx))))
 
+    A.Nil ->
+        return ([], Right ([], ITupIgnore))
+
     A.Pair a b -> do
         (usedA1, res1) <- compileExp' aenv env a
         (usedA2, res2) <- compileExp' aenv env b
@@ -84,6 +96,10 @@ compileExp' aenv env = \case
             ITupIgnore -> []
             ITupSingle _ -> error "wat"))
 
+    A.Const ty x
+      | Just str <- showExpConst ty x
+      -> return ([], Right ([], ITupSingle (C.ELit str)))
+
     A.PrimApp (A.PrimAdd _) e -> binary aenv env "+" e
     A.PrimApp (A.PrimSub _) e -> binary aenv env "-" e
     A.PrimApp (A.PrimMul _) e -> binary aenv env "*" e
@@ -94,7 +110,7 @@ compileExp' aenv env = \case
         let (shnames, _) = aveprj aenv idx
             buildExprs :: ShNames sh -> Exprs sh
             buildExprs ShZ = ITupIgnore
-            buildExprs (ShS n names) = ITupPair (buildExprs names) (ITupSingle (C.EVar n))
+            buildExprs (ShS names n) = ITupPair (buildExprs names) (ITupSingle (C.EVar n))
         in return ([], Right ([], buildExprs shnames))
 
     A.ToIndex shr she idxe -> do
@@ -120,15 +136,15 @@ compileExp' aenv env = \case
         let sts0 = [C.SDecl (C.TInt C.B64) temp Nothing]
         (usedA1, sts1) <- fmap (`toStoring` ITupSingle (TypedName (C.TInt C.B64) temp))
                               <$> compileExp' aenv env e
-        let (_, anames) = aveprj aenv idx
-            usedA = itupList anames ++ usedA1
+        let (shnames, anames) = aveprj aenv idx
+            usedA = SomeArray shnames anames : usedA1
         return (usedA, Right (sts0 ++ sts1
                              ,itupmap (\(TypedAName _ name) -> C.EIndex name (C.EVar temp)) anames))
 
-    _ -> throw "Unsupported Exp constructor"
+    e -> throw $ "Unsupported Exp constructor: " ++ A.showExpOp e
   where
     binary :: AVarEnv aenv -> VarEnv env -> String -> A.OpenExp env aenv (a, b)
-           -> SC ([TypedAName], Either (Names t -> [C.Stmt]) ([C.Stmt], Exprs t))
+           -> SC ([SomeArray], Either (Names t -> [C.Stmt]) ([C.Stmt], Exprs t))
     binary aenv' env' op e' = do
         (usedA, res) <- compileExp' aenv' env' e'
         (sts, ITupPair (ITupSingle e1) (ITupSingle e2)) <-
@@ -138,8 +154,9 @@ compileExp' aenv env = \case
 toStExprs :: TypeR t -> Either (Names t -> [C.Stmt]) ([C.Stmt], Exprs t) -> SC ([C.Stmt], Exprs t)
 toStExprs ty (Left fun) = do
     names <- genVars ty
-    let sts1 = fun names
-    return (sts1, itupmap (\(TypedName _ n) -> C.EVar n) names)
+    let sts1 = [C.SDecl t n Nothing | TypedName t n <- itupList names]
+        sts2 = fun names
+    return (sts1 ++ sts2, itupmap (\(TypedName _ n) -> C.EVar n) names)
 toStExprs _ (Right pair) = return pair
 
 toStoring :: Either (Names t -> [C.Stmt]) ([C.Stmt], Exprs t) -> Names t -> [C.Stmt]
@@ -153,6 +170,29 @@ toStoring (Right (sts, exs)) = (sts ++) . flip go exs
     go (ITupPair ns1 ns2) (ITupPair es1 es2) = go ns1 es1 ++ go ns2 es2
     go (ITupPair _ _) _ = error "wat"
 
+showExpConst :: ScalarType t -> t -> Maybe String
+showExpConst = \case
+    SingleScalarType (NumSingleType (IntegralNumType it)) -> Just . goI it
+    SingleScalarType (NumSingleType (FloatingNumType ft)) -> goF ft
+    VectorScalarType _ -> const Nothing
+  where
+    goI :: IntegralType t -> t -> String
+    goI TypeInt = (++ "LL") . show
+    goI TypeInt8 = ("(int8_t)" ++) . show
+    goI TypeInt16 = ("(int16_t)" ++) . show
+    goI TypeInt32 = show
+    goI TypeInt64 = (++ "LL") . show
+    goI TypeWord = (++ "ULL") . show
+    goI TypeWord8 = ("(uint8_t)" ++) . show
+    goI TypeWord16 = ("(uint16_t)" ++) . show
+    goI TypeWord32 = (++ "U") . show
+    goI TypeWord64 = (++ "ULL") . show
+
+    goF :: FloatingType t -> t -> Maybe String
+    goF TypeHalf = const Nothing
+    goF TypeFloat = Just . (++ "f") . show
+    goF TypeDouble = Just . show
+
 genVarsEnv :: A.ELeftHandSide t env env' -> VarEnv env -> SC (Names t, VarEnv env')
 genVarsEnv (LeftHandSideWildcard _) env = return (ITupIgnore, env)
 genVarsEnv (LeftHandSideSingle ty) env = do
diff --git a/SC/Prelude.hs b/SC/Prelude.hs
new file mode 100644
index 0000000..d29ef69
--- /dev/null
+++ b/SC/Prelude.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TemplateHaskell #-}
+module SC.Prelude where
+
+import Data.FileEmbed
+
+
+prelude :: String
+prelude = $(embedStringFile "prelude.c")