From: pimjager <pim@pimjager.nl>
Date: Fri, 6 May 2016 08:59:09 +0000 (+0200)
Subject: cleanup
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=ad0d73c9a00ded40c77b87a82059980acfb5edaf;p=cc1516.git

cleanup
---

diff --git a/sem.icl b/sem.icl
index 7f7cdf4..34675d2 100644
--- a/sem.icl
+++ b/sem.icl
@@ -50,35 +50,13 @@ variableStream :: [TVar]
 variableStream = map toString [1..]
 
 sem :: AST -> Either [SemError] AST
-//sem a = pure a
 sem (AST fd) = case foldM (const $ hasNoDups fd) () fd 
             		>>| foldM (const isNiceMain) () fd
             		>>| hasMain fd
                     >>| evalStateT (type fd) (zero, variableStream) of
 	Left e = Left [e]
     Right fds = Right (AST fds)
-	//_ = case execRWST (constraints fd) zero variableStream of
-	//	Left e = Left [e]
-	//	Right (a, b) = Right b
 where
-		constraints :: [FunDecl] -> Typing ()
-        constraints _ = pure ()
-        //TODO: fix
-		//constraints fds = mapM_ funconstraint fds >>| pure ()
-
-		funconstraint :: FunDecl -> Typing ()
-		funconstraint fd=:(FunDecl _ ident args mt vardecls stmts) = case mt of
-			Nothing = abort "Cannot infer functions yet"
-            _ = pure ()
-			//Just t = inEnv (ident, (Forall [] t)) (
-			//	mapM_ vardeclconstraint vardecls >>| pure ())
-
-		vardeclconstraint :: VarDecl -> Typing ()
-        vardeclconstraint _ = pure ()
-        //TODO: fix!
-		//vardeclconstraint (VarDecl p mt ident expr) = infer expr
-			//>>= \it->inEnv (ident, (Forall [] it)) (pure ())
-
 		hasNoDups :: [FunDecl] FunDecl -> Either SemError ()
 		hasNoDups fds (FunDecl p n _ _ _ _)
 		# mbs = map (\(FunDecl p` n` _ _ _ _)->if (n == n`) (Just p`) Nothing) fds
@@ -409,98 +387,3 @@ Mapmap _ 'Map'.Tip = 'Map'.Tip
 Mapmap f ('Map'.Bin sz k v ml mr) = 'Map'.Bin sz k (f v) 
                                         (Mapmap f ml) 
                                         (Mapmap f mr)
-
-//// ------------------------
-//// First step: Inference
-//// ------------------------//
-
-//unify :: Type Type -> Infer ()
-//unify t1 t2 = tell [(t1, t2)]//
-
-//fresh :: Infer Type
-//fresh = (gets id) >>= \vars-> (put $ tail vars) >>| (pure $ IdType $ head vars)//
-
-//op2Type :: Op2 -> Infer Type
-//op2Type op
-//| elem op [BiPlus, BiMinus, BiTimes, BiDivide, BiMod]
-//	= pure (IntType ->> IntType ->> IntType)
-//| elem op [BiEquals, BiUnEqual]
-//	= fresh >>= \t1-> fresh >>= \t2-> pure (t1 ->> t2 ->> BoolType)
-//| elem op [BiLesser, BiGreater, BiLesserEq, BiGreaterEq]
-//	= pure (IntType ->> IntType ->> BoolType)
-//| elem op [BiAnd, BiOr]
-//	= pure (BoolType ->> BoolType ->> BoolType)
-//| op == BiCons 
-//	= fresh >>= \t1-> pure (t1 ->> ListType t1 ->> ListType t1)//
-
-//op1Type :: Op1 -> Infer Type
-//op1Type UnNegation = pure $ (BoolType ->> BoolType)
-//op1Type UnMinus = pure $ (IntType ->> IntType)//
-
-////instantiate :: Scheme -> Infer Type
-////instantiate (Forall as t) = mapM (const fresh) as//
-
-//lookupEnv :: String -> Infer Type
-//lookupEnv ident = asks ('Map'.get ident)
-//	>>= \m->case m of
-//		Nothing = liftT $ Left $ UndeclaredVariableError zero ident
-//		Just (Forall as t) = pure t //instantiate ???//
-
-//class infer a :: a -> Infer Type
-//instance infer Expr where
-//	infer (VarExpr _ (VarDef ident fs)) = lookupEnv ident
-//    infer (Op2Expr _ e1 op e2) = 
-//        infer e1 >>= \t1 -> 
-//        infer e2 >>= \t2 ->
-//        fresh >>= \frsh -> 
-//        let given = t1 ->> (t2 ->> frsh) in
-//        op2Type op >>= \expected -> 
-//        unify expected given >>| 
-//        return frsh
-//	infer (Op1Expr _ op e) = 
-//        infer e >>= \t1 -> 
-//        fresh >>= \frsh -> 
-//        let given = t1 ->> frsh in
-//        op1Type op >>= \expected -> 
-//        unify expected given >>| 
-//        pure frsh
-//	infer (IntExpr _ _) = pure IntType
-//	infer (CharExpr _ _) = pure CharType
-//	infer (BoolExpr _ _) = pure BoolType
-//	infer (FunExpr _ f args sels) =  //todo, iets met field selectors
-//        lookupEnv f >>= \expected ->
-//        fresh >>= \frsh -> 
-//        mapM infer args >>= \argTypes ->
-//        let given = foldr (->>) frsh argTypes in
-//        unify expected given >>|
-//        pure frsh
-//	infer (EmptyListExpr _) = ListType <$> fresh
-//	infer (TupleExpr _ (e1, e2)) =
-//		infer e1 >>= \et1->infer e2 >>= \et2->pure $ TupleType (et1, et2)//
-
-////:: VarDef = VarDef String [FieldSelector]
-////:: FieldSelector = FieldHd | FieldTl | FieldFst | FieldSnd
-////:: Op1 = UnNegation | UnMinus
-////:: Op2 = BiPlus | BiMinus | BiTimes | BiDivide | BiMod | BiEquals | BiLesser |
-////	BiGreater | BiLesserEq | BiGreaterEq | BiUnEqual | BiAnd | BiOr | BiCons
-////:: FunDecl = FunDecl Pos String [String] (Maybe Type) [VarDecl] [Stmt]
-////:: FunCall = FunCall String [Expr]
-////:: Stmt 
-////	= IfStmt Expr [Stmt] [Stmt]
-////	| WhileStmt Expr [Stmt]
-////	| AssStmt VarDef Expr
-////	| FunStmt FunCall
-////	| ReturnStmt (Maybe Expr)
-////:: Pos = {line :: Int, col :: Int}
-////:: AST = AST [VarDecl] [FunDecl]
-////:: VarDecl = VarDecl Pos Type String Expr
-////:: Type 
-////	= TupleType (Type, Type)
-////	| ListType Type
-////	| IdType String 
-////	| IntType 
-////	| BoolType
-////	| CharType
-////	| VarType
-////    | VoidType
-////    | (->>) infixl 7 Type Type