cleanup

diff --git a/sem.icl b/sem.icl
index 7f7cdf4..34675d2 100644 (file)
--- 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