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