95 lines
3 KiB
FSharp
95 lines
3 KiB
FSharp
open System
|
|
|
|
type action = Shift | ReduceStack | ReduceInput
|
|
|
|
type State (input : string list, stack : string list, output : string list) =
|
|
member x.Input with get() = input
|
|
member x.Stack with get() = stack
|
|
member x.Output with get() = output
|
|
|
|
member x.report act =
|
|
let markTop = function | [] -> [] | x::xs -> ("["+x+"]")::xs
|
|
let (s, text) =
|
|
if x.Stack = [] && x.Input = [] then x, ""
|
|
else
|
|
match act with
|
|
| Shift -> State((markTop x.Input), x.Stack, x.Output), "shift"
|
|
| ReduceStack -> State(x.Input, (markTop x.Stack), x.Output), "reduce"
|
|
| ReduceInput -> State((markTop x.Input), x.Stack, x.Output), "reduce"
|
|
|
|
let lstr (x :string list) = String.Join(" ", (List.toArray x))
|
|
printfn "%25s %-9s %6s %s" (lstr (List.rev s.Output)) (lstr (List.rev s.Stack)) text (lstr s.Input)
|
|
|
|
member x.shift =
|
|
x.report Shift
|
|
State(x.Input.Tail, (x.Input.Head)::x.Stack, x.Output)
|
|
|
|
member x.reduce =
|
|
x.report ReduceStack
|
|
State (x.Input, (x.Stack.Tail), (x.Stack.Head)::x.Output)
|
|
|
|
member x.reduceNumber =
|
|
x.report ReduceInput
|
|
State(x.Input.Tail, x.Stack, (x.Input.Head)::x.Output)
|
|
|
|
let prec = function
|
|
| "^" -> 4 | "*" | "/" -> 3 | "+" | "-" -> 2 | "(" -> 1
|
|
| x -> failwith ("No precedence! Not an operator: " + x)
|
|
|
|
type assocKind = | Left | Right
|
|
let assoc = function | "^" -> Right | _ -> Left
|
|
|
|
let (|Number|Open|Close|Operator|) x =
|
|
if (Double.TryParse >> fst) x then Number
|
|
elif x = "(" then Open
|
|
elif x = ")" then Close
|
|
else Operator
|
|
|
|
let rec shunting_yard (s : State) =
|
|
|
|
let rec reduce_to_Open (s : State) =
|
|
match s.Stack with
|
|
| [] -> failwith "mismatched parentheses!"
|
|
| "("::xs -> State(s.Input.Tail, xs, s.Output)
|
|
| _ ->
|
|
reduce_to_Open s.reduce
|
|
|
|
let reduce_by_prec_and_shift x s =
|
|
let (xPrec, xAssoc) = (prec x, assoc x)
|
|
let rec loop (s : State) =
|
|
match s.Stack with
|
|
| [] -> s
|
|
| x::xs ->
|
|
let topPrec = prec x
|
|
if xAssoc = Left && xPrec <= topPrec || xAssoc = Right && xPrec < topPrec then
|
|
loop s.reduce
|
|
else
|
|
s
|
|
(loop s).shift
|
|
|
|
let rec reduce_rest (s : State) =
|
|
match s.Stack with
|
|
| [] -> s
|
|
| "("::_ -> failwith "mismatched parentheses!"
|
|
| x::_ ->
|
|
reduce_rest s.reduce
|
|
|
|
match s.Input with
|
|
| x::inputRest ->
|
|
match x with
|
|
| Number ->
|
|
shunting_yard s.reduceNumber
|
|
| Open ->
|
|
shunting_yard s.shift
|
|
| Close ->
|
|
shunting_yard (reduce_to_Open s)
|
|
| Operator ->
|
|
shunting_yard (reduce_by_prec_and_shift x s)
|
|
| [] -> reduce_rest s
|
|
|
|
[<EntryPoint>]
|
|
let main argv =
|
|
let input = if argv.Length = 0 then "3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3".Split() else argv
|
|
shunting_yard (State((Array.toList input), [], []))
|
|
|> (fun s -> s.report ReduceStack)
|
|
0
|