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