started with new typechecker

[cc1516.git] / sem.icl

diff --git a/sem.icl b/sem.icl
index 99aa44a..dc774cc 100644 (file)
--- a/sem.icl
+++ b/sem.icl
@@ -1,110 +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))
-
-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
-
-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]
+sem (AST vd fd) = Right $ (AST vd fd, 'Map'.newMap)
 
-semFunDecl :: FunDecl -> Env FunDecl
-semFunDecl f = pure $ Right f
+instance toString Gamma where
+       toString mp = concat [concat [k, ": ", toString v, "\n"]\\(k, v)<-'Map'.toList mp]
 
-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
-//
-//typeExpr :: Expr -> Env Type
-//typeExpr (IntExpr _ _) = Right $ pure IntType
-//typeExpr (CharExpr _ _) = Right $ pure CharType
-//typeExpr (BoolExpr _ _) = Right $ pure BoolType
-//typeExpr (Op1Expr p UnNegation expr) = undef//typeExpr expr 
-////   >>= \exprtype->case exprtype of
-////           Right BoolType = Right $ pure BoolType
-////           t = Left $ UnifyError p BoolType exprtype
-//typeExpr (Op1Expr p UnMinus expr) = undef// typeExpr expr 
-////   >>= \exprtype->case exprtype of
-////           IntType = Right $ pure IntType
-////           t = Left $ UnifyError p IntType exprtype
-//// typeExpr (Op2Expr Pos Expr Op2 Expr) = undef
-////typeExpr (FunExpr Pos FunCall
-////typeExpr (EmptyListExpr Pos 
-////typeExpr (TupleExpr Pos (Expr, Expr)
-////typeExpr (VarExpr Pos VarDef) = undef
-////
-//class unify a :: Type a -> Env a
-//
-//instance unify Type where
-//     unify IntType IntType = Right $ pure IntType
-//     unify BoolType BoolType = Right $ pure BoolType
-//     unify CharType CharType = Right $ pure 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
-//
-//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
+instance toString SemError where
+       toString se = "SemError: "