-- file PackCommandPack.mesa
-- Derived from Compiler/Binder>CommandPack (state transitions are changed)
-- last modified by Satterthwaite, September 22, 1980  12:26 PM
-- last modified by Russ Atkinson, 24-Nov-80 14:40:48
-- last modified by Lewis on  2-Apr-81 15:39:47

DIRECTORY
  CharIO: TYPE USING [CR, PutChar, PutString],
  CommandUtil: TYPE USING [CommandObject, CommandPtr],
  LongStorage: TYPE USING [Free, FreeString, Node, String],
  Streams: TYPE USING [Handle],
  Strings: TYPE USING [AppendChar, AppendString, EquivalentSubStrings, String,
                       SubString, SubStringDescriptor];

CommandPack: PROGRAM
    IMPORTS CharIO, Storage: LongStorage, Strings
    EXPORTS CommandUtil =
  BEGIN OPEN CommandUtil, Strings;

  CR: Char = CharIO.CR;
  Char: TYPE = CHARACTER;

  String: TYPE = Strings.String;

  Pair: TYPE = RECORD [key, val: String, next: PairList];
  PairList: PUBLIC TYPE = LONG POINTER TO Pair;

  TokenClass: TYPE = Char;
    id: TokenClass = 'I;
    eom: TokenClass = 03C;	-- ControlC

  State: TYPE = [0..18];
    --  0:
    --  1:    id
    --  2:    id ←
    --  3:    [ ?{id : id},
    --  4:    [ ?{id : id}, id
    --  5:    [ ?{id : id}, id :
    --  6:    [ ?{id : id}, id : id
    --  7:    [ ?{id : id}, ]
    --  8:    [ ?{id : id}, ] ←
    --  9:    LHS ← id
    -- 10:    ?(LHS ←) id [ ?{id : id},
    -- 11:    ?(LHS ←) id [ ?{id : id}, id
    -- 12:    ?(LHS ←) id [ ?{id : id}, id :
    -- 13:    ?(LHS ←) id [ ?{id : id}, id : id
    -- 14:    ?(LHS ←) id [ ?{id : id}, ]
    -- 15:    ?(LHS ←) id [ id ]
    -- 16:    ?(LHS ←) id ?ARG /
    -- 17:    ?(LHS ←) id ?ARG / id
    -- 18:    ?(LHS ←) id ?ARG ?(/ ?id) (;|eom) | eom
    --            where LHS = id  |  [ ?{id : id}, ]
    --            and   ARG = [ id ]  |  [ ?{id : id}, ]


  Failed: PUBLIC ERROR = CODE;

 -- stream-like utilities

  GetChar: PROC [p: CommandPtr] RETURNS [c: Char] = {
    IF p.pos >= p.len THEN RETURN [eom];
    c ← p.data[p.pos];
    p.pos ← p.pos + 1};

  GetIndex: PROC [p: CommandPtr, delta: INTEGER ← 0] RETURNS [CARDINAL] =
    {pos: CARDINAL ← p.pos + delta;
     IF delta < 0 AND pos > p.pos THEN pos ← 0;
     RETURN [pos];
     };

  SetIndex: PROC [p: CommandPtr, index: CARDINAL] = {p.pos ← index};

  Echo: PUBLIC PROC [d: Streams.Handle,
              operator: String,
              argList, resultList: PairList,
              switches: String] = {
    OPEN CharIO;
    EchoList: PROC [list: PairList] = {
       PutChar[d, '[ ];
       WHILE list # NIL DO
         next: PairList ← list.next;
         PutString[d, list.key];
         PutString[d, ": "L];
         PutString[d, list.val];
         IF next # NIL THEN PutString[d, ", "L];
         list ← next;
         ENDLOOP;
       PutChar[d, '] ];
       };
     IF resultList # NIL THEN {
        EchoList[resultList];
        PutString[d, " ← "L]};
     PutString[d, operator];
     IF argList # NIL THEN EchoList[argList];
     IF switches # NIL AND switches.length > 0 THEN
        {PutString[d, "/"L]; PutString[d, switches]};
     };


  -- external parsing routine

  Parse: PUBLIC PROC [s: CommandPtr, opX, argX, resultX: CARDINAL]
      RETURNS [operator: String, argList, resultList: PairList, switches: String] = {
    token: TokenClass;
    state: State;

    idString: STRING ← [100];
    tIndex: CARDINAL;

    c: Char;

    NextToken: PROC = {
      WHILE c = '  OR c = CR DO c ← GetChar[s] ENDLOOP;
      tIndex ← GetIndex[s] - 1;
      SELECT c FROM
	IN ['a..'z], IN ['A..'Z], IN ['0..'9], '<, '., '+, '-, '~, '!, '$ => {
	  idString.length ← 0;
	  WHILE TRUE
	    DO
	    SELECT c FROM
	      IN ['a..'z], IN ['A..'Z], IN ['0..'9],
	      '<, '>, '., '+, '-, '~, '!, '$ => {
		AppendChar[idString, c]; c ← GetChar[s]};
	      ENDCASE => EXIT;
	    ENDLOOP;
	  token ← id};
	'←, '[, ',, '], ':, '/ => {token ← c; c ← GetChar[s]};
	';, eom => token ← c;
	ENDCASE => BadCommand[]};

    CopyId: PROC [extra: CARDINAL] RETURNS [String] = INLINE {
      RETURN [CopyString[idString, extra]]};

    pair: ARRAY [0..1] OF String;

    PushArg: PROC = {argList ← AddPair[argList, pair[0], pair[1]]};

    PushResult: PROC = {resultList ← AddPair[resultList, pair[0], pair[1]]};

    RestoreToken: PROC = {SetIndex[s, tIndex]};

    BadCommand: PROC = {
      operator ← FreeString[operator];
      resultList ← FreePairList[resultList];
      argList ← FreePairList[argList];
      switches ← FreeString[switches];
      ERROR Failed};

    c ← ' ;  state ← 0;  operator ← switches ← NIL;
    argList ← resultList ← NIL;

    UNTIL state = 18
      DO
      NextToken[];
      SELECT token FROM
	id =>
	  SELECT state FROM
	    0 =>    {operator ← CopyId[MAX[resultX, opX]]; state ← 1};
	    2, 8 => {operator ← CopyId[opX]; state ← 9};
	    3 =>    {pair[0] ← CopyId[0]; state ← 4};
	    5 =>    {pair[1] ← CopyId[resultX]; PushResult[]; state ← 6};
	    10 =>   {pair[0] ← CopyId[0]; state ← 11};
	    12 =>   {pair[1] ← CopyId[argX]; PushArg[]; state ← 13};
	    16 =>   {switches ← CopyId[0]; state ← 17};
	    1, 9, 14, 17 => {RestoreToken[]; state ← 18};
	    ENDCASE =>  BadCommand[];
	'← =>
	  SELECT state FROM
	    1 => {
	      pair[0] ← NIL; pair[1] ← operator;  operator ← NIL;
	      PushResult[];  state ← 2};
	    7 => state ← 8;
	    ENDCASE => BadCommand[];
	'[ =>
	  SELECT state FROM
	    0 => state ← 3;
	    1, 9 => state ← 10;
	    14 => {RestoreToken[]; state ← 18};
	    ENDCASE => BadCommand[];
	'] =>
	  SELECT state FROM
	    3, 6 => state ← 7;
	    10, 13 => state ← 14;
	    11 => {pair[1] ← pair[0]; pair[0] ← NIL; PushArg[]; state ← 15};
	    ENDCASE => BadCommand[];
	': =>
	  SELECT state FROM
	    4 => state ← 5;
	    11 => state ← 12;
	    ENDCASE => BadCommand[];
	', =>
	  SELECT state FROM
	    6 => state ← 3;
	    13 => state ← 10;
	    ENDCASE => BadCommand[];
	'/ =>
	  SELECT state FROM
	    0, 1, 9, 14, 15 => state ← 16;
	    ENDCASE => BadCommand[];
	'; =>
	  SELECT state FROM
	    1, 9, 14, 15, 16, 17 => state ← 18;
	    ENDCASE => BadCommand[];
	eom =>
	  SELECT state FROM
	    0, 1, 9, 14, 15, 16, 17 => state ← 18;
	    ENDCASE => BadCommand[];
	ENDCASE;
      ENDLOOP;

    RETURN};


  CopyString: PUBLIC PROC [s: String, extra: CARDINAL ← 0] RETURNS [String] = {
    copy: String = Storage.String[IF s=NIL THEN 0 ELSE s.length + extra];
    IF s # NIL THEN AppendString[copy, s];  RETURN [copy]};

  FreeString: PUBLIC PROC [s: String] RETURNS [String] = {
    IF s # NIL THEN Storage.FreeString[s];  RETURN [NIL]};

 -- PairList utilities

  GetNthPair: PUBLIC PROC [list: PairList, n: CARDINAL, delete: BOOLEAN ← FALSE]
      RETURNS [key,value: String ← NIL] = {
    i: CARDINAL ← 0;
    FOR p: PairList ← list, p.next UNTIL p = NIL
      DO
      IF i = n THEN {key ← p.key;  value ← p.val;  IF delete THEN p.key ← p.val ← NIL;  EXIT};
      i ← i+1;
      ENDLOOP;
    RETURN};

  ListLength: PUBLIC PROC [list: PairList] RETURNS [n: CARDINAL ← 0] = {
    FOR p: PairList ← list, p.next UNTIL p = NIL DO n ← n+1 ENDLOOP;
    RETURN};

  KeyValue: PUBLIC PROC [key: Strings.SubString, list: PairList, delete: BOOLEAN ← FALSE]
      RETURNS [s: String ← NIL] = {
    FOR p: PairList ← list, p.next UNTIL p = NIL
      DO
      ss: Strings.SubStringDescriptor ← [base: p.key, offset: 0, length: p.key.length];
      IF Strings.EquivalentSubStrings[@ss, key]
	THEN {s ← p.val; IF delete THEN p.val ← NIL; EXIT};
      ENDLOOP;
    RETURN};

  FreePairList: PUBLIC PROC [list: PairList] RETURNS [PairList] = {
    next: PairList;
    p: PairList ← list;
    UNTIL p = NIL
      DO 
      next ← p.next;
      [] ← FreeString[p.key]; [] ← FreeString[p.val];
      Storage.Free[p];  p ← next;
      ENDLOOP;
    RETURN [NIL]};


  AddPair: PUBLIC PROC [list: PairList, key,val: String] RETURNS [PairList] = {
    new: PairList ← LOOPHOLE[Storage.Node[SIZE[Pair]]];
    new↑ ← [key: key, val: val, next: list];
    RETURN [new]};




  SetExtension: PUBLIC PROC [root, defaultExt: String] RETURNS [name: String] = {
    SELECT TRUE FROM
      ~Dotted[root] => {
	name ← AdjustString[root, defaultExt.length + 2];
	AppendChar[name, '.];
	AppendString[name, defaultExt]};
      ENDCASE => name ← root;
    RETURN};

 -- string utilities

  Dotted: PROC [s: String] RETURNS [BOOLEAN] = INLINE {
    FOR i: CARDINAL IN [0..s.length) DO IF s[i] = '. THEN RETURN [TRUE] ENDLOOP;
    RETURN [FALSE]};

 -- storage allocation

  AdjustString: PROC [old: String, extra: CARDINAL] RETURNS [new: String] = {
    IF old.length + extra <= old.maxlength
      THEN new ← old
      ELSE {
	new ← Storage.String[old.length + extra];
	AppendString[new, old];
	Storage.FreeString[old]};
    RETURN};

  END.