MODULEUtilities; IMPORT Text, ASCII, Fmt, CITextRefTbl, TextList, Convert, Params; IMPORT TextExtras; CONST KeywordPrefix = '-'; KeywordPrefixText = "-"; Spacer = ' '; AlternativeSep = '='; TypeSep = '/'; TYPE Key = OBJECT quota: CARDINAL := 1; exact := TRUE; required := FALSE; positional := FALSE; prefix := FALSE; index: CARDINAL; names: TextList.T := NIL; cghack: REF INTEGER; END; Error = {None, RequiredArgMissing, TooFewArgs, TooManyArgs, KeyAppearsMoreThanOnce}; REVEAL Template = BRANDED OBJECT table: CITextRefTbl.T; count: CARDINAL := 0; keys: REF ARRAY OF Key := NIL; END; Handle = BRANDED OBJECT errors := 0; template: Template; values: REF ARRAY OF REF ARRAY OF TEXT; errorList: REF ARRAY OF Error := NIL; leftOver: TextList.T := NIL; END; Args
<*INLINE*> PROCEDUREParsing key strings and building a templateAddRear (VAR (*inout*) l: TextList.T; t: Text.T)= BEGIN (* Append text to TextList.T *) WITH tl = TextList.List1(t) DO IF l = NIL THEN l := tl ELSE l := TextList.AppendD(l, tl); END; END END AddRear; <*INLINE*> PROCEDURECopy (READONLY args: T): REF T RAISES {}= VAR new := NEW(REF ARRAY OF TEXT, NUMBER(args)); BEGIN new^ := args; RETURN new; END Copy; <*INLINE*> PROCEDUREConcatenate (READONLY args1, args2: T): REF T RAISES {}= VAR length1 := NUMBER(args1); length2 := NUMBER(args2); new := NEW(REF ARRAY OF TEXT, length1 + length2); BEGIN SUBARRAY(new^, 0, length1) := args1; SUBARRAY(new^, length1, length2) := args2; RETURN new; END Concatenate;
PROCEDUREDecoding arguments and building the argument handleEnterKeyName ( table: CITextRefTbl.T; t: Text.T; k: Key) RAISES {BadTemplate}= BEGIN (* Add keyword to text hash table; no duplicates allowed *) IF table.put(t, k) THEN RAISE BadTemplate; END; (* if *) END EnterKeyName; <*INLINE*> PROCEDUREEnterKeyNames ( template: Template; key: Key) RAISES {BadTemplate}= BEGIN (* Make key accessible via hash table; its names are entered both with and without the special keyword prefix character *) VAR te: TextList.T := key.names; BEGIN WHILE te # NIL DO EnterKeyName(template.table, te.head, key); EnterKeyName(template.table, KeywordPrefixText & te.head, key); te := te.tail; END; END; END EnterKeyNames; <*INLINE*> PROCEDURECheckKeyTypeValid ( t, longForm: Text.T) RAISES {BadTemplate}= BEGIN IF Text.Length(t) > 1 AND NOT TextExtras.CIEqual(t, longForm) THEN RAISE BadTemplate; END; (* if *) END CheckKeyTypeValid; PROCEDUREKeyType ( key: Key; t: Text.T) RAISES {BadTemplate}= VAR ch := ASCII.Upper[Text.GetChar(t, 0)]; BEGIN IF ch = 'R' THEN CheckKeyTypeValid(t, "required"); key.required := TRUE; ELSIF ch = 'L' THEN CheckKeyTypeValid(t, "list"); key.quota := LAST(CARDINAL); key.exact := FALSE; ELSIF ch = 'F' THEN CheckKeyTypeValid(t, "flag"); key.quota := 0; ELSIF ch = 'X' THEN CheckKeyTypeValid(t, "prefix"); key.prefix := TRUE; ELSIF ch = 'P' THEN CheckKeyTypeValid(t, "positional"); key.positional := TRUE; ELSIF ch IN ASCII.Digits THEN VAR used: INTEGER; buffer := NEW(REF ARRAY OF CHAR, Text.Length(t)); BEGIN Text.SetChars(buffer^, t); key.quota := Convert.ToUnsigned(buffer^, used); IF used # NUMBER(buffer^) THEN RAISE BadTemplate END; key.exact := (ch # '0'); END ELSE RAISE BadTemplate; END; END KeyType; PROCEDUREGetItem ( t: Text.T; terminators: SET OF CHAR; limit: CARDINAL; VAR pos: CARDINAL; VAR item: Text.T) : CHAR RAISES {BadTemplate}= VAR start := pos; BEGIN (* Extract next alphanumeric item and return terminating character or '\000' if we have reached 'limit'. The value of 'item' returned is always at least one character long and alphanumeric *) EVAL TextExtras.FindCharSet(t, ASCII.Asciis - ASCII.AlphaNumerics, pos); IF pos = start THEN RAISE BadTemplate END; item := Text.Sub(t, start, pos - start); IF pos >= limit THEN RETURN '\000'; ELSE WITH ch = Text.GetChar(t, pos) DO INC(pos); IF pos >= limit OR NOT ch IN terminators THEN RAISE BadTemplate END; RETURN ch; END; END; END GetItem; PROCEDUREParseKey ( template: Template; t: Text.T; start, end: CARDINAL) RAISES {BadTemplate}= CONST BothSeps = SET OF CHAR {AlternativeSep, TypeSep}; JustTypeSep = SET OF CHAR {TypeSep}; VAR key := NEW(Key, index := template.count); pos := start; item: Text.T; ch: CHAR; BEGIN (* Build list of the alternative names of the key *) REPEAT ch := GetItem(t, BothSeps, end, pos, item); IF NOT Text.GetChar(item, 0) IN ASCII.Letters THEN RAISE BadTemplate; END; AddRear(key.names, item); UNTIL ch # AlternativeSep; (* Discover the type of the key *) WHILE ch = TypeSep DO ch := GetItem(t, JustTypeSep, end, pos, item); KeyType(key, item); END; (* Add the key names to the template *) EnterKeyNames(template, key); END ParseKey; PROCEDURENewTemplate (t: Text.T): Template RAISES {BadTemplate}= VAR template := NEW(Template, table := NEW(CITextRefTbl.Default).init()); BEGIN (* Parse 't' and build up hash table containing all keys *) VAR start, pos: CARDINAL := 0; BEGIN WHILE TextExtras.FindCharSet(t, ASCII.Asciis - ASCII.Set {Spacer}, pos) DO start := pos; WITH last = NOT TextExtras.FindChar(t, Spacer, pos) DO ParseKey(template, t, start, pos); INC(template.count); IF last THEN EXIT ELSE INC(pos) END; END; END; END; (* Build array so the keys can be accessed by index *) IF template.count > 0 THEN VAR i := template.table.iterate(); key: Text.T; value: REFANY; BEGIN template.keys := NEW(REF ARRAY OF Key, template.count); WHILE i.next(key, value) DO WITH key = NARROW(value, Key) DO template.keys[key.index] := key; END; END; END; END; RETURN template; END NewTemplate;
PROCEDURELooksLikeKeyword (t: Text.T): BOOLEAN RAISES {}= BEGIN RETURN Text.Length(t) >= 2 AND Text.GetChar(t, 0) = KeywordPrefix AND Text.GetChar(t, 1) IN ASCII.Letters; END LooksLikeKeyword; PROCEDUREIsKeyword ( h: Handle; t: Text.T; VAR key: Key; VAR tMinusPrefix: TEXT) : BOOLEAN RAISES {}= VAR ref: REFANY; BEGIN IF h.template.table.get(t, ref) THEN key := NARROW(ref, Key); RETURN TRUE; ELSE (* might be a prefix arg *) VAR iter := h.template.table.iterate(); name, uname: TEXT; val: REFANY; index: CARDINAL; ut := ToUpper(t); BEGIN WHILE iter.next(name, val) DO index := 0; key := val; uname := ToUpper(name); IF TextExtras.FindSub(ut, uname, index) AND index = 0 AND key.prefix THEN tMinusPrefix := TextExtras.Extract(t, Text.Length(name), Text.Length(t)); RETURN TRUE; END END; RETURN FALSE; END END; END IsKeyword; PROCEDUREToUpper (t: TEXT): TEXT= VAR l := Text.Length(t); x := NEW(REF ARRAY OF CHAR, l); BEGIN FOR i := 0 TO l-1 DO x[i] := ASCII.Upper[Text.GetChar(t, i)]; END; RETURN Text.FromChars(x^); END ToUpper; PROCEDURECheckedArgValue (t: Text.T): Text.T RAISES {}= VAR length := Text.Length(t); BEGIN IF length >= 2 AND Text.GetChar(t, 0) = KeywordPrefix AND Text.GetChar(t, 1) = KeywordPrefix THEN RETURN Text.Sub(t, 1, length - 1); ELSE RETURN t; END; (* if *) END CheckedArgValue; PROCEDURENewErrorList (number: CARDINAL): REF ARRAY OF Error RAISES {}= VAR new := NEW(REF ARRAY OF Error, number); BEGIN FOR i := 0 TO number - 1 DO new[i] := Error.None END; RETURN new; END NewErrorList; <*INLINE*> PROCEDURENoteError (h: Handle; key: Key; newError: Error) RAISES {}= BEGIN IF h.errorList = NIL THEN h.errorList := NewErrorList(h.template.count); END; WITH error = h.errorList[key.index] DO IF error = Error.None THEN error := newError; INC(h.errors); END; END; END NoteError; <*INLINE*> PROCEDUREMoveListOfArgs ( VAR from: ARRAY OF TEXT) : REF ARRAY OF TEXT RAISES {}= VAR number := NUMBER(from); new := NEW(REF ARRAY OF TEXT, number); BEGIN FOR i := 0 TO number - 1 DO WITH f = from[i] DO new[i] := CheckedArgValue(f); f := NIL; END; END; RETURN new; END MoveListOfArgs; VAR null_g := NEW(REF ARRAY OF TEXT, 0); PROCEDUREBindValue (h: Handle; key: Key; VAR args: T) RAISES {}= VAR quota := key.quota; error := Error.None; BEGIN WITH value = h.values[key.index] DO IF value # NIL AND NOT key.prefix THEN error := Error.KeyAppearsMoreThanOnce; ELSIF NUMBER(args) > quota THEN error := Error.TooManyArgs; ELSIF key.exact AND NUMBER(args) < quota THEN error := Error.TooFewArgs; END; IF error = Error.None THEN IF key.prefix THEN VAR new: REF ARRAY OF TEXT; length: CARDINAL; BEGIN IF value = NIL THEN length := 1; ELSE length := NUMBER(value^) + 1; END; new := NEW(REF ARRAY OF TEXT, length); FOR i := 0 TO length-2 DO new[i] := value[i]; END; new[length-1] := args[0]; value := new; END ELSE value := MoveListOfArgs(args); END ELSE IF value = NIL THEN value := null_g END; NoteError(h, key, error); FOR i := 0 TO LAST(args) DO args[i] := NIL END; END; END; END BindValue; PROCEDUREFindNextKeyword ( READONLY args: T; pos: CARDINAL; VAR argCount: CARDINAL) : CARDINAL RAISES {}= VAR countArgs := TRUE; BEGIN argCount := 0; LOOP IF pos >= NUMBER(args) THEN RETURN pos END; WITH arg = args[pos] DO IF arg = NIL THEN countArgs := FALSE; ELSIF LooksLikeKeyword(arg) THEN RETURN pos; ELSE IF countArgs THEN INC(argCount) END; END; END; INC(pos); END; END FindNextKeyword; PROCEDUREKeywordArgs (h: Handle; VAR args: T) RAISES {}= VAR argCount: CARDINAL; i := FindNextKeyword(args, 0, argCount); BEGIN WHILE i <= LAST(args) DO WITH arg = args[i] DO INC(i); VAR key: Key; next := FindNextKeyword(args, i, argCount); VAR tMinusPrefix: TEXT := NIL; BEGIN IF IsKeyword(h, arg, key, tMinusPrefix) THEN arg := NIL; IF key.prefix THEN VAR oneArg := NEW(REF ARRAY OF TEXT, 1); BEGIN IF tMinusPrefix = NIL THEN tMinusPrefix := "" END; oneArg[0] := tMinusPrefix; BindValue(h, key, oneArg^); END; (* dont consume following args *) IF argCount # 0 THEN next := i; END; ELSE IF i + argCount > LAST(args) AND key.quota < argCount THEN argCount := key.quota; END; WITH argsForKey = SUBARRAY(args, i, argCount) DO BindValue(h, key, argsForKey); END; END END; i := next; END; END; END; END KeywordArgs; PROCEDUREFindTrailingArgs ( READONLY args: T; VAR pos: CARDINAL) : BOOLEAN RAISES {}= VAR search := NUMBER(args); BEGIN LOOP IF search = 0 THEN EXIT; ELSE DEC(search); END; WITH arg = args[search] DO IF arg = NIL THEN INC(search); (* So 'search' points after the NIL *) EXIT; ELSIF LooksLikeKeyword(arg) THEN RETURN FALSE; ELSE (* loop *) END; END; END; (* Exit to here means we hit the start of the argument array or a NIL argument before hitting any keywords. If there are any arguments after this point we have found trailing arguments *) IF search < NUMBER(args) THEN pos := search; RETURN TRUE; ELSE RETURN FALSE; END; END FindTrailingArgs; PROCEDUREPositionalArgs (h: Handle; VAR args: T) RAISES {}= VAR aPos: CARDINAL := 0; limit: CARDINAL; BEGIN (* First check that we have some arguments to bind; only arguments at the head and tail of the argument array can be bound positionally *) EVAL FindNextKeyword(args, 0, limit); IF limit = 0 THEN IF NOT FindTrailingArgs(args, aPos) THEN RETURN END; limit := NUMBER(args); END; (* Iterate the keys, looking for those which can be bound positionally *) WITH keys = h.template.keys^ DO FOR kPos := FIRST(keys) TO LAST(keys) DO WITH key = keys[kPos] DO (* Check if we can bind positionally to this keyword *) IF key.positional AND key.quota # 0 THEN (* If is already bound then we terminate processing of positional args *) IF h.values[key.index] # NIL THEN RETURN END; (* Check we have some values to bind *) IF aPos = limit THEN IF limit < NUMBER(args) AND FindTrailingArgs(args, aPos) THEN (* We found some more at the tail of the argument array *) limit := NUMBER(args); ELSE RETURN; (* We've run out *) END; END; (* Bind as many values as we can *) WITH argCount = MIN(limit - aPos, key.quota) DO BindValue(h, key, SUBARRAY(args, aPos, argCount)); INC(aPos, argCount); END; END; END; END; END; END PositionalArgs; <*INLINE*> PROCEDURECheckRequiredArgsPresent (h: Handle) RAISES {}= BEGIN WITH keys = h.template.keys^ DO FOR i := FIRST(keys) TO LAST(keys) DO WITH key = keys[i] DO IF key.required AND h.values[i] = NIL THEN NoteError(h, key, Error.RequiredArgMissing); END; END; END; END; END CheckRequiredArgsPresent; <*INLINE*> PROCEDURECheckAllArgsDecoded (h: Handle; VAR args: T) RAISES {}= VAR afterKeyword := FALSE; BEGIN FOR i := FIRST(args) TO LAST(args) DO WITH arg = args[i] DO IF arg # NIL THEN WITH looksLikeKeyword = LooksLikeKeyword(arg) DO IF looksLikeKeyword OR NOT afterKeyword THEN AddRear(h.leftOver, arg); INC(h.errors); END; IF looksLikeKeyword THEN afterKeyword := TRUE END; END; arg := NIL; ELSE afterKeyword := FALSE; END; END; END; END CheckAllArgsDecoded; PROCEDUREDecode ( template: Template; VAR args: T; all := TRUE) : Handle RAISES {}= VAR h := NEW(Handle, template := template, values := NEW(REF ARRAY OF REF ARRAY OF TEXT, template.count)); BEGIN FOR i := 0 TO h.template.count - 1 DO h.values[i] := NIL END; IF h.template.count > 0 THEN KeywordArgs(h, args); IF all THEN PositionalArgs(h, args) END; CheckRequiredArgsPresent(h); END; IF all THEN CheckAllArgsDecoded(h, args) END; RETURN h; END Decode; PROCEDUREGood (h: Handle): BOOLEAN RAISES {}= BEGIN RETURN h.errors = 0; END Good; EXCEPTION Fatal; <*INLINE*> PROCEDUREInternalValue ( h: Handle; name: Text.T; VAR key: Key) : REF ARRAY OF TEXT RAISES {BadEnquiry}= VAR void: TEXT; BEGIN IF h.errors = 0 THEN IF IsKeyword(h, name, key, void) THEN RETURN h.values[key.index]; ELSE RAISE BadEnquiry; END; ELSE <*FATAL Fatal*> BEGIN RAISE Fatal; END; END; END InternalValue; PROCEDUREValue ( h: Handle; keyword: Text.T) : REF ARRAY OF TEXT RAISES {BadEnquiry}= VAR key: Key; BEGIN RETURN InternalValue(h, keyword, key); END Value; PROCEDUREFlag (h: Handle; keyword: Text.T): BOOLEAN RAISES {BadEnquiry}= VAR key: Key; value := InternalValue(h, keyword, key); BEGIN IF key.quota # 0 THEN RAISE BadEnquiry END; RETURN value # NIL; END Flag; PROCEDURESingle (h: Handle; keyword: Text.T): Text.T RAISES {BadEnquiry}= VAR key: Key; value := InternalValue(h, keyword, key); BEGIN IF key.quota # 1 OR NOT key.exact THEN RAISE BadEnquiry END; IF value = NIL THEN RETURN NIL ELSE RETURN value[0] END; END Single; <*INLINE*> PROCEDUREKeyName (h: Handle; i: CARDINAL): Text.T RAISES {}= BEGIN RETURN h.template.keys[i].names.head; END KeyName; PROCEDUREErrors (h: Handle; indent: CARDINAL := 0): Text.T RAISES {}= BEGIN IF h.errors = 0 THEN <*FATAL Fatal*> BEGIN RAISE Fatal; END; ELSE VAR texts := NEW(REF ARRAY OF TEXT, h.errors * 2); (* allocates space for all the error messages + padding *) pos: CARDINAL := 0; padding := Fmt.Pad("", indent); fmt: Text.T; <*INLINE*> PROCEDURE Add(t: Text.T) RAISES {}= BEGIN texts[pos] := t; INC(pos) END Add; <*INLINE*> PROCEDURE PaddedAdd(t: Text.T) RAISES {}= BEGIN Add(padding); Add(t) END PaddedAdd; BEGIN IF h.errorList # NIL THEN FOR i := 0 TO LAST(h.errorList^) DO VAR error := h.errorList[i]; BEGIN IF error # Error.None THEN CASE error OF | Error.RequiredArgMissing => fmt := "Argument required for key \'%s\'\n"; | Error.TooFewArgs => fmt := "Too few arguments for key \'%s\'\n"; | Error.TooManyArgs => fmt := "Too many arguments for key \'%s\'\n"; | Error.KeyAppearsMoreThanOnce => fmt := "More than one occurrence of key \'%s\'\n"; | Error.None => <*ASSERT FALSE*> END; (* case *) PaddedAdd(Fmt.F(fmt, KeyName(h, i))); END; END; END; END; VAR te: TextList.T := h.leftOver; BEGIN WHILE te # NIL DO IF LooksLikeKeyword(te.head) THEN fmt := "Unknown keyword \'%s\'\n"; ELSE fmt := "Unexpected argument \'%s\'\n"; END; PaddedAdd(Fmt.F(fmt, te.head)); te := te.tail; END; END; RETURN TextExtras.JoinN(texts^); END; END; (* if *) END Errors; PROCEDUREBind ( h: Handle; keyword: Text.T; v: REF ARRAY OF TEXT; override := FALSE) RAISES {BadBinding}= VAR ref: REFANY; key: Key; BEGIN IF h.errors # 0 THEN <*FATAL Fatal*> BEGIN RAISE Fatal; END; END; IF h.template.table.get(keyword, ref) THEN key := NARROW(ref, Key); WITH value = h.values[key.index] DO IF value # NIL AND NOT override THEN (* don't override existing value *) RETURN; ELSE VAR ok: BOOLEAN; BEGIN IF v = NIL THEN ok := NOT key.required; ELSIF key.exact THEN ok := NUMBER(v^) = key.quota; ELSE ok := NUMBER(v^) <= key.quota; END; IF ok THEN value := v; RETURN END; END; END; END; END; RAISE BadBinding; END Bind; VAR standard_g: Template; args_g: REF T; PROCEDUREInit ()= VAR total := Params.Count-1; new := NEW(REF T, total); <* FATAL BadTemplate *> BEGIN standard_g := NewTemplate(StandardTemplateDescription); FOR i := 0 TO total - 1 DO new[i] := Params.Get(i+1); END; args_g := new; END Init; PROCEDURECommandLine (): REF T RAISES {} = BEGIN RETURN Copy(args_g^); END CommandLine; PROCEDUREStandard (VAR args: T; VAR help, identify: BOOLEAN) RAISES {}= VAR h := Decode(standard_g, args, FALSE); <* FATAL BadEnquiry *> BEGIN help := Flag(h, "help"); identify := Flag(h, "identify"); END Standard; BEGIN Init(); END Args.