added PEnum

This commit is contained in:
sebastianselander 2023-03-24 17:39:10 +01:00
parent d6d0fb7146
commit 41fc863658
5 changed files with 43 additions and 20 deletions

View file

@ -66,26 +66,28 @@ LChar. Lit ::= Char ;
Branch. Branch ::= Pattern "=>" Exp ; Branch. Branch ::= Pattern "=>" Exp ;
PVar. Pattern ::= LIdent ; PVar. Pattern1 ::= LIdent ;
PLit. Pattern ::= Lit ; PLit. Pattern1 ::= Lit ;
PInj. Pattern ::= UIdent [Pattern] ; PCatch. Pattern1 ::= "_" ;
PCatch. Pattern ::= "_" ; PEnum. Pattern1 ::= UIdent ;
PInj. Pattern ::= UIdent [Pattern1] ;
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
-- * AUX -- * AUX
------------------------------------------------------------------------------- -------------------------------------------------------------------------------
separator Def ";" ; terminator Def ";" ;
separator nonempty Constructor "" ; separator nonempty Constructor "" ;
separator Type " " ; separator Type " " ;
separator Pattern " " ; separator nonempty Pattern1 " " ;
separator Branch "," ; terminator Branch ";" ;
separator Ident " "; separator Ident " ";
separator LIdent " "; separator LIdent " ";
separator TVar " " ; separator TVar " " ;
coercions Exp 4 ; coercions Exp 4 ;
coercions Type 2 ; coercions Type 2 ;
coercions Pattern 1 ;
token UIdent (upper (letter | digit | '_')*) ; token UIdent (upper (letter | digit | '_')*) ;
token LIdent (lower (letter | digit | '_')*) ; token LIdent (lower (letter | digit | '_')*) ;

14
sample-programs/basic-9 Normal file
View file

@ -0,0 +1,14 @@
data List (a) where {
Nil : List (a)
Cons : a -> List (a) -> List (a)
};
test xs = case xs of {
Cons Nil _ => 0 ;
};
List a /= List (List a)
a /= List a

View file

@ -562,6 +562,7 @@ withPattern p ma = case p of
T.PInj _ ps -> foldl' (flip withPattern) ma ps T.PInj _ ps -> foldl' (flip withPattern) ma ps
T.PLit _ -> ma T.PLit _ -> ma
T.PCatch -> ma T.PCatch -> ma
T.PEnum _ -> ma
inferPattern :: Pattern -> Infer (T.Pattern, T.Type) inferPattern :: Pattern -> Infer (T.Pattern, T.Type)
inferPattern = \case inferPattern = \case
@ -574,6 +575,10 @@ inferPattern = \case
zipWithM_ unify vs (map snd patterns) zipWithM_ unify vs (map snd patterns)
return (T.PInj (coerce constr) (map fst patterns), ret) return (T.PInj (coerce constr) (map fst patterns), ret)
PCatch -> (T.PCatch,) <$> fresh PCatch -> (T.PCatch,) <$> fresh
PEnum p -> do
t <- gets (M.lookup (coerce p) . constructors)
t <- maybeToRightM ("Constructor: " <> printTree p <> " does not exist") t
return (T.PEnum $ coerce p, t)
PVar x -> do PVar x -> do
fr <- fresh fr <- fresh
let pvar = T.PVar (coerce x, fr) let pvar = T.PVar (coerce x, fr)

View file

@ -64,7 +64,7 @@ type ExpT = (Exp, Type)
data Branch = Branch (Pattern, Type) ExpT data Branch = Branch (Pattern, Type) ExpT
deriving (C.Eq, C.Ord, C.Read, C.Show) deriving (C.Eq, C.Ord, C.Read, C.Show)
data Pattern = PVar Id | PLit (Lit, Type) | PInj Ident [Pattern] | PCatch data Pattern = PVar Id | PLit (Lit, Type) | PInj Ident [Pattern] | PCatch | PEnum Ident
deriving (C.Eq, C.Ord, C.Show, C.Read) deriving (C.Eq, C.Ord, C.Show, C.Read)
data Def = DBind Bind | DData Data data Def = DBind Bind | DData Data

View file

@ -12,30 +12,32 @@ hello_world = Cons 'h' (Cons 'e' (Cons 'l' (Cons 'l' (Cons 'o' (Cons ' ' (Cons '
length : List (a) -> Int ; length : List (a) -> Int ;
length xs = case xs of { length xs = case xs of {
Nil => 0, Nil => 0;
Cons x xs => length xs Cons x xs => length xs;
}; };
head : List (a) -> a ; head : List (a) -> a ;
head xs = case xs of { head xs = case xs of {
Cons x xs => x Cons x xs => x;
}; };
firstIsOne : List (Int) -> Bool () ; firstIsOne : List (Int) -> Bool () ;
firstIsOne xs = case xs of { firstIsOne xs = case xs of {
Cons x xs => case x of { Cons x xs => case x of {
0 => True , 0 => True;
_ => case xs of { _ => case xs of {
Cons x xs => False , Cons x xs => False;
_ => False _ => False;
} };
}, };
_ => False _ => False;
}; };
main = firstIsOne (Cons 1 Nil); main = firstIsOne (Cons 1 Nil);
deepPat xs = case xs of { deepPat xs = case xs of {
Cons 1 _ => True , Cons (Nil) _ => True;
_ => False _ => False;
} };