module calcgrammar.
accumulate lambdayacc.

% Grammar for online calculator example

type lparen, rparen, plust, minust, timest, dividet, expt, quitt gs.
type ae int -> gs.   % arithmetic expression

%%% tokenizer declarations:
printname _ "(" lparen.
printname _ ")" rparen.
printname _ "+" plust.
printname _ "-" minust.
printname _ "*" timest.
printname _ "/" dividet.
printname _ "^" expt.
printname _ "quit" quitt.
% iconst and id are universal


terminal X :- 
  oncememb X [minust,dividet,plust,expt,timest,lparen,rparen,quitt,(iconst V)].
non_terminal (ae X).

ntnum 2.  % 1+number of non_terminals for gammar being considered.

start_symbol (ae X).

cfg    % really ambiguous gammar w/precedence declarations
[
  rule ((ae R) ==> [iconst R2]) (R is R2),
  rule ((ae R3) ==> [lparen,(ae R1),rparen]) (R3 is R1),
  rule ((ae R4) ==> [(ae A4),plust,(ae B4)]) (R4 is (A4 + B4)),
  rule ((ae R5) ==> [(ae A5),minust,(ae B5)]) (R5 is (A5 - B5)),
  rule ((ae R6) ==> [(ae A6),timest,(ae B6)]) (R6 is (A6 * B6)),
  rule ((ae R7) ==> [(ae A7),dividet,(ae B7)]) (R7 is (A7 div B7)),
  rule ((ae R8) ==> [(ae A8),expt,(ae B8)]) (power A8 A8 B8 R8),
  rule ((ae R9) ==> [quitt]) failure
].

% precedence and associatvity.  needed to resovle shift-reduce conflicts:
binaryop plust (ae X) (ae Y) "left" 3.
binaryop minust (ae X) (ae Y) "left" 3.
binaryop timest (ae X) (ae Y) "left" 2.
binaryop dividet (ae X) (ae Y) "left" 2.
binaryop expt (ae X) (ae Y) "left" 1.


% freshcopy clauses:  (needed because of an implementation characteristic)
freshcopy (ae X) (ae Y) :- !.
freshcopy T T.


%%%%%%%%%%%%% Semantic action clauses:

type power int -> int -> int -> int -> o.
type failure o.

power X AX 0 1.
power X AX 1 AX.
power X AX E N :- E > 1, AX2 is (X * AX), E2 is (E - 1), power X AX2 E2 N.

failure :- !, fail.


% online calculator program:

calculator :-
  parseline (ae X), 
  print "Value = ", printterm std_out X, print "\n",
  calculator.  % repeat until quit entered.