DEADSOFTWARE

DswProcs: add function Directory.GetPath
[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;
38 skip-: BOOLEAN;
40 PROCEDURE err (n: SHORTINT);
41 BEGIN DevCPM.err(n)
42 END err;
44 PROCEDURE Identifier (VAR sym: BYTE);
45 VAR i, res: INTEGER; n: ARRAY MaxIdLen OF CHAR;
46 BEGIN i := 0;
47 REPEAT
48 n[i] := ch; INC(i); DevCPM.Get(ch)
49 UNTIL ~Strings.IsIdent(ch) OR (i = MaxIdLen);
50 IF i = MaxIdLen THEN err(240); DEC(i) END ;
51 n[i] := 0X; Strings.StringToUtf8(n, name, res); sym := ident;
52 IF res = 1 (*truncated*) THEN err(240) END
53 END Identifier;
55 PROCEDURE Get (VAR sym: BYTE);
56 BEGIN
57 DevCPM.errpos := DevCPM.curpos - 1;
58 WHILE (ch # DevCPM.Eot) & ((ch <= " ") OR (ch = 0A0X)) DO DevCPM.Get(ch) END;
59 DevCPM.startpos := DevCPM.curpos - 1;
60 CASE ch OF
61 | DevCPM.Eot: sym := eof
62 | "&": sym := and; DevCPM.Get(ch)
63 | "(": sym := lpar; DevCPM.Get(ch)
64 | ")": sym := rpar; DevCPM.Get(ch)
65 | "*":
66 sym := null; DevCPM.Get(ch);
67 IF ch = ">" THEN sym := endcom; DevCPM.Get(ch) END
68 | "+": sym := plus; DevCPM.Get(ch)
69 | "-": sym := minus; DevCPM.Get(ch)
70 | "D": Identifier(sym); IF name = "DEFINED" THEN sym := defined END
71 | "E": Identifier(sym);
72 IF name = "END" THEN sym := end
73 ELSIF name = "ELSE" THEN sym := else
74 ELSIF name = "ELSIF" THEN sym := elsif
75 ELSIF name = "ERROR" THEN sym := error
76 END
77 | "I": Identifier(sym); IF name = "IF" THEN sym := if END
78 | "N": Identifier(sym); IF name = "NEW" THEN sym := new END
79 | "O": Identifier(sym); IF name = "OR" THEN sym := or END
80 | "T": Identifier(sym); IF name = "THEN" THEN sym := then END
81 | "A".."C", "J".."M", "P".."S", "U".."Z", "a".."z", "_": Identifier(sym)
82 | "~": sym := not; DevCPM.Get(ch)
83 ELSE
84 IF Strings.IsIdent(ch) THEN Identifier(sym) ELSE sym := null; DevCPM.Get(ch) END
85 END
86 END Get;
88 PROCEDURE New (IN name: DevCPT.Name): Selector;
89 VAR s: Selector;
90 BEGIN
91 s := scope;
92 WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
93 IF s.next = NIL THEN NEW(s.next); s.next.name := name$; s.next.val := FALSE
94 ELSE err(1)
95 END;
96 RETURN s.next
97 END New;
99 PROCEDURE Old (IN name: DevCPT.Name): Selector;
100 VAR s: Selector;
101 BEGIN
102 s := scope;
103 WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
104 IF s.next = NIL THEN
105 err(0); NEW(s.next); s.next.name := name$; s.next.val := FALSE
106 END;
107 RETURN s.next
108 END Old;
110 PROCEDURE Find (IN name: DevCPT.Name): Selector;
111 VAR s: Selector;
112 BEGIN
113 s := scope;
114 WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
115 RETURN s.next
116 END Find;
118 PROCEDURE Set* (IN name: DevCPT.Name; val: BOOLEAN);
119 VAR s: Selector;
120 BEGIN
121 s := scope;
122 WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
123 IF s.next = NIL THEN NEW(s.next) END;
124 s.next.name := name$; s.next.val := val
125 END Set;
127 PROCEDURE ^ Expression (VAR x: BOOLEAN; use: BOOLEAN);
129 PROCEDURE Factor (VAR x: BOOLEAN; use: BOOLEAN);
130 BEGIN
131 x := FALSE;
132 IF sym = ident THEN
133 IF use THEN x := Old(name).val END; Get(sym);
134 ELSIF sym = defined THEN
135 Get(sym);
136 IF sym = lpar THEN
137 Get(sym);
138 IF sym = ident THEN
139 IF use THEN x := Find(name) # NIL END;
140 Get(sym)
141 ELSE err(48)
142 END;
143 IF sym # rpar THEN err(23)
144 ELSE Get(sym)
145 END
146 ELSE err(40)
147 END
148 ELSIF sym = lpar THEN
149 Get(sym); Expression(x, use);
150 IF sym # rpar THEN err(23)
151 ELSE Get(sym)
152 END
153 ELSIF sym = not THEN
154 Get(sym); Factor(x, use); IF use THEN x := ~x END
155 ELSE
156 err(13)
157 END
158 END Factor;
160 PROCEDURE Term (VAR x: BOOLEAN; use: BOOLEAN);
161 VAR y: BOOLEAN;
162 BEGIN
163 Factor(x, use);
164 WHILE sym = and DO
165 Get(sym); Factor(y, use & x); IF use & x THEN x := x & y END
166 END
167 END Term;
169 PROCEDURE Expression (VAR x: BOOLEAN; use: BOOLEAN);
170 VAR y: BOOLEAN;
171 BEGIN
172 Term(x, use);
173 WHILE sym = or DO
174 Get(sym); Term(y, use & ~x); IF use & ~x THEN x := x OR y END
175 END
176 END Expression;
178 PROCEDURE Printable (): BOOLEAN;
179 VAR c: Context;
180 BEGIN
181 c := top;
182 WHILE (c # NIL) & c.val DO c := c.next END;
183 RETURN c = NIL
184 END Printable;
186 PROCEDURE If (cond: BOOLEAN);
187 VAR c: Context;
188 BEGIN
189 NEW(c); c.next := top; c.alt := FALSE; c.val := cond; c.ref := 0; top := c;
190 INC(fold); skip := ~Printable()
191 END If;
193 PROCEDURE Else;
194 BEGIN
195 IF top.alt THEN err(14) (* double ELSE *)
196 ELSE top.alt := TRUE; top.val := ~top.val; skip := ~Printable()
197 END
198 END Else;
200 PROCEDURE End;
201 VAR i, ref: INTEGER;
202 BEGIN
203 i := 0; ref := top.ref; DEC(fold, ref + 1);
204 WHILE (top # NIL) & (i <= ref) DO top := top.next; INC(i) END;
205 IF top = NIL THEN err(51); fold := 0; If(TRUE) END;
206 skip := ~Printable()
207 END End;
209 PROCEDURE Parse*;
210 VAR val: BOOLEAN; s: Selector; use: BOOLEAN;
211 BEGIN
212 ch := " "; Get(sym); use := ~skip;
213 IF sym = new THEN
214 Get(sym);
215 IF sym = ident THEN
216 IF use THEN s := New(name) END; Get(sym);
217 IF (sym = plus) OR (sym = minus) THEN
218 IF use THEN s.val := sym = plus END; Get(sym)
219 END
220 ELSE err(48)
221 END
222 ELSIF sym = ident THEN
223 IF use THEN s := Old(name) END; Get(sym);
224 IF (sym = plus) OR (sym = minus) THEN
225 IF use THEN s.val := sym = plus END; Get(sym)
226 ELSE err(41)
227 END
228 ELSIF sym = error THEN
229 IF use THEN err(501) END; Get(sym)
230 ELSIF sym = if THEN
231 Get(sym); Expression(val, use); If(val);
232 IF sym = then THEN Get(sym)
233 ELSE err(27)
234 END
235 ELSIF sym = elsif THEN
236 IF fold <= 1 THEN err(14) END; (* ELSIF without IF *)
237 Else; Get(sym); Expression(val, use); If(val); INC(top.ref);
238 IF sym = then THEN Get(sym)
239 ELSE err(27)
240 END
241 ELSIF sym = else THEN
242 IF fold <= 1 THEN err(14) END; (* ELSE without IF *)
243 Else; Get(sym)
244 ELSIF sym = end THEN
245 IF fold <= 1 THEN err(14) END; (* END without IF *)
246 End; Get(sym)
247 ELSE
248 err(14)
249 END;
250 IF sym # endcom THEN err(5) ELSE DevCPM.errpos := DevCPM.curpos - 1 END
251 END Parse;
253 PROCEDURE Check*;
254 BEGIN
255 IF fold # 1 THEN err(14) END
256 END Check;
258 PROCEDURE Close*;
259 BEGIN
260 ch := " "; sym := eof; name := "";
261 fold := 0; top := NIL; scope := NIL;
262 skip := FALSE
263 END Close;
265 PROCEDURE Init*;
266 VAR s: Selector;
267 BEGIN
268 Close;
269 If(TRUE);
270 NEW(scope);
271 Set("TRUE", TRUE);
272 Set("FALSE", FALSE)
273 END Init;
275 END DevCPR.