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