(* Copyright 1989-1992 Digital Equipment Corporation.          *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* Created by J.Stolfi on Nov 1990                             *)
(*   based on classic Modula-2+ code by John Ellis             *)
(* Last modified on Mon Jun 29 20:54:47 PDT 1992 by stolfi     *)
(*      modified on Sun Mar  1 14:27:42 PST 1992 by meehan     *)
(*      modified on Thu Feb  6 00:15:28 PST 1992 by muller     *)


UNSAFE MODULE SxSyntax;

IMPORT
  Sx, SxPrivate, List, SxSymbol, Fmt, Char, Word, Convert, Thread,
  IntRefTbl, FWr, TextWr, Wr, Rd, RTMisc, Text, TextF;
FROM Sx IMPORT 
  UndefinedType, Elision, NoElision, ReadError, PrintError;

TYPE
  Tables =
    RECORD
      list: IntRefTbl.T := NIL; (* leading symbol number -> REFANY *)
      ref : IntRefTbl.T := NIL; (* TYPECODE -> REFANY *)
    END;

REVEAL
  Private =
    BRANDED OBJECT
      (* leading character -> token parser *)
      charParsers: ARRAY CHAR OF Parser;

      (* Chars that may appear in symnums, incl. | and \ *)
      symNumChars: SET OF CHAR;

      (* Parser for symbols and numbers *)
      symNumParser: Parser;

      (* Conversion proc for integer literals *)
      intConverter: IntConverter;

      (* Conversion proc for float literals *)
      floatConverter: FloatConverter;

      (* Conversion proc for other numeric literals *)
      otherNumConverter: OtherNumConverter;

      (* Interning proc for symbol names *)
      symbolConverter: SymbolConverter;

      inputFilters : Tables;    (* value type -> Filter *)
      outputFilters: Tables;    (* value type -> Filter *)
      printers     : Tables;    (* value type -> Printer *)

      defaultPrinter: Printer;  (* The default printing procedure *)

      indentation: CARDINAL;    (* Indentation per level *)
    END;

TYPE
  Vector = REF ARRAY OF REFANY;
  NoValueType = BRANDED REF INTEGER;

(**********************************************************)
(* ERROR MESSAGES                                         *)
(**********************************************************)

CONST
  IllegalChar        = "illegal character in input";
  UnexpectedEOF      = "unexpected end of input";
  BadOctalDigit      = "bad digit in octal escape";
  IllegalEscape      = "illegal escape sequence";
  IllegalCharLiteral = "badly formed character literal";
  BadSymNum          = "badly formed symbol or number";
  InvalidBase        = "invalid number base";
  IntegerOverflow    = "integer too big";
  InvalidDigit       = "invalid digit in number";
  Unmatched          = "unmatched";
  BadIdentifier      = "unknown identifier";
  UnreadableValue    = "unreadable value";
  BadTwoChar         = "illegal two-character prefix";
  InputFilterFailed  = "input filter failed";

  CantPrintRoot      = "attempted to print the root symbol";
  BastardSymbol      = "attempted to print a symbol that does not descend from the root symbol";
  CantPrintThisStuff = "attempted to print an unprintable object";
  OutputFilterFailed = "output filter failed";


PROCEDURE DoPPChar(wr: Wr.T; ch: CHAR) =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    IF (ch IN Char.Graphics) 
    AND (ch # '\\') 
    AND (ch # '\'') 
    AND (ch # '\"')
    THEN
      Wr.PutChar(wr, ch)
    ELSE
      PrintEscapeSequence(wr, '\\', ch);
    END;
  END DoPPChar;

PROCEDURE PPChar(ch: CHAR): TEXT =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    WITH wr = TextWr.New() DO
      Wr.PutChar(wr, '\'');
      DoPPChar(wr, ch);
      Wr.PutChar(wr, '\'');
      RETURN TextWr.ToText(wr)
    END;
  END PPChar;

PROCEDURE PP2Char(ch, next: CHAR): TEXT =
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    WITH wr = TextWr.New() DO
      Wr.PutChar(wr, '\"');
      DoPPChar(wr, ch);
      DoPPChar(wr, next);
      Wr.PutChar(wr, '\"');
      RETURN TextWr.ToText(wr)
    END;
  END PP2Char;

PROCEDURE PPChars(READONLY ch: CHARS): TEXT =
  CONST MaxMsg = 20;
  <* FATAL Wr.Failure, Thread.Alerted *>
  BEGIN
    WITH wr = TextWr.New() DO
      Wr.PutChar(wr, '\"');
      FOR i := 0 TO MIN(MaxMsg - 1, LAST(ch)) DO
        DoPPChar(wr, ch[i]);
      END;
      IF NUMBER(ch) > MaxMsg THEN 
        Wr.PutText(wr, "...")
      END;
      Wr.PutChar(wr, '\"');
      RETURN TextWr.ToText(wr)
    END;
  END PPChars;

(**********************************************************)
(* SPECIAL CHARACTERS                                     *)
(**********************************************************)

CONST
  TextQuote        = '\"';  (* Delimiter for TEXT literals *)
  TextEscape       = '\\';  (* Escape character for TEXT literals *)

  CharQuote        = '\'';  (* Delimiter for CHAR literals *)
  CharEscape       = '\\';  (* Escape character for CHAR literals *)

  SymbolQuote      = '|';   (* Delimiter for symbol names *)
  SymbolEscape     = '\\';  (* Escape character for symbol names *)
  SymbolDot        = '.';   (* Component separator for symbol names *)

  ListOpen         = '(';   (* Open delimiter for List.T's *)
  ListClose        = ')';   (* Close delimiter for List.T's *)

  VectorOpen       = '[';   (* Open delimiter for ARRAY OF REFANY *)
  VectorClose      = ']';   (* Close delimiter for ARRAY OF REFANY *)

  SharpChar        = '#';   (* Standard prefix for two-level syntax *)

  BlockCmntSharpChar  = '|';   (* (After SharpChar) starts block comment *)
  OpenBogusSharpChar = '<';    (* (After SharpChar) starts unreadable object *)
  CloseBogusSharpChar = '>';   (* (After SharpChar) ends unreadable object *)

CONST
  ElidedMark = '?';
  TruncatedMark = "...";

(**********************************************************)
(* METHODS                                                *)
(**********************************************************)

VAR (*CONST*)
  WhiteCharParser: Parser;
  IllegalCharParser: Parser;
  IllegalTwoCharParser: SubParser;

PROCEDURE Copy(t: T): T =
  BEGIN
    RETURN NEW(T,
      Read      := Read,
      ReadUntil := ReadUntil,
      Print     := Print,
      Copy      := Copy,

      charParsers  := t.charParsers,

      symNumChars  := t.symNumChars,
      symNumParser := t.symNumParser,

      intConverter      := t.intConverter,
      floatConverter    := t.floatConverter,
      otherNumConverter := t.otherNumConverter,
      symbolConverter   := t.symbolConverter,

      inputFilters  := CopyTables(t.inputFilters),
      outputFilters := CopyTables(t.outputFilters),
      printers      := CopyTables(t.printers),

      defaultPrinter := t.defaultPrinter,

      indentation := t.indentation
    );
  END Copy;

PROCEDURE CopyTables (tables: Tables): Tables =
  VAR t := Tables {NIL, NIL};
  BEGIN
    IF tables.list # NIL THEN t.list := tables.list.copy () END;
    IF tables.ref # NIL THEN t.ref := tables.ref.copy () END;
    RETURN t
  END CopyTables;

PROCEDURE Read(
    syntax: T;
    rd: Rd.T; 
    root: SxSymbol.T;
  ): REFANY
  RAISES {ReadError, Rd.EndOfFile, Rd.Failure, Thread.Alerted} =
  VAR
    item: REFANY := NoValue;
    anyFilters: BOOLEAN := (syntax.inputFilters # Tables{NIL, NIL});
  BEGIN
    REPEAT
      WITH
        ch = Rd.GetChar(rd),
        parser = syntax.charParsers[ch]
      DO
        IF parser = WhiteCharParser THEN
          (* ignore *)
        ELSE
          (* Parse rest of token *)
          item := parser.apply(rd, ch, root, syntax);
          (* Apply input filters, if any *)
          IF anyFilters AND item # NoValue THEN
            WITH filter = LookUpType(item, syntax.inputFilters, NIL) DO
              IF filter # NIL THEN
                TRY
                  item := NARROW(filter, Filter).apply(item, root, syntax)
                EXCEPT
                | FilterError(msg) => RAISE ReadError(InputFilterFailed & ": " & msg)
                END
              END;
            END
          END;
        END
      END;
    UNTIL item # NoValue;
    RETURN item
  END Read;

PROCEDURE ReadUntil(
    syntax: T;
    rd: Rd.T; 
    delim: CHAR; 
    root: SxSymbol.T;
  ): List.T
  RAISES {ReadError, Rd.Failure, Thread.Alerted} =
  VAR
    list: List.T;
    item: REFANY;
    cell: List.T;
    lastCell: List.T;
    anyFilters: BOOLEAN := (syntax.inputFilters # Tables{NIL, NIL});
  BEGIN
    TRY
      list := NIL;
      LOOP
        WITH
          ch = Rd.GetChar(rd),
          parser = syntax.charParsers[ch]
        DO
          IF ch = delim THEN 
            RETURN list 
          ELSIF parser = WhiteCharParser THEN
            (* ignore *)
          ELSE
            (* Parse rest of token *)
            item := parser.apply(rd, ch, root, syntax);
            (* Apply input filters, if any *)
            IF anyFilters AND item # NoValue THEN
              WITH filter = LookUpType(item, syntax.inputFilters, NIL) DO
                IF filter # NIL THEN
                  TRY
                    item := NARROW(filter, Filter).apply(item, root, syntax)
                  EXCEPT
                  | FilterError(msg) => RAISE ReadError(msg)
                  END
                END;
              END
            END;
            (* Add to list *)
            IF item # NoValue THEN
              cell := NEW(List.T);
              cell.first := item;
              cell.tail := NIL;
              IF list = NIL THEN
                list := cell;
              ELSE
                lastCell.tail := cell;
              END;
              lastCell := cell;
            END;
          END;
        END
      END;
    EXCEPT
    | Rd.EndOfFile => RAISE ReadError(UnexpectedEOF);
    END;
  END ReadUntil;

PROCEDURE Print(
    syntax: T;
    fwr: FWr.T; 
    value: REFANY; 
    elision: Elision;
    root: SxSymbol.T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} = 
  BEGIN
    IF elision.depth = 0 THEN
      Wr.PutChar(fwr, ElidedMark);
      RETURN
    END;
    IF elision.depth # LAST(CARDINAL) THEN DEC(elision.depth) END;

    IF syntax.outputFilters # Tables{NIL, NIL} THEN
      WITH filter = LookUpType(value, syntax.outputFilters, NIL) DO
        IF filter # NIL THEN
          TRY
            value := NARROW(filter, Filter).apply(value, root, syntax)
          EXCEPT
          | FilterError(msg) => RAISE PrintError(OutputFilterFailed & ": " & msg)
          END
        END;
      END
    END;
    WITH printer = LookUpType(value, syntax.printers, syntax.defaultPrinter) DO
      NARROW(printer, Printer).apply(fwr, value, elision, root, syntax)
    END
  END Print;

PROCEDURE LookUpType(
    value: REFANY;
    tables: Tables;
    defaultRes: REFANY := NIL
  ): REFANY =
  (*
    If /value/ is a list of the form (symbol ...), then 
    looks for that symbol in /tables.list/.  If the symbol is not 
    in the table, or /value/ is not of that form, looks for
    TYPECODE(value) in tables.ref. If not found in either place,
    returns /defaultRes/. *)
  VAR item: REFANY;
  BEGIN
    WITH tc = TYPECODE(value) DO
      (* Check for special list notation: *)
      IF tables.list # NIL AND tc = TYPECODE(List.T) AND value # NIL THEN
        WITH list = NARROW(value, List.T) DO
          <* ASSERT value # NIL *>
          TYPECASE list^.first OF
          | NULL => 
              (* not a (symbol ...) list, go on *)
          | SxSymbol.T(symbol) =>
              IF tables.list.in(symbol.number, item) THEN
                RETURN item
              END
          ELSE
            (* not a (symbol ...) list, go on *)
          END
        END;
      END;
      
      (* Look up typecode: *)
      IF tables.ref = NIL THEN
        RETURN defaultRes
      ELSIF tables.ref.in(tc, item) THEN
        RETURN item
      ELSE
        RETURN defaultRes
      END
    END
  END LookUpType;

PROCEDURE InitParsers() = 
  BEGIN
    (* Note: Sx and SxPrivate are not yet initialized at this point. *)
    WhiteCharParser   := NEW(Parser, apply := WhiteCharParseProc);
    IllegalCharParser := NEW(Parser, apply := IllegalCharParseProc);
    IllegalTwoCharParser := NEW(SubParser, apply := IllegalTwoCharSubParseProc);
    IllegalValuePrinter := NEW(Printer, apply := IllegalValuePrintProc);
  END InitParsers;

(**********************************************************)
(* BUFFER MANAGEMENT                                      *)
(**********************************************************)

(*
  The procedures below manage the temporary buffers
  used while parsing texts, numbers, and symbols.  Those buffers 
  initially live in the procedure's stack frame, but in case of 
  overflow they are moved to the untraced heap. *)

TYPE 
  CharPtr = UNTRACED REF CHAR;
  BufPtr = UNTRACED REF ARRAY OF CHAR;

  BufferRef = RECORD (* A buffer descriptor: *)
      end: CharPtr;    (* Address of first character beyond end of buffer *)
      pos: CharPtr;    (* Pointer to next free character in buffer *)
      ref: BufPtr;     (* Pointer to buffer descriptor *)
      dsp: BufPtr;     (* Ditto if buffer lives on heap, else NIL *)
    END;

PROCEDURE BufferInit(VAR chars: CHARS): BufferRef =
  (* 
     Creates a buffer descriptor for the given ARRAY OF CHAR, which
     is assumed to live in the caller's stack frame. *)
  BEGIN
    RETURN BufferRef{
      pos := ADR(chars[0]),
      end := ADR(chars[0]) + NUMBER(chars), 
      ref := ADR(chars),
      dsp := NIL
    }
  END BufferInit;

PROCEDURE BufferExpand(VAR (*IO*) buf: BufferRef) =
  (*
    Called when /buf/ overflows.  Allocates a bigger buffer from the
    untraced heap, copies /buf/'s contents there, and changes /buf/
    to point to the new buffer.  *)
  VAR new: BufferRef;
  BEGIN
    WITH 
      adr = ADR(buf.ref[0]),
      len = (buf.pos - adr)
    DO
      new.dsp := NEW(UNTRACED REF ARRAY OF CHAR, 2 * len);
      new.ref := new.dsp;
      WITH newadr = ADR(new.ref[0]) DO
        new.end := newadr + 2 * len;
        new.pos := newadr + len;
        RTMisc.Copy(adr, newadr, len);
      END
    END;
    IF buf.dsp # NIL THEN DISPOSE(buf.dsp) END;
    buf := new
  END BufferExpand;

PROCEDURE FromBuf(READONLY buf: BufferRef): TEXT =
  (*
    Converts the /length/ characters pointed to by /adr/ into a TEXT. *)
  BEGIN
    RETURN Text.FromChars(SUBARRAY(buf.ref^, 0, buf.pos - ADR(buf.ref[0])))
  END FromBuf;

(**********************************************************)
(* ILLEGAL CHARACTERS                                     *)
(**********************************************************)

PROCEDURE IllegalCharParseProc(
    <*UNUSED*> self: Parser;
    <*UNUSED*> rd: Rd.T;
    ch: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} = 
  BEGIN
    RAISE ReadError(IllegalChar & " = " & PPChar(ch))
  END IllegalCharParseProc;

(**********************************************************)
(* WHITESPACE CHARACTERS                                  *)
(**********************************************************)

PROCEDURE WhiteCharParseProc(
    <*UNUSED*> self: Parser;
    <*UNUSED*> rd: Rd.T;
    <*UNUSED*> ch: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} = 
  BEGIN
    RETURN NoValue
  END WhiteCharParseProc;

(**********************************************************)
(* TEXTS                                                  *)
(**********************************************************)

PROCEDURE TextParseProc(
    <*UNUSED*> self: Parser;
    rd: Rd.T;
    <*UNUSED*> ch: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} =
  (* 
    Parses a text literal delimited by /textQuote/. Assumes the
    initial quote has already been read. *)

  PROCEDURE DoParse(VAR locBuf: CHARS): REFANY 
    RAISES {ReadError, Rd.Failure, Thread.Alerted} =
    VAR buf: BufferRef := BufferInit(locBuf);
    BEGIN
      TRY
        ParseQuotedString(rd, TextQuote, TextEscape, buf);
        RETURN FromBuf(buf);
      FINALLY
        IF buf.dsp # NIL THEN DISPOSE(buf.dsp) END
      END;
    END DoParse;
  
  VAR locBuf: ARRAY [0..120] OF CHAR;
  BEGIN
    RETURN DoParse(locBuf)
  END TextParseProc;

PROCEDURE TextPrintProc(
    <*UNUSED*> self: Printer;
    fwr: FWr.T;
    value: REFANY;
    elision: Elision;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  VAR nChars: CARDINAL;
  BEGIN
    WITH text = NARROW(value, TEXT) DO
      IF Text.Empty(text) THEN 
        Wr.PutChar(fwr, TextQuote);
        Wr.PutChar(fwr, TextQuote);
      ELSE
        IF elision.length = NoElision.length THEN
          nChars := LAST(CARDINAL)
        ELSE
          nChars := MAX(elision.length * 10, 75);
        END;
        PrintQuotedString(
          fwr, 
          TextQuote, 
          TextEscape, 
          SUBARRAY(text^, 0, LAST(text^)), 
          nChars
        )
      END
    END
  END TextPrintProc;

PROCEDURE ParseQuotedString(
    rd: Rd.T;
    quoteChar: CHAR;
    escapeChar: CHAR;
    VAR (*IO*) buf: BufferRef;
  ) RAISES {ReadError, Rd.Failure, Thread.Alerted} =
  (*
    Copies a TEXT or CHAR literal from /rd/ into /buf/, translating
    escaped characters, until the first unescaped /quoteChar/ (which
    is discarded).  Assumes the opening /quoteChar/ has been read
    already.  *)
  VAR ch: CHAR;
  BEGIN
    TRY
      LOOP
        ch := Rd.GetChar(rd);
        IF ch = quoteChar THEN
          EXIT
        ELSIF ch = escapeChar THEN
          ch := GetEscapedChar(rd, escapeChar);
        ELSIF  NOT(ch IN Char.Graphics) THEN
          RAISE ReadError(IllegalChar & " = " & PPChar(ch));
        END;
        IF buf.pos >= buf.end THEN BufferExpand(buf) END;
        buf.pos^ := ch;
        INC(buf.pos);
      END;
    EXCEPT
    | Rd.EndOfFile => RAISE ReadError(UnexpectedEOF);
    END;
  END ParseQuotedString;

PROCEDURE GetEscapedChar(rd: Rd.T; escapeChar: CHAR): CHAR 
  RAISES {ReadError, Rd.Failure, Thread.Alerted} =
  (*
    Parses the body of a character escape sequence, after an /escapeChar/. *)
  VAR ch: CHAR; ord: CARDINAL;
  BEGIN
    <* ASSERT escapeChar IN Char.Graphics *>
    <* ASSERT NOT escapeChar IN Char.AlphaNumerics *>
    TRY
      ch := Rd.GetChar(rd);
      CASE ch OF
      | 'n' => ch := '\n';
      | 't' => ch := '\t';
      | 'r' => ch := '\r';
      | 'f' => ch := '\f';
      | 'b' => ch := '\010';
      | 'e' => ch := Char.ESC;
      | '0', '1', '2', '3', '4', '5', '6', '7' =>
          ord := ORD(ch) - ORD('0');
          FOR i := 1 TO 2 DO
            ch := Rd.GetChar(rd);
            IF ch < '0' OR ch > '7' THEN
              RAISE ReadError(BadOctalDigit & " = " & PPChar(ch));
            END;
            ord := ord * 8 + ORD(ch) - ORD('0');
          END;
          ch := VAL(ord, CHAR);
      ELSE
        IF (NOT ch IN Char.Graphics) 
        OR  ch IN Char.AlphaNumerics THEN
          RAISE ReadError(IllegalEscape & " = " & PP2Char(escapeChar, ch))
        END;
      END;
    EXCEPT
    | Rd.EndOfFile => RAISE ReadError(UnexpectedEOF);
    END;
    RETURN ch;
  END GetEscapedChar;

PROCEDURE PrintQuotedString(
    wr: FWr.T;
    quoteChar: CHAR;
    escapeChar: CHAR;
    READONLY chars: ARRAY OF CHAR;
    maxChars: CARDINAL := LAST(CARDINAL);
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  BEGIN
    Wr.PutChar(wr, quoteChar);
    FOR i := 0 TO MIN(maxChars - 1, LAST(chars)) DO
      WITH c = chars[i] DO
        IF c IN Char.Graphics AND c # quoteChar AND c # escapeChar THEN
          Wr.PutChar(wr, c);
        ELSE
          PrintEscapeSequence(wr, escapeChar, c);
        END
      END;
    END;
    IF NUMBER(chars) > maxChars THEN Wr.PutText(wr, "...") END;
    Wr.PutChar(wr, quoteChar)
  END PrintQuotedString;

PROCEDURE PrintEscapeSequence(wr: Wr.T; escapeChar: CHAR; c: CHAR) 
  RAISES {Wr.Failure, Thread.Alerted} =
  (*
    Prints an escape sequence for character /ch/, using the given
    /escapeChar/ as the escap esymbol. *)
  BEGIN
    IF c IN Char.AlphaNumerics THEN
      <* ASSERT FALSE *>
    ELSIF c IN Char.Graphics THEN
      Wr.PutChar(wr, escapeChar);
      Wr.PutChar(wr, c);
    ELSE
      Wr.PutChar(wr, escapeChar);
      CASE c OF
      | '\n' => Wr.PutChar(wr, 'n');
      | '\t' => Wr.PutChar(wr, 't');
      | '\r' => Wr.PutChar(wr, 'r');
      | '\f' => Wr.PutChar(wr, 'f');
      | '\010' => Wr.PutChar(wr, 'b');
      | Char.ESC => Wr.PutChar(wr, 'e');
      ELSE
        Wr.PutChar(wr, VAL(ORD('0') + ORD(c) DIV 64, CHAR));
        Wr.PutChar(wr, VAL(ORD('0') + ORD(c) MOD 64 DIV 8, CHAR));
        Wr.PutChar(wr, VAL(ORD('0') + ORD(c) MOD 8, CHAR));
      END;
    END
  END PrintEscapeSequence;

(**********************************************************)
(* CHARS                                                  *)
(**********************************************************)

PROCEDURE CharParseProc(
    <*UNUSED*> self: Parser;
    rd: Rd.T;
    <*UNUSED*> ch: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} =

  PROCEDURE DoParse(VAR locBuf: CHARS): REFANY 
    RAISES {ReadError, Rd.Failure, Thread.Alerted} =
    VAR buf: BufferRef := BufferInit(locBuf);
    BEGIN
      TRY
        ParseQuotedString(rd, CharQuote, CharEscape, buf);
        IF buf.pos - ADR(buf.ref[0]) # 1 THEN
          RAISE ReadError(IllegalCharLiteral)
        END;
        RETURN SxPrivate.PreboxedChar[buf.ref[0]];
      FINALLY
        IF buf.dsp # NIL THEN DISPOSE(buf.dsp) END
      END;
    END DoParse;
  
  VAR locBuf: ARRAY [0..10] OF CHAR;
  BEGIN
    RETURN DoParse(locBuf)
  END CharParseProc;

PROCEDURE RefCharPrintProc(
    <*UNUSED*> self: Printer;
    wr: FWr.T;
    value: REFANY;
    <*UNUSED*> elision: Elision;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  VAR buf: ARRAY [0..0] OF CHAR;
  BEGIN
    WITH ch = NARROW(value, REF CHAR)^ DO
      buf[0] := ch;
      PrintQuotedString(wr, CharQuote, CharEscape, buf)
    END
  END RefCharPrintProc;

(**********************************************************)
(* SYMBOLS AND NUMBERS (SYMNUMS)                          *)
(**********************************************************)

(*
  The following definitions describe a FSM 
  that disambiguates a symNum into a symbol, an integer literal,
  a float literal, or a syntax error. *)

TYPE
  SNState = {
    Start, Sign, UnsInt, SignInt,
    Base, BaseSign, BaseInt,
    PostDot, (* after initial dot, digit => Frac else => Symbol *)
    Frac, Exp, ExpSign, Float, 
    OtherNum, 
    Symbol
  };

  SNCharType = {
    Digit, 
    LetterACFZ, LetterDE,
    Dot, Sign, Underscore, Other
  };

VAR (*CONST*) 
  SNFSM: RECORD 
    type: ARRAY CHAR OF SNCharType;
    next: ARRAY SNState, SNCharType OF SNState;
  END;

PROCEDURE InitSymNumFSM() =
  (*
    Initializes the SNFSM tables *)
  BEGIN
    (* Note: Sx and SxPrivate are not yet initialized at this point. *)
    WITH s = SNFSM DO
    
      (* Define the distinct CHAR classes w.r.t. the SymNum syntax: *)
  
      FOR c := FIRST(CHAR) TO LAST(CHAR) DO s.type[c] := SNCharType.Other END;
  
      FOR c := '0' TO '9' DO s.type[c] := SNCharType.Digit END;

      FOR c := 'A' TO 'Z' DO 
        IF c = 'E' OR c = 'D' THEN 
          s.type[Char.Lower[c]] := SNCharType.LetterDE;
          s.type[Char.Upper[c]] := SNCharType.LetterDE;
        ELSE
          s.type[Char.Lower[c]] := SNCharType.LetterACFZ;
          s.type[Char.Upper[c]] := SNCharType.LetterACFZ;
        END
      END;
    
      s.type['.'] := SNCharType.Dot;
  
      s.type['+'] := SNCharType.Sign;
      s.type['-'] := SNCharType.Sign;
  
      s.type['_'] := SNCharType.Underscore;
      
      (* Set up FSM that distinguishes symbols from ints from floats: *)
  
      FOR c := FIRST(SNCharType) TO LAST(SNCharType) DO
        FOR state := FIRST(SNState) TO LAST(SNState) DO
          IF state = SNState.Start 
          OR state = SNState.Sign 
          OR state = SNState.Symbol
          OR state = SNState.PostDot
          THEN
            s.next[state, c] := SNState.Symbol;
          ELSE
            s.next[state, c] := SNState.OtherNum;
          END
        END;
      END;
  
      s.next[SNState.Start,    SNCharType.Digit]      := SNState.UnsInt;
      s.next[SNState.Start,    SNCharType.Sign]       := SNState.Sign;
      s.next[SNState.Start,    SNCharType.Dot]        := SNState.PostDot;
  
      s.next[SNState.Sign,     SNCharType.Digit]      := SNState.SignInt;
  
      s.next[SNState.UnsInt,   SNCharType.Digit]      := SNState.UnsInt;
      s.next[SNState.UnsInt,   SNCharType.Dot]        := SNState.Frac;
      s.next[SNState.UnsInt,   SNCharType.Underscore] := SNState.Base;
      s.next[SNState.UnsInt,   SNCharType.LetterDE]   := SNState.Exp;
  
      s.next[SNState.SignInt,  SNCharType.Digit]      := SNState.SignInt;
      s.next[SNState.SignInt,  SNCharType.Dot]        := SNState.Frac;
      s.next[SNState.SignInt,  SNCharType.LetterDE]   := SNState.Exp;
  
      s.next[SNState.Base,     SNCharType.Digit]      := SNState.BaseInt;
      s.next[SNState.Base,     SNCharType.LetterACFZ] := SNState.BaseInt;
      s.next[SNState.Base,     SNCharType.LetterDE]   := SNState.BaseInt;
      s.next[SNState.Base,     SNCharType.Sign]       := SNState.BaseSign;
  
      s.next[SNState.BaseSign, SNCharType.Digit]      := SNState.BaseInt;
      s.next[SNState.BaseSign, SNCharType.LetterACFZ] := SNState.BaseInt;
      s.next[SNState.BaseSign, SNCharType.LetterDE]   := SNState.BaseInt;
  
      s.next[SNState.BaseInt,  SNCharType.Digit]      := SNState.BaseInt;
      s.next[SNState.BaseInt,  SNCharType.LetterACFZ] := SNState.BaseInt;
      s.next[SNState.BaseInt,  SNCharType.LetterDE]   := SNState.BaseInt;

      s.next[SNState.PostDot,  SNCharType.Digit]      := SNState.Frac;
      
      s.next[SNState.Frac,     SNCharType.Digit]      := SNState.Frac;
      s.next[SNState.Frac,     SNCharType.LetterDE]   := SNState.Exp;
  
      s.next[SNState.Exp,      SNCharType.Digit]      := SNState.Float;
      s.next[SNState.Exp,      SNCharType.Sign]       := SNState.ExpSign;
  
      s.next[SNState.ExpSign,  SNCharType.Digit]      := SNState.Float;

      s.next[SNState.Float,    SNCharType.Digit]      := SNState.Float;
    END;

  END InitSymNumFSM;

PROCEDURE SymNumParseProc(
    <*UNUSED*> self: Parser;
    rd: Rd.T;
    ch: CHAR;
    root: SxSymbol.T;
    syntax: T;
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} =
  (*
    Parses a symbol or numeric literal whose first character 
    (previously read) is /ch/. *)

  PROCEDURE DoParse(VAR locBuf: CHARS): REFANY 
    RAISES {ReadError, Rd.Failure, Thread.Alerted} =
    VAR
      buf: BufferRef := BufferInit(locBuf);
      parent: SxSymbol.T := root;
      state: SNState;
    BEGIN
      IF root = NIL THEN 
        parent := SxSymbol.DefaultRoot 
      ELSE 
        parent := root 
      END;
      TRY 
        (* Gobble up the SymNum token: *)
        state := SNState.Start;
        LOOP
          IF ch = SymbolQuote THEN
            ParseQuotedString(rd, SymbolQuote, SymbolEscape, buf);
            state := SNState.Symbol;
          ELSIF ch = SymbolEscape THEN
            ch := GetEscapedChar(rd, SymbolEscape);
            state := SNState.Symbol;
            IF buf.pos >= buf.end THEN BufferExpand(buf) END;
            buf.pos^ := ch;
            INC(buf.pos);
          ELSIF NOT ch IN syntax.symNumChars THEN
            Rd.UnGetChar(rd);
            EXIT
          ELSE
            (* Compute next FSM state *)
            state := SNFSM.next[state, SNFSM.type[ch]];
  
            IF state = SNState.Symbol AND ch = SymbolDot THEN
              (* Update parent symbol, and discard name: *)
              WITH 
                name = SUBARRAY(buf.ref^, 0, buf.pos - ADR(buf.ref[0])) 
              DO
                parent := syntax.symbolConverter.apply(name, parent, root, syntax);
              END;
              buf.pos := ADR(buf.ref[0]);
            ELSE
              (* Gobble up character: *)
              IF buf.pos >= buf.end THEN BufferExpand(buf) END;
              buf.pos^ := ch;
              INC(buf.pos);
            END
          END;
          TRY ch := Rd.GetChar(rd) EXCEPT Rd.EndOfFile => EXIT END;
        END;
  
        (* Decide what to do with it *)
        WITH 
          chars = SUBARRAY(buf.ref^, 0, buf.pos - ADR(buf.ref[0]))
        DO
          CASE state OF
          | SNState.Symbol, 
            SNState.Sign, 
            SNState.Start,
            SNState.PostDot =>
              RETURN syntax.symbolConverter.apply(chars, parent, root, syntax)
          | SNState.UnsInt,
            SNState.SignInt,
            SNState.BaseInt =>
              RETURN syntax.intConverter.apply(chars, syntax)
          | SNState.Frac,
            SNState.Exp, 
            SNState.Float =>
              RETURN syntax.floatConverter.apply(chars, syntax)
          | SNState.ExpSign, 
            SNState.Base, 
            SNState.BaseSign, 
            SNState.OtherNum =>
              RETURN syntax.otherNumConverter.apply(chars, syntax)
          END
        END;
      FINALLY
        IF buf.dsp # NIL THEN DISPOSE(buf.dsp) END
      END
    END DoParse;

  VAR locBuf: ARRAY [0..120] OF CHAR;
  BEGIN
    RETURN DoParse(locBuf)
  END SymNumParseProc;

(**********************************************************)
(* SYMBOLS                                                *)
(**********************************************************)

PROCEDURE SymbolConvertProc(
    <*UNUSED*> self: SymbolConverter;
    VAR name: ARRAY OF CHAR; 
    parent: SxSymbol.T;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T;  
  ): REFANY RAISES {ReadError} =
  (*
    Interns a simple symbol name relative to the given parent. *)
  BEGIN
    RETURN SxSymbol.FromNameChars(name, parent);
  END SymbolConvertProc;

PROCEDURE SymbolPrintProc(
    <*UNUSED*> self: Printer;
    fwr: FWr.T;
    value: REFANY;
    <*UNUSED*> elision: Elision;
    root: SxSymbol.T;
    syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =

  PROCEDURE DoPrint(s: SxSymbol.T; last: BOOLEAN) 
    RAISES {Sx.PrintError, Wr.Failure, Thread.Alerted} =
    BEGIN
      WITH p = s.parent DO
        IF (p = root) THEN 
          PrintSimpleName(fwr, s.name, syntax, firstName := TRUE, lastName := last);
        ELSE
          IF (p = NIL) THEN RAISE PrintError(BastardSymbol) END;
          DoPrint(p, last := FALSE);
          Wr.PutChar(fwr, SymbolDot);
          PrintSimpleName(fwr, s.name, syntax, firstName := FALSE, lastName := last)
        END
      END;
    END DoPrint;

  BEGIN
    IF root = NIL THEN root := SxSymbol.DefaultRoot END;
    WITH symbol = NARROW(value, SxSymbol.T) DO
      IF (symbol = root) THEN
        RAISE PrintError(CantPrintRoot) 
      ELSIF (symbol = NIL) THEN 
        <* ASSERT FALSE *> 
      END;
      DoPrint(symbol, last := TRUE)
    END;
  END SymbolPrintProc;

PROCEDURE PrintSimpleName(
    wr: Wr.T;
    name: TEXT;
    syntax: T;
    firstName: BOOLEAN;   (* TRUE if this is the fisrt component of a symbol name *)
    lastName: BOOLEAN;    (* TRUE if this is the last component of a symbol name *) 
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  VAR quoted: BOOLEAN;
  BEGIN
    WITH 
      length = Text.Length(name)
    DO
      IF length = 0 THEN 
        IF firstName AND lastName THEN
          Wr.PutChar(wr, SymbolQuote);
          Wr.PutChar(wr, SymbolQuote);
        END;
        RETURN
      END;

      WITH 
        chars = SUBARRAY(name^, 0, length)
      DO
        (* Determine if name needs || quotes: *)
        IF firstName AND LooksLikeNumber(chars) THEN
          quoted := TRUE
        ELSE
          VAR savedEscapes: INTEGER := 0; 
              i: CARDINAL := 0;
          BEGIN
            WHILE i < length AND savedEscapes < 2 DO
              WITH c = chars[i] DO
                IF (NOT c IN Char.Graphics) OR c = SymbolEscape OR c = SymbolQuote THEN
                  (* same in quoted or unquoted format *)
                ELSIF c = SymbolDot THEN
                  (* Needs no escape in quoted format *)
                  INC(savedEscapes, 1)
                ELSIF NOT c IN syntax.symNumChars THEN
                  IF c IN Char.AlphaNumerics THEN
                    (* Can't use escape here, need quotes *)
                    savedEscapes := LAST(CARDINAL)
                  ELSE
                    (* Needs no escape in quoted format *)
                    INC(savedEscapes, 1)
                  END
                ELSE
                  (* Needs no escape in either format *)
                END;
              END;
              INC(i)
            END;
            quoted := (savedEscapes >= 2)
          END;
        END;

        (* Now print it *)
        IF quoted THEN
          (* Print with || quotes: *)
          PrintQuotedString(wr, SymbolQuote, SymbolEscape, chars, LAST(CARDINAL))
        ELSE
          (* Print without || quotes: *)
          FOR k := 0 TO length-1 DO
            WITH c = chars[k] DO
              IF (NOT c IN syntax.symNumChars) 
              OR (c = SymbolQuote) OR (c = SymbolEscape) OR (c = SymbolDot) THEN
                PrintEscapeSequence(wr, SymbolEscape, c)
              ELSE
                Wr.PutChar(wr, c)
              END
            END
          END
        END;
      END
    END
  END PrintSimpleName;

PROCEDURE LooksLikeNumber(READONLY name: ARRAY OF CHAR): BOOLEAN =
  VAR k: CARDINAL := 0;
  BEGIN
    IF k > LAST(name) THEN RETURN FALSE END;
    IF name[k] = '+' OR name[k] = '-' THEN 
      INC(k); IF k > LAST(name) THEN RETURN FALSE END
    END;
    RETURN name[k] IN Char.Digits
  END LooksLikeNumber;

(**********************************************************)
(* INTEGER LITERALS                                       *)
(**********************************************************)

VAR (*CONST*) digitValue: ARRAY CHAR OF INTEGER;

PROCEDURE InitDigitValue() =
  BEGIN
    (* Note: Sx and SxPrivate are not yet initialized at this point. *)

    FOR c := FIRST(CHAR) TO LAST(CHAR) DO
      digitValue[c] := 999 (* Larger than any base *)
    END;

    FOR c := '0' TO '9' DO
      digitValue[c] := ORD(c) - ORD('0')
    END;

    FOR c := 'A' TO 'Z' DO
      digitValue[Char.Upper[c]] := ORD(c) - ORD('A') + 10;
      digitValue[Char.Lower[c]] := digitValue[Char.Upper[c]]
    END;
  END InitDigitValue;

PROCEDURE IntConvertProc(
    <*UNUSED*> self: IntConverter;
    VAR chars: CHARS;   (* The number. *)
    <*UNUSED*> syntax: T;          (* The syntax table *)
  ): REFANY RAISES {ReadError} =
  VAR i: CARDINAL;
  BEGIN
    WITH nc = NUMBER(chars) DO
      i := 0;
      WHILE i < nc AND chars[i] # '_' DO INC(i) END;
      IF i = nc THEN
        (* Decimal number: allow only CARDINAL range *)
        RETURN DecIntToRefInteger(chars);
      ELSE
        <* ASSERT (i > 0) AND (i < nc - 1) *>
        WITH b = ToCardinal(SUBARRAY(chars, 0, i)) DO
          IF b < 2 OR b > 36 THEN 
            RAISE ReadError (InvalidBase & " = " & Fmt.Int(b))
          END;
          RETURN BaseIntToRefInteger(SUBARRAY(chars, i + 1, nc - i - 1), b)
        END
      END
    END;
  END IntConvertProc;

PROCEDURE DecIntToRefInteger(VAR c: CHARS): REF INTEGER 
  RAISES {ReadError} =
  (*
    Converts a signed string of decimal digits to a REF  INTEGER *)
  VAR val: INTEGER;
      temp: INTEGER;
      negate := FALSE;
      i: CARDINAL := 0;
  BEGIN
    IF c[i] = '-' THEN
      negate := TRUE;
      INC(i);
    ELSIF c[i] = '+' THEN
      INC(i);
    END;
    (* Accumulate *negative* of number, to avoid overflow as much as possible: *)
    val := 0;
    WHILE i < NUMBER(c) DO
      temp := val * 10 - digitValue[c[i]];
      IF temp > val THEN
        RAISE ReadError(IntegerOverflow);
      END;
      val := temp;
      INC(i);
    END;
    IF  NOT negate THEN
      val :=  -val;
      IF val < 0 THEN
        RAISE ReadError(IntegerOverflow);
      END;
    END;
    RETURN Sx.NewInteger(val);
  END DecIntToRefInteger;

PROCEDURE BaseIntToRefInteger(READONLY c: ARRAY OF CHAR; b: CARDINAL): REF INTEGER 
  RAISES {ReadError} =
  (*
    Converts a signed string of base /b/ digits to a REF INTEGER.
    If there is no sign, the value must be in [0 .. 2^32-1];
    if there is a sign ("+" or "-"), the final value must be in 
    [-2^31 .. 2^31-1]. *)
  VAR val: INTEGER;
      negate := FALSE;
      isSigned := FALSE;
      i := 0;
      temp: Word.T;
  BEGIN
    i := 0;
    IF c[i] = '-' THEN
      negate := TRUE;
      isSigned := TRUE;
      INC(i);
    ELSIF c[i] = '+' THEN
      isSigned := TRUE;
      INC(i);
    END;
    
    (* Accumulate number as unsigned: *)
    val := 0;
    WHILE i < NUMBER(c) DO
      WITH dig = digitValue[c[i]] DO
        IF dig >= b THEN 
          RAISE ReadError(InvalidDigit & " = " & PPChar(c[i]))
        END;
        temp := Word.Plus(Word.Times(val, b), dig);
        IF Word.LT(temp, val) THEN RAISE ReadError(IntegerOverflow) END
      END;
      val := temp;
      INC(i);
    END;
    (* Now val (as unsigned) is in [0..2^32-1] *)
    IF negate THEN
      IF val = FIRST(INTEGER) THEN 
        (* OK: val is 2^31 as unsigned, and -2^31 as signed *)
      ELSIF val < 0 THEN 
        (* val as unsigned is in [2^31+1 .. 2^32-1] *)
        RAISE ReadError(IntegerOverflow)
      ELSE
        (* val as unsigned is in [0..2^31-1] *)
        val := - val;
      END;
    ELSIF isSigned THEN
      IF val < 0 THEN RAISE ReadError(IntegerOverflow) END;
    ELSE
      (* OK *)
    END;
    RETURN Sx.NewInteger(val);
  END BaseIntToRefInteger;

PROCEDURE ToCardinal(READONLY c: ARRAY OF CHAR): CARDINAL RAISES {ReadError} =
  VAR val: INTEGER;
      temp: INTEGER;
      i: CARDINAL := 0;
  BEGIN
    (* Accumulate number: *)
    val := 0;
    WHILE i < NUMBER(c) DO
      temp := val * 10 + digitValue[c[i]];
      IF temp < val THEN
        RAISE ReadError(IntegerOverflow);
      END;
      val := temp;
      INC(i);
    END;
    RETURN val;
  END ToCardinal;

PROCEDURE RefIntegerPrintProc(
    <*UNUSED*> self: Printer;
    fwr: FWr.T;
    value: REFANY;
    <*UNUSED*> elision: Elision;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  BEGIN
    WITH integer = NARROW(value, REF INTEGER) DO
      Wr.PutText(fwr, Fmt.Int(integer^))
    END
  END RefIntegerPrintProc;

(**********************************************************)
(* FLOAT LITERALS                                         *)
(**********************************************************)

PROCEDURE FloatConvertProc(
    <*UNUSED*> self: FloatConverter;
    VAR chars: CHARS;
    <*UNUSED*> syntax: T;           (* The syntax table *)
  ): REFANY RAISES {ReadError} =
  VAR i: CARDINAL;
  BEGIN
    WITH nc = NUMBER(chars) DO
      i := 0;
      WHILE i < nc AND NOT SNFSM.type[chars[i]] = SNCharType.LetterDE DO INC(i) END;
      <* ASSERT (i > 0) *>
      IF i = nc OR chars[i] = 'e' OR chars[i] = 'E' THEN
        IF i = nc-1 THEN
          RETURN Sx.NewReal(ToReal(SUBARRAY(chars, 0, nc-1)))
        ELSE
          RETURN Sx.NewReal(ToReal(chars))
        END;
      ELSIF chars[i] = 'd' OR chars[i] = 'D' THEN
        IF i = nc-1 THEN
          RETURN Sx.NewLongReal(ToLongReal(SUBARRAY(chars, 0, nc-1)))
        ELSE
          RETURN Sx.NewLongReal(ToLongReal(chars))
        END
      ELSE
        <* ASSERT FALSE *>
      END
    END;
  END FloatConvertProc;

PROCEDURE ToReal(READONLY c: ARRAY OF CHAR): REAL RAISES {ReadError} =
  (*
    Converts a decimal digit string with embedded "." or "e" or "d"
    into a REAL *)
  VAR val: REAL;
      count: INTEGER;
  <* FATAL Convert.Failed *>
  BEGIN
    (* It is an implementation error if Convert.ToLongFloat 
    raises Convert.Failed, or stops too soon. *)
    val := Convert.ToFloat(c, count);
    IF count < NUMBER(c) THEN <* ASSERT FALSE *> END;
    RETURN val;
  END ToReal;

PROCEDURE ToLongReal(READONLY c: ARRAY OF CHAR): LONGREAL RAISES {ReadError} =
  (*
    Converts a decimal digit string with embedded "." or "e" or "d"  
    into a LONGREAL *)
  VAR val: LONGREAL;
      count: INTEGER;
  <* FATAL Convert.Failed *>
  BEGIN
    (* It is an implementation error if Convert.ToLongFloat 
    raises Convert.Failed, or stops too soon. *)
    val := Convert.ToLongFloat(c, count);
    IF count < NUMBER(c) THEN <* ASSERT FALSE *> END;
    RETURN val;
  END ToLongReal;

PROCEDURE RefRealPrintProc(
    <*UNUSED*> self: Printer;
    fwr: FWr.T;
    value: REFANY;
    <*UNUSED*> elision: Elision;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  VAR buffer: ARRAY [0..80] OF CHAR;
      needsDot := TRUE;
      length: CARDINAL;
  <* FATAL Convert.Failed *>
  BEGIN
    WITH real = NARROW(value, REF REAL)^ DO
      length := Convert.FromFloat(buffer, real);
      (* force 'e' exponent, and ensure there is an 'e' or '.': *)
      FOR i := 0 TO length - 1 DO
        WITH c = buffer[i] DO
          IF (c = 'd') OR (c = 'D')  OR (c = 'E') THEN c := 'e' END;
          IF (c = '.') OR (c = 'e') THEN needsDot := FALSE END
        END;
      END;
      IF needsDot THEN buffer[length] := '.'; INC(length) END;
      (* Wr.PutString(fwr, SUBARRAY(buffer, 0, length)) *)
      Wr.PutText(fwr, Text.FromChars(SUBARRAY(buffer, 0, length)))
    END
  END RefRealPrintProc;

PROCEDURE RefLongRealPrintProc(
    <*UNUSED*> self: Printer;
    fwr: FWr.T;
    value: REFANY;
    <*UNUSED*> elision: Elision;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  VAR buffer: ARRAY [0..82] OF CHAR;
      needsExp := TRUE;
      length: CARDINAL;
  <* FATAL Convert.Failed *>
  BEGIN
    WITH v = NARROW(value, REF LONGREAL)^ DO
      length := Convert.FromLongFloat(buffer, v);
      (* ensure there is a 'd' exponent: *)
      FOR i := 0 TO length - 1 DO
        WITH c = buffer[i] DO
          IF (c = 'e') OR (c = 'E')  OR (c = 'D') THEN c := 'd' END;
          IF (c = 'd') THEN needsExp := FALSE END;
        END
      END;
      IF needsExp THEN
        (* If number ends in '.', replace it by 'd', else append 'd': *)
        IF buffer[length-1] # '.' THEN INC(length, 1) END;
        buffer[length-1] := 'd'; 
      END;
      (* If number ends in "d0", supress  the "0" *)
      IF length >= 2 AND buffer[length-2] = 'd' AND buffer[length-1] = '0' THEN
        length := length - 1
      END;
      (* Wr.PutString(fwr, SUBARRAY(buffer, 0, length)) *)
      Wr.PutText(fwr, Text.FromChars(SUBARRAY(buffer, 0, length)))
    END
  END RefLongRealPrintProc;

(**********************************************************)
(* OTHER NUMBER-LIKE LITERALS                             *)
(**********************************************************)

PROCEDURE OtherNumConvertProc(
    <*UNUSED*> self: OtherNumConverter;
    VAR chars: CHARS;
    <*UNUSED*> syntax: T;           (* The syntax table *)
  ): REFANY RAISES {ReadError} =
  BEGIN
    RAISE ReadError(BadSymNum & " = " & PPChars(chars))
  END OtherNumConvertProc;

(**********************************************************)
(* LISTS AND NIL                                          *)
(**********************************************************)

PROCEDURE ListParseProc(
    <*UNUSED*> self: Parser;
    rd: Rd.T;
    <*UNUSED*> ch: CHAR;
    root: SxSymbol.T;
    syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} =
  BEGIN
    RETURN syntax.ReadUntil(rd, ListClose, root);
  END ListParseProc;

PROCEDURE NilPrintProc(
    <*UNUSED*> self: Printer;
    fwr: FWr.T;
    <*UNUSED*> value: REFANY;
    <*UNUSED*> elision: Elision;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  BEGIN
    Wr.PutChar(fwr, ListOpen);
    Wr.PutChar(fwr, ListClose)
  END NilPrintProc;

PROCEDURE ListPrintProc(
    <*UNUSED*> self: Printer;
    fwr: FWr.T;
    value: REFANY;
    elision: Elision;
    root: SxSymbol.T;
    syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  VAR nElems: CARDINAL;
  BEGIN
    VAR list := NARROW(value, List.T);
    BEGIN
      FWr.Begin(fwr, syntax.indentation);
      Wr.PutChar(fwr, ListOpen);
      IF elision.length = NoElision.length THEN
        nElems := LAST(CARDINAL)
      ELSE
        nElems := elision.length;
      END;
      LOOP
        IF list = NIL THEN EXIT END;
        IF nElems <= 0 THEN Wr.PutText(fwr, TruncatedMark); EXIT END;
        FWr.Begin(fwr, 0);
        syntax.Print(fwr, list.first, elision, root);
        IF list.tail # NIL THEN
          Wr.PutChar(fwr, ' ');
          FWr.UnitedBreak(fwr, 0);
          FWr.End(fwr);
          FWr.Break(fwr, 0);
        ELSE
          FWr.End(fwr);
        END;
        list := list.tail;
        DEC(nElems)
      END;
      Wr.PutChar(fwr, ListClose);
      FWr.End(fwr)
    END
  END ListPrintProc;

(**********************************************************)
(* VECTORS                                                *)
(**********************************************************)

PROCEDURE VectorParseProc(
    <*UNUSED*> self: Parser;
    rd: Rd.T;
    <*UNUSED*> ch: CHAR;
    root: SxSymbol.T;
    syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} =
  VAR l: List.T;
  BEGIN
    l := syntax.ReadUntil(rd, VectorClose, root);
    WITH
      length = List.Length(l),
      v = NEW(Vector, length)
    DO
      FOR i := 0 TO length - 1 DO v[i] := l.first; l := l.tail END;
      RETURN v
    END
  END VectorParseProc;

PROCEDURE VectorPrintProc(
    <*UNUSED*> self: Printer;
    fwr: FWr.T;
    value: REFANY;
    elision: Elision;
    root: SxSymbol.T;
    syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  VAR nElems: CARDINAL;
  BEGIN
    WITH vector = NARROW(value, Vector) DO
      FWr.Begin(fwr, syntax.indentation);
      Wr.PutChar(fwr, VectorOpen);
      IF elision.length = NoElision.length THEN
        nElems := NUMBER(vector^)
      ELSE
        nElems := MIN(NUMBER(vector^), elision.length);
      END;
      FOR i := 0 TO nElems - 1 DO
        FWr.Begin(fwr, 0);
        syntax.Print(fwr, vector[i], elision, root);
        IF i < LAST(vector^) THEN
          Wr.PutChar(fwr, ' ');
          FWr.UnitedBreak(fwr, 0);
          FWr.End(fwr);
          FWr.Break(fwr, 0);
        ELSE
          FWr.End(fwr);
        END;
      END;
      IF nElems < NUMBER(vector^) THEN
        Wr.PutText(fwr, TruncatedMark)
      END;
      Wr.PutChar(fwr, VectorClose);
      FWr.End(fwr)
    END
  END VectorPrintProc;

(**********************************************************)
(* UNMATCHED RIGHT DELIMITERS                             *)
(**********************************************************)

PROCEDURE UnmatchedCloseParseProc(
    <*UNUSED*> self: Parser;
    <*UNUSED*> rd: Rd.T;
    ch: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} =
  BEGIN
    RAISE ReadError(Unmatched & " " & PPChar(ch));
  END UnmatchedCloseParseProc;

(**********************************************************)
(* TWO-LEVEL SYNTAX (GENERAL)                             *)
(**********************************************************)

TYPE
  SplitParser = Parser OBJECT (* A Parser for chars with split syntax *)
      subParsers: ARRAY CHAR OF SubParser;  (* second-level dispatch table  *)
    END;

PROCEDURE SplitParseProc(
    self: SplitParser;
    rd: Rd.T;
    ch: CHAR;
    root: SxSymbol.T;
    syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} =
  (*
    The /apply/ method for SplitParsers. *)
  BEGIN
    TRY
      WITH 
        next = Rd.GetChar(rd),
        subParser = self.subParsers[next]
      DO
        RETURN subParser.apply(rd, ch, next, root, syntax)
      END;
    EXCEPT
    | Rd.EndOfFile => RAISE ReadError(UnexpectedEOF)
    END;
  END SplitParseProc;

(**********************************************************)
(* BLOCK COMMENTS                                         *)
(**********************************************************)

PROCEDURE BlockCmntSubParseProc(
    <*UNUSED*> self: SubParser;
    rd: Rd.T;
    ch, next: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} = 
  VAR levels: INTEGER; 
      c: CHAR;
  BEGIN
    levels := 1;
    TRY
      c := Rd.GetChar(rd);
      LOOP
        IF c = ch THEN
          c := Rd.GetChar(rd);
          IF c = next THEN levels := levels + 1; c := Rd.GetChar(rd) END;
        ELSIF c = next THEN
          c := Rd.GetChar(rd);
          IF c = ch THEN
            levels := levels - 1;
            IF levels = 0 THEN EXIT END;
            c := Rd.GetChar(rd);
          END;
        ELSE
          c := Rd.GetChar(rd);
        END;
      END;
    EXCEPT
    | Rd.EndOfFile => RAISE ReadError(UnexpectedEOF);
    END;
    RETURN NoValue;
  END BlockCmntSubParseProc;

(**********************************************************)
(* LINE COMMENTS                                          *)
(**********************************************************)

PROCEDURE LineCmntSubParseProc(
    <*UNUSED*> self: SubParser;
    rd: Rd.T;
    <*UNUSED*> ch: CHAR;
    next: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} = 
  VAR c: CHAR;
  BEGIN
    c := next;
    TRY
      WHILE c # '\n' DO c := Rd.GetChar(rd) END;
    EXCEPT
    | Rd.EndOfFile => (* OK *)
    END;
    RETURN NoValue;
  END LineCmntSubParseProc;

(**********************************************************)
(* TRUE, FALSE, AND UNDEFINED                             *)
(**********************************************************)

PROCEDURE TrueSubParseProc(
    <*UNUSED*> self: SubParser;
    rd: Rd.T;
    ch, next: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} = 
  BEGIN
    RETURN ParseWord(rd, ch, next, CHARS{'t','r','u','e'}, Sx.True)
  END TrueSubParseProc;

PROCEDURE FalseSubParseProc(
    <*UNUSED*> self: SubParser;
    rd: Rd.T;
    ch, next: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} = 
  BEGIN
    RETURN ParseWord(rd, ch, next, CHARS{'f','a','l','s','e'}, Sx.False)
  END FalseSubParseProc;

PROCEDURE UndefinedSubParseProc(
    <*UNUSED*> self: SubParser;
    rd: Rd.T;
    ch, next: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} = 
  BEGIN
    RETURN ParseWord(
      rd, 
      ch, next, 
      CHARS{'u','n','d','e','f','i','n','e','d'}, 
      Sx.Undefined
    )
  END UndefinedSubParseProc;

PROCEDURE ParseWord(
    rd: Rd.T; 
    ch, next: CHAR;
    READONLY word: ARRAY OF CHAR; 
    result: REFANY
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} = 
  (* 
    Parses the token #W, #Word or #WORD, returning /result/.
    Called with the initial letter "W" already gobbled in /next/ *)
  VAR c: CHAR;
      upperCase: BOOLEAN := TRUE;
      lowerCase: BOOLEAN := TRUE;
      i: CARDINAL;
  BEGIN
    <* ASSERT next = Char.Upper[word[0]] *>
    TRY
      i := 1;
      LOOP
        c := Rd.GetChar(rd);
        IF NOT c IN Char.AlphaNumerics THEN 
          Rd.UnGetChar(rd);
          EXIT
        END;
        IF i > LAST(word) THEN 
          RAISE ReadError(BadIdentifier & " after " & PPChar(ch));
        END;
        lowerCase := lowerCase AND (c = word[i]);
        upperCase := upperCase AND (c = Char.Upper[word[i]]);
        IF NOT (lowerCase OR upperCase) THEN 
          RAISE ReadError(BadIdentifier & " after " & PPChar(ch))
        END;
        INC(i)
      END
    EXCEPT
    | Rd.EndOfFile => (* OK *)
    END;
    IF (i # 1) AND (i # NUMBER(word)) THEN
      RAISE ReadError(BadIdentifier & " after " & PPChar(ch))
    ELSE
      RETURN result
    END;
  END ParseWord;

PROCEDURE RefBooleanPrintProc(
    <*UNUSED*> self: Printer;
    fwr: FWr.T;
    value: REFANY;
    <*UNUSED*> elision: Elision;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  BEGIN
    Wr.PutChar(fwr, SharpChar);
    WITH boolean = NARROW(value, REF BOOLEAN)^ DO
      IF boolean THEN
        Wr.PutText(fwr, "TRUE");
      ELSE
        Wr.PutText(fwr, "FALSE");
      END
    END
  END RefBooleanPrintProc;

PROCEDURE UndefinedPrintProc(
    <*UNUSED*> self: Printer;
    fwr: FWr.T;
    <*UNUSED*> value: REFANY;
    <*UNUSED*> elision: Elision;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  BEGIN
    Wr.PutChar(fwr, SharpChar);
    Wr.PutText(fwr, "UNDEFINED")
  END UndefinedPrintProc;

(**********************************************************)
(* UNREADABLE VALUES                                      *)
(**********************************************************)

PROCEDURE UnreadableSubParseProc(
    <*UNUSED*> self: SubParser;
    <*UNUSED*> rd: Rd.T;
    <*UNUSED*> ch, next: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} = 
  BEGIN
    RAISE ReadError(UnreadableValue);
  END UnreadableSubParseProc;

PROCEDURE RefanyPrintProc(
    <*UNUSED*> self: Printer;
    fwr: FWr.T;
    value: REFANY;
    <*UNUSED*> elision: Elision;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  BEGIN
    Wr.PutChar(fwr, SharpChar);
    Wr.PutChar(fwr, OpenBogusSharpChar);
    Wr.PutText(fwr, 
      "TYPECODE: " & Fmt.Int(TYPECODE(value)) & " ADDR: " &
      "16_" & Fmt.Ref(value)
    );
    Wr.PutChar(fwr, CloseBogusSharpChar);
  END RefanyPrintProc;

(**********************************************************)
(* UNPRINTABLE VALUES                                     *)
(**********************************************************)

PROCEDURE IllegalValuePrintProc(
    <*UNUSED*> self: Printer;
    <*UNUSED*> fwr: FWr.T;
    value: REFANY;
    <*UNUSED*> elision: Elision;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T;
  ) RAISES {PrintError, Wr.Failure, Thread.Alerted} =
  (*
    A method that raises PrintError for any argument *)
  BEGIN
    RAISE PrintError(CantPrintThisStuff & " (TYPECODE = " & Fmt.Int(TYPECODE(value)) & ")");
  END IllegalValuePrintProc;

(**********************************************************)
(* INVALID SHARP TOKENS                                   *)
(**********************************************************)

PROCEDURE IllegalTwoCharSubParseProc(
    <*UNUSED*> self: SubParser;
    <*UNUSED*> rd: Rd.T;
    ch, next: CHAR;
    <*UNUSED*> root: SxSymbol.T;
    <*UNUSED*> syntax: T
  ): REFANY RAISES {ReadError, Rd.Failure, Thread.Alerted} = 
  BEGIN
    RAISE ReadError(BadTwoChar & " = " & PP2Char(ch, next));
  END IllegalTwoCharSubParseProc;

(**********************************************************)
(* STANDARD SYNTAX TABLE                                  *)
(**********************************************************)

PROCEDURE Standard(): T =
  VAR t := NEW(T,
      Read := Read,
      ReadUntil := ReadUntil,
      Print := Print,
      Copy := Copy
    );
  BEGIN

    t.printers := Tables{NIL, NIL};
    t.inputFilters := Tables{NIL, NIL};
    t.outputFilters := Tables{NIL, NIL};

    t.indentation := StandardIndentation;

    (* Symbols, invalid characters, and whitespace *)
    (* Initially, all non-blank graphic characters are allowed in symbols *)
    (* The special characters will be excluded later. *)

    t.symNumChars := SET OF CHAR{};
    SetSymNumParser(t,  NEW(Parser, apply := SymNumParseProc));
    FOR ch := FIRST(CHAR) TO LAST(CHAR) DO 
      IF ch IN Char.Spaces THEN
        MakeCharSpace(t, ch)
      ELSIF ch IN Char.Graphics THEN 
        MakeCharSymNum(t, ch)
      ELSE
        MakeCharIllegal(t, ch)
      END
    END;

    SetSymbolConverter   (t, NEW(SymbolConverter,   apply := SymbolConvertProc));
    SetIntConverter      (t, NEW(IntConverter,      apply := IntConvertProc));
    SetFloatConverter    (t, NEW(FloatConverter,    apply := FloatConvertProc));
    SetOtherNumConverter (t, NEW(OtherNumConverter, apply := OtherNumConvertProc));

    (* Texts, characters, lists, vectors: *)
    SetCharParser(t, TextQuote,  NEW(Parser, apply := TextParseProc));
    SetCharParser(t, CharQuote,  NEW(Parser, apply := CharParseProc));
    SetCharParser(t, ListOpen,   NEW(Parser, apply := ListParseProc));
    SetCharParser(t, VectorOpen, NEW(Parser, apply := VectorParseProc));

    (* Closing delimiters: *)
    WITH 
      sp = NEW(Parser, apply := UnmatchedCloseParseProc)
    DO
      SetCharParser(t, ListClose,  sp);
      SetCharParser(t, VectorClose, sp);
    END;

    (* Invalid sharp characters and line comments: *)
    WITH 
      linp = NEW(SubParser, apply := LineCmntSubParseProc)
    DO
      FOR next := FIRST(CHAR) TO LAST(CHAR) DO 
        IF next IN Char.Spaces THEN
          SetTwoCharParser(t, SharpChar, next, linp)
        ELSE
          MakeTwoCharIllegal(t, SharpChar, next)
        END;
      END;
    END;

    SetTwoCharParser(t, SharpChar, BlockCmntSharpChar, 
      NEW(SubParser, apply := BlockCmntSubParseProc)
    );
    SetTwoCharParser(t, SharpChar, OpenBogusSharpChar, 
      NEW(SubParser, apply := UnreadableSubParseProc)
    );
    SetTwoCharParser(t, SharpChar, 'T', 
      NEW(SubParser, apply := TrueSubParseProc)
    );
    SetTwoCharParser(t, SharpChar, 'F', 
      NEW(SubParser, apply := FalseSubParseProc)
    );
    SetTwoCharParser(t, SharpChar, 'U', 
      NEW(SubParser, apply := UndefinedSubParseProc)
    );

    SetRefPrinter(t, TYPECODE(NIL),           NEW(Printer, apply := NilPrintProc));
    SetRefPrinter(t, TYPECODE(REF INTEGER),   NEW(Printer, apply := RefIntegerPrintProc));
    SetRefPrinter(t, TYPECODE(REF REAL),      NEW(Printer, apply := RefRealPrintProc));
    SetRefPrinter(t, TYPECODE(REF LONGREAL),  NEW(Printer, apply := RefLongRealPrintProc));
    SetRefPrinter(t, TYPECODE(REF BOOLEAN),   NEW(Printer, apply := RefBooleanPrintProc));
    SetRefPrinter(t, TYPECODE(REF CHAR),      NEW(Printer, apply := RefCharPrintProc));
    SetRefPrinter(t, TYPECODE(UndefinedType), NEW(Printer, apply := UndefinedPrintProc));
    SetRefPrinter(t, TYPECODE(TEXT),          NEW(Printer, apply := TextPrintProc));
    SetRefPrinter(t, TYPECODE(List.T),        NEW(Printer, apply := ListPrintProc));
    SetRefPrinter(t, TYPECODE(SxSymbol.T),    NEW(Printer, apply := SymbolPrintProc));
    SetRefPrinter(t, TYPECODE(Vector),        NEW(Printer, apply := VectorPrintProc));

    SetDefaultPrinter(t, NEW(Printer, apply := RefanyPrintProc));
    RETURN t
  END Standard;

(**********************************************************)
(* ADDING/DELETING FILTERS                                *)
(**********************************************************)

PROCEDURE SetInputListFilter(t: T; symbol: SxSymbol.T; filter: Filter) =
  VAR old: REFANY;
  BEGIN
    IF filter = NIL THEN
      IF t.inputFilters.list = NIL THEN RETURN END;
      EVAL t.inputFilters.list.delete(symbol.number, old)
    ELSE
      IF t.inputFilters.list = NIL THEN 
        t.inputFilters.list := IntRefTbl.New()
      END;
      EVAL t.inputFilters.list.put(symbol.number, filter)
    END;
  END SetInputListFilter;

PROCEDURE SetInputRefFilter(t: T; typeCode: INTEGER; filter: Filter) =
  VAR old: REFANY;
  BEGIN
    IF filter = NIL THEN
      IF t.inputFilters.ref = NIL THEN RETURN END;
      EVAL t.inputFilters.ref.delete(typeCode, old)
    ELSE
      IF t.inputFilters.ref = NIL THEN 
        t.inputFilters.ref := IntRefTbl.New()
      END;
      EVAL t.inputFilters.ref.put(typeCode, filter)
    END;
  END SetInputRefFilter;

PROCEDURE SetOutputListFilter(t: T; symbol: SxSymbol.T; filter: Filter) =
  VAR old: REFANY;
  BEGIN
    IF filter = NIL THEN
      IF t.outputFilters.list = NIL THEN RETURN END;
      EVAL t.outputFilters.list.delete(symbol.number, old)
    ELSE
      IF t.outputFilters.list = NIL THEN 
        t.outputFilters.list := IntRefTbl.New()
      END;
      EVAL t.outputFilters.list.put(symbol.number, filter)
    END;
  END SetOutputListFilter;

PROCEDURE SetOutputRefFilter(t: T; typeCode: INTEGER; filter: Filter) =
  VAR old: REFANY;
  BEGIN
    IF filter = NIL THEN
      IF t.outputFilters.ref = NIL THEN RETURN END;
      EVAL t.outputFilters.ref.delete(typeCode, old)
    ELSE
      IF t.outputFilters.ref = NIL THEN 
        t.outputFilters.ref := IntRefTbl.New()
      END;
      EVAL t.outputFilters.ref.put(typeCode, filter)
    END;
  END SetOutputRefFilter;

(**********************************************************)
(* SPECIAL CHARACTERS                                     *)
(**********************************************************)

PROCEDURE MakeCharIllegal(t: T; ch: CHAR) =
  BEGIN
    SetCharParser(t, ch, NIL);
  END MakeCharIllegal;

PROCEDURE MakeCharSpace(t: T; ch: CHAR) =
  BEGIN
    t.charParsers[ch] := WhiteCharParser;
    t.symNumChars := t.symNumChars - SET OF CHAR{ch};
  END MakeCharSpace;

PROCEDURE MakeCharSymNum(t: T; ch: CHAR) =
  BEGIN
    t.charParsers[ch] := t.symNumParser;
    t.symNumChars := t.symNumChars + SET OF CHAR{ch};
  END MakeCharSymNum;

PROCEDURE SetCharParser(t: T; ch: CHAR; parser: Parser) =
 BEGIN
   IF parser = NIL THEN
     t.charParsers[ch] := IllegalCharParser;
   ELSE
     t.charParsers[ch] := parser;
   END;
   t.symNumChars := t.symNumChars - SET OF CHAR{ch};
 END SetCharParser;

PROCEDURE MakeTwoCharIllegal(t: T; ch, next: CHAR) =
  BEGIN
    SetTwoCharParser(t, ch, next, NIL)
  END MakeTwoCharIllegal;

PROCEDURE SetTwoCharParser(t: T; ch, next: CHAR; parser: SubParser) =
  BEGIN
    IF t.charParsers[ch] = NIL 
    OR NOT ISTYPE(t.charParsers[ch], SplitParser) THEN
      SetCharParser(t,
        ch,
        NEW(SplitParser, 
          apply := SplitParseProc,
          subParsers := ARRAY CHAR OF SubParser{IllegalTwoCharParser, ..}
        )
      )
    END;
    WITH main = NARROW(t.charParsers[ch], SplitParser) DO
      IF parser = NIL THEN
        main.subParsers[next] := IllegalTwoCharParser
      ELSE
        main.subParsers[next] := parser
      END;
    END
  END SetTwoCharParser;

PROCEDURE SetSymbolConverter(t: T; symbolConverter: SymbolConverter) =
  BEGIN
    t.symbolConverter := symbolConverter
  END SetSymbolConverter;

PROCEDURE SetIntConverter(t: T; intConverter: IntConverter) =
  BEGIN
    t.intConverter := intConverter
  END SetIntConverter;

PROCEDURE SetFloatConverter(t: T; floatConverter: FloatConverter) =
  BEGIN
    t.floatConverter := floatConverter
  END SetFloatConverter;

PROCEDURE SetOtherNumConverter(t: T; otherNumConverter: OtherNumConverter) =
  BEGIN
    t.otherNumConverter := otherNumConverter
  END SetOtherNumConverter;

PROCEDURE SetSymNumParser(t: T; parser: Parser) =
  BEGIN
    t.symNumParser := parser;
    FOR ch := FIRST(CHAR) TO LAST(CHAR) DO
      IF ch IN t.symNumChars THEN
        t.charParsers[ch] := parser
      END
    END
  END SetSymNumParser;

PROCEDURE SetRefPrinter(t: T; typeCode: INTEGER; printer: Printer) =
  VAR old: REFANY;
  BEGIN
    IF printer = NIL THEN
      IF t.printers.ref = NIL THEN RETURN END;
      EVAL t.printers.ref.delete(typeCode, (*OUT*) old)
    ELSE
      IF t.printers.ref = NIL THEN
        t.printers.ref := IntRefTbl.New()
      END;
      EVAL t.printers.ref.put(typeCode, printer);
    END;
  END SetRefPrinter;

PROCEDURE SetListPrinter(t: T; symbol: SxSymbol.T; printer: Printer) =
  VAR old: REFANY;
  BEGIN
    IF printer = NIL THEN
      IF t.printers.list = NIL THEN RETURN END;
      EVAL t.printers.list.delete(symbol.number, (*OUT*) old)
    ELSE
      IF t.printers.list = NIL THEN
        t.printers.list := IntRefTbl.New()
      END;
      EVAL t.printers.list.put(symbol.number, printer);
    END;
  END SetListPrinter;

PROCEDURE SetDefaultPrinter(t: T; printer: Printer) =
  BEGIN
    t.defaultPrinter := printer;
  END SetDefaultPrinter;

(**********************************************************)
(* INDENTATION                                            *)
(**********************************************************)

PROCEDURE SetIndentation(t: T; indentation: CARDINAL) =
  BEGIN
    t.indentation := indentation;
  END SetIndentation;

(**********************************************************)
(* MODULE INITIALIZATION                                  *)
(**********************************************************)

PROCEDURE Init() =
  BEGIN
    (* Note: Sx and SxPrivate are not yet initialized at this point. *)
    NoValue := NEW(NoValueType);
    InitParsers();
    InitSymNumFSM();
    InitDigitValue();
    SxPrivate.Init();
  END Init;

BEGIN
  Init();
END SxSyntax.