src/syntax/lexer.slate

   1 define: #Lexer &parents: {StreamProcessor}
   2   &slots: {#inputBuffer -> ExtensibleArray new.
   3            #outputBuffer -> ExtensibleArray new.
   4            "A backing buffer of tokens for undo functionality."
   5            #lineNumber -> 1 "The current line number."}.
   6 "The lexer takes an input character Stream and divides it up into Tokens,
   7 using a buffer as necessary to hold the tokenized contents.
   8 Also, debugging information is stored for now in terms of the line number that
   9 the current stream position has reached."
  10 Lexer traits define: #WordTerminatingTokens -> '()[]{}@,.|!#$`"\'%'.
  11
  12 l@(Lexer traits) on: stream
  13 "Target the lexer to the particular stream and initialize it."
  14 [
  15   l `>> [resend. reset. ]
  16 ].
  17
  18 l@(Lexer traits) reset
  19 [
  20   l inputBuffer := l inputBuffer new.
  21   l outputBuffer := l outputBuffer new.
  22   l lineNumber := 1.
  23 ].
  24
  25 l@(Lexer traits) showTokensFrom: src
  26 [
  27   (l newOn: src) do: [| :x | inform: x printString].
  28 ].
  29
  30 l@(Lexer traits) isEndOfLine: char [char == $\n].
  31 l@(Lexer traits) isEscape: char [char == $\\].
  32
  33 l@(Lexer traits) isAtEnd
  34 "The lexer has reached its end when the stream is exhausted and the buffer is
  35 empty."
  36 [
  37   l outputBuffer isEmpty /\ [l hasMoreCharacters not]
  38 ].
  39
  40 l@(Lexer traits) hasMoreCharacters
  41 "Answers whether more characters are immediately available."
  42 [
  43   "It is important not to query the source stream, unless the input buffer is
  44    actually empty."
  45   l inputBuffer isEmpty not \/ [l source isAtEnd not]
  46 ].
  47
  48 Lexer traits define: #Error &parents: {DescriptiveError}
  49   &slots: {#lineNumber -> 0 "The line number on which the error was detected."}.
  50 "An error that occurred in parsing, always requiring a description."
  51
  52 l@(Lexer traits) error: description
  53 [
  54   (l Error newDescription:
  55     'Line ' ; l lineNumber printString ; ': ' ; description)
  56     `>> [lineNumber := l lineNumber. signal]
  57 ].
  58
  59 l@(Lexer traits) nextCharacter
  60 "To get the next character, either pull one from the buffer or read from the
  61 stream of characters. Raise an error if this is used at the end, and advance
  62 the line number if a new-line is reached."
  63 [| c |
  64   c := l inputBuffer isEmpty
  65     ifTrue:
  66       [l source isAtEnd
  67          ifTrue: [l error: 'Unexpected end of stream'].
  68        l source next]
  69     ifFalse: [l inputBuffer removeLast].
  70   (l isEndOfLine: c) ifTrue: [l lineNumber += 1].
  71   c
  72 ].
  73
  74 l@(Lexer traits) undoCharacter: c
  75 "Put the character back into the buffer, and decrement the line number if it's
  76 a new-line."
  77 [
  78   (l isEndOfLine: c) ifTrue: [l lineNumber -= 1].
  79   l inputBuffer addLast: c
  80 ].
  81
  82 l@(Lexer traits) peekCharacter
  83 "Grab the next character, but leave it in the buffer, so the position is not
  84 advanced."
  85 [
  86   l inputBuffer isEmpty
  87     ifTrue: [l undoCharacter: l nextCharacter]
  88     ifFalse: [l inputBuffer last]
  89 ].
  90
  91 l@(Lexer traits) peekCharacterForwardBy: n
  92 [
  93   l inputBuffer isEmpty
  94     ifTrue: [l undoCharacter: l nextCharacter]
  95     ifFalse: [l inputBuffer last]
  96 ].
  97
  98 l@(Lexer traits) readInteger: radix
  99 "The general method for building integers from the raw characters, with a
 100 radix (number of digits) parameter. Grab all following digits for the radix,
 101 multiplying the accumulator by the radix and adding the numeric equivalent
 102 of the character."
 103 [| number |
 104   number := 0.
 105   [l hasMoreCharacters /\ [(l peekCharacter isDigit: radix) \/ [l peekCharacter == $_]]] whileTrue:
 106     [| c |
 107      ((c := l nextCharacter) toDigit: radix) ifNotNilDo:
 108        [| :digit | number := number * radix + digit]].
 109   number
 110 ].
 111
 112 l@(Lexer traits) readMantissa: radix
 113 "Build a floating-point number's fractional part."
 114 [| number place |
 115   number := 0.
 116   place := 1.
 117   [l hasMoreCharacters /\ [(l peekCharacter isDigit: radix) \/ [l peekCharacter == $_]]] whileTrue:
 118     [| c |
 119      ((c := l nextCharacter) toDigit: radix) ifNotNilDo:
 120        [| :digit |
 121         number := number * radix + digit.
 122         place *= radix]].
 123   (number as: Float) / (place as: Float)
 124 ].
 125
 126 l@(Lexer traits) readExponent: radix
 127 "Build a floating-point number's exponent as an integer."
 128 [| c |
 129   (c := l nextCharacter) == $-
 130     ifTrue: [(l readInteger: radix) negated]
 131     ifFalse:
 132       [c == $+ ifFalse: [l undoCharacter: c]. l readInteger: radix]
 133 ].
 134
 135 l@(Lexer traits) newLiteralFor: obj
 136 [tokens LiteralToken for: obj].
 137
 138 "l@(Lexer traits) newLiteralFor: a@(ByteArray traits)
 139 [
 140   a isEmpty
 141     ifTrue: [TODO: 'intern empty array/bytearray/string']
 142     ifFalse: [resend]
 143 ]."
 144
 145 l@(Lexer traits) readNumber
 146 "The overall routine for building numbers."
 147 [| number isNegative radix c |
 148   isNegative := False.
 149   radix := 10.
 150   (c := l nextCharacter) == $-
 151     ifTrue: [isNegative := True]
 152     ifFalse: [c == $+ ifFalse: [l undoCharacter: c]].
 153   "Now read in all the continuous string of digits possible as an integer."
 154   number := l readInteger: radix.
 155   "Reaching the end of the lexing stream just finalizes the process."
 156   l hasMoreCharacters ifTrue:
 157     ["Conditionalize on the next character: it may set up a radix or a decimal."
 158      (c := l nextCharacter) == $r \/ [c == $R] ifTrue:
 159        [((radix := number) between: 2 and: 36) ifFalse:
 160           [l error: 'Number radix must be between 2 and 36.'].
 161         number := l readInteger: radix.
 162         l hasMoreCharacters
 163           ifTrue: [c := l nextCharacter]
 164           ifFalse:
 165             [^ (l newLiteralFor: (isNegative ifTrue: [number negated] ifFalse: [number]))]].
 166      c == $. /\ [l hasMoreCharacters] /\ [l peekCharacter isDigit: radix] ifTrue:
 167        [number := (number as: Float) + (l readMantissa: radix).
 168         l hasMoreCharacters
 169           ifTrue: [c := l nextCharacter]
 170           ifFalse:
 171             [^ (l newLiteralFor: (isNegative ifTrue: [number negated] ifFalse: [number]))]].
 172      c == $e \/ [c == $E]
 173        ifTrue:
 174          [number := (number as: Float) * ((radix as: Float) raisedTo: (l readExponent: 10))]
 175        ifFalse:
 176          [l undoCharacter: c]].
 177   l newLiteralFor: (isNegative ifTrue: [number negated] ifFalse: [number])
 178 ].
 179
 180 l@(Lexer traits) readEscapedCharacter
 181 "Language support for character escapes. This should be called at the point
 182 after the initial escape is seen, whether as a character or part of a string."
 183 [| c |
 184   (c := l nextCharacter) caseOf: {
 185     $n -> [$\n].
 186     $t -> [$\t].
 187     $r -> [$\r].
 188     $b -> [$\b].
 189     $s -> [$\s].
 190     $a -> [$\a].
 191     $v -> [$\v].
 192     $f -> [$\f].
 193     $e -> [$\e].
 194     $0 -> [$\0].
 195     $x ->
 196       [((l nextCharacter toDigit: 16) ifNil:
 197           [l error: 'Unexpected numeric-escape Character syntax. Expected $\\xNN']) * 16
 198          + ((l nextCharacter toDigit: 16) ifNil:
 199               [l error: 'Unexpected numeric-escape Character syntax. Expected $\\xNN'])
 200          as: ASCIIString Character]
 201   } otherwise: [c]
 202 ].
 203
 204 l@(Lexer traits) characterFor: c
 205 [(l isEscape: c) ifTrue: [l readEscapedCharacter] ifFalse: [c]].
 206
 207 l@(Lexer traits) nextSegmentUntil: terminator
 208 [| c |
 209   [| :result |
 210    [(c := l nextCharacter) == terminator]
 211      whileFalse:
 212        [result nextPut: (l characterFor: c)]] writingAs: ''
 213 ].
 214
 215 l@(Lexer traits) readString
 216 "Build a string until the next single-quote character is encountered.
 217 Escaping is accounted for."
 218 [
 219   l newLiteralFor: (l nextSegmentUntil: $\')
 220 ].
 221
 222 l@(Lexer traits) read: t@(tokens Comment traits)
 223 "Build a comment string until the next double-quote character is encountered.
 224 Escaping is accounted for."
 225 [
 226   t for: (l nextSegmentUntil: $\")
 227 ].
 228
 229 l@(Lexer traits) nextWordCharactersInto: s@(WriteStream traits)
 230 [| c |
 231   [l hasMoreCharacters
 232      /\ [(c := l peekCharacter) isWhitespace not]
 233      /\ [(l WordTerminatingTokens includes: c) not]]
 234     whileTrue: [s nextPut: l nextCharacter]
 235 ].
 236
 237 l@(Lexer traits) read: type@(tokens Selector traits)
 238 "Read a selector symbol into a token."
 239 [| result |
 240   (result :=
 241      [| :result |
 242       l hasMoreCharacters /\ [l peekCharacter isDigit] ifFalse:
 243         [l nextWordCharactersInto: result]] writingAs: '') isEmpty
 244    ifTrue: []
 245    ifFalse: [type for: result]
 246 ].
 247
 248 l@(Lexer traits) readLiteralPastHash
 249 "This handles the literal brace array syntaxes as well as literal symbols."
 250 [
 251   l hasMoreCharacters
 252     /\ ['({[\'#' includes: l peekCharacter]
 253     ifTrue:
 254       [l nextCharacter caseOf: {
 255          $\( -> [tokens BeginPattern].
 256          $\{ -> [tokens BeginLiteralArray].
 257          $\[ -> [tokens BeginLiteralBlock].
 258          $\' -> [l newLiteralFor:
 259                    ([| :result c |
 260                      [(c := l nextCharacter) == $\']
 261                        whileFalse:
 262                          [result nextPut: (l characterFor: c)]]
 263                       writingAs: '') intern].
 264          $#  -> [l nextCharacter = $\(
 265                    ifTrue: [tokens BeginLiteralParenthesis]
 266                    ifFalse: [l error: 'Expected ( after ##']]
 267      }]
 268     ifFalse:
 269       [l newLiteralFor:
 270          (#(l nextWordCharactersInto: _) `er writingAs: '') intern]
 271 ].
 272
 273 l@(Lexer traits) readCharacter
 274 "Read in a single character into a token or an escaped one."
 275 [
 276   l newLiteralFor: (l characterFor: l nextCharacter)
 277 ].
 278
 279 l@(Lexer traits) read: w@(tokens Whitespace traits)
 280 "A way to preserve the whitespace in the original text. Unused by default."
 281 [| result c |
 282   result :=
 283     [| :result |
 284      [c := l nextCharacter.
 285       l hasMoreCharacters
 286         /\ [c isWhitespace]
 287         /\ [(l isEndOfLine: c) not]]
 288        whileTrue: [result nextPut: c]] writingAs: ''.
 289   l undoCharacter: c.
 290   w for: result
 291 ].
 292
 293 l@(Lexer traits) skipWhitespace
 294 [| c |
 295   l hasMoreCharacters ifTrue:
 296     [[c := l nextCharacter.
 297       l hasMoreCharacters
 298         /\ [c isWhitespace]
 299         /\ [(l isEndOfLine: c) not]]
 300        whileTrue.
 301      l undoCharacter: c].
 302 ].
 303
 304 l@(Lexer traits) readToken
 305 "The overall handler for tokenization, this conditionalizes on the various
 306 initializing characters to build the various token objects."
 307 "TODO: place these dispatch tables in persistent places, much like a Lisp
 308 read-table."
 309 [| c |
 310   "Consume/discard whitespace first."
 311   l skipWhitespace.
 312   l hasMoreCharacters
 313     ifTrue:
 314       [(c := l nextCharacter) caseOf: {
 315          $\' -> [l readString].
 316          $\" -> [l read: tokens Comment].
 317          $$ -> [l readCharacter].
 318          $# -> [l readLiteralPastHash].
 319          $( -> [tokens BeginParenthesis].
 320          $) -> [tokens EndParenthesis].
 321          ${ -> [tokens BeginArray].
 322          $} -> [tokens EndArray].
 323          $[ -> [tokens BeginBlock].
 324          $] -> [tokens EndBlock].
 325          $@ -> [tokens At].
 326          $. -> [tokens EndStatement].
 327          $, -> [tokens Comma].
 328          $\| -> [tokens BeginVariables].
 329          $! -> [tokens Type].
 330          $` -> [(l read: tokens MacroSelector) ifNil: [tokens Quote]].
 331          $% -> [(l read: tokens DeferredSelector) ifNil: [tokens Eventually]].
 332          $\n -> [tokens EndLine]
 333        } otherwise:
 334          [c isDigit \/ [c == $+ \/ [c == $-] /\ [l peekCharacter isDigit]]
 335             ifTrue: [l undoCharacter: c. l readNumber]
 336             ifFalse: [l undoCharacter: c.
 337                       (l read: tokens Selector)
 338                         ifNil: [l error: 'Message selector must not be empty.']]]]
 339     ifFalse: [tokens EndStream]
 340 ].
 341
 342 l@(Lexer traits) next
 343 [
 344   l outputBuffer isEmpty
 345     ifTrue: [l readToken]
 346     ifFalse: [l outputBuffer removeFirst]
 347 ].
 348
 349 l@(Lexer traits) peek
 350 [
 351   l outputBuffer isEmpty
 352     ifTrue: [l outputBuffer addLast: l readToken].
 353   l outputBuffer first
 354 ].
 355
 356 l@(Lexer traits) peek: n
 357 [
 358   [(l outputBuffer includesKey: n) not]
 359     whileTrue: [l outputBuffer addLast: l readToken].
 360   l outputBuffer first: n
 361 ].
 362
 363 l@(Lexer traits) peekForwardBy: n
 364 [
 365   [(l outputBuffer includesKey: n) not]
 366     whileTrue: [l outputBuffer addLast: l readToken].
 367   l outputBuffer at: n ifAbsent: [l error: 'Could not find token forward by: ' ; n printString]
 368 ].
 369
 370 l@(Lexer traits) undoToken: token
 371 [
 372   l outputBuffer addFirst: token
 373 ].
 374
 375 _@(Lexer traits) undoToken: t@(tokens EndStream traits)
 376 "Avoid placing EndStream tokens in the output buffer."
 377 [t].
 378
 379 t@(tokens Token traits) readFrom: s
 380 [| next |
 381   ((next := (Lexer newOn: s reader) next) is: t)
 382     ifTrue: [next]
 383     ifFalse: [error: 'The source did not parse into ' ; t printName asAn ; '.']
 384 ].