Merged JK's work on PetitCompiler
Name: PetitCompiler-JanKurs.57
Author: JanKurs
Time: 05-11-2014, 05:10:47 AM
UUID: 4c625efe-77fd-465d-bd63-72ead0b5d3ba
Name: PetitCompiler-Tests-JanVrany.13
Author: JanVrany
Time: 05-11-2014, 09:31:07 AM
UUID: 189ae287-6bc1-40ba-8458-b8392c4260a0
"{ 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
! !
!PPPredicateObjectParser methodsFor:'*petitcompiler'!
firstCharSet
^ predicate
! !
!PPPredicateObjectParser methodsFor:'*petitcompiler'!
firstCharSetCached
^ predicate
! !
!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
! !
!PPSmalltalkWhitespaceParser methodsFor:'*petitcompiler'!
firstCharSet
^ PPCharSetPredicate on: [:e | false ]
! !
!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
! !
!UndefinedObject methodsFor:'*petitcompiler'!
isSeparator
^ false
! !
!stx_goodies_petitparser_compiler class methodsFor:'documentation'!
extensionsVersion_HG
^ '$Changeset: <not expanded> $'
! !