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