yacclook.pas

Yacc例子代码

                  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*);

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

{$ifndef fpc}{$F+}{$endif}
procedure redns_swap ( i, j : Integer );
{$ifndef fpc}{$F-}{$endif}
  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, {$ifdef fpc}@{$endif}redns_less,
		{$ifdef fpc}@{$endif}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*).