-- Look out! We be programming!
-- cradle2c.ex a Euphoria compiler by A.R.S. KA9QLQ Alvin Koffman Copy right 2002

include get.e -- for get character functions
include wildcard.e -- for upper()

with trace
--trace(1) -- output to screen

constant
  alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ", -- Define alphas
  nums = "0123456789",	-- Define numerics
  addop = "-+",  -- Define addops
  mulop = "*/" -- Define mulops

 integer exp_id -- this is a numeric id used for routine_id()
 object Look	-- Look ahead character

procedure GetChar() -- Read New Character From Input Stream
   Look = getc(0)			 --	this grabs a line of characters
   Look = upper(Look)
-- run alpha characters from Look through upper to ignore capitalisation
end procedure

function IsAlpha(object c) -- Recognize an Alpha Character
   return find(upper(c),alpha)
end function

function IsDigit(object c) -- Recognize a Decimal Digit
   return find(c,nums)
end function

function IsAddop(object c) -- Recognize an Alpha Character
   return find(upper(c),addop)
end function

function IsMulop(object c) -- Recognize an Alpha Character
   return find(upper(c),mulop)
end function

procedure Error(sequence s) -- called from Abort to
   puts(1,"\n Error: " & s & ".") -- output error
end procedure

procedure Abort(sequence s) -- Report Error and Halt
atom x
   Error(s)
   x = wait_key() -- wait so you can see results
   abort(1)	   -- when using Windows or Linux
end procedure

procedure Expected(sequence s) -- Report What Was Expected
   Abort(s & " Expected\n")
end procedure

procedure Match(integer x) -- test for integer
   if Look = x then GetChar() -- if integer advance 1 character
   else Expected("' + x + '") -- or crash and burn
   end if
end procedure

function GetNum() -- test for valid number
object x
   if not find(Look,nums) then Expected("Integer")
   end if
   x = Look -- this will pass the character back
   GetChar() -- ready Look with another character
   return x -- pass the number back to Term
end function


procedure Init() -- initialize program
   GetChar() -- grab a character
end procedure

procedure Factor() -- Parse and Translate a Math Expression
   if Look ='(' then -- look for parens in input
    Match('(')
    call_proc(exp_id,{}) -- bounce between Expression and Factor
    Match(')')
  else
   puts(1, "MOVE  " & GetNum() & " D0 \n")
  end if
end procedure

procedure Multiply() --Recognize and Translate a Multiply
   Match('*')
   Factor()
   puts(1, "MULS (SP)+,D0\n")
end procedure

procedure Divide() -- Recognize and Translate a Divide
   Match('/')
   Factor()
   puts(1, "MOVE (SP)+,D1\n")
   puts(1, "DIVS D1,D0\n")
end procedure

procedure Term() --Parse and Translate a Math Term
   Factor()
   while IsMulop(Look) do -- check for mulop
	 puts(1, "MOVE D0,-(SP)\n")
	 if Look = '*' then Multiply()
	  elsif Look = '/' then Divide()
	  elsif Look ='\n' then exit
	  else Expected("Mulop ")
	 end if
   end while
end procedure

procedure Add()  --Recognize and Translate an Add
   Match('+')	-- advance to netx character
   Term()   -- check for and move number to AX
   puts(1, "ADD (SP)+,D0\n")	-- run the number
end procedure

procedure Subtract()  --Recognize and Translate a Subtract
   Match('-')	-- advance to netx character
   Term()
   puts(1, "SUB (SP)+,D0\n")	-- run the number
   puts(1, "NEG D1\n")  -- make sign change
end procedure

procedure Expression()  -- Parse and Translate an Expression
   if IsAddop(Look) then  -- check for leading minus
	 puts(1,"CLR D0/n")
   else
   Term()   -- check for and move number to DO
   while IsAddop(Look) do -- loop for long addop
   puts(1, "MOVE D0,-(SP)\n") -- free up first register for next input
    if  Look = '+' then Add() -- add the registers
	elsif Look = '-' then Subtract() -- subtract the registers
	elsif Look = '\n' then exit -- end of line check
	else Expected("Addop ") -- trap error
    end if
   end while
   end if
end procedure


-- start
exp_id = routine_id("Expression")
   puts(1, "Input a line of characters \n") -- ask for imput
   Init()
   Expression()