{
  Yacc lookahead computation. This implementation is based on the
  lookahead set algorithm described in Aho/Sethi/Ullman, 1986,
  Section 4.7.


  Copyright (c) 1990-92  Albert Graef <ag@muwiinfa.geschichte.uni-mainz.de>
  Copyright (C) 1996	 Berend de Boer <berend@pobox.com>

  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or
  (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.


$Revision: 2 $
$Modtime: 96-07-31 14:09 $

$History: YACCLOOK.PAS $
 *
 * *****************  Version 2  *****************
 * User: Berend       Date: 96-10-10   Time: 21:16
 * Updated in $/Lex and Yacc/tply
 * Updated for protected mode, windows and Delphi 1.X and 2.X.

}


unit YaccLook;

interface
{$IFDEF VIRTUALPASCAL}
Uses Use32;
{$ENDIF}

procedure lookaheads;
  (* computes the LALR lookahead sets and enters corresponding reductions
     into the redn table (sorted w.r.t. rule numbers) *)

implementation

uses YaccBase, YaccTabl;

(* This implementation is based on algorithms 4.12 and 4.13 in Aho/Sethi/
   Ullman 1986 (with some optimizations added), which avoid the need to
   construct the full LR(1) set, and are able to compute lookaheads from
   LR(0) kernel items only.

   We start off with the LR(0) state set together with corresponding (shift
   and goto) transitions already computed. We compute the LALR(1) lookahead
   sets for kernel items and also record all corresponding reduce actions
   in the reduction table (where we also have to consider nonkernel items
   with empty right-hand side; these items also call for a reduction, but
   never appear in the kernel item table).

   This implementation uses some simple optimizations to speed up the
   algorithm. The lookahead sets are represented by (IntSet) pointers.
   Lookahead sets are associated with each kernel item in the item table,
   and with each reduction in the reduction table. A kernel item
   calling for a reduction shares its lookahead set pointer with the
   corresponding entry in the reduction table. The lookahead set for
   a nonkernel reduction item (item with empty right-hand side) only
   appears in the reduction table.

   The algorithm consists of two phases:

   1. Initialization:

      The initialization phase consists of a single traversal of the LR(0)
      set, where we compute lookahead sets generated spontaneously (lookaheads
      which are passed on from nonkernel items to the corresponding items in
      successor states), initialize lookahead sets and enter them into the
      lookahead and reduction table. Furthermore, during the initialization
      phase we also initialize the links for the propagation of lookaheads
      in the second phase.

      To determine lookaheads and propagation links, we compute the look-
      aheads for the closures of single LR(0) sets "in the small", according
      to the method in Aho/Sethi/Ullman 1986 (with some modifications),
      where we associate with each kernel item i a corresponding endmarker
      symbol #i as its lookahead symbol.

      The initialization phase proceeds as follows:

      1) Initialize all nonkernel item lookahead sets to empty.

      Now we pass over each state s in the LR0 set, repeating steps 2) thru
      5) specified below:

      2) Compute the closure closure(K(s)) of the states's kernel set K(s).

      3) Compute the lookahead sets for closure(K(s)) (described in detail
	 below) where each kernel item i is associated with a special
	 endmarker symbol #i as lookahead.

      Now the lookahead symbols, reductions and propagation links are entered
      into the corresponding tables as follows:

      4) Process kernel items: Add a propagation link from the kernel item
	 to the lookahead set of the linked item in the corresponding
	 successor state (as specified by the next field). If there is no
	 successor item (kernel item calling for a reduction), add a
	 corresponding entry into the reduction table instead.

      5) Process nonkernel items: find the corresponding kernel item in the
	 successor state which is generated spontaneously from the nonkernel
	 item. Add the spontaneous lookahead symbols (except endmarker
	 symbols) of the nonkernel item determined in step 3) to the kernel
	 item. If the nonkernel item has an empty right-hand side (nonkernel
	 item calling for a reduction), add a corresponding entry into the
	 reduction table instead. Furthermore, for each endmarker symbol
	 #i in the spontaneous lookahead set of the nonkernel item, add
	 a corresponding propagation link from the ith kernel item to the
	 lookahead set of the spontaneous kernel item.

      To compute the spontaneous lookaheads (step 3)), we proceed as follows:

      3a) First compute the first sets of tail strings of all items in
	  closure(K(s)). The "tail string" of an item [ X -> v.Yw ], where
	  Y is a nonterminal, is the symbol sequence w, whose first set
	  induces corresponding spontaneous lookaheads in the nonkernel
	  items of the state with left-hand side Y; note that the first
	  sets of "tail strings" in items [ X -> v.yw ], where y is a
	  *terminal* symbol, are not required and hence it is not
	  necessary to compute them. We also record for each item whether
	  its tail string is "nullable", i.e., may be derived to the empty
	  string. In this case, the item also passes on its own lookaheads,
	  in addition to the first symbols of its tail string. First sets
	  and nullable flags are computed using the information in YaccTable's
	  first and nullable tables.

      3b) Now follows an initialization part in which each item [ X -> v.Yw ]
	  passes on the first symbols of its tail string to the lookahead
	  sets of each corresponding nonkernel item [ Y -> .u ].

      3c) Finally, we repeatedly pass over the item set, passing on
	  lookaheads from items with nullable tail strings. Each item
	  [ X -> v.Yw ] with nullable w propagates its own lookaheads to
	  all corresponding nonkernel items [ Y -> .u]. Step 3c) terminates
	  as soon as no lookahead sets have been modified during the previous
	  pass.

   2. Propagation:

      The second phase of the lookahead computation algorithm now is quite
      simple. We repeatedly pass over all kernel items, propagating lookaheads
      according to the propagation links determined in the initialization
      phase. The algorithm terminates as soon as no lookahead sets have been
      modified during the previous pass. *)

(* Data structures used in lookahead computation: *)

type

SymSetArray = array [1..max_set_items] of IntSet;
BoolArray   = array [1..max_set_items] of Boolean;

var

item_set       : ItemSet;
lookahead_set  : SymSetArray;
n_kernel_items : Integer;

procedure spontaneous_lookaheads;

  (* compute spontaneous lookaheads for item_set; negative symbols are
     used for endmarkers (-i denotes endmarker #i) *)

  var count, last_count, i : Integer;
      first_syms : SymSetArray;
      nullable : BoolArray;

  function sym_count ( n : Integer ) : Integer;
    (* count lookahead symbols *)
    var count, i : Integer;
    begin
      count := 0;
      for i := 1 to n do
	inc(count, size(lookahead_set[i]));
      sym_count := count;
    end(*sym_count*);

  procedure compute_first_syms ( i : Integer );
    (* compute first set and nullable flag for tail string of item
       number i *)
    var j : Integer;
    begin
      empty(first_syms[i]); nullable[i] := true;
      with item_set, item[i], rule_table^[rule_no]^ do
	if (pos_no<=rhs_len) and (rhs_sym[pos_no]<0) then
	  begin
	    j := pos_no+1;
	    while (j<=rhs_len) and nullable[i] do
	      begin
		if rhs_sym[j]<0 then
		  begin
		    setunion(first_syms[i], first_set_table^[-rhs_sym[j]]^);
		    nullable[i] := YaccTabl.nullable^[-rhs_sym[j]];
		  end
		else
		  begin
		    include(first_syms[i], rhs_sym[j]);
		    nullable[i] := false;
		  end;
		inc(j);
	      end;
	  end;
    end(*compute_first_syms*);

  procedure init_lookaheads ( i : Integer );
    (* compute initial lookaheads induced by first sets of tail string
       of item i *)
    var sym, j : Integer;
    begin
      with item_set, item[i], rule_table^[rule_no]^ do
	if (pos_no<=rhs_len) and (rhs_sym[pos_no]<0) then
	  begin
	    sym := rhs_sym[pos_no];
	    for j := n_kernel_items+1 to n_items do
	      with item[j], rule_table^[rule_no]^ do
		if lhs_sym=sym then
		  setunion(lookahead_set[j], first_syms[i]);
	  end
    end(*initial_lookaheads*);

  procedure propagate ( i : Integer );
    (* propagate lookahead symbols of item i *)
    var sym, j : Integer;
    begin
      with item_set, item[i], rule_table^[rule_no]^ do
	if (pos_no<=rhs_len) and (rhs_sym[pos_no]<0) and nullable[i] then
	  begin
	    sym := rhs_sym[pos_no];
	    for j := n_kernel_items+1 to n_items do
	      with item[j], rule_table^[rule_no]^ do
		if lhs_sym=sym then
		  setunion(lookahead_set[j], lookahead_set[i]);
	  end
    end(*propagate*);

  begin(*spontaneous_lookaheads*)
    with item_set do
      begin
	(* initialize kernel lookahead sets: *)
	for i := 1 to n_kernel_items do singleton(lookahead_set[i], -i);
	(* compute first sets and nullable flags: *)
	for i := 1 to n_items do compute_first_syms(i);
	(* initialize nonkernel lookahead sets: *)
	for i := n_kernel_items+1 to n_items do empty(lookahead_set[i]);
	for i := 1 to n_items do init_lookaheads(i);
	(* repeated passes until no more lookaheads have been added
	   during the previous pass: *)
	count := sym_count(n_items);
	repeat
	  last_count := count;
	  for i := 1 to n_items do
	    propagate(i);
	  count := sym_count(n_items);
	until last_count=count;
      end;
  end(*spontaneous_lookaheads*);

{$F+}
function redns_less ( i, j : Integer ) : Boolean;
{$F-}
  begin
    redns_less := redn_table^[i].rule_no<redn_table^[j].rule_no
  end(*redns_less*);

{$F+}
procedure redns_swap ( i, j : Integer );
{$F-}
  var x : RednRec;
  begin
    x := redn_table^[i];
    redn_table^[i] := redn_table^[j];
    redn_table^[j] := x;
  end(*redns_swap*);

procedure sort_redns;
  (* sort reduction entries in act_state w.r.t. rule numbers *)
  begin
    with state_table^[act_state] do
      quicksort(redns_lo, redns_hi, redns_less, redns_swap);
  end(*sort_redns*);

procedure initialize;

  (* initialization phase of lookahead computation algorithm *)

  procedure add_prop ( i : Integer; symset : IntSetPtr );
    (* add a propagation link to kernel item i *)
    var prop : PropList;
    begin
      new(prop);
      prop^.symset := symset;
      prop^.next := prop_table^[i];
      prop_table^[i] := prop;
    end(*add_prop*);

  var i, j, k : Integer;
      lookaheads : IntSetPtr;

  begin
    (* initialize lookahead sets and propagation links: *)
    for i := 1 to n_items do lookahead_table^[i] := newEmptyIntSet;
    for i := 1 to n_items do prop_table^[i] := nil;
    act_state := 0;
    repeat
      with state_table^[act_state], item_set do
	begin
	  start_redns;
	  get_item_set(act_state, item_set);
	  n_kernel_items := n_items;
	  (* compute LR(0) closure: *)
	  closure(item_set);
	  (* compute spontaneous lookaheads: *)
	  spontaneous_lookaheads;
	  (* process kernel items: *)
	  for i := 1 to n_kernel_items do with item[i] do
	    if next>0 then
	      (* add propagation link: *)
	      add_prop(item_lo+i-1, lookahead_table^[next])
	    else
	      (* enter reduce action: *)
	      add_redn(lookahead_table^[item_lo+i-1], rule_no);
	  (* process nonkernel items: *)
	  (* find successor items: *)
	  for k := trans_lo to trans_hi do
	    with trans_table^[k] do
	      for i := n_kernel_items+1 to n_items do
		with item[i], rule_table^[rule_no]^ do
		  if pos_no>rhs_len then
		    next := 0
		  else if rhs_sym[pos_no]=sym then
		    next := find_item(next_state, rule_no, pos_no+1);
	  (* add spontaneous lookaheads and propagation links: *)
	  for i := n_kernel_items+1 to n_items do with item[i] do
	    if next>0 then
	      (* lookaheads are generated spontaneously for successor
		 item: *)
	      for j := 1 to size(lookahead_set[i]) do
		if lookahead_set[i][j]>=0 then
		  include(lookahead_table^[next]^, lookahead_set[i][j])
		else
		  add_prop(item_lo+(-lookahead_set[i][j])-1,
			   lookahead_table^[next])
	    else
	      (* nonkernel reduction item: *)
	      begin
		lookaheads := newEmptyIntSet;
		for j := 1 to size(lookahead_set[i]) do
		  if lookahead_set[i][j]>=0 then
		    include(lookaheads^, lookahead_set[i][j])
		  else
		    add_prop(item_lo+(-lookahead_set[i][j])-1,
			     lookaheads);
		add_redn(lookaheads, rule_no);
	      end;
	  end_redns;
	  sort_redns;
	end;
      inc(act_state);
    until act_state=n_states;
  end(*initialize*);

procedure propagate;

  (* propagation phase of lookahead computation algorithm *)

  var i, l : Integer;
      done : Boolean;
      prop : PropList;

  begin
    (* repeated passes over the kernel items table until no more lookaheads
       could be added in the previous pass: *)
    repeat
      done := true;
      for i := 1 to n_items do
	begin
	  prop := prop_table^[i];
	  while prop<>nil do with prop^ do
	    begin
	      l := size(symset^);
	      setunion(symset^, lookahead_table^[i]^);
	      if size(symset^)>l then done := false;
	      prop := next;
	    end;
	end;
    until done;
  end(*propagate*);

procedure lookaheads;
  begin
    initialize;
    propagate;
  end(*lookaheads*);

end(*YaccLookaheads*).
