\ opg.2 of 3 97.11.04 Wil Baden
\ Included by opg.

( An identifier is a letter followed by letters and digits. )
: is-identifier ( str len -- str' len' flag )
  DUP 0= ?? FAILURE

  OVER C@ isalpha 0= ?? FAILURE

  1 /STRING
  BEGIN  DUP 0= ?? SUCCESS
  OVER C@ isalnum
  WHILE  1 /STRING  REPEAT

  SUCCESS
;
( Since you can call an identifier with spaces, no special chars. )

( Op-Stack Operations. )

30 CONSTANT Op-Stack-Size
CREATE Op-Stack  Op-Stack-Size 1+ CELLS ALLOT

: op-push ( op -- )
  Op-Stack @ Op-Stack-Size CELLS < NOT
  ABORT" Too Many Elements -- Increase Op-Stack-Size "
  1 CELLS Op-Stack +!  Op-Stack DUP @ + !
;

: Op-Top ( -- op ) Op-Stack DUP @ + @ ;
: Op-Pop ( -- )  -1 CELLS Op-Stack +! ;

( Application. )

VARIABLE Parenthesis-Count

 1 CONSTANT Left-Paren
 2 CONSTANT Right-Paren
 8 CONSTANT Negation
 9 CONSTANT Function-Call
 10 CONSTANT Op-Dummy

CREATE Word-Holder  32 CHARS ALLOT

( `memorable`  Look up variable. )
: memorable ( str len -- )
  31 MIN  Word-Holder PLACE ( )
  Word-Holder FIND 0= IF
  COUNT TYPE SPACE  TRUE ABORT" Not Found "
  THEN
  DROP
;

( `callable`  Look up function. )
: callable ( str len -- str' len' )
  OVER C@ [CHAR] F = NOT IF
  2DUP  30 MIN  DUP 1+  Word-Holder C!
  Word-Holder CHAR+  PLACE ( . .)
  [CHAR] F  Word-Holder CHAR+  C!
  Word-Holder FIND NIP IF
  2DROP  Word-Holder COUNT
  THEN
  THEN ( str len)
;

( `translate-operation`  [I can't think of further explanation.] )
: translate-operation ( addr len -- )
  DEBUG @ IF  2DUP TYPE SPACE  THEN
  EVALUATE
;

( `op-store`  Make assignment. )
: op-store ( str len -- )( F: r -- )
  2DUP memorable translate-operation
  S" F! " translate-operation
;

( `op-fetch`  Pick up variable. )
: op-fetch ( str len -- )( F: -- r )
  2DUP memorable translate-operation
  S" F@ " translate-operation
;

( `op-literal`  Take care of literal. )
  VARIABLE Literal-State
: op-literal ( str len -- )( F: -- r )
  Literal-State OFF
  Word-Holder 0 2SWAP CHARS BOUNDS ?DO
  I C@ isDorE IF  Literal-State ON  THEN
  I C@  replace-last-char  1+
  1 CHARS +LOOP
  Literal-State @ 0= IF
  [CHAR] E  replace-last-char  1+
  THEN
  translate-operation
;

( `CASE` statements are used for ease of writing and reading. )

( `op-code`  Pick up code for operator. )
: op-code ( str len -- str len code )
  DUP 0= IF  0
  ELSE  OVER C@
  CASE [CHAR] )  OF  2  ENDOF
  [CHAR] +  OF  3  ENDOF
  [CHAR] -  OF  4  ENDOF
  [CHAR] *  OF  5  ENDOF
  [CHAR] /  OF  6  ENDOF
  [CHAR] ^  OF  7  ENDOF
  [CHAR] ,  OF  0  ENDOF
  DUP . EMIT
  TRUE ABORT" Illegal Operator "
  0 ENDCASE
  THEN
;

( `operator-precedence`  Get the precedence of an operator. )
: operator-precedence ( code -- precedence )
  CASE -1  OF -1  ENDOF ( Bottom Mark )
  0  OF  2  ENDOF ( Termination or Comma )
  1  OF  1  ENDOF ( Left Paren )
  2  OF  1  ENDOF ( Right Paren )
  3  OF  3  ENDOF ( Plus )
  4  OF  3  ENDOF ( Minus )
  5  OF  4  ENDOF ( Times )
  6  OF  4  ENDOF ( Divide )
  7  OF  5  ENDOF ( Power )
  8  OF  3  ENDOF ( Negation )
  9  OF  1  ENDOF ( Function-Call )
  10  OF  0  ENDOF ( Dummy )
  DROP  TRUE ABORT" Invalid Operation "
  0 ENDCASE
;
