#! ../isforth/isforth - fload
\ ------------------------------------------------------------------------
\ Tiny Forth-based Compiler #2
\
\ Based on Jack Crenshaw's compiler tutorial, parts 1-3
\ Supports:
\   Single-character tokens: + * * / ( )
\   One data type: 32-bit integer
\   Variables, assignment & function calls
\ ------------------------------------------------------------------------

variable look	\ Lookahead char

: getchar	key look ! ;

\ ------------------------------------------------------------------------
\ Error handling (not used, doesn't work)

: "  ( "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 ;

\ ------------------------------------------------------------------------
\ Scanner

: 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	0
		begin	look @ dup isdigit?
		while	'0' - swap 10 * +  getchar
		repeat
		drop
	then ;

\ ------------------------------------------------------------------------
\ Expression Parser

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

defer expression

: ident
	getname
	look @ '(' =
	if	'(' match  ')' match		\ Function call: F()
		."  CALL " emit cr
	else
		."  MOV EAX,[" emit ." ]" cr	\ Variable
	then ;

: factor
	look @ '(' =
	if	'(' match  expression  ')' match
	else	look @ isalpha?
		if	ident
		else	getnum  ."  MOV EAX," . cr
	then 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

: Assignment
	getname
	'=' match
	expression
	."  MOV [" emit ." ],EAX" cr ;

\ ------------------------------------------------------------------------
\ Main loop
\ ------------------------------------------------------------------------
: Parser
	begin	look @
	while	Assignment
		10 match
	repeat ;

\ Init
 getchar
 Parser