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