Lots of stuff; can compile simple single-generate program

11 files changed, 395 insertions, 43 deletions

diff --git a/Data/Array/Accelerate/C.hs b/Data/Array/Accelerate/C.hs
new file mode 100644
index 0000000..faa06f1
--- /dev/null
+++ b/Data/Array/Accelerate/C.hs
@@ -0,0 +1,76 @@
+{-|
+Module      : Data.Array.Accelerate.C
+Description : Sequential C backend for Accelerate
+Copyright   : (c) Tom Smeding, 2021
+License     : MIT
+Maintainer  : x+accelerate@tomsmeding.com
+Stability   : experimental
+Portability : non-portable (GHC extensions)
+
+This is a sequential C backend to Accelerate.
+
+Arrays are flattened in the C code: a two-dimensional array with elements of
+type @Float@ is encoded as a row-major single-dimensional array of type
+@float*@ in C. The indexing is the same as for the @linearIndex@ function from
+Accelerate.
+
+Because of the choices made in representing arrays as arguments to the
+generated C functions, using this backend may require a (basic) understanding
+of how Accelerate internally represents arrays (i.e. the so-called
+/representation types/). However, this only really becomes relevant if you use
+self-defined data types or sum types like @Maybe@, since otherwise it should be
+intuitive enough for casual use. These representation types show up in the
+precise form of the argument and output variable descriptors ('CArrTupNames')
+returned by 'translateAcc', and they influence the ordering of the arguments to the
+C functions.
+-}
+module Data.Array.Accelerate.C (
+    translateAcc,
+    CArrTupNames(..), CShNames(..), CArrNames(..),
+    C.Name(..), C.Type(..), C.Bits(..),
+) where
+
+import qualified Data.Array.Accelerate.Smart as Smart
+import qualified Data.Array.Accelerate.Sugar.Array as A
+import qualified Data.Array.Accelerate.Trafo as A
+
+import Data.Array.Accelerate.Trafo.UnDelayed
+import qualified Language.C as C
+import Language.C.Print (printProgram)
+import SC.Afun
+import SC.Prelude
+import SC.Monad
+
+
+-- | The function passed should have exactly one argument (that may consist of
+-- multiple arrays in a tuple, of course). The string argument determines the
+-- name of the top-level generated C function.
+--
+-- The result consists of:
+--
+-- 1. C source code (including required prelude) defining, ultimately, a C
+--    function that implements the top-level Accelerate array function.
+-- 2. The variable names corresponding to the components of the argument of the
+--    top-level function.
+-- 3. The variable names corresponding to the components of the result of the
+--    top-level function. These are out-arguments (i.e. pointer arguments) to
+--    that function.
+--
+-- For an example of how the produced function looks and how the variable name
+-- containers describe its arguments, see the documentation of 'CArrTupNames'.
+--
+-- Note that the variable name descriptors refer to the /representation types/
+-- of the input and output of the array function. This essentially means that
+-- the type has been converted to a form using only pairs and arrays. (This is
+-- the internal representation of data types in Accelerate.)
+translateAcc :: (A.Arrays a, A.Arrays b)
+             => String
+             -> (Smart.Acc a -> Smart.Acc b)
+             -> Either String (String, CArrTupNames (A.ArraysR a), CArrTupNames (A.ArraysR b))
+translateAcc procname afun = do
+    let ast = unDelayedAfun (A.convertAfun afun)
+    (auxdefs, fundef, argnames, outnames) <- evalSC (compileAfun1 (C.Name procname) ast)
+    let program = C.Program (auxdefs ++ [fundef])
+    return (prelude ++ "\n" ++ printProgram program 0 ""
+           ,argnames
+           ,outnames)
diff --git a/Data/Array/Accelerate/Trafo/UnDelayed.hs b/Data/Array/Accelerate/Trafo/UnDelayed.hs
new file mode 100644
index 0000000..8553dfa
--- /dev/null
+++ b/Data/Array/Accelerate/Trafo/UnDelayed.hs
@@ -0,0 +1,59 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+module Data.Array.Accelerate.Trafo.UnDelayed (
+  unDelayed, unDelayedAfun
+) where
+
+import Data.Array.Accelerate.AST
+import Data.Array.Accelerate.Trafo.Delayed
+
+
+-- | Convert from a delayed Acc representation back to the pre-fusion, internal
+-- Acc representation. This forgets information about whether nodes are
+-- manifest or not.
+unDelayed :: DelayedOpenAcc aenv a -> OpenAcc aenv a
+unDelayed (Manifest acc) = OpenAcc (unDelayed `through` acc)
+unDelayed (Delayed repr shexp fun _) = unDelayed (Manifest (Generate repr shexp fun))
+
+unDelayedAfun :: DelayedOpenAfun aenv a -> OpenAfun aenv a
+unDelayedAfun (Alam lhs fun) = Alam lhs (unDelayedAfun fun)
+unDelayedAfun (Abody a) = Abody (unDelayed a)
+
+through :: (forall aenv' t. f aenv' t -> g aenv' t)
+        -> PreOpenAcc f aenv a
+        -> PreOpenAcc g aenv a
+through f = \case
+  Alet lhs rhs body -> Alet lhs (f rhs) (f body)
+  Avar var -> Avar var
+  Apair a1 a2 -> Apair (f a1) (f a2)
+  Anil -> Anil
+  Apply ty fun a -> Apply ty (f `throughAF` fun) (f a)
+  Aforeign ty asm fun a -> Aforeign ty asm (f `throughAF` fun) (f a)
+  Acond e a1 a2 -> Acond e (f a1) (f a2)
+  Awhile fun1 fun2 a -> Awhile (f `throughAF` fun1) (f `throughAF` fun2) (f a)
+  Use ty arr -> Use ty arr
+  Unit ety e -> Unit ety e
+  Reshape sht e a -> Reshape sht e (f a)
+  Generate ty e efun -> Generate ty e efun
+  Transform ty e efun1 efun2 a -> Transform ty e efun1 efun2 (f a)
+  Replicate slix e a -> Replicate slix e (f a)
+  Slice slix a e -> Slice slix (f a) e
+  Map ty fun a -> Map ty fun (f a)
+  ZipWith ty fun a1 a2 -> ZipWith ty fun (f a1) (f a2)
+  Fold efun me a -> Fold efun me (f a)
+  FoldSeg ety efun me a1 a2 -> FoldSeg ety efun me (f a1) (f a2)
+  Scan dir efun me a -> Scan dir efun me (f a)
+  Scan' dir efun e a -> Scan' dir efun e (f a)
+  Permute efun1 a1 efun2 a2 -> Permute efun1 (f a1) efun2 (f a2)
+  Backpermute sht e efun a -> Backpermute sht e efun (f a)
+  Stencil stty ety efun bnd a -> Stencil stty ety efun bnd (f a)
+  Stencil2 stty1 stty2 ety efun bnd1 a1 bnd2 a2 ->
+    Stencil2 stty1 stty2 ety efun bnd1 (f a1) bnd2 (f a2)
+
+throughAF :: (forall aenv' t. f aenv' t -> g aenv' t)
+          -> PreOpenAfun f aenv a
+          -> PreOpenAfun g aenv a
+throughAF f = \case
+  Abody a -> Abody (f a)
+  Alam lhs fun -> Alam lhs (f `throughAF` fun)
diff --git a/Language/C.hs b/Language/C.hs
index 35cf432..6a3256f 100644
--- a/Language/C.hs
+++ b/Language/C.hs
@@ -9,6 +9,7 @@ data FunDef
     | ProcDef Name [(Type, Name)] [Stmt]
   deriving (Show, Eq)
 
+-- | Some C types.
 data Type
     = TInt Bits
     | TUInt Bits
@@ -17,9 +18,11 @@ data Type
     | TPtr Type
   deriving (Show, Eq)
 
+-- | The number of bits in a C integral type.
 data Bits = B8 | B16 | B32 | B64
   deriving (Show, Eq)
 
+-- | A C variable or function name.
 newtype Name = Name String
   deriving (Show, Eq, Ord)
 
diff --git a/Language/C/Print.hs b/Language/C/Print.hs
index e075b0e..cc511b2 100644
--- a/Language/C/Print.hs
+++ b/Language/C/Print.hs
@@ -20,12 +20,12 @@ printFunDef (FunDef rt n as (StExpr ss rete)) =
     % intercalates ", " [printType t % printString " " % printName an | (t, an) <- as]
     % printString ") {\n  "
     % addIndent 2 (intercalates "\n" (map printStmt ss))
-    % printString "\n  return (" % printExpr rete % printString ");\n}"
+    % printString "\n  return (" % printExpr rete % printString ");\n}\n"
 printFunDef (ProcDef n as ss) =
     printString "void " % printName n
     % printString "("
     % intercalates ", " [printType t % printString " " % printName an | (t, an) <- as]
-    % printString ") " % printBlock ss
+    % printString ") " % printBlock ss % printString "\n"
 
 printName :: Name -> PrintS
 printName (Name s) = printString s
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")
diff --git a/accelerate-sc.cabal b/accelerate-sc.cabal
index 1cb3060..6283c53 100644
--- a/accelerate-sc.cabal
+++ b/accelerate-sc.cabal
@@ -9,18 +9,23 @@ build-type:          Simple
 
 library
   exposed-modules:
+    Data.Array.Accelerate.C
   other-modules:
+    Data.Array.Accelerate.Trafo.UnDelayed
     Language.C
     Language.C.Print
     SC.Acc
+    SC.Afun
     SC.Defs
     SC.Exp
     SC.Monad
+    SC.Prelude
   build-depends:
     base >= 4.13 && < 4.15,
     containers >= 0.6.3.1 && < 0.7,
     accelerate ^>= 1.3.0.0,
-    transformers >= 0.5.6 && < 0.7
+    transformers >= 0.5.6 && < 0.7,
+    file-embed ^>= 0.0.15
   hs-source-dirs:      .
   default-language:    Haskell2010
   ghc-options:         -Wall -O2
diff --git a/prelude.c b/prelude.c
index bb345c4..22d01c0 100644
--- a/prelude.c
+++ b/prelude.c
@@ -1,4 +1,7 @@
-int builtin_divInt(int x, int y) {
+#include <stdlib.h>
+#include <stdint.h>
+
+/*int builtin_divInt(int x, int y) {
 	return
 		(x > 0 && y < 0) ? (x - 1) / y - 1
 		: (x < 0 && y > 0) ? (x + 1) / y - 1
@@ -10,4 +13,4 @@ int builtin_modInt(int x, int y) {
 		(x > 0 && y < 0) ? (x - 1) % y + y + 1
 		: (x < 0 && y > 0) ? (x + 1) % y + y - 1
 		: x % y;
-}
+}*/