src/syntax/parser.slate

   1 define: #Parser &parents: {ReadStream} &slots: {
   2   #lexer -> Lexer.
   3   #currentScope -> nodes Ground.
   4   "Where expressions are evaluated."
   5   #typesNamespace -> Types.
   6   "Where expressions following ! annotations are evaluated."
   7   #parseInteractively -> False.
   8   "Whether a newline after a complete expression denotes completion."
   9 }.
  10 "Reads tokens from a Lexer and builds a Syntax Node tree for it."
  11
  12 Parser traits define: #EndStatementTokens &builder: [{tokens EndStatement. tokens EndStream}].
  13 Parser traits define: #EndBlockStatementTokens &builder: [{tokens EndStatement. tokens EndBlock}].
  14 Parser traits define: #EndParenthesisStatementTokens &builder: [{tokens EndStatement. tokens EndParenthesis}].
  15 Parser traits define: #EndArrayStatementTokens &builder: [{tokens EndStatement. tokens EndArray}].
  16 Parser traits define: #InteractiveExcludeTokens &builder: [{tokens Comment}].
  17 Parser traits define: #ExcludeTokens &builder: [{tokens Comment. tokens EndLine}].
  18
  19 Parser traits define: #SpecialBinarySelectors &builder:
  20   [#{#:=. #::=. #=:=. #?=. #+=. #-=. #*=. #/= ".#^. #^^"}].
  21
  22 obj@(Root traits) recordPositionFrom: p@(Parser traits)
  23 [(nodes Literal for: obj) recordPositionFrom: p].
  24
  25 node@(nodes Node traits) recordPositionFrom: p@(Parser traits)
  26 [
  27   node `>>
  28    [lineNumber := p lexer lineNumber.
  29     source := p lexer source. ]
  30 ].
  31
  32 p@(Parser traits) on: source
  33 [
  34   p `>>
  35     [lexer := p lexer newOn: source reader.
  36      reset. ]
  37 ].
  38
  39 p@(Parser traits) reset
  40 [
  41   p lexer reset.
  42 ].
  43
  44 p@(Parser traits) is: token likeAnyOf: options
  45 [
  46   options anySatisfy: [| :opt | token isSameAs: opt]
  47 ].
  48
  49 p@(Parser traits) excludedTokens &interactive: interactive
  50 [
  51   (interactive `defaultsTo: p parseInteractively)
  52     ifTrue: [p InteractiveExcludeTokens]
  53     ifFalse: [p ExcludeTokens]
  54 ].
  55
  56 p@(Parser traits) nextToken &interactive: interactive
  57 "Takes the next token from either the buffer or the lexer transparently."
  58 [| token |
  59   exclude ::= p excludedTokens &interactive: interactive.
  60   [p is: (token := p lexer next)
  61      likeAnyOf: exclude] whileTrue.
  62   token
  63 ].
  64
  65 p@(Parser traits) peekToken &interactive: interactive
  66 "Return the next non-stop token from the Lexer, but leave it in the buffer
  67 and don't update the position."
  68 [| token lookAheadIndex |
  69   exclude ::= p excludedTokens &interactive: interactive.
  70   "Return the next non-stop token."
  71   lookAheadIndex := -1.
  72   [p is: (token := p lexer peekForwardBy: (lookAheadIndex += 1))
  73      likeAnyOf: exclude] whileTrue.
  74   token
  75 ].
  76
  77 p@(Parser traits) undoToken: token
  78 [
  79   p lexer undoToken: token
  80 ].
  81
  82 p@(Parser traits) isAtEnd
  83 [
  84   p lexer isAtEnd
  85 ].
  86
  87 Parser traits define: #Error &parents: {Lexer Error}.
  88 "An error that occurred in parsing, always requiring a description."
  89
  90 p@(Parser traits) error: description
  91 [
  92   (p Error newDescription:
  93     'Line ' ; p lexer lineNumber printString ; ': ' ; description)
  94    `>> [lineNumber := p lexer lineNumber. signal]
  95 ].
  96
  97 p@(Parser traits) unexpectedlyFound: found after: expr
  98 [
  99   p error: 'Expected: (anything else) but found: ' ; found signifier ; ' after: ' ; expr printString
 100 ].
 101
 102 p@(Parser traits) expected: expected butFound: found@(tokens Token traits)
 103 [
 104   p error: 'Expected: ' ; expected signifier  ; ' but found: ' ; found signifier
 105 ].
 106
 107 p@(Parser traits) check: found is: expected@(tokens Token traits)
 108 [(found isSameAs: expected) ifFalse:
 109   [p expected: expected butFound: found]].
 110
 111 p@(Parser traits) check: found is: expected@(Sequence traits)
 112 [(expected anySatisfy: #(isSameAs: found) `er) ifFalse:
 113   [p expected: expected butFound: found]].
 114
 115 p@(Parser traits) expected: expected@(Sequence traits) butFound: found
 116 [
 117   expectNames ::= expected collect: #signifier `er select: #isNotNil `er.
 118   p error: 'Expected ' ; expectNames printString ; ' but found ' ; found signifier
 119 ].
 120
 121 p@(Parser traits) nextExpression
 122 [| token lookAheadIndex |
 123   lookAheadIndex := 0.
 124   [token := p lexer peekForwardBy: lookAheadIndex.
 125    token == tokens BeginVariables \/ [token == tokens Eventually] ifTrue:
 126      [p lexer outputBuffer at: lookAheadIndex put:
 127         (tokens Selector for: (p nextLiteralFrom: token))].
 128    token == tokens At ifTrue:
 129      [^ (p nextMessage &after: (p recordDeclaredTypeOf: p nextSignatureOrDefinition))].
 130    lookAheadIndex += 1.
 131    (token isSameAs: tokens Selector)
 132      \/ [token isSameAs: tokens Comment]
 133      \/ [p parseInteractively not \/ [lookAheadIndex = 1]
 134            /\ [token isSameAs: tokens EndLine]]] whileTrue.
 135   p nextMessage
 136 ].
 137
 138 p@(Parser traits) nextAsStatement
 139 "Find a complete expression suitable as a statement."
 140 [
 141   p nextExpression ifNil: [nodes Literal Nil]
 142 ].
 143
 144 p@(Parser traits) next
 145 "The top-level Stream processing to return the next syntax node."
 146 [| token terminatesCorrectly |
 147   statement ::= p nextExpression.
 148   "Unless parsing lines greedily, statements need to be separated explicitly or be at the end of the input."
 149   (terminatesCorrectly := p is: (token := p nextToken) likeAnyOf: p EndStatementTokens)
 150     \/ [p parseInteractively]
 151     ifFalse: [p error: 'Expression was not terminated or separated correctly.'].
 152   statement ifNil:
 153     [terminatesCorrectly
 154        ifTrue: [nodes Literal Nil]
 155        ifFalse: [p expected: p EndStatementTokens
 156                    butFound: (p nextToken &interactive: p parseInteractively)]]
 157 ].
 158
 159 p@(Parser traits) nonInteractivelyDo: block
 160 [
 161   interactive ::= p parseInteractively.
 162   p parseInteractively := False.
 163   [block do] ensure: [p parseInteractively: interactive]
 164 ].
 165
 166 p@(Parser traits) inScope: scope do: block
 167 [
 168   oldScope ::= p currentScope.
 169   p currentScope := scope.
 170   [block do] ensure: [p currentScope := oldScope]
 171 ].
 172
 173 p@(Parser traits) nextAtom
 174 [
 175   (p nextFrom: (token ::= p nextToken))
 176     ifNil: [p undoToken: token. ]
 177     ifNotNilDo: [| :node | p recordDeclaredTypeOf: (node recordPositionFrom: p)]
 178 ].
 179
 180 p@(Parser traits) nextLiteral
 181 [
 182   p nextLiteralFrom: p nextToken
 183 ].
 184
 185 p@(Parser traits) recordDeclaredTypeOf: obj
 186 [obj].
 187
 188 p@(Parser traits) recordDeclaredTypeOf: node@(nodes Node traits)
 189 "Sets the type attribute of the node based on the suffixed type annotation.
 190 Type expressions are evaluated in a separate namespace for convenience.
 191 Type annotation suffixes may also be chained (for no particular reason)."
 192 [| token |
 193   p inScope: (p currentScope topLevel for: p typesNamespace) do:
 194     [[(token := p nextToken &interactive: p parseInteractively)
 195         isSameAs: tokens Type]
 196        whileTrue:
 197          [node type := p nextAtom
 198             ifNil: [p error: 'No type given after type declaration marker.']
 199             ifNotNilDo: [| :typeExpr | typeExpr evaluateIn: p typesNamespace]].
 200      p undoToken: token].
 201   node
 202 ].
 203
 204 p@(Parser traits) nextMessage &after: node
 205 [
 206   p parseRestArgumentsFor:
 207     (p parseOptionalKeywordsFor:
 208       (p nextPattern &after: node))
 209 ].
 210
 211 p@(Parser traits) parseRestArgumentsFor: expr
 212 [
 213   ((token ::= p peekToken) isSameAs: tokens Comma)
 214     ifTrue: [p unexpectedlyFound: token after: expr]
 215     ifFalse: [expr]
 216 ].
 217
 218 p@(Parser traits) parseRestArgumentsFor: message@(nodes Message traits)
 219 [| token arguments |
 220   arguments :=
 221     [| :arguments |
 222      [(token := p nextToken) isSameAs: tokens Comma]
 223        whileTrue: [arguments nextPut: p nextBinaryMessages]] writingAs: #{}.
 224   p undoToken: token.
 225   arguments
 226     ifEmpty: [message]
 227     ifNotEmpty: [(nodes RestArguments for: message) `>>
 228                    [arguments := arguments.
 229                     recordPositionFrom: p]]
 230 ].
 231
 232 p@(Parser traits) parseOptionalKeywordsFor: expr
 233 [
 234   (Syntax isOptionalSelector: (token ::= p peekToken))
 235     ifTrue: [p unexpectedlyFound: token after: expr]
 236     ifFalse: [expr]
 237 ].
 238
 239 p@(Parser traits) parseOptionalKeywordsFor: message@(nodes Message traits)
 240 [| token keywords arguments |
 241   arguments := #{} writer.
 242   keywords :=
 243     [| :keywords |
 244      [Syntax isOptionalSelector: (token := p nextToken)]
 245        whileTrue:
 246          [token value last = $:
 247             ifTrue: [keywords nextPut: token value intern.
 248                      arguments nextPut: p nextBinaryMessages]
 249             ifFalse: [keywords nextPut: (token value ; ':') intern.
 250                       arguments nextPut: (nodes Literal for: True)]]]
 251        writingAs: #{}.
 252   p undoToken: token.
 253   keywords
 254     ifEmpty: [message]
 255     ifNotEmpty: [(nodes OptionalKeywords for: message) `>>
 256                    [keywords := keywords.
 257                     arguments := arguments contents.
 258                     recordPositionFrom: p]]
 259 ].
 260
 261 p@(Parser traits) nextUnaryMessages &after: node
 262 [| result token |
 263   result := node `defaultsTo: p nextAtom.
 264   [Syntax isUnarySelector: (token := p nextToken &interactive: p parseInteractively)]
 265     whileTrue:
 266       [(result := token messageType sending: token value to: {result})
 267          recordPositionFrom: p.
 268        p recordDeclaredTypeOf: result].
 269   p undoToken: token.
 270   result
 271 ].
 272
 273 p@(Parser traits) nextBinaryMessages &after: node
 274 [| result token firstArg |
 275   result := p nextUnaryMessages &after: node.
 276   [(Syntax isBinarySelector: (token := p nextToken &interactive: p parseInteractively))
 277      /\ [p SpecialBinarySelectors noneSatisfy: [| :sel | token value =~ sel]]]
 278     whileTrue:
 279       [result := result isNil /\ [Syntax isReturnSelector: token]
 280          ifTrue:
 281            [(token value caseOf:
 282                {'^' -> [nodes ReturnClose].
 283                 '^^' -> [nodes ReturnFar]}
 284                otherwise: [nodes ReturnLevel by:
 285                              (Integer readFrom: token value allButFirst)])
 286               of: p nextUnaryMessages]
 287          ifFalse:
 288            [firstArg := result ifNil: [nodes ImplicitArgument].
 289             token messageType sending: token value to:
 290               (p nextUnaryMessages
 291                  ifNil: [{firstArg}]
 292                  ifNotNilDo: [| :secondArg | {firstArg. secondArg}])].
 293        result recordPositionFrom: p].
 294   p undoToken: token.
 295   result
 296 ].
 297
 298 p@(Parser traits) nextKeywordMessages &after: argument
 299 "Handles/creates all kewyord-message-send forms. It must gather all keywords
 300 into a single selector with arguments."
 301 [| messageType token result arguments selector |
 302   argument := p nextBinaryMessages &after: argument.
 303   token := p peekToken &interactive: p parseInteractively.
 304   selector := '' writer.
 305   (Syntax isKeywordSelector: token)
 306     ifTrue:
 307       [arguments :=
 308          [| :result |
 309           result nextPut: (argument ifNil: [nodes ImplicitArgument]).
 310           [(Syntax isKeywordSelector: (token := p nextToken &interactive: p parseInteractively))
 311              /\ [messageType isNil \/ [token messageType == nodes Message]]
 312              /\ [(Syntax isOptionalSelector: token) not]]
 313             whileTrue:
 314               [messageType ifNil: [messageType := token messageType].
 315                (Syntax isKeywordSelector: token)
 316                  ifFalse: [p error: 'Bad keyword token'].
 317                selector ; token value.
 318                result nextPut:
 319                  (p nextBinaryMessages ifNil: [p error: 'Bad keyword argument (being implicit).'])].
 320           p undoToken: token] writingAs: #{}.
 321        selector := selector contents.
 322        "Handle the special case of a StoreVariable:"
 323        arguments size = 2 /\ [arguments first isSameAs: nodes ImplicitArgument]
 324          ifTrue:
 325            [(p currentScope findVariable: selector allButLast intern)
 326               ifNotNilDo:
 327                 [| :variable | ^ ((variable store: arguments second) recordPositionFrom: p)]].
 328        (messageType sending: selector to: arguments) recordPositionFrom: p]
 329     ifFalse: [argument]
 330 ].
 331
 332 p@(Parser traits) nextSpecialBinaryMessages &after: node
 333 "Handles/creates all special-message-send forms."
 334 [| token result |
 335   result := p nextKeywordMessages &after: node.
 336   [(Syntax isBinarySelector: (token := p nextToken &interactive: p parseInteractively))
 337      /\ [p SpecialBinarySelectors anySatisfy: [| :sel | token value =~ sel]]]
 338     whileTrue:
 339       [result := nodes BinaryMacro sending: token value to:
 340          (p nextExpression ifNil: [{result}] ifNotNilDo: [| :rhs | {result. rhs}])].
 341   p undoToken: token.
 342   result
 343 ].
 344
 345 p@(Parser traits) nextPattern &after: node
 346 [| token result pattern |
 347   result := p nextSpecialBinaryMessages &after: node.
 348   [(token := p nextToken &interactive: p parseInteractively) == tokens BeginPattern
 349     \/ [(token isSameAs: tokens LiteralToken) /\ [token value isSameAs: Symbol]]]
 350     whileTrue:
 351       [token == tokens BeginPattern
 352          ifTrue: [(pattern := p nextFrom: token) arity >= 1
 353                     ifTrue:
 354                       [pattern completeWith: {result}.
 355                        result := pattern message]
 356                     ifFalse: [p error: 'Pattern cascaded with too many placeholders.']]
 357          ifFalse: [result := nodes Message sending: token value to: {result}]].
 358   p undoToken: token.
 359   result
 360 ].
 361
 362 p@(Parser traits) newVariableNamed: name in: block
 363 [
 364   nodes Variable clone `>>
 365     [name := name intern. scope := block. recordPositionFrom: p]
 366 ].
 367
 368 p@(Parser traits) nextBlock &updating: block
 369 [| token statements lineNumber inputVariables optKeywords optVariables |
 370   block `defaultsTo: (nodes Block new recordPositionFrom: p).
 371   lineNumber := p lexer lineNumber.
 372   inputVariables := #{} writer.
 373   optKeywords := #{} writer.
 374   optVariables := #{} writer.
 375   block parentScope := p currentScope.
 376   p inScope: block do:
 377     [p nonInteractivelyDo:
 378        [((token := p nextToken) isSameAs: tokens BeginVariables)
 379           ifTrue:
 380             [token := p nextToken.
 381              [token isSameAs: tokens EndVariables]
 382                whileFalse:
 383                  [| variable name varName |
 384                   (token isSameAs: tokens Selector)
 385                     ifFalse: [p error: 'Bad variable declaration'].
 386                   name := token value.
 387                   (Syntax isUnarySelector: name)
 388                     ifTrue:
 389                       [variable := block localVariables
 390                          detect: [| :var | name =~ var name /\ [(name =~ #_) not]]
 391                          ifNone: [p newVariableNamed: name in: block]]
 392                     ifFalse:
 393                       [varName := name allButFirst intern.
 394                        (Syntax isUnarySelector: varName) ifFalse:
 395                          [p error: 'Bad rest variable declaration: ' ; name].
 396                        (varName =~ #_) not
 397                          /\ [block localVariables anySatisfy: [| :var | varName =~ var name]]
 398                          ifTrue: [p error: 'Variable already declared: ' ; varName].
 399                        variable := p newVariableNamed: varName in: block.
 400                        name first caseOf:
 401                          {$* -> [block restVariable := variable].
 402                           $: -> [inputVariables nextPut: variable].
 403                           $& -> [optKeywords nextPut: name intern.
 404                                  optVariables nextPut: variable]}
 405                          otherwise: [p error: 'Bad declaration in Block header: ' ; name]].
 406                   p recordDeclaredTypeOf: variable.
 407                   token := p nextToken.
 408                   variable name = #_
 409                     \/ [block localVariables noneSatisfy: [| :var | variable name =~ var name]]
 410                     ifTrue: [block localVariables := block localVariables copyWith: variable]]]
 411           ifFalse: [p undoToken: token].
 412         block inputVariables := block inputVariables ; inputVariables contents.
 413         block optionalKeywords := block optionalKeywords ; optKeywords contents.
 414         block optionalVariables := block optionalVariables ; optVariables contents.
 415         "Defines the order of locals: inputs, optionals, rest, then non-optional locals."
 416         block localVariables :=
 417           block inputVariables ;
 418           block optionalVariables ;
 419           (block restVariable ifNil: [#{}] ifNotNilDo: [| :rest | {rest}]) ;
 420           (block localVariables select:
 421              [| :var |
 422               (block inputVariables includes: var) not
 423                 /\ [(block optionalVariables includes: var) not]
 424                 /\ [block restVariable ~== var]]).
 425         statements := #{} writer.
 426         statements nextPut: p nextAsStatement.
 427         [(token := p nextToken) isSameAs: tokens EndBlock]
 428           whileFalse:
 429             [p check: token is: p EndBlockStatementTokens.
 430              statements nextPut: p nextAsStatement]]].
 431   block statements := statements contents.
 432   block
 433 ].
 434
 435 p@(Parser traits) parseRoleAnnotationFor: sig@(nodes Signature traits)
 436 [| token |
 437   (token := p nextToken) == tokens At
 438    ifTrue: [sig roles := sig roles copyWith: p nextAtom]
 439    ifFalse: [p undoToken: token. sig roles := sig roles copyWith: ((nodes Literal for: NoRole) recordPositionFrom: p)].
 440   sig
 441 ].
 442
 443 p@(Parser traits) parseInputVariableFor: sig@(nodes Signature traits)
 444 [| token |
 445   (Syntax isUnarySelector: (token := p nextToken))
 446    ifTrue: [sig inputVariables := sig inputVariables copyWith: (p newVariableNamed: token value in: sig).
 447             p parseRoleAnnotationFor: sig]
 448    ifFalse: [p undoToken: token]. "TODO conditionally throw an error? or check for / handle a pattern"
 449   sig
 450 ].
 451
 452 p@(Parser traits) parseOptionalKeywordsFor: sig@(nodes Signature traits)
 453 [| token optKeywords optVariables |
 454   optVariables := #{} writer.
 455   optKeywords :=
 456     [| :optKeywords |
 457      [Syntax isOptionalSelector: (token := p nextToken)]
 458        whileTrue:
 459          [token value last = $:
 460             ifTrue: [optKeywords nextPut: token value intern.
 461                      (Syntax isUnarySelector: (token := p nextToken))
 462                        ifTrue: [optVariables nextPut: (p newVariableNamed: token value in: sig)]
 463                        ifFalse: [p undoToken: token]]
 464             ifFalse: [optKeywords nextPut: (token value ; ':') intern.
 465                       optVariables nextPut: (p newVariableNamed: token value allButFirst in: sig)]].
 466      p undoToken: token]
 467     writingAs: #{}.
 468   optKeywords ifNotEmpty:
 469     [sig optionalKeywords := optKeywords.
 470      sig optionalVariables := optVariables contents].
 471   sig
 472 ].
 473
 474 p@(Parser traits) nextSignature
 475 [| selector token result |
 476   selector := Nil.
 477   result := nodes Signature new recordPositionFrom: p.
 478
 479   p parseInputVariableFor: result.
 480   token := p nextToken.
 481   `conditions: {
 482     [Syntax isUnarySelector: token] -> [selector := token value].
 483     [Syntax isBinarySelector: token] -> [selector := token value. p parseInputVariableFor: result].
 484     [Syntax isKeywordSelector: token] ->
 485       [selector := ''.
 486        [selector := selector ; token value.
 487         p parseInputVariableFor: result.
 488         Syntax isKeywordSelector: (token := p nextToken)] whileTrue. p undoToken: token]
 489   } otherwise: [p error: 'Signature unexpectedly contains: ' ; token signifier].
 490
 491   selector ifNil: [p error: 'No selector name specified in signature'].
 492   result selector := selector intern.
 493   p parseOptionalKeywordsFor: result
 494 ].
 495
 496 p@(Parser traits) parseMethodDefinitionFor: sig@(nodes Signature traits)
 497 [| token |
 498   ((token := p nextToken) isSameAs: tokens BeginBlock)
 499     ifTrue: [p nextBlock &updating: (sig as: nodes MethodDefinition)]
 500     ifFalse: [p undoToken: token. sig]
 501 ].
 502
 503 p@(Parser traits) nextSignatureOrDefinition
 504 [
 505   p parseMethodDefinitionFor: p nextSignature
 506 ].