Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

poly: infer - a new approach #37

Merged
merged 3 commits into from
Jan 20, 2015
Merged

poly: infer - a new approach #37

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
8af47fc
poly: fix composition order of substitutions in Let case
chsievers Jan 20, 2015
7f589b1
poly: fix type inference for If, Fix and Op cases in a uniform way
chsievers Jan 20, 2015
9096471
poly: factored out common code in infer
chsievers Jan 20, 2015
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
33 changes: 16 additions & 17 deletions chapter7/poly/Infer.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -158,34 +158,33 @@ infer env ex = case ex of
let env' = apply s1 env
t' = generalize env' t1
(s2, t2) <- infer (env' `extend` (x, t')) e2
return (s1 `compose` s2, t2)
return (s2 `compose` s1, t2)

If cond tr fl -> do
(s1, t1) <- infer env cond
(s2, t2) <- infer env tr
(s3, t3) <- infer env fl
s4 <- unify (apply (compose s2 s3) t1) typeBool
s5 <- unify (apply (compose s1 s4) t2) (apply (compose s1 s4) t3)
let s6 = s4 `compose` s5
return (s6, apply s6 t2)
tv <- fresh
inferPrim env [cond, tr, fl] (typeBool `TArr` tv `TArr` tv `TArr` tv)

Fix e1 -> do
(s1, t) <- infer env e1
tv <- fresh
s2 <- unify (apply s1 (TArr tv tv)) (apply s1 t)
let s3 = s2 `compose` s1
return (s3, apply s3 tv)
inferPrim env [e1] ((tv `TArr` tv) `TArr` tv)

Op op e1 e2 -> do
(s1, t1) <- infer env e1
(s2, t2) <- infer env e2
tv <- fresh
s3 <- unify (TArr t1 (TArr t2 tv)) (ops op)
return (s1 `compose` s2 `compose` s3, apply s3 tv)
inferPrim env [e1, e2] (ops op)

Lit (LInt _) -> return (nullSubst, typeInt)
Lit (LBool _) -> return (nullSubst, typeBool)

inferPrim :: TypeEnv -> [Expr] -> Type -> Infer (Subst, Type)
inferPrim env l t = do
tv <- fresh
(s1, tf) <- foldM inferStep (nullSubst, id) l
s2 <- unify (tf tv) t
return (s2 `compose` s1, apply s2 tv)

where inferStep (s, tf) exp = do
(s', t) <- infer (apply s env) exp
return (s' `compose` s, tf . (TArr t))

inferExpr :: TypeEnv -> Expr -> Either TypeError Scheme
inferExpr env = runInfer . infer env

Expand Down