Merge closures mostly done. Desugaring cases is a problem.

src/TypeChecker/TypeCheckerIr.hs

@@ -10,31 +10,30 @@ import           Data.String   (IsString)
 import           Grammar.Abs   (Lit (..))
 import           Grammar.Print
 import           Prelude
-import qualified Prelude       as C (Eq, Ord, Read, Show)
 
 newtype Program' t = Program [Def' t]
-    deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
+    deriving (Eq, Ord, Show, Functor)
 
 data Def' t
     = DBind (Bind' t)
     | DData (Data' t)
-    deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
+    deriving (Eq, Ord, Show, Functor)
 
 data Type
     = TLit Ident
     | TVar TVar
     | TData Ident [Type]
     | TFun Type Type
-    deriving (Eq, Ord, Show, Read)
+    deriving (Eq, Ord, Show)
 
 data Data' t = Data t [Inj' t]
-    deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
+    deriving (Eq, Ord, Show, Functor)
 
 data Inj' t = Inj Ident t
-    deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
+    deriving (Eq, Ord, Show, Functor)
 
 newtype Ident = Ident String
-    deriving (C.Eq, C.Ord, C.Show, C.Read, IsString)
+    deriving (Eq, Ord, Show, IsString)
 
 data Pattern' t
     = PVar Ident
@@ -42,30 +41,31 @@ data Pattern' t
     | PCatch
     | PEnum Ident
     | PInj Ident [(Pattern' t, t)]
-    deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
+    deriving (Eq, Ord, Show, Functor)
 
 data Exp' t
     = EVar Ident
     | EInj Ident
     | ELit Lit
-    | ELet (Bind' t) (ExpT' t)
-    | EApp (ExpT' t) (ExpT' t)
-    | EAdd (ExpT' t) (ExpT' t)
-    | EAbs Ident (ExpT' t)
-    | ECase (ExpT' t) [Branch' t]
-    deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
+    | ELet (Bind' t) (T' Exp' t)
+    | EApp (T' Exp' t) (T' Exp' t)
+    | EAdd (T' Exp' t) (T' Exp' t)
+    | EAbs Ident (T' Exp' t)
+    | ECase (T' Exp' t) [Branch' t]
+    deriving (Eq, Ord, Show, Functor)
 
 newtype TVar = MkTVar Ident
-    deriving (C.Eq, C.Ord, C.Show, C.Read)
+    deriving (Eq, Ord, Show)
 
-type Id' t = (Ident, t)
-type ExpT' t = (Exp' t, t)
+type T' a t = (a t, t)
+type T  a t = (a, t)
 
-data Bind' t = Bind (Id' t) [Id' t] (ExpT' t)
-    deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
 
-data Branch' t = Branch (Pattern' t, t) (ExpT' t)
-    deriving (C.Eq, C.Ord, C.Show, C.Read, Functor)
+data Bind' t = Bind (T Ident t) [T Ident t] (T' Exp' t)
+    deriving (Eq, Ord, Show, Functor)
+
+data Branch' t = Branch (T' Pattern' t) (T' Exp' t)
+    deriving (Eq, Ord, Show, Functor)
 
 instance Print Ident where
     prt _ (Ident s) = doc $ showString s
@@ -81,22 +81,22 @@ instance Print t => Print (Bind' t) where
                 , prt i rhs
                 ]
 
-prtSig :: Print t => Id' t -> Doc
-prtSig (name, t) =
+prtSig :: Print t => T Ident t -> Doc
+prtSig (x, t) =
     concatD
-        [ prt 0 name
+        [ prt 0 x
         , doc $ showString ":"
         , prt 0 t
         ]
 
-instance Print t => Print (ExpT' t) where
-    prt i (e, t) =
+instance (Print a, Print t) => Print (T a t) where
+    prt i (x, t) =
         concatD
-            [ doc $ showString "("
-            , prt i e
-            , doc $ showString ":"
-            , prt 0 t
-            , doc $ showString ")"
+            [ -- doc $ showString "("
+            {- , -} prt i x
+--            , doc $ showString ":"
+--            , prt 0 t
+--            , doc $ showString ")"
             ]
 
 instance Print t => Print [Bind' t] where
@@ -104,16 +104,6 @@ instance Print t => Print [Bind' t] where
     prt i [x]      = concatD [prt i x]
     prt i (x : xs) = concatD [prt i x, doc (showString ";"), prt i xs]
 
-instance Print t => Print (Id' t) where
-    prt i (name, t) =
-        concatD
-            [ doc $ showString "("
-            , prt i name
-            , doc $ showString ","
-            , prt i t
-            , doc $ showString ")"
-            ]
-
 instance Print t => Print (Exp' t) where
     prt i = \case
         EVar lident -> prPrec i 3 (concatD [prt 0 lident])
@@ -151,9 +141,6 @@ instance Print t => Print [Inj' t] where
     prt i [x] = prt i x
     prt i (x : xs) = prPrec i 0 $ concatD [prt i x, doc $ showString "\n  ", prt i xs]
 
-instance Print t => Print (Pattern' t, t) where
-    prt i (p, t) = prPrec i 1 (concatD [prt i p, prt i t])
-
 instance Print t => Print (Pattern' t) where
     prt i = \case
         PVar name -> prPrec i 1 (concatD [prt 0 name])
@@ -189,8 +176,6 @@ type Branch = Branch' Type
 type Pattern = Pattern' Type
 type Inj = Inj' Type
 type Exp = Exp' Type
-type ExpT = ExpT' Type
-type Id = Id' Type
 pattern TVar' s = TVar (MkTVar s)
 pattern DBind' id vars expt = DBind (Bind id vars expt)
 pattern DData' typ injs = DData (Data typ injs)