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