WIP accum top-level args

1 files changed, 36 insertions, 0 deletions

diff --git a/src/CHAD/Accum.hs b/src/CHAD/Accum.hs
new file mode 100644
index 0000000..e26f781
--- /dev/null
+++ b/src/CHAD/Accum.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+module CHAD.Accum where
+
+import AST
+import CHAD.Types
+import Data
+
+
+
+hasArrays :: STy t' -> Bool
+hasArrays STNil = False
+hasArrays (STPair a b) = hasArrays a || hasArrays b
+hasArrays (STEither a b) = hasArrays a || hasArrays b
+hasArrays (STMaybe t) = hasArrays t
+hasArrays STArr{} = True
+hasArrays STScal{} = False
+hasArrays STAccum{} = error "Accumulators not allowed in source program"
+
+makeAccumulators :: SList STy envPro -> Ex (Append (D2AcE envPro) env) t -> Ex env (InvTup t (D2E envPro))
+makeAccumulators SNil e = e
+makeAccumulators (t `SCons` envpro) e =
+  makeAccumulators envpro $
+    EWith (EZero t) e
+
+uninvertTup :: SList STy list -> STy core -> Ex env (InvTup core list) -> Ex env (TPair core (Tup list))
+uninvertTup SNil _ e = EPair ext e (ENil ext)
+uninvertTup (t `SCons` list) tcore e =
+  ELet ext (uninvertTup list (STPair tcore t) e) $
+    let recT = STPair (STPair tcore t) (tTup list)  -- type of the RHS of that let binding
+    in EPair ext
+         (EFst ext (EFst ext (EVar ext recT IZ)))
+         (EPair ext
+            (ESnd ext (EVar ext recT IZ))
+            (ESnd ext (EFst ext (EVar ext recT IZ))))
+