[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] [PATCH] SIF parser
From: |
Paolo Bonzini |
Subject: |
[Help-smalltalk] [PATCH] SIF parser |
Date: |
Wed, 27 Jun 2007 08:11:45 +0200 |
User-agent: |
Thunderbird 2.0.0.4 (Macintosh/20070604) |
SIF was the most useless part of the Smalltalk standard, but it's nice
to have it if it only takes ~200 lines of code, and it helps shaking
bugs in the converter.
For the curious, SIF is yet another variant of the bang-separated
format, and it looks like this:
Class named: 'A' superclass: 'Object'
indexedInstanceVariables: #none
instanceVariableNames: 'a b c'
classVariableNames: 'D'
sharedPools: 'SystemExceptions'
classInstanceVariableNames: 'e'!
Annotation key: 'comment' value: 'comment'!
A classMethod!
initialize ^'a class method'!
A method!
initialize ^'a method'!
Global initializer!
'an eval' printNl!
Global variable: 'GlobalX'!
Global constant: 'GlobalY'!
Pool named: 'MyPool'!
GlobalX initializer!
5!
GlobalY initializer!
| a |
a := Set new.
a add: 5.
a!
MyPool variable: 'MyPoolX'!
MyPool constant: 'MyPoolY'!
MyPool initializerFor: 'MyPoolX'!
5!
MyPool initializerFor: 'MyPoolY'!
| a |
a := Set new.
a add: 5.
a!
Paolo
2007-06-27 Paolo Bonzini <address@hidden>
* scripts/Convert.st: Emit Namespace creation when needed.
Emit form feeds here.
* compiler/SIFParser.st: New.
* compiler/SqueakParser.st: Use super.
* compiler/STFileParser.st: Split part of #parseMethodDefinitionList
into a separate method.
* compiler/Exporter.st: Fix indentation of class-instance variables.
Don't emit form feed character.
--- orig/TODO
+++ mod/TODO
@@ -1,21 +1,24 @@
* 3.0
** implement new syntax (being done)
+*** implement GST syntax parser for STClassLoader
+*** option processing for scripts/Convert.st
+*** mega conversion of old source code and bug shaking
** implement a better packaging system allowing zipped source files with
XML package descriptions to be delivered and installed. Investigate
-basing it on the Virtual File System infrastructure.
+basing it on the Virtual File System infrastructure. (being done)
** faster startup (done)
** restructure init/pre/kernel files (done)
-** upgrade XML parser for package files
-*** support arch-dependent files that are installed in the image path
-
* sometime
+** upgrade XML parser for package files
+*** support arch-dependent files that are installed in the image path
+
** some kind of sandboxing (partly done)
** add check in/check out to the browser so that .st files remain
@@ -88,9 +91,6 @@ outside #new and so on).
* other
-** follow the implementation lines of compiler/STLoader.st to implement
-SIF file-in.
-
** make the smalltalk cpp work - nothing less, nothing more ;-)
** print entities correctly in the URIResolver. A file named abc&def
--- orig/compiler/Exporter.st
+++ mod/compiler/Exporter.st
@@ -138,8 +138,7 @@ Object subclass: FileOutExporter [
outClass environment = self defaultNamespace
ifTrue: [ ^self fileOutClassBody: aBlock ].
- outStream nextPut: 12 asCharacter; nl;
- nextPutAll: 'Namespace current: ';
+ outStream nextPutAll: 'Namespace current: ';
store: outClass environment;
nextPutAll: ' ['; nl; nl.
@@ -216,10 +215,10 @@ Object subclass: FileOutExporter [
"class instance varriables"
outClass asMetaclass instVarNames isEmpty
ifFalse: [ outStream nl; space: 4; nextPutAll: outClass name;
- nextPutAll: ' class ['; nl; space: 4.
+ nextPutAll: ' class ['; nl; tab.
outStream nextPut: $|; space.
self printFormattedSet: outClass asMetaclass
instVarNames.
- outStream space; nextPut: $|; nl; space: 4.
+ outStream space; nextPut: $|; nl; tab.
outStream nl; space: 4; nextPut: $]; nl ].
"class variables"
--- orig/compiler/STFileParser.st
+++ mod/compiler/STFileParser.st
@@ -75,8 +75,8 @@ endMethodList
evaluate: node
"This should be overridden because its result affects the parsing
process: true means 'start parsing methods', false means 'keep
- evaluating'. By default, always answer false."
- ^driver evaluate: node
+ evaluating'."
+ ^node statements size > 0 and: [ driver evaluate: node ]
! !
!STFileParser methodsFor: 'utility'!
@@ -156,34 +156,37 @@ parseDoits
node := self parseStatements.
scanner stripSeparators. "gobble doit terminating bang"
self step. "gobble doit terminating bang"
- node statements size > 0 and: [ self evaluate: node ]
+ self evaluate: node
] whileFalse.
^true
!
+parseMethodFromFile
+ | node source start stop |
+ start := currentToken start - 1.
+ tags := nil.
+ node := self parseMethod.
+
+ "One -1 accounts for base-1 vs. base-0 (as above), the
+ other drops the bang because we have a one-token lookahead."
+ stop := currentToken start - 2.
+ source := scanner stream copyFrom: start to: stop.
+ source := MappedCollection collection: source map: (1 - start to: stop).
+ node source: source.
+
+ scanner stripSeparators.
+ self step. "gobble method terminating bang"
+ ^node!
+
parseMethodDefinitionList
"Called after first !, expecting a set of bang terminated
method definitions, followed by a bang"
- | node source start stop |
[ scanner atEnd or: [ currentToken isSpecial
and: [ currentToken value == $! ] ] ] whileFalse: [
- start := currentToken start - 1.
- tags := nil.
- node := self parseMethod.
-
- "One -1 accounts for base-1 vs. base-0 (as above), the
- other drops the bang because we have a one-token lookahead."
- stop := currentToken start - 2.
- source := scanner stream copyFrom: start to: stop.
- source := MappedCollection collection: source map: (1 - start to: stop).
- node source: source.
-
- scanner stripSeparators.
- self step. "gobble method terminating bang"
- self compile: node
- ].
+ self compile: self parseMethodFromFile ].
+
scanner stripSeparators.
self step.
self endMethodList
--- orig/compiler/SqueakParser.st
+++ mod/compiler/SqueakParser.st
@@ -42,10 +42,10 @@ evaluate: node
This avoids that the STParsingDriver need to know about other
dialects."
| stmt |
- node statements size == 1 ifFalse: [ ^driver evaluate: node ].
+ node statements size == 1 ifFalse: [ ^super evaluate: node ].
stmt := node statements first.
- stmt isMessage ifFalse: [ ^driver evaluate: node ].
+ stmt isMessage ifFalse: [ ^super evaluate: node ].
stmt selector == #addCategory: ifTrue: [ ^false ].
stmt selector == #commentStamp:prior: ifTrue: [
stmt arguments: { scanner nextRawChunk }.
@@ -58,7 +58,7 @@ evaluate: node
stmt arguments: { stmt arguments first }.
stmt selector: #methodsFor: ].
- ^driver evaluate: node
+ ^super evaluate: node
! !
!SqueakFileInParser methodsFor: 'private-parsing'!
--- orig/packages.xml.in
+++ mod/packages.xml.in
@@ -399,6 +399,7 @@
<filein>STLoaderObjs.st</filein>
<filein>STLoader.st</filein>
<filein>SqueakParser.st</filein>
+ <filein>SIFParser.st</filein>
<filein>Exporter.st</filein>
<test>
@@ -421,6 +422,8 @@
<file>STLoaderObjs.st</file>
<file>STSymTable.st</file>
<file>RewriteTests.st</file>
+ <file>SqueakParser.st</file>
+ <file>SIFParser.st</file>
<file>Exporter.st</file>
</package>
--- orig/scripts/Convert.st
+++ mod/scripts/Convert.st
@@ -140,7 +140,7 @@ EmittedEntity subclass: EmittedEval [
STInST.STClassLoader subclass: SyntaxConverter [
- | stuffToEmit classesToEmit outStream |
+ | stuffToEmit classesToEmit createdNamespaces outStream |
<comment: 'A class loader that creates a set of "EmittedEntity"
based on the contents of the given file being loaded.
@@ -154,6 +154,11 @@ STInST.STClassLoader subclass: SyntaxCon
^self convertStream: in with: STInST.SqueakFileInParser to: out
]
+ SyntaxConverter class >> convertSIFStream: in to: out [
+ <catogory: 'instance creation'>
+ ^self convertStream: in with: STInST.SIFFileInParser to: out
+ ]
+
SyntaxConverter class >> convertStream: in to: out [
<catogory: 'instance creation'>
^self convertStream: in with: STInST.STFileInParser to: out
@@ -172,6 +177,7 @@ STInST.STClassLoader subclass: SyntaxCon
super initialize.
stuffToEmit := OrderedSet new.
classesToEmit := Dictionary new.
+ createdNamespaces := OrderedSet new.
]
outStream: out [
@@ -216,9 +222,21 @@ STInST.STClassLoader subclass: SyntaxCon
ifFalse: [ stuffToEmit add: (EmittedEval new namespace:
evalNamespace) ]
]
+ createNamespaces [
+ createdNamespaces do: [ :each || stmt |
+ stmt := RBMessageNode
+ receiver: (RBVariableNode named: (each superspace nameIn: self
currentNamespace))
+ selector: #addSubspace:
+ arguments: { RBLiteralNode value: each name asSymbol }.
+ self lastEval addStatement: stmt
+ ].
+ createdNamespaces := OrderedSet new
+ ]
+
unknown: node [
<category: 'collecting entities'>
+ self createNamespaces.
self lastEval addStatement: node.
^false
]
@@ -228,6 +246,9 @@ STInST.STClassLoader subclass: SyntaxCon
| class emittedClass |
+ createdNamespaces remove: self currentNamespace ifAbsent: [ ].
+ self createNamespaces.
+
class := super defineSubclass: receiver
selector: selector
arguments: argumentNodes.
@@ -240,12 +261,20 @@ STInST.STClassLoader subclass: SyntaxCon
^false
]
+ doAddNamespace: receiver selector: selector arguments: argumentNodes [
+ | ns |
+ super doAddNamespace: receiver selector: selector arguments:
argumentNodes.
+
+ ns := (self resolveNamespace: receiver) at: argumentNodes first value.
+ createdNamespaces add: ns
+ ]
+
doEmitStuff [
<category: 'emitting'>
- stuffToEmit do: [ :each | each emitTo: outStream ].
- stuffToEmit := OrderedSet new.
- classesToEmit := Dictionary new
+ stuffToEmit
+ do: [ :each | each emitTo: outStream ]
+ separatedBy: [ outStream nl; nextPut: 12 asCharacter; nl ].
]
addMethod: aMethod toLoadedClass: aClass [
* added files
--- /dev/null
+++
/Volumes/disk0s8/devel/gst/,,address@hidden/new-files-archive/./compiler/.arch-ids/SIFParser.st.id
@@ -0,0 +1 @@
+Paolo Bonzini <address@hidden> Tue Jun 26 09:44:12 2007 15063.0
--- /dev/null
+++
/Volumes/disk0s8/devel/gst/,,address@hidden/new-files-archive/./compiler/SIFParser.st
@@ -0,0 +1,246 @@
+"======================================================================
+|
+| SIF input parser
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 2007 Free Software Foundation, Inc.
+| Written by Paolo Bonzini.
+|
+| This file is part of GNU Smalltalk.
+|
+| GNU Smalltalk is free software; you can redistribute it and/or modify it
+| under the terms of the GNU General Public License as published by the Free
+| Software Foundation; either version 2, or (at your option) any later version.
+|
+| GNU Smalltalk 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 General Public License for more
+| details.
+|
+| You should have received a copy of the GNU General Public License along with
+| GNU Smalltalk; see the file COPYING. If not, write to the Free Software
+| Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+|
+ ======================================================================"
+
+
+STFileInParser subclass: #SIFFileInParser
+ instanceVariableNames: 'lastClass'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Refactory-Parser'!
+
+!SIFFileInParser methodsFor: 'parsing'!
+
+parseMethodDefinitionList
+ "Methods are defined one by one in SIF."
+ self compile: self parseMethodFromFile.
+ self endMethodList
+! !
+
+!SIFFileInParser methodsFor: 'evaluating'!
+
+evaluate: node
+ "Convert some SIF messages to GNU Smalltalk file-out syntax.
+ This avoids that the STParsingDriver need to know about other
+ dialects."
+ | stmt |
+ node statements size == 0 ifTrue: [ ^false ].
+ node statements size == 1 ifFalse: [ node printNl. ^self error: 'invalid
SIF' ].
+
+ stmt := node statements first.
+ stmt isMessage ifFalse: [ ^super evaluate: node ].
+ stmt selector == #interchangeVersion: ifTrue: [ ^false ].
+
+ stmt selector ==
#named:superclass:indexedInstanceVariables:instanceVariableNames:classVariableNames:sharedPools:classInstanceVariableNames:
ifTrue: [
+ lastClass := self evaluateClass: stmt.
+ ^false ].
+
+ stmt selector == #key:value: ifTrue: [
+ lastClass isNil
+ ifFalse: [ self evaluateAnnotation: stmt to: lastClass ].
+ ^false ].
+
+ stmt selector == #classMethod ifTrue: [
+ lastClass := nil.
+ self evaluateClassMethod: stmt.
+ ^true ].
+
+ stmt selector == #method ifTrue: [
+ lastClass := nil.
+ self evaluateMethod: stmt.
+ ^true ].
+
+ (stmt selector == #initializerFor:) ifTrue: [
+ lastClass := nil.
+ self evaluateInitializer: stmt.
+ ^false ].
+
+ (stmt selector == #initializer) ifTrue: [
+ lastClass := nil.
+ self evaluateGlobalInitializer: stmt.
+ ^false ].
+
+ (stmt selector == #variable: or: [ stmt selector == #constant: ]) ifTrue: [
+ lastClass := nil.
+ self evaluatePoolDefinition: stmt.
+ ^false ].
+
+ stmt selector == #named: ifTrue: [
+ lastClass := nil.
+ self evaluatePool: stmt.
+ ^false ].
+
+ stmt printNl.
+ self error: 'invalid SIF'
+!
+
+evaluateStatement: stmt
+ driver evaluate: (RBSequenceNode new
+ temporaries: #();
+ statements: { stmt })
+!
+
+evaluateClass: stmt
+ "Convert `Class named: ...' syntax to GNU Smalltalk file-out syntax."
+ | name superclass shape ivn cvn sp civn newStmt newClass |
+ name := stmt arguments at: 1.
+ superclass := stmt arguments at: 2.
+ shape := stmt arguments at: 3.
+ ivn := stmt arguments at: 4.
+ cvn := stmt arguments at: 5.
+ sp := stmt arguments at: 6.
+ civn := stmt arguments at: 7.
+
+ shape value = #none
+ ifTrue: [ shape := RBLiteralNode value: nil ].
+ shape value = #object
+ ifTrue: [ shape := RBLiteralNode value: #pointer ].
+
+ newStmt := RBMessageNode
+ receiver: (RBVariableNode named: superclass value)
+ selector:
#variable:subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:
+ arguments: {
+ shape. RBLiteralNode value: name value asSymbol.
+ ivn. cvn. sp. RBLiteralNode value: nil }.
+ self evaluateStatement: newStmt.
+
+ newClass := RBVariableNode named: name value.
+ newStmt := RBMessageNode
+ receiver: (self makeClassOf: newClass)
+ selector: #instanceVariableNames:
+ arguments: { civn }.
+ self evaluateStatement: newStmt.
+
+ ^newClass!
+
+makeClassOf: node
+ ^RBMessageNode
+ receiver: node
+ selector: #class
+ arguments: #()!
+
+evaluateAnnotation: stmt to: object
+ "Convert `Annotation key: ...' syntax to GNU Smalltalk file-out syntax."
+ | key value selector newStmt |
+ key := stmt arguments at: 1.
+ value := stmt arguments at: 2.
+ key value = 'package' ifTrue: [ selector := #category: ].
+ key value = 'category' ifTrue: [ selector := #category: ].
+ key value = 'comment' ifTrue: [ selector := #comment: ].
+ selector isNil ifFalse: [
+ newStmt := RBMessageNode
+ receiver: object
+ selector: selector
+ arguments: { value }.
+ self evaluateStatement: newStmt ]!
+
+evaluateClassMethod: stmt
+ "Convert `Foo classMethod' syntax to GNU Smalltalk file-out syntax."
+ stmt receiver: (self makeClassOf: stmt receiver).
+ self evaluateMethod: stmt!
+
+evaluateMethod: stmt
+ "Convert `Foo method' syntax to GNU Smalltalk file-out syntax."
+ | newStmt |
+ newStmt := RBMessageNode
+ receiver: stmt receiver
+ selector: #methodsFor:
+ arguments: { RBLiteralNode value: nil }.
+ self evaluateStatement: newStmt!
+
+evaluateInitializer: stmt
+ "Convert `Foo initializerFor: Bar' syntax to GNU Smalltalk file-out
syntax."
+ self
+ evaluateInitializerFor: stmt arguments first value
+ in: stmt receiver!
+
+evaluateGlobalInitializer: stmt
+ "Convert `Foo initializer' syntax to GNU Smalltalk file-out syntax."
+ | node |
+ stmt receiver name = 'Global' ifTrue: [
+ node := self parseStatements.
+ scanner stripSeparators.
+ self step.
+ ^super evaluate: node ].
+
+ self
+ evaluateInitializerFor: stmt receiver name
+ in: (RBVariableNode named: 'Smalltalk')!
+
+evaluateInitializerFor: key in: receiver
+ | position node arg newStmt |
+ position := currentToken start.
+ node := RBOptimizedNode
+ left: position
+ body: self parseStatements
+ right: currentToken start.
+
+ scanner stripSeparators.
+ self step.
+ newStmt := RBMessageNode
+ receiver: receiver
+ selector: #at:put:
+ arguments: { RBLiteralNode value: key asSymbol. node }.
+ self evaluateStatement: newStmt!
+
+evaluatePoolDefinition: stmt
+ "Convert `Foo variable:/constant: ...' syntax to GNU Smalltalk file-out
+ syntax."
+ | receiver key newStmt |
+ receiver := stmt receiver.
+ receiver name = 'Global' ifTrue: [ receiver := RBVariableNode named:
'Smalltalk' ].
+ key := RBLiteralNode value: stmt arguments first value asSymbol.
+
+ newStmt := RBMessageNode
+ receiver: receiver
+ selector: #at:put:
+ arguments: { key. RBLiteralNode value: nil }.
+
+ self evaluateStatement: newStmt!
+
+evaluatePool: stmt
+ "Convert `Pool named: ...' syntax to GNU Smalltalk file-out syntax."
+ | key newStmt |
+ key := RBLiteralNode value: stmt arguments first value asSymbol .
+ newStmt := RBMessageNode
+ receiver: (RBVariableNode named: 'Smalltalk')
+ selector: #addSubspace:
+ arguments: { key }.
+
+ self evaluateStatement: newStmt!
+! !
+
+!SIFFileInParser methodsFor: 'private-parsing'!
+
+scannerClass
+ "We need a special scanner to convert the double-bangs in strings
+ to single bangs. Unlike in GNU Smalltalk, all bangs must be
+ `escaped' in Squeak."
+ ^SqueakFileInScanner! !
+
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Help-smalltalk] [PATCH] SIF parser,
Paolo Bonzini <=