Adjust old type checker to new syntax, and refactor lambda lifter to use typed AST

2023-02-15 23:55:16 +01:00 · 2023-02-15 23:55:16 +01:00 · 210e55bb15
commit 210e55bb15
parent 514c809b1e
18 changed files with 554 additions and 145 deletions
--- a/src/TypeCheckerIr.hs
+++ b/src/TypeCheckerIr.hs
@ -0,0 +1,108 @@
+{-# LANGUAGE LambdaCase #-}
+
+module TypeCheckerIr
+  ( module Grammar.Abs
+  , module TypeCheckerIr
+  ) where
+
+import           Grammar.Abs   (Ident (..), Type (..))
+import           Grammar.Print
+import           Prelude
+import qualified Prelude       as C (Eq, Ord, Read, Show)
+
+newtype Program = Program [Bind]
+  deriving (C.Eq, C.Ord, C.Show, C.Read)
+
+data Exp
+    = EId  Id
+    | EInt Integer
+    | ELet [Bind] Exp
+    | EApp Type Exp Exp
+    | EAdd Type Exp Exp
+    | EAbs Type Id  Exp
+    | EAnn Exp Type
+  deriving (C.Eq, C.Ord, C.Show, C.Read)
+
+type Id = (Ident, Type)
+
+data Bind = Bind Id [Id] Exp
+  deriving (C.Eq, C.Ord, C.Show, C.Read)
+
+instance Print Program where
+  prt i (Program sc) = prPrec i 0 $ prt 0 sc
+
+instance Print Bind where
+  prt i (Bind name@(n, _) parms rhs) = prPrec i 0 $ concatD
+    [ prtId 0 name
+    , doc $ showString ";"
+    , prt 0 n
+    , prtIdPs 0 parms
+    , doc $ showString "="
+    , prt 0 rhs
+    ]
+
+instance Print [Bind] where
+  prt _ []     = concatD []
+  prt _ [x]    = concatD [prt 0 x]
+  prt _ (x:xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs]
+
+prtIdPs :: Int -> [Id] -> Doc
+prtIdPs i = prPrec i 0 . concatD . map (prtIdP i)
+
+prtId :: Int -> Id -> Doc
+prtId i (name, t) = prPrec i 0 $ concatD
+  [ prt 0 name
+  , doc $ showString ":"
+  , prt 0 t
+  ]
+
+prtIdP :: Int -> Id -> Doc
+prtIdP i (name, t) = prPrec i 0 $ concatD
+  [ doc $ showString "("
+  , prt 0 name
+  , doc $ showString ":"
+  , prt 0 t
+  , doc $ showString ")"
+  ]
+
+
+instance Print Exp where
+  prt i = \case
+    EId  n       -> prPrec i 3 $ concatD [prtIdP 0 n]
+    EInt i1      -> prPrec i 3 $ concatD [prt 0 i1]
+    ELet bs e    -> prPrec i 3 $ concatD
+                      [ doc $ showString "let"
+                      , prt 0 bs
+                      , doc $ showString "in"
+                      , prt 0 e
+                      ]
+    EApp t e1 e2 -> prPrec i 2 $ concatD
+                      [ doc $ showString "@"
+                      , prt 0 t
+                      , prt 2 e1
+                      , prt 3 e2
+                      ]
+    EAdd t e1 e2 -> prPrec i 1 $ concatD
+                      [ doc $ showString "@"
+                      , prt 0 t
+                      , prt 1 e1
+                      , doc $ showString "+"
+                      , prt 2 e2
+                      ]
+    EAbs t n  e  -> prPrec i 0 $ concatD
+                      [ doc $ showString "@"
+                      , prt 0 t
+                      , doc $ showString "\\"
+                      , prtIdP 0 n
+                      , doc $ showString "."
+                      , prt 0 e
+                      ]
+    EAnn e t     -> prPrec i 3 $ concatD
+                      [ doc $ showString "("
+                      , prt 0 e
+                      , doc $ showString ":"
+                      , prt 0 t
+                      , doc $ showString ")"
+                      ]
+
+