|
@@ -1,26 +1,69 @@
|
|
-Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
!PPParser methodsFor: 'accessing'!
memo
|
|
|
|
|
|
+Object subclass: #PPParser
|
|
|
|
+ instanceVariableNames: 'memo'
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPParser methodsFor: 'accessing'!
|
|
|
|
+
|
|
|
|
+memo
|
|
^memo
|
|
^memo
|
|
-
! !
!PPParser methodsFor: 'initialization'!
initialize
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPParser methodsFor: 'initialization'!
|
|
|
|
+
|
|
|
|
+initialize
|
|
memo := Dictionary new
|
|
memo := Dictionary new
|
|
-
! !
!PPParser methodsFor: 'operations'!
flatten
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPParser methodsFor: 'operations'!
|
|
|
|
+
|
|
|
|
+flatten
|
|
^PPFlattenParser on: self
|
|
^PPFlattenParser on: self
|
|
-
!
withSource
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+withSource
|
|
^PPSourceParser on: self
|
|
^PPSourceParser on: self
|
|
-
!
==> aBlock
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+==> aBlock
|
|
^PPActionParser on: self block: aBlock
|
|
^PPActionParser on: self block: aBlock
|
|
-
!
, aParser
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+, aParser
|
|
^PPSequenceParser with: self with: aParser
|
|
^PPSequenceParser with: self with: aParser
|
|
-
!
/ aParser
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+/ aParser
|
|
^PPChoiceParser with: self with: aParser
|
|
^PPChoiceParser with: self with: aParser
|
|
-
!
plus
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+plus
|
|
^PPRepeatingParser on: self min: 1
|
|
^PPRepeatingParser on: self min: 1
|
|
-
!
star
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+star
|
|
^PPRepeatingParser on: self min: 0
|
|
^PPRepeatingParser on: self min: 0
|
|
-
!
not
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+not
|
|
^PPNotParser on: self
|
|
^PPNotParser on: self
|
|
-
!
optional
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+optional
|
|
^self / PPEpsilonParser new
|
|
^self / PPEpsilonParser new
|
|
-
!
memoizedParse: aStream
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+memoizedParse: aStream
|
|
| start end node |
|
|
| start end node |
|
|
start := aStream position.
|
|
start := aStream position.
|
|
^self memo at: start
|
|
^self memo at: start
|
|
@@ -32,31 +75,83 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
end := aStream position.
|
|
end := aStream position.
|
|
self memo at: start put: (Array with: node with: end).
|
|
self memo at: start put: (Array with: node with: end).
|
|
node]
|
|
node]
|
|
-
! !
!PPParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
self subclassResponsibility
|
|
self subclassResponsibility
|
|
-
!
parseAll: aStream
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+parseAll: aStream
|
|
| result |
|
|
| result |
|
|
result := (PPSequenceParser with: self with: PPEOFParser new) memoizedParse: aStream.
|
|
result := (PPSequenceParser with: self with: PPEOFParser new) memoizedParse: aStream.
|
|
^result isParseFailure
|
|
^result isParseFailure
|
|
ifTrue: [self error: (result messageFor: aStream contents)]
|
|
ifTrue: [self error: (result messageFor: aStream contents)]
|
|
ifFalse: [result first]
|
|
ifFalse: [result first]
|
|
-
! !
PPParser subclass: #PPEOFParser
instanceVariableNames: ''
category: 'Parser'!
!PPEOFParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPParser subclass: #PPEOFParser
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPEOFParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
^aStream atEnd
|
|
^aStream atEnd
|
|
ifFalse: [
|
|
ifFalse: [
|
|
PPFailure new reason: 'EOF expected' at: aStream position]
|
|
PPFailure new reason: 'EOF expected' at: aStream position]
|
|
ifTrue: [nil]
|
|
ifTrue: [nil]
|
|
-
! !
PPParser subclass: #PPAnyParser
instanceVariableNames: ''
category: 'Parser'!
!PPAnyParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPParser subclass: #PPAnyParser
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPAnyParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
^aStream atEnd
|
|
^aStream atEnd
|
|
ifTrue: [PPFailure new
|
|
ifTrue: [PPFailure new
|
|
reason: 'did not expect EOF' at: aStream position]
|
|
reason: 'did not expect EOF' at: aStream position]
|
|
ifFalse: [aStream next]
|
|
ifFalse: [aStream next]
|
|
-
! !
PPParser subclass: #PPEpsilonParser
instanceVariableNames: ''
category: 'Parser'!
!PPEpsilonParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPParser subclass: #PPEpsilonParser
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPEpsilonParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
^nil
|
|
^nil
|
|
-
! !
PPParser subclass: #PPStringParser
instanceVariableNames: 'string'
category: 'Parser'!
!PPStringParser methodsFor: 'accessing'!
string
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPParser subclass: #PPStringParser
|
|
|
|
+ instanceVariableNames: 'string'
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPStringParser methodsFor: 'accessing'!
|
|
|
|
+
|
|
|
|
+string
|
|
^string
|
|
^string
|
|
-
!
string: aString
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+string: aString
|
|
string := aString
|
|
string := aString
|
|
-
! !
!PPStringParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPStringParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
| position result |
|
|
| position result |
|
|
position := aStream position.
|
|
position := aStream position.
|
|
result := aStream next: self string size.
|
|
result := aStream next: self string size.
|
|
@@ -65,29 +160,87 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
ifFalse: [
|
|
ifFalse: [
|
|
aStream position: position.
|
|
aStream position: position.
|
|
PPFailure new reason: 'Expected ', self string, ' but got ', (result at: position) printString; yourself]
|
|
PPFailure new reason: 'Expected ', self string, ' but got ', (result at: position) printString; yourself]
|
|
-
! !
PPParser subclass: #PPCharacterParser
instanceVariableNames: 'regexp'
category: 'Parser'!
!PPCharacterParser methodsFor: 'accessing'!
string: aString
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPParser subclass: #PPCharacterParser
|
|
|
|
+ instanceVariableNames: 'regexp'
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPCharacterParser methodsFor: 'accessing'!
|
|
|
|
+
|
|
|
|
+string: aString
|
|
regexp := RegularExpression fromString: '[', aString, ']'
|
|
regexp := RegularExpression fromString: '[', aString, ']'
|
|
-
! !
!PPCharacterParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPCharacterParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
^(aStream peek notNil and: [self match: aStream peek])
|
|
^(aStream peek notNil and: [self match: aStream peek])
|
|
ifTrue: [aStream next]
|
|
ifTrue: [aStream next]
|
|
ifFalse: [PPFailure new reason: 'Could not match' at: aStream position]
|
|
ifFalse: [PPFailure new reason: 'Could not match' at: aStream position]
|
|
-
! !
!PPCharacterParser methodsFor: 'private'!
match: aString
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPCharacterParser methodsFor: 'private'!
|
|
|
|
+
|
|
|
|
+match: aString
|
|
^aString match: regexp
|
|
^aString match: regexp
|
|
-
! !
PPParser subclass: #PPListParser
instanceVariableNames: 'parsers'
category: 'Parser'!
!PPListParser methodsFor: 'accessing'!
parsers
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPParser subclass: #PPListParser
|
|
|
|
+ instanceVariableNames: 'parsers'
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPListParser methodsFor: 'accessing'!
|
|
|
|
+
|
|
|
|
+parsers
|
|
^parsers ifNil: [#()]
|
|
^parsers ifNil: [#()]
|
|
-
!
parsers: aCollection
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+parsers: aCollection
|
|
parsers := aCollection
|
|
parsers := aCollection
|
|
-
! !
!PPListParser methodsFor: 'copying'!
copyWith: aParser
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPListParser methodsFor: 'copying'!
|
|
|
|
+
|
|
|
|
+copyWith: aParser
|
|
^self class withAll: (self parsers copyWith: aParser)
|
|
^self class withAll: (self parsers copyWith: aParser)
|
|
-
! !
!PPListParser class methodsFor: 'instance creation'!
withAll: aCollection
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPListParser class methodsFor: 'instance creation'!
|
|
|
|
+
|
|
|
|
+withAll: aCollection
|
|
^self new
|
|
^self new
|
|
parsers: aCollection;
|
|
parsers: aCollection;
|
|
yourself
|
|
yourself
|
|
-
!
with: aParser with: anotherParser
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+with: aParser with: anotherParser
|
|
^self withAll: (Array with: aParser with: anotherParser)
|
|
^self withAll: (Array with: aParser with: anotherParser)
|
|
-
! !
PPListParser subclass: #PPSequenceParser
instanceVariableNames: ''
category: 'Parser'!
!PPSequenceParser methodsFor: 'copying'!
, aRule
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPListParser subclass: #PPSequenceParser
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPSequenceParser methodsFor: 'copying'!
|
|
|
|
+
|
|
|
|
+, aRule
|
|
^self copyWith: aRule
|
|
^self copyWith: aRule
|
|
-
! !
!PPSequenceParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPSequenceParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
| start elements element |
|
|
| start elements element |
|
|
start := aStream position.
|
|
start := aStream position.
|
|
elements := #().
|
|
elements := #().
|
|
@@ -100,9 +253,23 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
^element isParseFailure
|
|
^element isParseFailure
|
|
ifFalse: [elements]
|
|
ifFalse: [elements]
|
|
ifTrue: [aStream position: start. element]
|
|
ifTrue: [aStream position: start. element]
|
|
-
! !
PPListParser subclass: #PPChoiceParser
instanceVariableNames: ''
category: 'Parser'!
!PPChoiceParser methodsFor: 'copying'!
/ aRule
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPListParser subclass: #PPChoiceParser
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPChoiceParser methodsFor: 'copying'!
|
|
|
|
+
|
|
|
|
+/ aRule
|
|
^self copyWith: aRule
|
|
^self copyWith: aRule
|
|
-
! !
!PPChoiceParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPChoiceParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
| result |
|
|
| result |
|
|
self parsers
|
|
self parsers
|
|
detect: [:each |
|
|
detect: [:each |
|
|
@@ -110,46 +277,120 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
result isParseFailure not]
|
|
result isParseFailure not]
|
|
ifNone: [].
|
|
ifNone: [].
|
|
^result
|
|
^result
|
|
-
! !
PPParser subclass: #PPDelegateParser
instanceVariableNames: 'parser'
category: 'Parser'!
!PPDelegateParser methodsFor: 'accessing'!
parser
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPParser subclass: #PPDelegateParser
|
|
|
|
+ instanceVariableNames: 'parser'
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPDelegateParser methodsFor: 'accessing'!
|
|
|
|
+
|
|
|
|
+parser
|
|
^parser
|
|
^parser
|
|
-
!
parser: aParser
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+parser: aParser
|
|
parser := aParser
|
|
parser := aParser
|
|
-
! !
!PPDelegateParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPDelegateParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
^self parser memoizedParse: aStream
|
|
^self parser memoizedParse: aStream
|
|
-
! !
!PPDelegateParser class methodsFor: 'instance creation'!
on: aParser
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPDelegateParser class methodsFor: 'instance creation'!
|
|
|
|
+
|
|
|
|
+on: aParser
|
|
^self new
|
|
^self new
|
|
parser: aParser;
|
|
parser: aParser;
|
|
yourself
|
|
yourself
|
|
-
! !
PPDelegateParser subclass: #PPAndParser
instanceVariableNames: ''
category: 'Parser'!
!PPAndParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPDelegateParser subclass: #PPAndParser
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPAndParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
^self basicParse: aStream
|
|
^self basicParse: aStream
|
|
-
!
basicParse: aStream
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+basicParse: aStream
|
|
| element position |
|
|
| element position |
|
|
position := aStream position.
|
|
position := aStream position.
|
|
element := self parser memoizedParse: aStream.
|
|
element := self parser memoizedParse: aStream.
|
|
aStream position: position.
|
|
aStream position: position.
|
|
^element
|
|
^element
|
|
-
! !
PPAndParser subclass: #PPNotParser
instanceVariableNames: ''
category: 'Parser'!
!PPNotParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPAndParser subclass: #PPNotParser
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPNotParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
| element |
|
|
| element |
|
|
element := self basicParse: aStream.
|
|
element := self basicParse: aStream.
|
|
^element isParseFailure
|
|
^element isParseFailure
|
|
ifTrue: [nil]
|
|
ifTrue: [nil]
|
|
ifFalse: [PPFailure reason: element at: aStream position]
|
|
ifFalse: [PPFailure reason: element at: aStream position]
|
|
-
! !
PPDelegateParser subclass: #PPActionParser
instanceVariableNames: 'block'
category: 'Parser'!
!PPActionParser methodsFor: 'accessing'!
block
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPDelegateParser subclass: #PPActionParser
|
|
|
|
+ instanceVariableNames: 'block'
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPActionParser methodsFor: 'accessing'!
|
|
|
|
+
|
|
|
|
+block
|
|
^block
|
|
^block
|
|
-
!
block: aBlock
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+block: aBlock
|
|
block := aBlock
|
|
block := aBlock
|
|
-
! !
!PPActionParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPActionParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
| element |
|
|
| element |
|
|
element := self parser memoizedParse: aStream.
|
|
element := self parser memoizedParse: aStream.
|
|
^element isParseFailure
|
|
^element isParseFailure
|
|
ifFalse: [self block value: element]
|
|
ifFalse: [self block value: element]
|
|
ifTrue: [element]
|
|
ifTrue: [element]
|
|
-
! !
!PPActionParser class methodsFor: 'instance creation'!
on: aParser block: aBlock
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPActionParser class methodsFor: 'instance creation'!
|
|
|
|
+
|
|
|
|
+on: aParser block: aBlock
|
|
^self new
|
|
^self new
|
|
parser: aParser;
|
|
parser: aParser;
|
|
block: aBlock;
|
|
block: aBlock;
|
|
yourself
|
|
yourself
|
|
-
! !
PPDelegateParser subclass: #PPFlattenParser
instanceVariableNames: ''
category: 'Parser'!
!PPFlattenParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPDelegateParser subclass: #PPFlattenParser
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPFlattenParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
| start element stop |
|
|
| start element stop |
|
|
start := aStream position.
|
|
start := aStream position.
|
|
element := self parser memoizedParse: aStream.
|
|
element := self parser memoizedParse: aStream.
|
|
@@ -158,7 +399,16 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
ifFalse: [aStream collection
|
|
ifFalse: [aStream collection
|
|
copyFrom: start + 1
|
|
copyFrom: start + 1
|
|
to: aStream position]
|
|
to: aStream position]
|
|
-
! !
PPDelegateParser subclass: #PPSourceParser
instanceVariableNames: ''
category: 'Parser'!
!PPSourceParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPDelegateParser subclass: #PPSourceParser
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPSourceParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
| start element stop result |
|
|
| start element stop result |
|
|
start := aStream position.
|
|
start := aStream position.
|
|
element := self parser memoizedParse: aStream.
|
|
element := self parser memoizedParse: aStream.
|
|
@@ -166,11 +416,28 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
ifTrue: [element]
|
|
ifTrue: [element]
|
|
ifFalse: [result := aStream collection copyFrom: start + 1 to: aStream position.
|
|
ifFalse: [result := aStream collection copyFrom: start + 1 to: aStream position.
|
|
Array with: element with: result].
|
|
Array with: element with: result].
|
|
-
! !
PPDelegateParser subclass: #PPRepeatingParser
instanceVariableNames: 'min'
category: 'Parser'!
!PPRepeatingParser methodsFor: 'accessing'!
min
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+PPDelegateParser subclass: #PPRepeatingParser
|
|
|
|
+ instanceVariableNames: 'min'
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPRepeatingParser methodsFor: 'accessing'!
|
|
|
|
+
|
|
|
|
+min
|
|
^min
|
|
^min
|
|
-
!
min: aNumber
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+min: aNumber
|
|
min := aNumber
|
|
min := aNumber
|
|
-
! !
!PPRepeatingParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPRepeatingParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
| start element elements failure |
|
|
| start element elements failure |
|
|
start := aStream position.
|
|
start := aStream position.
|
|
elements := Array new.
|
|
elements := Array new.
|
|
@@ -188,30 +455,75 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
ifFalse: [elements addLast: element]].
|
|
ifFalse: [elements addLast: element]].
|
|
elements]
|
|
elements]
|
|
ifNotNil: [failure].
|
|
ifNotNil: [failure].
|
|
-
! !
!PPRepeatingParser class methodsFor: 'instance creation'!
on: aParser min: aNumber
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPRepeatingParser class methodsFor: 'instance creation'!
|
|
|
|
+
|
|
|
|
+on: aParser min: aNumber
|
|
^self new
|
|
^self new
|
|
parser: aParser;
|
|
parser: aParser;
|
|
min: aNumber;
|
|
min: aNumber;
|
|
yourself
|
|
yourself
|
|
-
! !
Object subclass: #PPFailure
instanceVariableNames: 'position, reason'
category: 'Parser'!
!PPFailure methodsFor: 'accessing'!
position
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+Object subclass: #PPFailure
|
|
|
|
+ instanceVariableNames: 'position, reason'
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!PPFailure methodsFor: 'accessing'!
|
|
|
|
+
|
|
|
|
+position
|
|
^position ifNil: [0]
|
|
^position ifNil: [0]
|
|
-
!
position: aNumber
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+position: aNumber
|
|
position := aNumber
|
|
position := aNumber
|
|
-
!
reason
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+reason
|
|
^reason ifNil: ['']
|
|
^reason ifNil: ['']
|
|
-
!
reason: aString
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+reason: aString
|
|
reason := aString
|
|
reason := aString
|
|
-
!
reason: aString at: anInteger
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+reason: aString at: anInteger
|
|
self
|
|
self
|
|
reason: aString;
|
|
reason: aString;
|
|
position: anInteger
|
|
position: anInteger
|
|
-
! !
!PPFailure methodsFor: 'testing'!
isParseFailure
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPFailure methodsFor: 'testing'!
|
|
|
|
+
|
|
|
|
+isParseFailure
|
|
^true
|
|
^true
|
|
-
! !
!PPFailure class methodsFor: 'instance creation'!
reason: aString at: anInteger
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!PPFailure class methodsFor: 'instance creation'!
|
|
|
|
+
|
|
|
|
+reason: aString at: anInteger
|
|
^self new
|
|
^self new
|
|
reason: aString at: anInteger;
|
|
reason: aString at: anInteger;
|
|
yourself
|
|
yourself
|
|
-
! !
Object subclass: #SmalltalkParser
instanceVariableNames: ''
category: 'Parser'!
!SmalltalkParser methodsFor: 'grammar'!
parser
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+Object subclass: #SmalltalkParser
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!SmalltalkParser methodsFor: 'grammar'!
|
|
|
|
+
|
|
|
|
+parser
|
|
| method expression separator comment ws identifier keyword className string symbol number literalArray variable reference classReference literal ret methodParser expressionParser keyword unarySelector binarySelector keywordPattern unaryPattern binaryPattern assignment temps blockParamList block expression expressions subexpression statements sequence operand unaryMessage unarySend unaryTail binaryMessage binarySend binaryTail keywordMessage keywordSend keywordPair cascade message jsStatement |
|
|
| method expression separator comment ws identifier keyword className string symbol number literalArray variable reference classReference literal ret methodParser expressionParser keyword unarySelector binarySelector keywordPattern unaryPattern binaryPattern assignment temps blockParamList block expression expressions subexpression statements sequence operand unaryMessage unarySend unaryTail binaryMessage binarySend binaryTail keywordMessage keywordSend keywordPair cascade message jsStatement |
|
|
|
|
|
|
separator := (String cr, String space, String lf, String tab) asChoiceParser.
|
|
separator := (String cr, String space, String lf, String tab) asChoiceParser.
|
|
@@ -374,43 +686,134 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
yourself].
|
|
yourself].
|
|
|
|
|
|
^method, PPEOFParser new ==> [:node | node first]
|
|
^method, PPEOFParser new ==> [:node | node first]
|
|
-
! !
!SmalltalkParser methodsFor: 'parsing'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!SmalltalkParser methodsFor: 'parsing'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
^self parser parse: aStream
|
|
^self parser parse: aStream
|
|
-
! !
!SmalltalkParser class methodsFor: 'instance creation'!
parse: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!SmalltalkParser class methodsFor: 'instance creation'!
|
|
|
|
+
|
|
|
|
+parse: aStream
|
|
^self new
|
|
^self new
|
|
parse: aStream
|
|
parse: aStream
|
|
-
! !
Object subclass: #Chunk
instanceVariableNames: 'contents'
category: 'Parser'!
!Chunk methodsFor: 'accessing'!
contents
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+Object subclass: #Chunk
|
|
|
|
+ instanceVariableNames: 'contents'
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!Chunk methodsFor: 'accessing'!
|
|
|
|
+
|
|
|
|
+contents
|
|
^contents ifNil: ['']
|
|
^contents ifNil: ['']
|
|
-
!
contents: aString
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+contents: aString
|
|
contents := aString
|
|
contents := aString
|
|
-
! !
!Chunk methodsFor: 'testing'!
isEmptyChunk
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!Chunk methodsFor: 'testing'!
|
|
|
|
+
|
|
|
|
+isEmptyChunk
|
|
^false
|
|
^false
|
|
-
!
isInstructionChunk
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+isInstructionChunk
|
|
^false
|
|
^false
|
|
-
! !
Chunk subclass: #InstructionChunk
instanceVariableNames: ''
category: 'Parser'!
!InstructionChunk methodsFor: 'testing'!
isInstructionChunk
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+Chunk subclass: #InstructionChunk
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!InstructionChunk methodsFor: 'testing'!
|
|
|
|
+
|
|
|
|
+isInstructionChunk
|
|
^true
|
|
^true
|
|
-
! !
Chunk subclass: #EmptyChunk
instanceVariableNames: ''
category: 'Parser'!
!EmptyChunk methodsFor: 'testing'!
isEmptyChunk
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+Chunk subclass: #EmptyChunk
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!EmptyChunk methodsFor: 'testing'!
|
|
|
|
+
|
|
|
|
+isEmptyChunk
|
|
^true
|
|
^true
|
|
-
! !
Object subclass: #ChunkParser
instanceVariableNames: 'parser, separator, eof, ws, chunk, emptyChunk, instructionChunk'
category: 'Parser'!
!ChunkParser methodsFor: ''!
instructionChunk
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+Object subclass: #ChunkParser
|
|
|
|
+ instanceVariableNames: 'parser, separator, eof, ws, chunk, emptyChunk, instructionChunk'
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!ChunkParser methodsFor: ''!
|
|
|
|
+
|
|
|
|
+instructionChunk
|
|
^instructionChunk ifNil: [
|
|
^instructionChunk ifNil: [
|
|
instructionChunk := self ws, '!' asParser, self chunk
|
|
instructionChunk := self ws, '!' asParser, self chunk
|
|
==> [:node | InstructionChunk new contents: node last contents]]
|
|
==> [:node | InstructionChunk new contents: node last contents]]
|
|
-
! !
!ChunkParser methodsFor: 'accessing'!
parser
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!ChunkParser methodsFor: 'accessing'!
|
|
|
|
+
|
|
|
|
+parser
|
|
^parser ifNil: [
|
|
^parser ifNil: [
|
|
parser := self instructionChunk / self emptyChunk / self chunk / self eof]
|
|
parser := self instructionChunk / self emptyChunk / self chunk / self eof]
|
|
-
!
eof
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+eof
|
|
^eof ifNil: [eof := self ws, PPEOFParser new ==> [:node | nil]]
|
|
^eof ifNil: [eof := self ws, PPEOFParser new ==> [:node | nil]]
|
|
-
!
separator
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+separator
|
|
^separator ifNil: [separator := (String cr, String space, String lf, String tab) asChoiceParser]
|
|
^separator ifNil: [separator := (String cr, String space, String lf, String tab) asChoiceParser]
|
|
-
!
ws
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+ws
|
|
^ws ifNil: [ws := self separator star]
|
|
^ws ifNil: [ws := self separator star]
|
|
-
!
chunk
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+chunk
|
|
^chunk ifNil: [chunk := self ws, ('!!' asParser / ('!' asParser not, PPAnyParser new)) plus flatten, '!' asParser ==> [:node | Chunk new contents: (node second replace: '!!' with: '!')]]
|
|
^chunk ifNil: [chunk := self ws, ('!!' asParser / ('!' asParser not, PPAnyParser new)) plus flatten, '!' asParser ==> [:node | Chunk new contents: (node second replace: '!!' with: '!')]]
|
|
-
!
emptyChunk
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+emptyChunk
|
|
^emptyChunk ifNil: [emptyChunk := self separator plus, '!' asParser, self ws ==> [:node | EmptyChunk new]]
|
|
^emptyChunk ifNil: [emptyChunk := self separator plus, '!' asParser, self ws ==> [:node | EmptyChunk new]]
|
|
-
! !
Object subclass: #Importer
instanceVariableNames: 'chunkParser'
category: 'Parser'!
!Importer methodsFor: 'accessing'!
chunkParser
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+Object subclass: #Importer
|
|
|
|
+ instanceVariableNames: 'chunkParser'
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!Importer methodsFor: 'accessing'!
|
|
|
|
+
|
|
|
|
+chunkParser
|
|
^chunkParser ifNil: [chunkParser := ChunkParser new parser]
|
|
^chunkParser ifNil: [chunkParser := ChunkParser new parser]
|
|
-
! !
!Importer methodsFor: 'fileIn'!
import: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!Importer methodsFor: 'fileIn'!
|
|
|
|
+
|
|
|
|
+import: aStream
|
|
aStream atEnd ifFalse: [
|
|
aStream atEnd ifFalse: [
|
|
| nextChunk |
|
|
| nextChunk |
|
|
nextChunk := self chunkParser parse: aStream.
|
|
nextChunk := self chunkParser parse: aStream.
|
|
@@ -420,14 +823,26 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
scanFrom: aStream]
|
|
scanFrom: aStream]
|
|
ifFalse: [Compiler new loadExpression: nextChunk contents].
|
|
ifFalse: [Compiler new loadExpression: nextChunk contents].
|
|
self import: aStream]]
|
|
self import: aStream]]
|
|
-
! !
Object subclass: #Exporter
instanceVariableNames: ''
category: 'Parser'!
!Exporter methodsFor: 'fileOut'!
exportCategory: aString
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+Object subclass: #Exporter
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!Exporter methodsFor: 'fileOut'!
|
|
|
|
+
|
|
|
|
+exportCategory: aString
|
|
| stream |
|
|
| stream |
|
|
stream := '' writeStream.
|
|
stream := '' writeStream.
|
|
(Smalltalk current classes
|
|
(Smalltalk current classes
|
|
select: [:each | each category = aString])
|
|
select: [:each | each category = aString])
|
|
do: [:each | stream nextPutAll: (self export: each)].
|
|
do: [:each | stream nextPutAll: (self export: each)].
|
|
self exportCategoryExtensions: aString on: stream.
|
|
self exportCategoryExtensions: aString on: stream.
|
|
- ^stream contents
!
export: aClass
|
|
|
|
|
|
+ ^stream contents
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+export: aClass
|
|
| stream |
|
|
| stream |
|
|
stream := '' writeStream.
|
|
stream := '' writeStream.
|
|
self exportDefinitionOf: aClass on: stream.
|
|
self exportDefinitionOf: aClass on: stream.
|
|
@@ -435,7 +850,12 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
self exportMetaDefinitionOf: aClass on: stream.
|
|
self exportMetaDefinitionOf: aClass on: stream.
|
|
self exportMethodsOf: aClass class on: stream.
|
|
self exportMethodsOf: aClass class on: stream.
|
|
^stream contents
|
|
^stream contents
|
|
-
! !
!Exporter methodsFor: 'private'!
exportDefinitionOf: aClass on: aStream
|
|
|
|
|
|
+
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+!Exporter methodsFor: 'private'!
|
|
|
|
+
|
|
|
|
+exportDefinitionOf: aClass on: aStream
|
|
aStream
|
|
aStream
|
|
nextPutAll: 'smalltalk.addClass(';
|
|
nextPutAll: 'smalltalk.addClass(';
|
|
nextPutAll: '''', (self classNameFor: aClass), ''', ';
|
|
nextPutAll: '''', (self classNameFor: aClass), ''', ';
|
|
@@ -450,13 +870,16 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
nextPutAll: ');'.
|
|
nextPutAll: ');'.
|
|
aClass comment notEmpty ifTrue: [
|
|
aClass comment notEmpty ifTrue: [
|
|
aStream
|
|
aStream
|
|
- nextPutAll: String cr;
|
|
|
|
|
|
+ lf;
|
|
nextPutAll: 'smalltalk.';
|
|
nextPutAll: 'smalltalk.';
|
|
nextPutAll: (self classNameFor: aClass);
|
|
nextPutAll: (self classNameFor: aClass);
|
|
nextPutAll: '.comment=';
|
|
nextPutAll: '.comment=';
|
|
nextPutAll: 'unescape(''', aClass comment escaped, ''')'].
|
|
nextPutAll: 'unescape(''', aClass comment escaped, ''')'].
|
|
- aStream cr
|
|
|
|
-
!
exportMetaDefinitionOf: aClass on: aStream
|
|
|
|
|
|
+ aStream lf
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+exportMetaDefinitionOf: aClass on: aStream
|
|
aClass class instanceVariableNames isEmpty ifFalse: [
|
|
aClass class instanceVariableNames isEmpty ifFalse: [
|
|
aStream
|
|
aStream
|
|
nextPutAll: 'smalltalk.', (self classNameFor: aClass class);
|
|
nextPutAll: 'smalltalk.', (self classNameFor: aClass class);
|
|
@@ -464,42 +887,63 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
aClass class instanceVariableNames
|
|
aClass class instanceVariableNames
|
|
do: [:each | aStream nextPutAll: '''', each, '''']
|
|
do: [:each | aStream nextPutAll: '''', each, '''']
|
|
separatedBy: [aStream nextPutAll: ','].
|
|
separatedBy: [aStream nextPutAll: ','].
|
|
- aStream nextPutAll: '];', String cr]
|
|
|
|
-
!
exportMethodsOf: aClass on: aStream
|
|
|
|
|
|
+ aStream nextPutAll: '];', String lf]
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+exportMethodsOf: aClass on: aStream
|
|
aClass methodDictionary values do: [:each |
|
|
aClass methodDictionary values do: [:each |
|
|
(each category match: '^\*') ifFalse: [
|
|
(each category match: '^\*') ifFalse: [
|
|
self exportMethod: each of: aClass on: aStream]].
|
|
self exportMethod: each of: aClass on: aStream]].
|
|
- aStream cr
!
classNameFor: aClass
|
|
|
|
|
|
+ aStream lf
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+classNameFor: aClass
|
|
^aClass isMetaclass
|
|
^aClass isMetaclass
|
|
ifTrue: [aClass instanceClass name, '.klass']
|
|
ifTrue: [aClass instanceClass name, '.klass']
|
|
ifFalse: [
|
|
ifFalse: [
|
|
aClass isNil
|
|
aClass isNil
|
|
ifTrue: ['nil']
|
|
ifTrue: ['nil']
|
|
ifFalse: [aClass name]]
|
|
ifFalse: [aClass name]]
|
|
-
!
exportMethod: aMethod of: aClass on: aStream
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+exportMethod: aMethod of: aClass on: aStream
|
|
aStream
|
|
aStream
|
|
- nextPutAll: 'smalltalk.addMethod(', String cr;
|
|
|
|
- nextPutAll: '''', aMethod selector asSelector, ''',', String cr;
|
|
|
|
- nextPutAll: 'smalltalk.method({', String cr;
|
|
|
|
- nextPutAll: 'selector: ''', aMethod selector, ''',', String cr;
|
|
|
|
- nextPutAll: 'category: ''', aMethod category, ''',', String cr;
|
|
|
|
- nextPutAll: 'fn: ', aMethod fn compiledSource, ',', String cr;
|
|
|
|
- nextPutAll: 'source: unescape(''', aMethod source escaped, '''),', String cr;
|
|
|
|
- nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',', String cr;
|
|
|
|
|
|
+ nextPutAll: 'smalltalk.addMethod(';lf;
|
|
|
|
+ nextPutAll: '''', aMethod selector asSelector, ''',';lf;
|
|
|
|
+ nextPutAll: 'smalltalk.method({';lf;
|
|
|
|
+ nextPutAll: 'selector: ''', aMethod selector, ''',';lf;
|
|
|
|
+ nextPutAll: 'category: ''', aMethod category, ''',';lf;
|
|
|
|
+ nextPutAll: 'fn: ', aMethod fn compiledSource, ',';lf;
|
|
|
|
+ nextPutAll: 'source: unescape(''', aMethod source escaped, '''),';lf;
|
|
|
|
+ nextPutAll: 'messageSends: ', aMethod messageSends asJavascript, ',';lf;
|
|
nextPutAll: 'referencedClasses: ['.
|
|
nextPutAll: 'referencedClasses: ['.
|
|
aMethod referencedClasses
|
|
aMethod referencedClasses
|
|
do: [:each | aStream nextPutAll: 'smalltalk.', (self classNameFor: each)]
|
|
do: [:each | aStream nextPutAll: 'smalltalk.', (self classNameFor: each)]
|
|
separatedBy: [aStream nextPutAll: ','].
|
|
separatedBy: [aStream nextPutAll: ','].
|
|
aStream
|
|
aStream
|
|
- nextPutAll: ']', String cr;
|
|
|
|
- nextPutAll: '}),', String cr;
|
|
|
|
|
|
+ nextPutAll: ']';lf;
|
|
|
|
+ nextPutAll: '}),';lf;
|
|
nextPutAll: 'smalltalk.', (self classNameFor: aClass);
|
|
nextPutAll: 'smalltalk.', (self classNameFor: aClass);
|
|
- nextPutAll: ');', String cr, String cr
!
|
|
|
|
|
|
+ nextPutAll: ');';lf;lf
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+
|
|
exportCategoryExtensions: aString on: aStream
|
|
exportCategoryExtensions: aString on: aStream
|
|
Smalltalk current classes, (Smalltalk current classes collect: [:each | each class]) do: [:each |
|
|
Smalltalk current classes, (Smalltalk current classes collect: [:each | each class]) do: [:each |
|
|
each methodDictionary values do: [:method |
|
|
each methodDictionary values do: [:method |
|
|
method category = ('*', aString) ifTrue: [
|
|
method category = ('*', aString) ifTrue: [
|
|
- self exportMethod: method of: each on: aStream]]]
! !
Exporter subclass: #ChunkExporter
instanceVariableNames: ''
category: 'Parser'!
!ChunkExporter methodsFor: 'not yet classified'!
exportDefinitionOf: aClass on: aStream
|
|
|
|
|
|
+ self exportMethod: method of: each on: aStream]]]
|
|
|
|
+! !
|
|
|
|
+
|
|
|
|
+Exporter subclass: #ChunkExporter
|
|
|
|
+ instanceVariableNames: ''
|
|
|
|
+ category: 'Parser'!
|
|
|
|
+
|
|
|
|
+!ChunkExporter methodsFor: 'not yet classified'!
|
|
|
|
+
|
|
|
|
+exportDefinitionOf: aClass on: aStream
|
|
"Chunk format."
|
|
"Chunk format."
|
|
|
|
|
|
aStream
|
|
aStream
|
|
@@ -517,10 +961,17 @@ exportCategoryExtensions: aString on: aStream
|
|
nextPutAll: '!', (self classNameFor: aClass), ' commentStamp!';lf;
|
|
nextPutAll: '!', (self classNameFor: aClass), ' commentStamp!';lf;
|
|
nextPutAll: aClass comment escaped, '!';lf].
|
|
nextPutAll: aClass comment escaped, '!';lf].
|
|
aStream lf
|
|
aStream lf
|
|
-
!
exportMethod: aMethod of: aClass on: aStream
|
|
|
|
|
|
+
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+exportMethod: aMethod of: aClass on: aStream
|
|
aStream
|
|
aStream
|
|
lf; lf; nextPutAll: aMethod source; lf;
|
|
lf; lf; nextPutAll: aMethod source; lf;
|
|
- nextPutAll: '!'
!
exportMethodsOf: aClass on: aStream
|
|
|
|
|
|
+ nextPutAll: '!'
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+exportMethodsOf: aClass on: aStream
|
|
|
|
+
|
|
| methodsByCategory |
|
|
| methodsByCategory |
|
|
methodsByCategory := Dictionary new.
|
|
methodsByCategory := Dictionary new.
|
|
aClass methodDictionary values do: [:m |
|
|
aClass methodDictionary values do: [:m |
|
|
@@ -532,7 +983,10 @@ exportCategoryExtensions: aString on: aStream
|
|
nextPutAll: ' methodsFor: ''', category, '''!'.
|
|
nextPutAll: ' methodsFor: ''', category, '''!'.
|
|
(methodsByCategory at: category) do: [:each |
|
|
(methodsByCategory at: category) do: [:each |
|
|
self exportMethod: each of: aClass on: aStream].
|
|
self exportMethod: each of: aClass on: aStream].
|
|
- aStream nextPutAll: ' !'; lf; lf]
!
exportMetaDefinitionOf: aClass on: aStream
|
|
|
|
|
|
+ aStream nextPutAll: ' !'; lf; lf]
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+exportMetaDefinitionOf: aClass on: aStream
|
|
|
|
|
|
aClass class instanceVariableNames isEmpty ifFalse: [
|
|
aClass class instanceVariableNames isEmpty ifFalse: [
|
|
aStream
|
|
aStream
|
|
@@ -542,10 +996,15 @@ exportCategoryExtensions: aString on: aStream
|
|
do: [:each | aStream nextPutAll: each]
|
|
do: [:each | aStream nextPutAll: each]
|
|
separatedBy: [aStream nextPutAll: ', '].
|
|
separatedBy: [aStream nextPutAll: ', '].
|
|
aStream
|
|
aStream
|
|
- nextPutAll: '''!'; lf; lf]
!
classNameFor: aClass
|
|
|
|
|
|
+ nextPutAll: '''!'; lf; lf]
|
|
|
|
+!
|
|
|
|
+
|
|
|
|
+classNameFor: aClass
|
|
^aClass isMetaclass
|
|
^aClass isMetaclass
|
|
ifTrue: [aClass instanceClass name, ' class']
|
|
ifTrue: [aClass instanceClass name, ' class']
|
|
ifFalse: [
|
|
ifFalse: [
|
|
aClass isNil
|
|
aClass isNil
|
|
ifTrue: ['nil']
|
|
ifTrue: ['nil']
|
|
- ifFalse: [aClass name]]
! !
|
|
|
|
|
|
+ ifFalse: [aClass name]]
|
|
|
|
+! !
|
|
|
|
+
|