module lambdayacc.
accum_sig parser, tokenizer.
accumulate lyaccshares, tokenizer, parser,blists,maps.

type output_fcs out_stream -> (list gs) -> o.


% ----------------------------- Main Parsing Predicates ---------------
% These are the functions a user would use to parse a file or line 
% using a parser generated by LambdaYacc

% Parse a user-inputted line of text using Start as the start symbol
parseline Start Absyn :- print "\nEnter Expression: ",
		   input_line std_in Line,  	% get string
		   open_string Line In,     	% create in_stream from string
		   ((pi It\ (pi LA\ (pi (LN\ (yyinitial LN It [eols] :- 
	 	   lookahead It LA, eof_symbol LA, !))))) => (eof_symbol "\n" => yyinitial 0 In Tokens)),
		   close_in In, !,
		   startparse Start [bols] Tokens Absyn Str, !.

% Parse the specified file
parsefile File Absyn :-  open_in File In,
			print "Scanning for tokens...\n",
			(yyinitial 0 In Tokens),
			close_in In, !, 
			print "Parsing " , print File, print "\n",
			parse [bofs] Tokens Absyn Str,!.


% --------------------------- Generate Parser ---------------------
% main predicate:
% usage: genparser grammar_module parser_module
% e.g., genparser "calcgramar" "calcparser" will generate
%  "calcparser.mod" and "calcparser.sig".  
genparser Gfile File :- Sigfile is (File ^ ".sig"),
			       Modfile is (File ^ ".mod"), 
			       open_out Sigfile SS,		     % create signature file
			       output SS "\nsig ", output SS File, output SS ".\n",
			       output SS "accum_sig ", 
			       output SS Gfile, output SS ", lambdayacc.\n",
			       close_out SS, !, 
			       open_out Modfile OS, 	             % open output stream for mod file
			       output OS "module ", output OS File, 
			       output OS ".\naccumulate ",
			       output OS Gfile, output OS ".\n\n",   % don't reaccumulate lambdayacc!
			       gen_first OS 0 Printed, % generate FIRST set as atomic clauses
			       print "Computing Valid Handles...\n",
			       !, fsbrc SH, !, 
			       rrdeterministic SH Printed, 		     % no reduce-reduce conflicts
			       print "No reduce-reduce conflicts.\n",
			  % check and resolve sr-conflicts, gen rules:
			       srdeterministic SH SH Printed OS,
			       print "No remaining shift-reduce conflicts; generating rules... \n",
			  % initial shift:
			       start_symbol Start,
			       output OS "parse [bofs] [A|B] R \"shift\" :- \n", output OS "\tfirst (",
			       printterm OS Start, output OS ") A, parse [A,bofs] B R Str.\n",
			       output OS "startparse START [bols] [A|B] R \"shift\" :- \n", output OS "\tfirst (",
			       output OS "START) A, parse [A,bols] B R Str,!.\n",
			  % accept rule:
			       output OS "parse [Sx,bofs] [eofs] Sx \"accept\" :- start_symbol Sx.\n",
			       output OS "parse [Sx,bols] [eols] Sx \"accept\" :- !.\n",
			       forevery (X\ (gen_reduce OS X)) SH,    % generate reduce rules
			  % print failure rule:
			       output OS "\nparse V I R \"error\" :- !, finderrline V I,",
			       output OS "print \"Remaining Input = \", print_tokens 10 I, !, fail.\n",
			       print "Parser written to file.\n",
			       close_out OS, !.
% Take arguments from command line and convert to strings
genparser A B :- (term_to_string A As, term_to_string B Bs, genparser As Bs,halt);
		   print "\n\nError generating parser.  Please press Ctrl + C to exit".


% uncomment to trace:
%parse A B C D :- printterm std_out (parse A B C D), print " <-- trace\n", fail.

% Special parsing clauses used for conflicts handled by the operator associativity
% and precendence clauses in the grammar.  These will come before any parse clauses
% in the parser itself

parse A [(linenum N)|Beta] R S :- !, parse A Beta R S.  % ignore newlines

parse [Ea,OP,Eb|Alpha] [OP|Beta] Result "special" :- binaryop OP Eb Ea Assoc Prec1, !,
						     ( (Assoc = "left", parse [Ea,OP,Eb|Alpha] [OP|Beta] Result "reduce");
						     (Assoc = "right", parse [Ea,OP,Eb|Alpha] [OP|Beta] Result "shift")).

parse [Ea,OP1,Eb|Alpha] [OP2|Beta] Result "special" :- (not (OP1 = OP2)), binaryop OP1 Eb Ea Assoc1 Prec1,
						       (binaryop OP2 Ea Ed Assoc2 Prec2; unaryop OP2 Ed Prec2), !,
						       ( (Prec1 =< Prec2, parse [Ea,OP1,Eb|Alpha] [OP2|Beta] Result "reduce");
						       (Prec1 > Prec2, parse [Ea,OP1,Eb|Alpha] [OP2|Beta] Result "shift")).

parse [Ea,Eb|Alpha] [A|Beta] Result "special" :- implicitop Eb Ea Assoc Prec, implicitop Ea Ec Assoc Prec, first Ec A, !,
						 ( (Assoc = "left", parse [Ea,Eb|Alpha] [A|Beta] Result "reduce");
						 (Assoc = "right", parse [Ea,Eb|Alpha] [A|Beta] Result "shift")).

parse [Ea,OP1,Eb|Alpha] [A|Beta] Result "special" :- binaryop OP1 Eb Ea Assoc1 Prec1,
						     implicitop Ea Ec Assoc2 Prec2, first Ec A, !,
						     ( (Prec1 =< Prec2, parse [Ea,OP1,Eb|Alpha] [A|Beta] Result "reduce");
						     (Prec1 > Prec2, parse [Ea,OP1,Eb|Alpha] [A|Beta] Result "shift")).

parse [Ea,Eb|Alpha] [OP1|Beta] Result "special" :- implicitop Eb Ea Assoc1 Prec1, 
						   (binaryop OP1 Ea Ec Assoc2 Prec2; unaryop OP1 Ec Prec2), !,
						   ( (Prec1 =< Prec2, parse [Ea,Eb|Alpha] [OP1|Beta] Result "reduce");
						   (Prec1 > Prec2, parse [Ea,Eb|Alpha] [OP1|Beta] Result "shift")).

parse [Ea,OP1|Alpha] [S2|Beta] Result "special" :- unaryop OP1 Ea Prec1, ((binaryop S2 Ea Eb Assoc2 Prec2, !); 
						   (implicitop Ea Eb Assoc2 Prec2, first Eb S2)), !,
						   ( (Prec1 =< Prec2, parse [Ea,OP1|Alpha] [S2|Beta] Result "reduce");
						   (Prec1 > Prec2, parse [Ea,OP1|Alpha] [S2|Beta] Result "shift")).




% ---------- Generate the freshcopy clauses ----------
% For every nonterminal, print a freshcopy clause
% This will only work if the grammar's listing of 
% nonterminals has them in the form "aryn symbol", for 
% 0 <= n <= 4
generate_fc A :- nonterm_list NTs, term_to_string A File, Name is File ^ ".mod", open_append Name FCmod,
	       output FCmod "\n\n", output_fcs FCmod NTs, output FCmod "freshcopy X X.", close_out FCmod.

output_fcs _ nil.
output_fcs OS [(ary4 H)|T] :- output OS "freshcopy (", printterm OS (H A C E G),
			      output OS ") (", printterm OS (H B D F I), output OS ") :- !.\n", output_fcs OS T,!.
output_fcs OS [(ary3 H)|T] :- output OS "freshcopy (", printterm OS (H A C E),
			      output OS ") (", printterm OS (H B D F), output OS ") :- !.\n", output_fcs OS T,!.
output_fcs OS [(ary2 H)|T] :- output OS "freshcopy (", printterm OS (H A C),
			      output OS ") (", printterm OS (H B D), output OS ") :- !.\n", output_fcs OS T,!.
output_fcs OS [(ary1 H)|T] :- output OS "freshcopy (", printterm OS (H A),
			      output OS ") (", printterm OS (H B), output OS ") :- !.\n", output_fcs OS T,!.
output_fcs OS [(ary0 H)|T] :- output_fcs OS T,!.
output_fcs OS [H|T] :- output_fcs OS T.	 % Ignore ones not declared in the proper form; this may be necessary 
					 % if a person creating grammar uses a symbol of arity > 4.