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: (l nextSegmentUntil: $\') intern].
 274          $#  -> [l nextCharacter = $\(
 275                    ifTrue: [tokens BeginLiteralParenthesis]
 276                    ifFalse: [l error: 'Expected ( after ##']]
 277      }]
 278     ifFalse:
 279       [l newLiteralFor:
 280          (#(l nextWordCharactersInto: _) `er writingAs: '') intern]
 281 ].
 282
 283 l@(Lexer traits) readCharacter
 284 "Read in a single character into a token or an escaped one."
 285 [
 286   l newLiteralFor: (l characterFor: l nextCharacter)
 287 ].
 288
 289 l@(Lexer traits) read: w@(tokens Whitespace traits)
 290 "A way to preserve the whitespace in the original text. Unused by default."
 291 [| result c |
 292   result :=
 293     [| :result |
 294      [c := l nextCharacter.
 295       l hasMoreCharacters
 296         /\ [c isWhitespace]
 297         /\ [(l isEndOfLine: c) not]]
 298        whileTrue: [result nextPut: c]] writingAs: ''.
 299   l undoCharacter: c.
 300   w for: result
 301 ].
 302
 303 l@(Lexer traits) skipWhitespace
 304 [| c |
 305   l hasMoreCharacters ifTrue:
 306     [[c := l nextCharacter.
 307       l hasMoreCharacters
 308         /\ [c isWhitespace]
 309         /\ [(l isEndOfLine: c) not]]
 310        whileTrue.
 311      l undoCharacter: c].
 312 ].
 313
 314 l@(Lexer traits) readToken
 315 "The overall handler for tokenization, this conditionalizes on the various
 316 initializing characters to build the various token objects."
 317 "TODO: place these dispatch tables in persistent places, much like a Lisp
 318 read-table."
 319 [| c |
 320   "Consume/discard whitespace first."
 321   l skipWhitespace.
 322   l hasMoreCharacters
 323     ifTrue:
 324       [(c := l nextCharacter) caseOf: {
 325          $\' -> [l readString].
 326          $\" -> [l read: tokens Comment].
 327          $$ -> [l readCharacter].
 328          $# -> [l readLiteralPastHash].
 329          $( -> [tokens BeginParenthesis].
 330          $) -> [tokens EndParenthesis].
 331          ${ -> [tokens BeginArray].
 332          $} -> [tokens EndArray].
 333          $[ -> [tokens BeginBlock].
 334          $] -> [tokens EndBlock].
 335          $@ -> [tokens At].
 336          $. -> [tokens EndStatement].
 337          $, -> [tokens Comma].
 338          $\| -> [tokens BeginVariables].
 339          $! -> [tokens Type].
 340          $` -> [(l read: tokens MacroSelector) ifNil: [tokens Quote]].
 341          $% -> [(l read: tokens DeferredSelector) ifNil: [tokens Eventually]].
 342          $\n -> [tokens EndLine]
 343        } otherwise:
 344          [c isDigit \/ [c == $+ \/ [c == $-] /\ [l peekCharacter isDigit]]
 345             ifTrue: [l undoCharacter: c. l readNumber]
 346             ifFalse: [l undoCharacter: c.
 347                       (l read: tokens Selector)
 348                         ifNil: [l error: 'Message selector must not be empty.']
 349                         ifNotNilDo:
 350                           [| :sel |
 351                            l isAtEnd not /\
 352                              [l QuoteMacroChars includesKey: l peekCharacter]
 353                              ifTrue: [l nextQuoteMacroNamed: sel]
 354                              ifFalse: [sel]]]]]
 355     ifFalse: [tokens EndStream]
 356 ].
 357
 358 l@(Lexer traits) next
 359 [
 360   l outputBuffer isEmpty
 361     ifTrue: [l readToken]
 362     ifFalse: [l outputBuffer removeFirst]
 363 ].
 364
 365 l@(Lexer traits) peek
 366 [
 367   l outputBuffer isEmpty
 368     ifTrue: [l outputBuffer addLast: l readToken].
 369   l outputBuffer first
 370 ].
 371
 372 l@(Lexer traits) peek: n
 373 [
 374   [(l outputBuffer includesKey: n) not]
 375     whileTrue: [l outputBuffer addLast: l readToken].
 376   l outputBuffer first: n
 377 ].
 378
 379 l@(Lexer traits) peekForwardBy: n
 380 [
 381   [(l outputBuffer includesKey: n) not]
 382     whileTrue: [l outputBuffer addLast: l readToken].
 383   l outputBuffer at: n ifAbsent: [l error: 'Could not find token forward by: ' ; n printString]
 384 ].
 385
 386 l@(Lexer traits) undoToken: token
 387 [
 388   l outputBuffer addFirst: token
 389 ].
 390
 391 _@(Lexer traits) undoToken: t@(tokens EndStream traits)
 392 "Avoid placing EndStream tokens in the output buffer."
 393 [t].
 394
 395 t@(tokens Token traits) readFrom: s
 396 [| next |
 397   ((next := (Lexer newOn: s reader) next) is: t)
 398     ifTrue: [next]
 399     ifFalse: [error: 'The source did not parse into ' ; t printName asAn ; '.']
 400 ].