diff options
Diffstat (limited to 'snug-clean/src/Snug/Compile/Typing.icl')
-rw-r--r-- | snug-clean/src/Snug/Compile/Typing.icl | 24 |
1 files changed, 20 insertions, 4 deletions
diff --git a/snug-clean/src/Snug/Compile/Typing.icl b/snug-clean/src/Snug/Compile/Typing.icl index 5587da7..4d69aca 100644 --- a/snug-clean/src/Snug/Compile/Typing.icl +++ b/snug-clean/src/Snug/Compile/Typing.icl @@ -7,8 +7,24 @@ import Snug.Syntax instance type Expression where type locals e = case e of - BasicValue bv -> type locals bv + BasicValue bv -> + type locals bv Symbol sym -> // TODO - Constructor cons -> // TODO - Case _ alts -> checkSameTypes "case alternatives" [type locals e \\ CaseAlternative _ e <- alts] - ExpApp e1 e2 -> // TODO + Constructor cons -> + lookupConstructorM ns cons >>= \(ConstructorDef _ args ret) -> + foldr TyFun ret args + Case _ alts -> + checkSameTypes "case alternatives" [type locals e \\ CaseAlternative _ e <- alts] + ExpApp e1 e2 -> + type locals e1 >>= \t1 -> case t1 of + TyFun t1arg t1ret -> + type locals e2 >>= \t2 -> + unify t1arg t2 -> + resolve t1ret + TyVar _ -> + freshTyVar >>= \t1arg -> + freshTyVar >>= \t1ret -> + unify t1arg t2 -> + resolve t1ret + _ -> + fail "ExpApp: first argument cannot be unified with a function type" |