module lpbasicgram.
accumulate lambdayacc, lpbasic_absyn.

non_terminal X :- member X [(exp S),(stat SS),(statlist S3),(astat S4)].
ntnum 5.
terminal X :- 
  oncememb X [minust,dividet,plust,expt,timest,lparen,rparen,eqt,(iconst V),
              (id S),(sconst St),ort,andt,nott,assignt,ift,thent,elset,begint,
	      lesst,whilet,lett,intok,endt,semicolon,comma,printt].

%%% tokenizer declarations:
printname _ "(" lparen.
printname _ ")" rparen.
printname _ "+" plust.
printname _ "-" minust.
printname _ "*" timest.
printname _ "/" dividet.
printname _ "^" expt.
printname _ "not" nott.
printname _ "|" ort.
printname _ "&" andt.
printname _ "=" eqt.
printname _ "<" lesst.
printname _ ":=" assignt.
printname _ "if" ift.
printname _ "then" thent.
printname _ "else" elset.
printname _ "while" whilet.
printname _ "let" lett.
printname _ "in" intok.
printname _ "BEGIN" begint.
printname _ "END" endt.
printname _ "print" printt.
printname _ ";" semicolon.
printname _ "," comma.
% iconst, sconst and id are universal

start_symbol (stat S).

cfg
[
  rule ((statlist Sl) ==> [stat Tl]) (Sl = [Tl]),
  rule ((statlist HT) ==> [stat H2,semicolon,statlist T2]) (HT = [H2|T2]),
  rule ((exp N) ==> [iconst M]) (N = (intexp M)),
  rule ((exp S2) ==> [sconst Sb2]) (S2 = (strexp Sb2)),
  rule ((exp Var) ==> [id Va2]) (Var = (varexp Va2)),
  rule ((exp EE12) ==> [exp E1,plust,exp E2]) 
				(EE12 = (sumexp  E1 E2)),
  rule ((exp EE34) ==> [exp E3,minust,exp E4]) 
				(EE34 = (difexp E3 E4)),
  rule ((exp EE56) ==> [exp E5,timest,exp E6]) 
				(EE56 = (multexp E5 E6)),
  rule ((exp EE78) ==> [exp E7,dividet,exp E8]) 
				(EE78 = (divexp E7 E8)),
  rule ((exp EE90) ==> [exp E9,andt,exp E10]) 
				(EE90 = (andexp E9 E10)),
  rule ((exp EEor) ==> [exp E11,ort,exp E12]) 
				(EEor = (orexp E11 E12)),
  rule ((exp EEeq) ==> [exp E11,eqt,exp E12]) 
				(EEeq = (eqexp E11 E12)),
  rule ((exp EEiq) ==> [exp El6,lesst,exp El7]) 
				(EEiq = (ineqexp El6 El7)),
  rule ((exp EEnot) ==> [nott,lparen,exp E13,rparen]) 
				(EEnot = (notexp E13)),
  rule ((exp E14) ==> [lparen,exp E14,rparen]) true,
  rule ((stat SSp) ==> [printt,exp E15]) 
				(SSp = (printst E15)),
  rule ((stat AST) ==> [astat AST2]) (AST = AST2),
  rule ((astat ASn) ==> [id Str,assignt,exp E16]) 
				(ASn = (assignst (varexp Str) E16)),
  rule ((stat SSif) ==> [ift,exp F1,thent,stat SF1]) 
				(SSif = (ifst F1 SF1)),
  rule ((stat SSie) ==> [ift,exp F2,thent,stat SF2,elset,stat SFE2])
				(SSie = (ifelsest F2 SF2 SFE2)),
  rule ((stat SSwh) ==> [whilet,exp W1,stat WL1]) 
				(SSwh = (whilest W1 WL1)),
  rule ((stat Slet) ==> [lett,astat Alet,intok,stat Slbd])
				(formlet Alet Slbd Slet),
  rule ((stat SBl) ==> [begint,statlist SBll,endt]) (SBl = (blockst SBll))
].

binaryop plust (exp X) (exp Y) "left" 3.
binaryop minust (exp X) (exp Y) "left" 3.
binaryop timest (exp X) (exp Y) "left" 2.
binaryop dividet (exp X) (exp Y) "left" 2.
binaryop andt (exp X) (exp Y) "left" 5.
binaryop ort (exp X) (exp Y) "left" 5.
binaryop eqt (exp X) (exp Y) "left" 6.
binaryop lesst (exp X) (exp Y) "left" 6.
%binaryop expt (exp X) (exp Y) "left" 1.

%% semantic action caluses:
formlet (assignst (varexp V) E) St (letst E Lam) :-
  pi x\ ((copyexp (varexp V) x :- !) => copyst St (Lam x)).

run File :- parsefile File (stat St), !,
            welltyped St, lbexecute [St].


% hack:  freshcopy clauses:

freshcopy (statlist A) (statlist B) :- !.
freshcopy (exp A) (exp B) :- !.
freshcopy (stat A) (stat B) :- !.
freshcopy (astat A) (astat B) :- !.
freshcopy T T.