← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to utils/tply/lexpos.pas

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2001-08-29 23:15:17 UTC
  • Revision ID: james.westby@ubuntu.com-20010829231517-thxsp7ctuab584ia
Tags: upstream-1.0.4
Import upstream version 1.0.4

Show diffs side-by-side

added added

removed removed

Lines of Context:
utils/tply/lexpos.pas
 
1
{
 
2
  Construct the position table, as well as first position sets.
 
3
 
 
4
  The position table stores symbol positions in regular expressions of
 
5
  the Lex grammar. It also allows to store the corresponding first
 
6
  and follow sets. By this means, the position table represents an eps-
 
7
  free nondeterministic automaton for the regular expressions of the
 
8
  Lex grammar (cf. Aho/Sethi/Ullman, Compilers : Principles, Techniques
 
9
  and Tools, 1986, Section 3.9, on constructing NFA's from regular
 
10
  expressions using position tables).
 
11
 
 
12
 
 
13
  Copyright (c) 1990-92  Albert Graef <ag@muwiinfa.geschichte.uni-mainz.de>
 
14
  Copyright (C) 1996     Berend de Boer <berend@pobox.com>
 
15
 
 
16
  This program is free software; you can redistribute it and/or modify
 
17
  it under the terms of the GNU General Public License as published by
 
18
  the Free Software Foundation; either version 2 of the License, or
 
19
  (at your option) any later version.
 
20
 
 
21
  This program is distributed in the hope that it will be useful,
 
22
  but WITHOUT ANY WARRANTY; without even the implied warranty of
 
23
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
24
  GNU General Public License for more details.
 
25
 
 
26
  You should have received a copy of the GNU General Public License
 
27
  along with this program; if not, write to the Free Software
 
28
  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
29
 
 
30
 
 
31
$Revision: 1.1 $
 
32
$Modtime: 96-08-01 6:30 $
 
33
 
 
34
$History: LEXPOS.PAS $
 
35
 * 
 
36
 * *****************  Version 2  *****************
 
37
 * User: Berend       Date: 96-10-10   Time: 21:16
 
38
 * Updated in $/Lex and Yacc/tply
 
39
 * Updated for protected mode, windows and Delphi 1.X and 2.X.
 
40
 
 
41
}
 
42
 
 
43
 
 
44
unit LexPos;
 
45
 
 
46
 
 
47
interface
 
48
 
 
49
uses LexBase, LexTable;
 
50
 
 
51
 
 
52
procedure addExpr(r : RegExpr; var FIRST : IntSet);
 
53
  (* Add the positions in r to the position table, and return the set of
 
54
     first positions of r. *)
 
55
 
 
56
implementation
 
57
 
 
58
procedure eval(r : RegExpr;
 
59
               var FIRST, LAST : IntSet;
 
60
               var nullable : Boolean);
 
61
  (* Evaluates the expression r, adding the positions in r to the position
 
62
     table and assigning FIRST, LAST and FOLLOW sets accordingly (cf. Aho/
 
63
     Sethi/Ullman, Compilers : Principles, Techniques and Tools, Section 3.9).
 
64
     Returns:
 
65
     - FIRST: the set of first positions in r
 
66
     - LAST: the set of last positions in r
 
67
     - nullable: denotes whether the r is nullable (i.e. is matched by the
 
68
       empty string). *)
 
69
  var
 
70
    c : Char;
 
71
    str : StrPtr;
 
72
    cc : CClassPtr;
 
73
    rule, pos : Integer;
 
74
    r1, r2 : RegExpr;
 
75
    FIRST1, LAST1 : IntSet;
 
76
    nullable1 : Boolean;
 
77
    i : integer;
 
78
  begin
 
79
    if is_epsExpr(r) then
 
80
      begin
 
81
        empty(FIRST); empty(LAST);
 
82
        nullable := true
 
83
      end
 
84
    else if is_markExpr(r, rule, pos) then
 
85
      begin
 
86
        addMarkPos(rule, pos);
 
87
        singleton(FIRST, n_pos); singleton(LAST, n_pos);
 
88
        nullable := true
 
89
      end
 
90
    else if is_charExpr(r, c) then
 
91
      begin
 
92
        addCharPos(c);
 
93
        singleton(FIRST, n_pos); singleton(LAST, n_pos);
 
94
        nullable := false
 
95
      end
 
96
    else if is_strExpr(r, str) then
 
97
      if length(str^)=0 then
 
98
        (* empty string is treated as empty expression *)
 
99
        begin
 
100
          empty(FIRST); empty(LAST);
 
101
          nullable := true
 
102
        end
 
103
      else
 
104
        begin
 
105
          addCharPos(str^[1]);
 
106
          singleton(FIRST, n_pos);
 
107
          for i := 2 to length(str^) do
 
108
            begin
 
109
              addCharPos(str^[i]);
 
110
              singleton(pos_table^[pred(n_pos)].follow_pos^, n_pos);
 
111
            end;
 
112
          singleton(LAST, n_pos);
 
113
          nullable := false
 
114
        end
 
115
    else if is_CClassExpr(r, cc) then
 
116
      begin
 
117
        addCClassPos(cc);
 
118
        singleton(FIRST, n_pos); singleton(LAST, n_pos);
 
119
        nullable := false
 
120
      end
 
121
    else if is_starExpr(r, r1) then
 
122
      begin
 
123
        eval(r1, FIRST, LAST, nullable);
 
124
        for i := 1 to size(LAST) do
 
125
          setunion(pos_table^[LAST[i]].follow_pos^, FIRST);
 
126
        nullable := true
 
127
      end
 
128
    else if is_plusExpr(r, r1) then
 
129
      begin
 
130
        eval(r1, FIRST, LAST, nullable);
 
131
        for i := 1 to size(LAST) do
 
132
          setunion(pos_table^[LAST[i]].follow_pos^, FIRST);
 
133
      end
 
134
    else if is_optExpr(r, r1) then
 
135
      begin
 
136
        eval(r1, FIRST, LAST, nullable);
 
137
        nullable := true
 
138
      end
 
139
    else if is_catExpr(r, r1, r2) then
 
140
      begin
 
141
        eval(r1, FIRST, LAST1, nullable);
 
142
        eval(r2, FIRST1, LAST, nullable1);
 
143
        for i := 1 to size(LAST1) do
 
144
          setunion(pos_table^[LAST1[i]].follow_pos^, FIRST1);
 
145
        if nullable then setunion(FIRST, FIRST1);
 
146
        if nullable1 then setunion(LAST, LAST1);
 
147
        nullable := nullable and nullable1
 
148
      end
 
149
    else if is_altExpr(r, r1, r2) then
 
150
      begin
 
151
        eval(r1, FIRST, LAST, nullable);
 
152
        eval(r2, FIRST1, LAST1, nullable1);
 
153
        setunion(FIRST, FIRST1);
 
154
        setunion(LAST, LAST1);
 
155
        nullable := nullable or nullable1
 
156
      end
 
157
  end(*eval*);
 
158
 
 
159
procedure addExpr(r : RegExpr; var FIRST : IntSet);
 
160
  var LAST : IntSet;
 
161
      nullable : Boolean;
 
162
  begin
 
163
    eval(r, FIRST, LAST, nullable);
 
164
  end(*addExpr*);
 
165
 
 
166
end(*LexPos*).
 
 
b'\\ No newline at end of file'