This is so ugly

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