working on adapting the typechecker
This commit is contained in:
sebastianselander
parent
936cb1301f
commit
914855e20f
3 changed files with 658 additions and 652 deletions
36
Grammar.cf
36
Grammar.cf
|
|
@ -1,12 +1,13 @@
|
||||||
--------------------------------------------------------------------------------
|
|
||||||
|
-------------------------------------------------------------------------------
|
||||||
-- * PROGRAM
|
-- * PROGRAM
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
Program. Program ::= [Def] ;
|
Program. Program ::= [Def] ;
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- * TOP-LEVEL
|
-- * TOP-LEVEL
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
DBind. Def ::= Bind ;
|
DBind. Def ::= Bind ;
|
||||||
DSig. Def ::= Sig ;
|
DSig. Def ::= Sig ;
|
||||||
|
|
@ -16,9 +17,9 @@ Sig. Sig ::= LIdent ":" Type ;
|
||||||
|
|
||||||
Bind. Bind ::= LIdent [LIdent] "=" Exp ;
|
Bind. Bind ::= LIdent [LIdent] "=" Exp ;
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- * TYPES
|
-- * TYPES
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
TLit. Type2 ::= UIdent ;
|
TLit. Type2 ::= UIdent ;
|
||||||
TVar. Type2 ::= TVar ;
|
TVar. Type2 ::= TVar ;
|
||||||
|
|
@ -30,9 +31,9 @@ internal TEVar. Type1 ::= TEVar ;
|
||||||
MkTVar. TVar ::= LIdent ;
|
MkTVar. TVar ::= LIdent ;
|
||||||
internal MkTEVar. TEVar ::= LIdent ;
|
internal MkTEVar. TEVar ::= LIdent ;
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- * DATA TYPES
|
-- * DATA TYPES
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
Constructor. Constructor ::= UIdent ":" Type ;
|
Constructor. Constructor ::= UIdent ":" Type ;
|
||||||
|
|
||||||
|
|
@ -40,12 +41,12 @@ Indexed. Indexed ::= UIdent "(" [Type] ")" ;
|
||||||
|
|
||||||
Data. Data ::= "data" Indexed "where" "{" [Constructor] "}" ;
|
Data. Data ::= "data" Indexed "where" "{" [Constructor] "}" ;
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- * EXPRESSIONS
|
-- * EXPRESSIONS
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
EAnn. Exp5 ::= "(" Exp ":" Type ")" ;
|
EAnn. Exp5 ::= "(" Exp ":" Type ")" ;
|
||||||
EId. Exp4 ::= LIdent ;
|
EId. Exp4 ::= Ident ;
|
||||||
ELit. Exp4 ::= Lit ;
|
ELit. Exp4 ::= Lit ;
|
||||||
EApp. Exp3 ::= Exp3 Exp4 ;
|
EApp. Exp3 ::= Exp3 Exp4 ;
|
||||||
EAdd. Exp1 ::= Exp1 "+" Exp2 ;
|
EAdd. Exp1 ::= Exp1 "+" Exp2 ;
|
||||||
|
|
@ -53,16 +54,16 @@ ELet. Exp ::= "let" LIdent "=" Exp "in" Exp ;
|
||||||
EAbs. Exp ::= "\\" LIdent "." Exp ;
|
EAbs. Exp ::= "\\" LIdent "." Exp ;
|
||||||
ECase. Exp ::= "case" Exp "of" "{" [Inj] "}";
|
ECase. Exp ::= "case" Exp "of" "{" [Inj] "}";
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- * LITERALS
|
-- * LITERALS
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
LInt. Lit ::= Integer ;
|
LInt. Lit ::= Integer ;
|
||||||
LChar. Lit ::= Char ;
|
LChar. Lit ::= Char ;
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- * CASE
|
-- * CASE
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
Inj. Inj ::= Init "=>" Exp ;
|
Inj. Inj ::= Init "=>" Exp ;
|
||||||
|
|
||||||
|
|
@ -70,9 +71,9 @@ InitLit. Init ::= Lit ;
|
||||||
InitConstructor. Init ::= UIdent [LIdent] ;
|
InitConstructor. Init ::= UIdent [LIdent] ;
|
||||||
InitCatch. Init ::= "_" ;
|
InitCatch. Init ::= "_" ;
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- * AUX
|
-- * AUX
|
||||||
--------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
|
|
||||||
separator Def ";" ;
|
separator Def ";" ;
|
||||||
separator nonempty Constructor "" ;
|
separator nonempty Constructor "" ;
|
||||||
|
|
@ -80,6 +81,7 @@ separator Type " " ;
|
||||||
separator nonempty Inj ";" ;
|
separator nonempty Inj ";" ;
|
||||||
separator Ident " ";
|
separator Ident " ";
|
||||||
separator LIdent " ";
|
separator LIdent " ";
|
||||||
|
separator TVar " " ;
|
||||||
|
|
||||||
coercions Exp 5 ;
|
coercions Exp 5 ;
|
||||||
coercions Type 2 ;
|
coercions Type 2 ;
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load diff
|
|
@ -2,178 +2,207 @@
|
||||||
|
|
||||||
module TypeChecker.TypeCheckerIr where
|
module TypeChecker.TypeCheckerIr where
|
||||||
|
|
||||||
-- import Control.Monad.Except
|
import Control.Monad.Except
|
||||||
-- import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
-- import Control.Monad.State
|
import Control.Monad.State
|
||||||
-- import Data.Functor.Identity (Identity)
|
import Data.Functor.Identity (Identity)
|
||||||
-- import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
-- import Grammar.Abs (
|
import Grammar.Abs (
|
||||||
-- Data (..),
|
Data (..),
|
||||||
-- Ident (..),
|
Ident (..),
|
||||||
-- Init (..),
|
Init (..),
|
||||||
-- Literal (..),
|
Lit (..),
|
||||||
-- Type (..),
|
TVar (..),
|
||||||
-- )
|
)
|
||||||
-- import Grammar.Print
|
import Grammar.Abs qualified as GA (Type (..))
|
||||||
-- import Prelude
|
import Grammar.Print
|
||||||
-- import Prelude qualified as C (Eq, Ord, Read, Show)
|
import Prelude
|
||||||
|
import Prelude qualified as C (Eq, Ord, Read, Show)
|
||||||
|
|
||||||
-- -- | A data type representing type variables
|
-- | A data type representing type variables
|
||||||
-- data Poly = Forall [Ident] Type
|
data Poly = Forall [Ident] Type
|
||||||
-- deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
-- newtype Ctx = Ctx {vars :: Map Ident Poly}
|
newtype Ctx = Ctx {vars :: Map Ident Poly}
|
||||||
-- deriving Show
|
deriving (Show)
|
||||||
|
|
||||||
-- data Env = Env
|
data Env = Env
|
||||||
-- { count :: Int
|
{ count :: Int
|
||||||
-- , sigs :: Map Ident Type
|
, sigs :: Map Ident GA.Type
|
||||||
-- , constructors :: Map Ident Type
|
, constructors :: Map Ident GA.Type
|
||||||
-- } deriving Show
|
}
|
||||||
|
deriving (Show)
|
||||||
|
|
||||||
-- type Error = String
|
type Error = String
|
||||||
-- type Subst = Map Ident Type
|
type Subst = Map Ident Type
|
||||||
|
|
||||||
-- type Infer = StateT Env (ReaderT Ctx (ExceptT Error Identity))
|
type Infer = StateT Env (ReaderT Ctx (ExceptT Error Identity))
|
||||||
|
|
||||||
-- newtype Program = Program [Def]
|
newtype Program = Program [Def]
|
||||||
-- deriving (C.Eq, C.Ord, C.Show, C.Read)
|
deriving (C.Eq, C.Ord, C.Show, C.Read)
|
||||||
|
|
||||||
-- data Exp
|
data Type
|
||||||
-- = EId Id
|
= TLit Ident
|
||||||
-- | ELit Type Literal
|
| TVar TVar
|
||||||
-- | ELet Bind Exp
|
| TFun Type Type
|
||||||
-- | EApp Type Exp Exp
|
| TAll TVar Type
|
||||||
-- | EAdd Type Exp Exp
|
| TIndexed Indexed
|
||||||
-- | EAbs Type Id Exp
|
deriving (Show, Eq, Ord, Read)
|
||||||
-- | ECase Type Exp [Inj]
|
|
||||||
-- deriving (C.Eq, C.Ord, C.Read, C.Show)
|
|
||||||
|
|
||||||
-- data Inj = Inj (Init, Type) Exp
|
data Exp
|
||||||
-- deriving (C.Eq, C.Ord, C.Read, C.Show)
|
= EId Id
|
||||||
|
| ELit Lit
|
||||||
|
| ELet Bind ExpT
|
||||||
|
| EApp ExpT ExpT
|
||||||
|
| EAdd ExpT ExpT
|
||||||
|
| EAbs Id ExpT
|
||||||
|
| ECase ExpT [Inj]
|
||||||
|
deriving (C.Eq, C.Ord, C.Read, C.Show)
|
||||||
|
|
||||||
-- data Def = DBind Bind | DData Data
|
type ExpT = (Exp, Type)
|
||||||
-- deriving (C.Eq, C.Ord, C.Read, C.Show)
|
|
||||||
|
|
||||||
-- type Id = (Ident, Type)
|
data Indexed = Indexed Ident [Type]
|
||||||
|
deriving (Show, Read, Ord, Eq)
|
||||||
|
|
||||||
-- data Bind = Bind Id Exp
|
data Inj = Inj (Init, Type) ExpT
|
||||||
-- deriving (C.Eq, C.Ord, C.Show, C.Read)
|
deriving (C.Eq, C.Ord, C.Read, C.Show)
|
||||||
|
|
||||||
-- instance Print [Def] where
|
data Def = DBind Bind | DData Data
|
||||||
-- prt _ [] = concatD []
|
deriving (C.Eq, C.Ord, C.Read, C.Show)
|
||||||
-- prt _ (x : xs) = concatD [prt 0 x, doc (showString "\n"), prt 0 xs]
|
|
||||||
|
|
||||||
-- instance Print Def where
|
type Id = (Ident, Type)
|
||||||
-- prt i (DBind bind) = prt i bind
|
|
||||||
-- prt i (DData d) = prt i d
|
|
||||||
|
|
||||||
-- instance Print Program where
|
data Bind = Bind Id [Id] ExpT
|
||||||
-- prt i (Program sc) = prPrec i 0 $ prt 0 sc
|
deriving (C.Eq, C.Ord, C.Show, C.Read)
|
||||||
|
|
||||||
-- instance Print Bind where
|
instance Print [Def] where
|
||||||
-- prt i (Bind (t, name) rhs) =
|
prt _ [] = concatD []
|
||||||
-- prPrec i 0 $
|
prt _ (x : xs) = concatD [prt 0 x, doc (showString "\n"), prt 0 xs]
|
||||||
-- concatD
|
|
||||||
-- [ prt 0 name
|
|
||||||
-- , doc $ showString ":"
|
|
||||||
-- , prt 0 t
|
|
||||||
-- , doc $ showString "\n"
|
|
||||||
-- , prt 0 name
|
|
||||||
-- , doc $ showString "="
|
|
||||||
-- , prt 0 rhs
|
|
||||||
-- ]
|
|
||||||
|
|
||||||
-- instance Print [Bind] where
|
instance Print Def where
|
||||||
-- prt _ [] = concatD []
|
prt i (DBind bind) = prt i bind
|
||||||
-- prt _ [x] = concatD [prt 0 x]
|
prt i (DData d) = prt i d
|
||||||
-- prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), doc (showString "\n"), prt 0 xs]
|
|
||||||
|
|
||||||
-- prtIdPs :: Int -> [Id] -> Doc
|
instance Print Program where
|
||||||
-- prtIdPs i = prPrec i 0 . concatD . map (prtIdP i)
|
prt i (Program sc) = prPrec i 0 $ prt 0 sc
|
||||||
|
|
||||||
-- prtId :: Int -> Id -> Doc
|
instance Print Bind where
|
||||||
-- prtId i (name, t) =
|
prt i (Bind (t, name) args rhs) =
|
||||||
-- prPrec i 0 $
|
prPrec i 0 $
|
||||||
-- concatD
|
concatD
|
||||||
-- [ prt 0 name
|
[ prt 0 name
|
||||||
-- , doc $ showString ":"
|
, doc $ showString ":"
|
||||||
-- , prt 0 t
|
, prt 0 t
|
||||||
-- ]
|
, doc $ showString "\n"
|
||||||
|
, prt 0 name
|
||||||
|
, doc $ showString "="
|
||||||
|
, prt 0 rhs
|
||||||
|
]
|
||||||
|
|
||||||
-- prtIdP :: Int -> Id -> Doc
|
instance Print [Bind] where
|
||||||
-- prtIdP i (name, t) =
|
prt _ [] = concatD []
|
||||||
-- prPrec i 0 $
|
prt _ [x] = concatD [prt 0 x]
|
||||||
-- concatD
|
prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), doc (showString "\n"), prt 0 xs]
|
||||||
-- [ doc $ showString "("
|
|
||||||
-- , prt 0 name
|
|
||||||
-- , doc $ showString ":"
|
|
||||||
-- , prt 0 t
|
|
||||||
-- , doc $ showString ")"
|
|
||||||
-- ]
|
|
||||||
|
|
||||||
-- instance Print Exp where
|
prtIdPs :: Int -> [Id] -> Doc
|
||||||
-- prt i = \case
|
prtIdPs i = prPrec i 0 . concatD . map (prtIdP i)
|
||||||
-- EId n -> prPrec i 3 $ concatD [prtId 0 n, doc $ showString "\n"]
|
|
||||||
-- ELit _ (LInt i1) -> prPrec i 3 $ concatD [prt 0 i1, doc $ showString "\n"]
|
|
||||||
-- ELet bs e ->
|
|
||||||
-- prPrec i 3 $
|
|
||||||
-- concatD
|
|
||||||
-- [ doc $ showString "let"
|
|
||||||
-- , prt 0 bs
|
|
||||||
-- , doc $ showString "in"
|
|
||||||
-- , prt 0 e
|
|
||||||
-- , doc $ showString "\n"
|
|
||||||
-- ]
|
|
||||||
-- EApp _ e1 e2 ->
|
|
||||||
-- prPrec i 2 $
|
|
||||||
-- concatD
|
|
||||||
-- [ 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
|
|
||||||
-- , doc $ showString "\n"
|
|
||||||
-- ]
|
|
||||||
-- EAbs t n e ->
|
|
||||||
-- prPrec i 0 $
|
|
||||||
-- concatD
|
|
||||||
-- [ doc $ showString "@"
|
|
||||||
-- , prt 0 t
|
|
||||||
-- , doc $ showString "\\"
|
|
||||||
-- , prtId 0 n
|
|
||||||
-- , doc $ showString "."
|
|
||||||
-- , prt 0 e
|
|
||||||
-- , doc $ showString "\n"
|
|
||||||
-- ]
|
|
||||||
-- ECase t exp injs ->
|
|
||||||
-- prPrec
|
|
||||||
-- i
|
|
||||||
-- 0
|
|
||||||
-- ( concatD
|
|
||||||
-- [ doc (showString "case")
|
|
||||||
-- , prt 0 exp
|
|
||||||
-- , doc (showString "of")
|
|
||||||
-- , doc (showString "{")
|
|
||||||
-- , prt 0 injs
|
|
||||||
-- , doc (showString "}")
|
|
||||||
-- , doc (showString ":")
|
|
||||||
-- , prt 0 t
|
|
||||||
-- , doc $ showString "\n"
|
|
||||||
-- ]
|
|
||||||
-- )
|
|
||||||
|
|
||||||
-- instance Print Inj where
|
prtId :: Int -> Id -> Doc
|
||||||
-- prt i = \case
|
prtId i (name, t) =
|
||||||
-- Inj (init, t) exp -> prPrec i 0 (concatD [prt 0 init, doc (showString ":"), prt 0 t, doc (showString "=>"), prt 0 exp])
|
prPrec i 0 $
|
||||||
|
concatD
|
||||||
|
[ prt 0 name
|
||||||
|
, doc $ showString ":"
|
||||||
|
, prt 0 t
|
||||||
|
]
|
||||||
|
|
||||||
-- instance Print [Inj] where
|
prtIdP :: Int -> Id -> Doc
|
||||||
-- prt _ [] = concatD []
|
prtIdP i (name, t) =
|
||||||
-- prt _ [x] = concatD [prt 0 x]
|
prPrec i 0 $
|
||||||
-- prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs]
|
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 [prtId 0 n, doc $ showString "\n"]
|
||||||
|
ELit _ lit -> prPrec i 3 $ concatD [prt 0 lit, doc $ showString "\n"]
|
||||||
|
ELet bs e ->
|
||||||
|
prPrec i 3 $
|
||||||
|
concatD
|
||||||
|
[ doc $ showString "let"
|
||||||
|
, prt 0 bs
|
||||||
|
, doc $ showString "in"
|
||||||
|
, prt 0 e
|
||||||
|
, doc $ showString "\n"
|
||||||
|
]
|
||||||
|
EApp _ e1 e2 ->
|
||||||
|
prPrec i 2 $
|
||||||
|
concatD
|
||||||
|
[ 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
|
||||||
|
, doc $ showString "\n"
|
||||||
|
]
|
||||||
|
EAbs t n e ->
|
||||||
|
prPrec i 0 $
|
||||||
|
concatD
|
||||||
|
[ doc $ showString "@"
|
||||||
|
, prt 0 t
|
||||||
|
, doc $ showString "\\"
|
||||||
|
, prtId 0 n
|
||||||
|
, doc $ showString "."
|
||||||
|
, prt 0 e
|
||||||
|
, doc $ showString "\n"
|
||||||
|
]
|
||||||
|
ECase t exp injs ->
|
||||||
|
prPrec
|
||||||
|
i
|
||||||
|
0
|
||||||
|
( concatD
|
||||||
|
[ doc (showString "case")
|
||||||
|
, prt 0 exp
|
||||||
|
, doc (showString "of")
|
||||||
|
, doc (showString "{")
|
||||||
|
, prt 0 injs
|
||||||
|
, doc (showString "}")
|
||||||
|
, doc (showString ":")
|
||||||
|
, prt 0 t
|
||||||
|
, doc $ showString "\n"
|
||||||
|
]
|
||||||
|
)
|
||||||
|
|
||||||
|
instance Print ExpT where
|
||||||
|
prt i (e, t) = concatD [prt i e, doc (showString ":"), prt i t]
|
||||||
|
|
||||||
|
instance Print Inj where
|
||||||
|
prt i = \case
|
||||||
|
Inj (init, t) exp -> prPrec i 0 (concatD [prt 0 init, doc (showString ":"), prt 0 t, doc (showString "=>"), prt 0 exp])
|
||||||
|
|
||||||
|
instance Print [Inj] where
|
||||||
|
prt _ [] = concatD []
|
||||||
|
prt _ [x] = concatD [prt 0 x]
|
||||||
|
prt _ (x : xs) = concatD [prt 0 x, doc (showString ";"), prt 0 xs]
|
||||||
|
|
||||||
|
instance Print Type where
|
||||||
|
prt i = \case
|
||||||
|
TLit uident -> prPrec i 2 (concatD [prt 0 uident])
|
||||||
|
TVar tvar -> prPrec i 2 (concatD [prt 0 tvar])
|
||||||
|
TAll tvar type_ -> prPrec i 1 (concatD [doc (showString "forall"), prt 0 tvar, doc (showString "."), prt 0 type_])
|
||||||
|
TIndexed indexed -> prPrec i 1 (concatD [prt 0 indexed])
|
||||||
|
TFun type_1 type_2 -> prPrec i 0 (concatD [prt 1 type_1, doc (showString "->"), prt 0 type_2])
|
||||||
|
|
||||||
|
instance Print Indexed where
|
||||||
|
prt i (Indexed u ts) = concatD [prt i u, prt i ts]
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue