% BEGINNING-OF
% implemented by John Hale
% from section 6.5.1 of Stabler's 185 Class Notes


%% these matcher functions should return a list of key/value pairs
%% the "value" is not important for implementing sets, so use the dummy value true
declare
fun {GetParent R}
   case R of
      LHS#_#_  then [LHS#true]
   else nil
   end
end

fun {AllSymbols R}
   fun {PairWithTrue X}
      X#true
   end
in
   case R of
      LHS#Trigger#Predicted  then {List.append [LHS#true]
				   {List.append
				    {List.map Trigger PairWithTrue}
				    {List.map Predicted PairWithTrue}}}
   else nil
   end
end

fun {TriggerParent R}
   case R of
      LHS#Trigger#_  then [Trigger#LHS]
   else nil
   end
end

%% use a function on grammar rules, F, to build a hash table of facts about the grammar
fun {EveryRule F Rules} MyD={Dictionary.new} in
	   for Rule in Rules do
	      for Key#Value in {F Rule} do
		 if {Not {Dictionary.member MyD Key}}
		 then MyD.Key := Value  % stuff it in
		 else skip  % no duplicates: we're a *set*, not a list!
		 end
	      end  % each output from our function F
	   end % each rule of our rule-list
	   MyD
	end

fun {Difference D1 D2} D1K={Dictionary.keys D1} Result={Dictionary.new} in
	   for K in D1K do
	      if {Not {Dictionary.member D2 K}} % K \in D1  and  K \not\in D2
	      then Result.K := D1.K
	      else skip
	      end
	   end
	   Result
	end

fun {Unscan Terminals Relation}
   case Relation of
      nil#Parent then [nil#Parent]
   [] Beginning#Parent andthen {List.member {List.last Beginning} Terminals}
   then [ {List.take Beginning {List.length Beginning}-1}#Parent ]
   else nil
   end
end

fun {Unreduce Grammar Relation}
   case Relation of
      nil#Parent then [ nil#Parent ]
   [] Beginning#Parent then
      local Targets={List.filter Grammar fun {$ LHS#_#_}
					    LHS=={List.last Beginning}
					 end}
	 AllButLast={List.take Beginning {List.length Beginning}-1}
      in
	 {List.map Targets fun {$ _#Trigger#_} {List.append AllButLast Trigger}#Parent end}
      end
   end
end

% use Queue from the Mozart standard library to build the closure of the proof rules
% for the BEGINNING-OF relation in a breadth-first way
[Queue]={Module.link ['x-oz://system/adt/Queue.ozf']}

 fun {Closure Sofar Q Inf}
	   case {Q.isEmpty} of
	      true then Sofar
	   [] false then
	      local Focus = {Q.top} in
		 if {Not {List.member Focus Sofar}}
		 then
		    _={Q.get} % throw away top of queue
		    {Closure (Focus|Sofar)
		     {List.foldL % this expression is the new Q
		      Inf
		      fun {$ Q Inference}
			 for Result in {Inference Focus} do
			    {Q.put Result}
			 end
			 Q
		      end
		      Q % Q before any updates
		     }
		     Inf}
		 else
		    _={Q.get} % throw away top of queue
		    {Closure Sofar Q Inf}
		 end
	      end
	   end
	end

fun {BeginningOf G}
   % make a list of all the Terminals
   NTs={EveryRule GetParent G}
   AllS={EveryRule AllSymbols G}
   Ts={Difference AllS NTs}
   Terminals={List.map {Dictionary.entries Ts} fun {$ X} X.1 end}
   % specialize the inferences Unscan and Unreduce for this grammar
   Infs=[fun {$ Relation} {Unscan Terminals Relation} end
	 fun {$ Relation} {Unreduce G Relation} end
	]
   Q={Queue.newFromList    % initial axia
      {List.foldL G fun {$ Old R} {TriggerParent R}.1|Old end nil}
     }
   fun {NR Acc}
      fun {$ L} 
	 case L of
	    nil then Acc
	 [] Head|Rest then {{NR neg(Head)|Acc} Rest}
	 end
      end
   end
   NegativeReversal={NR nil} % accumulator always starts out empty
in
   {List.map {Closure nil Q Infs} fun {$ Symbols#Parent} {List.append {NegativeReversal Symbols} [Parent]} end }
end