|
@@ -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
|
|
|
-
! !
!PPParser methodsFor: 'initialization'!
initialize
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPParser methodsFor: 'initialization'!
|
|
|
+
|
|
|
+initialize
|
|
|
memo := Dictionary new
|
|
|
-
! !
!PPParser methodsFor: 'operations'!
flatten
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPParser methodsFor: 'operations'!
|
|
|
+
|
|
|
+flatten
|
|
|
^PPFlattenParser on: self
|
|
|
-
!
withSource
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+withSource
|
|
|
^PPSourceParser on: self
|
|
|
-
!
==> aBlock
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+==> aBlock
|
|
|
^PPActionParser on: self block: aBlock
|
|
|
-
!
, aParser
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+, aParser
|
|
|
^PPSequenceParser with: self with: aParser
|
|
|
-
!
/ aParser
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+/ aParser
|
|
|
^PPChoiceParser with: self with: aParser
|
|
|
-
!
plus
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+plus
|
|
|
^PPRepeatingParser on: self min: 1
|
|
|
-
!
star
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+star
|
|
|
^PPRepeatingParser on: self min: 0
|
|
|
-
!
not
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+not
|
|
|
^PPNotParser on: self
|
|
|
-
!
optional
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+optional
|
|
|
^self / PPEpsilonParser new
|
|
|
-
!
memoizedParse: aStream
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+memoizedParse: aStream
|
|
|
| start end node |
|
|
|
start := aStream position.
|
|
|
^self memo at: start
|
|
@@ -32,31 +75,83 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
end := aStream position.
|
|
|
self memo at: start put: (Array with: node with: end).
|
|
|
node]
|
|
|
-
! !
!PPParser methodsFor: 'parsing'!
parse: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPParser methodsFor: 'parsing'!
|
|
|
+
|
|
|
+parse: aStream
|
|
|
self subclassResponsibility
|
|
|
-
!
parseAll: aStream
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+parseAll: aStream
|
|
|
| result |
|
|
|
result := (PPSequenceParser with: self with: PPEOFParser new) memoizedParse: aStream.
|
|
|
^result isParseFailure
|
|
|
ifTrue: [self error: (result messageFor: aStream contents)]
|
|
|
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
|
|
|
ifFalse: [
|
|
|
PPFailure new reason: 'EOF expected' at: aStream position]
|
|
|
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
|
|
|
ifTrue: [PPFailure new
|
|
|
reason: 'did not expect EOF' at: aStream position]
|
|
|
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
|
|
|
-
! !
PPParser subclass: #PPStringParser
instanceVariableNames: 'string'
category: 'Parser'!
!PPStringParser methodsFor: 'accessing'!
string
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+PPParser subclass: #PPStringParser
|
|
|
+ instanceVariableNames: 'string'
|
|
|
+ category: 'Parser'!
|
|
|
+
|
|
|
+!PPStringParser methodsFor: 'accessing'!
|
|
|
+
|
|
|
+string
|
|
|
^string
|
|
|
-
!
string: aString
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+string: aString
|
|
|
string := aString
|
|
|
-
! !
!PPStringParser methodsFor: 'parsing'!
parse: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPStringParser methodsFor: 'parsing'!
|
|
|
+
|
|
|
+parse: aStream
|
|
|
| position result |
|
|
|
position := aStream position.
|
|
|
result := aStream next: self string size.
|
|
@@ -65,29 +160,87 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
ifFalse: [
|
|
|
aStream position: position.
|
|
|
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, ']'
|
|
|
-
! !
!PPCharacterParser methodsFor: 'parsing'!
parse: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPCharacterParser methodsFor: 'parsing'!
|
|
|
+
|
|
|
+parse: aStream
|
|
|
^(aStream peek notNil and: [self match: aStream peek])
|
|
|
ifTrue: [aStream next]
|
|
|
ifFalse: [PPFailure new reason: 'Could not match' at: aStream position]
|
|
|
-
! !
!PPCharacterParser methodsFor: 'private'!
match: aString
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPCharacterParser methodsFor: 'private'!
|
|
|
+
|
|
|
+match: aString
|
|
|
^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: aCollection
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+parsers: aCollection
|
|
|
parsers := aCollection
|
|
|
-
! !
!PPListParser methodsFor: 'copying'!
copyWith: aParser
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPListParser methodsFor: 'copying'!
|
|
|
+
|
|
|
+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
|
|
|
parsers: aCollection;
|
|
|
yourself
|
|
|
-
!
with: aParser with: anotherParser
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+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
|
|
|
-
! !
!PPSequenceParser methodsFor: 'parsing'!
parse: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPSequenceParser methodsFor: 'parsing'!
|
|
|
+
|
|
|
+parse: aStream
|
|
|
| start elements element |
|
|
|
start := aStream position.
|
|
|
elements := #().
|
|
@@ -100,9 +253,23 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
^element isParseFailure
|
|
|
ifFalse: [elements]
|
|
|
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
|
|
|
-
! !
!PPChoiceParser methodsFor: 'parsing'!
parse: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPChoiceParser methodsFor: 'parsing'!
|
|
|
+
|
|
|
+parse: aStream
|
|
|
| result |
|
|
|
self parsers
|
|
|
detect: [:each |
|
|
@@ -110,46 +277,120 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
result isParseFailure not]
|
|
|
ifNone: [].
|
|
|
^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: aParser
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+parser: aParser
|
|
|
parser := aParser
|
|
|
-
! !
!PPDelegateParser methodsFor: 'parsing'!
parse: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPDelegateParser methodsFor: 'parsing'!
|
|
|
+
|
|
|
+parse: aStream
|
|
|
^self parser memoizedParse: aStream
|
|
|
-
! !
!PPDelegateParser class methodsFor: 'instance creation'!
on: aParser
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPDelegateParser class methodsFor: 'instance creation'!
|
|
|
+
|
|
|
+on: aParser
|
|
|
^self new
|
|
|
parser: aParser;
|
|
|
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
|
|
|
-
!
basicParse: aStream
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+basicParse: aStream
|
|
|
| element position |
|
|
|
position := aStream position.
|
|
|
element := self parser memoizedParse: aStream.
|
|
|
aStream position: position.
|
|
|
^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 := self basicParse: aStream.
|
|
|
^element isParseFailure
|
|
|
ifTrue: [nil]
|
|
|
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: aBlock
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+block: aBlock
|
|
|
block := aBlock
|
|
|
-
! !
!PPActionParser methodsFor: 'parsing'!
parse: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPActionParser methodsFor: 'parsing'!
|
|
|
+
|
|
|
+parse: aStream
|
|
|
| element |
|
|
|
element := self parser memoizedParse: aStream.
|
|
|
^element isParseFailure
|
|
|
ifFalse: [self block value: element]
|
|
|
ifTrue: [element]
|
|
|
-
! !
!PPActionParser class methodsFor: 'instance creation'!
on: aParser block: aBlock
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPActionParser class methodsFor: 'instance creation'!
|
|
|
+
|
|
|
+on: aParser block: aBlock
|
|
|
^self new
|
|
|
parser: aParser;
|
|
|
block: aBlock;
|
|
|
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 := aStream position.
|
|
|
element := self parser memoizedParse: aStream.
|
|
@@ -158,7 +399,16 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
ifFalse: [aStream collection
|
|
|
copyFrom: start + 1
|
|
|
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 := aStream position.
|
|
|
element := self parser memoizedParse: aStream.
|
|
@@ -166,11 +416,28 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
ifTrue: [element]
|
|
|
ifFalse: [result := aStream collection copyFrom: start + 1 to: aStream position.
|
|
|
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: aNumber
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+min: aNumber
|
|
|
min := aNumber
|
|
|
-
! !
!PPRepeatingParser methodsFor: 'parsing'!
parse: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPRepeatingParser methodsFor: 'parsing'!
|
|
|
+
|
|
|
+parse: aStream
|
|
|
| start element elements failure |
|
|
|
start := aStream position.
|
|
|
elements := Array new.
|
|
@@ -188,30 +455,75 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
ifFalse: [elements addLast: element]].
|
|
|
elements]
|
|
|
ifNotNil: [failure].
|
|
|
-
! !
!PPRepeatingParser class methodsFor: 'instance creation'!
on: aParser min: aNumber
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPRepeatingParser class methodsFor: 'instance creation'!
|
|
|
+
|
|
|
+on: aParser min: aNumber
|
|
|
^self new
|
|
|
parser: aParser;
|
|
|
min: aNumber;
|
|
|
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: aNumber
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+position: aNumber
|
|
|
position := aNumber
|
|
|
-
!
reason
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+reason
|
|
|
^reason ifNil: ['']
|
|
|
-
!
reason: aString
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+reason: aString
|
|
|
reason := aString
|
|
|
-
!
reason: aString at: anInteger
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+reason: aString at: anInteger
|
|
|
self
|
|
|
reason: aString;
|
|
|
position: anInteger
|
|
|
-
! !
!PPFailure methodsFor: 'testing'!
isParseFailure
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPFailure methodsFor: 'testing'!
|
|
|
+
|
|
|
+isParseFailure
|
|
|
^true
|
|
|
-
! !
!PPFailure class methodsFor: 'instance creation'!
reason: aString at: anInteger
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!PPFailure class methodsFor: 'instance creation'!
|
|
|
+
|
|
|
+reason: aString at: anInteger
|
|
|
^self new
|
|
|
reason: aString at: anInteger;
|
|
|
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 |
|
|
|
|
|
|
separator := (String cr, String space, String lf, String tab) asChoiceParser.
|
|
@@ -374,43 +686,134 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
yourself].
|
|
|
|
|
|
^method, PPEOFParser new ==> [:node | node first]
|
|
|
-
! !
!SmalltalkParser methodsFor: 'parsing'!
parse: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!SmalltalkParser methodsFor: 'parsing'!
|
|
|
+
|
|
|
+parse: aStream
|
|
|
^self parser parse: aStream
|
|
|
-
! !
!SmalltalkParser class methodsFor: 'instance creation'!
parse: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!SmalltalkParser class methodsFor: 'instance creation'!
|
|
|
+
|
|
|
+parse: aStream
|
|
|
^self new
|
|
|
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: aString
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+contents: aString
|
|
|
contents := aString
|
|
|
-
! !
!Chunk methodsFor: 'testing'!
isEmptyChunk
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!Chunk methodsFor: 'testing'!
|
|
|
+
|
|
|
+isEmptyChunk
|
|
|
^false
|
|
|
-
!
isInstructionChunk
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+isInstructionChunk
|
|
|
^false
|
|
|
-
! !
Chunk subclass: #InstructionChunk
instanceVariableNames: ''
category: 'Parser'!
!InstructionChunk methodsFor: 'testing'!
isInstructionChunk
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+Chunk subclass: #InstructionChunk
|
|
|
+ instanceVariableNames: ''
|
|
|
+ category: 'Parser'!
|
|
|
+
|
|
|
+!InstructionChunk methodsFor: 'testing'!
|
|
|
+
|
|
|
+isInstructionChunk
|
|
|
^true
|
|
|
-
! !
Chunk subclass: #EmptyChunk
instanceVariableNames: ''
category: 'Parser'!
!EmptyChunk methodsFor: 'testing'!
isEmptyChunk
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+Chunk subclass: #EmptyChunk
|
|
|
+ instanceVariableNames: ''
|
|
|
+ category: 'Parser'!
|
|
|
+
|
|
|
+!EmptyChunk methodsFor: 'testing'!
|
|
|
+
|
|
|
+isEmptyChunk
|
|
|
^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 := self ws, '!' asParser, self chunk
|
|
|
==> [:node | InstructionChunk new contents: node last contents]]
|
|
|
-
! !
!ChunkParser methodsFor: 'accessing'!
parser
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!ChunkParser methodsFor: 'accessing'!
|
|
|
+
|
|
|
+parser
|
|
|
^parser ifNil: [
|
|
|
parser := self instructionChunk / self emptyChunk / self chunk / self eof]
|
|
|
-
!
eof
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+eof
|
|
|
^eof ifNil: [eof := self ws, PPEOFParser new ==> [:node | nil]]
|
|
|
-
!
separator
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+separator
|
|
|
^separator ifNil: [separator := (String cr, String space, String lf, String tab) asChoiceParser]
|
|
|
-
!
ws
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+ws
|
|
|
^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: '!')]]
|
|
|
-
!
emptyChunk
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+emptyChunk
|
|
|
^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]
|
|
|
-
! !
!Importer methodsFor: 'fileIn'!
import: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!Importer methodsFor: 'fileIn'!
|
|
|
+
|
|
|
+import: aStream
|
|
|
aStream atEnd ifFalse: [
|
|
|
| nextChunk |
|
|
|
nextChunk := self chunkParser parse: aStream.
|
|
@@ -420,14 +823,26 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
scanFrom: aStream]
|
|
|
ifFalse: [Compiler new loadExpression: nextChunk contents].
|
|
|
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 := '' writeStream.
|
|
|
(Smalltalk current classes
|
|
|
select: [:each | each category = aString])
|
|
|
do: [:each | stream nextPutAll: (self export: each)].
|
|
|
self exportCategoryExtensions: aString on: stream.
|
|
|
- ^stream contents
!
export: aClass
|
|
|
+ ^stream contents
|
|
|
+!
|
|
|
+
|
|
|
+export: aClass
|
|
|
| stream |
|
|
|
stream := '' writeStream.
|
|
|
self exportDefinitionOf: aClass on: stream.
|
|
@@ -435,7 +850,12 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
self exportMetaDefinitionOf: aClass on: stream.
|
|
|
self exportMethodsOf: aClass class on: stream.
|
|
|
^stream contents
|
|
|
-
! !
!Exporter methodsFor: 'private'!
exportDefinitionOf: aClass on: aStream
|
|
|
+
|
|
|
+! !
|
|
|
+
|
|
|
+!Exporter methodsFor: 'private'!
|
|
|
+
|
|
|
+exportDefinitionOf: aClass on: aStream
|
|
|
aStream
|
|
|
nextPutAll: 'smalltalk.addClass(';
|
|
|
nextPutAll: '''', (self classNameFor: aClass), ''', ';
|
|
@@ -450,13 +870,16 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
nextPutAll: ');'.
|
|
|
aClass comment notEmpty ifTrue: [
|
|
|
aStream
|
|
|
- nextPutAll: String cr;
|
|
|
+ lf;
|
|
|
nextPutAll: 'smalltalk.';
|
|
|
nextPutAll: (self classNameFor: aClass);
|
|
|
nextPutAll: '.comment=';
|
|
|
nextPutAll: 'unescape(''', aClass comment escaped, ''')'].
|
|
|
- aStream cr
|
|
|
-
!
exportMetaDefinitionOf: aClass on: aStream
|
|
|
+ aStream lf
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+exportMetaDefinitionOf: aClass on: aStream
|
|
|
aClass class instanceVariableNames isEmpty ifFalse: [
|
|
|
aStream
|
|
|
nextPutAll: 'smalltalk.', (self classNameFor: aClass class);
|
|
@@ -464,42 +887,63 @@ Object subclass: #PPParser
instanceVariableNames: 'memo'
category: 'Parser'!
|
|
|
aClass class instanceVariableNames
|
|
|
do: [:each | aStream nextPutAll: '''', each, '''']
|
|
|
separatedBy: [aStream nextPutAll: ','].
|
|
|
- aStream nextPutAll: '];', String cr]
|
|
|
-
!
exportMethodsOf: aClass on: aStream
|
|
|
+ aStream nextPutAll: '];', String lf]
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+exportMethodsOf: aClass on: aStream
|
|
|
aClass methodDictionary values do: [:each |
|
|
|
(each category match: '^\*') ifFalse: [
|
|
|
self exportMethod: each of: aClass on: aStream]].
|
|
|
- aStream cr
!
classNameFor: aClass
|
|
|
+ aStream lf
|
|
|
+!
|
|
|
+
|
|
|
+classNameFor: aClass
|
|
|
^aClass isMetaclass
|
|
|
ifTrue: [aClass instanceClass name, '.klass']
|
|
|
ifFalse: [
|
|
|
aClass isNil
|
|
|
ifTrue: ['nil']
|
|
|
ifFalse: [aClass name]]
|
|
|
-
!
exportMethod: aMethod of: aClass on: aStream
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+exportMethod: aMethod of: aClass on: 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: ['.
|
|
|
aMethod referencedClasses
|
|
|
do: [:each | aStream nextPutAll: 'smalltalk.', (self classNameFor: each)]
|
|
|
separatedBy: [aStream nextPutAll: ','].
|
|
|
aStream
|
|
|
- nextPutAll: ']', String cr;
|
|
|
- nextPutAll: '}),', String cr;
|
|
|
+ nextPutAll: ']';lf;
|
|
|
+ nextPutAll: '}),';lf;
|
|
|
nextPutAll: 'smalltalk.', (self classNameFor: aClass);
|
|
|
- nextPutAll: ');', String cr, String cr
!
|
|
|
+ nextPutAll: ');';lf;lf
|
|
|
+!
|
|
|
+
|
|
|
+
|
|
|
exportCategoryExtensions: aString on: aStream
|
|
|
Smalltalk current classes, (Smalltalk current classes collect: [:each | each class]) do: [:each |
|
|
|
each methodDictionary values do: [:method |
|
|
|
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."
|
|
|
|
|
|
aStream
|
|
@@ -517,10 +961,17 @@ exportCategoryExtensions: aString on: aStream
|
|
|
nextPutAll: '!', (self classNameFor: aClass), ' commentStamp!';lf;
|
|
|
nextPutAll: aClass comment escaped, '!';lf].
|
|
|
aStream lf
|
|
|
-
!
exportMethod: aMethod of: aClass on: aStream
|
|
|
+
|
|
|
+!
|
|
|
+
|
|
|
+exportMethod: aMethod of: aClass on: aStream
|
|
|
aStream
|
|
|
lf; lf; nextPutAll: aMethod source; lf;
|
|
|
- nextPutAll: '!'
!
exportMethodsOf: aClass on: aStream
|
|
|
+ nextPutAll: '!'
|
|
|
+!
|
|
|
+
|
|
|
+exportMethodsOf: aClass on: aStream
|
|
|
+
|
|
|
| methodsByCategory |
|
|
|
methodsByCategory := Dictionary new.
|
|
|
aClass methodDictionary values do: [:m |
|
|
@@ -532,7 +983,10 @@ exportCategoryExtensions: aString on: aStream
|
|
|
nextPutAll: ' methodsFor: ''', category, '''!'.
|
|
|
(methodsByCategory at: category) do: [:each |
|
|
|
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: [
|
|
|
aStream
|
|
@@ -542,10 +996,15 @@ exportCategoryExtensions: aString on: aStream
|
|
|
do: [:each | aStream nextPutAll: each]
|
|
|
separatedBy: [aStream nextPutAll: ', '].
|
|
|
aStream
|
|
|
- nextPutAll: '''!'; lf; lf]
!
classNameFor: aClass
|
|
|
+ nextPutAll: '''!'; lf; lf]
|
|
|
+!
|
|
|
+
|
|
|
+classNameFor: aClass
|
|
|
^aClass isMetaclass
|
|
|
ifTrue: [aClass instanceClass name, ' class']
|
|
|
ifFalse: [
|
|
|
aClass isNil
|
|
|
ifTrue: ['nil']
|
|
|
- ifFalse: [aClass name]]
! !
|
|
|
+ ifFalse: [aClass name]]
|
|
|
+! !
|
|
|
+
|