From 4ce6adb6f5dc6623b903853322be726a9f95a3b8 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Wed, 29 Nov 2023 11:26:28 +0100
Subject: Continue with cases WIP: todo is matching code for basic values and
 adding locals for constructor arguments in a pattern

---
 snug-clean/src/Snug/Compile/Typing.icl | 24 ++++++++++++++++++++----
 1 file changed, 20 insertions(+), 4 deletions(-)

(limited to 'snug-clean/src/Snug/Compile/Typing.icl')

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"
-- 
cgit v1.2.3