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
( [ Operator
$ Infix
( undefined , ( 1 , True
) ) ] , 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) )
| b = ( opt, ( n, tts) )
where (b, (oper, opt)) = case o of
Prinfix t -> (False, t)
Infix t -> (cond op opt, 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+PSBKdXN0IC4gT3BlcmF0b3IgLiBkCgp0b09wIDAgPSB0b09wJyBQcmluZml4IFsoIi0iLCAobmVnYXRlLCAoNSwgVHJ1ZSkpKV0gCnRvT3AgMSA9IHRvT3AnIFByZWZpeCBbKCJzcXIiLCAoXjIpKV0KdG9PcCAzID0gdG9PcCcgUG9zdGZpeCBbKCIhIiwgXHggLT4gcHJvZHVjdCBbMS4ueF0pXQp0b09wIDQgPSB0b09wJyBJbmZpeCBbKCIrIiwgKCgrKSwgKDUsIFRydWUpKSksICgiLSIsICgoLSksICg1LCBUcnVlKSkpLAoJKCIqIiwgKCgqKSwgKDYsIFRydWUpKSksICgiLyIsICgoLyksICg2LCBUcnVlKSkpLCAoIl4iLCAoKCoqKSwgKDcsIEZhbHNlKSkpXQoKcGFyc2UgPSBmbWFwIGZzdCAuIHBhcnNlJyAuIHRha2VXaGlsZSAobm90IC4gbnVsbCkgLiBtYXAgZnN0IC4gCgl0YWlsIC4gaXRlcmF0ZSAoaGVhZCAuIGxleCAuIHNuZCkgLiAoLCkgIiIgLiAoKysgIikiKSB3aGVyZQoJKG9wZywgZmYpID0gKE9wZXJhdG9yICQgUHJpbmZpeCAoaWQsICgxLCBUcnVlKSksIGZtYXAgLiBmaXJzdCkKCWFkZCBpIHQgPSBmZiAodCA6KSAuIHBhcnNlJycgaQoJcGFyc2UnID0gZmYgU3RhdGVtZW50IC4gYWRkIDAgb3BnCglwYXJzZScnIHBvcyAobDpscykKCQl8IGlzRGlnaXQgKGhlYWQgbCkgPSBpZnAgKDw9IDIpICQgYWRkIDMgKE9wZXJhbmQgJCByZWFkIGwpIGxzCgkJfCBsID09ICIoIiA9IGlmcCAoPD0gMikgJCB1bmN1cnJ5IChhZGQgMykgPTw8IHBhcnNlJyBscwoJCXwgbCA9PSAiKSIgPSBpZnAgKD49IDMpICQgSnVzdCAoW09wZXJhdG9yICQgSW5maXggKHVuZGVmaW5lZCwgKDEsIFRydWUpKV0sIGxzKQoJCXwgcG9zIDw9IDEgPSBjaG9vc2UgMQoJCXwgcG9zIDw9IDQgPSBjaG9vc2UgNCB3aGVyZQoJCWlmcCBnIHggPSBpZiBnIHBvcyB0aGVuIHggZWxzZSBOb3RoaW5nCgkJY2hvb3NlIGkgPSBmbGlwICh1bmN1cnJ5IGFkZCkgbHMgPTw8IGNhc2UgKHRvT3AgaSBsLCBpZnAgKDwgaSkgJCB0b09wIChpIC0gMSkgbCkgb2YKCQkJKEp1c3QgdCwgTm90aGluZykgLT4gSnVzdCAoKGkgKyAxKSBgcmVtYCA1LCB0KQoJCQkoTm90aGluZywgSnVzdCB0KSAtPiBKdXN0IChpLCB0KQoJCQlfIC0+IE5vdGhpbmcKCmV2YWwgKE9wZXJhbmQgdCkgPSB0CmV2YWwgKFN0YXRlbWVudCB0KSA9IGZzdCAuIHNuZCAkIGV2YWwnICgwLCBUcnVlKSAodW5kZWZpbmVkLCB0KSB3aGVyZQoJKG9wZywgc2YpID0gKCgxMCwgdW5kZWZpbmVkKSwgc2Vjb25kIC4gZmlyc3QpCgljb25kIChwcjEsIGFzMSkgKHByMiwgYXMyKSA9IHByMSA+IHByMiB8fCBwcjEgPT0gcHIyICYmIGlmIGFzMSA9PSBhczIgdGhlbiBhczEKCQllbHNlIGVycm9yICJjYW5ub3QgbWl4IHR3byBvcGVyYXRvcnMiCglldmFsJyBfIChuLCAoT3BlcmF0b3IgKFByZWZpeCBnKSA6IHRzKSkgPSBzZiBnICQgZXZhbCcgb3BnICh1bmRlZmluZWQsIHRzKQoJZXZhbCcgb3AgKG4sIChPcGVyYXRvciAoUG9zdGZpeCBnKSA6IHRzKSkgPSBldmFsJyBvcCAoZyBuLCB0cykKCWV2YWwnIG9wIChuLCB0dHNAKE9wZXJhdG9yIG8gOiB0cykpCgkJfCBiID0gKG9wdCwgKG4sIHR0cykpCgkJfCBvdGhlcndpc2UgPSBzZiBvcGVyICQgdW50aWwgKGNvbmQgb3B0IC4gZnN0KSAoZXZhbCcgb3B0IC4gc25kKSAob3BnLCAobiwgdHMpKSAKCQl3aGVyZSAoYiwgKG9wZXIsIG9wdCkpID0gY2FzZSBvIG9mCgkJCVByaW5maXggdCAtPiAoRmFsc2UsIHQpCgkJCUluZml4IHQgLT4gKGNvbmQgb3Agb3B0LCBmaXJzdCAoJCBuKSB0KQoJZXZhbCcgb3AgKG4sIHQgOiB0cykgPSBldmFsJyBvcCAoZXZhbCB0LCB0cykKCmNhbGMgPSBmbWFwIGV2YWwgLiBwYXJzZQoKbWFpbiA9IG1hcE1fIChwcmludCAuIGNhbGMpIAoJWyAiMiArIDMiCiAgICAsICI0IC0gMyIKICAgICwgIjIgKyAoLTMpIgogICAgLCAiNCAqIDUiCiAgICAsICI2LzQiCiAgICAsICIxLjIgKyAxLzIiCiAgICAsICIxLygtMykiCiAgICAsICIwLjUgKyAwLjIiCiAgICAsICIzIF4gMiBeIDIiCiAgICAsICIxNzY1NC8zNDIiCiAgICAsICIyLzMgXiAyIgogICAgLCAiKDIvMykgXiAyIgoJLCAiKDIgKyAzKSAvICgyIC0gMikiCgksICIyICsgMzQ1ICsgKyArICsgNiIKCSwgIiAgLSBzcXIgNSEgKygtc3FyKDEgLSAyXiAzKSBec3FyIDIgKjkgISkgICAgIgoJLCAiNSArIDkgMyIKCSwgInNxciBzcXIgMyIKCSwgIjIgKyAtMyAqIDUiCgld