diff options
Diffstat (limited to 'paper/While/WhileCommon.icl')
-rw-r--r-- | paper/While/WhileCommon.icl | 94 |
1 files changed, 94 insertions, 0 deletions
diff --git a/paper/While/WhileCommon.icl b/paper/While/WhileCommon.icl new file mode 100644 index 0000000..353f997 --- /dev/null +++ b/paper/While/WhileCommon.icl @@ -0,0 +1,94 @@ +implementation module WhileCommon + +import StdBool, StdInt, StdList, StdClass, StdString +from StdFunc import o +from GenEq import generic gEq +import Common +import WhileLexer +import Yard + +derive gEq AExpr, Operator, BExpr, Comparator + +instance zero State where zero = \v -> Left (Runtime "Undefined variable") + +instance toString AExpr +where + toString (Var v) = v + toString (Lit i) = toString i + toString (Op a1 op a2) = "(" <+ a1 <+ " " <+ op <+ " " <+ a2 <+ ")" + +instance toString Operator +where + toString Add = "+"; toString Sub = "-" + toString Mul = "*"; toString Div = "/" + +instance toString BExpr +where + toString (Bool b) = if b "true" "false" + toString (Not b) = "~" <+ b + toString (And b1 b2) = "(" <+ b1 <+ " & " <+ b2 <+ ")" + toString (Or b1 b2) = "(" <+ b1 <+ " | " <+ b2 <+ ")" + toString (Comp a1 cmp a2) = a1 <+ " " <+ cmp <+ " " <+ a2 + +instance toString Comparator +where + toString Eq = "="; toString Ne = "<>" + toString Le = "<="; toString Lt = "<" + toString Ge = ">="; toString Gt = ">" + +instance eval AExpr Int +where + eval (Var v) st = st v + eval (Lit i) st = pure i + eval (Op a1 op a2) st = eval a1 st >>= \r1 -> eval a2 st >>= \r2 -> toOp op r1 r2 + where + toOp :: Operator -> Int Int -> Either Error Int + toOp Add = \i j -> pure (i + j) + toOp Sub = \i j -> pure (i - j) + toOp Mul = \i j -> pure (i * j) + toOp Div = \i j -> if (j == 0) (Left (Runtime "Division by 0")) (pure (i / j)) + +instance eval BExpr Bool +where + eval (Bool b) st = pure b + eval (Not b) st = eval b st >>= pure o not + eval (And b1 b2) st = eval b1 st >>= \r -> eval b2 st >>= pure o ((&&) r) + eval (Or b1 b2) st = eval b1 st >>= \r -> eval b2 st >>= pure o ((||) r) + eval (Comp a1 cmp a2) st = eval a1 st >>= \r -> eval a2 st >>= pure o (toCmp cmp r) + where + toCmp :: Comparator -> Int Int -> Bool + toCmp Eq = \i j -> i == j + toCmp Ne = \i j -> i <> j + toCmp Le = \i j -> i <= j + toCmp Lt = \i j -> i < j + toCmp Ge = \i j -> i >= j + toCmp Gt = \i j -> i > j + +pbexpr :: Parser Token BExpr +pbexpr = liftM2 Or pbconj (item OrToken *> pbexpr) <|> pbconj +pbconj = liftM2 And pbnot (item AndToken *> pbconj) <|> pbnot +pbnot = item NotToken *> pbnot <|> pbcomp +pbcomp = liftM3 Comp paexpr (toComp <$> satisfy isCompToken) paexpr <|> pbconst +pbconst = toBool <$> satisfy isBoolToken + <|> item ParenOpen *> pbexpr <* item ParenClose + +paexpr :: Parser Token AExpr +paexpr = liftOp Add pasub (item AddToken *> paexpr) <|> pasub +pasub = liftM2 (foldl (\r->Op r Sub)) pamul (many (item SubToken *> pamul)) +pamul = liftOp Mul padiv (item MulToken *> pamul) <|> padiv +padiv = liftM2 (foldl (\r->Op r Div)) paref (many (item DivToken *> paref)) +paref = Var o toVar <$> satisfy isVarToken + <|> (\(LiteralToken i) -> Lit i) <$> satisfy isLiteralToken + <|> item ParenOpen *> paexpr <* item ParenClose + +toComp EqToken = Eq; toComp NeToken = Ne; toComp LeToken = Le +toComp LtToken = Lt; toComp GeToken = Ge; toComp GtToken = Lt +isCompToken t = isMember t [EqToken, NeToken, LeToken, LtToken, GeToken, GtToken] +toBool (BoolToken b) = Bool b +isBoolToken (BoolToken _) = True; isBoolToken _ = False +toVar (VarToken v) = v +isVarToken (VarToken _) = True; isVarToken _ = False +isLiteralToken (LiteralToken _) = True; isLiteralToken _ = False + +liftOp :: Operator (m AExpr) (m AExpr) -> m AExpr | Monad m +liftOp op a1 a2 = a1 >>= \r1 -> a2 >>= \r2 -> pure (Op r1 op r2) |