Add closures and fix lets in monomorphizer

This commit is contained in:
Martin Fredin 2023-05-06 22:49:08 +02:00
parent 677a200a15
commit 72e599d5de
26 changed files with 1440 additions and 692 deletions

View file

@ -1,6 +1,7 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
module TypeChecker.TypeCheckerIr (
module Grammar.Abs,
module TypeChecker.TypeCheckerIr,
@ -10,31 +11,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 +42,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 +82,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,15 +105,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
@ -151,9 +143,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 +178,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)