X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=sem.icl;h=4a3fbe59ec8dadf8f15878f924406bccede18e6c;hb=ae679fa9a2d32f0d4037f689398bad77d5dd1b78;hp=709071c9cdde16695b64b55a5f09408a2062ae60;hpb=9e1081469910f9b70a1ea713f431aadf385c52b7;p=cc1516.git diff --git a/sem.icl b/sem.icl index 709071c..4a3fbe5 100644 --- a/sem.icl +++ b/sem.icl @@ -20,10 +20,41 @@ import AST from parse import :: ParserOutput, :: Error :: Gamma :== 'Map'.Map String Type -:: Env a :== (State Gamma (Either SemError a)) +:: 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 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) @@ -31,16 +62,6 @@ 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 @@ -81,7 +102,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) = +typeExpr (Op2Expr p e1 BiEquals e2) = undef typeExpr (Op2Expr p e1 BiUnEqual e2) = undef //char of int typeExpr (Op2Expr p e1 BiLesser e2) = undef @@ -139,3 +160,4 @@ extrPos (BoolExpr p _) = p extrPos (FunExpr p _) = p extrPos (EmptyListExpr p) = p extrPos (TupleExpr p _) = p +*/ \ No newline at end of file