summaryrefslogtreecommitdiff
path: root/Assignment2/src/Expression.icl
diff options
context:
space:
mode:
authorCamil Staps2018-07-06 11:12:03 +0200
committerCamil Staps2018-07-06 11:14:23 +0200
commitfdcc5373160d2d522ecd9a1b8e1dde0d782605e2 (patch)
treecece8d2c8a49f530ba8f8c77ef928031271201c0 /Assignment2/src/Expression.icl
parentProvide initial description of the implementation (diff)
This is so ugly
Diffstat (limited to 'Assignment2/src/Expression.icl')
-rw-r--r--Assignment2/src/Expression.icl51
1 files changed, 51 insertions, 0 deletions
diff --git a/Assignment2/src/Expression.icl b/Assignment2/src/Expression.icl
new file mode 100644
index 0000000..7622103
--- /dev/null
+++ b/Assignment2/src/Expression.icl
@@ -0,0 +1,51 @@
+implementation module Expression
+
+from StdChar import instance == Char
+from StdOverloaded import class toString(toString)
+from StdString import instance toString {#Char}, instance toString Int, instance toString Real
+
+import Data._Array
+from Data.Func import $
+import Data.Maybe
+import Text
+import Text.GenParse
+
+:: Expression
+ = (+) infixl 6 !Expression !Expression
+ | (-) infixl 6 !Expression !Expression
+ | (*) infixl 7 !Expression !Expression
+ | (/) infixl 7 !Expression !Expression
+ | LitInt !Int
+ | LitReal !Real
+ | Var !String
+
+derive gParse Expression
+
+parseInfix :: !String -> Expression
+parseInfix s = fromJust $ gParse{|*|} $ addLiteralBoxes $ preParseString s
+where
+ addLiteralBoxes :: !Expr -> Expr
+ addLiteralBoxes e = case e of
+ ExprInt i -> ExprApp {ExprIdent "LitInt",e}
+ ExprReal r -> ExprApp {ExprIdent "LitReal",e}
+
+ ExprIdent id | id.[0] == 'v'
+ -> ExprApp {ExprIdent "Var",ExprString id}
+
+ ExprApp es -> ExprApp (mapArray addLiteralBoxes es)
+ ExprTuple es -> ExprTuple (mapArray addLiteralBoxes es)
+ ExprAppInInfix es x y z
+ -> ExprAppInInfix (mapArray addLiteralBoxes es) x y z
+
+ _ -> e
+
+instance toString Expression
+where
+ toString e = case e of
+ (e1 + e2) -> "(+ " <+ e1 <+ " " <+ e2 <+ ")"
+ (e1 - e2) -> "(- " <+ e1 <+ " " <+ e2 <+ ")"
+ (e1 * e2) -> "(* " <+ e1 <+ " " <+ e2 <+ ")"
+ (e1 / e2) -> "(/ " <+ e1 <+ " " <+ e2 <+ ")"
+ LitInt i -> toString i
+ LitReal r -> toString r
+ Var v -> v