\ 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