From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 7 Apr 2016 13:57:47 +0000 (+0200)
Subject: either binds ftw
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=5b1c37a52f0d63d4972665f672df100a231a2f57;p=cc1516.git

either binds ftw
---

diff --git a/sem.icl b/sem.icl
index 50b67ea..667b6eb 100644
--- a/sem.icl
+++ b/sem.icl
@@ -61,21 +61,26 @@ semFunDecl f = pure $ Right f
 semVarDecl :: VarDecl -> Env VarDecl
 semVarDecl v = pure $ Right v
 //Right v
-//semVarDecl vd=:(VarDecl pos type ident expr) = case unify type expr of
-//	Left e = Left e
+//semVarDecl vd=:(VarDecl pos type ident expr) = case unify type expr of //	Left e = Left e
 //	//TODO ident in de environment
 //	Right e = Right $ pure vd
-//
+
+typeOp1 :: Pos Expr Type -> Env Type
+typeOp1 p expr rtype = typeExpr expr >>= \exprtype->case exprtype of
+	Left e = pure $ Left e
+	Right rtype = pure $ Right rtype
+	Right (IdType ident) = putIdent ident rtype >>| pure (Right rtype)
+	Right t = pure $ Left $ UnifyError p rtype t
+
 typeExpr :: Expr -> Env Type
 typeExpr (IntExpr _ _) = pure $ Right IntType
 typeExpr (CharExpr _ _) = pure $ Right CharType
 typeExpr (BoolExpr _ _) = pure $ Right BoolType
-typeExpr (Op1Expr p UnNegation expr) = typeExpr expr 
-	>>= \exprtype->case exprtype of
-        Left e = pure $ Left e
-		Right BoolType = pure $ Right BoolType
-        Right (IdType ident) = putIdent ident BoolType >>| pure (Right BoolType)
-		Right t = pure $ Left $ UnifyError p BoolType t
+typeExpr (Op1Expr p UnNegation expr) = typeOp1 p expr BoolType
+typeExpr (Op1Expr p UnMinus expr) = typeOp1 p expr IntType
+typeExpr (TupleExpr p (e1, e2)) = typeExpr e1 
+	>>= \ete1->typeExpr e2 >>= \ete2->pure (
+		ete1 >>= \te1->ete2 >>= \te2->Right $ TupleType (te1, te2))
 //typeExpr (Op1Expr p UnMinus expr) = typeExpr expr 
 //	>>= \exprtype->case exprtype of
 //		IntType = pure $ Right IntType
@@ -83,12 +88,8 @@ typeExpr (Op1Expr p UnNegation expr) = typeExpr expr
 //typeExpr (Op2Expr Pos Expr Op2 Expr) = undef
 //typeExpr (FunExpr Pos FunCall) = undef
 //typeExpr (EmptyListExpr Pos) = undef
-//typeExpr (TupleExpr Pos (Expr, Expr)) = undef
 //typeExpr (VarExpr Pos VarDef) = undef
 
-
-
-////
 class unify a :: Type a -> Env Type
 
 instance unify Type where
@@ -111,14 +112,3 @@ instance unify Type where
 //		BoolType = undef
 //		CharType = undef
 //		VarType = undef
-//
-//extrPos :: Expr -> Pos
-//extrPos (VarExpr p _) = p
-//extrPos (Op2Expr p _ _ _) = p
-//extrPos (Op1Expr p _ _) = p
-//extrPos (IntExpr p _) = p
-//extrPos (CharExpr p _) = p
-//extrPos (BoolExpr p _) = p
-//extrPos (FunExpr p _) = p
-//extrPos (EmptyListExpr p) = p
-//extrPos (TupleExpr p _) = p