2016 Update

Task/Parsing-RPN-calculator-algorithm/Ela/parsing-rpn-calculator-algorithm.ela

@@ -1,21 +1,42 @@
-open string console list format read
+open string generic monad io
 
-eval str = writen "Input\tOperation\tStack after" $
-               eval' (split " " str) []
-      where eval' [] (s::_) = printfn "Result: {0}" s
-            eval' (x::xs) sta | "+"? = eval' xs <| op (+)
-                              | "-"? = eval' xs <| op (-)
-                              | "^"? = eval' xs <| op (**)
-                              | "/"? = eval' xs <| op (/)
-                              | "*"? = eval' xs <| op (*)
-                              | else = eval' xs <| conv x
-                    where c? = x == c
-                          op (^) = out "Operate" st' $ st'
-                                    where st' = (head ss ^ s) :: tail ss
-                          conv x = out "Push" st' $ st'
-                                    where st' = readStr x :: sta
-                          (s,ss) | sta == [] = ((),[])
-                                 | else = (head sta,tail sta)
-                          out op st' = printfn "{0}\t{1}\t\t{2}" x op st'
+type OpType = Push | Operate
+  deriving Show
 
-eval "3 4 2 * 1 5 - 2 3 ^ ^ / +"
+type Op = Op (OpType typ) input stack
+  deriving Show
+
+parse str = split " " str
+
+eval stack []      = []
+eval stack (x::xs) = op :: eval nst xs
+  where (op, nst)  = conv x stack
+        conv "+"@x = operate x (+)
+        conv "-"@x = operate x (-)
+        conv "*"@x = operate x (*)
+        conv "/"@x = operate x (/)
+        conv "^"@x = operate x (**)
+        conv x     = \stack ->
+          let n = gread x::stack in
+          (Op Push x n, n)
+        operate input fn (x::y::ys) =
+          let n = (y `fn` x) :: ys in
+          (Op Operate input n, n)
+
+print_line (Op typ input stack) = do
+  putStr input
+  putStr "\t"
+  put typ
+  putStr "\t\t"
+  putLn stack
+
+print ((Op typ input stack)@x::xs) lv = print_line x `seq` print xs (head stack)
+print [] lv = lv
+
+print_result xs = do
+  putStrLn "Input\tOperation\tStack after"
+  res <- return $ print xs 0
+  putStrLn ("Result: " ++ show res)
+
+res = parse "3 4 2 * 1 5 - 2 3 ^ ^ / +" |> eval []
+print_result res ::: IO