Parsing/Shunting-yard algorithm: Difference between revisions

=={{header|8th}}--

<lang forth>\ Convert infix expression to postfix, using 'shunting-yard' algorithm

\ https://en.wikipedia.org/wiki/Shunting-yard_algorithm

\ precedence of infix tokens. negative means 'right-associative', otherwise left:

with: n

{

"+" : 2,

"-" : 2,

"/" : 3,

"*" : 3,

"^" : -4,

"(" : 1,

")" : -1

} var, tokens

: precedence \ s -- s n

tokens @ over m:@ nip

null? if drop 0 then ;

var ops

var out

: >out \ x --

out @ swap

a:push drop ;

: >ops \ op prec --

2 a:close

ops @ swap

a:push drop ;

: a:peek -1 a:@ ;

\ Check the array for items with greater or equal precedence,

\ and move them to the out queue:

: pop-ops \ op prec ops -- op prec ops

\ empty array, do nothing:

a:len not if ;; then

\ Look at top of ops stack:

a:peek a:open \ op p ops[] op2 p2

\ if the 'p2' is not less p (meaning item on top of stack is greater or equal

\ in precedence), then pop the item from the ops stack and push onto the out:

3 pick \ p2 p

< not if

\ op p ops[] op2

>out a:pop drop recurse ;;

then

drop ;

: right-paren

"RIGHTPAREN" . cr

2drop

\ move non-left-paren from ops and move to out:

ops @

repeat

a:len not if

break

else

a:pop a:open

1 = if

2drop ;;

else

>out

then

then

again drop ;

: .state \ n --

drop \ "Token: %s\n" s:strfmt .

"Out: " .

out @ ( . space drop ) a:each drop cr

"ops: " . ops @ ( 0 a:@ . space 2drop ) a:each drop cr cr ;

: handle-number \ s n --

"NUMBER " . over . cr

drop >out ;

: left-paren \ s n --

"LEFTPAREN" . cr

>ops ;

: handle-op \ s n --

"OPERATOR " . over . cr

\ op precedence

\ Is the current op left-associative?

dup sgn 1 = if

\ it is, so check the ops array for items with greater or equal precedence,

\ and move them to the out queue:

ops @ pop-ops drop

then

\ push the operator

>ops ;

: handle-token \ s --

precedence dup not if

\ it's a number:

handle-number

else

dup 1 = if left-paren

else dup -1 = if right-paren

else handle-op

then then

then ;

: infix>postfix \ s -- s

/\s+/ s:/ \ split to indiviual whitespace-delimited tokens

\ Initialize our data structures

a:new ops ! a:new out !

(

nip dup >r

handle-token

r> .state

) a:each drop

\ remove all remaining ops and put on output:

out @

ops @ a:rev

( nip a:open drop a:push ) a:each drop

\ final string:

" " a:join ;

"3 + 4 * 2 / ( 1 - 5 ) ^ 2 ^ 3" infix>postfix . cr

"Expected: \n" . "3 4 2 * 1 5 - 2 3 ^ ^ / +" . cr

bye

</lang>

{{out}}

<pre>NUMBER 3

Out: 3

ops:

OPERATOR +

Out: 3

ops: +

NUMBER 4

Out: 3 4

ops: +

OPERATOR *

Out: 3 4

ops: + *

NUMBER 2

Out: 3 4 2

ops: + *

OPERATOR /

Out: 3 4 2 *

ops: + /

LEFTPAREN

Out: 3 4 2 *

ops: + / (

NUMBER 1

Out: 3 4 2 * 1

ops: + / (

OPERATOR -

Out: 3 4 2 * 1

ops: + / ( -

NUMBER 5

Out: 3 4 2 * 1 5

ops: + / ( -

RIGHTPAREN

Out: 3 4 2 * 1 5 -

ops: + /

OPERATOR ^

Out: 3 4 2 * 1 5 -

ops: + / ^

NUMBER 2

Out: 3 4 2 * 1 5 - 2

ops: + / ^

OPERATOR ^

Out: 3 4 2 * 1 5 - 2

ops: + / ^ ^

NUMBER 3

Out: 3 4 2 * 1 5 - 2 3

ops: + / ^ ^

3 4 2 * 1 5 - 2 3 ^ ^ / +

Expected:

3 4 2 * 1 5 - 2 3 ^ ^ / +

</pre>