import Data
. Char ( isDigit
) import Control. Arrow ( first, second)
type DD = D -> D
type DDD = D -> D -> D
data Oper = Prinfix ( DD, Order) | Prefix DD | Postfix DD | Infix ( DDD, Order)
data Expr = Operand D | Operator Oper | Statement [ Expr]
toOp' d xs l = lookup l xs >>= Just . Operator . d
toOp 0 = toOp' Prinfix
[ ( "-" , ( negate , ( 5 , True
) ) ) ] toOp 1 = toOp' Prefix [("sqr", (^2))]
toOp 3 = toOp' Postfix
[ ( "!" , \x
-> product [ 1 .. x
] ) ] toOp 4 = toOp' Infix [("+", ((+), (5, True))), ("-", ((-), (5, True))),
("*", ((*), (6, True))), ("/", ((/), (6, True))), ("^", ((**), (7, False)))]
( opg
, ff
) = ( Operator
$ Prinfix
( id , ( 1 , True
) ) , fmap . first
) add i t = ff ( t :) . parse'' i
parse' = ff Statement . add 0 opg
parse' ' pos (l:ls)
| isDigit (head l) = ifp (<= 2) $ add 3 (Operand $ read l) ls
| l == "(" = ifp (<= 2) $ uncurry (add 3) =<< parse' ls
| l == ")" = ifp ( >= 3 ) $ Just ( [ opg] , ls)
| pos <= 1 = choose 1
| pos <= 4 = choose 4 where
ifp g x = if g pos then x else Nothing
choose i
= flip ( uncurry add
) ls
=<< case ( toOp i l
, ifp
( < i
) $ toOp
( i
- 1 ) l
) of ( Just t
, Nothing
) -> Just
( ( i
+ 1 ) `
rem `
5 , t
) ( Nothing, Just t) -> Just ( i, t)
_ -> Nothing
eval ( Operand t) = t
eval
( Statement t
) = fst . snd $ eval
' (0, True) (undefined, t) where (opg, sf) = ((10, undefined), second . first)
cond (pr1, as1) (pr2, as2) = pr1 > pr2 || pr1 == pr2 && if as1 == as2 then as1
else error "cannot mix two operators"
eval' _ ( n, ( Operator ( Prefix g) : ts) ) = sf g $ eval' opg (undefined, ts)
eval' op ( n, ( Operator ( Postfix g) : ts) ) = eval' op (g n, ts)
eval' op ( n, tts@ ( Operator o : ts) )
| cond op opt = ( opt, ( n, tts) )
where (oper, opt) = case o of
Prinfix t -> t
Infix t -> first ($ n) t
eval' op ( n, t : ts) = eval' op (eval t, ts)
calc = fmap eval . parse
main = mapM_ (print . calc)
[ "2 + 3"
, "4 - 3"
, "2 + (-3)"
, "4 * 5"
, "6/4"
, "1.2 + 1/2"
, "1/(-3)"
, "0.5 + 0.2"
, "3 ^ 2 ^ 2"
, "17654/342"
, "2/3 ^ 2"
, "(2/3) ^ 2"
, "(2 + 3) / (2 - 2)"
, "2 + 345 + + + + 6"
, " - sqr 5! +(-sqr(1 - 2^ 3) ^sqr 2 *9 !) "
, "5 + 9 3"
, "sqr sqr 3"
, "2 + -3 * 5"
]
aW1wb3J0IERhdGEuQ2hhciAoaXNEaWdpdCkKaW1wb3J0IENvbnRyb2wuQXJyb3cgKGZpcnN0LCBzZWNvbmQpCgp0eXBlIE9yZGVyID0gKEludCwgQm9vbCkKdHlwZSBEID0gRG91YmxlCnR5cGUgREQgPSBEIC0+IEQKdHlwZSBEREQgPSBEIC0+IEQgLT4gRAoKZGF0YSBPcGVyID0gUHJpbmZpeCAoREQsIE9yZGVyKSB8IFByZWZpeCBERCB8IFBvc3RmaXggREQgfCBJbmZpeCAoRERELCBPcmRlcikKZGF0YSBFeHByID0gT3BlcmFuZCBEIHwgT3BlcmF0b3IgT3BlciB8IFN0YXRlbWVudCBbRXhwcl0KCnRvT3AnIGQgeHMgbCA9IGxvb2t1cCBsIHhzID4+PSBKdXN0IC4gT3BlcmF0b3IgLiBkCgp0b09wIDAgPSB0b09wJyBQcmluZml4IFsoIi0iLCAobmVnYXRlLCAoNSwgVHJ1ZSkpKV0gCnRvT3AgMSA9IHRvT3AnIFByZWZpeCBbKCJzcXIiLCAoXjIpKV0KdG9PcCAzID0gdG9PcCcgUG9zdGZpeCBbKCIhIiwgXHggLT4gcHJvZHVjdCBbMS4ueF0pXQp0b09wIDQgPSB0b09wJyBJbmZpeCBbKCIrIiwgKCgrKSwgKDUsIFRydWUpKSksICgiLSIsICgoLSksICg1LCBUcnVlKSkpLAoJKCIqIiwgKCgqKSwgKDYsIFRydWUpKSksICgiLyIsICgoLyksICg2LCBUcnVlKSkpLCAoIl4iLCAoKCoqKSwgKDcsIEZhbHNlKSkpXQoKcGFyc2UgPSBmbWFwIGZzdCAuIHBhcnNlJyAuIHRha2VXaGlsZSAobm90IC4gbnVsbCkgLiBtYXAgZnN0IC4gCgl0YWlsIC4gaXRlcmF0ZSAoaGVhZCAuIGxleCAuIHNuZCkgLiAoLCkgIiIgLiAoKysgIikiKSB3aGVyZQoJKG9wZywgZmYpID0gKE9wZXJhdG9yICQgUHJpbmZpeCAoaWQsICgxLCBUcnVlKSksIGZtYXAgLiBmaXJzdCkKCWFkZCBpIHQgPSBmZiAodCA6KSAuIHBhcnNlJycgaQoJcGFyc2UnID0gZmYgU3RhdGVtZW50IC4gYWRkIDAgb3BnCglwYXJzZScnIHBvcyAobDpscykKCQl8IGlzRGlnaXQgKGhlYWQgbCkgPSBpZnAgKDw9IDIpICQgYWRkIDMgKE9wZXJhbmQgJCByZWFkIGwpIGxzCgkJfCBsID09ICIoIiA9IGlmcCAoPD0gMikgJCB1bmN1cnJ5IChhZGQgMykgPTw8IHBhcnNlJyBscwoJCXwgbCA9PSAiKSIgPSBpZnAgKD49IDMpICQgSnVzdCAoW29wZ10sIGxzKQoJCXwgcG9zIDw9IDEgPSBjaG9vc2UgMQoJCXwgcG9zIDw9IDQgPSBjaG9vc2UgNCB3aGVyZQoJCWlmcCBnIHggPSBpZiBnIHBvcyB0aGVuIHggZWxzZSBOb3RoaW5nCgkJY2hvb3NlIGkgPSBmbGlwICh1bmN1cnJ5IGFkZCkgbHMgPTw8IGNhc2UgKHRvT3AgaSBsLCBpZnAgKDwgaSkgJCB0b09wIChpIC0gMSkgbCkgb2YKCQkJKEp1c3QgdCwgTm90aGluZykgLT4gSnVzdCAoKGkgKyAxKSBgcmVtYCA1LCB0KQoJCQkoTm90aGluZywgSnVzdCB0KSAtPiBKdXN0IChpLCB0KQoJCQlfIC0+IE5vdGhpbmcKCmV2YWwgKE9wZXJhbmQgdCkgPSB0CmV2YWwgKFN0YXRlbWVudCB0KSA9IGZzdCAuIHNuZCAkIGV2YWwnICgwLCBUcnVlKSAodW5kZWZpbmVkLCB0KSB3aGVyZQoJKG9wZywgc2YpID0gKCgxMCwgdW5kZWZpbmVkKSwgc2Vjb25kIC4gZmlyc3QpCgljb25kIChwcjEsIGFzMSkgKHByMiwgYXMyKSA9IHByMSA+IHByMiB8fCBwcjEgPT0gcHIyICYmIGlmIGFzMSA9PSBhczIgdGhlbiBhczEKCQllbHNlIGVycm9yICJjYW5ub3QgbWl4IHR3byBvcGVyYXRvcnMiCglldmFsJyBfIChuLCAoT3BlcmF0b3IgKFByZWZpeCBnKSA6IHRzKSkgPSBzZiBnICQgZXZhbCcgb3BnICh1bmRlZmluZWQsIHRzKQoJZXZhbCcgb3AgKG4sIChPcGVyYXRvciAoUG9zdGZpeCBnKSA6IHRzKSkgPSBldmFsJyBvcCAoZyBuLCB0cykKCWV2YWwnIG9wIChuLCB0dHNAKE9wZXJhdG9yIG8gOiB0cykpCgkJfCBjb25kIG9wIG9wdCA9IChvcHQsIChuLCB0dHMpKQoJCXwgb3RoZXJ3aXNlID0gc2Ygb3BlciAkIHVudGlsIChjb25kIG9wdCAuIGZzdCkgKGV2YWwnIG9wdCAuIHNuZCkgKG9wZywgKG4sIHRzKSkgCgkJd2hlcmUgKG9wZXIsIG9wdCkgPSBjYXNlIG8gb2YKCQkJUHJpbmZpeCB0IC0+IHQKCQkJSW5maXggdCAtPiBmaXJzdCAoJCBuKSB0CglldmFsJyBvcCAobiwgdCA6IHRzKSA9IGV2YWwnIG9wIChldmFsIHQsIHRzKQoKY2FsYyA9IGZtYXAgZXZhbCAuIHBhcnNlCgptYWluID0gbWFwTV8gKHByaW50IC4gY2FsYykgCglbICIyICsgMyIKICAgICwgIjQgLSAzIgogICAgLCAiMiArICgtMykiCiAgICAsICI0ICogNSIKICAgICwgIjYvNCIKICAgICwgIjEuMiArIDEvMiIKICAgICwgIjEvKC0zKSIKICAgICwgIjAuNSArIDAuMiIKICAgICwgIjMgXiAyIF4gMiIKICAgICwgIjE3NjU0LzM0MiIKICAgICwgIjIvMyBeIDIiCiAgICAsICIoMi8zKSBeIDIiCgksICIoMiArIDMpIC8gKDIgLSAyKSIKCSwgIjIgKyAzNDUgKyArICsgKyA2IgoJLCAiICAtIHNxciA1ISArKC1zcXIoMSAtIDJeIDMpIF5zcXIgMiAqOSAhKSAgICAiCgksICI1ICsgOSAzIgoJLCAic3FyIHNxciAzIgoJLCAiMiArIC0zICogNSIKCV0=