[PATCH] convert: Use the STTools.Loader from the Convert.st

The parsing code of Convert.st has been copied into the STTools
package. Start using the new package in the Convert scripts.

2013-08-10  Holger Hans Peter Freyther  <[hidden email]>

        * scripts/Convert.st: Use the STTools tools instead of the
        current code.
---
 ChangeLog          |   5 +
 scripts/Convert.st | 326 +----------------------------------------------------
 2 files changed, 7 insertions(+), 324 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 893d7bb..614902d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2013-08-10  Holger Hans Peter Freyther  <[hidden email]>
+
+ * scripts/Convert.st: Use the STTools tools instead of the
+ current code.
+
 2013-03-30  Holger Hans Peter Freyther  <[hidden email]>
 
  * configure.ac: Introduce the GTKTools package
diff --git a/scripts/Convert.st b/scripts/Convert.st
index a02b3b6..a7a402e 100644
--- a/scripts/Convert.st
+++ b/scripts/Convert.st
@@ -30,7 +30,7 @@
 |
  ======================================================================"
 
-PackageLoader fileInPackage: #Parser.
+PackageLoader fileInPackage: #STTools.
 
 STInST.OldSyntaxExporter class extend [
     emitEval: aBlock to: aStream for: namespace [
@@ -63,328 +63,6 @@ STInST.NewSyntaxExporter class extend [
     ]
 ]
 
-
-Object subclass: EmittedEntity [  
-    emitTo: aStream filteredBy: aBlock [
-        self subclassResponsibility
-    ]
-]
-
-EmittedEntity subclass: EmittedComments [
-    | comments |
-    EmittedComments class >> comments: aCollection source: aString [
- ^self new comments: (aCollection collect: [ :c |
-    aString copyFrom: c first to: c last ])
-    ]
-
-    emitTo: outStream filteredBy: aBlock [
- comments do: [ :c |
- STInST.FileOutExporter defaultExporter fileOutComment: c to: outStream.
- outStream nl; nl]
-    ]
-
-    comments: anArray [
- comments := anArray
-   ]
-]
-
-EmittedEntity subclass: EmittedClass [
-    | class methodsToEmit classMethodsToEmit isComplete |
-    
-    <comment: 'This class is responsible for emitting a class
-    by using a FormattingExporter.'>
-    
-    EmittedClass class >> forClass: aClass [        
- (aClass superclass notNil and: [
-    aClass superclass isDefined not ]) ifTrue: [
-        Warning signal:
-    ('superclass %1 is undefined' % {aClass superclass}) ].
-        ^super new initializeWithClass: aClass complete: true
-    ]
-    
-    EmittedClass class >> forExtension: aClass [
- aClass isDefined ifFalse: [
-    Warning signal:
- ('extensions for undefined class %1' % {aClass}) ].
-        ^super new initializeWithClass: aClass complete: false
-    ]
-    
-    initializeWithClass: aClass complete: aBoolean [
-        class := aClass.
-        methodsToEmit := STInST.OrderedSet new.
- classMethodsToEmit := STInST.OrderedSet new.
- isComplete := aBoolean
-    ]
-
-    forClass [
-        ^class
-    ]
-    
-    addMethod: aMethod [
-        methodsToEmit add: aMethod selector asSymbol.
-    ]
-
-    addClassMethod: aMethod [
- classMethodsToEmit add: aMethod selector asSymbol.
-    ]
-
-    emitTo: aStream filteredBy: aBlock [
- (aBlock value: class)
-    ifFalse: [
-        Notification signal: ('Skipping %1' % {class}).
- ^self ].
-
-        Notification signal: ('Converting %1...' % {class}).
-        (STInST.FileOutExporter defaultExporter on: class to: aStream)
-            completeFileOut: isComplete;
-            fileOutSelectors: methodsToEmit classSelectors: classMethodsToEmit.
-    ]
-]
-
-EmittedEntity subclass: EmittedEval [
-    | statements comments namespace |
-    
-    <comment: 'This class is responsible for emitting a set of
-    statements that should be inside an Eval declaration.'>
-    
-    EmittedEval class >> new [
-        ^super new initialize
-    ]
-    
-    initialize [
-        statements := OrderedCollection new
-    ]
-    
-    namespace [
- ^namespace
-    ]
-
-    namespace: aNamespace [
- namespace := aNamespace
-    ]
-
-    addStatement: aStatement [
-        statements add: aStatement
-    ]
-    
-    emitTo: aStream filteredBy: aBlock [
- statements isEmpty ifTrue: [ ^self ].
- STInST.FileOutExporter defaultExporter
-    emitEval: [
- | formatter |
- formatter := STInST.RBFormatter new.
- formatter indent: 1 while: [
-    formatter indent.
-            aStream nextPutAll: (formatter formatAll: statements) ]]
-    to: aStream
-    for: namespace.
-    ]
-]
-
-
-
-STInST.STClassLoader subclass: SyntaxConverter [
-    | stuffToEmit classesToEmit createdNamespaces filter outStream rewriter |
-    
-    <comment: 'A class loader that creates a set of "EmittedEntity"
-    based on the contents of the given file being loaded.
-    When the contents of the file are loaded, the responsibilty of
-    emitting code using the new syntax belongs to those various
-    entities that have been constructed.'>
-    
-    
-    SyntaxConverter class >> convertSqueakStream: in to: out [
-        <category: 'instance creation'>
-        ^self convertStream: in with: STInST.SqueakFileInParser to: out
-    ]
-    
-    SyntaxConverter class >> convertSIFStream: in to: out [
-        <category: 'instance creation'>
-        ^self convertStream: in with: STInST.SIFFileInParser to: out
-    ]
-    
-    SyntaxConverter class >> convertStream: in to: out [
-        <category: 'instance creation'>
-        ^self convertStream: in with: STInST.STFileInParser to: out
-    ]
-    
-    SyntaxConverter class >> convertStream: in with: aParserClass to: out [
-        <category: 'instance creation'>
-        ^self new convertStream: in with: aParserClass to: out
-    ]
-
-    initialize [
-        <category: 'initialization'>
- super initialize.
- filter := [ :class | [true] ].
-        stuffToEmit := OrderedSet new.
-        classesToEmit := Dictionary new.
-        createdNamespaces := OrderedSet new.
-    ]
-
-    convertStream: in with: aParserClass to: out onError: aBlock [
-        <category: 'operation'>
-        self
-    outStream: out;
-    parseSmalltalkStream: in with: aParserClass onError: aBlock;
-    doEmitStuff.        
-    ]
-
-    convertStream: in with: aParserClass to: out [
-        <category: 'operation'>
-        self
-    outStream: out;
-    parseSmalltalkStream: in with: aParserClass;
-    doEmitStuff.        
-    ]
-
-    filter: aBlock [
-        <category: 'accessing'>
-        filter := aBlock.
-    ]
-    
-    outStream: out [
-        <category: 'accessing'>
-        outStream := out.
-    ]
-    
-    rewrite: node [
- ^rewriter isNil
-    ifTrue: [ node ]
-    ifFalse: [ rewriter executeTree: node; tree ].
-    ]
-
-    evaluate: node [
-        <category: 'overrides'>
-
- | rewritten |
- rewritten := self rewrite: node.
- node comments isEmpty ifFalse: [
-    stuffToEmit add: (EmittedComments comments: node comments source: node source) ].
-
-        ^super evaluate: rewritten
-    ]
-    
-    addRule: searchString parser: aParserClass [
- | tree rule |
- tree := aParserClass parseRewriteExpression: searchString.
- tree isMessage ifFalse: [ self error: 'expected ->' ].
- tree selector = #-> ifFalse: [ self error: 'expected ->' ].
- rule := RBStringReplaceRule
-    searchForTree: tree receiver
-    replaceWith: tree arguments first.
-
- rewriter isNil ifTrue: [ rewriter := ParseTreeRewriter new ].
- rewriter addRule: rule
-    ]
-
-    compile: node [
-        <category: 'collecting entities'>
-        
-        | rewritten method |
-
- rewritten := self rewrite: node.
-        method := self defineMethod: rewritten.                
-        (classesToEmit includesKey: currentClass asClass)
-            ifTrue: [ self addMethod: method toLoadedClass: currentClass ]
-            ifFalse: [ self addMethod: method toExtensionClass: currentClass ].
- ^method
-    ]
-    
-    lastEval [
-        <category: 'collecting entities'>
-
- | lastIsEval evalNamespace |
-
-        evalNamespace := currentNamespace = self defaultNamespace
-    ifTrue: [ nil ]
-    ifFalse: [ currentNamespace ].
-
-        lastIsEval := stuffToEmit notEmpty
-    and: [ (stuffToEmit last isKindOf: EmittedEval)
-    and: [ stuffToEmit last namespace = evalNamespace ]].
-
- ^lastIsEval
-    ifTrue: [ stuffToEmit last ]
-    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
-    ]
-    
-    doSubclass: receiver selector: selector arguments: argumentNodes [
-        <category: 'evaluating statements'>
-        
-        | class emittedClass |
-        
- createdNamespaces remove: self currentNamespace ifAbsent: [ ].
- self createNamespaces.
-
-        class := super defineSubclass: receiver
-                       selector: selector
-                       arguments: argumentNodes.        
-                            
-        Notification signal: ('Parsing %1' % {class}).
-        emittedClass := EmittedClass forClass: class.
-    
-        classesToEmit at: class put: emittedClass.
-        stuffToEmit add: emittedClass.
-        
-        ^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.
- ^false
-    ]
-
-    doEmitStuff [
-        <category: 'emitting'>
-
-        stuffToEmit
-    do: [ :each | each emitTo: outStream filteredBy: filter ]
-    separatedBy: [ outStream nl; nextPut: 12 asCharacter; nl ].
-    ]
-    
-    addMethod: aMethod toLoadedClass: aClass [
-        <category: 'collecting entities'>
-
-        (aClass isMetaclass)
-            ifTrue: [ (classesToEmit at: currentClass asClass) addClassMethod: aMethod ]
-            ifFalse: [ (classesToEmit at: currentClass) addMethod: aMethod ]
-    ]
-    
-    addMethod: aMethod toExtensionClass: aClass [
-        <category: 'collecting entities'>
-
-        ((stuffToEmit size > 0)
-            and: [ (stuffToEmit last isKindOf: EmittedClass) and: [ stuffToEmit last forClass = aClass ] ])                
-                ifTrue: [ stuffToEmit last addMethod: aMethod ]
-                ifFalse: [ stuffToEmit add: ((EmittedClass forExtension: currentClass) addMethod: aMethod) ]            
-    ]
-]
-
-
 String extend [
    asFilterOn: aBlock through: valueBlock [
  | regex |
@@ -413,7 +91,7 @@ Eval [
     verbose := false.
     outFile := nil.
     filter := [ :class | true ].
-    converter := SyntaxConverter new.
+    converter := STTools.Loader new.
     STInST.FileOutExporter defaultExporter: STInST.FormattingExporter.
     outFormats := Dictionary from: {
  'gst2' -> STInST.OldSyntaxExporter.
--
1.8.3.2


_______________________________________________
help-smalltalk mailing list
[hidden email]
https://lists.gnu.org/mailman/listinfo/help-smalltalk