diff options
Diffstat (limited to 'src/AST/Types.hs')
-rw-r--r-- | src/AST/Types.hs | 25 |
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 |