From f490bc3083cc290680499d4c12be9b732b94fd82 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Wed, 13 Apr 2016 13:18:00 +0200 Subject: [PATCH] yay, binary ops --- AST.dcl | 3 +++ AST.icl | 16 ++++++++++++---- examples/varEx.spl | 7 +++++-- sem.dcl | 3 ++- sem.icl | 44 +++++++++++++++++++++----------------------- spl.icl | 2 +- 6 files changed, 44 insertions(+), 31 deletions(-) diff --git a/AST.dcl b/AST.dcl index 97741e5..4fd4121 100644 --- a/AST.dcl +++ b/AST.dcl @@ -43,4 +43,7 @@ from StdOverloaded import class toString instance toString AST instance toString Type instance toString Pos +instance toString Op2 +instance == Op2 +instance == Type instance toString FieldSelector diff --git a/AST.icl b/AST.icl index b5f8ca0..5173c4c 100644 --- a/AST.icl +++ b/AST.icl @@ -6,6 +6,7 @@ from Data.List import map, intercalate, replicate, flatten, isEmpty from Data.Func import $ from Text import class Text(concat), instance Text String from Data.Maybe import :: Maybe, maybe +import GenEq instance toString Pos where toString {line,col} = concat [toString line, ":", toString col, " "] @@ -85,14 +86,17 @@ instance print VarDef where instance print FunCall where print (FunCall i args) = [i,"(":printersperse "," args] ++ [")"] -instance print Expr where - print (VarExpr _ vd) = print vd - print (Op2Expr _ e1 o e2) = ["(":print e1] ++ [" ",case o of +instance toString Op2 where + toString o = case o of BiPlus = "+"; BiMinus = "-"; BiTimes = "*"; BiDivide = "/" BiMod = "%"; BiEquals = "=="; BiLesser = "<"; BiGreater = ">" BiLesserEq = "<="; BiGreaterEq = ">="; BiUnEqual = "!="; BiAnd = "&&"; BiOr = "||"; BiCons = ":" - ," ":print e2] ++ [")"] + +instance print Expr where + print (VarExpr _ vd) = print vd + print (Op2Expr _ e1 o e2) = ["(":print e1] ++ + [" ",toString o, " ":print e2] ++ [")"] print (Op1Expr _ o e) = ["(",case o of UnNegation = "!"; UnMinus = "-" :print e] ++ [")"] @@ -106,3 +110,7 @@ instance print Expr where print (FunExpr _ fc) = print fc print (EmptyListExpr _) = ["[]"] print (TupleExpr _ (e1, e2)) = ["(":print e1] ++ [",":print e2] ++ [")"] + +derive gEq Op2, Type +instance == Op2 where (==) o1 o2 = gEq{|*|} o1 o2 +instance == Type where (==) o1 o2 = gEq{|*|} o1 o2 diff --git a/examples/varEx.spl b/examples/varEx.spl index 68aa4f6..4c809fb 100644 --- a/examples/varEx.spl +++ b/examples/varEx.spl @@ -18,9 +18,12 @@ var l = 1:2:[]; var m = 4; var n = m + 2; var q = v + 2; -var z = !v; +//var z = !v; +var pim = 'a' == 'b'; +var pim = 'a' + 'b'; +var pim = ('a':[]) == ('b':[]); facR(n) :: Int -> Int { return 5; -} \ No newline at end of file +} diff --git a/sem.dcl b/sem.dcl index 0332076..dbf1014 100644 --- a/sem.dcl +++ b/sem.dcl @@ -2,13 +2,14 @@ definition module sem import qualified Data.Map as Map from Data.Either import :: Either -from AST import :: AST, :: Pos, :: Type, :: FieldSelector +from AST import :: AST, :: Pos, :: Type, :: FieldSelector, :: Op2 from StdOverloaded import class toString :: SemError = ParseError Pos String | UnifyError Pos Type Type | FieldSelectorError Pos Type FieldSelector + | OperatorError Pos Op2 Type | Error String :: Gamma :: SemOutput :== Either [SemError] (AST, Gamma) diff --git a/sem.icl b/sem.icl index 75ecd37..77131b0 100644 --- a/sem.icl +++ b/sem.icl @@ -60,6 +60,10 @@ instance toString SemError where toString p, "SemError: Cannot select ", toString fs, " from type: ", toString t] + toString (OperatorError p o t) = concat [ + toString p, + "SemError: No ", toString o, " for type ", + toString t] sem :: AST -> SemOutput sem (AST vd fd) = case runStateT m ('Map'.newMap, getRandomStream 1) of @@ -78,6 +82,11 @@ semVarDecl :: VarDecl -> Env VarDecl semVarDecl (VarDecl pos type ident ex) = unify type ex >>= \t-> putIdent ident t >>| (pure $ VarDecl pos t ident ex) +typeOp2 :: Expr Expr Op2 [Type] -> Env Type +typeOp2 e1 e2 op ts = typeExpr e1 >>= \t1-> typeExpr e2 >>= \t2-> + unify t1 t2 >>= \t3->if (isMember t3 ts) (pure t3) + (liftT $ Left $ OperatorError (extrPos e1) op t3) + typeExpr :: Expr -> Env Type typeExpr (IntExpr _ _) = pure IntType typeExpr (CharExpr _ _) = pure CharType @@ -86,31 +95,20 @@ typeExpr (Op1Expr p UnNegation expr) = unify BoolType expr typeExpr (Op1Expr p UnMinus expr) = unify IntType expr typeExpr (TupleExpr p (e1, e2)) = typeExpr e1 >>= \t1-> typeExpr e2 >>= \t2-> pure $ TupleType (t1, t2) -//Int -typeExpr (Op2Expr p e1 BiPlus e2) = unify IntType e1 >>| unify IntType e2 -typeExpr (Op2Expr p e1 BiMinus e2) = unify IntType e1 >>| unify IntType e2 -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 e1 >>= \t1 -> unify t1 e2 - >>| pure BoolType //todo, actually check t1 in Char,Bool,Int -typeExpr (Op2Expr p e1 BiUnEqual e2) = typeExpr (Op2Expr p e1 BiEquals e2) -//char of int -typeExpr (Op2Expr p e1 BiLesser e2) = typeExpr e1 >>= \t1 -> unify t1 e2 - >>| pure BoolType //todo, actually check t1 in Char, Int -typeExpr (Op2Expr p e1 BiGreater e2) = typeExpr (Op2Expr p e1 BiLesser e2) -typeExpr (Op2Expr p e1 BiLesserEq e2) = typeExpr (Op2Expr p e1 BiLesser e2) -typeExpr (Op2Expr p e1 BiGreaterEq e2) = typeExpr (Op2Expr p e1 BiLesser e2) -//bool -typeExpr (Op2Expr p e1 BiAnd e2) = unify BoolType e1 >>| unify BoolType e2 -typeExpr (Op2Expr p e1 BiOr e2) = unify BoolType e1 >>| unify BoolType e2 -//a -typeExpr (Op2Expr p e1 BiCons e2) = typeExpr e1 >>= \t1-> typeExpr e2 - >>= \t2-> unify (ListType t1) t2 +typeExpr (Op2Expr p e1 op e2) +| isMember op [BiPlus, BiMinus, BiTimes, BiDivide, BiMod] = + typeOp2 e1 e2 op [IntType] +| isMember op [BiEquals, BiUnEqual] = + typeOp2 e1 e2 op [IntType, BoolType, CharType] +| isMember op [BiLesser, BiGreater, BiLesserEq, BiGreaterEq] = + typeOp2 e1 e2 op [IntType, CharType] +| isMember op [BiAnd, BiOr] = + typeOp2 e1 e2 op [BoolType] +| op == BiCons = typeExpr e1 >>= \t1-> typeExpr e2 + >>= \t2-> unify (ListType t1) t2 typeExpr (EmptyListExpr p) = freshIdent >>= \frsh-> let t = IdType frsh in putIdent frsh t >>| pure t -//typeExpr (FunExpr p (FunCall f es)) = undef +typeExpr (FunExpr p (FunCall fid args)) = undef //ignore field selectors typeExpr (VarExpr p (VarDef ident fs)) = gets (\(st, r)->'Map'.get ident st) >>= \mt->case mt of diff --git a/spl.icl b/spl.icl index 5dad10e..291b0bd 100644 --- a/spl.icl +++ b/spl.icl @@ -72,7 +72,7 @@ Start w (Right (semOut, gamma)) # stdin = if (not args.sem) stdin ( stdin <<< "//SEM\n" <<< toString gamma <<< "//SEM\n") - = snd $ fclose stdin w + = snd $ fclose (stdin <<< "\n") w where printTokens :: [Token] -> String printTokens ts = concat $ flatten $ map pt ts -- 2.20.1