From: Mart Lubbers Date: Tue, 12 Apr 2016 20:01:39 +0000 (+0200) Subject: revent X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=6f035b0bf9e10d215a2d8d6198d29f7727877cad;p=cc1516.git revent --- diff --git a/sem.icl b/sem.icl index 4a3fbe5..31221ca 100644 --- a/sem.icl +++ b/sem.icl @@ -20,41 +20,10 @@ import AST from parse import :: ParserOutput, :: Error :: Gamma :== 'Map'.Map String Type -:: Env a = Env (State Gamma (Either SemError a)) - -instance Functor Env where - fmap f m = liftM f m - -instance Applicative Env where - (<*>) f g = ap f g - pure a = Env $ pure $ Right a - -instance Alternative Env where - empty = Env $ pure $ Left (Error "Undefined error") - (<|>) f g = f >>= \ef -> g >>= \eg -> Env $ pure $ (ef <|> eg) //case ef of - //Left e = eg - //Right r = Right r - -instance Monad Env where - bind e f = e >>= \ee -> Env $ pure $ case ee of - (Left e) = Left e - (Right r) = f r +:: Env a :== (State Gamma (Either SemError a)) get = state $ \s -> (s,s) -instance toString SemError where - toString (ParseError p e) = concat [ - toString p,"SemError: ParseError: ", e] - toString (Error e) = "SemError: " +++ e - toString (UnifyErrorStub t1 t2) = toString (UnifyError {line=0,col=0} t1 t2) - toString (UnifyError p t1 t2) = concat [ - toString p, - "SemError: Cannot unify types. Expected: ", - toString t1, ". Given: ", toString t2] - -sem :: AST -> SemOutput -sem x = undef -/* putIdent :: String Type -> Env Void putIdent i t = gets ('Map'.get i) >>= \mt -> case mt of Nothing = pure <$> modify ('Map'.put i t) @@ -62,6 +31,17 @@ putIdent i t = gets ('Map'.get i) >>= \mt -> case mt 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 (UnifyErrorStub t1 t2) = toString (UnifyError {line=0,col=0} t1 +t2) + toString (UnifyError p t1 t2) = concat [ + toString p, + "SemError: Cannot unify types. Expected: ", + toString t1, ". Given: ", toString t2] + sem :: AST -> SemOutput sem (AST vd fd) # (eithervds, gamma) = runState (mapM semVarDecl vd) 'Map'.newMap @@ -102,7 +82,7 @@ typeExpr (Op2Expr p e1 BiTimes e2) = unify IntType e1 >>| unify IntType e2 typeExpr (Op2Expr p e1 BiDivide e2) = unify IntType e1 >>| unify IntType e2 typeExpr (Op2Expr p e1 BiMod e2) = unify IntType e1 >>| unify IntType e2 //bool, char of int -typeExpr (Op2Expr p e1 BiEquals e2) = undef +typeExpr (Op2Expr p e1 BiEquals e2) = typeExpr (Op2Expr p e1 BiUnEqual e2) = undef //char of int typeExpr (Op2Expr p e1 BiLesser e2) = undef @@ -116,7 +96,8 @@ typeExpr (Op2Expr p e1 BiOr e2) = undef typeExpr (Op2Expr p e1 BiCons e2) = undef //typeExpr (FunExpr Pos FunCall) = undef //typeExpr (EmptyListExpr Pos) = undef -//typeExpr (VarExpr Pos VarDef) = undef //when checking var-expr, be sure to put the infered type +//typeExpr (VarExpr Pos VarDef) = undef //when checking var-expr, be sure to +//put the infered type //in the context class unify a :: Type a -> Env Type @@ -160,4 +141,3 @@ extrPos (BoolExpr p _) = p extrPos (FunExpr p _) = p extrPos (EmptyListExpr p) = p extrPos (TupleExpr p _) = p -*/ \ No newline at end of file