WIP better zero/plus, fixing Accum (...)

The accumulator implementation was wrong because it forgot (in accumAdd)
to take into account that values may be variably-sized. Furthermore, it
was also complexity-inefficient because it did not build up a sparse
value. Thus let's go for the Haskell-interpreter-equivalent of what a
real, fast, compiled implementation would do: just a tree with mutable
variables. In practice one can decide to indeed flatten parts of that
tree, i.e. using a tree representation for nested pairs is bad, but that
should have been done _before_ execution and for _all_ occurrences of
that type fragment, not live at runtime by the accumulator
implementation.

1 files changed, 65 insertions, 0 deletions

diff --git a/src/CHAD/Types.hs b/src/CHAD/Types.hs
new file mode 100644
index 0000000..0b32393
--- /dev/null
+++ b/src/CHAD/Types.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+module CHAD.Types where
+
+import AST.Types
+
+
+type family D1 t where
+  D1 TNil = TNil
+  D1 (TPair a b) = TPair (D1 a) (D1 b)
+  D1 (TEither a b) = TEither (D1 a) (D1 b)
+  D1 (TMaybe a) = TMaybe (D1 a)
+  D1 (TArr n t) = TArr n (D1 t)
+  D1 (TScal t) = TScal t
+
+type family D2 t where
+  D2 TNil = TNil
+  D2 (TPair a b) = TEither TNil (TPair (D2 a) (D2 b))
+  D2 (TEither a b) = TEither TNil (TEither (D2 a) (D2 b))
+  D2 (TMaybe t) = TMaybe (D2 t)
+  D2 (TArr n t) = TArr n (D2 t)
+  D2 (TScal t) = D2s t
+
+type family D2s t where
+  D2s TI32 = TNil
+  D2s TI64 = TNil
+  D2s TF32 = TScal TF32
+  D2s TF64 = TScal TF64
+  D2s TBool = TNil
+
+type family D1E env where
+  D1E '[] = '[]
+  D1E (t : env) = D1 t : D1E env
+
+type family D2E env where
+  D2E '[] = '[]
+  D2E (t : env) = D2 t : D2E env
+
+type family D2AcE env where
+  D2AcE '[] = '[]
+  D2AcE (t : env) = TAccum (D2 t) : D2AcE env
+
+d1 :: STy t -> STy (D1 t)
+d1 STNil = STNil
+d1 (STPair a b) = STPair (d1 a) (d1 b)
+d1 (STEither a b) = STEither (d1 a) (d1 b)
+d1 (STMaybe t) = STMaybe (d1 t)
+d1 (STArr n t) = STArr n (d1 t)
+d1 (STScal t) = STScal t
+d1 STAccum{} = error "Accumulators not allowed in input program"
+
+d2 :: STy t -> STy (D2 t)
+d2 STNil = STNil
+d2 (STPair a b) = STEither STNil (STPair (d2 a) (d2 b))
+d2 (STEither a b) = STEither STNil (STEither (d2 a) (d2 b))
+d2 (STMaybe t) = STMaybe (d2 t)
+d2 (STArr n t) = STArr n (d2 t)
+d2 (STScal t) = case t of
+  STI32 -> STNil
+  STI64 -> STNil
+  STF32 -> STScal STF32
+  STF64 -> STScal STF64
+  STBool -> STNil
+d2 STAccum{} = error "Accumulators not allowed in input program"