handle application as list

This commit is contained in:
Rachel Lambda Samuelsson 2022-01-26 19:05:15 +01:00
parent 6499987dd8
commit 413f7d3a21
4 changed files with 49 additions and 31 deletions

View File

@ -30,10 +30,11 @@ runProcess = (fst <$>) .: runStateT
postprocess :: [H.Def] -> Process [TL] postprocess :: [H.Def] -> Process [TL]
postprocess defs = addDef <~> defs >> defToTL <~> defs postprocess defs = addDef <~> defs >> defToTL <~> defs
-- just adds types for processing type signatures
addDef :: H.Def -> Process () addDef :: H.Def -> Process ()
addDef = \case addDef = \case
H.VarDef _ i t _ -> lift . addEnv i =<< typeSigToPolyT t -- the type checker will check this matches the exp
H.TypeDef _ t _ -> insertType =<< fst <$> typeSigToIdParams t H.TypeDef _ t _ -> insertType =<< fst <$> typeSigToIdParams t
H.VarDef _ i t _ -> pure ()
-- add type before typesig to id params -- add type before typesig to id params
defToTL :: H.Def -> Process TL defToTL :: H.Def -> Process TL
@ -92,12 +93,7 @@ expToExp :: H.Exp -> Process Exp
expToExp = \case expToExp = \case
H.ExpLet p as e -> Let p <$> assignTo2pl <~> as <*> expToExp e H.ExpLet p as e -> Let p <$> assignTo2pl <~> as <*> expToExp e
H.ExpAbs p is e -> Abs p is <$> expToExp e H.ExpAbs p is e -> Abs p is <$> expToExp e
H.ExpApp p e1 (e2:es) -> do H.ExpApp p e es -> App p <$> expToExp e <*> expToExp <~> es
e1' <- expToExp e1
e2' <- expToExp e2
es' <- traverse expToExp es
pure (foldl (App p) (App p e1' e2') es')
H.ExpApp p e [] -> throwError Oop
H.ExpVar p i -> pure (Var p i) H.ExpVar p i -> pure (Var p i)
declTo2pl :: H.Decl -> Process (Id, MonoT) declTo2pl :: H.Decl -> Process (Id, MonoT)

View File

@ -149,6 +149,9 @@ constructs _ _ = False
infer :: Exp -> Check (Subst, MonoT) infer :: Exp -> Check (Subst, MonoT)
infer = setPos >=> \case infer = setPos >=> \case
Var _ i -> (emptySubst,) <$> lookupType i
Let _ [] e -> infer e Let _ [] e -> infer e
Let p ((i,e1):ies) e2 -> do Let p ((i,e1):ies) e2 -> do
(s1, t1) <- infer e1 (s1, t1) <- infer e1
@ -165,13 +168,31 @@ infer = setPos >=> \case
(s, t) <- infer (Abs p is e) (s, t) <- infer (Abs p is e)
pure (s, apply s tv `TArr` t) pure (s, apply s tv `TArr` t)
App p e1 e2 -> localEnv' $ do App _ e es -> go e (reverse es)
tv <- fresh where
go :: Exp -> [Exp] -> Check (Subst, MonoT)
go _ [] = throwError Oop
go e1 [e2] = localEnv' $ do
(s1, t1) <- infer e1 (s1, t1) <- infer e1
applyEnv s1 applyEnv s1
(s2, t2) <- infer e2
s3 <- unify (apply s2 t1) (TArr t2 tv)
return (s3 <&> s2 <&> s1, apply s3 tv)
App _ _ _ -> throwError Oop
Var _ i -> (emptySubst,) <$> lookupType i (s2, t2) <- infer e2
tv <- fresh
s3 <- unify (apply s2 t1) (t2 `TArr` tv)
pure (s3 <&> s2 <&> s1, apply s3 tv)
go e1 (e2:es) = localEnv' $ do
(s1, t1) <- go e1 es
applyEnv s1
(s2, t2) <- infer e2
tv <- fresh
s3 <- unify (apply s2 t1) (t2 `TArr` tv)
pure (s3 <&> s2 <&> s1, apply s3 tv)

View File

@ -41,7 +41,7 @@ type Exp = Exp' Pos
data Exp' a data Exp' a
= Let a [(Id,Exp)] Exp = Let a [(Id,Exp)] Exp
| Abs a [Id] Exp | Abs a [Id] Exp
| App a Exp Exp | App a Exp [Exp]
| Var a Id | Var a Id
deriving Show deriving Show

1
tst Normal file
View File

@ -0,0 +1 @@
λf g x y z w. f w (g x y z)