X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=sem.icl;h=dc774cc0791ed11fd9557a716d996cbf332c8dda;hb=e0fd23079f1f63b83431afe78e9ec218d4609e9a;hp=667b6eb24db9eb4530845742c826be87a6dfdc03;hpb=5b1c37a52f0d63d4972665f672df100a231a2f57;p=cc1516.git

diff --git a/sem.icl b/sem.icl
index 667b6eb..dc774cc 100644
--- a/sem.icl
+++ b/sem.icl
@@ -1,114 +1,42 @@
 implementation module sem
 
 import qualified Data.Map as Map
+
 from Data.Func import $
-import Data.Maybe
+from StdFunc import o
+
 import Data.Either
-import Data.Functor
-import Control.Applicative
-import Control.Monad
-import Control.Monad.State
-import Control.Monad.Identity
-import StdMisc
-from StdFunc import id, const
+
 import StdString
 import StdList
+import StdEnum
+import RWST
+import GenEq
 
 from Text import class Text(concat), instance Text String
 
 import AST
-from parse import :: ParserOutput, :: Error
 
 :: Gamma :== 'Map'.Map String Type
-:: Env a :== (State Gamma (Either SemError a))
-
-get = state $ \s -> (s,s)
-
-putIdent :: String Type -> Env Void
-putIdent i t = gets ('Map'.get i) >>= \mt -> case mt of
-    Nothing = pure <$> modify ('Map'.put i t)
-    Just t2 = unify t t2 >>= \r -> case r of
-        Left e  = pure $ Left e
-        Right t3 = pure <$> modify ('Map'.put i t3)
-
-instance toString SemError where
-	toString (ParseError p e) = concat [
-		toString p,"SemError: ParseError: ", e]
-	toString (Error e) = "SemError: " +++ e
-	toString (UnifyError p t1 t2) = concat [
-		toString p,
-		"SemError: Cannot unify types. Expected: ",
-		toString t1, ". Given: ", toString t2]
+:: Constraint :== String
+:: Infer a :== RWST [String] [Constraint] Gamma (Either SemError) a
+:: SemError
+	= ParseError Pos String 
+	| UnifyError Pos Type Type 
+    | FieldSelectorError Pos Type FieldSelector 
+	| OperatorError Pos Op2 Type
+    | UndeclaredVariableError Pos String
+    | ArgumentMisMatchError Pos String
+	| Error String
+
+variableStream :: [String]
+variableStream = map toString [1..]
 
 sem :: AST -> SemOutput
-sem (AST vd fd)
-# (eithervds, gamma) = runState (mapM semVarDecl vd) 'Map'.newMap
-# (eitherfds, gamma) = runState (mapM semFunDecl fd) gamma
-= case splitEithers eithervds of
-	(Left errs) = Left $ errs ++ [x\\(Left x)<-eitherfds]
-	(Right vds) = case splitEithers eitherfds of
-		(Left errs) = Left errs
-		(Right fds) = Right $ AST vds fds
+sem (AST vd fd) = Right $ (AST vd fd, 'Map'.newMap)
 
-splitEithers :: [Either a b] -> Either [a] [b]
-splitEithers [] = Right []
-splitEithers [Right x:xs] = splitEithers xs >>= \rest->Right [x:rest]
-splitEithers xs = Left $ [x\\(Left x)<-xs]
+instance toString Gamma where
+	toString mp = concat [concat [k, ": ", toString v, "\n"]\\(k, v)<-'Map'.toList mp]
 
-semFunDecl :: FunDecl -> Env FunDecl
-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
-//	//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) = 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
-//		t = Left $ UnifyError p IntType exprtype
-//typeExpr (Op2Expr Pos Expr Op2 Expr) = undef
-//typeExpr (FunExpr Pos FunCall) = undef
-//typeExpr (EmptyListExpr Pos) = undef
-//typeExpr (VarExpr Pos VarDef) = undef
-
-class unify a :: Type a -> Env Type
-
-instance unify Type where
-	unify IntType IntType = pure $ Right IntType
-	unify BoolType BoolType = pure $ Right BoolType
-	unify CharType CharType = pure $ Right CharType
-	unify _ _ = undef
-//
-//instance unify Expr where
-//	unify type expr = case type of
-//		_ ->> _ = Left $ ParseError (extrPos expr)
-//			"Expression cannot be a higher order function. Yet..."
-//		VoidType = Left $ ParseError (extrPos expr)
-//			"Expression cannot be a Void type."
-//		IdType _ = Left $ ParseError (extrPos expr)
-//			"Expression cannot be an polymorf type."
-//		TupleType (_, _) = undef
-//		ListType _ = undef
-//		IntType = undef
-//		BoolType = undef
-//		CharType = undef
-//		VarType = undef
+instance toString SemError where
+	toString se = "SemError: "