Il 08/04/2013 11:30, Holger Hans Peter Freyther ha scritto: > This will hold non UI tools to help with tooling. This can be linters, > the converter, package related tools. Beging with moving parts of the > gst-convert code into this package.
Please rename to SourceEntity/SourceEval/SourceClass/SourceComments, and rename Loader to SourceProcessor. Please make this part of STInST. Also, please make scripts/Convert.st use it. Paolo > 2013-03-30 Holger Hans Peter Freyther <[email protected]> > > * configure.ac: Introduce the Tooling package. > > 2013-03-30 Holger Hans Peter Freyther <[email protected]> > > * Makefile.frag: Added. > * Parser/EmittedClass.st: Added from scripts/Convert.st. > * Parser/EmittedComments.st: Added from scripts/Convert.st. > * Parser/EmittedEntity.st: Added from scripts/Convert.st. > * Parser/EmittedEval.st: Added from scripts/Convert.st. > * Parser/Loader.st: Added from scripts/Convert.st. > * README: Added. > * TODO: Added. > * package.xml: Added. > --- > .gitignore | 1 + > ChangeLog | 4 + > configure.ac | 1 + > packages/tooling/ChangeLog | 11 ++ > packages/tooling/Makefile.frag | 5 + > packages/tooling/Parser/EmittedClass.st | 85 ++++++++++ > packages/tooling/Parser/EmittedComments.st | 51 ++++++ > packages/tooling/Parser/EmittedEntity.st | 39 +++++ > packages/tooling/Parser/EmittedEval.st | 72 +++++++++ > packages/tooling/Parser/Loader.st | 235 > ++++++++++++++++++++++++++++ > packages/tooling/README | 2 + > packages/tooling/TODO | 2 + > packages/tooling/package.xml | 11 ++ > 13 files changed, 519 insertions(+) > create mode 100644 packages/tooling/ChangeLog > create mode 100644 packages/tooling/Makefile.frag > create mode 100644 packages/tooling/Parser/EmittedClass.st > create mode 100644 packages/tooling/Parser/EmittedComments.st > create mode 100644 packages/tooling/Parser/EmittedEntity.st > create mode 100644 packages/tooling/Parser/EmittedEval.st > create mode 100644 packages/tooling/Parser/Loader.st > create mode 100644 packages/tooling/README > create mode 100644 packages/tooling/TODO > create mode 100644 packages/tooling/package.xml > > diff --git a/.gitignore b/.gitignore > index d7a3ac0..dc2aca2 100644 > --- a/.gitignore > +++ b/.gitignore > @@ -69,6 +69,7 @@ packages/i18n/ref-add.sed > packages/i18n/ref-del.sed > packages/net/gnutls-wrapper > packages/object-dumper/stamp-classes > +packages/tooling/stamp-classes > snprintfv/snprintfv/compat.stamp > > tests/gst.im > diff --git a/ChangeLog b/ChangeLog > index aa767b8..f162b3d 100644 > --- a/ChangeLog > +++ b/ChangeLog > @@ -1,5 +1,9 @@ > 2013-03-30 Holger Hans Peter Freyther <[email protected]> > > + * configure.ac: Introduce the Tooling package. > + > +2013-03-30 Holger Hans Peter Freyther <[email protected]> > + > * configure.ac: Introduce the GTKTools package > > 2013-03-31 Holger Hans Peter Freyther <[email protected]> > diff --git a/configure.ac b/configure.ac > index c447b1c..e6ef587 100644 > --- a/configure.ac > +++ b/configure.ac > @@ -586,6 +586,7 @@ GST_PACKAGE_ENABLE([Sport], [sport]) > GST_PACKAGE_ENABLE([SUnit], [sunit]) > GST_PACKAGE_ENABLE([Swazoo], [swazoo-httpd]) > GST_PACKAGE_ENABLE([Sockets], [sockets], [], [gst_cv_sockets]) > +GST_PACKAGE_ENABLE([Tooling], [tooling]) > GST_PACKAGE_ENABLE([VFSAddOns], [vfs], [], [], [Makefile]) > GST_PACKAGE_ENABLE([GTKTools], [gtktools]) > GST_PACKAGE_ENABLE([GTKTools-Example-Clock], [gtktools/Examples/Clock]) > diff --git a/packages/tooling/ChangeLog b/packages/tooling/ChangeLog > new file mode 100644 > index 0000000..8c85f31 > --- /dev/null > +++ b/packages/tooling/ChangeLog > @@ -0,0 +1,11 @@ > +2013-03-30 Holger Hans Peter Freyther <[email protected]> > + > + * Makefile.frag: Added. > + * Parser/EmittedClass.st: Added from scripts/Convert.st. > + * Parser/EmittedComments.st: Added from scripts/Convert.st. > + * Parser/EmittedEntity.st: Added from scripts/Convert.st. > + * Parser/EmittedEval.st: Added from scripts/Convert.st. > + * Parser/Loader.st: Added from scripts/Convert.st. > + * README: Added. > + * TODO: Added. > + * package.xml: Added. > diff --git a/packages/tooling/Makefile.frag b/packages/tooling/Makefile.frag > new file mode 100644 > index 0000000..01d8d86 > --- /dev/null > +++ b/packages/tooling/Makefile.frag > @@ -0,0 +1,5 @@ > +Tooling_FILES = \ > +packages/tooling/Parser/EmittedEntity.st > packages/tooling/Parser/EmittedClass.st > packages/tooling/Parser/EmittedComments.st > packages/tooling/Parser/EmittedEval.st packages/tooling/Parser/Loader.st > packages/tooling/Lint/Monticello.st > +$(Tooling_FILES): > +$(srcdir)/packages/tooling/stamp-classes: $(Tooling_FILES) > + touch $(srcdir)/packages/tooling/stamp-classes > diff --git a/packages/tooling/Parser/EmittedClass.st > b/packages/tooling/Parser/EmittedClass.st > new file mode 100644 > index 0000000..9a2cb13 > --- /dev/null > +++ b/packages/tooling/Parser/EmittedClass.st > @@ -0,0 +1,85 @@ > +"====================================================================== > +| > +| Smalltalk syntax conversion tool > +| > +| > + ======================================================================" > + > + > +"====================================================================== > +| > +| Copyright 2007, 2008, 2009 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. > +| > + ======================================================================" > + > +EmittedEntity subclass: EmittedClass [ > + | class methodsToEmit classMethodsToEmit isComplete | > + > + <category: 'Tooling-Parser-Core'> > + <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. > + ] > +] > diff --git a/packages/tooling/Parser/EmittedComments.st > b/packages/tooling/Parser/EmittedComments.st > new file mode 100644 > index 0000000..fb09552 > --- /dev/null > +++ b/packages/tooling/Parser/EmittedComments.st > @@ -0,0 +1,51 @@ > +"====================================================================== > +| > +| Smalltalk syntax conversion tool > +| > +| > + ======================================================================" > + > + > +"====================================================================== > +| > +| Copyright 2007, 2008, 2009 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. > +| > + ======================================================================" > + > +EmittedEntity subclass: EmittedComments [ > + | comments | > + <category: 'Tooling-Parser-Core'> > + > + 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 > + ] > +] > diff --git a/packages/tooling/Parser/EmittedEntity.st > b/packages/tooling/Parser/EmittedEntity.st > new file mode 100644 > index 0000000..aeb6928 > --- /dev/null > +++ b/packages/tooling/Parser/EmittedEntity.st > @@ -0,0 +1,39 @@ > +"====================================================================== > +| > +| Parsing helper routines > +| > +| > + ======================================================================" > + > + > +"====================================================================== > +| > +| Copyright 2007, 2008, 2009 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. > +| > + ======================================================================" > + > +Object subclass: EmittedEntity [ > + <category: 'Tooling-Parser-Core'> > + > + emitTo: aStream filteredBy: aBlock [ > + self subclassResponsibility > + ] > +] > diff --git a/packages/tooling/Parser/EmittedEval.st > b/packages/tooling/Parser/EmittedEval.st > new file mode 100644 > index 0000000..2b82158 > --- /dev/null > +++ b/packages/tooling/Parser/EmittedEval.st > @@ -0,0 +1,72 @@ > +"====================================================================== > +| > +| Smalltalk syntax conversion tool > +| > +| > + ======================================================================" > + > + > +"====================================================================== > +| > +| Copyright 2007, 2008, 2009 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. > +| > + ======================================================================" > + > +EmittedEntity subclass: EmittedEval [ > + | statements comments namespace | > + > + <category: 'Tooling-Parser-Core'> > + <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. > + ] > +] > diff --git a/packages/tooling/Parser/Loader.st > b/packages/tooling/Parser/Loader.st > new file mode 100644 > index 0000000..6b64301 > --- /dev/null > +++ b/packages/tooling/Parser/Loader.st > @@ -0,0 +1,235 @@ > +"====================================================================== > +| > +| Smalltalk syntax conversion tool > +| > +| > + ======================================================================" > + > + > +"====================================================================== > +| > +| Copyright 2007, 2008, 2009 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.STClassLoader subclass: Loader [ > + | stuffToEmit classesToEmit createdNamespaces filter outStream rewriter | > + > + <category: 'Tooling-Parser-Core'> > + <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. > + > + TODO: Split the loading and converting'> > + > + > + Loader class >> convertSqueakStream: in to: out [ > + <category: 'instance creation'> > + ^self convertStream: in with: STInST.SqueakFileInParser to: out > + ] > + > + Loader class >> convertSIFStream: in to: out [ > + <category: 'instance creation'> > + ^self convertStream: in with: STInST.SIFFileInParser to: out > + ] > + > + Loader class >> convertStream: in to: out [ > + <category: 'instance creation'> > + ^self convertStream: in with: STInST.STFileInParser to: out > + ] > + > + Loader 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) ] > + ] > +] > diff --git a/packages/tooling/README b/packages/tooling/README > new file mode 100644 > index 0000000..9c11254 > --- /dev/null > +++ b/packages/tooling/README > @@ -0,0 +1,2 @@ > +Random collection of tooling classes for GST. Used for import/export > +of GST to other dialects and the base for IDEs and similiar utilities. > diff --git a/packages/tooling/TODO b/packages/tooling/TODO > new file mode 100644 > index 0000000..bc29fe6 > --- /dev/null > +++ b/packages/tooling/TODO > @@ -0,0 +1,2 @@ > +* Make the Loader have a Converter subclass and use a Visitor instead > + of the calls to emitTo:. > diff --git a/packages/tooling/package.xml b/packages/tooling/package.xml > new file mode 100644 > index 0000000..ff3c23f > --- /dev/null > +++ b/packages/tooling/package.xml > @@ -0,0 +1,11 @@ > +<package> > + <name>Tooling</name> > + <namespace>Tooling</namespace> > + <prereq>Parser</prereq> > + > + <filein>Parser/EmittedEntity.st</filein> > + <filein>Parser/EmittedClass.st</filein> > + <filein>Parser/EmittedComments.st</filein> > + <filein>Parser/EmittedEval.st</filein> > + <filein>Parser/Loader.st</filein> > +</package> > _______________________________________________ help-smalltalk mailing list [email protected] https://lists.gnu.org/mailman/listinfo/help-smalltalk
