Clean up code organisation a little

1 files changed, 25 insertions, 0 deletions

diff --git a/src/AST/Types.hs b/src/AST/Types.hs
index acf7053..be7cffe 100644
--- a/src/AST/Types.hs
+++ b/src/AST/Types.hs
@@ -1,8 +1,10 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
 module AST.Types where
 
 import Data.Int (Int32, Int64)
@@ -117,3 +119,26 @@ hasArrays (STMaybe t) = hasArrays t
 hasArrays STArr{} = True
 hasArrays STScal{} = False
 hasArrays STAccum{} = True
+
+type family Tup env where
+  Tup '[] = TNil
+  Tup (t : ts) = TPair (Tup ts) t
+
+mkTup :: f TNil -> (forall a b. f a -> f b -> f (TPair a b))
+      -> SList f list -> f (Tup list)
+mkTup nil _    SNil = nil
+mkTup nil pair (e `SCons` es) = pair (mkTup nil pair es) e
+
+tTup :: SList STy env -> STy (Tup env)
+tTup = mkTup STNil STPair
+
+unTup :: (forall a b. c (TPair a b) -> (c a, c b))
+      -> SList f list -> c (Tup list) -> SList c list
+unTup _ SNil _ = SNil
+unTup unpack (_ `SCons` list) tup =
+  let (xs, x) = unpack tup
+  in x `SCons` unTup unpack list xs
+
+type family InvTup core env where
+  InvTup core '[] = core
+  InvTup core (t : ts) = InvTup (TPair core t) ts