--- a/ChangeSet.st Wed May 15 14:19:33 2019 +0200
+++ b/ChangeSet.st Sun May 26 01:31:11 2019 +0200
@@ -91,6 +91,13 @@
privateIn:ChangeSet
!
+ChangeSet::ChangeFileReader subclass:#GithubPharoSmalltalkFileReader
+ instanceVariableNames:'parser'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ChangeSet
+!
+
ChangeSet::ChangeProcessingError subclass:#InvalidChangeChunkError
instanceVariableNames:''
classVariableNames:''
@@ -704,6 +711,38 @@
"Created: / 10-02-2019 / 16:18:31 / Claus Gittinger"
!
+fromGithubPharoSmalltalkStream:aStream
+ "build a changeSet from a Pharo GitHub format stream,
+ containing a class or extension definition.
+ See https://github.com/bouraqadi/PharoJS/Pharo
+ as an example.
+ Return the changeSet."
+
+ |changeSet|
+
+ changeSet := self new.
+ GithubPharoSmalltalkFileReader new
+ changesFromStream:aStream
+ for:changeSet
+ do:[:aChange :lineNumberOrNil :posOrNil |
+ changeSet add:aChange.
+ ].
+
+ ^ changeSet
+
+ "
+ self fromGithubPharoSmalltalkStream:
+ '/Users/cg/Downloads/smalltalk/PharoJS-master/Pharo/PharoJsBridgeTest/PjBasicTest.class.st'
+ asFilename readStream
+
+ self fromGithubPharoSmalltalkStream:
+ '/Users/cg/Downloads/smalltalk/PharoJS-master/Pharo/PharoJsCoreLibraries/PjStack.class.st'
+ asFilename readStream
+ "
+
+ "Created: / 25-05-2019 / 22:53:58 / Claus Gittinger"
+!
+
fromSIFStream:aStream
"build a changeSet from a SIF stream, containing chunks
in smalltalk interchange format.
@@ -5365,6 +5404,651 @@
"Modified: / 10-02-2019 / 22:48:34 / Claus Gittinger"
! !
+!ChangeSet::GithubPharoSmalltalkFileReader class methodsFor:'documentation'!
+
+documentation
+"
+ ChangeSet fromGithubPharoSmalltalkStream:
+ '/Users/cg/Downloads/smalltalk/PharoJS-master/Pharo/PharoJsBridgeTest/PjBasicTest.class.st'
+ asFilename readStream
+
+ ChangeSet fromGithubPharoSmalltalkStream:
+ '/Users/cg/Downloads/smalltalk/PharoJS-master/Pharo/PharoJsCoreLibraries/PjStack.class.st'
+ asFilename readStream
+
+ |dir|
+ dir := '/Users/cg/Downloads/smalltalk/PharoJS-master/Pharo/PharoJsCoreLibraries' asFilename.
+ dir filesMatchingGLOB:'*.st' do:[:eachSTFile |
+ Transcript showCR:'reading %1' with:eachSTFile baseName.
+ eachSTFile readingFileDo:[:s |
+ ChangeSet fromGithubPharoSmalltalkStream:s
+ ].
+ ].
+"
+! !
+
+!ChangeSet::GithubPharoSmalltalkFileReader methodsFor:'private'!
+
+readClassDefinition:what
+ "what is either #class or #trait.
+ 'Class/Trait' '{' has been read.
+ read the class definition proper"
+
+ |name superClassName classType pools category
+ traits classTraits instVarNames classVarNames classInstVarNames
+ classDefChange traitDefChange|
+
+ parser nextToken.
+ [parser token == $} ] whileFalse:[
+ |keyw|
+
+ parser tokenType == #Symbol ifFalse:[
+ parser parseError:'class definition keyword symbol expected (eg. #name)'
+ ].
+ keyw := parser token.
+ parser nextToken.
+ parser expectToken:$:.
+
+ keyw == #name ifTrue:[
+ parser tokenType == #Symbol ifFalse:[
+ parser parseError:'class name symbol expected (eg. #name : #className)'
+ ].
+ name := parser token.
+ parser nextToken.
+ ] ifFalse:[
+ keyw == #superclass ifTrue:[
+ parser tokenType == #Symbol ifFalse:[
+ parser parseError:'superclass name symbol expected (eg. #superclass : #className)'
+ ].
+ superClassName := parser token.
+ parser nextToken.
+ ] ifFalse:[
+ keyw == #category ifTrue:[
+ parser tokenType == #Symbol ifFalse:[
+ parser parseError:'category symbol expected (eg. #category : #categoryName)'
+ ].
+ category := parser token.
+ parser nextToken.
+ ] ifFalse:[
+ keyw == #type ifTrue:[
+ parser tokenType == #Symbol ifFalse:[
+ parser parseError:'category symbol expected (eg. #category : #categoryName)'
+ ].
+ classType := parser token.
+ parser nextToken.
+ ] ifFalse:[
+ keyw == #pools ifTrue:[
+ parser tokenType == $[ ifFalse:[
+ parser parseError:'pools collection expected (eg. #pools : [ ... ]'
+ ].
+ pools := self readStringList.
+ ] ifFalse:[
+ keyw == #traits ifTrue:[
+ parser tokenType == #String ifFalse:[
+ parser parseError:'traits string expected'
+ ].
+ traits := parser token.
+ parser nextToken.
+ ] ifFalse:[
+ keyw == #classTraits ifTrue:[
+ parser tokenType == #String ifFalse:[
+ parser parseError:'classTraits string expected'
+ ].
+ classTraits := parser token.
+ parser nextToken.
+ ] ifFalse:[
+ keyw == #instVars ifTrue:[
+ parser tokenType == $[ ifFalse:[
+ parser parseError:'instVarNames collection expected (eg. #instVars : [ ... ]'
+ ].
+ instVarNames := self readStringList
+ ] ifFalse:[
+ keyw == #classVars ifTrue:[
+ parser tokenType == $[ ifFalse:[
+ parser parseError:'classVars collection expected (eg. #instVars : [ ... ]'
+ ].
+ classVarNames := self readStringList
+ ] ifFalse:[
+ keyw == #classInstVars ifTrue:[
+ parser tokenType == $[ ifFalse:[
+ parser parseError:'classInstVars collection expected (eg. #instVars : [ ... ]'
+ ].
+ classInstVarNames := self readStringList
+ ] ifFalse:[
+ self halt.
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ parser token = ',' ifTrue:[
+ parser nextToken
+ ].
+ ].
+ parser nextToken.
+
+ what == #class ifTrue:[
+ classDefChange := ClassDefinitionChange new.
+ classDefChange className:name.
+ classDefChange superClassName:superClassName.
+ "/ classDefChange instanceVariableString:(instVars asStringWith:' ').
+ classDefChange category:(category ? 'Pharo classes').
+
+ self addChange:classDefChange.
+ ] ifFalse:[
+ what == #trait ifTrue:[
+ traitDefChange := TraitDefinitionChange new.
+ traitDefChange className:name.
+ traitDefChange category:(category ? 'Pharo traits').
+
+ self addChange:traitDefChange.
+ ] ifFalse:[
+ self halt.
+ ].
+ ].
+
+ parser atEnd ifFalse:[
+ self readMethods:what.
+ ].
+
+ "
+ self fromGithubPharoSmalltalkStream:
+ '/Users/cg/Downloads/smalltalk/PharoJS-master/Pharo/PharoJsBridgeTest/PjBasicTest.class.st'
+ asFilename readStream
+
+ self fromGithubPharoSmalltalkStream:
+ '/Users/cg/Downloads/smalltalk/PharoJS-master/Pharo/PharoJsCoreLibraries/PjStack.class.st'
+ asFilename readStream
+ "
+
+"/
+"/ "/ expect a subclass definition of the form:
+"/ "/ <identifier> subclass: <identifier>
+"/ classDefinition := parser keywordExpression.
+"/ (classDefinition isMessage
+"/ and:[ #( #'subclass:' ) includes:classDefinition selector ]) ifFalse:[
+"/ parser parseError:'class definition message expected (id subclass: id)'
+"/ ].
+"/ classDefinition receiver isVariable ifFalse:[
+"/ parser parseError:'invalid superclass in class definition'
+"/ ].
+"/ superClassName := classDefinition receiver name.
+"/
+"/ "/ GNU uses plain name for the new class - we need a symbol
+"/ classDefinition arg1 isVariable ifFalse:[
+"/ parser parseError:'invalid classname in class definition'
+"/ ].
+"/ newClassName := classDefinition arg1 name.
+"/
+"/ classDefinition arguments
+"/ at:1 put:(ConstantNode value:classDefinition arg1 name asSymbol).
+"/
+"/ parser tokenType == $[ ifFalse:[
+"/ parser parseError:'"[" expected (class definition)'
+"/ ].
+"/ parser nextToken.
+"/
+"/ [(parser tokenType == #BinaryOperator) and:[parser token = '<']] whileTrue:[
+"/ parser nextToken.
+"/ k := parser token.
+"/ ( #('category:' 'comment:') includes: k) ifTrue:[
+"/ parser nextToken.
+"/ (parser tokenType == #String) ifTrue:[
+"/ k = 'category:' ifTrue:[
+"/ classCategory := parser token.
+"/ ] ifFalse:[
+"/ classComment := parser token.
+"/ ].
+"/ parser nextToken.
+"/ (parser token = '>') ifFalse:[
+"/ parser parseError:'">" expected'
+"/ ].
+"/ parser nextToken.
+"/ ] ifFalse:[
+"/self halt.
+"/ ].
+"/ ] ifFalse:[
+"/ self halt.
+"/ ].
+"/ ].
+"/
+"/ instVars := OrderedCollection new.
+"/ "/ instvar definition?
+"/ parser tokenType == $| ifTrue:[
+"/ parser nextToken.
+"/ [ parser tokenType == $| ] whileFalse:[
+"/ parser tokenType == #Identifier ifFalse:[
+"/ parser parseError:'identifier expected (in instvar list)'.
+"/ ].
+"/ instVars add:parser token.
+"/ parser nextToken.
+"/ ].
+"/ parser nextToken.
+"/ ].
+"/
+"/ self addChange:(ClassDefinitionChange new
+"/ className:newClassName;
+"/ superClassName:superClassName;
+"/ instanceVariableString:(instVars asStringWith:' ');
+"/ category:(classCategory ? 'GNU classes');
+"/ yourself).
+"/
+"/ classComment notNil ifTrue:[
+"/ self addChange:(ClassCommentChange new
+"/ className:newClassName;
+"/ comment:classComment;
+"/ yourself)
+"/ ].
+"/
+"/ "/ methods
+"/ [ parser tokenType == $] ] whileFalse:[
+"/ "/ must be
+"/ "/ ( NewClassName | NewClassName "class" ) methodSpec
+"/ "/ or
+"/ "/ methodSpec
+"/ methodClassName := newClassName.
+"/
+"/ (parser tokenType == #Identifier
+"/ and:[ parser token = newClassName ]) ifTrue:[
+"/ parser nextToken.
+"/ (parser tokenType == #Identifier
+"/ and:[ parser token = 'class' ]) ifTrue:[
+"/ parser nextToken.
+"/ methodClassName := methodClassName,' class'.
+"/ ].
+"/ "/ expect >>
+"/ (parser tokenType == #BinaryOperator
+"/ and:[parser token = '>>']) ifFalse:[
+"/ parser parseError:('">>" expected').
+"/ ].
+"/ parser nextToken.
+"/ ].
+"/
+"/ methodSpecStartPos := parser tokenPosition.
+"/ parser parseMethodSpec.
+"/ methodSpecEndPos := parser tokenPosition-1.
+"/ methodSpecSource := inputStream collection copyFrom:methodSpecStartPos to:methodSpecEndPos.
+"/
+"/ parser tokenType == $[ ifFalse:[
+"/ parser parseError:'"[" expected (method definition)'
+"/ ].
+"/ parser nextToken.
+"/
+"/ methodStartPos := parser tokenPosition.
+"/ parser parseMethodBody.
+"/ methodEndPos := parser tokenPosition-1.
+"/ methodSource := inputStream collection copyFrom:methodStartPos to:methodEndPos.
+"/
+"/ parser tokenType == $] ifFalse:[
+"/ parser parseError:'"]" expected (method definition)'
+"/ ].
+"/ parser nextToken.
+"/
+"/ self addChange:(MethodDefinitionChange
+"/ className:methodClassName
+"/ selector:parser selector
+"/ source:(methodSpecSource,Character cr,methodSource)
+"/ category:'* uncategorized GNU *')
+"/ ].
+"/
+"/"<<END
+"/
+"/ ChangeSet fromGNUSmalltalkStream:'
+"/Object subclass: Polynomial [
+"/ <category: ''Math''>
+"/ |coeffs|
+"/ Polynomial class >> new [ ^ super basicNew init ]
+"/ init [ coeffs := OrderedCollection new. ^ self ]
+"/ Polynomial class >> newWithCoefficients: coefficients [
+"/ |r|
+"/ r := super basicNew.
+"/ ^ r initWithCoefficients: coefficients
+"/ ]
+"/ initWithCoefficients: coefficients [
+"/ coeffs := coefficients asOrderedCollection.
+"/ ^ self
+"/ ]
+"/ / denominator [ |n q|
+"/ n := self deepCopy.
+"/ self >= denominator
+"/ ifTrue: [
+"/ q := Polynomial new.
+"/ [ n >= denominator ]
+"/ whileTrue: [ |piv|
+"/ piv := (n coeff: 0) / (denominator coeff: 0).
+"/ q addCoefficient: piv.
+"/ n := n - (denominator * piv).
+"/ n clean
+"/ ].
+"/ ^ { q . (n degree) > 0 ifTrue: [ n ] ifFalse: [ n addCoefficient: 0. n ] }
+"/ ]
+"/ ifFalse: [
+"/ ^ { Polynomial newWithCoefficients: #( 0 ) . self deepCopy }
+"/ ]
+"/ ]
+"/ * constant [ |r| r := self deepCopy.
+"/ 1 to: (coeffs size) do: [ :i |
+"/ r at: i put: ((r at: i) * constant)
+"/ ].
+"/ ^ r
+"/ ]
+"/ at: index [ ^ coeffs at: index ]
+"/ at: index put: obj [ ^ coeffs at: index put: obj ]
+"/ >= anotherPoly [
+"/ ^ (self degree) >= (anotherPoly degree)
+"/ ]
+"/ degree [ ^ coeffs size ]
+"/ - anotherPoly [ "This is not a real subtraction between Polynomial: it is an
+"/ internal method ..."
+"/ |a|
+"/ a := self deepCopy.
+"/ 1 to: ( (coeffs size) min: (anotherPoly degree) ) do: [ :i |
+"/ a at: i put: ( (a at: i) - (anotherPoly at: i) )
+"/ ].
+"/ ^ a
+"/ ]
+"/ coeff: index [ ^ coeffs at: (index + 1) ]
+"/ addCoefficient: coeff [ coeffs add: coeff ]
+"/ clean [
+"/ [ (coeffs size) > 0
+"/ ifTrue: [ (coeffs at: 1) = 0 ] ifFalse: [ false ] ]
+"/ whileTrue: [ coeffs removeFirst ].
+"/ ]
+"/ display [
+"/ 1 to: (coeffs size) do: [ :i |
+"/ (coeffs at: i) display.
+"/ i < (coeffs size)
+"/ ifTrue: [ (''x^%1 + '' % {(coeffs size) - i} ) display ]
+"/ ]
+"/ ]
+"/ displayNl [ self display. Character nl display ]
+"/].' readStream
+"/
+"/END>>"
+"/
+"/ "Created: / 10-02-2019 / 16:21:15 / Claus Gittinger"
+"/
+
+ "Created: / 26-05-2019 / 01:24:29 / Claus Gittinger"
+!
+
+readClassFile
+ parser nextToken. "/ skip over 'Class'
+ parser token == ${ ifFalse:[
+ parser parseError:'"{" expected after Class keyword'
+ ].
+ self readClassDefinition:#class.
+ self assert:(parser atEnd).
+
+ "Created: / 25-05-2019 / 22:58:09 / Claus Gittinger"
+ "Modified: / 26-05-2019 / 01:23:35 / Claus Gittinger"
+!
+
+readClassOrExtensionFile
+ parser := Parser new.
+
+ parser source:inputStream.
+ parser nextToken.
+
+ "/ file starts with one of:
+ "/ Class { ... }
+ "/ Extension
+ parser token = 'Class' ifTrue:[
+ self readClassFile.
+ ^ self.
+ ].
+ parser token = 'Extension' ifTrue:[
+ self readExtensionFile.
+ ^ self.
+ ].
+ parser token = 'Package' ifTrue:[
+ self readPackageFile.
+ ^ self.
+ ].
+ parser token = 'Trait' ifTrue:[
+ self readTraitFile.
+ ^ self.
+ ].
+ self halt.
+
+ "Created: / 25-05-2019 / 23:17:40 / Claus Gittinger"
+ "Modified: / 26-05-2019 / 01:24:50 / Claus Gittinger"
+!
+
+readExtensionFile
+ |keyw className|
+
+ parser nextToken. "/ skip over 'Extension'
+ parser expectToken:${.
+ parser tokenType == #Symbol ifFalse:[
+ parser parseError:'"#name" expected after "Extension {"'
+ ].
+ keyw := parser token.
+ parser nextToken. "/ skip over keyword
+ parser expectToken:$:.
+ keyw == #name ifTrue:[
+ parser tokenType == #Symbol ifFalse:[
+ parser parseError:'classname expected after "#name :"'
+ ].
+ className := parser token.
+ parser nextToken. "/ skip over class name
+ ] ifFalse:[
+ self halt
+ ].
+ parser expectToken:$}.
+
+ self readMethods:#class.
+
+ "Created: / 25-05-2019 / 23:16:52 / Claus Gittinger"
+ "Modified: / 26-05-2019 / 01:29:47 / Claus Gittinger"
+!
+
+readMethod:what
+ |keyw methodClassName category originalSource methodSource methodSourceStream s change|
+
+ parser token == ${ ifTrue:[
+ parser nextToken. "/ skip over '{'
+ (parser tokenType == #Symbol) ifFalse:[
+ parser parseError:'keyword symbol expected after " {"'
+ ].
+ keyw := parser token.
+
+ parser nextToken. "/ skip over keyword
+ parser expectToken:$:.
+ keyw == #category ifTrue:[
+ parser tokenType == #Symbol ifFalse:[
+ parser parseError:'classname expected after "#name :"'
+ ].
+ category := parser token.
+ parser nextToken. "/ skip over category name
+ ] ifFalse:[
+ self halt
+ ].
+
+ parser expectToken:$}.
+ ].
+
+ parser tokenType == #Identifier ifFalse:[
+ parser parseError:'method class name expected'
+ ].
+ methodClassName := parser token.
+ parser nextToken.
+
+ parser token = 'class' ifTrue:[
+ self assert:(what == #class).
+ methodClassName := methodClassName,' class'.
+ parser nextToken.
+ ] ifFalse:[
+ parser token = 'classSide' ifTrue:[
+ self assert:(what == #trait).
+ methodClassName := methodClassName,' class'.
+ parser nextToken.
+ ].
+ ].
+
+ parser token = '>>' ifFalse:[
+ parser parseError:'">>" expected after class name'
+ ].
+
+ originalSource := parser sourceStream.
+ methodSourceStream := WriteStream on:(String new:20).
+ s := CollectingReadStream
+ on:originalSource
+ collecting:[:each | methodSourceStream nextPut:each].
+
+ parser setSource:s.
+ parser nextToken.
+ parser parseMethodSpec.
+
+ "/ skip the last character in the collected source...
+ methodSourceStream skip:-1.
+
+ parser token == $[ ifFalse:[
+ parser parseError:'"[" expected after method spec'
+ ].
+ parser nextToken.
+
+ parser parseMethodBody.
+ parser setSource:originalSource.
+
+ "/ skip the last character in the collected source...
+ methodSourceStream skip:-1.
+ parser token == $] ifFalse:[
+ parser parseError:'"]" expected after method'
+ ].
+ parser nextToken.
+
+ methodSource := methodSourceStream contents.
+
+ methodSource := methodSource withoutLeadingSeparators.
+
+ change := MethodDefinitionChange
+ className:methodClassName
+ selector:parser selector
+ source:methodSource
+ category:category.
+ self addChange:change
+
+ "Created: / 26-05-2019 / 01:29:00 / Claus Gittinger"
+!
+
+readMethods:what
+ [
+ self readMethod:what.
+ ] doUntil:[ parser sourceStream atEnd ].
+
+ "Created: / 26-05-2019 / 01:29:11 / Claus Gittinger"
+!
+
+readPackageFile
+ |keyw packageName|
+
+ parser nextToken. "/ skip over 'Package'
+ parser expectToken:${.
+
+ parser tokenType == #Symbol ifFalse:[
+ parser parseError:'"#name" expected after "Extension {"'
+ ].
+ keyw := parser token.
+ parser nextToken. "/ skip over keyword
+ parser expectToken:$:.
+
+ keyw == #name ifTrue:[
+ parser tokenType == #Symbol ifFalse:[
+ parser parseError:'classname expected after "#name :"'
+ ].
+ packageName := parser token.
+ parser nextToken. "/ skip over class name
+ ] ifFalse:[
+ self halt
+ ].
+ parser expectToken:$}.
+
+ "Created: / 26-05-2019 / 00:18:30 / Claus Gittinger"
+!
+
+readPools
+ "'pools' ':' '[' has been read.
+ read the pools list"
+
+ ^ self readStringList
+
+ "
+ ChangeSet fromGithubPharoSmalltalkStream:
+ '/Users/cg/Downloads/smalltalk/PharoJS-master/Pharo/PharoJsCoreLibraries/PjStack.class.st'
+ asFilename readStream
+ "
+
+ "Created: / 25-05-2019 / 23:11:52 / Claus Gittinger"
+ "Modified: / 26-05-2019 / 01:16:38 / Claus Gittinger"
+!
+
+readStringList
+ "'[' has been read.
+ read a list of strings"
+
+ |strings|
+
+ self assert:(parser tokenType == $[).
+
+ parser nextToken. "/ skip over initial "["
+
+ strings := OrderedCollection new.
+
+ [parser token == $] ] whileFalse:[
+ |keyw|
+
+ parser tokenType == #String ifFalse:[
+ parser parseError:'string expected'
+ ].
+ strings add:parser token.
+ parser nextToken.
+ parser token = ',' ifTrue:[
+ parser nextToken.
+ ].
+ ].
+ parser nextToken.
+ ^ strings
+
+ "
+ ChangeSet fromGithubPharoSmalltalkStream:
+ '/Users/cg/Downloads/smalltalk/PharoJS-master/Pharo/PharoJsCoreLibraries/PjStack.class.st'
+ asFilename readStream
+ "
+
+ "Created: / 26-05-2019 / 01:16:27 / Claus Gittinger"
+!
+
+readTraitFile
+ parser nextToken. "/ skip over 'Class'
+ parser token == ${ ifFalse:[
+ parser parseError:'"{" expected after Class keyword'
+ ].
+ self readClassDefinition:#trait.
+ self assert:(parser atEnd).
+
+ "Created: / 26-05-2019 / 01:23:19 / Claus Gittinger"
+! !
+
+!ChangeSet::GithubPharoSmalltalkFileReader methodsFor:'reading'!
+
+changesFromStream:aStream for:changeSetArg do:changeActionArg
+ inputStream := aStream.
+ changeSet := changeSetArg.
+ changeAction := changeActionArg.
+
+ self readClassOrExtensionFile.
+ ^ changeSet
+
+ "Created: / 10-02-2019 / 16:20:21 / Claus Gittinger"
+ "Modified: / 25-05-2019 / 23:17:46 / Claus Gittinger"
+! !
+
!ChangeSet::InvalidChangeChunkError class methodsFor:'queries'!
mayProceed