MODULE DswOpts;

  IMPORT Kernel, Log;

  CONST
    (* symbol *)
    null* = 0; opt* = 1; char* = 2; string* = 3; ident* = 4; eos* = 5; eof* = 6;

    (* scanner options *)
    options* = 0; strings* = 1; identifiers* = 2; chars* = 3; terminators* = 4;
    emptystr* = 5; emptyident* = 6; invalid* = 7;

    (* errors *)
    ok* = 0; unkopt* = 1; missarg* = 2;

  TYPE
    String* = POINTER TO ARRAY OF CHAR;

  VAR
    optMode: BOOLEAN;
    args: POINTER TO ARRAY OF String;
    argn-, argi-: INTEGER; 
    str-: String;
    ch-: CHAR;
    opts*: SET;

  PROCEDURE Skip (n: INTEGER);
  BEGIN
    ASSERT(n >= 0, 20);
    ASSERT(argn < LEN(args), 21);
    ASSERT(argi + n <= LEN(args[argn]$), 22);
    INC(argi, n)
  END Skip;

  PROCEDURE IsOpt (ch: CHAR): BOOLEAN;
  BEGIN
    RETURN (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch >= "0") & (ch <= "9") OR (ch = "-")
  END IsOpt;

  PROCEDURE IsIdentStart (ch: CHAR): BOOLEAN;
  BEGIN
    RETURN (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch = "_")
  END IsIdentStart;

  PROCEDURE IsIdent (ch: CHAR): BOOLEAN;
  BEGIN
    RETURN (CAP(ch) >= "A") & (CAP(ch) <= "Z") OR (ch = "_") OR (ch >= "0") & (ch <= "9")
  END IsIdent;

  PROCEDURE Get* (VAR x: BYTE);
    VAR i, j, len: INTEGER; sym: BYTE; c: CHAR;
  BEGIN
    ch := 0X; str := NIL;
    IF argn >= LEN(args) THEN
      optMode := FALSE; sym := eof
    ELSE
      sym := null;
      c := args[argn, argi];
      IF c = 0X THEN
        optMode := FALSE; INC(argn); argi := 0;
        IF terminators IN opts THEN sym := eos; (* !!! *)
        ELSIF argn >= LEN(args) THEN sym := eof (* !!! *)
        ELSE c := args[argn, argi] (* continue parsing *)
        END
      END;
      IF sym = null THEN
        IF (options IN opts) & (optMode & IsOpt(c) OR (c = "-") & IsOpt(args[argn, argi + 1])) THEN
          sym := opt;
          IF optMode THEN
            ch := c; optMode := TRUE; Skip(1)
          ELSE
            ch := args[argn, argi + 1]; optMode := TRUE; Skip(2)
          END
        ELSIF (identifiers IN opts) OR (strings IN opts) THEN
          len := 0; i := argi; sym := null;
          (* --- get length of identifier --- *)
          IF (identifiers IN opts) & (IsIdentStart(args[argn, i]) OR (emptyident IN opts)) THEN
            WHILE IsIdent(args[argn, i]) DO
              INC(len);
              INC(i)
            END;
            sym := ident
          END;
          (* --- get length of string --- *)
          IF strings IN opts THEN
            WHILE args[argn, i] # 0X DO
              INC(len);
              INC(i)
            END;
            sym := string
          ELSIF (identifiers IN opts) & (args[argn, i] # 0X) & ~(invalid IN opts) THEN
            WHILE args[argn, i] # 0X DO INC(i) END;
            sym := null
          END;
          (* --- copy string --- *)
          IF (sym # null) & ((len > 0) OR (sym = string) & (emptystr IN opts) OR (sym = ident) & (emptyident IN opts)) THEN
            NEW(str, len + 1);
            FOR j := 0 TO len - 1 DO
              str[j] := args[argn, argi + j]
            END;
            str[len] := 0X
          END;
          optMode := FALSE;
          Skip(i - argi)
        ELSIF chars IN opts THEN
          ch := c; optMode := FALSE; Skip(1)
        ELSE
          optMode := FALSE; sym := null; Skip(1)
        END
      END
    END;
    x := sym
  END Get;

  PROCEDURE Reset*;
  BEGIN
    argn := 1; argi := 0; ch := 0X; str := NIL; optMode := FALSE;
    opts := {options, strings, emptystr}
  END Reset;

  PROCEDURE GetOpt* (IN optstring: ARRAY OF CHAR): CHAR;
    VAR save: SET; sym: BYTE; c: CHAR; i, mode: INTEGER;
  BEGIN
    save := opts; opts := {options, strings, emptystr}; c := 0X;
    Get(sym);
    IF sym = opt THEN
      c := ch; i := 0;
      WHILE (optstring[i] # 0X) & (optstring[i] # c) DO
        INC(i);
        WHILE optstring[i] = ":" DO
          INC(i)
        END
      END;
      IF optstring[i] = c THEN
        opts := {strings, emptystr}; mode := 0; INC(i);
        WHILE optstring[i] = ":" DO
          INC(mode);
          INC(i)
        END;
        IF mode # 0 THEN Get(sym);
          IF (sym # string) & (mode = 1) THEN
            NEW(str, 2); str[0] := c; c := ":"
          END 
        END
      ELSE NEW(str, 2); str[0] := c; c := "?"
      END
    ELSIF sym = eof THEN c := 0X (* eof *)
    ELSE c := "$" (* string *)
    END;
    opts := save;
    RETURN c
  END GetOpt;

  PROCEDURE Init;
    VAR i: INTEGER;
  BEGIN
    NEW(args, Kernel.argc);
    FOR i := 0 TO Kernel.argc - 1 DO
      NEW(args[i], LEN(Kernel.argv[i]$) + 1);
      args[i]^ := Kernel.argv[i]$
    END;
    Reset
  END Init;

BEGIN
  Init
END DswOpts.