#! ../isforth/isforth - fload
\ ------------------------------------------------------------------------
\ Tiny Forth-based Compiler #1
\
\ Based on Jack Crenshaw's compiler tutorial, parts 1-2
\ Reads single-character tokens: 0-9 + * * / ( )
\ ------------------------------------------------------------------------

variable look	\ Lookahead char

: getchar	key look ! ;

: "  ( "text" -- a # )
	pad '"' parse tuck   pad swap cmove ; immediate

: error ( a n -- )
	cr ." Error: " type ." ." cr bye ;
: expected ( a n -- )
	cr ." Error: " type ." expected." cr bye ;

\ ------------------------------------------------------------------------

: match ( c -- )
	look @ =
		if	getchar
		else	." Expected char not found" cr bye
	then ;

: upcase ( c -- c' )
	dup 96 >  over 123 u<  and	\ Is lowercase?
		if	32 -
	then ;

: isdigit? ( c -- f )
	dup 47 >  swap 58 u<  and ;
: isalpha? ( c -- f )
	upcase dup 64 >  swap 98 u<  and ;

: getname ( -- c )
	look @ isalpha? not
		if ." Name expected" cr bye then
	look @ upcase
	getchar ;

: getnum ( -- c )
	look @ isdigit? not
		if	." Integer expected" cr bye
		else	look @ 48 -  getchar
	then ;

\ ------------------------------------------------------------------------

: isaddop? ( c -- f )	'+' over =	swap '-' =	or ;
: ismulop? ( c -- f )	'*' over =	swap '/' =	or ;

defer expression

: factor
	look @ '(' =
		if	'(' match  expression  ')' match
		else	getnum  ."  MOV EAX," . cr
		then ;

: Mul	'*' match
	factor
	."  POP EBX" cr
	."  MUL EBX" cr ;

: Div	'/' match
	factor
	."  POP EBX" cr
	."  XOR EDX,EDX" cr
	."  DIV EBX" cr ;

: term
	factor
	begin	look @ ismulop?
	while	."  PUSH EAX" cr
		look @ '*' =	if	Mul
	  else	look @ '/' =	if	Div
	  else	." expected mulop" cr bye
	  then then
	repeat ;

: Add	'+' match
	term
	."  POP EBX" cr
	."  ADD EAX,EBX" cr ;

: Sub	'-' match
	term
	."  POP EBX" cr
	."  SUB EAX,EBX" cr
	."  NEG EAX" cr ;

: (expression)
	look @ isaddop?
		if	."  XOR EAX,EAX" cr
		else	term
		then
	begin	look @ isaddop?
	while	."  PUSH EAX" cr
		look @ '+' =	if	Add
	  else	look @ '-' =	if	Sub
	  else	." expected addop" cr bye
	  then then
	repeat ;

' (expression) is expression

\ ------------------------------------------------------------------------
\ Init
\ ------------------------------------------------------------------------
 getchar
 expression