\ infix 00.11.26 8:00 pm NAB
\ Based on Brad Rodriguez' BNF code.
.( Loading infix module...) cr
needs toolkit
needs bnf
variable debug
0 debug !
: string>buffer ( c-addr u -- )
bp @ swap dup ballot move ;
: ," ( <..."> -- ) ( Runtime: -- )
[char] " parse postpone sliteral
postpone string>buffer ; immediate
: between ( n low high -- bool )
1+ within ;
: ^ ( n1 n2 -- n1^n2 )
over swap 1 ?do over * loop nip ;
char + token '+'
char - token '-'
char * token '*'
char / token '/'
char ( token '('
char ) token ')'
char ^ token '^'
char = token '='
char , token ','
bl token 'bl'
bnf: <spaces> 'bl' recurse | 'bl' | ;bnf
: <digit>
@token dup b,
[char] 0 [char] 9 between
update-pointer ;
: <letter>
@token >lower dup b,
[char] a [char] z between
update-pointer ;
bnf: (number)
<digit> recurse | <digit> ;bnf
bnf: <number>
<spaces> (number) <spaces> ;bnf
bnf: (var)
<letter> recurse | <letter> ;bnf
bnf: <var>
<spaces> (var) (number) <spaces>
| <spaces> (var) <spaces> ;bnf
0 value exprvec
bnf: <element>
<spaces> '(' <spaces>
exprvec execute
<spaces> ')' <spaces>
| <number> bl b,
| <var> ," @ " ;bnf
bnf: <primary>
'-' recurse ," negate "
| <element> ;bnf
bnf: <factor>
<primary> '^' recurse ," ^ "
| <primary> ;bnf
bnf: <t'>
'*' <factor> ," * " recurse
| '/' <factor> ," / " recurse
| ;bnf
bnf: <term> <factor> <t'> ;bnf
bnf: <e'>
'+' <term> ," + " recurse
| '-' <term> ," - " recurse
| ;bnf
bnf: <expression> <term> <e'> ;bnf
' <expression> to exprvec
: start-parsing ( -- startaddr )
true success ! bl skip bp @ ;
: evaluate-code ( startaddr -- )
bp @ over - dup >r
debug @ if cr 2dup type cr then
evaluate r> negate ballot ;
bnf: <eval>
<var> bl b, '=' <expression>
," swap !"
| <expression>
;bnf
bnf: <evalchain>
<eval> ',' recurse
| <eval>
;bnf
: let ( "var=expr" -- )
start-parsing <evalchain>
evaluate-code ; immediate