lexrules.pas

Yacc例子代码

          end(*ident*);
        begin(*start_state_list*)
          ident(done);                     if not done then exit;
          while act_char=',' do
            begin
              get_char;
              ident(done);                 if not done then exit;
            end;
        end(*start_state_list*);
      begin(*start_state_prefix*)
        n_st := 0;
        if act_char='<' then
          begin
            get_char;
            start_state_list(done);        if not done then exit;
            if act_char='>' then
              begin
                done := true;
                get_char;
              end
            else
              done := false
          end
        else
          done := true
      end(*start_state_prefix*);
    procedure caret( var done : Boolean );
      begin(*caret*)
        done := true;
        cf   := act_char='^';
        if act_char='^' then get_char;
      end(*caret*);

  procedure scan_char ( var done : Boolean; var c : Char );
    var
      oct_val : Byte;
      count : Integer;
    begin
      done := true;
      if act_char='\' then
        begin
          get_char;
          case act_char of
            #0  : done := false;
            'n' : begin
                    c := nl;
                    get_char
                  end;
            'r' : begin
                    c := cr;
                    get_char
                  end;
            't' : begin
                    c := tab;
                    get_char
                  end;
            'b' : begin
                    c := bs;
                    get_char
                  end;
            'f' : begin
                    c := ff;
                    get_char
                  end;
            '0'..'7' : begin
                         oct_val := ord(act_char)-ord('0');
                         get_char;
                         count := 1;
                         while ('0'<=act_char) and
                           (act_char<='7') and
                           (count<3) do
                           begin
                             inc(count);
                             oct_val := oct_val*8+ord(act_char)-ord('0');
                             get_char
                           end;
                         c := chr(oct_val);
                       end
            else  begin
                    c := act_char;
                    get_char
                  end
          end
        end
      else
        begin
          c := act_char;
          get_char
        end
    end(*scan_char*);
  procedure scan_str ( var done : Boolean; var str : String );
    var c : Char;
    begin
      str := '';
      get_char;
      while (act_char<>#0) and (act_char<>'"') do
        begin
          scan_char(done, c);        if not done then exit;
          str := str+c;
        end;
      if act_char=#0 then
        done := false
      else
        begin
          get_char;
          done := true;
        end
    end(*scan_str*);
  procedure scan_cclass( var done : Boolean; var cc : CClass );
    (* scan a character class *)
    var
      caret : boolean;
      c, c1,cl : Char;
    begin
      cc := [];
      get_char;
      if act_char='^' then
        begin
          caret := true;
          get_char;
        end
      else
        caret := false;
      while (act_char<>#0) and (act_char<>']') do
        begin
          scan_char(done, c);              if not done then exit;
          if act_char='-' then
            begin
              get_char;
              if (act_char<>#0) and (act_char<>']') then
                begin
                  scan_char(done, c1);     if not done then exit;
                  for cl:=c to c1 do
                    cc:=cc+[cl];
                   {cc := cc+[c..c1];}
                end
              else
                cc := cc+[c,'-'];
            end
          else
            cc := cc+[c];
        end;
      if act_char=#0 then
        done := false
      else
        begin
          get_char;
          done := true;
        end;
      if caret then cc := [#1..#255]-cc;
    end(*scan_cclass*);
  procedure scan_num( var done : Boolean; var n : Integer );
    var str : String;
    begin
      if act_char in digits then
        begin
          str := act_char;
          get_char;
          while act_char in digits do
            begin
              str := str+act_char;
              get_char;
            end;
          done := isInt(str, n);
        end
      else
        done := false
    end(*scan_num*);

    procedure DoExpr ( var done : Boolean; var r : RegExpr );
      procedure term ( var done : Boolean; var r : RegExpr );
        procedure factor ( var done : Boolean; var r : RegExpr );
          var str  : String;
              cc   : CClass;
              c    : Char;
              n, m : Integer;
          begin(*factor*)
            case act_char of
              '"' : begin
                      scan_str(done, str);         if not done then exit;
                      r := strExpr(newStr(str));
                    end;
              '[' : begin
                      scan_cclass(done, cc);       if not done then exit;
                      r := cclassExpr(newCClass(cc));
                    end;
              '.' : begin
                      get_char;
                      r := cclassExpr(newCClass([#1..#255]-[nl]));
                      done := true;
                    end;
              '(' : begin
                      get_char;
                      DoExpr(done, r);               if not done then exit;
                      if act_char=')' then
                        begin
                          get_char;
                          done := true;
                        end
                      else
                        done := false
                    end;
              else  begin
                      scan_char(done, c);          if not done then exit;
                      r := charExpr(c);
                    end;
            end;
            while done and (act_char in ['*','+','?','{']) do
              case act_char of
                '*' : begin
                        get_char;
                        r := starExpr(r);
                      end;
                '+' : begin
                        get_char;
                        r := plusExpr(r);
                      end;
                '?' : begin
                        get_char;
                        r := optExpr(r);
                      end;
                '{' : begin
                        get_char;
                        scan_num(done, m);         if not done then exit;
                        if act_char=',' then
                          begin
                            get_char;
                            scan_num(done, n);     if not done then exit;
                            r := mnExpr(r, m, n);
                          end
                        else
                          r := mnExpr(r, m, m);
                        if act_char='}' then
                          begin
                            get_char;
                            done := true;
                          end
                        else
                          done := false
                      end;
              end
          end(*factor*);
        const term_delim : CClass = [#0,' ',tab,'$','|',')','/'];
        var r1 : RegExpr;
        begin(*term*)
          if not (act_char in term_delim) then
            begin
              factor(done, r);             if not done then exit;
              while not (act_char in term_delim) do
                begin
                  factor(done, r1);        if not done then exit;
                  r := catExpr(r, r1);
                end
            end
          else
            begin
              r := epsExpr;
              done := true;
            end
        end(*term*);
      var r1 : RegExpr;
      begin(*expr*)
        term(done, r);                     if not done then exit;
        while act_char='|' do
          begin
            get_char;
            term(done, r1);                if not done then exit;
            r := altExpr(r, r1);
          end
      end(*expr*);

    var r1, r2 : RegExpr;

    begin(*rule*)
      start_state_prefix(done);            if not done then exit;
      caret(done);                         if not done then exit;
      DoExpr(done, r1);                      if not done then exit;
      if act_char='$' then
        begin
          r := catExpr(catExpr(r1,
                 markExpr(rule_no, 1)),
                 cclassExpr(newCClass([nl])));
          get_char;
        end
      else if act_char='/' then
        begin
          get_char;
          DoExpr(done, r2);                  if not done then exit;
          r := catExpr(catExpr(r1,
                 markExpr(rule_no, 1)), r2);
        end
      else
        r := catExpr(r1, markExpr(rule_no, 1));
      r := catExpr(r, markExpr(rule_no, 0));
      done := (act_char=#0) or (act_char=' ') or (act_char=tab);
    end(*rule*);

  var done : Boolean;

  begin(*parse_rule*)
    init_scanner;
    rule(done);
    if done then
      begin
        expr := copy(line, 1, act_pos-1);
        stmt := copy(line, act_pos, length(line));
      end
    else
      mark_error(syntax_error, 0)
  end(*parse_rule*);

end(*LexRules*).