PPCBenchmarkResource updated to work on Smalltalk/X
...as API of FileReference and Filename differ.
"{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }"
"{ NameSpace: Smalltalk }"
Object subclass:#PPCBenchmarkResources
instanceVariableNames:''
classVariableNames:'javaCache'
poolDictionaries:''
category:'PetitCompiler-Benchmarks-Core'
!
!PPCBenchmarkResources methodsFor:'as yet unclassified'!
changesSized: size
| string changes |
changes := PharoFilesOpener default changesFileOrNil contents.
string := changes copyFrom: 1 to: size.
^ string
!
javaInDirectory: directory
| files |
files := self readDirectory: directory.
files := self files: files withExtension: 'java'.
^ files collect: [ :f | (FileStream fileNamed: f) contents asString ]
!
javaLangClass
!
javaLangMath
^ (FileStream fileNamed: '../java-src/java/lang/Math.java') contents asString
!
javaSourcesBig
^ self javaInDirectory: '../java-src/java/util'.
"^ self workingJavaInDirectory: '../java-src/java/util'"
!
petitParserPackage
^ '
Object subclass: #PPCharSetPredicate
instanceVariableNames: ''block classification''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Tools''!!
!!PPCharSetPredicate commentStamp: ''<historical>'' prior: 0!!
!!
!!PPCharSetPredicate methodsFor: ''initialization'' stamp: ''lr 8/30/2010 12:19''!!
initializeOn: aBlock
block := aBlock.
classification := Array new: 255.
1 to: classification size do: [ :index |
classification at: index put: (block
value: (Character value: index)) ]!! !!
!!PPCharSetPredicate methodsFor: ''evaluating'' stamp: ''lr 8/30/2010 12:19''!!
value: aCharacter
| index |
index := aCharacter asInteger.
index == 0
ifTrue: [ ^ block value: aCharacter ].
index > 255
ifTrue: [ ^ block value: aCharacter ].
^ classification at: index!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPCharSetPredicate class
instanceVariableNames: ''''!!
!!PPCharSetPredicate class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPCharSetPredicate class methodsFor: ''instance creation'' stamp: ''lr 8/25/2010 11:05''!!
on: aBlock
^ self basicNew initializeOn: aBlock!! !!
PPDelegateParser subclass: #PPExpressionParser
instanceVariableNames: ''operators''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Tools''!!
!!PPExpressionParser commentStamp: ''<historical>'' prior: 0!!
A PPExpressionParser is a parser to conveniently define an expression grammar with prefix, postfix, and left- and right-associative infix operators.
The following code initializes a parser for arithmetic expressions. First we instantiate an expression parser, a simple parser for expressions in parenthesis and a simple parser for integer numbers.
expression := PPExpressionParser new.
parens := $( asParser token trim , expression , $) asParser token trim
==> [ :nodes | nodes second ].
integer := #digit asParser plus token trim
==> [ :token | token value asInteger ].
Then we define on what term the expression grammar is built on:
expression term: parens / integer.
Finally we define the operator-groups in descending precedence. Note, that the action blocks receive both, the terms and the parsed operator in the order they appear in the parsed input.
expression
group: [ :g |
g prefix: $- asParser token trim do: [ :op :a | a negated ] ];
group: [ :g |
g postfix: ''++'' asParser token trim do: [ :a :op | a + 1 ].
g postfix: ''--'' asParser token trim do: [ :a :op | a - 1 ] ];
group: [ :g |
g right: $^ asParser token trim do: [ :a :op :b | a raisedTo: b ] ];
group: [ :g |
g left: $* asParser token trim do: [ :a :op :b | a * b ].
g left: $/ asParser token trim do: [ :a :op :b | a / b ] ];
group: [ :g |
g left: $+ asParser token trim do: [ :a :op :b | a + b ].
g left: $- asParser token trim do: [ :a :op :b | a - b ] ].
After evaluating the above code the ''expression'' is an efficient parser that evaluates examples like:
expression parse: ''-8++''.
expression parse: ''1+2*3''.
expression parse: ''1*2+3''.
expression parse: ''(1+2)*3''.
expression parse: ''8/4/2''.
expression parse: ''8/(4/2)''.
expression parse: ''2^2^3''.
expression parse: ''(2^2)^3''.
Instance Variables:
operators <Dictionary> The operators defined in the current group.!!
!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
build: aParser right: aChoiceParser
^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]!! !!
!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
build: aParser left: aChoiceParser
^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]!! !!
!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:38''!!
build: aParser postfix: aChoiceParser
^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]!! !!
!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 21:15''!!
buildOn: aParser
^ self buildSelectors inject: aParser into: [ :term :selector |
| list |
list := operators at: selector ifAbsent: [ #() ].
list isEmpty
ifTrue: [ term ]
ifFalse: [
self
perform: selector with: term
with: (list size = 1
ifTrue: [ list first first ==> [ :operator | Array with: list first second with: operator ] ]
ifFalse: [
list
inject: PPChoiceParser new
into: [ :choice :each | choice / (each first ==> [ :operator | Array with: each second with: operator ]) ] ]) ] ]!! !!
!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:39''!!
build: aParser prefix: aChoiceParser
^ aChoiceParser star , aParser map: [ :ops :term | ops reversed inject: term into: [ :result :operator | operator first value: operator second value: result ] ]!! !!
!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
buildSelectors
^ #(build:prefix: build:postfix: build:right: build:left:)!! !!
!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 2/7/2010 23:23''!!
operator: aSymbol parser: aParser do: aBlock
parser isNil
ifTrue: [ ^ self error: ''You did not specify a term when creating the receiver.'' ].
operators isNil
ifTrue: [ ^ self error: ''Use #group: to define precedence groups in descending order.'' ].
(operators at: aSymbol ifAbsentPut: [ OrderedCollection new ])
addLast: (Array with: aParser asParser with: aBlock)!! !!
!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 21:26''!!
term: aParser
"Defines the initial term aParser of the receiver."
parser isNil
ifTrue: [ parser := aParser ]
ifFalse: [ self error: ''Unable to redefine the term.'' ]!! !!
!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
postfix: aParser do: aTwoArgumentBlock
"Define a postfix operator aParser. Evaluate aTwoArgumentBlock with the term and the operator."
self operator: #build:postfix: parser: aParser do: aTwoArgumentBlock!! !!
!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
left: aParser do: aThreeArgumentBlock
"Define an operator aParser that is left-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."
self operator: #build:left: parser: aParser do: aThreeArgumentBlock!! !!
!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
prefix: aParser do: aTwoArgumentBlock
"Define a prefix operator aParser. Evaluate aTwoArgumentBlock with the operator and the term."
self operator: #build:prefix: parser: aParser do: aTwoArgumentBlock!! !!
!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
right: aParser do: aThreeArgumentBlock
"Define an operator aParser that is right-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."
self operator: #build:right: parser: aParser do: aThreeArgumentBlock!! !!
!!PPExpressionParser methodsFor: ''specifying'' stamp: ''lr 2/7/2010 23:20''!!
group: aOneArgumentBlock
"Defines a priority group by evaluating aOneArgumentBlock."
operators := Dictionary new.
parser := [
aOneArgumentBlock value: self.
self buildOn: parser ]
ensure: [ operators := nil ]!! !!
PPDelegateParser subclass: #PPCompositeParser
instanceVariableNames: ''dependencies''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Tools''!!
!!PPCompositeParser commentStamp: ''lr 12/4/2009 18:38'' prior: 0!!
A PPCompositeParser is composed parser built from various primitive parsers.
Every production in the receiver is specified as a method that returns its parser. Note that every production requires an instance variable of the same name, otherwise the production is not cached and cannot be used in recursive grammars. Productions should refer to each other by reading the respective inst-var. Note: these inst-vars are typically not written, as the assignment happens in the initialize method using reflection.
The start production is defined in the method start. It is aliased to the inst-var parser defined in the superclass of PPCompositeParser.!!
!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 6/4/2010 13:37''!!
productionAt: aSymbol ifAbsent: aBlock
"Answer the production named aSymbol, if there is no such production answer the result of evaluating aBlock."
(self class ignoredNames includes: aSymbol asString)
ifTrue: [ ^ aBlock value ].
(self class startSymbol = aSymbol)
ifTrue: [ ^ parser ].
^ self instVarAt: (self class allInstVarNames
indexOf: aSymbol asString
ifAbsent: [ ^ aBlock value ])!! !!
!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 5/8/2011 15:45''!!
productionNames
"Answer a dictionary of slot indexes and production names."
| productionNames ignoredNames |
productionNames := Dictionary new.
ignoredNames := self class ignoredNames
collect: [ :each | each asSymbol ].
self class allInstVarNames keysAndValuesDo: [ :key :value |
(ignoredNames includes: value asSymbol)
ifFalse: [ productionNames at: key put: value asSymbol ] ].
^ productionNames!! !!
!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 3/16/2013 21:41''!!
dependencyAt: aClass
"Answer the dependent parser aClass. Throws an error if this parser class is not declared in the method #dependencies on the class-side of the receiver."
^ dependencies at: aClass ifAbsent: [ self error: ''Undeclared dependency in '' , self class name , '' to '' , aClass name ]!! !!
!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 12/4/2009 18:39''!!
productionAt: aSymbol
"Answer the production named aSymbol."
^ self productionAt: aSymbol ifAbsent: [ nil ]!! !!
!!PPCompositeParser methodsFor: ''initialization'' stamp: ''lr 3/16/2013 17:15''!!
initializeStartingAt: aSymbol dependencies: aDictionary
self initialize.
parser := PPDelegateParser named: aSymbol.
self productionNames keysAndValuesDo: [ :key :value |
self instVarAt: key put: (PPDelegateParser named: value) ].
dependencies := aDictionary!! !!
!!PPCompositeParser methodsFor: ''accessing'' stamp: ''lr 5/16/2008 17:32''!!
start
"Answer the production to start this parser with."
self subclassResponsibility!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPCompositeParser class
instanceVariableNames: ''''!!
!!PPCompositeParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 1/29/2010 11:35''!!
ignoredNames
"Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser."
^ PPCompositeParser allInstVarNames!! !!
!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 12/7/2009 08:20''!!
startSymbol
"Answer the method that represents the default start symbol."
^ #start!! !!
!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 3/16/2013 21:42''!!
dependencies
"Answer a collection of PPCompositeParser classes that this parser directly dependends on. Override this method in subclasses to declare dependent parsers. The default implementation does not depend on other PPCompositeParser."
^ #()!! !!
!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!!
debug: anObject startingAt: aSymbol onError: aBlock
^ (self newStartingAt: aSymbol) debug: anObject onError: aBlock!! !!
!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!!
debug: anObject startingAt: aSymbol
^ (self newStartingAt: aSymbol) debug: anObject!! !!
!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!!
debug: anObject onError: aBlock
^ self debug: anObject startingAt: self startSymbol onError: aBlock!! !!
!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!!
debug: anObject
^ self debug: anObject startingAt: self startSymbol!! !!
!!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 3/16/2013 21:21''!!
newStartingAt: aSymbol
"Answer a new parser starting at aSymbol. The code makes sure to resolve all dependent parsers correctly."
| parsers remaining |
parsers := IdentityDictionary new.
remaining := OrderedCollection with: self.
[ remaining isEmpty ] whileFalse: [
| dependency |
dependency := remaining removeLast.
(parsers includesKey: dependency) ifFalse: [
parsers at: dependency put: dependency basicNew.
remaining addAll: dependency dependencies ] ].
parsers keysAndValuesDo: [ :class :parser |
| dependencies |
dependencies := IdentityDictionary new.
class dependencies
do: [ :dependency | dependencies at: dependency put: (parsers at: dependency) ].
parser
initializeStartingAt: (class == self
ifTrue: [ aSymbol ]
ifFalse: [ class startSymbol ])
dependencies: dependencies ].
parsers keysAndValuesDo: [ :class :parser |
parser setParser: (parser perform: parser children first name).
parser productionNames keysAndValuesDo: [ :key :value |
(parser instVarAt: key) setParser: (parser perform: value) ] ].
^ parsers at: self!! !!
!!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 12/7/2009 08:24''!!
new
"Answer a new parser starting at the default start symbol."
^ self newStartingAt: self startSymbol!! !!
!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!!
parse: anObject onError: aBlock
^ self parse: anObject startingAt: self startSymbol onError: aBlock!! !!
!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!!
parse: anObject startingAt: aSymbol onError: aBlock
^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock!! !!
!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!!
parse: anObject startingAt: aSymbol
^ (self newStartingAt: aSymbol) parse: anObject!! !!
!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!!
parse: anObject
^ self parse: anObject startingAt: self startSymbol!! !!
PPParser subclass: #PPUnresolvedParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Tools''!!
!!PPUnresolvedParser commentStamp: ''lr 11/28/2009 18:50'' prior: 0!!
This is a temporary placeholder or forward reference to a parser that has not been defined yet. If everything goes well it will eventually be replaced with the real parser instance.!!
!!PPUnresolvedParser methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:51''!!
parseOn: aStream
self error: self printString , '' need to be resolved before execution.''!! !!
!!PPUnresolvedParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:15''!!
displayColor
^ Color red!! !!
!!PPUnresolvedParser methodsFor: ''testing'' stamp: ''lr 10/27/2008 11:29''!!
isUnresolved
^ true!! !!
Object subclass: #PPParser
instanceVariableNames: ''properties''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPParser commentStamp: ''<historical>'' prior: 0!!
An abstract parser for all parsers in PetitParser. Subclasses implement #parseOn: to perform the actual recursive-descent parsing. All parsers support a variety of methods to perform an actual parse, see the methods in the #parsing protocol. Parsers are combined with a series of operators that can be found in the #operations protocol.
Instance Variables:
properties <Dictionary> Stores additional state in the parser object.!!
!!PPParser methodsFor: ''*petitjava-operations'' stamp: ''sback 9/2/2010 23:01''!!
javaToken
^ PPJavaTokenParser on: self!! !!
!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 12/18/2013 06:41''!!
gtInspectorParserInspectorIn: composite
<gtInspectorPresentationOrder: 30>
composite custom: (
PPVerticalParserInspector new
title: ''Sampler'';
startOn: self)!! !!
!!PPParser methodsFor: ''*petitgui'' stamp: ''AlexandreBergel 12/18/2013 16:40''!!
gtGraphViewIn: composite
<gtInspectorPresentationOrder: 50>
composite roassal
title: ''Graph'';
painting: [ :view |
self visualizeStructureInGraphOn: view.
].!! !!
!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!!
gtNamedTreeViewIn: composite
<gtInspectorPresentationOrder: 40>
composite tree
title: ''Named Tree'';
children: [:n | n namedChildren ];
format: [:n| n name ifNil: [ n asString ] ];
shouldExpandToLevel: 3!! !!
!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!!
gtTreeViewIn: composite
<gtInspectorPresentationOrder: 40>
composite tree
title: ''Tree'';
children: [:n | n children ];
format: [:n| n name ifNil: [ n asString ] ifNotNil: [n name] ];
shouldExpandToLevel: 6!! !!
!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 1/30/2013 19:35''!!
morphicShapeDefault
^ self newRowMorph
addMorphBack: (self newColumnMorph
addMorphBack: (self newSpacerMorph);
addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
makeForwardArrow;
yourself);
addMorphBack: (self newRowMorph
borderWidth: 1;
layoutInset: 3;
color: Color white;
addMorphBack: (StringMorph new
contents: self displayName;
color: self displayColor;
yourself);
yourself);
yourself!! !!
!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 10:56''!!
morphicProduction
^ self newRowMorph
layoutInset: 4;
addMorphBack: (self newRowMorph
layoutInset: 4;
addMorphBack: (StringMorph new
contents: self displayName;
emphasis: TextEmphasis bold emphasisCode;
yourself);
yourself);
addMorphBack: (self morphicShapeSeen: IdentitySet new depth: 0);
addMorphBack: (self newColumnMorph
addMorphBack: (self newSpacerMorph);
addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
makeForwardArrow;
yourself);
yourself!! !!
!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:24''!!
morphicShapeSeen: aSet depth: anInteger
^ self morphicShapeDefault!! !!
!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:43''!!
morphicShapeSeen: aSet depth: anInteger do: aBlock
" avoid recursion "
(aSet includes: self)
ifTrue: [ ^ self morphicShapeDefault ].
" display nice name when possible "
(anInteger > 0 and: [ self name notNil ])
ifTrue: [ ^ self morphicShapeDefault ].
" don''t do it too deep "
(anInteger > 10)
ifTrue: [ ^ self morphicShapeDefault ].
aSet add: self.
^ aBlock value: [ :parser |
parser
morphicShapeSeen: aSet
depth: anInteger + 1 ]!! !!
!!PPParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 10/30/2010 11:54''!!
transform: aBlock
"Answer a copy of all parsers reachable from the receiver transformed using aBlock."
| mapping root |
mapping := IdentityDictionary new.
self allParsersDo: [ :each |
mapping
at: each
put: (aBlock value: each copy) ].
root := mapping at: self.
[ | changed |
changed := false.
root allParsersDo: [ :each |
each children do: [ :old |
mapping at: old ifPresent: [ :new |
each replace: old with: new.
changed := true ] ] ].
changed ] whileTrue.
^ root!! !!
!!PPParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/13/2010 09:38''!!
replace: aParser with: anotherParser
"Replace the references of the receiver pointing to aParser with anotherParser."!! !!
!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
namedChildrenDo: aBlock
"Iterate over the named children of the receiver."
self namedChildrenDo: aBlock seen: IdentitySet new!! !!
!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:01''!!
allNamedParsers
"Answer all the named parse nodes of the receiver."
| result |
result := OrderedCollection new.
self allNamedParsersDo: [ :parser | result addLast: parser ].
^ result!! !!
!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
namedChildrenDo: aBlock seen: aSet
"Iterate over the named children of the receiver."
self children do: [ :each |
(aSet includes: each)
ifTrue: [ ^ self ].
aSet add: each.
each name isNil
ifTrue: [ each namedChildrenDo: aBlock seen: aSet ]
ifFalse: [ aBlock value: each ] ]!! !!
!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:45''!!
innerChildren
"Answer the inner children of the receiver."
| result |
result := OrderedCollection new.
self innerChildrenDo: [ :parser | result addLast: parser ].
^ result!! !!
!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:51''!!
innerChildrenDo: aBlock seen: aSet
"Iterate over the inner children of the receiver."
self children do: [ :each |
(aSet includes: each)
ifTrue: [ ^ self ].
aSet add: each.
each name isNil ifTrue: [
aBlock value: each.
each innerChildrenDo: aBlock seen: aSet ] ]!! !!
!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:48''!!
innerChildrenDo: aBlock
"Iterate over the inner children of the receiver."
self innerChildrenDo: aBlock seen: IdentitySet new!! !!
!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:12''!!
allNamedParsersDo: aBlock
"Iterate over all the named parse nodes of the receiver."
self allParsersDo: [ :each |
each name notNil
ifTrue: [ aBlock value: each ] ]!! !!
!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
namedChildren
"Answer the named children of the receiver."
| result |
result := OrderedCollection new.
self namedChildrenDo: [ :parser | result addLast: parser ].
^ result!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
trimBlanks
"Answer a new parser that consumes blanks before and after the receiving parser."
^ self trim: #blank asParser!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 2/19/2010 07:42''!!
answer: anObject
"Answer a new parser that always returns anObject from a successful parse."
^ self ==> [ :nodes | anObject ]!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
trim: aParser
"Answer a new parser that consumes and ignores aParser repeatedly before and after the receiving parser."
^ PPTrimmingParser on: self trimmer: aParser!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/6/2011 20:28''!!
map: aBlock
"Answer a new parser that works on the receiving sequence an passes in each element as a block argument."
^ aBlock numArgs = 1
ifTrue: [ self ==> aBlock ]
ifFalse: [ self error: aBlock numArgs asString , '' arguments expected.'' ]
!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 6/29/2010 14:25''!!
token
"Answer a new parser that transforms the input to a token."
^ PPTokenParser on: self!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/3/2011 14:59''!!
foldRight: aBlock
"Answer a new parser that that folds the result of the receiver from right-to-left into aBlock. The argument aBlock must take two or more arguments."
| size args |
size := aBlock numArgs.
args := Array new: size.
^ self ==> [ :nodes |
args at: size put: nodes last.
nodes size - size + 1 to: 1 by: 1 - size do: [ :index |
args
replaceFrom: 1 to: size - 1 with: nodes startingAt: index;
at: size put: (aBlock valueWithArguments: args) ].
args at: size ]!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
trimSpaces
"Answer a new parser that consumes spaces before and after the receiving parser."
^ self trim: #space asParser!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/15/2008 16:08''!!
flatten
"Answer a new parser that flattens the underlying collection."
^ PPFlattenParser on: self!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/31/2010 12:06''!!
trim
"Answer a new parser that consumes spaces before and after the receiving parser."
^ self trimSpaces!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 6/12/2010 10:20''!!
>=> aBlock
"Answer a new parser that wraps the receiving parser with a two argument block. The first argument is the parsed stream, the second argument a continuation block on the delegate parser."
^ PPWrappingParser on: self block: aBlock!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/12/2010 20:32''!!
==> aBlock
"Answer a new parser that performs aBlock as action handler on success."
^ PPActionParser on: self block: aBlock!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/3/2011 15:00''!!
foldLeft: aBlock
"Answer a new parser that that folds the result of the receiver from left-to-right into aBlock. The argument aBlock must take two or more arguments."
| size args |
size := aBlock numArgs.
args := Array new: size.
^ self ==> [ :nodes |
args at: 1 put: nodes first.
2 to: nodes size by: size - 1 do: [ :index |
args
replaceFrom: 2 to: size with: nodes startingAt: index;
at: 1 put: (aBlock valueWithArguments: args) ].
args first ]!! !!
!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/6/2010 19:26''!!
token: aTokenClass
"Answer a new parser that transforms the input to a token of class aTokenClass."
^ self token tokenClass: aTokenClass!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
max: anInteger lazy: aParser
"Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed."
^ (self starLazy: aParser) setMax: anInteger!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:01''!!
starLazy: aParser
"Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed."
^ PPLazyRepeatingParser on: self limit: aParser!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 9/15/2010 09:34''!!
times: anInteger
"Answer a new parser that parses the receiver exactly anInteger times."
^ self min: anInteger max: anInteger!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
min: aMinInteger max: aMaxInteger greedy: aParser
"Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
^ (self starGreedy: aParser) setMin: aMinInteger; setMax: aMaxInteger!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:02''!!
star
"Answer a new parser that parses the receiver zero or more times. This is a greedy and blind implementation that tries to consume as much input as possible and it does not consider what comes afterwards."
^ PPPossessiveRepeatingParser on: self!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:02''!!
min: anInteger
"Answer a new parser that parses the receiver at least anInteger times."
^ self star setMin: anInteger!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
min: aMinInteger max: aMaxInteger
"Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times."
^ self star setMin: aMinInteger; setMax: aMaxInteger!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:01''!!
starGreedy: aParser
"Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed."
^ PPGreedyRepeatingParser on: self limit: aParser!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
min: aMinInteger max: aMaxInteger lazy: aParser
"Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
^ (self starLazy: aParser) setMin: aMinInteger; setMax: aMaxInteger!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
min: anInteger lazy: aParser
"Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed."
^ (self starLazy: aParser) setMin: anInteger!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
max: anInteger greedy: aParser
"Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
^ (self starGreedy: aParser) setMax: anInteger!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
plus
"Answer a new parser that parses the receiver one or more times."
^ self star setMin: 1!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
min: anInteger greedy: aParser
"Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
^ (self starGreedy: aParser) setMin: anInteger!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
max: anInteger
"Answer a new parser that parses the receiver at most anInteger times."
^ self star setMax: anInteger!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:04''!!
plusGreedy: aParser
"Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed."
^ (self starGreedy: aParser) setMin: 1!! !!
!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:04''!!
plusLazy: aParser
"Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed."
^ (self starLazy: aParser) setMin: 1!! !!
!!PPParser methodsFor: ''*petitsmalltalk-operations'' stamp: ''lr 6/29/2010 14:27''!!
smalltalkToken
^ PPSmalltalkTokenParser on: self!! !!
!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 5/22/2010 10:45''!!
isTerminal
"Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
^ self children isEmpty!! !!
!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''JanKurs 5/31/2013 11:49''!!
isFirstSetTerminal
"Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
^ self children isEmpty!! !!
!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 11/12/2009 17:25''!!
isNullable
"Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing."
^ false!! !!
!!PPParser methodsFor: ''converting'' stamp: ''lr 11/29/2011 20:48''!!
asParser
"Answer the receiving parser."
^ self!! !!
!!PPParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:36''!!
printNameOn: aStream
self name isNil
ifTrue: [ aStream print: self hash ]
ifFalse: [ aStream nextPutAll: self name ]!! !!
!!PPParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:36''!!
printOn: aStream
super printOn: aStream.
aStream nextPut: $(.
self printNameOn: aStream.
aStream nextPut: $)!! !!
!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:37''!!
example
^ String streamContents: [ :stream | self exampleOn: stream ] limitedTo: 1024!! !!
!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:20''!!
exampleOn: aStream!! !!
!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 9/12/2011 18:34''!!
displayColor
^ self isTerminal
ifTrue: [ Color r: 0.5 g: 0.0 b: 0.5 ]
ifFalse: [ Color blue ]!! !!
!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:31''!!
displayName
^ self name isNil
ifFalse: [ self name asString ]
ifTrue: [ self class name asString ]!! !!
!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:11''!!
backgroundForDepth: anInteger
^ Color gray: 1.0 - (anInteger / 20.0)!! !!
!!PPParser methodsFor: ''parsing'' stamp: ''lr 10/29/2010 17:05''!!
parse: anObject onError: aBlock
"Parse anObject with the receiving parser and answer the parse-result or answer the result of evaluating aBlock. Depending on the number of arguments of the block it is simply evaluated, evaluated with the failure object, or evaluated with the error message and position."
| result |
result := self parse: anObject.
result isPetitFailure
ifFalse: [ ^ result ].
aBlock numArgs = 0
ifTrue: [ ^ aBlock value ].
aBlock numArgs = 1
ifTrue: [ ^ aBlock value: result ].
^ aBlock value: result message value: result position!! !!
!!PPParser methodsFor: ''parsing'' stamp: ''lr 6/4/2011 18:12''!!
matchesIn: anObject
"Search anObject repeatedly for the matches of the receiver. Answered an OrderedCollection of the matched parse-trees."
| result |
result := OrderedCollection new.
self
matchesIn: anObject
do: [ :each | result addLast: each ].
^ result!! !!
!!PPParser methodsFor: ''parsing'' stamp: ''lr 8/16/2011 07:26''!!
matchesSkipIn: anObject
"Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of the matched parse-trees. Skip over matches."
| result |
result := OrderedCollection new.
self
matchesSkipIn: anObject
do: [ :each | result addLast: each ].
^ result!! !!
!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/25/2013 23:42''!!
matchingSkipRangesIn: anObject do: aBlock
"Search anObject repeatedly for the matches of the receiver. Skip over matches. Evaluate aBlock with the range of each match (index of first character to: index of last character)."
self token
matchesSkipIn: anObject
do: [ :token | aBlock value: (token start to: token stop) ]!! !!
!!PPParser methodsFor: ''parsing'' stamp: ''DamienCassou 10/29/2011 19:18''!!
matchingSkipRangesIn: anObject
"Search anObject repeatedly for the matches of the receiver. Skip over matches. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)."
| result |
result := OrderedCollection new.
self
matchingSkipRangesIn: anObject
do: [ :value | result addLast: value ].
^ result!! !!
!!PPParser methodsFor: ''parsing'' stamp: ''lr 6/4/2011 18:12''!!
matchingRangesIn: anObject
"Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)."
| result |
result := OrderedCollection new.
self
matchingRangesIn: anObject
do: [ :value | result addLast: value ].
^ result!! !!
!!PPParser methodsFor: ''parsing'' stamp: ''lr 8/16/2011 07:26''!!
matchesSkipIn: anObject do: aBlock
"Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Skip over matches."
(self ==> aBlock / #any asParser) star parse: anObject!! !!
!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/25/2013 23:41''!!
matchingRangesIn: anObject do: aBlock
"Search anObject repeatedly for the matches of the receiver. Evaluate aBlock with the range of each match (index of first character to: index of last character)."
self token
matchesIn: anObject
do: [ :token | aBlock value: (token start to: token stop) ]!! !!
!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/8/2010 00:30''!!
matches: anObject
"Answer if anObject can be parsed by the receiver."
^ (self parse: anObject) isPetitFailure not!! !!
!!PPParser methodsFor: ''parsing'' stamp: ''lr 3/1/2010 21:51''!!
matchesIn: anObject do: aBlock
"Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Make sure to always consume exactly one character with each step, to not miss any match."
((self and ==> aBlock , #any asParser) / #any asParser) star parse: anObject!! !!
!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 5/31/2010 18:37''!!
matchList: matchList index: matchIndex against: parserList index: parserIndex inContext: aDictionary seen: aSet
| parser currentIndex currentDictionary currentSeen parsers |
matchList size < matchIndex
ifTrue: [ ^ parserList size < parserIndex ].
parser := matchList at: matchIndex.
parser class = PPListPattern ifTrue: [
currentIndex := parserIndex - 1.
[ currentDictionary := aDictionary copy.
currentSeen := aSet copy.
parserList size < currentIndex or: [
parsers := parserList copyFrom: parserIndex to: currentIndex.
(currentDictionary at: parser ifAbsentPut: [ parsers ]) = parsers and: [
(self
matchList: matchList
index: matchIndex + 1
against: parserList
index: currentIndex + 1
inContext: currentDictionary
seen: currentSeen)
ifTrue: [
currentDictionary keysAndValuesDo: [ :key :value | aDictionary at: key put: value ].
^ true ].
false ] ] ] whileFalse: [ currentIndex := currentIndex + 1 ].
^ false ].
parserList size < parserIndex
ifTrue: [ ^ false ].
(parser match: (parserList at: parserIndex) inContext: aDictionary seen: aSet)
ifFalse: [ ^ false ].
^ self
matchList: matchList
index: matchIndex + 1
against: parserList
index: parserIndex + 1
inContext: aDictionary
seen: aSet!! !!
!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 7/17/2011 11:53''!!
copyInContext: aDictionary seen: aSeenDictionary
| copy |
aSeenDictionary
at: self
ifPresent: [ :value | ^ value ].
copy := aSeenDictionary
at: self
put: self copy.
copy children do: [ :each |
copy
replace: each
with: (each copyInContext: aDictionary seen: aSeenDictionary) ].
^ copy!! !!
!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 07:49''!!
copyInContext: aDictionary
^ self copyInContext: aDictionary seen: IdentityDictionary new!! !!
!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/29/2010 23:07''!!
matchList: matchList against: parserList inContext: aDictionary seen: aSet
^ self matchList: matchList index: 1 against: parserList index: 1 inContext: aDictionary seen: aSet!! !!
!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
match: aParser inContext: aDictionary seen: anIdentitySet
"This is the default implementation to match two parsers. This code can properly handle recursion. This is code is supposed to be overridden in subclasses that add new state."
(self == aParser or: [ anIdentitySet includes: self ])
ifTrue: [ ^ true ].
anIdentitySet add: self.
^ self class = aParser class and: [ self matchList: self children against: aParser children inContext: aDictionary seen: anIdentitySet ]!! !!
!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/29/2010 23:14''!!
match: aParser inContext: aDictionary
^ self match: aParser inContext: aDictionary seen: IdentitySet new!! !!
!!PPParser methodsFor: ''testing'' stamp: ''lr 10/27/2008 11:28''!!
isUnresolved
^ false!! !!
!!PPParser methodsFor: ''testing'' stamp: ''lr 8/6/2010 16:44''!!
isPetitParser
^ true!! !!
!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
propertyAt: aKey ifAbsentPut: aBlock
"Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value."
^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !!
!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
removeProperty: aKey ifAbsent: aBlock
"Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock."
| answer |
properties isNil ifTrue: [ ^ aBlock value ].
answer := properties removeKey: aKey ifAbsent: aBlock.
properties isEmpty ifTrue: [ properties := nil ].
^ answer!! !!
!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
propertyAt: aKey
"Answer the property value associated with aKey."
^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
propertyAt: aKey ifAbsent: aBlock
"Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock."
^ properties isNil
ifTrue: [ aBlock value ]
ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !!
!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
propertyAt: aKey put: anObject
"Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
^ (properties ifNil: [ properties := Dictionary new: 1 ])
at: aKey put: anObject!! !!
!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
hasProperty: aKey
"Test if the property aKey is present."
^ properties notNil and: [ properties includesKey: aKey ]!! !!
!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
removeProperty: aKey
"Remove the property with aKey. Answer the property or raise an error if aKey isn''t found."
^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:41''!!
visualizationGraphType
^ nil!! !!
!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:26''!!
visualizeStructureInGraphOn: view
view shape rectangle
borderWidth: 1;
if: [ :p | p name isNil ] fillColor: Color lightGray.
view interaction
item: ''Explore'' action: #explore;
highlightWhenOver: [ :p |
self allParsers select: [ :ch | ch children includes: p ]
] color: Color orange muchLighter;
highlightWhenOver: [ :p | |children|
children := p namedChildren.
] color: Color orange muchDarker;
highlightWhenOver: [ :p | Array with: p ] color: Color orange;
popupText: [:p | p class name asString ].
view
nodes: self allParsers
forEach: [ :aParser | |labels|
labels := OrderedCollection new.
aParser name notNil ifTrue: [ labels add: aParser name ].
aParser visualizationGraphType notNil ifTrue: [ labels add: aParser visualizationGraphType ].
labels isEmpty ifFalse: [
view shape label.
view interaction forwarder.
view nodes: labels asArray ].
].
view shape: (ROLine new add: (ROArrow new size: 4) offset: 0.1).
view edgesToAll: #children.
view treeLayout
layered;
on: ROLayoutEnd do: [ :evt | ROFocusView on: (view raw elementFromModel: self) ].
view zoomInButton.
view zoomOutButton.!! !!
!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''tg 8/25/2010 00:32''!!
namedParsersDo: aBlock
self namedParsersDo: aBlock seen: IdentitySet new!! !!
!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''VincentBlondeau 2/14/2014 17:06''!!
viewAllNamedParsersWithSelection: aCollectionOfNames previewing: aBlock on: view
view shape label
color: [ :each |
(aCollectionOfNames includes: each name)
ifFalse: [ Color black ]
ifTrue: [ Color red ] ];
text: [ :each | each displayName ].
view interaction popupText: aBlock.
view interaction item: ''Explore'' action: #explore.
view nodes: (self allParsers reject: [ :each | each name isEmptyOrNil ]).
view edges: (self allParsers reject: [ :each | each name isEmptyOrNil ]) from: #yourself toAll: #namedParsers.
view horizontalDominanceTreeLayout
verticalGap: 10;
layered!! !!
!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:21''!!
visualizeStructureInGraph
"
PPSmalltalkParser new visualize
"
| view |
view := ROMondrianViewBuilder new.
self visualizeStructureInGraphOn: view.
view open.
^ view!! !!
!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''VincentBlondeau 2/14/2014 17:06''!!
viewAllNamedParsersOn: view
view shape
rectangleWithoutBorder;
withText: #displayName.
view nodes: (self allParsers reject: [ :each | each name isEmptyOrNil ]).
view edgesToAll: #namedParsers.
view horizontalDominanceTreeLayout layered!! !!
!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 12/6/2011 07:43''!!
viewAllNamedParsersWithSelection: aCollectionOfNames on: view
self viewAllNamedParsersWithSelection: aCollectionOfNames previewing: [ :each | each name ] on: view!! !!
!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 12/14/2011 12:40''!!
namedParsersDo: aBlock seen: aSet
self children do: [ :each |
(aSet includes: each)
ifFalse: [
aSet add: each.
each name isEmptyOrNil
ifFalse: [ aBlock value: each ]
ifTrue: [ each namedParsersDo: aBlock seen: aSet ] ] ]!! !!
!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 6/5/2013 23:01''!!
viewAllNamedParsers
| view |
view := ROMondrianViewBuilder new.
self viewAllNamedParsersOn: view.
^ view open setLabel: ''All named parsers''!! !!
!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''tg 8/25/2010 00:31''!!
namedParsers
| result |
result := OrderedCollection new.
self namedParsersDo: [ :parser | result addLast: parser ].
^ result!! !!
!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:36''!!
allParsers
"Answer all the parse nodes of the receiver."
| result |
result := OrderedCollection new.
self allParsersDo: [ :parser | result addLast: parser ].
^ result!! !!
!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:36''!!
allParsersDo: aBlock
"Iterate over all the parse nodes of the receiver."
self allParsersDo: aBlock seen: IdentitySet new!! !!
!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:35''!!
allParsersDo: aBlock seen: aSet
"Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."
(aSet includes: self)
ifTrue: [ ^ self ].
aSet add: self.
aBlock value: self.
self children
do: [ :each | each allParsersDo: aBlock seen: aSet ]!! !!
!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/19/2010 07:56''!!
separatedBy: aParser
"Answer a new parser that parses the receiver one or more times, separated by aParser."
^ (PPSequenceParser with: self with: (PPSequenceParser with: aParser with: self) star) ==> [ :nodes |
| result |
result := Array new: 2 * nodes second size + 1.
result at: 1 put: nodes first.
nodes second
keysAndValuesDo: [ :index :pair | result replaceFrom: 2 * index to: 2 * index + 1 with: pair startingAt: 1 ].
result ]!! !!
!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/19/2010 07:42''!!
delimitedBy: aParser
"Answer a new parser that parses the receiver one or more times, separated and possibly ended by aParser."
^ (self separatedBy: aParser) , (aParser optional) ==> [ :node |
node second isNil
ifTrue: [ node first ]
ifFalse: [ node first copyWith: node second ] ]!! !!
!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/25/2012 16:54''!!
withoutSeparators
"Filters out the separators from a parse result produced by one of the productions #delimitedBy: or #separatedBy:."
^ self ==> [ :items |
| result |
result := Array new: items size + 1 // 2.
1 to: result size do: [ :index | result at: index put: (items at: 2 * index - 1) ].
result ]!! !!
!!PPParser methodsFor: ''copying'' stamp: ''lr 4/19/2010 10:33''!!
postCopy
super postCopy.
properties := properties copy!! !!
!!PPParser methodsFor: ''initialization'' stamp: ''lr 4/24/2008 10:33''!!
initialize!! !!
!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 21:58''!!
newColumnMorph
^ AlignmentMorph newColumn
cellPositioning: #topLeft;
color: Color transparent;
listCentering: #topLeft;
vResizing: #shrinkWrap;
hResizing: #shrinkWrap;
layoutInset: 0;
yourself!! !!
!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 21:57''!!
newRowMorph
^ AlignmentMorph newRow
cellPositioning: #topLeft;
color: Color transparent;
listCentering: #topLeft;
vResizing: #shrinkWrap;
hResizing: #shrinkWrap;
layoutInset: 0;
yourself!! !!
!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 22:03''!!
newSpacerMorph
^ Morph new
color: Color transparent;
borderWidth: 0;
extent: 7 @ 7;
yourself!! !!
!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 9/16/2010 17:55''!!
followSets
"Answer a dictionary with all the parsers reachable from the receiver as key and their follow-set as value. The follow-set of a parser is the list of terminal parsers that can appear immediately to the right of that parser."
| current previous continue firstSets followSets |
current := previous := 0.
firstSets := self firstSets.
followSets := IdentityDictionary new.
self allParsersDo: [ :each | followSets at: each put: IdentitySet new ].
(followSets at: self) add: PPSentinel instance.
[ followSets keysAndValuesDo: [ :parser :follow |
parser
followSets: followSets
firstSets: firstSets
into: follow ].
current := followSets
inject: 0
into: [ :result :each | result + each size ].
continue := previous < current.
previous := current.
continue ] whileTrue.
^ followSets!! !!
!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 10/22/2009 19:59''!!
firstSet
"Answer the first-set of the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #firstSets to calculate the first-sets at once."
^ self firstSets at: self!! !!
!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 11/19/2009 23:49''!!
cycleSet
"Answer a set of all nodes that are within one or more cycles of left-recursion. This is generally not a problem if at least one of the nodes is memoized, but it might make the grammar very inefficient and should be avoided if possible."
| cycles |
cycles := IdentitySet new.
self cycleSet: OrderedCollection new firstSets: self firstSets into: cycles.
^ cycles!! !!
!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''JanKurs 5/31/2013 11:49''!!
firstSets
"Answer a dictionary with all the parsers reachable from the receiver as key and their first-set as value. The first-set of a parser is the list of terminal parsers that begin the parser derivable from that parser."
| firstSets |
firstSets := IdentityDictionary new.
self allParsersDo: [ :each |
firstSets at: each put: (each isFirstSetTerminal
ifTrue: [ IdentitySet with: each ]
ifFalse: [ IdentitySet new ]).
each isNullable
ifTrue: [ (firstSets at: each) add: PPSentinel instance ] ].
[ | changed tally |
changed := false.
firstSets keysAndValuesDo: [ :parser :first |
tally := first size.
parser firstSets: firstSets into: first.
changed := changed or: [ tally ~= first size ] ].
changed ] whileTrue.
^ firstSets!! !!
!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 11/12/2009 21:13''!!
followSet
"Answer the follow-set of the receiver starting at the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #followSets to calculate the follow-sets at once."
^ self followSets at: self!! !!
!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:30''!!
parseOn: aPPContext
"Parse aStream with the receiving parser and answer the parse-result or an instance of PPFailure. Override this method in subclasses to specify custom parse behavior. Do not call this method from outside, instead use #parse:."
self subclassResponsibility!! !!
!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/17/2014 13:15''!!
debugWithContext: aPPContext
^ self enableDebug parseWithContext: aPPContext !! !!
!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/11/2014 13:33''!!
updateContext: aPPContext
"nothing to do"!! !!
!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:26''!!
parse: anObject withContext: aPPContext
"Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
aPPContext stream: anObject asPetitStream.
^ self parseWithContext: aPPContext.
!! !!
!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:25''!!
parse: anObject
"Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
^ self parse: anObject withContext: PPContext new!! !!
!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/19/2014 16:34''!!
parseWithContext: context
context root: self.
self updateContext: context.
^ self parseOn: context!! !!
!!PPParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:38''!!
children
"Answer a set of child parsers that could follow the receiver."
^ #()!! !!
!!PPParser methodsFor: ''accessing'' stamp: ''lr 4/19/2010 10:38''!!
name: aString
self propertyAt: #name put: aString!! !!
!!PPParser methodsFor: ''accessing'' stamp: ''lr 4/19/2010 10:35''!!
name
"Answer the production name of the receiver."
^ self propertyAt: #name ifAbsent: [ nil ]!! !!
!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/19/2009 23:47''!!
cycleSet: aDictionary
"PRIVATE: Answer the children that could be part of a cycle-set with the receiver, subclasses might restrict the number of children returned. aDictionary is pre-calcualted first-sets."
^ self children!! !!
!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 5/22/2010 10:45''!!
cycleSet: aStack firstSets: aDictionary into: aSet
"PRIVATE: Try to find a cycle, where aStack contains the previously visited parsers. The method returns quickly when the receiver is a terminal, terminals cannot be part of a cycle. If aStack already contains the receiver, then we are in a cycle. In this case we don''t process the children further and add the nodes to aSet."
| index |
self isTerminal
ifTrue: [ ^ self ].
(index := aStack indexOf: self) > 0
ifTrue: [ ^ aSet addAll: (aStack copyFrom: index to: aStack size) ].
aStack addLast: self.
(self cycleSet: aDictionary)
do: [ :each | each cycleSet: aStack firstSets: aDictionary into: aSet ].
aStack removeLast!! !!
!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/12/2009 21:25''!!
firstSets: aFirstDictionary into: aSet
"PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."
self children do: [ :parser | aSet addAll: (aFirstDictionary at: parser) ]!! !!
!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/12/2009 21:25''!!
followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
"PRIVATE: Try to add additional elements to the follow-set aSet of the receiver, use the incomplete aFollowDictionary and the complete aFirstDictionary."
self children do: [ :parser | (aFollowDictionary at: parser) addAll: aSet ]!! !!
!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 1/16/2014 15:41''!!
debug: anObject
"Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
^ self enableDebug parse: anObject asPetitStream!! !!
!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 12:21''!!
enableDebuggerOutput
self debuggerOutput: true.!! !!
!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 4/22/2013 18:04''!!
debuggerOutput: aBoolean
self propertyAt: #debuggerOutput put: aBoolean!! !!
!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 12:21''!!
disableDebuggerOutput
self debuggerOutput: false. !! !!
!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 17:01''!!
enableDebug
| root newParser |
root := PPParserDebuggerResult new.
newParser := self transform: [:each |
each >=> [:stream :continuation |
| result child |
child := PPParserDebuggerResult new
parser: each;
parent: root.
root := root children add: child.
child start: stream position + 1.
child showChildren: each debuggerOutput.
result := continuation value.
child end: stream position.
root result: result.
root := root parent.
result
]
].
^ PPDebugParser on: newParser root: root.
!! !!
!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 4/22/2013 18:04''!!
debuggerOutput
^ self propertyAt: #debuggerOutput ifAbsentPut: true.!! !!
!!PPParser methodsFor: ''operators'' stamp: ''lr 2/19/2010 07:36''!!
negate
"Answer a new parser consumes any input token but the receiver."
^ self not , #any asParser ==> #second!! !!
!!PPParser methodsFor: ''operators'' stamp: ''lr 9/1/2010 22:03''!!
optional
"Answer a new parser that parses the receiver, if possible."
^ PPOptionalParser on: self!! !!
!!PPParser methodsFor: ''operators'' stamp: ''lr 12/3/2010 11:34''!!
def: aParser
"Redefine the receiver as the argument aParser. This method is useful when defining recursive parsers: instantiate a PPUnresolvedParser and later redefine it with another one."
^ self becomeForward: (aParser name: self name)!! !!
!!PPParser methodsFor: ''operators'' stamp: ''lr 10/23/2008 14:05''!!
wrapped
"Answer a new parser that is simply wrapped."
^ PPDelegateParser on: self!! !!
!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 16:34''!!
memoized
"Answer a new memoized parser, for refraining redundant computations. This ensures polynomial time O(n^4) for left-recursive grammars and O(n^3) for non left-recursive grammars in the worst case. Not necessary for most grammars that are carefully written and in O(n) anyway."
^ PPMemoizedParser on: self!! !!
!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 15:12''!!
and
"Answer a new parser (logical and-predicate) that succeeds whenever the receiver does, but never consumes input."
^ PPAndParser on: self!! !!
!!PPParser methodsFor: ''operators'' stamp: ''lr 4/14/2010 11:46''!!
/ aParser
"Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice)."
^ PPChoiceParser with: self with: aParser!! !!
!!PPParser methodsFor: ''operators'' stamp: ''lr 4/30/2010 12:13''!!
end
"Answer a new parser that succeeds at the end of the input and return the result of the receiver."
^ PPEndOfInputParser on: self!! !!
!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 15:12''!!
not
"Answer a new parser (logical not-predicate) that succeeds whenever the receiver fails, but never consumes input."
^ PPNotParser on: self!! !!
!!PPParser methodsFor: ''operators'' stamp: ''lr 4/14/2010 11:53''!!
| aParser
"Answer a new parser that either parses the receiver or aParser. Fail if both pass or fail (exclusive choice, unordered choice)."
^ (self not , aParser) / (aParser not , self) ==> #second!! !!
!!PPParser methodsFor: ''operators'' stamp: ''lr 9/23/2008 18:32''!!
, aParser
"Answer a new parser that parses the receiver followed by aParser."
^ PPSequenceParser with: self with: aParser!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPParser class
instanceVariableNames: ''''!!
!!PPParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPParser class methodsFor: ''instance creation'' stamp: ''lr 10/27/2008 11:17''!!
named: aString
^ self new name: aString!! !!
!!PPParser class methodsFor: ''instance creation'' stamp: ''lr 4/18/2008 14:00''!!
new
^ self basicNew initialize!! !!
PPParser subclass: #PPPluggableParser
instanceVariableNames: ''block''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPPluggableParser commentStamp: ''<historical>'' prior: 0!!
A pluggable parser that passes the parser stream into a block. This enables users to perform manual parsing or to embed other parser frameworks into PetitParser.
Instance Variables:
block <BlockClosure> The pluggable one-argument block.
!!
!!PPPluggableParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
match: aParser inContext: aDictionary seen: anIdentitySet
^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]!! !!
!!PPPluggableParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 16:52''!!
initializeOn: aBlock
block := aBlock!! !!
!!PPPluggableParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:42''!!
parseOn: aPPContext
| position result |
position := aPPContext remember.
result := block value: aPPContext.
result isPetitFailure
ifTrue: [ aPPContext restore: position ].
^ result!! !!
!!PPPluggableParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:41''!!
displayName
^ String streamContents: [ :stream | block decompile shortPrintOn: stream ]!! !!
!!PPPluggableParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
block
"Answer the pluggable block."
^ block!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPPluggableParser class
instanceVariableNames: ''''!!
!!PPPluggableParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPPluggableParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 16:52''!!
on: aBlock
^ self new initializeOn: aBlock!! !!
PPParser subclass: #PPFailingParser
instanceVariableNames: ''message''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPFailingParser commentStamp: ''<historical>'' prior: 0!!
A parser that consumes nothing and always fails.
Instance Variables:
message <String> The failure message.!!
!!PPFailingParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 19:16''!!
setMessage: aString
message := aString!! !!
!!PPFailingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:59''!!
parseOn: aPPContext
^ PPFailure message: message context: aPPContext!! !!
!!PPFailingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:43''!!
displayName
^ message!! !!
!!PPFailingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:16''!!
displayColor
^ Color red!! !!
!!PPFailingParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 21:27''!!
printNameOn: aStream
super printNameOn: aStream.
aStream nextPutAll: '', ''; print: message!! !!
!!PPFailingParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 12:01''!!
match: aParser inContext: aDictionary seen: anIdentitySet
^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self message = aParser message ]!! !!
!!PPFailingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
message
"Answer the error message of the receiving parser."
^ message!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPFailingParser class
instanceVariableNames: ''''!!
!!PPFailingParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPFailingParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 19:16''!!
message: aString
^ self new setMessage: aString!! !!
PPParser subclass: #PPLiteralParser
instanceVariableNames: ''literal message''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPLiteralParser commentStamp: ''<historical>'' prior: 0!!
Abstract literal parser that parses some kind of literal type (to be specified by subclasses).
Instance Variables:
literal <Object> The literal object to be parsed.
message <String> The error message to be generated.
!!
!!PPLiteralParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 9/15/2010 12:08''!!
match: aParser inContext: aDictionary seen: anIdentitySet
^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self literal = aParser literal and: [ self message = aParser message ] ]!! !!
!!PPLiteralParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:25''!!
visualizationGraphType
^ literal printString!! !!
!!PPLiteralParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:19''!!
displayName
^ literal printString!! !!
!!PPLiteralParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:26''!!
message
"Answer the failure message."
^ message!! !!
!!PPLiteralParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:26''!!
literal
"Answer the parsed literal."
^ literal!! !!
!!PPLiteralParser methodsFor: ''operators'' stamp: ''lr 6/1/2010 22:24''!!
caseInsensitive
"Answer a parser that can parse the receiver case-insensitive."
self subclassResponsibility!! !!
!!PPLiteralParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 13:25''!!
initializeOn: anObject message: aString
literal := anObject.
message := aString!! !!
!!PPLiteralParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:38''!!
printNameOn: aStream
super printNameOn: aStream.
aStream nextPutAll: '', ''; print: literal!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPLiteralParser class
instanceVariableNames: ''''!!
!!PPLiteralParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPLiteralParser class methodsFor: ''instance creation'' stamp: ''lr 1/7/2010 15:29''!!
on: anObject message: aString
^ self new initializeOn: anObject message: aString!! !!
!!PPLiteralParser class methodsFor: ''instance creation'' stamp: ''lr 1/7/2010 15:30''!!
on: anObject
^ self on: anObject message: anObject printString , '' expected''!! !!
PPLiteralParser subclass: #PPLiteralObjectParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPLiteralObjectParser commentStamp: ''<historical>'' prior: 0!!
A parser that accepts a single literal object, such as a character. This is the same as the predicate parser ''PPPredicateParser expect: literal'' but slightly more efficient.!!
!!PPLiteralObjectParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:25''!!
exampleOn: aStream
aStream nextPut: literal!! !!
!!PPLiteralObjectParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
parseOn: aPPContext
^ (aPPContext stream atEnd not and: [ literal = aPPContext stream uncheckedPeek ])
ifFalse: [ PPFailure message: message context: aPPContext ]
ifTrue: [ aPPContext stream next ]!! !!
!!PPLiteralObjectParser methodsFor: ''operators'' stamp: ''lr 8/18/2010 20:16''!!
caseInsensitive
"Answer a parser that can parse the receiver case-insensitive."
literal asUppercase = literal asLowercase ifTrue: [ ^ self ].
^ PPPredicateObjectParser on: [ :value | literal sameAs: value ] message: message!! !!
!!PPLiteralObjectParser methodsFor: ''operators'' stamp: ''lr 4/28/2011 20:02''!!
negate
^ (PPPredicateObjectParser expect: literal message: message) negate!! !!
PPParser subclass: #PPPredicateParser
instanceVariableNames: ''predicate predicateMessage negated negatedMessage''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPPredicateParser commentStamp: ''<historical>'' prior: 0!!
An abstract parser that accepts if a given predicate holds.
Instance Variables:
predicate <BlockClosure> The block testing for the predicate.
predicateMessage <String> The error message of the predicate.
negated <BlockClosure> The block testing for the negation of the predicate.
negatedMessage <String> The error message of the negated predicate.!!
!!PPPredicateParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 9/15/2010 11:56''!!
match: aParser inContext: aDictionary seen: anIdentitySet
^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block and: [ self message = aParser message ] ]!! !!
!!PPPredicateParser methodsFor: ''printing'' stamp: ''lr 5/2/2010 13:37''!!
printNameOn: aStream
super printNameOn: aStream.
aStream nextPutAll: '', ''; print: predicateMessage!! !!
!!PPPredicateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/1/2010 17:05''!!
exampleOn: aStream
"Produce a random character that is valid. If there are characters in the alpha-numeric range prefer those over all others."
| valid normal |
valid := Character allCharacters
select: [ :char | self matches: (String with: char) ].
normal := valid
select: [ :char | char asInteger < 127 and: [ char isAlphaNumeric ] ].
aStream nextPut: (normal isEmpty
ifTrue: [ valid atRandom ]
ifFalse: [ normal atRandom ])!! !!
!!PPPredicateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/2/2010 19:35''!!
displayName
^ predicateMessage!! !!
!!PPPredicateParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:36''!!
message
"Answer the failure message."
^ predicateMessage!! !!
!!PPPredicateParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:36''!!
block
"Answer the predicate block of the receiver."
^ predicate!! !!
PPPredicateParser subclass: #PPPredicateObjectParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPPredicateObjectParser commentStamp: ''<historical>'' prior: 0!!
A parser that accepts if a given predicate on one element of the input sequence holds.!!
!!PPPredicateObjectParser methodsFor: ''operators'' stamp: ''lr 6/12/2010 09:12''!!
negate
"Answer a parser that is the negation of the receiving predicate parser."
^ self class
on: negated message: negatedMessage
negated: predicate message: predicateMessage!! !!
!!PPPredicateObjectParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:03''!!
parseOn: aPPContext
^ (aPPContext stream atEnd not and: [ predicate value: aPPContext stream uncheckedPeek ])
ifFalse: [ PPFailure message: predicateMessage context: aPPContext ]
ifTrue: [ aPPContext stream next ]!! !!
!!PPPredicateObjectParser methodsFor: ''initialization'' stamp: ''lr 6/12/2010 09:12''!!
initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString
predicate := aBlock.
predicateMessage := aString.
negated := aNegatedBlock.
negatedMessage := aNegatedString!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPPredicateObjectParser class
instanceVariableNames: ''''!!
!!PPPredicateObjectParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPPredicateObjectParser class methodsFor: ''*petitregex-chars'' stamp: ''lr 8/30/2010 14:48''!!
control
^ self chars: ((0 to: 31) collect: [ :each | Character value: each ]) message: ''control character expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 8/25/2010 10:57''!!
expect: anObject
^ self expect: anObject message: anObject printString , '' expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 4/1/2011 20:05''!!
anyExceptAnyOf: aCollection
^ self
on: [ :each | (aCollection includes: each) not ] message: ''any except '' , aCollection printString , '' expected''
negated: [ :each | aCollection includes: each ] message: aCollection printString , '' not expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 4/1/2011 20:05''!!
anyOf: aCollection
^ self
on: [ :each | aCollection includes: each ] message: ''any of '' , aCollection printString , '' expected''
negated: [ :each | (aCollection includes: each) not ] message: ''none of '' , aCollection printString , ''expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 6/12/2010 09:10''!!
any
^ self
on: [ :each | true ] message: ''input expected''
negated: [ :each | false ] message: ''no input expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 6/12/2010 09:10''!!
between: min and: max
^ self
on: [ :each | each >= min and: [ each <= max ] ] message: min printString , ''..'' , max printString , '' expected''
negated: [ :each | each < min or: [ each > max ] ] message: min printString , ''..'' , max printString , '' not expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 8/25/2010 10:57''!!
expect: anObject message: aString
^ self
on: [ :each | each = anObject ] message: aString
negated: [ :each | each ~= anObject ] message: ''no '' , aString!! !!
!!PPPredicateObjectParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:10''!!
on: aBlock message: aString
^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: ''no '' , aString!! !!
!!PPPredicateObjectParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:10''!!
on: aBlock message: aString negated: aNegatedBlock message: aNegatedString
^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
char: aCharacter
^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , '' expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
punctuation
^ self chars: ''.,"''''?!!!!;:#$%&()*+-/<>=@[]\^_{}|~'' message: ''punctuation expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
blank
^ self chars: (String with: Character space with: Character tab) message: ''blank expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
hex
^ self
on: (PPCharSetPredicate on: [ :char |
(char between: $0 and: $9)
or: [ (char between: $a and: $f)
or: [ (char between: $A and: $F) ] ] ])
message: ''hex digit expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
newline
^ self chars: (String with: Character cr with: Character lf) message: ''newline expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
word
^ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: ''letter or digit expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 6/12/2010 09:10''!!
lf
^ self char: Character lf!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
digit
^ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: ''digit expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:05''!!
letter
^ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: ''letter expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
uppercase
^ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: ''uppercase letter expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
cr
^ self char: Character cr message: ''carriage return expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
space
^ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: ''separator expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
lowercase
^ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: ''lowercase letter expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
tab
^ self char: Character tab message: ''tab expected''!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
chars: aCollection message: aString
^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString!! !!
!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 10:57''!!
char: aCharacter message: aString
^ self expect: aCharacter message: aString!! !!
PPPredicateParser subclass: #PPPredicateSequenceParser
instanceVariableNames: ''size''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPPredicateSequenceParser commentStamp: ''<historical>'' prior: 0!!
A parser that accepts if a given predicate on an arbitrary number of elements of the input sequence holds.
Instance Variables:
size <Integer> The number of elements to consume.!!
!!PPPredicateSequenceParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
match: aParser inContext: aDictionary seen: anIdentitySet
^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self size = aParser size ]!! !!
!!PPPredicateSequenceParser methodsFor: ''operators'' stamp: ''lr 6/12/2010 09:14''!!
negate
"Answer a parser that is the negation of the receiving predicate parser."
^ self class
on: negated message: negatedMessage
negated: predicate message: predicateMessage
size: size!! !!
!!PPPredicateSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:03''!!
parseOn: aPPContext
| position result |
position := aPPContext remember.
result := aPPContext stream next: size.
(result size = size and: [ predicate value: result ])
ifTrue: [ ^ result ].
aPPContext restore: position.
^ PPFailure message: predicateMessage context: aPPContext!! !!
!!PPPredicateSequenceParser methodsFor: ''accessing'' stamp: ''lr 6/12/2010 08:58''!!
size
"Answer the sequence size of the receiver."
^ size!! !!
!!PPPredicateSequenceParser methodsFor: ''initialization'' stamp: ''lr 6/12/2010 09:13''!!
initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
predicate := aBlock.
predicateMessage := aString.
negated := aNegatedBlock.
negatedMessage := aNegatedString.
size := anInteger !! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPPredicateSequenceParser class
instanceVariableNames: ''''!!
!!PPPredicateSequenceParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPPredicateSequenceParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:14''!!
on: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger!! !!
!!PPPredicateSequenceParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:14''!!
on: aBlock message: aString size: anInteger
^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: ''no '' , aString size: anInteger !! !!
PPParser subclass: #PPDelegateParser
instanceVariableNames: ''parser''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPDelegateParser commentStamp: ''<historical>'' prior: 0!!
A parser that delegates to another parser.
Instance Variables:
parser <PPParser> The parser to delegate to.!!
!!PPDelegateParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:37''!!
children
^ Array with: parser!! !!
!!PPDelegateParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/13/2010 09:39''!!
replace: aParser with: anotherParser
super replace: aParser with: anotherParser.
parser == aParser ifTrue: [ parser := anotherParser ]!! !!
!!PPDelegateParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
parseOn: aPPContext
^ parser parseOn: aPPContext!! !!
!!PPDelegateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:27''!!
exampleOn: aStream
parser exampleOn: aStream!! !!
!!PPDelegateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:20''!!
displayDescription
^ nil!! !!
!!PPDelegateParser methodsFor: ''initialization'' stamp: ''lr 4/20/2008 16:23''!!
setParser: aParser
parser := aParser!! !!
!!PPDelegateParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:21''!!
morphicShapeSeen: aSet depth: anInteger
^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
self displayDescription isNil
ifTrue: [ cc value: parser ]
ifFalse: [
self newRowMorph
addMorphBack: (self newColumnMorph
addMorphBack: (self newSpacerMorph height: 10);
addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
yourself);
addMorphBack: (self newRowMorph
color: (self backgroundForDepth: anInteger);
addMorphBack: (self newColumnMorph
addMorphBack: (cc value: parser);
addMorphBack: (self newRowMorph
hResizing: #spaceFill;
addMorphBack: (self newSpacerMorph
width: 20;
yourself);
addMorphBack: (self newColumnMorph
hResizing: #spaceFill;
listCentering: #center;
addMorphBack: (self newSpacerMorph);
addMorphBack: (StringMorph new
contents: self displayDescription;
yourself);
yourself);
yourself);
yourself);
addMorphBack: (self newColumnMorph
addMorphBack: (self newSpacerMorph height: 10);
addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
yourself);
yourself);
yourself ] ]!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPDelegateParser class
instanceVariableNames: ''''!!
!!PPDelegateParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPDelegateParser class methodsFor: ''instance creation'' stamp: ''lr 4/20/2008 16:22''!!
on: aParser
^ self new setParser: aParser!! !!
PPDelegateParser subclass: #PPAndParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPAndParser commentStamp: ''TudorGirba 2/27/2011 22:22'' prior: 0!!
The and-predicate, a parser that succeeds whenever its delegate does, but does not consume the input stream [Parr 1994, 1995].!!
!!PPAndParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/1/2010 16:16''!!
exampleOn: aStream!! !!
!!PPAndParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:17''!!
displayDescription
^ ''and''!! !!
!!PPAndParser methodsFor: ''operators'' stamp: ''lr 5/1/2010 16:16''!!
and
^ self!! !!
!!PPAndParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:50''!!
parseOn: aPPContext
| element position |
position := aPPContext remember.
element := parser parseOn: aPPContext.
aPPContext restore: position.
^ element!! !!
PPDelegateParser subclass: #PPTrimmingParser
instanceVariableNames: ''trimmer''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPTrimmingParser commentStamp: ''lr 4/6/2010 19:27'' prior: 0!!
A parser that silently consumes spaces before and after the delegate parser.!!
!!PPTrimmingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 4/14/2010 20:48''!!
exampleOn: aStream
super exampleOn: aStream.
aStream nextPut: Character space!! !!
!!PPTrimmingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:42''!!
parseOn: aPPContext
| position element |
position := aPPContext remember.
[ (trimmer parseOn: aPPContext) isPetitFailure ]
whileFalse.
element := parser parseOn: aPPContext.
element isPetitFailure ifTrue: [
aPPContext restore: position.
^ element ].
[ (trimmer parseOn: aPPContext) isPetitFailure ]
whileFalse.
^ element!! !!
!!PPTrimmingParser methodsFor: ''initialization'' stamp: ''lr 7/31/2010 12:00''!!
setTrimmer: aParser
trimmer := aParser!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPTrimmingParser class
instanceVariableNames: ''''!!
!!PPTrimmingParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPTrimmingParser class methodsFor: ''instance creation'' stamp: ''lr 7/31/2010 12:01''!!
on: aParser trimmer: aTrimParser
^ self new
setParser: aParser;
setTrimmer: aTrimParser;
yourself!! !!
PPDelegateParser subclass: #PPMemoizedParser
instanceVariableNames: ''buffer context''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPMemoizedParser commentStamp: ''<historical>'' prior: 0!!
A memoized parser, for refraining redundant computations.
Instance Variables:
stream <PositionableStream> The stream of the associated memento objects.
buffer <Array of: PPMemento> The buffer of memento objects.
!!
!!PPMemoizedParser methodsFor: ''operators'' stamp: ''lr 4/2/2009 19:48''!!
memoized
"Ther is no point in memoizing more than once."
^ self!! !!
!!PPMemoizedParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:20''!!
reset: aPPContext
context := aPPContext.
buffer := Dictionary new.!! !!
!!PPMemoizedParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
parseOn: aPPContext
| memento contextMemento aStream |
"TODO: JK memoizing needs review!!!!"
contextMemento := aPPContext remember.
context == aPPContext
ifFalse: [ self reset: aPPContext ].
memento := (buffer at: contextMemento ifAbsentPut: [ PPMemento new ]).
memento contextMemento isNil
ifTrue: [
aStream := aPPContext stream.
memento result: (aStream size - aStream position + 2 < memento count
ifTrue: [ PPFailure message: ''overflow'' context: aPPContext ]
ifFalse: [ memento increment. parser parseOn: aPPContext ]).
memento contextMemento: aPPContext remember ]
ifFalse: [ context restore: memento contextMemento ].
^ memento result.!! !!
PPDelegateParser subclass: #PPEndOfInputParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPEndOfInputParser commentStamp: ''lr 4/18/2008 13:46'' prior: 0!!
A parser that succeeds only at the end of the input stream.!!
!!PPEndOfInputParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:58''!!
parseOn: aPPContext
| position result |
position := aPPContext remember.
result := parser parseOn: aPPContext.
(result isPetitFailure or: [ aPPContext stream atEnd ])
ifTrue: [ ^ result ].
result := PPFailure
message: ''end of input expected''
context: aPPContext.
aPPContext restore: position.
^ result!! !!
!!PPEndOfInputParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:18''!!
displayDescription
^ ''end of input''!! !!
!!PPEndOfInputParser methodsFor: ''operators'' stamp: ''lr 12/7/2009 08:53''!!
end
^ self!! !!
PPDelegateParser subclass: #PPActionParser
instanceVariableNames: ''block''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPActionParser commentStamp: ''<historical>'' prior: 0!!
A parser that performs an action block with the successful parse result of the delegate.
Instance Variables:
block <BlockClosure> The action block to be executed.
!!
!!PPActionParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 16:58''!!
setBlock: aBlock
block := aBlock!! !!
!!PPActionParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:41''!!
visualizationGraphType
^ ''[]''!! !!
!!PPActionParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
parseOn: aPPContext
| element |
^ (element := parser parseOn: aPPContext) isPetitFailure
ifFalse: [ block value: element ]
ifTrue: [ element ]!! !!
!!PPActionParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
block
"Answer the action block of the receiver."
^ block!! !!
!!PPActionParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 5/7/2011 15:08''!!
match: aParser inContext: aDictionary seen: anIdentitySet
^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPActionParser class
instanceVariableNames: ''''!!
!!PPActionParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPActionParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 16:58''!!
on: aParser block: aBlock
^ (self on: aParser) setBlock: aBlock!! !!
PPActionParser subclass: #PPWrappingParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPWrappingParser commentStamp: ''<historical>'' prior: 0!!
A parser that performs an action block upon activation with the stream and a continuation block.!!
!!PPWrappingParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
parseOn: aPPContext
^ block value: aPPContext value: [ parser parseOn: aPPContext ]!! !!
PPParser subclass: #PPListParser
instanceVariableNames: ''parsers''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPListParser commentStamp: ''<historical>'' prior: 0!!
Abstract parser that parses a list of things in some way (to be specified by the subclasses).
Instance Variables:
parsers <SequenceableCollection of: PPParser> A sequence of other parsers to delegate to.!!
!!PPListParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 08:15''!!
copyInContext: aDictionary seen: aSeenDictionary
| copy copies |
aSeenDictionary at: self ifPresent: [ :value | ^ value ].
copy := aSeenDictionary at: self put: self copy.
copies := OrderedCollection new.
parsers do: [ :each |
| result |
result := each
copyInContext: aDictionary
seen: aSeenDictionary.
result isCollection
ifTrue: [ copies addAll: result ]
ifFalse: [ copies add: result ] ].
^ copy
setParsers: copies;
yourself!! !!
!!PPListParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 5/22/2010 10:24''!!
replace: aParser with: anotherParser
super replace: aParser with: anotherParser.
parsers keysAndValuesDo: [ :index :parser |
parser == aParser
ifTrue: [ parsers at: index put: anotherParser ] ]!! !!
!!PPListParser methodsFor: ''initialization'' stamp: ''lr 4/29/2010 10:12''!!
setParsers: aCollection
parsers := aCollection asArray!! !!
!!PPListParser methodsFor: ''initialization'' stamp: ''lr 4/29/2010 10:12''!!
initialize
super initialize.
self setParsers: #()!! !!
!!PPListParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:37''!!
children
^ parsers!! !!
!!PPListParser methodsFor: ''copying'' stamp: ''lr 9/17/2008 22:36''!!
copyWith: aParser
^ self species withAll: (parsers copyWith: aParser)!! !!
!!PPListParser methodsFor: ''copying'' stamp: ''lr 5/22/2010 10:26''!!
postCopy
super postCopy.
parsers := parsers copy!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPListParser class
instanceVariableNames: ''''!!
!!PPListParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 9/23/2008 18:32''!!
with: aFirstParser with: aSecondParser
^ self withAll: (Array with: aFirstParser with: aSecondParser)!! !!
!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 5/3/2010 20:26''!!
with: aParser
^ self withAll: (Array with: aParser)!! !!
!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 4/29/2010 10:12''!!
withAll: aCollection
^ self basicNew setParsers: aCollection!! !!
PPListParser subclass: #PPChoiceParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPChoiceParser commentStamp: ''lr 4/18/2008 15:35'' prior: 0!!
A parser that uses the first parser that succeeds.!!
!!PPChoiceParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:42''!!
visualizationGraphType
^ ''/''!! !!
!!PPChoiceParser methodsFor: ''operators'' stamp: ''lr 9/17/2008 00:16''!!
/ aRule
^ self copyWith: aRule!! !!
!!PPChoiceParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
parseOn: aPPContext
"This is optimized code that avoids unnecessary block activations, do not change. When all choices fail, the last failure is answered."
| element |
1 to: parsers size do: [ :index |
element := (parsers at: index)
parseOn: aPPContext.
element isPetitFailure
ifFalse: [ ^ element ] ].
^ element!! !!
!!PPChoiceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 5/2/2010 20:15''!!
exampleOn: aStream
"If there is already a lot written, try to pick an empty possiblity."
aStream position > 512 ifTrue: [
(parsers anySatisfy: [ :each | each isNullable ])
ifTrue: [ ^ self ] ].
parsers atRandom exampleOn: aStream!! !!
!!PPChoiceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:14''!!
morphicShapeSeen: aSet depth: anInteger
^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
| morph |
morph := self newColumnMorph
cellInset: 5;
yourself.
self children do: [ :each |
morph addMorphBack: (self newRowMorph
hResizing: #spaceFill;
addMorphBack: (cc value: each);
addMorphBack: (self newColumnMorph
hResizing: #spaceFill;
addMorphBack: (self newSpacerMorph height: 10);
addMorphBack: ((LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
hResizing: #spaceFill;
minWidth: 20;
yourself);
yourself);
yourself) ].
morph fullBounds.
self newRowMorph
addMorphBack: (self newColumnMorph
addMorphBack: (self newSpacerMorph height: 10);
addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
yourself);
addMorphBack: (self newColumnMorph
addMorphBack: (self newSpacerMorph width: 1; height: 10);
addMorphBack: (LineMorph from: 0 @ 0 to: 0 @ (morph height - 23) color: Color black width: 1);
yourself);
addMorphBack: morph;
addMorphBack: (self newColumnMorph
addMorphBack: (self newSpacerMorph width: 1; height: 10);
addMorphBack: (LineMorph from: 0 @ (morph height - 23) to: 0 @ 0 color: Color black width: 1)
makeForwardArrow;
width: 1;
yourself);
yourself ]!! !!
PPDelegateParser subclass: #PPNotParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPNotParser commentStamp: ''<historical>'' prior: 0!!
The not-predicate, a parser that succeeds whenever its delegate does not, but consumes no input [Parr 1994, 1995].!!
!!PPNotParser methodsFor: ''*petitanalyzer-testing'' stamp: ''JanKurs 5/31/2013 11:50''!!
isFirstSetTerminal
^ true!! !!
!!PPNotParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:01''!!
parseOn: aPPContext
| element position |
position := aPPContext remember.
element := parser parseOn: aPPContext.
aPPContext restore: position.
^ element isPetitFailure
ifFalse: [ PPFailure message: '''' context: aPPContext ]!! !!
!!PPNotParser methodsFor: ''*petitanalyzer-private'' stamp: ''JanKurs 5/31/2013 11:50''!!
firstSets: aFirstDictionary into: aSet
!! !!
!!PPNotParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/11/2009 21:09''!!
exampleOn: aStream!! !!
!!PPNotParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:17''!!
displayDescription
^ ''not''!! !!
PPLiteralParser subclass: #PPLiteralSequenceParser
instanceVariableNames: ''size''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPLiteralSequenceParser commentStamp: ''lr 12/4/2009 18:39'' prior: 0!!
A parser accepts a sequence of literal objects, such as a String. This is an optimization to avoid having to compose longer sequences from PPSequenceParser.!!
!!PPLiteralSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:38''!!
parseOn: aPPContext
| memento result |
memento := aPPContext remember.
result := aPPContext stream next: size.
literal = result ifTrue: [ ^ result ].
aPPContext restore: memento.
^ PPFailure message: message context: aPPContext!! !!
!!PPLiteralSequenceParser methodsFor: ''initialization'' stamp: ''lr 6/1/2010 22:21''!!
initializeOn: anObject message: aString
super initializeOn: anObject message: aString.
size := literal size!! !!
!!PPLiteralSequenceParser methodsFor: ''accessing'' stamp: ''lr 9/15/2010 11:16''!!
size
"Answer the sequence size of the receiver."
^ size!! !!
!!PPLiteralSequenceParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:25''!!
exampleOn: aStream
aStream nextPutAll: literal!! !!
!!PPLiteralSequenceParser methodsFor: ''operators'' stamp: ''lr 8/18/2010 20:16''!!
caseInsensitive
"Answer a parser that can parse the receiver case-insensitive."
literal asUppercase = literal asLowercase ifTrue: [ ^ self ].
^ PPPredicateSequenceParser on: [ :value | literal sameAs: value ] message: message size: size!! !!
PPDelegateParser subclass: #PPOptionalParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPOptionalParser commentStamp: ''lr 4/3/2011 14:46'' prior: 0!!
A parser that optionally parsers its delegate, or answers nil.!!
!!PPOptionalParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 9/1/2010 22:10''!!
isNullable
^ true!! !!
!!PPOptionalParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
visualizationGraphType
^ ''?''!! !!
!!PPOptionalParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/19/2014 15:12''!!
parseOn: aPPContext
| element |
element := parser parseOn: aPPContext.
^ element isPetitFailure ifFalse: [ element ]!! !!
PPDelegateParser subclass: #PPFlattenParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPFlattenParser commentStamp: ''lr 11/22/2009 13:09'' prior: 0!!
A parser that answers a flat copy of the range my delegate parses.!!
!!PPFlattenParser methodsFor: ''private'' stamp: ''lr 2/25/2013 23:31''!!
on: aCollection start: aStartInteger stop: aStopInteger value: anObject
^ aCollection copyFrom: aStartInteger to: aStopInteger!! !!
!!PPFlattenParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:42''!!
parseOn: aPPContext
| start element |
start := aPPContext stream position.
element := parser parseOn: aPPContext.
element isPetitFailure ifTrue: [ ^ element ].
^ self on: aPPContext stream collection start: start + 1 stop: aPPContext stream position value: element!! !!
PPFlattenParser subclass: #PPTokenParser
instanceVariableNames: ''tokenClass''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPTokenParser commentStamp: ''lr 2/25/2013 23:31'' prior: 0!!
A parser that answers a token with the value of my delegate parses.
Instance Variables:
tokenClass <PPToken class> The token sub-class to be used.!!
!!PPTokenParser methodsFor: ''private'' stamp: ''lr 4/6/2010 19:18''!!
defaultTokenClass
^ PPToken!! !!
!!PPTokenParser methodsFor: ''private'' stamp: ''lr 2/25/2013 23:32''!!
on: aCollection start: aStartInteger stop: aStopInteger value: anObject
^ self tokenClass on: aCollection start: aStartInteger stop: aStopInteger value: anObject!! !!
!!PPTokenParser methodsFor: ''initialization'' stamp: ''lr 4/6/2010 19:19''!!
initialize
tokenClass := self defaultTokenClass
!! !!
!!PPTokenParser methodsFor: ''accessing'' stamp: ''lr 4/6/2010 19:23''!!
tokenClass
^ tokenClass!! !!
!!PPTokenParser methodsFor: ''accessing'' stamp: ''lr 4/6/2010 19:24''!!
tokenClass: aTokenClass
tokenClass := aTokenClass!! !!
!!PPTokenParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
match: aParser inContext: aDictionary seen: anIdentitySet
^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self tokenClass = aParser tokenClass ]!! !!
PPDelegateParser subclass: #PPRepeatingParser
instanceVariableNames: ''min max''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPRepeatingParser commentStamp: ''lr 4/3/2011 14:45'' prior: 0!!
An abstract parser that repeatedly parses between ''min'' and ''max'' instances of its delegate. The default configuration parses an infinite number of elements, as ''min'' is set to 0 and ''max'' to infinity (SmallInteger maxVal).
Instance Variables:
min <Integer> The minimum number of repetitions.
max <Integer> The maximum number of repetitions.!!
!!PPRepeatingParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
match: aParser inContext: aDictionary seen: anIdentitySet
^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self min = aParser min and: [ self max = aParser max ] ]!! !!
!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:00''!!
setMax: anInteger
max := anInteger!! !!
!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:01''!!
setMin: anInteger
min := anInteger!! !!
!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:06''!!
initialize
super initialize.
self setMin: 0; setMax: SmallInteger maxVal!! !!
!!PPRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:08''!!
max
"Answer the maximum number of repetitions."
^ max!! !!
!!PPRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:08''!!
min
"Answer the minimum number of repetitions."
^ min!! !!
!!PPRepeatingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/11/2009 20:57''!!
exampleOn: aStream
"Perform the minimal repeatitions required, and a random amount of more if possible and if not that much output has been produced yet."
min timesRepeat: [
super exampleOn: aStream ].
(max - min min: 5) atRandom timesRepeat: [
aStream position > 512
ifTrue: [ ^ self ].
super exampleOn: aStream ]!! !!
!!PPRepeatingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:18''!!
displayDescription
^ String streamContents: [ :stream |
min = 0
ifFalse: [ stream print: min; nextPutAll: ''..'' ].
max = SmallInteger maxVal
ifTrue: [ stream nextPut: $* ]
ifFalse: [ stream print: max ] ]!! !!
!!PPRepeatingParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 10/21/2009 12:13''!!
isNullable
^ min = 0!! !!
!!PPRepeatingParser methodsFor: ''*petitanalyzer-private'' stamp: ''JanKurs 5/31/2013 11:51''!!
followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
| firstSet |
super followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet.
firstSet := aFirstDictionary at: self.
self children do: [:p | (aFollowDictionary at: p) addAll: (firstSet reject: [:each | each isNullable]) ]!! !!
!!PPRepeatingParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
visualizationGraphType
^ ''*''!! !!
!!PPRepeatingParser methodsFor: ''printing'' stamp: ''lr 6/3/2010 14:00''!!
printOn: aStream
super printOn: aStream.
aStream nextPutAll: '' [''; print: min; nextPutAll: '', ''; nextPutAll: (max = SmallInteger maxVal
ifTrue: [ ''*'' ] ifFalse: [ max printString ]); nextPut: $]!! !!
PPRepeatingParser subclass: #PPPossessiveRepeatingParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPPossessiveRepeatingParser commentStamp: ''lr 4/3/2011 14:35'' prior: 0!!
The default repeating parser with standard PEG semantics (i.e. possessive, blind, eager).!!
!!PPPossessiveRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:43''!!
parseOn: aPPContext
| start element elements |
start := aPPContext remember.
elements := OrderedCollection new.
[ elements size < min ] whileTrue: [
(element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
aPPContext restore: start.
^ element ].
elements addLast: element ].
[ elements size < max ] whileTrue: [
(element := parser parseOn: aPPContext) isPetitFailure
ifTrue: [ ^ elements asArray ].
elements addLast: element ].
^ elements asArray!! !!
PPRepeatingParser subclass: #PPLimitedRepeatingParser
instanceVariableNames: ''limit''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPLimitedRepeatingParser commentStamp: ''lr 4/3/2011 14:37'' prior: 0!!
An abstract parser that repeatedly parses between ''min'' and ''max'' instances of my delegate and that requires the input to be completed with a specified parser ''limit''. Subclasses provide repeating behavior as typically seen in regular expression implementations (non-blind).
Instance Variables:
limit <PPParser> The parser to complete the input with.!!
!!PPLimitedRepeatingParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/4/2011 18:46''!!
replace: aParser with: anotherParser
super replace: aParser with: anotherParser.
limit == aParser ifTrue: [ limit := anotherParser ]!! !!
!!PPLimitedRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/2/2011 10:00''!!
setLimit: aParser
limit := aParser!! !!
!!PPLimitedRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/4/2011 18:46''!!
children
^ Array with: parser with: limit!! !!
!!PPLimitedRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/2/2011 10:00''!!
limit
"Answer the parser that limits (or ends) this repetition."
^ limit!! !!
!!PPLimitedRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 16:04''!!
matchesLimitOn: aPPContext
| element position |
position := aPPContext remember.
element := limit parseOn: aPPContext.
aPPContext restore: position.
^ element isPetitFailure not!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPLimitedRepeatingParser class
instanceVariableNames: ''''!!
!!PPLimitedRepeatingParser class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPLimitedRepeatingParser class methodsFor: ''instance creation'' stamp: ''lr 4/3/2011 14:58''!!
on: aParser limit: aLimitParser
^ (self on: aParser) setLimit: aLimitParser!! !!
PPLimitedRepeatingParser subclass: #PPGreedyRepeatingParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPGreedyRepeatingParser commentStamp: ''lr 4/3/2011 15:08'' prior: 0!!
A greedy repeating parser, commonly seen in regular expression implementations. It aggressively consumes as much input as possible and then backtracks to meet the ''limit'' condition.
This class essentially implements the iterative version of the following recursive parser composition:
| parser |
parser := PPChoiceParser new.
parser setParsers: (Array
with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])
with: (limit and ==> [ :each | OrderedCollection new ])).
^ parser ==> [ :rest | rest asArray ]!!
!!PPGreedyRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:59''!!
parseOn: aPPContext
| start element elements positions |
start := aPPContext remember.
elements := OrderedCollection new.
[ elements size < min ] whileTrue: [
(element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
aPPContext restore: start.
^ element ].
elements addLast: element ].
positions := OrderedCollection with: aPPContext remember.
[ elements size < max and: [ (element := parser parseOn: aPPContext) isPetitFailure not ] ] whileTrue: [
elements addLast: element.
positions addLast: aPPContext remember ].
[ positions isEmpty ] whileFalse: [
aPPContext restore: positions last.
element := limit parseOn: aPPContext.
element isPetitFailure ifFalse: [
aPPContext restore: positions last.
^ elements asArray ].
elements isEmpty ifTrue: [
aPPContext restore: start.
^ element ].
elements removeLast.
positions removeLast ].
aPPContext restore: start.
^ PPFailure message: ''overflow'' context: aPPContext at: start!! !!
PPParser subclass: #PPEpsilonParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPEpsilonParser commentStamp: ''lr 5/15/2008 15:09'' prior: 0!!
A parser that consumes nothing and always succeeds.!!
!!PPEpsilonParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 10/21/2009 12:11''!!
isNullable
^ true!! !!
!!PPEpsilonParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:15''!!
morphicShapeSeen: aSet depth: anInteger
^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
self newRowMorph
addMorphBack: (self newColumnMorph
addMorphBack: (self newSpacerMorph height: 10);
addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
yourself);
yourself ]!! !!
!!PPEpsilonParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:42''!!
displayName
^ ''epsilon''!! !!
!!PPEpsilonParser methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:49''!!
parseOn: aStream
^ nil!! !!
PPLimitedRepeatingParser subclass: #PPLazyRepeatingParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPLazyRepeatingParser commentStamp: ''lr 4/3/2011 15:08'' prior: 0!!
A lazy repeating parser, commonly seen in regular expression implementations. It limits its consumption to meet the ''limit'' condition as early as possible.
This class essentially implements the iterative version of the following recursive parser composition:
| parser |
parser := PPChoiceParser new.
parser setParsers: (Array
with: (limit and ==> [ :each | OrderedCollection new ])
with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])).
^ parser ==> [ :rest | rest asArray ]!!
!!PPLazyRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
parseOn: aPPContext
| start element elements |
start := aPPContext remember.
elements := OrderedCollection new.
[ elements size < min ] whileTrue: [
(element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
aPPContext restore: start.
^ element ].
elements addLast: element ].
[ self matchesLimitOn: aPPContext ] whileFalse: [
elements size < max ifFalse: [
aPPContext restore: start.
^ PPFailure message: ''overflow'' context: aPPContext at: start ].
element := parser parseOn: aPPContext.
element isPetitFailure ifTrue: [
aPPContext restore: start.
^ element ].
elements addLast: element ].
^ elements asArray!! !!
PPListParser subclass: #PPSequenceParser
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Parsers''!!
!!PPSequenceParser commentStamp: ''lr 4/18/2008 15:34'' prior: 0!!
A parser that parses a sequence of parsers.!!
!!PPSequenceParser methodsFor: ''operators-mapping'' stamp: ''lr 5/6/2011 20:27''!!
map: aBlock
^ aBlock numArgs = self children size
ifTrue: [ self ==> [ :nodes | aBlock valueWithArguments: nodes ] ]
ifFalse: [ self error: aBlock numArgs asString , '' arguments expected.'' ]!! !!
!!PPSequenceParser methodsFor: ''operators-mapping'' stamp: ''lr 1/8/2010 12:01''!!
permutation: anArrayOfIntegers
"Answer a permutation of the receivers sequence."
anArrayOfIntegers do: [ :index |
(index isInteger and: [ index between: 1 and: parsers size ])
ifFalse: [ self error: ''Invalid permutation index: '' , index printString ] ].
^ self ==> [ :nodes | anArrayOfIntegers collect: [ :index | nodes at: index ] ]!! !!
!!PPSequenceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/17/2009 21:54''!!
morphicShapeSeen: aSet depth: anInteger
^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
self children
inject: self newRowMorph
into: [ :result :each |
result
addMorphBack: (cc value: each);
yourself ] ]!! !!
!!PPSequenceParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:24''!!
exampleOn: aStream
parsers do: [ :each | each exampleOn: aStream ]!! !!
!!PPSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:43''!!
parseOn: aPPContext
"This is optimized code that avoids unnecessary block activations, do not change."
| start elements element |
start := aPPContext remember.
elements := Array new: parsers size.
1 to: parsers size do: [ :index |
element := (parsers at: index)
parseOn: aPPContext.
element isPetitFailure ifTrue: [
aPPContext restore: start.
^ element ].
elements at: index put: element ].
^ elements!! !!
!!PPSequenceParser methodsFor: ''operators'' stamp: ''lr 9/17/2008 00:17''!!
, aRule
^ self copyWith: aRule!! !!
!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 12/9/2010 10:37''!!
cycleSet: aDictionary
| firstSet |
1 to: parsers size do: [ :index |
firstSet := aDictionary at: (parsers at: index).
(firstSet anySatisfy: [ :each | each isNullable ])
ifFalse: [ ^ parsers copyFrom: 1 to: index ] ].
^ parsers!! !!
!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 9/16/2010 17:56''!!
firstSets: aFirstDictionary into: aSet
| nullable |
parsers do: [ :parser |
nullable := false.
(aFirstDictionary at: parser) do: [ :each |
each isNullable
ifTrue: [ nullable := true ]
ifFalse: [ aSet add: each ] ].
nullable
ifFalse: [ ^ self ] ].
aSet add: PPSentinel instance!! !!
!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 8/14/2010 13:51''!!
followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
parsers keysAndValuesDo: [ :index :parser |
| followSet firstSet |
followSet := aFollowDictionary at: parser.
index = parsers size
ifTrue: [ followSet addAll: aSet ]
ifFalse: [
(self class withAll: (parsers
copyFrom: index + 1 to: parsers size))
firstSets: aFirstDictionary
into: (firstSet := IdentitySet new).
(firstSet anySatisfy: [ :each | each isNullable ])
ifTrue: [ followSet addAll: aSet ].
followSet addAll: (firstSet
reject: [ :each | each isNullable ]) ] ]!! !!
!!PPSequenceParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
visualizationGraphType
^ '',''!! !!
Object subclass: #PPFailure
instanceVariableNames: ''message context position''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Core''!!
!!PPFailure commentStamp: ''<historical>'' prior: 0!!
The failure object in PetitParser. It is the only class that responds to #isPetitFailure with true. It contains an error message and a position of the occurrence of the failure.
Instance Variables:
message <String> The error message of this failure.
position <Integer> The position of this failure in the input stream.
!!
!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:39''!!
sampleIn: composite
(composite text)
title: ''Sample'';
display: [:res | res findStream contents ifNil: [''''] ];
allowNil.!! !!
!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:40''!!
treeViewIn: composite
composite tree
title: ''Execution Traces'';
format: [:resultNode | resultNode formattedText ];
children: [:resultNode | resultNode showChildren
ifTrue: [ resultNode children ]
ifFalse: [ #() ] ]. !! !!
!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:53''!!
gtDebugView: composite
<gtInspectorPresentationOrder: 40>
| browser |
browser :=
composite tabulator.
browser title: ''Debug View''.
browser row: #tree;
row: #source.
browser transmit
fromOutsideEntityPort;
toOutsidePort: #debugResult;
transformed: [ :failure | failure debugResult ].
browser transmit
from: #tree;
to: #source port: #selectionInterval;
transformed: [:debuggingResult |
debuggingResult ifNotNil: [
debuggingResult start to: debuggingResult end]
].
browser transmit
fromOutsidePort: #debugResult;
to: #source;
andShow: [ :a | self sampleIn: a ].
browser transmit
fromOutsidePort: #debugResult;
to: #tree;
andShow: [ :a | self treeViewIn: a ].
browser startOn: self!! !!
!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:54''!!
debugResult
^ context root enableDebug parse: context stream reset!! !!
!!PPFailure methodsFor: ''testing'' stamp: ''lr 2/7/2010 20:54''!!
isPetitFailure
"I am the only class that should implement this method to return true."
^ true!! !!
!!PPFailure methodsFor: ''printing'' stamp: ''JanKurs 8/19/2014 16:30''!!
printOn: aStream
aStream nextPutAll: self message; nextPutAll: '' at ''; print: self position!! !!
!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:57''!!
initializeMessage: aString context: aPPContext
self initializeMessage: aString context: aPPContext position: aPPContext position!! !!
!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:33''!!
initializeMessage: aString at: anInteger
self halt: ''deprecated''.!! !!
!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:57''!!
initializeMessage: aString context: aPPContext position: position
message := aString.
context := aPPContext.
position := position.!! !!
!!PPFailure methodsFor: ''accessing'' stamp: ''lr 5/5/2010 13:56''!!
message
"Answer a human readable error message of this parse failure."
^ message!! !!
!!PPFailure methodsFor: ''accessing'' stamp: ''lr 5/5/2010 13:55''!!
position
"Answer the position in the source string that caused this parse failure."
^ position!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPFailure class
instanceVariableNames: ''''!!
!!PPFailure class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:33''!!
message: aString at: anInteger
self halt: ''deprecated, use message:context:''.
^ self basicNew initializeMessage: aString at: anInteger!! !!
!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:32''!!
message: aString context: aPPContext
^ self basicNew initializeMessage: aString context: aPPContext!! !!
!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:57''!!
message: aString context: aPPContext at: position
^ self basicNew initializeMessage: aString context: aPPContext position: position!! !!
ReadStream subclass: #PPStream
instanceVariableNames: ''''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Core''!!
!!PPStream commentStamp: ''<historical>'' prior: 0!!
A positional stream implementation used for parsing. It overrides some methods for optimization reasons.!!
!!PPStream methodsFor: ''accessing'' stamp: ''lr 4/29/2008 21:48''!!
peek
"An improved version of peek, that is slightly faster than the built in version."
^ self atEnd ifFalse: [ collection at: position + 1 ]!! !!
!!PPStream methodsFor: ''accessing'' stamp: ''lr 10/5/2010 16:29''!!
uncheckedPeek
"An unchecked version of peek that throws an error if we try to peek over the end of the stream, even faster than #peek."
^ collection at: position + 1!! !!
!!PPStream methodsFor: ''accessing'' stamp: ''lr 2/13/2012 20:25''!!
collection
"Answer the underlying collection."
^ collection!! !!
!!PPStream methodsFor: ''accessing'' stamp: ''lr 8/25/2010 11:36''!!
position: anInteger
"The receiver does not check for invalid arguments passed to this method, as it is solely used with valid indexes for backtracking."
position := anInteger!! !!
!!PPStream methodsFor: ''printing'' stamp: ''lr 11/4/2010 19:23''!!
printOn: aStream
collection isString
ifFalse: [ ^ super printOn: aStream ].
aStream
nextPutAll: (collection copyFrom: 1 to: position);
nextPutAll: ''·'';
nextPutAll: (collection copyFrom: position + 1 to: readLimit)!! !!
!!PPStream methodsFor: ''converting'' stamp: ''lr 2/7/2010 20:53''!!
asPetitStream
^ self!! !!
Object subclass: #PPToken
instanceVariableNames: ''collection start stop value''
classVariableNames: ''NewLineParser''
poolDictionaries: ''''
category: ''PetitParser-Core''!!
!!PPToken commentStamp: ''lr 2/25/2013 23:34'' prior: 0!!
PPToken represents a parsed part of the input stream. Contrary to a simple String it remembers where it came from, the original collection, its start and stop position and its parse value.
Instance Variables:
collection <SequenceableCollection> The collection this token comes from.
start <Integer> The start position in the collection.
stop <Integer> The stop position in the collection.
value <Object> The parse result.!!
!!PPToken methodsFor: ''querying'' stamp: ''lr 9/7/2011 20:41''!!
line
"Answer the line number of this token in the underlying collection."
| line |
line := 1.
(NewLineParser , [ :stream |
start <= stream position
ifTrue: [ ^ line ].
line := line + 1 ] asParser
/ #any asParser) star
parse: collection.
^ line!! !!
!!PPToken methodsFor: ''querying'' stamp: ''lr 9/7/2011 20:40''!!
column
"Answer the column number of this token in the underlying collection."
| position |
position := 0.
(NewLineParser , [ :stream |
start <= stream position
ifTrue: [ ^ start - position ].
position := stream position ] asParser
/ #any asParser) star
parse: collection.
^ start - position!! !!
!!PPToken methodsFor: ''initialization'' stamp: ''lr 2/25/2013 23:36''!!
initializeOn: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject
collection := aSequenceableCollection.
start := aStartInteger.
stop := aStopInteger.
value := anObject!! !!
!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:33''!!
stop
"Answer the stop position of this token in the underlying collection."
^ stop!! !!
!!PPToken methodsFor: ''accessing'' stamp: ''lr 2/25/2013 23:56''!!
size
"Answer the size of this token in the underlying collection."
^ stop - start + 1!! !!
!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:34''!!
collection
"Answer the underlying collection of this token."
^ collection!! !!
!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:33''!!
start
"Answer the start position of this token in the underlying collection."
^ start!! !!
!!PPToken methodsFor: ''printing'' stamp: ''lr 2/26/2013 00:37''!!
printOn: aStream
super printOn: aStream.
aStream nextPut: $[; print: self start; nextPut: $,; print: self stop; nextPut: $].
aStream nextPut: $(; print: self parsedValue; nextPut: $)!! !!
!!PPToken methodsFor: ''copying'' stamp: ''lr 2/26/2013 00:34''!!
copyFrom: aStartInteger to: aStopInteger
^ self class on: collection start: start + aStartInteger - 1 stop: stop + aStopInteger - 3 value: value!! !!
!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:34''!!
value
self notify: ''Token>>#value is no longer supported. Instead use Token>>#inputValue or the more pragmatic #parsedValue.''.
^ self inputValue!! !!
!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:32''!!
inputValue
"Answer the consumed input of this token."
^ collection copyFrom: start to: stop!! !!
!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:32''!!
parsedValue
"Answer the parsed value of this token."
^ value!! !!
!!PPToken methodsFor: ''comparing'' stamp: ''lr 2/26/2013 00:34''!!
= anObject
^ self class = anObject class and: [ self parsedValue = anObject parsedValue ]!! !!
!!PPToken methodsFor: ''comparing'' stamp: ''lr 2/26/2013 00:34''!!
hash
^ self parsedValue hash!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPToken class
instanceVariableNames: ''''!!
!!PPToken class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPToken class methodsFor: ''initialization'' stamp: ''lr 11/29/2011 20:42''!!
initialize
"Platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple."
NewLineParser := (Character lf asParser) / (Character cr asParser , Character lf asParser optional)!! !!
!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 2/25/2013 23:39''!!
on: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject
^ self basicNew
initializeOn: aSequenceableCollection
start: aStartInteger stop: aStopInteger
value: anObject!! !!
!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 2/25/2013 23:36''!!
on: aSequenceableCollection
^ self on: aSequenceableCollection start: 1 stop: aSequenceableCollection size value: nil!! !!
!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 4/6/2010 20:58''!!
new
self error: ''Token can only be created using a dedicated constructor.''!! !!
Object subclass: #PPContextMemento
instanceVariableNames: ''stream position properties''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Core''!!
!!PPContextMemento commentStamp: ''<historical>'' prior: 0!!
!!
!!PPContextMemento methodsFor: ''comparing'' stamp: ''JanKurs 3/19/2014 13:03''!!
= anObject
(self == anObject) ifTrue: [ ^ true ].
(anObject class = PPContextMemento) ifFalse: [ ^ false ].
(anObject stream == stream) ifFalse: [ ^ false ].
(anObject position = position) ifFalse: [ ^ false ].
(anObject properties = properties) ifFalse: [ ^ false ].
^ true.
!! !!
!!PPContextMemento methodsFor: ''comparing'' stamp: ''JanKurs 3/19/2014 13:04''!!
hash
^ (position hash bitXor: stream hash) bitXor: properties hash.!! !!
!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
propertyAt: aKey ifAbsentPut: aBlock
"Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value."
^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !!
!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
removeProperty: aKey ifAbsent: aBlock
"Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock."
| answer |
properties isNil ifTrue: [ ^ aBlock value ].
answer := properties removeKey: aKey ifAbsent: aBlock.
properties isEmpty ifTrue: [ properties := nil ].
^ answer!! !!
!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:14''!!
propertyAt: aKey
"Answer the property value associated with aKey."
^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
propertyAt: aKey ifAbsent: aBlock
"Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock."
^ properties isNil
ifTrue: [ aBlock value ]
ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !!
!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
propertyAt: aKey put: anObject
"Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
^ (properties ifNil: [ properties := Dictionary new: 1 ])
at: aKey put: anObject!! !!
!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:14''!!
hasProperty: aKey
"Test if the property aKey is present."
^ properties notNil and: [ properties includesKey: aKey ]!! !!
!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
removeProperty: aKey
"Remove the property with aKey. Answer the property or raise an error if aKey isn''t found."
^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 13:04''!!
properties
^ properties !! !!
!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:52''!!
stream: aStream
stream := aStream!! !!
!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:51''!!
position
^ position!! !!
!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:52''!!
position: anInteger
position := anInteger !! !!
!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:51''!!
stream
^ stream!! !!
Object subclass: #PPContext
instanceVariableNames: ''stream root properties''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Core''!!
!!PPContext commentStamp: ''<historical>'' prior: 0!!
!!
!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:27''!!
remember
| memento |
memento := PPContextMemento new
stream: stream;
position: stream position;
yourself.
self rememberProperties: memento.
^ memento!! !!
!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:26''!!
restore: aPPContextMemento
aPPContextMemento stream == stream ifFalse: [ self error: ''Oops!!!!'' ].
stream position: aPPContextMemento position.
self restoreProperties: aPPContextMemento.!! !!
!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:29''!!
restoreProperties: aPPContextMemento
aPPContextMemento stream == stream ifFalse: [ self error: ''Oops!!!!'' ].
aPPContextMemento class selectorsAndMethodsDo: [ :selector :method |
(selector beginsWith: ''restore'') ifTrue: [
aPPContextMemento withArgs: (Array with: self) executeMethod: method.
]
]!! !!
!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:28''!!
rememberProperties: aPPContextMemento
aPPContextMemento class selectorsAndMethodsDo: [ :selector :method |
(selector beginsWith: ''remember'') ifTrue: [
aPPContextMemento withArgs: (Array with: self) executeMethod: method.
]
]
!! !!
!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:25''!!
peekTwice
^ stream peekTwice!! !!
!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:02''!!
position
^ stream position!! !!
!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
uncheckedPeek
^ stream uncheckedPeek!! !!
!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:11''!!
upTo: anObject
^ stream upTo: anObject!! !!
!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
collection
^ stream collection !! !!
!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/16/2014 12:13''!!
atEnd
^ stream atEnd!! !!
!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:24''!!
peek
^ stream peek!! !!
!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:29''!!
upToAll: whatever
^ stream upToAll: whatever!! !!
!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
skip: anInteger
^ stream skip: anInteger !! !!
!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:31''!!
upToAnyOf: whatever
^ stream upToAnyOf: whatever!! !!
!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:02''!!
next
^ stream next!! !!
!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
propertyAt: aKey ifAbsentPut: aBlock
"Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value."
^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !!
!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
removeProperty: aKey ifAbsent: aBlock
"Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock."
| answer |
properties isNil ifTrue: [ ^ aBlock value ].
answer := properties removeKey: aKey ifAbsent: aBlock.
properties isEmpty ifTrue: [ properties := nil ].
^ answer!! !!
!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
propertyAt: aKey
"Answer the property value associated with aKey."
^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
propertyAt: aKey ifAbsent: aBlock
"Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock."
^ properties isNil
ifTrue: [ aBlock value ]
ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !!
!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
propertyAt: aKey put: anObject
"Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
^ (properties ifNil: [ properties := Dictionary new: 1 ])
at: aKey put: anObject!! !!
!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
hasProperty: aKey
"Test if the property aKey is present."
^ properties notNil and: [ properties includesKey: aKey ]!! !!
!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
removeProperty: aKey
"Remove the property with aKey. Answer the property or raise an error if aKey isn''t found."
^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
!!PPContext methodsFor: ''initialization'' stamp: ''JanKurs 1/16/2014 11:24''!!
initialize
stream := nil.!! !!
!!PPContext methodsFor: ''as yet unclassified'' stamp: ''JanKurs 3/19/2014 16:26''!!
parsed: aPPParser at: anInteger result: anObject
self halt.
^ anObject!! !!
!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 10/29/2013 10:13''!!
root: aPPParser
root := aPPParser !! !!
!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 10/29/2013 10:13''!!
root
^ root !! !!
!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 1/15/2014 15:36''!!
stream: aStream
stream := aStream.!! !!
!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 1/16/2014 15:12''!!
stream
^ stream!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPContext class
instanceVariableNames: ''''!!
!!PPContext class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPContext class methodsFor: ''as yet unclassified'' stamp: ''JanKurs 1/16/2014 14:38''!!
on: aPPParser stream: aStream
^ self basicNew
initialize;
root: aPPParser;
stream: aStream asPetitStream;
yourself!! !!
Object subclass: #PPMemento
instanceVariableNames: ''result count context''
classVariableNames: ''''
poolDictionaries: ''''
category: ''PetitParser-Core''!!
!!PPMemento commentStamp: ''<historical>'' prior: 0!!
PPMemento is an internal class used by PPMemoizedParser to cache results and detect left-recursive calls.
Instance Variables:
result <Object> The cached result.
count <Integer> The number of recursive cycles followed.
position <Integer> The position of the cached result in the input stream.!!
!!PPMemento methodsFor: ''accessing'' stamp: ''JanKurs 1/15/2014 16:09''!!
contextMemento: aPPContextMemento
context := aPPContextMemento
!! !!
!!PPMemento methodsFor: ''accessing'' stamp: ''JanKurs 1/15/2014 16:09''!!
contextMemento
^ context!! !!
!!PPMemento methodsFor: ''accessing'' stamp: ''lr 4/24/2008 10:15''!!
result
^ result!! !!
!!PPMemento methodsFor: ''accessing'' stamp: ''lr 4/22/2008 18:23''!!
result: anObject
result := anObject!! !!
!!PPMemento methodsFor: ''accessing-readonly'' stamp: ''lr 4/22/2008 18:23''!!
count
^ count!! !!
!!PPMemento methodsFor: ''initialization'' stamp: ''lr 4/22/2008 18:21''!!
initialize
count := 0
!! !!
!!PPMemento methodsFor: ''actions'' stamp: ''lr 4/22/2008 18:20''!!
increment
count := count + 1!! !!
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
PPMemento class
instanceVariableNames: ''''!!
!!PPMemento class commentStamp: ''<historical>'' prior: 0!!
!!
!!PPMemento class methodsFor: ''instance creation'' stamp: ''lr 4/22/2008 18:21''!!
new
^ self basicNew initialize!! !!
PPToken initialize!!''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!SequenceableCollection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 2/7/2010 20:53''!!
asPetitStream
^ PPStream on: self!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!Character methodsFor: ''*petitparser-core-operators'' stamp: ''lr 6/12/2010 09:04''!!
- aCharacter
"Create a range of characters between the receiver and the argument."
^ PPPredicateObjectParser between: self and: aCharacter!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!Character methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
asParser
"Answer a parser that accepts the receiving character."
^ PPLiteralObjectParser on: self!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!PositionableStream methodsFor: ''*petitparser-core'' stamp: ''sback 9/3/2010 10:00''!!
peekTwice
"Answer what would be returned if the message next were sent to the
receiver. If the receiver is at the end, answer nil."
| array |
self atEnd
ifTrue: [^Array with: nil with: nil].
array := Array with: (self next) with: (self peek).
position := position - 1.
^array!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!Stream methodsFor: ''*petitparser-core-converting'' stamp: ''lr 4/8/2010 14:46''!!
asPetitStream
^ self contents asPetitStream!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!Symbol methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
asParser
"Answer a predicate parser named after the receiving symbol. Possible symbols are the method selectors on the class-side of PPPredicateObjectParser."
^ PPPredicateObjectParser perform: self!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!String methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:48''!!
asParser
"Answer a parser that accepts the receiving string."
^ PPLiteralSequenceParser on: self!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!BlockClosure methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:48''!!
asParser
"Answer a parser implemented in the receiving one-argument block."
^ PPPluggableParser on: self!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!UndefinedObject methodsFor: ''*petitparser-converting'' stamp: ''lr 11/29/2011 20:49''!!
asParser
"Answer a parser that succeeds and does not consume anything."
^ PPEpsilonParser new!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!Text methodsFor: ''*petitparser-core-converting'' stamp: ''lr 2/7/2010 20:53''!!
asPetitStream
^ string asPetitStream!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!Collection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:38''!!
asChoiceParser
^ PPChoiceParser withAll: (self collect: [ :each | each asParser ])!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!Collection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:38''!!
asSequenceParser
^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!Object methodsFor: ''*petitparser-core-testing'' stamp: ''lr 8/6/2010 16:44''!!
isPetitParser
^ false!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
!!Object methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
asParser
"Answer a parser accepting the receiving object."
^ PPPredicateObjectParser expect: self!! !!
''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.314418 pm''!!
!!Object methodsFor: ''*petitparser-core-testing'' stamp: ''lr 2/7/2010 20:54''!!
isPetitFailure
^ false!! !!
'
!
smalltalkInDirectory: directory
| files |
files := self readDirectory: directory.
files := self files: files withExtension: 'st'.
^ files collect: [ :f | (FileStream fileNamed: f) contents asString ]
!
smalltalkObjectMethods
^ Object allMethods collect: [ :m | m sourceCode ].
!
smalltalkSourcesBig
^ self smalltalkInDirectory: '../smalltalk-src/'
!
smalltalkSourcesBig_old
^ ((Smalltalk allClasses copyFrom: 1 to: 30) collect: [ :c |
c allMethods collect: [ :m | m sourceCode ]
]) gather: [:each | each ].
!
workingJavaInDirectory: directory
| sources parser |
"return only such a files, that can be parsed by PPJavaSyntax"
javaCache ifNil: [ javaCache := Dictionary new ].
^ javaCache at: directory ifAbsentPut: [
sources := self javaInDirectory: directory.
parser := PPJavaSyntax new.
sources select: [ :source | ([parser parse: source ] on: Error do: [ PPFailure new ]) isPetitFailure not ]
]
! !
!PPCBenchmarkResources methodsFor:'private utilities'!
files: files withExtension: extension
( (Smalltalk respondsTo: #isSmalltalkX) and:[ Smalltalk isSmalltalkX ] ) ifTrue:[
^ files select: [ :f | f suffix = extension ]
] ifFalse:[
"Assuming Pharo..."
^ files select: [ :f | f extension = extension ]
]
"Modified: / 20-04-2015 / 10:58:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
readDirectory: directory
| file |
( (Smalltalk respondsTo: #isSmalltalkX) and:[ Smalltalk isSmalltalkX ] ) ifTrue:[
file := directory asFilename.
file exists ifFalse:[
self error: 'Directory does not exist'.
].
^ file recursiveDirectoryContentsAsFilenames select:[:each | each isRegularFile ]
] ifFalse:[
"Assuming Pharo..."
file := directory asFileReference.
file exists ifFalse: [
self error: 'Directory does not exist'.
].
^ file allFiles
]
"Modified: / 20-04-2015 / 11:12:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!PPCBenchmarkResources class methodsFor:'documentation'!
version_HG
^ '$Changeset: <not expanded> $'
! !