<* PRAGMA LL *> <* PRAGMA EXPORTED *> MODULEInvariant for Syntax: forall (c, c IN SELF.map iff exists (item in SELF.mlist, item.ch = c)); IMPORT Atom, FloatMode, Fmt, Lex, Rd, RdClass, RdUtils, RefList, Text, Thread, Wr; CONST MinBoxedInt = -100; MaxBoxedInt = 100; SLASH = '\\'; BAR = '|'; SQUOTE = '\''; DQUOTE = '"'; DIGITS = SET OF CHAR {'0'.. '9'}; LETTERS = SET OF CHAR {'a'.. 'z', 'A'.. 'Z'}; ALPHANUMERICS = LETTERS + DIGITS; BLANKS = SET OF CHAR {'\f', '\r', ' ', '\n', '\t', '\013'}; NOREADMACROS = BLANKS + SET OF CHAR {';'}; EXCEPTION SetReadMacroError; <* FATAL SetReadMacroError *> VAR BoxedInts := ARRAY [MinBoxedInt .. MaxBoxedInt] OF REF INTEGER {NIL, ..}; BoxedChars := ARRAY CHAR OF REF CHAR {NIL, ..}; BoxedReals := ARRAY [-1 .. 1] OF REF REAL {NIL, ..}; BoxedLongReals := ARRAY [-1 .. 1] OF REF LONGREAL {NIL, ..}; BoxedExtendeds := ARRAY [-1 .. 1] OF REF EXTENDED {NIL, ..}; <* EXPORTED *> PROCEDURE Sx FromInt (i: INTEGER): REF INTEGER = BEGIN IF MinBoxedInt <= i AND i <= MaxBoxedInt THEN RETURN BoxedInts [i] ELSE VAR r := NEW (REF INTEGER); BEGIN r^ := i; RETURN r END END END FromInt; <* EXPORTED *> PROCEDUREFromChar (c: CHAR): REF CHAR = BEGIN RETURN BoxedChars [c] END FromChar; <* EXPORTED *> PROCEDUREFromBool (b: BOOLEAN): Atom.T = BEGIN IF b THEN RETURN True ELSE RETURN False END END FromBool; <* EXPORTED *> PROCEDUREFromReal (x: REAL): REF REAL = BEGIN IF x = -1.0E0 THEN RETURN BoxedReals [-1] ELSIF x = 0.0E0 THEN RETURN BoxedReals [0] ELSIF x = 1.0E0 THEN RETURN BoxedReals [1] ELSE VAR r := NEW (REF REAL); BEGIN r^ := x; RETURN r END END END FromReal; <* EXPORTED *> PROCEDUREFromLongReal (x: LONGREAL): REF LONGREAL= BEGIN IF x = -1.0D0 THEN RETURN BoxedLongReals [-1] ELSIF x = 0.0D0 THEN RETURN BoxedLongReals [0] ELSIF x = 1.0D0 THEN RETURN BoxedLongReals [1] ELSE VAR r := NEW (REF LONGREAL); BEGIN r^ := x; RETURN r END END END FromLongReal; <* EXPORTED *> PROCEDUREFromExtended (x: EXTENDED): REF EXTENDED = BEGIN IF x = -1.0X0 THEN RETURN BoxedExtendeds [-1] ELSIF x = 0.0X0 THEN RETURN BoxedExtendeds [0] ELSIF x = 1.0X0 THEN RETURN BoxedExtendeds [1] ELSE VAR r := NEW (REF EXTENDED); BEGIN r^ := x; RETURN r END END END FromExtended; REVEAL Syntax = MUTEX BRANDED OBJECT <* LL = SELF *> map := SET OF CHAR {}; mlist: MList := NIL; END;
TYPE MList = REF RECORD ch : CHAR; m : ReadMacro; next: MList := NIL END; VAR Standard := NEW (Syntax); <* EXPORTED *> PROCEDUREThis is a simple class of reader with oneRead (rd: Rd.T; syntax: Syntax := NIL): T RAISES {ReadError, Rd.EndOfFile, Thread.Alerted} = VAR c: CHAR; s := syntax; a: RefList.T; m: ReadMacro; BEGIN IF s = NIL THEN s := Standard END; TRY LOOP LOOP Lex.Skip (rd, BLANKS); c := Rd.GetChar (rd); IF c # ';' THEN EXIT END; REPEAT c := Rd.GetChar (rd) UNTIL c = '\n' END; m := NIL; LOCK s DO IF c IN s.map THEN m := Syn (s, c).m END END; IF m # NIL THEN a := m.read (rd, syntax); IF a = NIL THEN (* skip *) ELSIF a.tail = NIL THEN RETURN a.head ELSE RAISE ReadError ( Fmt.F ("Read-macro for '%s' produced %s results", Text.FromChar (c), Fmt.Int (RefList.Length (a)))) END ELSE RETURN ReadToken (rd, c, syntax) END END EXCEPT | Rd.Failure (ref) => RAISE ReadError (RdUtils.FailureText (ref)) END END Read; <* EXPORTED *> PROCEDUREReadDelimitedList (rd: Rd.T; delim: CHAR; syntax: Syntax := NIL): RefList.T RAISES {ReadError, Thread.Alerted} = VAR c : CHAR; s := syntax; a : RefList.T; m : ReadMacro; res: RefList.T := NIL; BEGIN IF s = NIL THEN s := Standard END; TRY LOOP LOOP Lex.Skip (rd, BLANKS); c := Rd.GetChar (rd); IF c # ';' THEN EXIT END; REPEAT c := Rd.GetChar (rd) UNTIL c = '\n' END; m := NIL; LOCK s DO IF c IN s.map THEN m := Syn (s, c).m END END; IF m # NIL THEN a := m.read (rd, syntax); (* res := RefList.AppendD (res, RefList.Reverse (a)); *) WHILE a # NIL DO res := RefList.Cons (a.head, res); a := a.tail END ELSIF c = delim THEN RETURN RefList.ReverseD (res) ELSE res := RefList.Cons (ReadToken (rd, c, syntax), res) END END EXCEPT | Rd.EndOfFile => RAISE ReadError ("End-of-file in ReadDelimitedList") | Rd.Failure (ref) => RAISE ReadError (RdUtils.FailureText (ref)) END END ReadDelimitedList; CONST ATOM_CHARS = SET OF CHAR { '!', '#', '$', '%', '&', '*', '+', '-', '.', '/', ':', '<', '=', '>', '?', '@', '[', ']', '^', '_', '{', '}', '~'}; ID_CHARS = ALPHANUMERICS + SET OF CHAR {'_'}; PROCEDUREReadToken (rd: Rd.T; c: CHAR; s: Syntax): T RAISES {Rd.EndOfFile, Rd.Failure, ReadError, Thread.Alerted} = BEGIN IF c = DQUOTE THEN RETURN ReadDelimitedText (rd, c) ELSIF c = SQUOTE THEN RETURN FromChar (ReadCharLiteral (rd)) ELSIF c = '(' THEN RETURN ReadDelimitedList (rd, ')', s) ELSIF c = BAR THEN RETURN Atom.FromText (ReadDelimitedText (rd, BAR)) ELSIF c IN LETTERS THEN RETURN ReadAtom (rd, c, ID_CHARS) ELSIF c = '+' OR c = '-' OR c = '.' THEN (* ambiguous *) IF Rd.EOF (rd) THEN RETURN Atom.FromText (Text.FromChar (c)) ELSE VAR d := Rd.GetChar (rd); BEGIN IF d IN DIGITS THEN RETURN ReadNumber (rd, d, c) ELSIF d IN ATOM_CHARS THEN RETURN Atom.FromText (Text.FromChar (c) & Text.FromChar (d) & Lex.Scan (rd, ATOM_CHARS)) ELSE Rd.UnGetChar (rd); RETURN Atom.FromText (Text.FromChar (c)) END END END ELSIF c IN DIGITS THEN RETURN ReadNumber (rd, c, c) ELSIF c IN ATOM_CHARS THEN RETURN ReadAtom (rd, c, ATOM_CHARS) ELSE RAISE ReadError (Fmt.F ("Bad character '%s'", Text.FromChar (c))) END END ReadToken; PROCEDUREReadAtom (rd: Rd.T; c: CHAR; READONLY cs: SET OF CHAR): Atom.T RAISES {Rd.Failure, Thread.Alerted} = BEGIN RETURN Atom.FromText (Text.FromChar (c) & Lex.Scan (rd, cs)) END ReadAtom; TYPE RefArrayReader = Rd.T OBJECT mu: MUTEX METHODS init (): RefArrayReader := Init; putChar (ch: CHAR) RAISES {ReadError} := PutChar; OVERRIDES length := Length; seek := Seek; close := Close END;
buff
, pre-allocated.
Invariants: rd.lo = 0 and rd.length() = rd.hi.
We use this because we have to scan ahead to determine what type
of number we've got. As we scan, we store the digits in the buffer.
When we reach the end of the number, we pass the reader to the
appropriate procedure in Lex (Int, Real, LongReal, or Extended).
CONST MAXLEN = 4000; VAR Reader := NEW (RefArrayReader, mu := NEW (MUTEX), buff := NEW (REF ARRAY OF CHAR, MAXLEN), lo := 0, st := 0, seekable := TRUE, intermittent := FALSE); PROCEDUREInit (rd: RefArrayReader): RefArrayReader = BEGIN rd.cur := 0; rd.hi := 0; rd.closed := FALSE; RETURN rd END Init; PROCEDURESeek (rd: RefArrayReader; pos: CARDINAL; <* UNUSED *> dontBlock: BOOLEAN): RdClass.SeekResult = BEGIN rd.cur := pos; IF pos < rd.hi THEN RETURN RdClass.SeekResult.Ready ELSE RETURN RdClass.SeekResult.Eof END END Seek; PROCEDURELength (rd: RefArrayReader): INTEGER = BEGIN RETURN rd.hi END Length; PROCEDUREClose (<* UNUSED *> rd: RefArrayReader) = BEGIN END Close; PROCEDUREPutChar (rd: RefArrayReader; ch: CHAR) RAISES {ReadError} = BEGIN IF rd.hi >= MAXLEN THEN RAISE ReadError("Sx: Text literal or numeric too long") END; rd.buff[rd.hi] := ch; INC(rd.hi); END PutChar; PROCEDUREReadNumber (rd: Rd.T; c: CHAR; prev: CHAR): T RAISES {Rd.EndOfFile, Rd.Failure, ReadError, Thread.Alerted} = CONST HEX_DIGITS = SET OF CHAR {'0'.. '9', 'a'.. 'f', 'A'.. 'F'}; VAR wr := Reader; PROCEDURE scanExp (): Rd.T RAISES {Rd.EndOfFile, Rd.Failure, ReadError, Thread.Alerted} = BEGIN wr.putChar (c); c := Rd.GetChar (rd); IF c = '+' OR c = '-' THEN wr.putChar (c); c := Rd.GetChar (rd) END; IF NOT c IN DIGITS THEN RAISE ReadError ("Illegal exponent") END; REPEAT wr.putChar (c); c := Rd.GetChar (rd) UNTIL NOT c IN DIGITS; Rd.UnGetChar (rd); RETURN wr END scanExp; PROCEDURE scanFloat (): T RAISES {Lex.Error, FloatMode.Trap, Rd.EndOfFile, Rd.Failure, ReadError, Thread.Alerted} = BEGIN IF c = 'e' OR c = 'E' THEN RETURN FromReal (Lex.Real (scanExp ())) ELSIF c = 'd' OR c = 'D' THEN RETURN FromLongReal (Lex.LongReal (scanExp ())) ELSIF c = 'x' OR c = 'X' THEN RETURN FromExtended (Lex.Extended (scanExp ())) ELSE Rd.UnGetChar (rd); RETURN FromReal (Lex.Real (wr)) END END scanFloat; BEGIN TRY LOCK wr.mu DO EVAL wr.init (); IF NOT prev IN DIGITS THEN wr.putChar (prev) END; (* + - . *) REPEAT wr.putChar (c); c := Rd.GetChar (rd) UNTIL NOT c IN DIGITS; IF prev = '.' THEN RETURN scanFloat () ELSIF c = '_' THEN wr.putChar (c); c := Rd.GetChar (rd); IF NOT c IN HEX_DIGITS THEN RAISE ReadError ("Illegal integer") END; REPEAT wr.putChar (c); c := Rd.GetChar (rd) UNTIL NOT c IN HEX_DIGITS; Rd.UnGetChar (rd); RETURN FromInt (Lex.Int (wr)) ELSIF c = '.' THEN REPEAT wr.putChar (c); c := Rd.GetChar (rd) UNTIL NOT c IN DIGITS; RETURN scanFloat () ELSE Rd.UnGetChar (rd); RETURN FromInt (Lex.Int (wr)) END END EXCEPT | Lex.Error, FloatMode.Trap => RAISE ReadError ("Bad Format in number") END END ReadNumber; PROCEDUREReadDelimitedText (rd: Rd.T; delim: CHAR): TEXT RAISES {Rd.EndOfFile, Rd.Failure, ReadError, Thread.Alerted} = VAR wr := Reader; c : CHAR; BEGIN LOCK wr.mu DO EVAL wr.init (); LOOP c := Rd.GetChar (rd); IF c = delim THEN RETURN Text.FromChars (SUBARRAY (wr.buff^, 0, wr.hi)) ELSIF c = SLASH THEN wr.putChar (ReadEscapeSequence (rd, delim)) ELSIF ISO_Latin_printing (c) THEN wr.putChar (c) ELSE RAISE ReadError ("Illegal character in Text literal") END END END END ReadDelimitedText; PROCEDUREISO_Latin_printing (ch: CHAR): BOOLEAN = BEGIN RETURN ' ' <= ch AND ch <= '~' OR '\241' <= ch AND ch <= '\377' END ISO_Latin_printing; PROCEDUREReadCharLiteral (rd: Rd.T): CHAR RAISES {Rd.EndOfFile, Rd.Failure, ReadError, Thread.Alerted} = VAR c := Rd.GetChar (rd); BEGIN IF c = SQUOTE OR NOT ISO_Latin_printing (c) THEN RAISE ReadError ("Illegal character literal") END; IF c = SLASH THEN c := ReadEscapeSequence (rd, SQUOTE) END; IF Rd.GetChar (rd) = SQUOTE THEN RETURN c ELSE RAISE ReadError ("Illegal character literal") END END ReadCharLiteral; PROCEDUREReadEscapeSequence (rd: Rd.T; delim: CHAR): CHAR RAISES {Rd.EndOfFile, Rd.Failure, ReadError, Thread.Alerted} = (* Note that for reading, \' is allowed but unnecessary in text literals, and \" is allowed but unnecessary in character literals. *) CONST OCTAL_CODES = ARRAY ['0' .. '7'] OF INTEGER {0, 1, 2, 3, 4, 5, 6, 7}; VAR c := Rd.GetChar (rd); sum: [0 .. 8_377]; BEGIN IF c = 'n' THEN RETURN '\n' ELSIF c = 'r' THEN RETURN '\r' ELSIF c = 't' THEN RETURN '\t' ELSIF c = 'f' THEN RETURN '\f' ELSIF c = SLASH OR c = delim OR c = DQUOTE OR c = SQUOTE THEN RETURN c ELSIF '0' <= c AND c <= '3' THEN sum := OCTAL_CODES [c]; c := Rd.GetChar (rd); IF '0' <= c AND c <= '7' THEN sum := 8 * sum + OCTAL_CODES [c]; c := Rd.GetChar (rd); IF '0' <= c AND c <= '7' THEN sum := 8 * sum + OCTAL_CODES [c]; RETURN VAL (sum, CHAR) END END END; RAISE ReadError ("Illegal escape sequence") END ReadEscapeSequence; <* EXPORTED *> PROCEDUREPrintChar (wr: Wr.T; ch: CHAR; delim: CHAR) RAISES {Wr.Failure, Thread.Alerted} = BEGIN IF ch = '\n' THEN Wr.PutText (wr, "\\n") ELSIF ch = '\t' THEN Wr.PutText (wr, "\\t") ELSIF ch = '\r' THEN Wr.PutText (wr, "\\r") ELSIF ch = '\f' THEN Wr.PutText (wr, "\\f") ELSIF ch = SLASH THEN Wr.PutText (wr, "\\\\") ELSIF ch = delim THEN Wr.PutChar (wr, SLASH); Wr.PutChar (wr, ch) ELSIF ISO_Latin_printing (ch) THEN Wr.PutText (wr, Text.FromChar (ch)) ELSE Wr.PutText (wr, Fmt.F ("\\%03s", Fmt.Int (ORD (ch), 8))) END END PrintChar; PROCEDURENeedsBars (t: TEXT): BOOLEAN = VAR len := Text.Length (t); c : CHAR; BEGIN IF len = 0 THEN RETURN TRUE END; (* || *) c := Text.GetChar (t, 0); IF c IN LETTERS THEN FOR i := 1 TO len - 1 DO c := Text.GetChar (t, i); IF NOT c IN ID_CHARS THEN RETURN TRUE END END; RETURN FALSE ELSIF c IN ATOM_CHARS THEN FOR i := 1 TO len - 1 DO c := Text.GetChar (t, i); IF NOT c IN ATOM_CHARS THEN RETURN TRUE END END; RETURN FALSE ELSE RETURN TRUE END END NeedsBars; <* EXPORTED *> PROCEDURECopySyntax (s: Syntax := NIL): Syntax = VAR new := NEW (Syntax); oldml: MList; BEGIN IF s # NIL THEN new.map := s.map; LOCK s DO oldml := s.mlist; WHILE oldml # NIL DO new.mlist := NEW (MList, ch := oldml.ch, m := oldml.m, next := new.mlist); oldml := oldml.next END END END; RETURN new END CopySyntax; PROCEDURESyn (s: Syntax; ch: CHAR): MList = <* LL = s *> VAR ml := s.mlist; BEGIN LOOP IF ml.ch = ch THEN RETURN ml ELSE ml := ml.next END END END Syn; <* EXPORTED *> PROCEDURESetReadMacro (s: Syntax; ch: CHAR; m: ReadMacro) = PROCEDURE remove (VAR ml: MList) = (* My favorite use of VAR *) BEGIN IF ml.ch = ch THEN ml := ml.next ELSE remove (ml.next) END END remove; BEGIN IF s = NIL THEN RAISE SetReadMacroError END; LOCK s DO IF ch IN NOREADMACROS THEN RAISE SetReadMacroError END; IF ch IN s.map THEN IF m = NIL THEN VAR tmp := SET OF CHAR {ch}; BEGIN (* Win32 code generator bug *) s.map := s.map - tmp; END; remove (s.mlist) ELSE Syn (s, ch).m := m END ELSIF m # NIL THEN VAR tmp := SET OF CHAR {ch}; BEGIN (* Win32 code generator bug *) s.map := s.map + tmp; END; s.mlist := NEW (MList, ch := ch, m := m, next := s.mlist) END END END SetReadMacro; BEGIN True := Atom.FromText ("TRUE"); False := Atom.FromText ("FALSE"); FOR i := MinBoxedInt TO MaxBoxedInt DO BoxedInts [i] := NEW (REF INTEGER); BoxedInts [i]^ := i END; FOR c := FIRST (CHAR) TO LAST (CHAR) DO BoxedChars [c] := NEW (REF CHAR); BoxedChars [c]^ := c END; FOR i := -1 TO +1 DO BoxedReals [i] := NEW (REF REAL); BoxedReals [i]^ := FLOAT (i, REAL); BoxedLongReals [i] := NEW (REF LONGREAL); BoxedLongReals [i]^ := FLOAT (i, LONGREAL); BoxedExtendeds [i] := NEW (REF EXTENDED); BoxedExtendeds [i]^ := FLOAT (i, EXTENDED) END END Sx.