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; new = 6;
  11     ident = 7; plus = 8; minus = 9;
  12     not = 10; and = 11; or = 12; rpar = 13; lpar = 14;
  13     endcom = 15; eof = 16;
  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
  39   PROCEDURE err (n: SHORTINT);
  40   BEGIN DevCPM.err(n)
  41   END err;
  42
  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;
  53
  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     | "E": Identifier(sym);
  70         IF name = "END" THEN sym := end
  71         ELSIF name = "ELSE" THEN sym := else
  72         ELSIF name = "ELSIF" THEN sym := elsif
  73         END
  74     | "I": Identifier(sym); IF name = "IF" THEN sym := if END
  75     | "N": Identifier(sym); IF name = "NEW" THEN sym := new END
  76     | "O": Identifier(sym); IF name = "OR" THEN sym := or END
  77     | "T": Identifier(sym); IF name = "THEN" THEN sym := then END
  78     | "A".."D", "J".."M", "P".."S", "U".."Z", "a".."z", "_": Identifier(sym)
  79     | "~": sym := not; DevCPM.Get(ch)
  80     ELSE
  81       IF Strings.IsIdent(ch) THEN Identifier(sym) ELSE sym := null; DevCPM.Get(ch) END
  82     END
  83   END Get;
  84
  85   PROCEDURE New (IN name: DevCPT.Name; val: BOOLEAN);
  86     VAR s: Selector;
  87   BEGIN
  88     s := scope;
  89     WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
  90     IF s.next = NIL THEN NEW(s.next); s.next.name := name$; s.next.val := val
  91     ELSE err(1)
  92     END
  93   END New;
  94
  95   PROCEDURE Old (IN name: DevCPT.Name): Selector;
  96     VAR s: Selector;
  97   BEGIN
  98     s := scope;
  99     WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
 100     IF s.next = NIL THEN
 101       err(0); NEW(s.next); s.next.name := name$; s.next.val := FALSE
 102     END;
 103     RETURN s.next
 104   END Old;
 105
 106   PROCEDURE Find (IN name: DevCPT.Name): Selector;
 107     VAR s: Selector;
 108   BEGIN
 109     s := scope;
 110     WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
 111     RETURN s.next
 112   END Find;
 113
 114   PROCEDURE Set* (IN name: DevCPT.Name; val: BOOLEAN);
 115     VAR s: Selector;
 116   BEGIN
 117     s := scope;
 118     WHILE (s.next # NIL) & (s.next.name$ # name$) DO s := s.next END;
 119     IF s.next = NIL THEN NEW(s.next); s.next.name := name$; s.next.val := val END
 120   END Set;
 121
 122   PROCEDURE ^ Expression (VAR x: BOOLEAN);
 123
 124   PROCEDURE Factor (VAR x: BOOLEAN);
 125   BEGIN x := FALSE;
 126     IF sym = ident THEN
 127       x := Old(name).val; Get(sym)
 128     ELSIF sym = lpar THEN
 129       Get(sym); Expression(x);
 130       IF sym # rpar THEN err(23)
 131       ELSE Get(sym)
 132       END
 133     ELSIF sym = not THEN
 134       Get(sym); Factor(x); x := ~x
 135     ELSE
 136       err(13)
 137     END
 138   END Factor;
 139
 140   PROCEDURE Term (VAR x: BOOLEAN);
 141     VAR y: BOOLEAN;
 142   BEGIN
 143     Factor(x);
 144     WHILE sym = and DO
 145       Get(sym); Factor(y); x := x & y
 146     END
 147   END Term;
 148
 149   PROCEDURE Expression (VAR x: BOOLEAN);
 150     VAR y: BOOLEAN;
 151   BEGIN
 152     Term(x);
 153     WHILE sym = or DO
 154       Get(sym); Term(y); x := x OR y
 155     END
 156   END Expression;
 157
 158   PROCEDURE If (cond: BOOLEAN);
 159     VAR c: Context;
 160   BEGIN
 161     NEW(c); c.next := top; c.alt := FALSE; c.val := cond; c.ref := 0; top := c;
 162     INC(fold)
 163   END If;
 164
 165   PROCEDURE Else;
 166   BEGIN
 167     IF top.alt THEN err(14) (* double ELSE *)
 168     ELSE top.alt := TRUE; top.val := ~top.val;
 169     END
 170   END Else;
 171
 172   PROCEDURE End;
 173     VAR i, ref: INTEGER;
 174   BEGIN
 175     i := 0; ref := top.ref; DEC(fold, ref + 1);
 176     WHILE (top # NIL) & (i <= ref) DO top := top.next; INC(i) END;
 177     IF top = NIL THEN err(51); fold := 0; If(TRUE) END
 178   END End;
 179
 180   PROCEDURE Parse*;
 181     VAR val: BOOLEAN;
 182   BEGIN
 183     Get(sym);
 184     IF sym = new THEN
 185       Get(sym);
 186       IF sym = ident THEN New(name, FALSE); Get(sym)
 187       ELSE err(48)
 188       END
 189     ELSIF sym = ident THEN
 190       Get(sym);
 191       IF sym = plus THEN Old(name).val := TRUE; Get(sym)
 192       ELSIF sym = minus THEN Old(name).val := FALSE; Get(sym)
 193       ELSE err(41)
 194       END
 195     ELSIF sym = if THEN
 196       Get(sym); Expression(val); If(val);
 197       IF sym = then THEN Get(sym)
 198       ELSE err(27)
 199       END
 200     ELSIF sym = elsif THEN
 201       IF fold <= 1 THEN err(14) END; (* ELSIF without IF *)
 202       Else; Get(sym); Expression(val); If(val); INC(top.ref);
 203       IF sym = then THEN Get(sym)
 204       ELSE err(27)
 205       END
 206     ELSIF sym = else THEN
 207       IF fold <= 1 THEN err(14) END; (* ELSE without IF *)
 208       Else; Get(sym)
 209     ELSIF sym = end THEN
 210       IF fold <= 1 THEN err(14) END; (* END without IF *)
 211       End; Get(sym)
 212     ELSE
 213       err(14)
 214     END;
 215     IF sym # endcom THEN err(5) ELSE DevCPM.errpos := DevCPM.curpos - 1 END
 216   END Parse;
 217
 218   PROCEDURE Printable* (): BOOLEAN;
 219     VAR c: Context;
 220   BEGIN
 221     c := top;
 222     WHILE (c # NIL) & c.val DO c := c.next END;
 223     RETURN c = NIL
 224   END Printable;
 225
 226   PROCEDURE Check*;
 227   BEGIN
 228     IF fold # 1 THEN err(14) END
 229   END Check;
 230
 231   PROCEDURE Close*;
 232   BEGIN
 233     ch := " "; sym := eof; name := "";
 234     fold := 0; top := NIL; scope := NIL
 235   END Close;
 236
 237   PROCEDURE Init*;
 238   BEGIN
 239     Close;
 240     If(TRUE);
 241     NEW(scope);
 242     New("TRUE", TRUE);
 243     New("FALSE", FALSE)
 244   END Init;
 245
 246 END DevCPR.