src/generic/Dev/Mod/CPR.cp

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