--- a/ChangeSet.st Fri Jan 25 04:33:42 2019 +0000
+++ b/ChangeSet.st Sun Feb 10 23:18:24 2019 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
@@ -82,6 +84,13 @@
privateIn:ChangeSet
!
+ChangeSet::ChangeFileReader subclass:#GNUSmalltalkFileReader
+ instanceVariableNames:'parser'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ChangeSet
+!
+
ChangeSet::ChangeProcessingError subclass:#InvalidChangeChunkError
instanceVariableNames:''
classVariableNames:''
@@ -675,6 +684,25 @@
"Created: / 02-04-2011 / 00:50:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+fromGNUSmalltalkStream:aStream
+ "build a changeSet from a GNU Smalltalk .gst format stream, containing a class definition.
+ Return the changeSet."
+
+ |changeSet|
+
+ changeSet := self new.
+ GNUSmalltalkFileReader new
+ changesFromStream:aStream
+ for:changeSet
+ do:[:aChange :lineNumberOrNil :posOrNil |
+ changeSet add:aChange.
+ ].
+
+ ^ changeSet
+
+ "Created: / 10-02-2019 / 16:18:31 / Claus Gittinger"
+!
+
fromSIFStream:aStream
"build a changeSet from a SIF stream, containing chunks
in smalltalk interchange format.
@@ -790,7 +818,6 @@
"Created: / 27.10.1997 / 13:52:54 / cg"
! !
-
!ChangeSet class methodsFor:'Compatibility-VW'!
component: component definition: anObject change: changeSymbol
@@ -5071,6 +5098,270 @@
"Modified: / 15.12.1999 / 00:29:06 / cg"
! !
+!ChangeSet::GNUSmalltalkFileReader class methodsFor:'documentation'!
+
+documentation
+"
+ documentation to be added.
+
+ [author:]
+ Claus Gittinger
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+! !
+
+!ChangeSet::GNUSmalltalkFileReader methodsFor:'private'!
+
+readClass
+ |classDefinition classCategory classComment k
+ newClassName superClassName instVars
+ methodStartPos methodEndPos methodSpecStartPos methodSpecEndPos
+ methodClassName
+ methodSpecSource methodSource|
+
+ parser := Parser new.
+
+ parser source:inputStream.
+ parser nextToken.
+
+ "/ 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"
+ "Modified: / 10-02-2019 / 23:17:42 / Claus Gittinger"
+! !
+
+!ChangeSet::GNUSmalltalkFileReader methodsFor:'reading'!
+
+changesFromStream:aStream for:changeSetArg do:changeActionArg
+ inputStream := aStream.
+ changeSet := changeSetArg.
+ changeAction := changeActionArg.
+
+ self readClass.
+ ^ changeSet
+
+ "
+ ChangeSet fromGNUSmalltalkStream:'
+Object subclass: Polynomial [
+ |coeffs|
+ Polynomial class >> new [ ^ super basicNew init ]
+ init [ coeffs := OrderedCollection new. ^ self ]
+]
+' readStream
+ "
+
+ "Created: / 10-02-2019 / 16:20:21 / Claus Gittinger"
+ "Modified: / 10-02-2019 / 22:48:34 / Claus Gittinger"
+! !
+
!ChangeSet::InvalidChangeChunkError class methodsFor:'queries'!
mayProceed