--- a/compiler/TParser.st Sun Sep 20 12:01:42 2015 +0100
+++ b/compiler/TParser.st Tue Sep 22 17:43:38 2015 +0100
@@ -3,7 +3,7 @@
"{ NameSpace: Smalltalk }"
RBParser subclass:#TParser
- instanceVariableNames:'parsingInlineAssembly'
+ instanceVariableNames:'parsingPrimitive'
classVariableNames:''
poolDictionaries:''
category:'Languages-Tea-Compiler-AST'
@@ -28,25 +28,10 @@
"Modified: / 13-09-2015 / 07:55:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
-!TParser methodsFor:'accessing'!
-
-initializeParserWith: aString type: aSymbol
- |stream|
-
- stream := ReadStream on: aString.
- source := aString.
- self scanner: (TScanner
- perform: aSymbol
- with: stream
- with: self errorBlock)
-
- "Created: / 02-09-2015 / 05:57:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
!TParser methodsFor:'initialization & release'!
scanner: aScanner
- parsingInlineAssembly := false.
+ parsingPrimitive := false.
super scanner: aScanner.
"Created: / 02-09-2015 / 06:34:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -123,42 +108,6 @@
"Created: / 14-09-2015 / 14:35:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-parseInlineAssembly
- | position blockNode firstLine prevScope|
-
- position := currentToken start.
- firstLine := currentToken lineNumber.
- parsingInlineAssembly := true.
- self step. "/ To eat %[ token
- blockNode := self parseBlockArgsInto: TInlineAssemblyNode new.
-"/ node arguments do:[:eachArg | eachArg parent:self].
- blockNode left: position.
- blockNode firstLineNumber:firstLine.
- prevScope := currentScope.
- currentScope := blockNode.
- self rememberLastNode:blockNode.
- blockNode body: (self parseStatements: false).
- RBParser isSmalltalkX ifTrue:[
- self addComments:(scanner getCommentsBeforeToken) afterNode:blockNode body.
- ].
- "/ ensure that right is set, even if parse aborted due to an error
- blockNode right: currentToken start-1.
-
- (currentToken isTInlineAssemblyEnd )
- ifFalse: [self parserError: '''$]'' expected'].
- "/ fix right
- blockNode right: currentToken start.
- blockNode lastLineNumber:currentToken lineNumber.
- parsingInlineAssembly := false.
-
- self step.
- self addComments:(scanner getCommentsBeforeToken) afterNode:blockNode.
- currentScope := prevScope.
- ^ blockNode
-
- "Created: / 02-09-2015 / 06:25:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
parseKeywordMessageWith: node
| message |
message := super parseKeywordMessageWith: node.
@@ -186,98 +135,32 @@
"Modified: / 21-08-2015 / 22:50:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
-parseStatementList: tagBoolean into: sequenceNode
- | statements return periods returnPosition returnLineNumber node valueNode|
- return := false.
- statements := OrderedCollection new.
- periods := OrderedCollection new.
- self addComments:(scanner getCommentsBeforeToken) beforeNode:sequenceNode.
- tagBoolean ifTrue: [self parseResourceTag].
-
- [
- "skip empty statements"
- emptyStatements ifTrue:
- [[currentToken isSpecial and: [currentToken value == $.]] whileTrue:
- [periods add: currentToken start.
- self step]].
-
- self atEnd
- or: [(currentToken isSpecial and: ['])}' includes: currentToken value ])
- or: [(currentToken isTInlineAssemblyEnd)]]
- ] whileFalse:[
- self addComments:(scanner getCommentsBeforeToken) beforeNode:node "value".
+parseKeywordPragma
+ | selectorParts arguments |
- return ifTrue: [
- self class isSmalltalkX
- ifTrue:
- ["could output a warning"]
- ifFalse:
- [self
- parserError: 'End of statement list encounted (statements after return)'
- lastNode:node]].
- (currentToken isTInlineAssemblyBegin) ifTrue:[
- node := self parseInlineAssembly.
- statements add: node.
- ] ifFalse:[
- (currentToken isSTXPrimitiveCode)
- ifTrue:[
- " primPosition := currentToken start. "
- node := RBSTXPrimitiveCCodeNode new codeToken: currentToken.
- self addComments:(scanner getCommentsBeforeToken) afterNode:node.
- statements add: node.
- self step.
- ] ifFalse:[
- (currentToken isSpecial and: [currentToken value == $^])
- ifTrue:
- [
- returnPosition := currentToken start.
- returnLineNumber := currentToken lineNumber.
- self step.
-
- valueNode := self parseAssignment.
- node := RBReturnNode return: returnPosition value: valueNode.
- node lineNumber:returnLineNumber.
- scanner atEnd ifFalse:[
- self addComments:(scanner getCommentsBeforeToken) afterNode:node value.
- ].
+ selectorParts := OrderedCollection new: 2.
+ arguments := OrderedCollection new: 2.
+ [ currentToken isKeyword ] whileTrue: [
+ selectorParts add: currentToken.
+ self step.
+ "Hack to handle <primitive: [:asm | asm ret: 1 ]>
+ style primitives"
+ (selectorParts size == 1
+ and:[selectorParts last value = 'primitive:'
+ and:[currentToken isSpecial
+ and:[currentToken value == $[]]]) ifTrue: [
+ parsingPrimitive := true.
+ arguments addLast: self parseBlock.
+ parsingPrimitive := false.
+ ] ifFalse:[
+ arguments addLast: self parsePragmaLiteral
+ ]
+ ].
+ ^ RBPragmaNode
+ selectorParts: selectorParts
+ arguments: arguments.
- statements add: node.
- return := true]
- ifFalse:
- [
- node := self parseAssignment.
- node notNil ifTrue:[
- self addComments:(scanner getCommentsAfterTokenIfInLine:node lastLineNumber) afterNode:node.
- scanner atEnd ifFalse:[
- self addComments:(scanner getCommentsAfterToken) afterNode:node.
- self addComments:(scanner getCommentsBeforeToken) afterNode:node.
- ].
-
- statements add: node
- ]].
- ].
- ].
-
- (currentToken isSpecial and: [currentToken value == $.])
- ifTrue:
- [periods add: currentToken start.
- self step]
- ifFalse:
- [return := true].
- emptyStatements
- ifTrue:
- [[currentToken isSpecial and: [currentToken value == $.]] whileTrue:
- [periods add: currentToken start.
- self step]]].
-
- sequenceNode
- statements: statements;
- periods: periods.
-
- self addComments:(scanner getCommentsBeforeToken) afterNode:node "value".
- ^sequenceNode
-
- "Created: / 02-09-2015 / 06:23:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Created: / 22-09-2015 / 16:49:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
parseType
@@ -318,7 +201,7 @@
!
parseTypeSpec: forReturn
- parsingInlineAssembly ifTrue:[ ^ nil ].
+ parsingPrimitive ifTrue:[ ^ nil ].
(currentToken isBinary and: [currentToken value == #<]) ifTrue: [
| start stop type |