DEADSOFTWARE

reimplenet DEFINED as operator
[cpc.git] / src / generic / Dev / Mod / CPR.cp
1 MODULE DevCPR;
3 IMPORT Strings, DevCPM, DevCPT;
5 CONST
6 MaxIdLen = LEN(DevCPT.Name);
8 (* symbol values *)
9 null = 0;
10 if = 1; then = 2; else = 3; elsif = 4; end = 5;
11 new = 6; error = 7; ident = 8; plus = 9; minus = 10;
12 not = 11; and = 12; or = 13; rpar = 14; lpar = 15; defined = 16;
13 endcom = 17; eof = 18;
15 TYPE
16 Context = POINTER TO RECORD
17 next: Context; (* upper level block *)
18 alt: BOOLEAN; (* else branch *)
19 val: BOOLEAN; (* condition value, inverted if alt *)
20 ref: INTEGER (* ELSIF count *)
21 END;
23 Selector = POINTER TO RECORD
24 next: Selector;
25 name: DevCPT.Name;
26 val: BOOLEAN
27 END;
29 VAR
30 ch: CHAR; (* current character *)
31 name: DevCPT.Name; (* ident *)
33 VAR
34 sym: BYTE; (* parser symbol *)
35 fold: INTEGER; (* condition folding *)
36 scope: Selector;
37 top: Context;
39 PROCEDURE err (n: SHORTINT);
40 BEGIN DevCPM.err(n)
41 END err;
43 PROCEDURE Identifier (VAR sym: BYTE);
44 VAR i, res: INTEGER; n: ARRAY MaxIdLen OF CHAR;
45 BEGIN i := 0;
46 REPEAT
47 n[i] := ch; INC(i); DevCPM.Get(ch)
48 UNTIL ~Strings.IsIdent(ch) OR (i = MaxIdLen);
49 IF i = MaxIdLen THEN err(240); DEC(i) END ;
50 n[i] := 0X; Strings.StringToUtf8(n, name, res); sym := ident;
51 IF res = 1 (*truncated*) THEN err(240) END
52 END Identifier;
54 PROCEDURE Get (VAR sym: BYTE);
55 BEGIN
56 DevCPM.errpos := DevCPM.curpos - 1;
57 WHILE (ch # DevCPM.Eot) & ((ch <= " ") OR (ch = 0A0X)) DO DevCPM.Get(ch) END;
58 DevCPM.startpos := DevCPM.curpos - 1;
59 CASE ch OF
60 | DevCPM.Eot: sym := eof
61 | "&": sym := and; DevCPM.Get(ch)
62 | "(": sym := lpar; DevCPM.Get(ch)
63 | ")": sym := rpar; DevCPM.Get(ch)
64 | "*":
65 sym := null; DevCPM.Get(ch);
66 IF ch = ">" THEN sym := endcom; DevCPM.Get(ch) END
67 | "+": sym := plus; DevCPM.Get(ch)
68 | "-": sym := minus; DevCPM.Get(ch)
69 | "D": Identifier(sym); IF name = "DEFINED" THEN sym := defined END
70 | "E": Identifier(sym);
71 IF name = "END" THEN sym := end
72 ELSIF name = "ELSE" THEN sym := else
73 ELSIF name = "ELSIF" THEN sym := elsif
74 ELSIF name = "ERROR" THEN sym := error
75 END
76 | "I": Identifier(sym); IF name = "IF" THEN sym := if END
77 | "N": Identifier(sym); IF name = "NEW" THEN sym := new END
78 | "O": Identifier(sym); IF name = "OR" THEN sym := or END
79 | "T": Identifier(sym); IF name = "THEN" THEN sym := then END
80 | "A".."C", "J".."M", "P".."S", "U".."Z", "a".."z", "_": Identifier(sym)
81 | "~": sym := not; DevCPM.Get(ch)
82 ELSE
83 IF Strings.IsIdent(ch) THEN Identifier(sym) ELSE sym := null; DevCPM.Get(ch) END
84 END
85 END Get;
87 PROCEDURE New (IN name: DevCPT.Name; val: BOOLEAN);
88 VAR s: Selector;
89 BEGIN
90 s := scope;
91 WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
92 IF s.next = NIL THEN NEW(s.next); s.next.name := name$; s.next.val := val
93 ELSE err(1)
94 END
95 END New;
97 PROCEDURE Old (IN name: DevCPT.Name): Selector;
98 VAR s: Selector;
99 BEGIN
100 s := scope;
101 WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
102 IF s.next = NIL THEN
103 err(0); NEW(s.next); s.next.name := name$; s.next.val := FALSE
104 END;
105 RETURN s.next
106 END Old;
108 PROCEDURE Find (IN name: DevCPT.Name): Selector;
109 VAR s: Selector;
110 BEGIN
111 s := scope;
112 WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
113 RETURN s.next
114 END Find;
116 PROCEDURE Set* (IN name: DevCPT.Name; val: BOOLEAN);
117 VAR s: Selector;
118 BEGIN
119 s := scope;
120 WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
121 IF s.next = NIL THEN NEW(s.next) END;
122 s.next.name := name$; s.next.val := val
123 END Set;
125 PROCEDURE ^ Expression (VAR x: BOOLEAN);
127 PROCEDURE Factor (VAR x: BOOLEAN);
128 BEGIN
129 IF sym = ident THEN
130 x := Old(name).val; Get(sym);
131 ELSIF sym = defined THEN
132 Get(sym);
133 IF sym = lpar THEN
134 Get(sym);
135 IF sym = ident THEN
136 x := Find(name) # NIL;
137 Get(sym)
138 ELSE err(48)
139 END;
140 IF sym # rpar THEN err(23)
141 ELSE Get(sym)
142 END
143 ELSE err(40)
144 END
145 ELSIF sym = lpar THEN
146 Get(sym); Expression(x);
147 IF sym # rpar THEN err(23)
148 ELSE Get(sym)
149 END
150 ELSIF sym = not THEN
151 Get(sym); Factor(x); x := ~x
152 ELSE
153 x := FALSE;
154 err(13)
155 END
156 END Factor;
158 PROCEDURE Term (VAR x: BOOLEAN);
159 VAR y: BOOLEAN;
160 BEGIN
161 Factor(x);
162 WHILE sym = and DO
163 Get(sym); Factor(y); x := x & y
164 END
165 END Term;
167 PROCEDURE Expression (VAR x: BOOLEAN);
168 VAR y: BOOLEAN;
169 BEGIN
170 Term(x);
171 WHILE sym = or DO
172 Get(sym); Term(y); x := x OR y
173 END
174 END Expression;
176 PROCEDURE If (cond: BOOLEAN);
177 VAR c: Context;
178 BEGIN
179 NEW(c); c.next := top; c.alt := FALSE; c.val := cond; c.ref := 0; top := c;
180 INC(fold)
181 END If;
183 PROCEDURE Else;
184 BEGIN
185 IF top.alt THEN err(14) (* double ELSE *)
186 ELSE top.alt := TRUE; top.val := ~top.val;
187 END
188 END Else;
190 PROCEDURE End;
191 VAR i, ref: INTEGER;
192 BEGIN
193 i := 0; ref := top.ref; DEC(fold, ref + 1);
194 WHILE (top # NIL) & (i <= ref) DO top := top.next; INC(i) END;
195 IF top = NIL THEN err(51); fold := 0; If(TRUE) END
196 END End;
198 PROCEDURE Printable* (): BOOLEAN;
199 VAR c: Context;
200 BEGIN
201 c := top;
202 WHILE (c # NIL) & c.val DO c := c.next END;
203 RETURN c = NIL
204 END Printable;
206 PROCEDURE Parse*;
207 VAR val: BOOLEAN;
208 BEGIN
209 Get(sym);
210 IF sym = new THEN
211 Get(sym);
212 IF sym = ident THEN New(name, FALSE); Get(sym)
213 ELSE err(48)
214 END
215 ELSIF sym = error THEN
216 IF Printable() THEN err(501) END; Get(sym)
217 ELSIF sym = ident THEN
218 Get(sym);
219 IF sym = plus THEN Old(name).val := TRUE; Get(sym)
220 ELSIF sym = minus THEN Old(name).val := FALSE; Get(sym)
221 ELSE err(41)
222 END
223 ELSIF sym = if THEN
224 Get(sym); Expression(val); If(val);
225 IF sym = then THEN Get(sym)
226 ELSE err(27)
227 END
228 ELSIF sym = elsif THEN
229 IF fold <= 1 THEN err(14) END; (* ELSIF without IF *)
230 Else; Get(sym); Expression(val); If(val); INC(top.ref);
231 IF sym = then THEN Get(sym)
232 ELSE err(27)
233 END
234 ELSIF sym = else THEN
235 IF fold <= 1 THEN err(14) END; (* ELSE without IF *)
236 Else; Get(sym)
237 ELSIF sym = end THEN
238 IF fold <= 1 THEN err(14) END; (* END without IF *)
239 End; Get(sym)
240 ELSE
241 err(14)
242 END;
243 IF sym # endcom THEN err(5) ELSE DevCPM.errpos := DevCPM.curpos - 1 END
244 END Parse;
246 PROCEDURE Check*;
247 BEGIN
248 IF fold # 1 THEN err(14) END
249 END Check;
251 PROCEDURE Close*;
252 BEGIN
253 ch := " "; sym := eof; name := "";
254 fold := 0; top := NIL; scope := NIL
255 END Close;
257 PROCEDURE Init*;
258 VAR s: Selector;
259 BEGIN
260 Close;
261 If(TRUE);
262 NEW(scope);
263 New("TRUE", TRUE);
264 New("FALSE", FALSE)
265 END Init;
267 END DevCPR.