aboutsummaryrefslogtreecommitdiff
path: root/snug-clean/src/Snug/Compile/Typing.icl
diff options
context:
space:
mode:
Diffstat (limited to 'snug-clean/src/Snug/Compile/Typing.icl')
-rw-r--r--snug-clean/src/Snug/Compile/Typing.icl24
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"