[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] New syntax parser
From: |
Paolo Bonzini |
Subject: |
[Help-smalltalk] [PATCH] New syntax parser |
Date: |
Wed, 08 Aug 2007 18:30:39 +0200 |
User-agent: |
Thunderbird 2.0.0.6 (Macintosh/20070728) |
This is the last missing brick to trigger the big conversion to the new
syntax (also a work of Daniele, with only a few minor fixes from me).
Actually since the parser is supposed to be backwards compatible I want
to check that it does convert the kernel sources correctly (in addition
to generating documentation from said sources).
The old parser is still accessible with "-f gst2" to gst-convert.
There are known bugs in the handling of comments, which mysteriously
disappear. Well, I know why but I don't know how to fix them. :-P
In addition, another blocker for the 3.0 release surfaced, which is the
ability to store class variable initializers somewhere. For now, I'm
adding an addClassVarName:value: method to which we'll add meat later.
The C parser should also call this same method so that initializers will
be handled properly.
Paolo
2007-08-08 Paolo Bonzini <address@hidden>
Daniele Sciascia <address@hidden>
* kernel/Class.st: Add #addClassVarName:value:.
* scripts/Convert.st: Add GSTParser support.
packages/stinst/parser:
2007-08-08 Daniele Sciascia <address@hidden>
* RBParser.st: Add #parseMethodInto:.
* STFileParser.st: Support "self evaluate: nil". Only skip "!"
after evaluating. Add #currentNamespace.
* STLoader.st: Handle #addClassVarName:value:.
* STLoaderObjs.st: Add #collectCategories.
* GSTParser.st: New.
* looking for address@hidden/smalltalk--devo--2.2--patch-503 to compare with
* comparing to address@hidden/smalltalk--devo--2.2--patch-503
A packages/stinst/parser/GSTParser.st
M packages/stinst/parser/STFileParser.st
M scripts/Convert.st
M packages/stinst/parser/package.xml
M packages/stinst/parser/RBParser.st
M packages/stinst/parser/STLoader.st
M packages/stinst/parser/STLoaderObjs.st
M kernel/Class.st
* modified files
--- orig/kernel/Class.st
+++ mod/kernel/Class.st
@@ -96,14 +96,21 @@ superclass: aClass
!Class methodsFor: 'accessing instances and variables'!
addClassVarName: aString
- "Add a class variable with the given name to the class pool dictionary"
+ "Add a class variable with the given name to the class pool dictionary."
| sym |
sym := aString asClassPoolKey.
-
(self classPool includesKey: sym)
- ifTrue: [ SystemExceptions.AlreadyDefined signalOn: aString ].
+ ifFalse: [ self classPool at: sym put: nil ].
- self classPool at: sym put: nil
+ ^self classPool associationAt: sym
+!
+
+addClassVarName: aString value: valueBlock
+ "Add a class variable with the given name to the class pool dictionary,
+ and evaluate valueBlock as its initializer."
+ ^(self addClassVarName: aString)
+ value: valueBlock value;
+ yourself
!
bindingFor: aString
--- orig/packages/stinst/parser/RBParser.st
+++ mod/packages/stinst/parser/RBParser.st
@@ -292,6 +292,10 @@ parseMessagePattern
parseMethod
| methodNode |
methodNode := self parseMessagePattern.
+ ^self parseMethodInto: methodNode!
+
+parseMethodInto: methodNode
+ tags := nil.
self parseResourceTag.
self addCommentsTo: methodNode.
methodNode body: (self parseStatements: true).
--- orig/packages/stinst/parser/STFileParser.st
+++ mod/packages/stinst/parser/STFileParser.st
@@ -76,7 +76,7 @@ evaluate: node
"This should be overridden because its result affects the parsing
process: true means 'start parsing methods', false means 'keep
evaluating'."
- ^node statements size > 0 and: [ driver evaluate: node ]
+ ^node notNil and: [ node statements size > 0 and: [ driver evaluate: node
]]
! !
!STFileParser methodsFor: 'utility'!
@@ -154,10 +154,11 @@ parseDoits
[
self atEnd ifTrue: [ ^false ].
node := self parseStatements.
- scanner stripSeparators. "gobble doit terminating bang"
+ scanner stripSeparators.
self evaluate: node
] whileFalse: [
- self step "gobble doit terminating bang"
+ (currentToken isSpecial and: [currentToken value == $!])
+ ifTrue: [ self step ]
].
^true
!
@@ -258,6 +259,12 @@ evaluate: node
process: true means 'start parsing methods', false means 'keep
evaluating'. By default, always answer false."
^false
+!
+
+currentNamespace
+ ^Namespace current
+!
+
! !
RBScanner subclass: #STFileScanner
--- orig/packages/stinst/parser/STLoader.st
+++ mod/packages/stinst/parser/STLoader.st
@@ -154,6 +154,9 @@ initialize
toEvaluate: #addClassVarName:
perform: #doSend:selector:arguments:;
+
+ toEvaluate: #addClassVarName:value:
+ perform: #doAddClassVarName:selector:arguments:;
toEvaluate: #instanceVariableNames:
perform: #doSend:selector:arguments:
@@ -266,6 +269,15 @@ doSend: receiver selector: selector argu
^false
!
+doAddClassVarName: receiver selector: selector arguments: argumentNodes
+ | class classVarName value |
+ class := self resolveClass: receiver.
+ classVarName := argumentNodes first value asString.
+ value := argumentNodes last.
+ class addClassVarName: classVarName value: value.
+ ^false
+!
+
doImport: receiver selector: selector arguments: argumentNodes
| class namespace |
receiver isMessage ifTrue: [ ^false ].
--- orig/packages/stinst/parser/STLoaderObjs.st
+++ mod/packages/stinst/parser/STLoaderObjs.st
@@ -532,10 +532,21 @@ superclass
methodDictionary
methods isNil ifTrue: [ methods := LookupTable new ].
^methods
-!
+!
methodDictionary: aDictionary
methods := aDictionary
+!
+
+collectCategories
+ | categories |
+ self methodDictionary isNil ifTrue: [ ^#() ].
+
+ categories := Set new.
+ self methodDictionary do:
+ [ :method | categories add: (method methodCategory) ].
+
+ ^categories asSortedCollection
! !
!PseudoBehavior methodsFor: 'printing'!
--- orig/packages/stinst/parser/package.xml
+++ mod/packages/stinst/parser/package.xml
@@ -17,6 +17,7 @@
<filein>STLoader.st</filein>
<filein>SqueakParser.st</filein>
<filein>SIFParser.st</filein>
+ <filein>GSTParser.st</filein>
<filein>Exporter.st</filein>
<test>
@@ -39,8 +40,9 @@
<file>STSymTable.st</file>
<file>RewriteTests.st</file>
<file>SqueakParser.st</file>
+ <file>STFileParser.st</file>
<file>SIFParser.st</file>
+ <file>GSTParser.st</file>
<file>Exporter.st</file>
- <file>STFileParser.st</file>
<file>ChangeLog</file>
</package>
--- orig/scripts/Convert.st
+++ mod/scripts/Convert.st
@@ -383,7 +383,8 @@ Eval [
filter := [ :class | true ].
converter := SyntaxConverter new.
formats := Dictionary from: {
- 'gst' -> STInST.STFileInParser.
+ 'gst2' -> STInST.STFileInParser.
+ 'gst' -> STInST.GSTFileInParser.
'squeak' -> STInST.SqueakFileInParser.
'sif' -> STInST.SIFFileInParser
}.
* added files
--- /dev/null
+++ mod/packages/stinst/parser/GSTParser.st
@@ -0,0 +1,334 @@
+"======================================================================
+|
+| GNU Smalltalk syntax parser
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2007 Free Software Foundation, Inc.
+| Written by Daniele Sciascia.
+|
+| This file is part of the GNU Smalltalk class library.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library is distributed in the hope that it will be
+| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+STInST.STFileInParser subclass: GSTFileInParser [
+ | class |
+
+ parseStatements [
+ | returnPosition statements node |
+
+ (currentToken isSpecial and: [currentToken value == $!])
+ ifTrue: [ ^RBSequenceNode statements: #() ].
+
+ statements := OrderedCollection new.
+
+ (currentToken isSpecial and: [currentToken value == $^])
+ ifTrue: [returnPosition := currentToken start.
+ self step.
+ node := RBReturnNode return: returnPosition value: self
parseAssignment.
+ self addCommentsTo: node.
+ statements add: node]
+ ifFalse: [node := self parseAssignment.
+ self addCommentsTo: node.
+ statements add: node].
+
+ (currentToken isSpecial and: [self skipToken: $[])
+ ifTrue: [self parseDeclaration: node. ^nil].
+
+ ^RBSequenceNode statements: statements
+ ]
+
+ parseDeclaration: node [
+ node isMessage ifTrue: [
+ (node selectorParts first value = 'subclass:')
+ ifTrue: [self parseClass: node. ^self].
+
+ ((node receiver name = 'Namespace')
+ and: [node selectorParts first value = 'current:' ])
+ ifTrue: [self parseNamespace: node. ^self].
+
+ (node selectorParts first value = 'extend')
+ ifTrue: [self parseClassExtension: node. ^self]].
+
+ node isVariable
+ ifTrue: [(node name = 'Eval')
+ ifTrue: [self parseEval. ^self]].
+
+ self parserError: 'expected Eval, Namespace or class definition'
+ ]
+
+ parseEval [
+ | stmts |
+ stmts := self parseStatements: false.
+ self skipExpectedToken: $].
+ self evaluate: stmts.
+ ]
+
+ parseNamespace: node [
+ | namespace fullNamespace |
+ namespace := RBVariableNode
+ named: self driver currentNamespace name asString.
+ fullNamespace := RBVariableNode
+ named: (self driver currentNamespace nameIn: Smalltalk).
+
+ self evaluateMessageOn: namespace
+ selector: #addSubspace:
+ argument: node arguments first name asSymbol.
+
+ self evaluateStatement: node.
+ self parseSmalltalk.
+ self skipExpectedToken: $].
+
+ "restore previous namespace"
+ node parent: nil.
+ node arguments: { fullNamespace }.
+ self evaluateStatement: node
+ ]
+
+ parseClassExtension: node [
+ class := node receiver.
+ self parseClassBody.
+ class := nil
+ ]
+
+ parseClass: node [
+ self evaluateMessageOn: (node receiver)
+ selector: #subclass:
+ argument: (node arguments first name asSymbol).
+
+ class := node arguments first.
+ self parseClassBody.
+ class := nil.
+ ]
+
+ parseClassBody [
+ [ self skipToken: $] ]
+ whileFalse: [ self parseClassBodyElement ]
+ ]
+
+ parseClassBodyElement [
+ | node classNode |
+
+ "look for class tag"
+ (currentToken value = #< and: [self nextToken isKeyword])
+ ifTrue: [self parseClassTag. ^self].
+
+ "look for class variable"
+ (currentToken isIdentifier and: [self nextToken isAssignment])
+ ifTrue: [self parseClassVariable. ^self].
+
+ "class side"
+ ((currentToken isIdentifier
+ and: [self nextToken isIdentifier])
+ and: [self nextToken value = 'class'])
+ ifTrue: [classNode := RBVariableNode identifierToken:
currentToken.
+ self step.
+
+ (classNode = class)
+ ifTrue: ["look for class method"
+ (self nextToken value = #>>)
+ ifTrue: [self step. self step.
+ self parseMethodSourceOn:
(self makeClassOf: classNode).
+ ^self ].
+
+ "look for metaclass"
+ (self nextToken value = $[)
+ ifTrue: [self parseMetaclass.
+ ^self ].
+
+ self parserError: 'invalid class body
element'].
+
+ "look for overriding class method"
+ self step.
+ (currentToken value = #>>)
+ ifTrue: ["TODO: check that classNode is a
superclass of the current class"
+ self step.
+ self parseMethodSourceOn: (self
makeClassOf: classNode).
+ ^self].
+
+ self parserError: 'invalid class body element' ].
+
+ "look for overriding method"
+ (currentToken isIdentifier and: [self nextToken value = #>>])
+ ifTrue: ["check that classNode is a superclass of the current
class!!!"
+ classNode := RBVariableNode identifierToken: currentToken.
+ self step. self step.
+ self parseMethodSourceOn: classNode.
+ ^self].
+
+ node := self parseMessagePattern.
+
+ "look for method"
+ (self skipToken: $[)
+ ifTrue: [self parseMethodSource: node. ^self].
+
+ "look for instance variables"
+ (node selectorParts first value = #|)
+ ifTrue: [self parseInstanceVariables: node. ^self].
+
+ self parserError: 'invalid class body element'
+ ]
+
+ parseClassTag [
+ | selector argument stmt |
+
+ self skipExpectedToken: #<.
+
+ (currentToken isKeyword)
+ ifTrue: [selector := currentToken value asSymbol. self step]
+ ifFalse: [self parserError: 'expected keyword'].
+
+ argument := self parsePrimitiveObject.
+ self skipExpectedToken: #>.
+
+ argument isVariable
+ ifTrue: [stmt := RBMessageNode
+ receiver: class
+ selector: selector
+ arguments: { argument }.
+ self evaluateStatement: stmt]
+ ifFalse: [self evaluateMessageOn: class
+ selector: selector
+ argument: argument token value]
+ ]
+
+ parseClassVariable [
+ | node stmt name |
+
+ node := self parseAssignment.
+ node isAssignment
+ ifFalse: [self parserError: 'expected assignment'].
+
+ self skipExpectedToken: $. .
+
+ name := RBLiteralNode value: (node variable name asSymbol).
+ node := self makeSequenceNode: node.
+ node := RBBlockNode body: node.
+
+ stmt := RBMessageNode
+ receiver: class
+ selector: #addClassVarName:value:
+ arguments: { name . node }.
+
+ self evaluateStatement: stmt.
+ ]
+
+ parseMetaclass [
+ | tmpClass |
+
+ self step. self step.
+ tmpClass := class.
+ class := self makeClassOf: class.
+ self parseClassBody.
+ class := tmpClass
+ ]
+
+ parseMethodSource: patternNode [
+ self parseMethodSource: patternNode on: class
+ ]
+
+ parseMethodSourceOn: classNode [
+ | patternNode |
+
+ patternNode := self parseMessagePattern.
+ self skipExpectedToken: $[.
+ self parseMethodSource: patternNode on: classNode.
+ ]
+
+ parseMethodSource: patternNode on: classNode [
+ "TODO: parse category tag inside methods"
+ | methodNode source start stop |
+
+ start := patternNode selectorParts first start - 1.
+ methodNode := self parseMethodInto: patternNode.
+ stop := currentToken start - 1.
+ self skipExpectedToken: $].
+ source := scanner stream copyFrom: start to: stop.
+ source := MappedCollection collection: source map: (1 - start to:
stop).
+ methodNode source: source.
+
+ self evaluateMessageOn: classNode
+ selector: #methodsFor:
+ argument: nil.
+
+ self compile: methodNode
+ ]
+
+ parseInstanceVariables: node [
+ | vars |
+
+ vars := (node arguments at: 1) name.
+ [currentToken isIdentifier]
+ whileTrue: [vars := vars , ' ' , currentToken value.
+
+ self step ].
+ self skipExpectedToken: #|.
+
+ self evaluateMessageOn: class
+ selector: #instanceVariableNames:
+ argument: vars.
+ ]
+
+ evaluateMessageOn: rec selector: sel argument: arg [
+ | stmt |
+
+ stmt := RBMessageNode
+ receiver: rec
+ selector: sel
+ arguments: { RBLiteralNode value: arg }.
+
+ self evaluateStatement: stmt.
+ ]
+
+ evaluateStatement: node [
+ ^self evaluate: (self makeSequenceNode: node).
+ ]
+
+ makeSequenceNode: stmt [
+ | seq |
+ seq := RBSequenceNode
+ leftBar: nil
+ temporaries: #()
+ rightBar: nil.
+ seq statements: { stmt }.
+ seq periods: #().
+ ^seq
+ ]
+
+ makeClassOf: node [
+ ^RBMessageNode
+ receiver: node
+ selector: #class
+ arguments: #()
+ ]
+
+ skipToken: tokenValue [
+ (currentToken value = tokenValue)
+ ifTrue: [self step. ^true]
+ ifFalse: [^false]
+ ]
+
+ skipExpectedToken: tokenValue [
+ (self skipToken: tokenValue)
+ ifFalse: [self parserError: ('expected ' , tokenValue asSymbol)]
+ ]
+]
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] New syntax parser,
Paolo Bonzini <=