either binds ftw

diff --git a/sem.icl b/sem.icl
index 50b67ea..667b6eb 100644 (file)
--- 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