summaryrefslogblamecommitdiff
path: root/Assignment2/src/Expression.icl
blob: 762210325f7d27aa0b6fb178930c124b3b59b465 (plain) (tree)

















































                                                                                              
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