D2[Array] now has a Maybe instead of zero-size for zero

Remaining problem: 'add' in Compile doesn't use the D2 stuff

1 files changed, 51 insertions, 0 deletions

diff --git a/src/AST/Types.hs b/src/AST/Types.hs
index 0b41671..217b2f5 100644
--- a/src/AST/Types.hs
+++ b/src/AST/Types.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
@@ -8,7 +9,9 @@
 module AST.Types where
 
 import Data.Int (Int32, Int64)
+import Data.GADT.Show
 import Data.Kind (Type)
+import Data.Some
 import Data.Type.Equality
 
 import Data
@@ -54,6 +57,8 @@ instance TestEquality STy where
   testEquality (STAccum a) (STAccum a') | Just Refl <- testEquality a a' = Just Refl
   testEquality STAccum{} _ = Nothing
 
+instance GShow STy where gshowsPrec = defaultGshowsPrec
+
 data SScalTy t where
   STI32 :: SScalTy TI32
   STI64 :: SScalTy TI64
@@ -70,6 +75,8 @@ instance TestEquality SScalTy where
   testEquality STBool STBool = Just Refl
   testEquality _ _ = Nothing
 
+instance GShow SScalTy where gshowsPrec = defaultGshowsPrec
+
 scalRepIsShow :: SScalTy t -> Dict (Show (ScalRep t))
 scalRepIsShow STI32 = Dict
 scalRepIsShow STI64 = Dict
@@ -82,6 +89,50 @@ type TIx = TScal TI64
 tIx :: STy TIx
 tIx = STScal STI64
 
+unSTy :: STy t -> Ty
+unSTy = \case
+  STNil -> TNil
+  STPair a b -> TPair (unSTy a) (unSTy b)
+  STEither a b -> TEither (unSTy a) (unSTy b)
+  STMaybe t -> TMaybe (unSTy t)
+  STArr n t -> TArr (unSNat n) (unSTy t)
+  STScal t -> TScal (unSScalTy t)
+  STAccum t -> TAccum (unSTy t)
+
+unSEnv :: SList STy env -> [Ty]
+unSEnv SNil = []
+unSEnv (SCons t l) = unSTy t : unSEnv l
+
+unSScalTy :: SScalTy t -> ScalTy
+unSScalTy = \case
+  STI32 -> TI32
+  STI64 -> TI64
+  STF32 -> TF32
+  STF64 -> TF64
+  STBool -> TBool
+
+reSTy :: Ty -> Some STy
+reSTy = \case
+  TNil -> Some STNil
+  TPair a b | Some a' <- reSTy a, Some b' <- reSTy b -> Some $ STPair a' b'
+  TEither a b | Some a' <- reSTy a, Some b' <- reSTy b -> Some $ STEither a' b'
+  TMaybe t | Some t' <- reSTy t -> Some $ STMaybe t'
+  TArr n t | Some n' <- reSNat n, Some t' <- reSTy t -> Some $ STArr n' t'
+  TScal t | Some t' <- reSScalTy t -> Some $ STScal t'
+  TAccum t | Some t' <- reSTy t -> Some $ STAccum t'
+
+reSEnv :: [Ty] -> Some (SList STy)
+reSEnv [] = Some SNil
+reSEnv (t : l) | Some t' <- reSTy t, Some env <- reSEnv l = Some (SCons t' env)
+
+reSScalTy :: ScalTy -> Some SScalTy
+reSScalTy = \case
+  TI32 -> Some STI32
+  TI64 -> Some STI64
+  TF32 -> Some STF32
+  TF64 -> Some STF64
+  TBool -> Some STBool
+
 type family ScalRep t where
   ScalRep TI32 = Int32
   ScalRep TI64 = Int64