Ported PetitCompiler-(Tests).
Name: PetitCompiler-JanKurs.41
Author: JanKurs
Time: 25-10-2014, 03:30:28 AM
UUID: 105186d1-1187-4ca6-8d66-3d2d47def4d3
Repository: http://smalltalkhub.com/mc/JanKurs/PetitParser/main
Name: PetitCompiler-Tests-JanKurs.4
Author: JanKurs
Time: 25-10-2014, 03:30:58 AM
UUID: 3e798fad-d5f6-4881-a583-f0bbffe27869
Repository: http://smalltalkhub.com/mc/JanKurs/PetitParser/main
In addition, fixed some problems to make it compilable under Smalltalk/X:
* Fixed PPCTokenNode>>initialize - there's no children instvar, it's initialization removed.
* Fixed PPCContextMemento>>propertyAt:ifAbsent: - removed return-in-return, not compilable under Smalltalk/X (C issues)
* Fixed PPCContextMemento>>hash - there's no stream instvar, access to it removed.
* Fixed PPCAbstractCharacterNode>>compileWith:effect:id: - removed dot after method selector (stc does not like it)
"{ Package: 'stx:goodies/petitparser/compiler' }"!
!Character methodsFor:'*petitcompiler'!
ppcPrintable
^ self asInteger > 31 and: [ self asInteger < 127 ]
! !
!Object methodsFor:'*petitcompiler'!
isInlinedMethod
^ false
! !
!PPActionParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCActionNode new
name: self name;
block: block;
child: parser;
yourself
! !
!PPActionParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
block isSymbol ifTrue: [
^ aPetitCompiler compileSymbolBlock: block for: self
].
^ aPetitCompiler compileBlock: block for: self
! !
!PPAndParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCAndNode new
name: self name;
child: parser;
yourself
! !
!PPCharSetPredicate methodsFor:'*petitcompiler'!
block
^ block
! !
!PPCharSetPredicate methodsFor:'*petitcompiler'!
classification
^ classification
! !
!PPCharSetPredicate methodsFor:'*petitcompiler'!
equals: anotherPredicate
self == anotherPredicate ifTrue: [ ^ true ].
self class == anotherPredicate class ifFalse: [ ^ false ].
^ classification = anotherPredicate classification.
! !
!PPChoiceParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCChoiceNode new
name: self name;
children: parsers;
yourself
! !
!PPChoiceParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
^ aPetitCompiler compileChoice: self
! !
!PPContext methodsFor:'*petitcompiler'!
asCompiledParserContext
^ PPCContext new
stream: stream;
yourself
! !
!PPContext methodsFor:'*petitcompiler'!
comment
^ self globalAt: #comment ifAbsent: [ nil ].
! !
!PPContext methodsFor:'*petitcompiler'!
comment: value
^ self globalAt: #comment put: value
! !
!PPContext methodsFor:'*petitcompiler'!
compiledParser
^ self globalAt: #compiledParser
! !
!PPContext methodsFor:'*petitcompiler'!
compiledParser: aPPParser
^ self globalAt: #compiledParser put: aPPParser
! !
!PPContext methodsFor:'*petitcompiler'!
lastTokenResult
^ scanner lastResult
! !
!PPContext methodsFor:'*petitcompiler'!
lwRemember
^ self position
! !
!PPContext methodsFor:'*petitcompiler'!
lwRestore: position
^ self position: position
! !
!PPContext methodsFor:'*petitcompiler'!
matchToken: id
^ scanner matchToken: id
! !
!PPContext methodsFor:'*petitcompiler'!
nextToken
scanner next
! !
!PPContext methodsFor:'*petitcompiler'!
nextToken: id
^ scanner next: id
! !
!PPContext methodsFor:'*petitcompiler'!
peek: anInteger
^ stream peek: anInteger
! !
!PPContext methodsFor:'*petitcompiler'!
whitespace
^ self globalAt: #whitespace ifAbsent: [ nil ].
! !
!PPContext methodsFor:'*petitcompiler'!
whitespace: value
^ self globalAt: #whitespace put: value
! !
!PPDelegateParser methodsFor:'*petitcompiler'!
asCompilerNode
self class == PPDelegateParser ifTrue: [
^ PPCForwardNode new
name: self name;
child: parser;
yourself
].
^ super asCompilerNode
! !
!PPDelegateParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
(self class == PPDelegateParser) ifTrue: [
(self name notNil and: [ parser name isNil ]) ifTrue: [
parser name: self name.
^ parser compileWith: aPetitCompiler.
].
(self name notNil and: [ parser name notNil ]) ifTrue: [
^ aPetitCompiler compileDelegate: self.
]
].
^ super compileWith: aPetitCompiler.
! !
!PPEpsilonParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCNilNode new
! !
!PPEpsilonParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
^ aPetitCompiler compileNil
! !
!PPFailure methodsFor:'*petitcompiler'!
context: aPPContext
context := aPPContext
! !
!PPFailure methodsFor:'*petitcompiler'!
message: text
message := text
! !
!PPFailure methodsFor:'*petitcompiler'!
position: anInteger
position := anInteger
! !
!PPLiteralObjectParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCCharacterNode new
character: literal;
name: self name;
yourself
! !
!PPLiteralObjectParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
^ aPetitCompiler compileCharacter: literal.
! !
!PPLiteralObjectParser methodsFor:'*petitcompiler'!
firstCharParser
^ self
! !
!PPLiteralParser methodsFor:'*petitcompiler'!
id
^ literal printString
! !
!PPLiteralSequenceParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCLiteralNode new
literal: literal;
name: self name;
yourself
! !
!PPLiteralSequenceParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
^ aPetitCompiler compileLiteral: literal.
! !
!PPLiteralSequenceParser methodsFor:'*petitcompiler'!
firstCharParser
^ literal first asParser
! !
!PPNotParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCNotNode new
child: parser;
name: self name;
yourself
! !
!PPNotParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
^ aPetitCompiler compileNot: self
! !
!PPNotParser methodsFor:'*petitcompiler'!
firstCharParser
^ parser firstCharParser not
! !
!PPOptionalParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCOptionalNode new
name: self name;
child: parser;
yourself
" ^ super asCompilerNode "
! !
!PPOptionalParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
^ aPetitCompiler compileOptional: self
! !
!PPParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCUnknownNode new
parser: self;
name: self name;
yourself
! !
!PPParser methodsFor:'*petitcompiler'!
asCompilerTree
^ self transform: [ :p | p asCompilerNode ]
! !
!PPParser methodsFor:'*petitcompiler'!
bridge
^ self
! !
!PPParser methodsFor:'*petitcompiler'!
cached
"Faster way of memoizing --- it ignores context information, therefore it is not suitable for context-sensitive rules"
^ PPCachingParser on: self
! !
!PPParser methodsFor:'*petitcompiler'!
compile
^ self compile: #PPGeneratedParser
! !
!PPParser methodsFor:'*petitcompiler'!
compile: name
^ self compile: name parameters: #()
! !
!PPParser methodsFor:'*petitcompiler'!
compile: name andParse: input
^ (self compile: name) parse: input
! !
!PPParser methodsFor:'*petitcompiler'!
compile: name parameters: params
^ (PPCCompiler new parameters: params; compile: self as: name) new
! !
!PPParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
| compiled |
self children do: [ :child |
compiled := child compileWith: aPetitCompiler.
self replace: child with: compiled bridge.
].
^ aPetitCompiler compileBridgeTo: self
! !
!PPParser methodsFor:'*petitcompiler'!
compileWithParameters: params
^ self compile: #PPGeneratedParser parameters: params
! !
!PPParser methodsFor:'*petitcompiler'!
first
first ifNil: [
first := self firstSet
].
^ first
! !
!PPParser methodsFor:'*petitcompiler'!
first: firstSet
first := firstSet
! !
!PPParser methodsFor:'*petitcompiler'!
firstSetSuchThat: block
^ self firstSetSuchThat: block into: (OrderedCollection new) openSet: IdentitySet new.
! !
!PPParser methodsFor:'*petitcompiler'!
firstSetSuchThat: block into: aCollection openSet: aSet
(aSet includes: self) ifTrue: [ ^ aCollection ].
aSet add: self.
(block value: self) ifTrue: [aCollection add: self. ^ aCollection ].
self children do: [ :child |
child firstSetSuchThat: block into: aCollection openSet: aSet
].
^ aCollection
! !
!PPParser methodsFor:'*petitcompiler'!
id
self name ifNotNil: [ ^ self name ].
^ self hash asString
! !
!PPParser methodsFor:'*petitcompiler'!
isCompiled
^ false
! !
!PPParser methodsFor:'*petitcompiler'!
isContextFree
^ self propertyAt: #isContextFree ifAbsentPut:
[ self allParsers allSatisfy: [ :p | p isContextFreePrim ] ].
! !
!PPParser methodsFor:'*petitcompiler'!
isContextFreePrim
^ true
! !
!PPParser methodsFor:'*petitcompiler'!
isToken
^ false
! !
!PPParser methodsFor:'*petitcompiler'!
isTokenParser
^ false
! !
!PPParser methodsFor:'*petitcompiler'!
optimize
^ self copy
! !
!PPParser methodsFor:'*petitcompiler'!
optimized
^ self copy
! !
!PPParser methodsFor:'*petitcompiler'!
trimmingToken
| ws |
ws := #space asParser star.
^ ((ws, (PPTokenParser on: self), ws) ==> #second)
name: 'trimmingToken';
yourself
! !
!PPPluggableParser methodsFor:'*petitcompiler'!
acceptsEpsilon
^ true
! !
!PPPluggableParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCPluggableNode new
block: block;
name: self name;
yourself
! !
!PPPossessiveRepeatingParser methodsFor:'*petitcompiler'!
asCompilerNode
((self min = 0) and: [ self max = SmallInteger maxVal ]) ifTrue: [
^ PPCStarNode new
name: self name;
child: parser;
yourself
].
((self min = 1) and: [ self max = SmallInteger maxVal ]) ifTrue: [
^ PPCPlusNode new
name: self name;
child: parser;
yourself
].
^ super asCompilerNode
! !
!PPPossessiveRepeatingParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
((self min = 1) and: [ self max = SmallInteger maxVal ]) ifTrue: [
^ aPetitCompiler compilePlus: self.
].
((self min = 0) and: [ self max = SmallInteger maxVal ]) ifTrue: [
^ aPetitCompiler compileStar: self.
].
^ super compileWith: aPetitCompiler.
! !
!PPPossessiveRepeatingParser methodsFor:'*petitcompiler'!
optimized
^ (PPFastPossessiveRepeatingParser on: parser)
setMin: min;
setMax: max;
yourself
! !
!PPPredicateObjectParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCPredicateNode new
name: self name;
predicate: predicate;
yourself
! !
!PPPredicateObjectParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
(predicateMessage = 'input expected') ifTrue: [
^ aPetitCompiler compileAny.
].
^ aPetitCompiler compilePredicate: predicate.
! !
!PPPredicateObjectParser methodsFor:'*petitcompiler'!
firstCharParser
^ self
! !
!PPSequenceParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCSequenceNode new
children: parsers;
name: self name;
yourself
! !
!PPSequenceParser methodsFor:'*petitcompiler'!
checkFirst: context
first isEmpty ifTrue: [ ^ true ].
first do: [ :elem |
(context matchToken: elem id) ifTrue: [ ^ true ].
].
^ false
! !
!PPSequenceParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
^ aPetitCompiler compileSequence: self.
! !
!PPSequenceParser methodsFor:'*petitcompiler'!
firstSetSuchThat: block into: aCollection openSet: aSet
(aSet includes: self) ifTrue: [ ^ aCollection ].
aSet add: self.
(block value: self) ifTrue: [ aCollection add: self. ^ aCollection ].
self children do: [ :child |
child firstSetSuchThat: block into: aCollection openSet: aSet.
child acceptsEpsilon ifFalse: [ ^ aCollection ]
].
^ aCollection
! !
!PPSequenceParser methodsFor:'*petitcompiler'!
optimized
^ PPFastSequenceParser withAll: parsers
! !
!PPSmalltalkGrammar methodsFor:'*petitcompiler'!
comment
^ $" asParser, $" asParser negate star, $" asParser.
! !
!PPSmalltalkGrammar methodsFor:'*petitcompiler'!
updateContext: aPPContext
super updateContext: aPPContext.
"
aPPContext globalAt: #comment ifAbsentPut: [ self comment ].
aPPContext globalAt: #whitespace ifAbsentPut: [ PPSmalltalkWhitespaceParser new ].
"
! !
!PPSmalltalkGrammar methodsFor:'*petitcompiler'!
whitespace
^ #space asParser plus
! !
!PPSmalltalkGrammar methodsFor:'*petitcompiler'!
whitespaceOld
^ #space asParser plus
! !
!PPSmalltalkGrammar methodsFor:'*petitcompiler'!
whitespaceX
whitespace ifNil: [
whitespace := PPSmalltalkWhitespaceParser new
].
^ whitespace
! !
!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
^ aPetitCompiler compileSmalltalkToken: self.
! !
!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!
parseOnX: aPPContext
| memento comments token |
memento := aPPContext remember.
comments := self
parseComments: #()
on: aPPContext.
token := super parseOn: aPPContext.
token isPetitFailure ifTrue: [
aPPContext restore: memento.
^ token ].
comments := self
parseComments: comments
on: aPPContext.
^ token comments: comments
! !
!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!
updateContext: aPPContext
aPPContext globalAt: #whitespace ifAbsentPut: PPSmalltalkWhitespaceParser new
! !
!PPSmalltalkTokenParser methodsFor:'*petitcompiler'!
whitespace
^ PPSmalltalkWhitespaceParser new
! !
!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!
acceptsEpsilon
^ true
! !
!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!
acceptsEpsilonOpenSet: set
^ true
! !
!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!
firstCharParser
^ PPFailingParser new
! !
!PPStream methodsFor:'*petitcompiler'!
peek: anInteger
| endPosition |
endPosition := position + anInteger min: readLimit.
^ collection copyFrom: position+1 to: endPosition.
! !
!PPToken methodsFor:'*petitcompiler'!
= anObject
^ self class = anObject class and: [ self inputValue = anObject inputValue ]
! !
!PPToken methodsFor:'*petitcompiler'!
hash
^ self inputValue hash
! !
!PPToken methodsFor:'*petitcompiler'!
isToken
^ true
! !
!PPTokenParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCTokenNode new
name: self name;
tokenClass: self tokenClass;
child: parser;
yourself
! !
!PPTokenParser methodsFor:'*petitcompiler'!
displayName
^ 'TOKEN[', parser displayName, ']'
! !
!PPTokenParser methodsFor:'*petitcompiler'!
firstSets: aFirstDictionary into: aSet
"Or keep empty, if token is a terminal"
^ super firstSets: aFirstDictionary into: aSet
! !
!PPTokenParser methodsFor:'*petitcompiler'!
id
id ifNil: [
id := ('TOK[', parser id, ']') asSymbol
].
^ id
! !
!PPTokenParser methodsFor:'*petitcompiler'!
isFirstSetTerminal
^ false
! !
!PPTokenParser methodsFor:'*petitcompiler'!
isTokenParser
^ true
! !
!PPTokenParser methodsFor:'*petitcompiler'!
isUnique
unique ifNil: [
unique := parser firstSet size = 1 and: [ (parser firstSet anyOne isKindOf: PPLiteralParser) ]
].
^ unique
! !
!PPTokenParser methodsFor:'*petitcompiler'!
optimize
^ self transform: [ :each | each optimized ]
! !
!PPTokenParser methodsFor:'*petitcompiler'!
parseOnX: aPPContext
(aPPContext matchToken: self id) ifTrue: [
^ aPPContext nextToken: self id.
].
^ PPFailure message: self id, ' not found' context: aPPContext.
! !
!PPTokenParser methodsFor:'*petitcompiler'!
parser
^ parser
! !
!PPTokenParser methodsFor:'*petitcompiler'!
startsWith: aCharacter
self first do: [:first | (first startsWith: aCharacter) ifTrue: [ ^ true ] ].
^ false
! !
!PPTokenParser methodsFor:'*petitcompiler'!
whitespace
^ self class whitespace
! !
!PPTrimmingParser methodsFor:'*petitcompiler'!
asCompilerNode
^ PPCTrimNode new
child: parser;
name: self name;
yourself
! !
!PPTrimmingParser methodsFor:'*petitcompiler'!
compileWith: aPetitCompiler
^ aPetitCompiler compileTrim: self.
! !
!PPTrimmingParser methodsFor:'*petitcompiler'!
firstSets: aFirstDictionary into: aSet
super firstSets: aFirstDictionary into: aSet
! !
!UndefinedObject methodsFor:'*petitcompiler'!
asInteger
^ 256
! !
!UndefinedObject methodsFor:'*petitcompiler'!
isAlphaNumeric
^ false
! !
!UndefinedObject methodsFor:'*petitcompiler'!
isDigit
^ false
! !
!UndefinedObject methodsFor:'*petitcompiler'!
isLetter
^ false
! !
!stx_goodies_petitparser_compiler class methodsFor:'documentation'!
extensionsVersion_HG
^ '$Changeset: <not expanded> $'
! !