blob: 53699c0a3b2d098dbc643e518f5a42ed5ad00652 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
implementation module Expression
from StdChar import instance == Char
from StdOverloaded import class toString(toString), class toReal(toReal)
from StdReal import entier, instance toReal Int, instance == Real
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 <+ ".0"
LitReal r -> if (toReal (entier r) == r) (r <+ ".0") (toString r)
Var v -> v
|
