src/generic/Dsw/Mod/Opts.cp

   1 MODULE DswOpts;
   2
   3   IMPORT Kernel, Log;
   4
   5   CONST
   6     (* symbol *)
   7     null* = 0; opt* = 1; char* = 2; string* = 3; ident* = 4; eos* = 5; eof* = 6;
   8
   9     (* scanner options *)
  10     options* = 0; strings* = 1; identifiers* = 2; chars* = 3; terminators* = 4;
  11     emptystr* = 5; emptyident* = 6; invalid* = 7;
  12
  13     (* errors *)
  14     ok* = 0; unkopt* = 1; missarg* = 2;
  15
  16   TYPE
  17     String* = POINTER TO ARRAY OF CHAR;
  18
  19   VAR
  20     optMode: BOOLEAN;
  21     args: POINTER TO ARRAY OF String;
  22     argn-, argi-: INTEGER;
  23     str-: String;
  24     ch-: CHAR;
  25     opts*: SET;
  26
  27   PROCEDURE Skip (n: INTEGER);
  28   BEGIN
  29     ASSERT(n >= 0, 20);
  30     ASSERT(argn < LEN(args), 21);
  31     ASSERT(argi + n <= LEN(args[argn]$), 22);
  32     INC(argi, n)
  33   END Skip;
  34
  35   PROCEDURE IsOpt (ch: CHAR): BOOLEAN;
  36   BEGIN
  37     RETURN (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch >= "0") & (ch <= "9") OR (ch = "-")
  38   END IsOpt;
  39
  40   PROCEDURE IsIdentStart (ch: CHAR): BOOLEAN;
  41   BEGIN
  42     RETURN (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch = "_")
  43   END IsIdentStart;
  44
  45   PROCEDURE IsIdent (ch: CHAR): BOOLEAN;
  46   BEGIN
  47     RETURN (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch = "_") OR (ch >= "0") & (ch <= "9")
  48   END IsIdent;
  49
  50   PROCEDURE Get* (VAR x: BYTE);
  51     VAR i, j, len: INTEGER; sym: BYTE; c: CHAR;
  52   BEGIN
  53     ch := 0X; str := NIL;
  54     IF argn >= LEN(args) THEN
  55       optMode := FALSE; sym := eof
  56     ELSE
  57       sym := null;
  58       c := args[argn, argi];
  59       IF c = 0X THEN
  60         optMode := FALSE; INC(argn); argi := 0;
  61         IF terminators IN opts THEN sym := eos; (* !!! *)
  62         ELSIF argn >= LEN(args) THEN sym := eof (* !!! *)
  63         ELSE c := args[argn, argi] (* continue parsing *)
  64         END
  65       END;
  66       IF sym = null THEN
  67         IF (options IN opts) & (optMode & IsOpt(c) OR (c = "-") & IsOpt(args[argn, argi + 1])) THEN
  68           sym := opt;
  69           IF optMode THEN
  70             ch := c; optMode := TRUE; Skip(1)
  71           ELSE
  72             ch := args[argn, argi + 1]; optMode := TRUE; Skip(2)
  73           END
  74         ELSIF (identifiers IN opts) OR (strings IN opts) THEN
  75           len := 0; i := argi; sym := null;
  76           (* --- get length of identifier --- *)
  77           IF (identifiers IN opts) & (IsIdentStart(args[argn, i]) OR (emptyident IN opts)) THEN
  78             WHILE IsIdent(args[argn, i]) DO
  79               INC(len);
  80               INC(i)
  81             END;
  82             sym := ident
  83           END;
  84           (* --- get length of string --- *)
  85           IF strings IN opts THEN
  86             WHILE args[argn, i] # 0X DO
  87               INC(len);
  88               INC(i)
  89             END;
  90             sym := string
  91           ELSIF (identifiers IN opts) & (args[argn, i] # 0X) & ~(invalid IN opts) THEN
  92             WHILE args[argn, i] # 0X DO INC(i) END;
  93             sym := null
  94           END;
  95           (* --- copy string --- *)
  96           IF (sym # null) & ((len > 0) OR (sym = string) & (emptystr IN opts) OR (sym = ident) & (emptyident IN opts)) THEN
  97             NEW(str, len + 1);
  98             FOR j := 0 TO len - 1 DO
  99               str[j] := args[argn, argi + j]
 100             END;
 101             str[len] := 0X
 102           END;
 103           optMode := FALSE;
 104           Skip(i - argi)
 105         ELSIF chars IN opts THEN
 106           ch := c; optMode := FALSE; Skip(1)
 107         ELSE
 108           optMode := FALSE; sym := null; Skip(1)
 109         END
 110       END
 111     END;
 112     x := sym
 113   END Get;
 114
 115   PROCEDURE Reset*;
 116   BEGIN
 117     argn := 1; argi := 0; ch := 0X; str := NIL; optMode := FALSE;
 118     opts := {options, strings, emptystr}
 119   END Reset;
 120
 121   PROCEDURE GetOpt* (IN optstring: ARRAY OF CHAR): CHAR;
 122     VAR save: SET; sym: BYTE; c: CHAR; i, mode: INTEGER;
 123   BEGIN
 124     save := opts; opts := {options, strings, emptystr}; c := 0X;
 125     Get(sym);
 126     IF sym = opt THEN
 127       c := ch; i := 0;
 128       WHILE (optstring[i] # 0X) & (optstring[i] # c) DO
 129         INC(i);
 130         WHILE optstring[i] = ":" DO
 131           INC(i)
 132         END
 133       END;
 134       IF optstring[i] = c THEN
 135         opts := {strings, emptystr}; mode := 0; INC(i);
 136         WHILE optstring[i] = ":" DO
 137           INC(mode);
 138           INC(i)
 139         END;
 140         IF mode # 0 THEN Get(sym);
 141           IF (sym # string) & (mode = 1) THEN
 142             NEW(str, 2); str[0] := c; c := ":"
 143           END
 144         END
 145       ELSE NEW(str, 2); str[0] := c; c := "?"
 146       END
 147     ELSIF sym = eof THEN c := 0X (* eof *)
 148     ELSE c := "$" (* string *)
 149     END;
 150     opts := save;
 151     RETURN c
 152   END GetOpt;
 153
 154   PROCEDURE Init;
 155     VAR i: INTEGER;
 156   BEGIN
 157     NEW(args, Kernel.argc);
 158     FOR i := 0 TO Kernel.argc - 1 DO
 159       NEW(args[i], LEN(Kernel.argv[i]$) + 1);
 160       args[i]^ := Kernel.argv[i]$
 161     END;
 162     Reset
 163   END Init;
 164
 165 BEGIN
 166   Init
 167 END DswOpts.