yaccsem.pas

Yacc例子代码

        begin
          write(yyout, act_char);
          next_char;
        end;
  end(*copy_code*);

procedure scan_val;
  (* process a $ value in an action
     (not very pretty, but it does its job) *)
  var tag, numstr : String; i, code : Integer;
  begin
    tokleng := 0;
    next_char;
    if act_char='<' then
      begin
        (* process type tag: *)
        next_char;
        tag := '';
        while (act_char<>nl) and (act_char<>#0) and (act_char<>'>') do
          begin
            tag := tag+act_char;
            next_char;
          end;
        if act_char='>' then
          begin
            if not search_type(tag) then
              begin
                tokleng := length(tag);
                error(unknown_identifier);
              end;
            next_char;
          end
        else
          error(syntax_error);
      end
    else
      tag := '';
    tokleng := 0;
    if act_char='$' then
      begin
        (* left-hand side value: *)
        write(yyout, 'yyval');
        (* check for value type: *)
        if (tag='') and (n_types>0) then with act_rule do
          if sym_type^[lhs_sym]>0 then
            tag := sym_table^[sym_type^[lhs_sym]].pname^
          else
            begin
              tokleng := 1;
              error(type_error);
            end;
        if tag<>'' then write(yyout, '.yy', tag);
        next_char;
      end
    else
      begin
        (* right-hand side value: *)
        if act_char='-' then
          begin
            numstr := '-';
            next_char;
          end
        else
          numstr := '';
        while ('0'<=act_char) and (act_char<='9') do
          begin
            numstr := numstr+act_char;
            next_char;
          end;
        if numstr<>'' then
          begin
            val(numstr, i, code);
            if code=0 then
              if i<=act_rule.rhs_len then
                begin
                  write(yyout, 'yyv[yysp-', act_rule.rhs_len-i, ']');
                  (* check for value type: *)
                  if (tag='') and (n_types>0) then with act_rule do
                    if i<=0 then
                      begin
                        tokleng := length(numstr)+1;
                        error(type_error);
                      end
                    else if sym_type^[rhs_sym[i]]>0 then
                      tag := sym_table^[sym_type^[rhs_sym[i]]].pname^
                    else
                      begin
                        tokleng := length(numstr)+1;
                        error(type_error);
                      end;
                  if tag<>'' then write(yyout, '.yy', tag);
                end
              else
                begin
                  tokleng := length(numstr);
                  error(range_error);
                end
            else
              error(syntax_error)
          end
        else
          error(syntax_error)
      end
  end(*scan_val*);

procedure copy_action;
  var str_state : Boolean;
  begin
    str_state := false;
    while act_char=' ' do next_char;
    write(yyout, ' ':9);
    while act_char<>#0 do
      if act_char=nl then
        begin
          writeln(yyout);
          next_char;
          while act_char=' ' do next_char;
          write(yyout, ' ':9);
        end
      else if act_char='''' then
        begin
          write(yyout, '''');
          str_state := not str_state;
          next_char;
        end
      else if not str_state and (act_char='}') then
        begin
          writeln(yyout);
          exit;
        end
      else if not str_state and (act_char='$') then
        scan_val
      else
        begin
          write(yyout, act_char);
          next_char;
        end;
  end(*copy_action*);

procedure copy_single_action;
  var str_state : Boolean;
  begin
    str_state := false;
    while act_char=' ' do next_char;
    write(yyout, ' ':9);
    while act_char<>#0 do
      if act_char=nl then
        begin
          writeln(yyout);
          next_char;
          while act_char=' ' do next_char;
          write(yyout, ' ':9);
        end
      else if act_char='''' then
        begin
          write(yyout, '''');
          str_state := not str_state;
          next_char;
        end
      else if not str_state and (act_char=';') then
        begin
          writeln(yyout, ';');
          exit;
        end
      else if not str_state and (act_char='$') then
        scan_val
      else
        begin
          write(yyout, act_char);
          next_char;
        end;
  end(*copy_single_action*);

procedure copy_rest_of_file;
  begin
    while act_char<>#0 do
      if act_char=nl then
        begin
          writeln(yyout);
          next_char;
        end
      else
        begin
          write(yyout, act_char);
          next_char;
        end;
  end(*copy_rest_of_file*);

procedure start_rule ( sym : Integer );
  begin
    if n_rules=0 then
      begin
        (* fix start nonterminal of the grammar: *)
        if startnt=0 then startnt := sym;
        (* add augmented start production: *)
        with act_rule do
          begin
            lhs_sym := -1;
            rhs_len := 2;
            rhs_sym[1] := startnt;
            rhs_sym[2] := 0; (* end marker *)
          end;
        add_rule(newRuleRec(act_rule));
      end;
    act_rule.lhs_sym := sym;
  end(*start_rule*);

procedure start_body;
  begin
    act_rule.rhs_len := 0;
    p_act := false;
    writeln(yyout, n_rules:4, ' : begin');
  end(*start_body*);

procedure end_body;
  begin
    if not p_act and (act_rule.rhs_len>0) then
      (* add default action: *)
      writeln(yyout, ' ':9, 'yyval := yyv[yysp-',
                            act_rule.rhs_len-1, '];');
    add_rule(newRuleRec(act_rule));
    writeln(yyout, ' ':7, 'end;');
  end(*end_body*);

procedure add_rule_action;
  (* process an action inside a rule *)
  var k : Integer; r : RuleRec;
  begin
    writeln(yyout, ' ':7, 'end;');
    inc(n_act);
    k := get_key('$$'+intStr(n_act));
    with r do
      begin
        lhs_sym := new_nt;
        def_key(k, lhs_sym);
        rhs_len := 0;
      end;
    with act_rule do
      begin
        inc(rhs_len);
        if rhs_len>max_rule_len then fatal(rule_table_overflow);
        rhs_sym[rhs_len] := r.lhs_sym;
      end;
    add_rule(newRuleRec(r));
    rule_prec^[n_rules+1] := rule_prec^[n_rules];
    rule_prec^[n_rules] := 0;
    writeln(yyout, n_rules:4, ' : begin');
  end(*add_rule_action*);

procedure add_symbol ( sym : Integer );
  begin
    if p_act then add_rule_action;
    p_act := false;
    with act_rule do
      begin
        inc(rhs_len);
        if rhs_len>max_rule_len then fatal(rule_table_overflow);
        rhs_sym[rhs_len] := sym;
        if sym>=0 then rule_prec^[n_rules+1] := sym_prec^[sym]
      end
  end(*add_symbol*);

procedure add_action;
  begin
    if p_act then add_rule_action;
    p_act := true;
  end(*add_action*);

procedure add_rule_prec ( sym : Integer );
  begin
    rule_prec^[n_rules+1] := sym_prec^[sym];
  end(*add_rule_prec*);

procedure generate_parser;
  begin
    if startnt=0 then error(empty_grammar);
    if errors=0 then
      begin
        write('sort ... ');
        sort_rules; rule_offsets;
        write('closures ... ');
        closures;
        write('first sets ... ');
        first_sets;
        write('LR0 set ... ');
        LR0Set;
        write('lookaheads ... ');
        lookaheads;
        writeln;
        write('code generation ... ');
        parse_table;
      end;
  end(*generate_parser*);

begin
  n_act := 0;
end(*YaccSem*).