[Cuis-dev] SqueakComptibilityPackage for 6.2
Mariano Montone
marianomontone at gmail.com
Sun Mar 3 05:48:24 PST 2024
Hello,
It turns out PetitParser also depends on SqueakCompatibility, so I
attach the modified PetitParser packages without the SqueakCompatibility
dependency.
Once that is integrated, I can remove SqueakCompatibility from Erudite.
Mariano
El 1/3/24 a las 17:32, Juan Vuletich escribió:
> Hi Folks,
>
> On 2/27/2024 10:55 PM, marianomontone--- via Cuis-dev wrote:
>> On 27/2/24 11:14, "H. Fernandes via Cuis-dev"
>> <cuis-dev at lists.cuis.st> wrote:
>>> Hi Juan,
>>>
>>> The SqueakCompatibility dependency is not mine but from Erudite
>>> package DrGeo depends on. Mariano, can this dependency be removed?
>>
>> Erudite uses the String>>subStrings: method SqueakCompatibility
>> provides.
>> Could be removed if I move that method to Erudite package, perhaps.
>>
>> Mariano
>
> Oh. I don't think having that in SqueakCompatibility makes much sense.
> Moved it (actually a better implementation) to the base image. Just
> pushed to the repo.
>
> Mariano, please remove SqueakCompatibility as a prerequisite for
> Erudite if possible.
>
> Hilaire, this seems harmless enough. Added it to Cuis 6.2 stable too.
>
> Apologies for the inconvenience.
>
> Thanks,
>
-------------- next part --------------
'From Cuis6.3 [latest update: #6247] on 3 March 2024 at 10:43:19 am'!
'Description Please enter a description for this package '!
!provides: 'PetitParser' 1 7!
SystemOrganization addCategory: #'PetitParser-Core'!
SystemOrganization addCategory: #'PetitParser-Tools'!
SystemOrganization addCategory: #'PetitParser-Parsers'!
!classDefinition: #PPStream category: #'PetitParser-Core'!
ReadStream subclass: #PPStream
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Core'!
!classDefinition: 'PPStream class' category: #'PetitParser-Core'!
PPStream class
instanceVariableNames: ''!
!classDefinition: #PPFailure category: #'PetitParser-Core'!
Object subclass: #PPFailure
instanceVariableNames: 'message position'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Core'!
!classDefinition: 'PPFailure class' category: #'PetitParser-Core'!
PPFailure class
instanceVariableNames: ''!
!classDefinition: #PPMemento category: #'PetitParser-Core'!
Object subclass: #PPMemento
instanceVariableNames: 'result count position'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Core'!
!classDefinition: 'PPMemento class' category: #'PetitParser-Core'!
PPMemento class
instanceVariableNames: ''!
!classDefinition: #PPToken category: #'PetitParser-Core'!
Object subclass: #PPToken
instanceVariableNames: 'collection start stop'
classVariableNames: 'NewLineParser'
poolDictionaries: ''
category: 'PetitParser-Core'!
!classDefinition: 'PPToken class' category: #'PetitParser-Core'!
PPToken class
instanceVariableNames: ''!
!classDefinition: #PPCharSetPredicate category: #'PetitParser-Tools'!
Object subclass: #PPCharSetPredicate
instanceVariableNames: 'block classification'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Tools'!
!classDefinition: 'PPCharSetPredicate class' category: #'PetitParser-Tools'!
PPCharSetPredicate class
instanceVariableNames: ''!
!classDefinition: #PPParser category: #'PetitParser-Parsers'!
Object subclass: #PPParser
instanceVariableNames: 'properties'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPParser class' category: #'PetitParser-Parsers'!
PPParser class
instanceVariableNames: ''!
!classDefinition: #PPUnresolvedParser category: #'PetitParser-Tools'!
PPParser subclass: #PPUnresolvedParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Tools'!
!classDefinition: 'PPUnresolvedParser class' category: #'PetitParser-Tools'!
PPUnresolvedParser class
instanceVariableNames: ''!
!classDefinition: #PPDelegateParser category: #'PetitParser-Parsers'!
PPParser subclass: #PPDelegateParser
instanceVariableNames: 'parser'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPDelegateParser class' category: #'PetitParser-Parsers'!
PPDelegateParser class
instanceVariableNames: ''!
!classDefinition: #PPCompositeParser category: #'PetitParser-Tools'!
PPDelegateParser subclass: #PPCompositeParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Tools'!
!classDefinition: 'PPCompositeParser class' category: #'PetitParser-Tools'!
PPCompositeParser class
instanceVariableNames: ''!
!classDefinition: #PPExpressionParser category: #'PetitParser-Tools'!
PPDelegateParser subclass: #PPExpressionParser
instanceVariableNames: 'operators'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Tools'!
!classDefinition: 'PPExpressionParser class' category: #'PetitParser-Tools'!
PPExpressionParser class
instanceVariableNames: ''!
!classDefinition: #PPActionParser category: #'PetitParser-Parsers'!
PPDelegateParser subclass: #PPActionParser
instanceVariableNames: 'block'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPActionParser class' category: #'PetitParser-Parsers'!
PPActionParser class
instanceVariableNames: ''!
!classDefinition: #PPWrappingParser category: #'PetitParser-Parsers'!
PPActionParser subclass: #PPWrappingParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPWrappingParser class' category: #'PetitParser-Parsers'!
PPWrappingParser class
instanceVariableNames: ''!
!classDefinition: #PPAndParser category: #'PetitParser-Parsers'!
PPDelegateParser subclass: #PPAndParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPAndParser class' category: #'PetitParser-Parsers'!
PPAndParser class
instanceVariableNames: ''!
!classDefinition: #PPEndOfInputParser category: #'PetitParser-Parsers'!
PPDelegateParser subclass: #PPEndOfInputParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPEndOfInputParser class' category: #'PetitParser-Parsers'!
PPEndOfInputParser class
instanceVariableNames: ''!
!classDefinition: #PPFlattenParser category: #'PetitParser-Parsers'!
PPDelegateParser subclass: #PPFlattenParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPFlattenParser class' category: #'PetitParser-Parsers'!
PPFlattenParser class
instanceVariableNames: ''!
!classDefinition: #PPTokenParser category: #'PetitParser-Parsers'!
PPFlattenParser subclass: #PPTokenParser
instanceVariableNames: 'tokenClass'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPTokenParser class' category: #'PetitParser-Parsers'!
PPTokenParser class
instanceVariableNames: ''!
!classDefinition: #PPMemoizedParser category: #'PetitParser-Parsers'!
PPDelegateParser subclass: #PPMemoizedParser
instanceVariableNames: 'stream buffer'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPMemoizedParser class' category: #'PetitParser-Parsers'!
PPMemoizedParser class
instanceVariableNames: ''!
!classDefinition: #PPNotParser category: #'PetitParser-Parsers'!
PPDelegateParser subclass: #PPNotParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPNotParser class' category: #'PetitParser-Parsers'!
PPNotParser class
instanceVariableNames: ''!
!classDefinition: #PPOptionalParser category: #'PetitParser-Parsers'!
PPDelegateParser subclass: #PPOptionalParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPOptionalParser class' category: #'PetitParser-Parsers'!
PPOptionalParser class
instanceVariableNames: ''!
!classDefinition: #PPRepeatingParser category: #'PetitParser-Parsers'!
PPDelegateParser subclass: #PPRepeatingParser
instanceVariableNames: 'min max'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPRepeatingParser class' category: #'PetitParser-Parsers'!
PPRepeatingParser class
instanceVariableNames: ''!
!classDefinition: #PPLimitedRepeatingParser category: #'PetitParser-Parsers'!
PPRepeatingParser subclass: #PPLimitedRepeatingParser
instanceVariableNames: 'limit'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPLimitedRepeatingParser class' category: #'PetitParser-Parsers'!
PPLimitedRepeatingParser class
instanceVariableNames: ''!
!classDefinition: #PPGreedyRepeatingParser category: #'PetitParser-Parsers'!
PPLimitedRepeatingParser subclass: #PPGreedyRepeatingParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPGreedyRepeatingParser class' category: #'PetitParser-Parsers'!
PPGreedyRepeatingParser class
instanceVariableNames: ''!
!classDefinition: #PPLazyRepeatingParser category: #'PetitParser-Parsers'!
PPLimitedRepeatingParser subclass: #PPLazyRepeatingParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPLazyRepeatingParser class' category: #'PetitParser-Parsers'!
PPLazyRepeatingParser class
instanceVariableNames: ''!
!classDefinition: #PPPossessiveRepeatingParser category: #'PetitParser-Parsers'!
PPRepeatingParser subclass: #PPPossessiveRepeatingParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPPossessiveRepeatingParser class' category: #'PetitParser-Parsers'!
PPPossessiveRepeatingParser class
instanceVariableNames: ''!
!classDefinition: #PPTrimmingParser category: #'PetitParser-Parsers'!
PPDelegateParser subclass: #PPTrimmingParser
instanceVariableNames: 'trimmer'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPTrimmingParser class' category: #'PetitParser-Parsers'!
PPTrimmingParser class
instanceVariableNames: ''!
!classDefinition: #PPEpsilonParser category: #'PetitParser-Parsers'!
PPParser subclass: #PPEpsilonParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPEpsilonParser class' category: #'PetitParser-Parsers'!
PPEpsilonParser class
instanceVariableNames: ''!
!classDefinition: #PPFailingParser category: #'PetitParser-Parsers'!
PPParser subclass: #PPFailingParser
instanceVariableNames: 'message'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPFailingParser class' category: #'PetitParser-Parsers'!
PPFailingParser class
instanceVariableNames: ''!
!classDefinition: #PPListParser category: #'PetitParser-Parsers'!
PPParser subclass: #PPListParser
instanceVariableNames: 'parsers'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPListParser class' category: #'PetitParser-Parsers'!
PPListParser class
instanceVariableNames: ''!
!classDefinition: #PPChoiceParser category: #'PetitParser-Parsers'!
PPListParser subclass: #PPChoiceParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPChoiceParser class' category: #'PetitParser-Parsers'!
PPChoiceParser class
instanceVariableNames: ''!
!classDefinition: #PPSequenceParser category: #'PetitParser-Parsers'!
PPListParser subclass: #PPSequenceParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPSequenceParser class' category: #'PetitParser-Parsers'!
PPSequenceParser class
instanceVariableNames: ''!
!classDefinition: #PPLiteralParser category: #'PetitParser-Parsers'!
PPParser subclass: #PPLiteralParser
instanceVariableNames: 'literal message'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPLiteralParser class' category: #'PetitParser-Parsers'!
PPLiteralParser class
instanceVariableNames: ''!
!classDefinition: #PPLiteralObjectParser category: #'PetitParser-Parsers'!
PPLiteralParser subclass: #PPLiteralObjectParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPLiteralObjectParser class' category: #'PetitParser-Parsers'!
PPLiteralObjectParser class
instanceVariableNames: ''!
!classDefinition: #PPLiteralSequenceParser category: #'PetitParser-Parsers'!
PPLiteralParser subclass: #PPLiteralSequenceParser
instanceVariableNames: 'size'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPLiteralSequenceParser class' category: #'PetitParser-Parsers'!
PPLiteralSequenceParser class
instanceVariableNames: ''!
!classDefinition: #PPPluggableParser category: #'PetitParser-Parsers'!
PPParser subclass: #PPPluggableParser
instanceVariableNames: 'block'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPPluggableParser class' category: #'PetitParser-Parsers'!
PPPluggableParser class
instanceVariableNames: ''!
!classDefinition: #PPPredicateParser category: #'PetitParser-Parsers'!
PPParser subclass: #PPPredicateParser
instanceVariableNames: 'predicate predicateMessage negated negatedMessage'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPPredicateParser class' category: #'PetitParser-Parsers'!
PPPredicateParser class
instanceVariableNames: ''!
!classDefinition: #PPPredicateObjectParser category: #'PetitParser-Parsers'!
PPPredicateParser subclass: #PPPredicateObjectParser
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPPredicateObjectParser class' category: #'PetitParser-Parsers'!
PPPredicateObjectParser class
instanceVariableNames: ''!
!classDefinition: #PPPredicateSequenceParser category: #'PetitParser-Parsers'!
PPPredicateParser subclass: #PPPredicateSequenceParser
instanceVariableNames: 'size'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitParser-Parsers'!
!classDefinition: 'PPPredicateSequenceParser class' category: #'PetitParser-Parsers'!
PPPredicateSequenceParser class
instanceVariableNames: ''!
!PPStream commentStamp: '<historical>' prior: 0!
A positional stream implementation used for parsing. It overrides some methods for optimization reasons.!
!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.
!
!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.!
!PPToken commentStamp: '<historical>' 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 and its start and stop position.
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.!
!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.!
!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.!
!PPDelegateParser commentStamp: '<historical>' prior: 0!
A parser that delegates to another parser.
Instance Variables:
parser <PPParser> The parser to delegate to.!
!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.!
!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.!
!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.
!
!PPWrappingParser commentStamp: '<historical>' prior: 0!
A parser that performs an action block upon activation with the stream and a continuation block.!
!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].!
!PPEndOfInputParser commentStamp: 'lr 4/18/2008 13:46' prior: 0!
A parser that succeeds only at the end of the input stream.!
!PPFlattenParser commentStamp: 'lr 11/22/2009 13:09' prior: 0!
A parser that answers a flat copy of the range my delegate parses.!
!PPTokenParser commentStamp: '<historical>' prior: 0!
A parser that answers a token of the range my delegate parses.
Instance Variables:
tokenClass <PPToken class> The token sub-class to be used.!
!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.
!
!PPNotParser commentStamp: '<historical>' prior: 0!
The not-predicate, a parser that succeeds whenever its delegate does not, but consumes no input [Parr 1994, 1995].!
!PPOptionalParser commentStamp: 'lr 4/3/2011 14:46' prior: 0!
A parser that optionally parsers its delegate, or answers nil.!
!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.!
!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.!
!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 ]!
!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 ]!
!PPPossessiveRepeatingParser commentStamp: 'lr 4/3/2011 14:35' prior: 0!
The default repeating parser with standard PEG semantics (i.e. possessive, blind, eager).!
!PPTrimmingParser commentStamp: 'lr 4/6/2010 19:27' prior: 0!
A parser that silently consumes spaces before and after the delegate parser.!
!PPEpsilonParser commentStamp: 'lr 5/15/2008 15:09' prior: 0!
A parser that consumes nothing and always succeeds.!
!PPFailingParser commentStamp: '<historical>' prior: 0!
A parser that consumes nothing and always fails.
Instance Variables:
message <String> The failure message.!
!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.!
!PPChoiceParser commentStamp: 'lr 4/18/2008 15:35' prior: 0!
A parser that uses the first parser that succeeds.!
!PPSequenceParser commentStamp: 'lr 4/18/2008 15:34' prior: 0!
A parser that parses a sequence of 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.
!
!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.!
!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.!
!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.
!
!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.!
!PPPredicateObjectParser commentStamp: '<historical>' prior: 0!
A parser that accepts if a given predicate on one element of the input sequence holds.!
!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.!
!PPStream methodsFor: 'converting' stamp: 'lr 2/7/2010 20:53'!
asPetitStream
^ self! !
!PPStream methodsFor: 'accessing' stamp: 'lr 2/13/2012 20:25'!
collection
"Answer the underlying collection."
^ collection! !
!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 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: '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: '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)! !
!PPFailure methodsFor: 'initialization' stamp: 'lr 5/5/2010 13:55'!
initializeMessage: aString at: anInteger
message := aString.
position := anInteger! !
!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: '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 methodsFor: 'printing' stamp: 'lr 5/5/2010 14:01'!
printOn: aStream
aStream nextPutAll: self message; nextPutAll: ' at '; print: position! !
!PPFailure class methodsFor: 'instance creation' stamp: 'lr 5/5/2010 13:56'!
message: aString at: anInteger
^ self basicNew initializeMessage: aString at: anInteger! !
!PPMemento methodsFor: 'accessing-readonly' stamp: 'lr 4/22/2008 18:23'!
count
^ count! !
!PPMemento methodsFor: 'actions' stamp: 'lr 4/22/2008 18:20'!
increment
count := count + 1! !
!PPMemento methodsFor: 'initialization' stamp: 'lr 4/22/2008 18:21'!
initialize
count := 0
! !
!PPMemento methodsFor: 'accessing' stamp: 'lr 4/22/2008 18:23'!
position
^ position! !
!PPMemento methodsFor: 'accessing' stamp: 'lr 4/26/2008 15:48'!
position: anInteger
position := anInteger! !
!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 class methodsFor: 'instance creation' stamp: 'lr 4/22/2008 18:21'!
new
^ self basicNew initialize! !
!PPToken methodsFor: 'comparing' stamp: 'lr 10/7/2009 09:06'!
= anObject
^ self class = anObject class and: [ self value = anObject value ]! !
!PPToken methodsFor: 'comparing' stamp: 'lr 10/7/2009 09:06'!
hash
^ self value hash! !
!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:39'!
size
"Answer the size of this token."
^ stop - start + 1! !
!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: '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 6/15/2010 23:34'!
value
"Answer the contents of this token."
^ collection copyFrom: start to: stop! !
!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: '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: 'copying' stamp: 'lr 6/16/2008 10:55'!
copyFrom: aStartInteger to: aStopInteger
^ self class on: collection start: start + aStartInteger - 1 stop: stop + aStopInteger - 3! !
!PPToken methodsFor: 'initialization' stamp: 'lr 4/30/2010 12:13'!
initializeOn: aSequenceableCollection start: aStartInteger stop: aStopInteger
collection := aSequenceableCollection.
start := aStartInteger.
stop := aStopInteger! !
!PPToken methodsFor: 'printing' stamp: 'lr 6/16/2008 10:13'!
printOn: aStream
super printOn: aStream.
aStream nextPut: $(; nextPutAll: self value; nextPut: $)! !
!PPToken class methodsFor: 'initialization' stamp: 'pmon 6/1/2012 22:35'!
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 4/6/2010 20:58'!
new
self error: 'Token can only be created using a dedicated constructor.'! !
!PPToken class methodsFor: 'instance creation' stamp: 'lr 4/30/2010 12:13'!
on: aSequenceableCollection
^ self on: aSequenceableCollection start: 1 stop: aSequenceableCollection size! !
!PPToken class methodsFor: 'instance creation' stamp: 'lr 4/30/2010 12:13'!
on: aSequenceableCollection start: aStartInteger stop: aStopInteger
^ self basicNew
initializeOn: aSequenceableCollection
start: aStartInteger stop: aStopInteger! !
!PPCharSetPredicate methodsFor: 'initialization' stamp: 'MM 3/3/2024 10:32:17'!
initializeOn: aBlock
block := aBlock.
classification := Array new: 255.
1 to: classification size do: [ :index |
classification at: index put: (block
value: (Character codePoint: index)) ]! !
!PPCharSetPredicate methodsFor: 'evaluating' stamp: 'MM 3/3/2024 10:33:38'!
value: aCharacter
| index |
index := aCharacter codePoint.
index == 0
ifTrue: [ ^ block value: aCharacter ].
index > 255
ifTrue: [ ^ block value: aCharacter ].
^ classification at: index! !
!PPCharSetPredicate class methodsFor: 'instance creation' stamp: 'lr 8/25/2010 11:05'!
on: aBlock
^ self basicNew initializeOn: aBlock! !
!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 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/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 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 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 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 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 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 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 9/1/2010 22:03'!
optional
"Answer a new parser that parses the receiver, if possible."
^ PPOptionalParser on: self! !
!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-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 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 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 5/15/2008 16:08'!
flatten
"Answer a new parser that flattens the underlying collection."
^ PPFlattenParser on: self! !
!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/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 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/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-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 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 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 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: 'converting' stamp: 'lr 11/29/2011 20:48'!
asParser
"Answer the receiving parser."
^ self! !
!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:35'!
name
"Answer the production name of the receiver."
^ self propertyAt: #name ifAbsent: [ nil ]! !
!PPParser methodsFor: 'accessing' stamp: 'lr 4/19/2010 10:38'!
name: aString
self propertyAt: #name put: aString! !
!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/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/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: '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: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: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'!
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 ])
at: aKey put: anObject! !
!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: '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: 'initialization' stamp: 'lr 4/24/2008 10:33'!
initialize! !
!PPParser methodsFor: 'testing' stamp: 'lr 8/6/2010 16:44'!
isPetitParser
^ true! !
!PPParser methodsFor: 'testing' stamp: 'lr 10/27/2008 11:28'!
isUnresolved
^ false! !
!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 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 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: '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 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 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 6/4/2011 18:11'!
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)."
[ :stream | stream position + 1 ] asParser , self , [ :stream | stream position ] asParser
matchesIn: anObject
do: [ :value | aBlock value: (value first to: value last) ]! !
!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: 'DamienCassou 10/29/2011 19:19'!
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)."
[ :stream | stream position + 1 ] asParser , self , [ :stream | stream position ] asParser
matchesSkipIn: anObject
do: [ :value | aBlock value: (value first to: value last) ]! !
!PPParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:53'!
parse: anObject
"Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
^ self parseOn: anObject asPetitStream! !
!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 2/7/2010 22:18'!
parseOn: aStream
"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: '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/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/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/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/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/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/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/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/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/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/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: '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/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/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: 'copying' stamp: 'lr 4/19/2010 10:33'!
postCopy
super postCopy.
properties := properties copy! !
!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 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! !
!PPUnresolvedParser methodsFor: 'testing' stamp: 'lr 10/27/2008 11:29'!
isUnresolved
^ true! !
!PPUnresolvedParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:51'!
parseOn: aStream
self error: self printString , ' need to be resolved before execution.'! !
!PPDelegateParser methodsFor: 'accessing' stamp: 'lr 10/21/2009 16:37'!
children
^ Array with: parser! !
!PPDelegateParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:47'!
parseOn: aStream
^ parser parseOn: aStream! !
!PPDelegateParser methodsFor: 'initialization' stamp: 'lr 4/20/2008 16:23'!
setParser: aParser
parser := aParser! !
!PPDelegateParser class methodsFor: 'instance creation' stamp: 'lr 4/20/2008 16:22'!
on: aParser
^ self new setParser: aParser! !
!PPCompositeParser methodsFor: 'initialization' stamp: 'lr 5/8/2011 15:27'!
initializeStartingAt: aSymbol
| productionNames |
self initialize.
productionNames := self productionNames.
parser := PPDelegateParser named: aSymbol.
productionNames keysAndValuesDo: [ :key :value |
self instVarAt: key put: (PPDelegateParser named: value) ].
parser setParser: (self perform: aSymbol).
productionNames keysAndValuesDo: [ :key :value |
(self instVarAt: key) setParser: (self perform: value) ]! !
!PPCompositeParser methodsFor: 'querying' stamp: 'lr 12/4/2009 18:39'!
productionAt: aSymbol
"Answer the production named aSymbol."
^ self productionAt: aSymbol ifAbsent: [ nil ]! !
!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: 'accessing' stamp: 'lr 5/16/2008 17:32'!
start
"Answer the production to start this parser with."
self subclassResponsibility! !
!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: '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: 'instance creation' stamp: 'lr 12/7/2009 08:24'!
newStartingAt: aSymbol
"Answer a new parser starting at aSymbol."
^ self basicNew initializeStartingAt: aSymbol! !
!PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:57'!
parse: anObject
^ self parse: anObject startingAt: 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 20:57'!
parse: anObject startingAt: aSymbol
^ (self newStartingAt: aSymbol) parse: anObject! !
!PPCompositeParser class methodsFor: 'parsing' stamp: 'lr 2/7/2010 21:02'!
parse: anObject startingAt: aSymbol onError: aBlock
^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock! !
!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: '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'!
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 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: '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: '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 ]! !
!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'!
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'!
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: '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.' ]! !
!PPActionParser methodsFor: 'accessing' stamp: 'lr 4/30/2010 11:10'!
block
"Answer the action block of the receiver."
^ block! !
!PPActionParser methodsFor: 'parsing' stamp: 'pmon 6/1/2012 00:27'!
parseOn: aStream
| element |
^ (element := parser parseOn: aStream) isPetitFailure
ifFalse: [ block isSymbol
ifTrue: [ element perform: block]
ifFalse: [ block value: element ] ]
ifTrue: [ element ]! !
!PPActionParser methodsFor: 'initialization' stamp: 'lr 5/2/2010 16:58'!
setBlock: aBlock
block := aBlock! !
!PPActionParser class methodsFor: 'instance creation' stamp: 'lr 5/2/2010 16:58'!
on: aParser block: aBlock
^ (self on: aParser) setBlock: aBlock! !
!PPWrappingParser methodsFor: 'parsing' stamp: 'lr 5/12/2010 20:19'!
parseOn: aStream
^ block value: aStream value: [ parser parseOn: aStream ]! !
!PPAndParser methodsFor: 'operators' stamp: 'lr 5/1/2010 16:16'!
and
^ self! !
!PPAndParser methodsFor: 'parsing' stamp: 'lr 8/1/2010 17:10'!
parseOn: aStream
| element position |
position := aStream position.
element := parser parseOn: aStream.
aStream position: position.
^ element! !
!PPEndOfInputParser methodsFor: 'operators' stamp: 'lr 12/7/2009 08:53'!
end
^ self! !
!PPEndOfInputParser methodsFor: 'parsing' stamp: 'lr 8/1/2010 17:10'!
parseOn: aStream
| position result |
position := aStream position.
result := parser parseOn: aStream.
(result isPetitFailure or: [ aStream atEnd ])
ifTrue: [ ^ result ].
result := PPFailure
message: 'end of input expected'
at: aStream position.
aStream position: position.
^ result! !
!PPFlattenParser methodsFor: 'private' stamp: 'lr 6/16/2008 10:10'!
create: aCollection start: aStartInteger stop: aStopInteger
^ aCollection copyFrom: aStartInteger to: aStopInteger! !
!PPFlattenParser methodsFor: 'parsing' stamp: 'lr 8/1/2010 17:11'!
parseOn: aStream
| start element stop |
start := aStream position.
element := parser parseOn: aStream.
element isPetitFailure ifTrue: [
aStream position: start.
^ element ].
stop := aStream position.
^ self create: aStream collection start: start + 1 stop: stop! !
!PPTokenParser methodsFor: 'private' stamp: 'lr 12/7/2009 09:54'!
create: aCollection start: aStartInteger stop: aStopInteger
^ self tokenClass on: aCollection start: aStartInteger stop: aStopInteger! !
!PPTokenParser methodsFor: 'private' stamp: 'lr 4/6/2010 19:18'!
defaultTokenClass
^ PPToken! !
!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! !
!PPMemoizedParser methodsFor: 'operators' stamp: 'lr 4/2/2009 19:48'!
memoized
"Ther is no point in memoizing more than once."
^ self! !
!PPMemoizedParser methodsFor: 'parsing' stamp: 'lr 8/1/2010 17:11'!
parseOn: aStream
| memento |
stream == aStream
ifFalse: [ self reset: aStream ].
memento := (buffer at: stream position + 1)
ifNil: [ buffer at: stream position + 1 put: PPMemento new ].
memento position isNil
ifTrue: [
memento result: (stream size - stream position + 2 < memento count
ifTrue: [ PPFailure message: 'overflow' at: stream position ]
ifFalse: [ memento increment. parser parseOn: stream ]).
memento position: stream position ]
ifFalse: [ stream position: memento position ].
^ memento result! !
!PPMemoizedParser methodsFor: 'private' stamp: 'lr 4/2/2009 19:22'!
reset: aStream
stream := aStream.
buffer := Array new: aStream size + 1! !
!PPNotParser methodsFor: 'parsing' stamp: 'lr 8/1/2010 17:11'!
parseOn: aStream
| element position |
position := aStream position.
element := parser parseOn: aStream.
aStream position: position.
^ element isPetitFailure
ifFalse: [ PPFailure message: '' at: aStream position ]! !
!PPOptionalParser methodsFor: 'parsing' stamp: 'lr 8/14/2011 11:47'!
parseOn: aStream
| element |
element := parser parseOn: aStream.
^ element isPetitFailure ifFalse: [ element ]! !
!PPRepeatingParser methodsFor: 'initialization' stamp: 'lr 4/1/2011 21:06'!
initialize
super initialize.
self setMin: 0; setMax: SmallInteger maxVal! !
!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: '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: '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: $]! !
!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: 'private' stamp: 'lr 4/2/2011 10:10'!
matchesLimitOn: aStream
| element position |
position := aStream position.
element := limit parseOn: aStream.
aStream position: position.
^ element isPetitFailure not! !
!PPLimitedRepeatingParser methodsFor: 'initialization' stamp: 'lr 4/2/2011 10:00'!
setLimit: aParser
limit := aParser! !
!PPLimitedRepeatingParser class methodsFor: 'instance creation' stamp: 'lr 4/3/2011 14:58'!
on: aParser limit: aLimitParser
^ (self on: aParser) setLimit: aLimitParser! !
!PPGreedyRepeatingParser methodsFor: 'parsing' stamp: 'lr 4/2/2011 15:54'!
parseOn: aStream
| start element elements positions |
start := aStream position.
elements := OrderedCollection new.
[ elements size < min ] whileTrue: [
(element := parser parseOn: aStream) isPetitFailure ifTrue: [
aStream position: start.
^ element ].
elements addLast: element ].
positions := OrderedCollection with: aStream position.
[ elements size < max and: [ (element := parser parseOn: aStream) isPetitFailure not ] ] whileTrue: [
elements addLast: element.
positions addLast: aStream position ].
[ positions isEmpty ] whileFalse: [
aStream position: positions last.
element := limit parseOn: aStream.
element isPetitFailure ifFalse: [
aStream position: positions last.
^ elements asArray ].
elements isEmpty ifTrue: [
aStream position: start.
^ element ].
elements removeLast.
positions removeLast ].
aStream position: start.
^ PPFailure message: 'overflow' at: start! !
!PPLazyRepeatingParser methodsFor: 'parsing' stamp: 'lr 4/2/2011 10:14'!
parseOn: aStream
| start element elements |
start := aStream position.
elements := OrderedCollection new.
[ elements size < min ] whileTrue: [
(element := parser parseOn: aStream) isPetitFailure ifTrue: [
aStream position: start.
^ element ].
elements addLast: element ].
[ self matchesLimitOn: aStream ] whileFalse: [
elements size < max ifFalse: [
aStream position: start.
^ PPFailure message: 'overflow' at: start ].
element := parser parseOn: aStream.
element isPetitFailure ifTrue: [
aStream position: start.
^ element ].
elements addLast: element ].
^ elements asArray! !
!PPPossessiveRepeatingParser methodsFor: 'parsing' stamp: 'lr 4/2/2011 09:52'!
parseOn: aStream
| start element elements |
start := aStream position.
elements := OrderedCollection new.
[ elements size < min ] whileTrue: [
(element := parser parseOn: aStream) isPetitFailure ifTrue: [
aStream position: start.
^ element ].
elements addLast: element ].
[ elements size < max ] whileTrue: [
(element := parser parseOn: aStream) isPetitFailure
ifTrue: [ ^ elements asArray ].
elements addLast: element ].
^ elements asArray! !
!PPTrimmingParser methodsFor: 'parsing' stamp: 'lr 8/1/2010 17:11'!
parseOn: aStream
| position element |
position := aStream position.
[ (trimmer parseOn: aStream) isPetitFailure ]
whileFalse.
element := parser parseOn: aStream.
element isPetitFailure ifTrue: [
aStream position: position.
^ element ].
[ (trimmer parseOn: aStream) isPetitFailure ]
whileFalse.
^ element! !
!PPTrimmingParser methodsFor: 'initialization' stamp: 'lr 7/31/2010 12:00'!
setTrimmer: aParser
trimmer := aParser! !
!PPTrimmingParser class methodsFor: 'instance creation' stamp: 'lr 7/31/2010 12:01'!
on: aParser trimmer: aTrimParser
^ self new
setParser: aParser;
setTrimmer: aTrimParser;
yourself! !
!PPEpsilonParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:49'!
parseOn: aStream
^ nil! !
!PPFailingParser methodsFor: 'accessing' stamp: 'lr 4/30/2010 11:10'!
message
"Answer the error message of the receiving parser."
^ message! !
!PPFailingParser methodsFor: 'parsing' stamp: 'lr 5/5/2010 13:57'!
parseOn: aStream
^ PPFailure message: message at: aStream position! !
!PPFailingParser methodsFor: 'printing' stamp: 'lr 4/16/2010 21:27'!
printNameOn: aStream
super printNameOn: aStream.
aStream nextPutAll: ', '; print: message! !
!PPFailingParser methodsFor: 'initialization' stamp: 'lr 5/2/2010 19:16'!
setMessage: aString
message := aString! !
!PPFailingParser class methodsFor: 'instance creation' stamp: 'lr 5/2/2010 19:16'!
message: aString
^ self new setMessage: aString! !
!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 methodsFor: 'initialization' stamp: 'lr 4/29/2010 10:12'!
initialize
super initialize.
self setParsers: #()! !
!PPListParser methodsFor: 'initialization' stamp: 'lr 4/29/2010 10:12'!
setParsers: aCollection
parsers := aCollection asArray! !
!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 9/23/2008 18:32'!
with: aFirstParser with: aSecondParser
^ self withAll: (Array with: aFirstParser with: aSecondParser)! !
!PPListParser class methodsFor: 'instance creation' stamp: 'lr 4/29/2010 10:12'!
withAll: aCollection
^ self basicNew setParsers: aCollection! !
!PPChoiceParser methodsFor: 'operators' stamp: 'lr 9/17/2008 00:16'!
/ aRule
^ self copyWith: aRule! !
!PPChoiceParser methodsFor: 'parsing' stamp: 'lr 5/22/2010 11:48'!
parseOn: aStream
"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: aStream.
element isPetitFailure
ifFalse: [ ^ element ] ].
^ element! !
!PPSequenceParser methodsFor: 'operators' stamp: 'lr 9/17/2008 00:17'!
, aRule
^ self copyWith: aRule! !
!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: 'parsing' stamp: 'lr 5/6/2010 10:47'!
parseOn: aStream
"This is optimized code that avoids unnecessary block activations, do not change."
| start elements element |
start := aStream position.
elements := Array new: parsers size.
1 to: parsers size do: [ :index |
element := (parsers at: index)
parseOn: aStream.
element isPetitFailure ifTrue: [
aStream position: start.
^ element ].
elements at: index put: element ].
^ elements! !
!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: 'accessing' stamp: 'lr 5/2/2010 13:26'!
literal
"Answer the parsed literal."
^ literal! !
!PPLiteralParser methodsFor: 'accessing' stamp: 'lr 5/2/2010 13:26'!
message
"Answer the failure message."
^ message! !
!PPLiteralParser methodsFor: 'printing' stamp: 'lr 4/16/2010 16:38'!
printNameOn: aStream
super printNameOn: aStream.
aStream nextPutAll: ', '; print: literal! !
!PPLiteralParser class methodsFor: 'instance creation' stamp: 'lr 1/7/2010 15:30'!
on: anObject
^ self on: anObject message: anObject printString , ' expected'! !
!PPLiteralParser class methodsFor: 'instance creation' stamp: 'lr 1/7/2010 15:29'!
on: anObject message: aString
^ self new initializeOn: anObject message: aString! !
!PPLiteralObjectParser methodsFor: 'operators' stamp: 'pmon 5/31/2012 23:48'!
caseInsensitive
"Answer a parser that can parse the receiver case-insensitive."
literal asUppercase = literal asLowercase ifTrue: [ ^ self ].
^ PPPredicateObjectParser on: [ :value | literal asLowercase = value asLowercase ] message: message! !
!PPLiteralObjectParser methodsFor: 'operators' stamp: 'lr 4/28/2011 20:02'!
negate
^ (PPPredicateObjectParser expect: literal message: message) negate! !
!PPLiteralObjectParser methodsFor: 'parsing' stamp: 'lr 10/30/2010 11:48'!
parseOn: aStream
^ (aStream atEnd not and: [ literal = aStream uncheckedPeek ])
ifFalse: [ PPFailure message: message at: aStream position ]
ifTrue: [ aStream next ]! !
!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! !
!PPLiteralSequenceParser methodsFor: 'initialization' stamp: 'lr 6/1/2010 22:21'!
initializeOn: anObject message: aString
super initializeOn: anObject message: aString.
size := literal size! !
!PPLiteralSequenceParser methodsFor: 'parsing' stamp: 'lr 10/30/2010 11:48'!
parseOn: aStream
| position result |
position := aStream position.
result := aStream next: size.
literal = result ifTrue: [ ^ result ].
aStream position: position.
^ PPFailure message: message at: aStream position! !
!PPLiteralSequenceParser methodsFor: 'accessing' stamp: 'lr 9/15/2010 11:16'!
size
"Answer the sequence size of the receiver."
^ size! !
!PPPluggableParser methodsFor: 'accessing' stamp: 'lr 4/30/2010 11:10'!
block
"Answer the pluggable block."
^ block! !
!PPPluggableParser methodsFor: 'initialization' stamp: 'lr 5/2/2010 16:52'!
initializeOn: aBlock
block := aBlock! !
!PPPluggableParser methodsFor: 'parsing' stamp: 'lr 2/7/2010 20:54'!
parseOn: aStream
| position result |
position := aStream position.
result := block value: aStream.
result isPetitFailure
ifTrue: [ aStream position: position ].
^ result! !
!PPPluggableParser class methodsFor: 'instance creation' stamp: 'lr 5/2/2010 16:52'!
on: aBlock
^ self new initializeOn: aBlock! !
!PPPredicateParser methodsFor: 'accessing' stamp: 'lr 5/2/2010 13:36'!
block
"Answer the predicate block of the receiver."
^ predicate! !
!PPPredicateParser methodsFor: 'accessing' stamp: 'lr 5/2/2010 13:36'!
message
"Answer the failure message."
^ predicateMessage! !
!PPPredicateParser methodsFor: 'printing' stamp: 'lr 5/2/2010 13:37'!
printNameOn: aStream
super printNameOn: aStream.
aStream nextPutAll: ', '; print: predicateMessage! !
!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 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: 'parsing' stamp: 'lr 9/30/2010 11:05'!
parseOn: aStream
^ (aStream atEnd not and: [ predicate value: aStream uncheckedPeek ])
ifFalse: [ PPFailure message: predicateMessage at: aStream position ]
ifTrue: [ aStream next ]! !
!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 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'!
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
^ self expect: anObject message: anObject printString , ' 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: '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:02'!
char: aCharacter
^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , ' expected'! !
!PPPredicateObjectParser class methodsFor: 'factory-chars' stamp: 'lr 8/25/2010 10:57'!
char: aCharacter message: aString
^ self expect: aCharacter message: aString! !
!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: 'pmon 5/31/2012 23:56'!
cr
^ self char: Character cr message: 'carriage return expected'! !
!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: 'MM 3/3/2024 10:39:09'!
hex
^ self
on: (PPCharSetPredicate on: [ :char |
(char codePoint >= $0 codePoint and: [char codePoint <= $9 codePoint])
or: [char codePoint >= $a codePoint and: [char codePoint <= $f codePoint]]
or: [char codePoint >= $A codePoint and: [char codePoint <= $F codePoint]]] )
message: 'hex 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: 'pmon 5/31/2012 23:54'!
lf
^ self char: Character lf! !
!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: 'pmon 5/31/2012 23:57'!
newline
^ self chars: (String with: Character cr with: Character lf) message: 'newline 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:06'!
space
^ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: 'separator 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'!
uppercase
^ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: 'uppercase letter 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: '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! !
!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 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: 'parsing' stamp: 'lr 6/12/2010 09:25'!
parseOn: aStream
| position result |
position := aStream position.
result := aStream next: size.
(result size = size and: [ predicate value: result ])
ifTrue: [ ^ result ].
aStream position: position.
^ PPFailure message: predicateMessage at: aStream position! !
!PPPredicateSequenceParser methodsFor: 'accessing' stamp: 'lr 6/12/2010 08:58'!
size
"Answer the sequence size of the receiver."
^ size! !
!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 ! !
!Object methodsFor: '*petitparser-core-converting' stamp: 'lr 12/18/2011 15:58'!
asParser
"Answer a parser accepting the receiving object."
^ PPPredicateObjectParser expect: self! !
!Object methodsFor: '*petitparser-core-testing' stamp: 'lr 2/7/2010 20:54'!
isPetitFailure
^ false! !
!Object methodsFor: '*petitparser-core-testing' stamp: 'lr 8/6/2010 16:44'!
isPetitParser
^ false! !
!UndefinedObject methodsFor: '*petitparser-converting' stamp: 'lr 11/29/2011 20:49'!
asParser
"Answer a parser that succeeds and does not consume anything."
^ PPEpsilonParser new! !
!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! !
!Character methodsFor: '*petitparser-core-converting' stamp: 'lr 12/18/2011 15:58'!
asParser
"Answer a parser that accepts the receiving character."
^ PPLiteralObjectParser on: self! !
!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! !
!Collection methodsFor: '*petitparser-core-converting' stamp: 'lr 11/29/2011 20:38'!
asChoiceParser
^ PPChoiceParser withAll: (self collect: [ :each | each asParser ])! !
!Collection methodsFor: '*petitparser-core-converting' stamp: 'lr 11/29/2011 20:38'!
asSequenceParser
^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])! !
!SequenceableCollection methodsFor: '*petitparser-core-converting' stamp: 'lr 12/18/2011 15:57'!
asParser
self notify: 'SequenceableCollection>>#asParser is no longer supported. If you would like to create a PPSequenceParser from a Collection consider using #asSequenceParser instead.'.
^ self asSequenceParser! !
!SequenceableCollection methodsFor: '*petitparser-core-converting' stamp: 'lr 2/7/2010 20:53'!
asPetitStream
^ PPStream on: self! !
!String methodsFor: '*petitparser-core-converting' stamp: 'lr 11/29/2011 20:48'!
asParser
"Answer a parser that accepts the receiving string."
^ PPLiteralSequenceParser on: self! !
!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! !
!UnicodeString methodsFor: '*petitparser-core-converting' stamp: 'jmv 10/31/2022 17:46:45'!
asParser
"Answer a parser that accepts the receiving string."
^ PPLiteralSequenceParser on: self! !
!UnicodeSymbol methodsFor: '*petitparser-core-converting' stamp: 'jmv 10/31/2022 18:06:00'!
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! !
!Text methodsFor: '*petitparser-core-converting' stamp: 'lr 2/7/2010 20:53'!
asPetitStream
^ string asPetitStream! !
!Set methodsFor: '*petitparser-core-converting' stamp: 'lr 12/18/2011 15:57'!
asParser
self notify: 'Set>>#asParser is no longer supported. If you would like to create a PPChoiceParser from a Collection consider using #asChoiceParser instead. Sets have a unpredictable order and should be avoided'.
^ self asChoiceParser! !
!Stream methodsFor: '*petitparser-core-converting' stamp: 'lr 4/8/2010 14:46'!
asPetitStream
^ self contents asPetitStream! !
PPToken initialize!
-------------- next part --------------
'From Cuis6.3 [latest update: #6247] on 3 March 2024 at 10:43:47 am'!
'Description Please enter a description for this package '!
!provides: 'PetitTests' 1 4!
!requires: 'PetitParser' 1 2 nil!
SystemOrganization addCategory: #'PetitTests-Core'!
SystemOrganization addCategory: #'PetitTests-Examples'!
SystemOrganization addCategory: #'PetitTests-Tests'!
!classDefinition: #PPAbstractParserTest category: #'PetitTests-Core'!
TestCase subclass: #PPAbstractParserTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Core'!
!classDefinition: 'PPAbstractParserTest class' category: #'PetitTests-Core'!
PPAbstractParserTest class
instanceVariableNames: ''!
!classDefinition: #PPCompositeParserTest category: #'PetitTests-Core'!
PPAbstractParserTest subclass: #PPCompositeParserTest
instanceVariableNames: 'parser result'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Core'!
!classDefinition: 'PPCompositeParserTest class' category: #'PetitTests-Core'!
PPCompositeParserTest class
instanceVariableNames: ''!
!classDefinition: #PPArithmeticParserTest category: #'PetitTests-Tests'!
PPCompositeParserTest subclass: #PPArithmeticParserTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Tests'!
!classDefinition: 'PPArithmeticParserTest class' category: #'PetitTests-Tests'!
PPArithmeticParserTest class
instanceVariableNames: ''!
!classDefinition: #PPExpressionParserTest category: #'PetitTests-Tests'!
PPArithmeticParserTest subclass: #PPExpressionParserTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Tests'!
!classDefinition: 'PPExpressionParserTest class' category: #'PetitTests-Tests'!
PPExpressionParserTest class
instanceVariableNames: ''!
!classDefinition: #PPLambdaParserTest category: #'PetitTests-Tests'!
PPCompositeParserTest subclass: #PPLambdaParserTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Tests'!
!classDefinition: 'PPLambdaParserTest class' category: #'PetitTests-Tests'!
PPLambdaParserTest class
instanceVariableNames: ''!
!classDefinition: #PPComposedTest category: #'PetitTests-Tests'!
PPAbstractParserTest subclass: #PPComposedTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Tests'!
!classDefinition: 'PPComposedTest class' category: #'PetitTests-Tests'!
PPComposedTest class
instanceVariableNames: ''!
!classDefinition: #PPExtensionTest category: #'PetitTests-Tests'!
PPAbstractParserTest subclass: #PPExtensionTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Tests'!
!classDefinition: 'PPExtensionTest class' category: #'PetitTests-Tests'!
PPExtensionTest class
instanceVariableNames: ''!
!classDefinition: #PPObjectTest category: #'PetitTests-Tests'!
PPAbstractParserTest subclass: #PPObjectTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Tests'!
!classDefinition: 'PPObjectTest class' category: #'PetitTests-Tests'!
PPObjectTest class
instanceVariableNames: ''!
!classDefinition: #PPParserTest category: #'PetitTests-Tests'!
PPAbstractParserTest subclass: #PPParserTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Tests'!
!classDefinition: 'PPParserTest class' category: #'PetitTests-Tests'!
PPParserTest class
instanceVariableNames: ''!
!classDefinition: #PPPredicateTest category: #'PetitTests-Tests'!
PPAbstractParserTest subclass: #PPPredicateTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Tests'!
!classDefinition: 'PPPredicateTest class' category: #'PetitTests-Tests'!
PPPredicateTest class
instanceVariableNames: ''!
!classDefinition: #PPScriptingTest category: #'PetitTests-Tests'!
PPAbstractParserTest subclass: #PPScriptingTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Tests'!
!classDefinition: 'PPScriptingTest class' category: #'PetitTests-Tests'!
PPScriptingTest class
instanceVariableNames: ''!
!classDefinition: #PPTokenTest category: #'PetitTests-Tests'!
PPAbstractParserTest subclass: #PPTokenTest
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Tests'!
!classDefinition: 'PPTokenTest class' category: #'PetitTests-Tests'!
PPTokenTest class
instanceVariableNames: ''!
!classDefinition: #PPParserResource category: #'PetitTests-Core'!
TestResource subclass: #PPParserResource
instanceVariableNames: 'parsers'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Core'!
!classDefinition: 'PPParserResource class' category: #'PetitTests-Core'!
PPParserResource class
instanceVariableNames: ''!
!classDefinition: #PPArithmeticParser category: #'PetitTests-Examples'!
PPCompositeParser subclass: #PPArithmeticParser
instanceVariableNames: 'terms addition factors multiplication power primary parentheses number'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Examples'!
!classDefinition: 'PPArithmeticParser class' category: #'PetitTests-Examples'!
PPArithmeticParser class
instanceVariableNames: ''!
!classDefinition: #PPLambdaParser category: #'PetitTests-Examples'!
PPCompositeParser subclass: #PPLambdaParser
instanceVariableNames: 'expression abstraction application variable'
classVariableNames: ''
poolDictionaries: ''
category: 'PetitTests-Examples'!
!classDefinition: 'PPLambdaParser class' category: #'PetitTests-Examples'!
PPLambdaParser class
instanceVariableNames: ''!
!PPScriptingTest commentStamp: '<historical>' prior: 0!
These are some simple demo-scripts of parser combinators for the compiler construction course.
http://www.iam.unibe.ch/~scg/Teaching/CC/index.html!
!PPAbstractParserTest methodsFor: 'utilities' stamp: 'DamienPollet 8/11/2011 01:50'!
assert: aParser fail: aCollection
^ self assert: aParser fail: aCollection end: 0! !
!PPAbstractParserTest methodsFor: 'utilities' stamp: 'DamienPollet 8/11/2011 01:49'!
assert: aParser fail: aCollection end: anInteger
| stream result |
self
assert: aParser isPetitParser
description: 'Parser invalid'.
stream := aCollection asPetitStream.
result := aParser parse: stream.
self
assert: result isPetitFailure
description: 'Parser did not fail'.
self
assert: stream position = anInteger
description: 'Parser failed at wrong position'.
^ result! !
!PPAbstractParserTest methodsFor: 'utilities' stamp: 'DamienPollet 8/11/2011 01:49'!
assert: aParser parse: aCollection
^ self assert: aParser parse: aCollection to: nil end: aCollection size ! !
!PPAbstractParserTest methodsFor: 'utilities' stamp: 'DamienPollet 8/11/2011 01:49'!
assert: aParser parse: aCollection end: anInteger
^ self assert: aParser parse: aCollection to: nil end: anInteger! !
!PPAbstractParserTest methodsFor: 'utilities' stamp: 'DamienPollet 8/11/2011 01:49'!
assert: aParser parse: aCollection to: anObject
^ self assert: aParser parse: aCollection to: anObject end: aCollection size ! !
!PPAbstractParserTest methodsFor: 'utilities' stamp: 'DamienPollet 8/11/2011 01:49'!
assert: aParser parse: aParseObject to: aTargetObject end: anInteger
| stream result |
self
assert: aParser isPetitParser
description: 'Parser invalid'.
stream := aParseObject asPetitStream.
result := aParser parse: stream.
aTargetObject isNil
ifTrue: [ self deny: result isPetitFailure ]
ifFalse: [ self assert: result = aTargetObject ].
self
assert: stream position = anInteger
description: 'Parser accepted at wrong position'.
^ result! !
!PPAbstractParserTest methodsFor: 'utilities' stamp: 'lr 10/6/2009 08:21'!
assert: aParser parse: aParserObject toToken: from stop: to
| token |
token := PPToken on: aParserObject start: from stop: to.
^ self assert: aParser parse: aParserObject to: token! !
!PPAbstractParserTest methodsFor: 'utilities' stamp: 'lr 10/6/2009 08:22'!
assert: aParser parse: aParserObject toToken: from stop: to end: end
| token |
token := PPToken on: aParserObject start: from stop: to.
^ self assert: aParser parse: aParserObject to: token end: end! !
!PPAbstractParserTest class methodsFor: 'testing' stamp: 'lr 1/12/2011 21:23'!
isAbstract
^ self name = #PPAbstractParserTest! !
!PPAbstractParserTest class methodsFor: 'accessing' stamp: 'lr 6/12/2010 08:22'!
packageNamesUnderTest
^ #('PetitParser' 'PetitTests')! !
!PPCompositeParserTest methodsFor: 'accessing' stamp: 'FirstnameLastname 11/26/2009 21:52'!
parserClass
self subclassResponsibility! !
!PPCompositeParserTest methodsFor: 'accessing' stamp: 'lr 3/29/2010 15:21'!
parserInstance
^ PPParserResource current parserAt: self parserClass! !
!PPCompositeParserTest methodsFor: 'accessing' stamp: 'lr 11/18/2011 19:44'!
parserInstanceFor: aSymbol
^ aSymbol = #start
ifTrue: [ self parserInstance ]
ifFalse: [
self parserInstance
productionAt: aSymbol
ifAbsent: [ self error: 'Production ' , self parserClass name , '>>' , aSymbol printString , ' not found.' ] ]! !
!PPCompositeParserTest methodsFor: 'utilities' stamp: 'lr 11/29/2010 11:20'!
assert: aCollection is: anObject
self parse: aCollection.
self
assert: result = anObject
description: 'Got: ' , result printString , '; Expected: ' , anObject printString
resumable: true! !
!PPCompositeParserTest methodsFor: 'parsing' stamp: 'lr 11/18/2011 19:45'!
fail: aString rule: aSymbol
| production |
production := self parserInstanceFor: aSymbol.
result := production end parse: aString.
self
assert: result isPetitFailure
description: 'Able to parse ' , aString printString.
^ result! !
!PPCompositeParserTest methodsFor: 'parsing' stamp: 'lr 11/29/2010 11:26'!
parse: aString
^ self parse: aString rule: #start! !
!PPCompositeParserTest methodsFor: 'parsing' stamp: 'lr 11/18/2011 19:45'!
parse: aString rule: aSymbol
| production |
production := self parserInstanceFor: aSymbol.
result := production end parse: aString.
self
deny: result isPetitFailure
description: 'Unable to parse ' , aString printString.
^ result! !
!PPCompositeParserTest methodsFor: 'running' stamp: 'FirstnameLastname 11/26/2009 21:48'!
setUp
super setUp.
parser := self parserInstance! !
!PPCompositeParserTest methodsFor: 'running' stamp: 'lr 11/29/2010 11:19'!
tearDown
super tearDown.
parser := result := nil! !
!PPCompositeParserTest class methodsFor: 'testing' stamp: 'lr 10/4/2009 17:09'!
isAbstract
^ self name = #PPCompositeParserTest! !
!PPCompositeParserTest class methodsFor: 'accessing' stamp: 'lr 3/29/2010 15:21'!
resources
^ Array with: PPParserResource! !
!PPArithmeticParserTest methodsFor: 'accessing' stamp: 'FirstnameLastname 11/26/2009 21:53'!
parserClass
^ PPArithmeticParser! !
!PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/30/2008 17:21'!
testAdd
self assert: '1 + 2' is: 3.
self assert: '2 + 1' is: 3.
self assert: '1 + 2.3' is: 3.3.
self assert: '2.3 + 1' is: 3.3.
self assert: '1 + -2' is: -1.
self assert: '-2 + 1' is: -1! !
!PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/21/2008 10:23'!
testAddMany
self assert: '1' is: 1.
self assert: '1 + 2' is: 3.
self assert: '1 + 2 + 3' is: 6.
self assert: '1 + 2 + 3 + 4' is: 10.
self assert: '1 + 2 + 3 + 4 + 5' is: 15! !
!PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/21/2008 09:32'!
testDiv
self assert: '12 / 3' is: 4.
self assert: '-16 / -4' is: 4! !
!PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 7/3/2008 15:46'!
testDivMany
self assert: '100 / 2' is: 50.
self assert: '100 / 2 / 2' is: 25.
self assert: '100 / 2 / 2 / 5' is: 5.
self assert: '100 / 2 / 2 / 5 / 5' is: 1
! !
!PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/21/2008 09:31'!
testMul
self assert: '2 * 3' is: 6.
self assert: '2 * -4' is: -8! !
!PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/21/2008 10:16'!
testMulMany
self assert: '1 * 2' is: 2.
self assert: '1 * 2 * 3' is: 6.
self assert: '1 * 2 * 3 * 4' is: 24.
self assert: '1 * 2 * 3 * 4 * 5' is: 120! !
!PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 7/3/2008 15:28'!
testPow
self assert: '2 ^ 3' is: 8.
self assert: '-2 ^ 3' is: -8.
self assert: '-2 ^ -3' is: -0.125! !
!PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 7/3/2008 15:45'!
testPowMany
self assert: '4 ^ 3' is: 64.
self assert: '4 ^ 3 ^ 2' is: 262144.
self assert: '4 ^ 3 ^ 2 ^ 1' is: 262144.
self assert: '4 ^ 3 ^ 2 ^ 1 ^ 0' is: 262144! !
!PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 8/14/2010 13:38'!
testSub
self assert: '1 - 2' is: -1.
self assert: '1.2 - 1.2' is: 0.
self assert: '1 - -2' is: 3.
self assert: '-1 - -2' is: 1! !
!PPArithmeticParserTest methodsFor: 'testing-operations' stamp: 'lr 4/28/2008 11:56'!
testSubMany
self assert: '1' is: 1.
self assert: '1 - 2' is: -1.
self assert: '1 - 2 - 3' is: -4.
self assert: '1 - 2 - 3 - 4' is: -8.
self assert: '1 - 2 - 3 - 4 - 5' is: -13! !
!PPArithmeticParserTest methodsFor: 'testing-expression' stamp: 'lr 4/21/2008 10:03'!
testBrackets
self assert: '(1)' is: 1.
self assert: '(1 + 2)' is: 3.
self assert: '((1))' is: 1.
self assert: '((1 + 2))' is: 3.
self assert: '2 * (3 + 4)' is: 14.
self assert: '(2 + 3) * 4' is: 20.
self assert: '6 / (2 + 4)' is: 1.
self assert: '(2 + 6) / 2' is: 4! !
!PPArithmeticParserTest methodsFor: 'testing-expression' stamp: 'lr 4/21/2008 10:00'!
testPriority
self assert: '2 * 3 + 4' is: 10.
self assert: '2 + 3 * 4' is: 14.
self assert: '6 / 3 + 4' is: 6.
self assert: '2 + 6 / 2' is: 5! !
!PPArithmeticParserTest methodsFor: 'testing' stamp: 'lr 4/21/2008 09:32'!
testNum
self assert: '0' is: 0.
self assert: '0.0' is: 0.0.
self assert: '1' is: 1.
self assert: '1.2' is: 1.2.
self assert: '34' is: 34.
self assert: '56.78' is: 56.78.
self assert: '-9' is: -9.
self assert: '-9.9' is: -9.9! !
!PPExpressionParserTest methodsFor: 'accessing' stamp: 'lr 4/6/2010 19:39'!
parserInstance
| expression parens number |
expression := PPExpressionParser new.
parens := $( asParser token trim , expression , $) asParser token trim
==> [ :nodes | nodes second ].
number := (#digit asParser plus , ($. asParser , #digit asParser plus) optional) token trim
==> [ :token | token value asNumber ].
expression term: parens / number.
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 ] ].
^ expression end! !
!PPExpressionParserTest methodsFor: 'testing' stamp: 'FirstnameLastname 11/26/2009 22:13'!
testPostfixAdd
self assert: '0++' is: 1.
self assert: '0++++' is: 2.
self assert: '0++++++' is: 3.
self assert: '0+++1' is: 2.
self assert: '0+++++1' is: 3.
self assert: '0+++++++1' is: 4! !
!PPExpressionParserTest methodsFor: 'testing' stamp: 'FirstnameLastname 11/26/2009 22:11'!
testPostfixSub
self assert: '1--' is: 0.
self assert: '2----' is: 0.
self assert: '3------' is: 0.
self assert: '2---1' is: 0.
self assert: '3-----1' is: 0.
self assert: '4-------1' is: 0.! !
!PPExpressionParserTest methodsFor: 'testing' stamp: 'FirstnameLastname 11/26/2009 22:13'!
testPrefixNegate
self assert: '1' is: 1.
self assert: '-1' is: -1.
self assert: '--1' is: 1.
self assert: '---1' is: -1! !
!PPExpressionParserTest class methodsFor: 'testing' stamp: 'lr 4/6/2010 19:40'!
shouldInheritSelectors
^ true! !
!PPLambdaParserTest methodsFor: 'accessing' stamp: 'FirstnameLastname 11/26/2009 21:53'!
parserClass
^ PPLambdaParser! !
!PPLambdaParserTest methodsFor: 'testing' stamp: 'lr 4/30/2008 09:38'!
testAbstraction
self assert: '\x.y' is: #('x' 'y').
self assert: '\x.\y.z' is: #('x' ('y' 'z'))! !
!PPLambdaParserTest methodsFor: 'testing' stamp: 'lr 4/30/2008 09:38'!
testApplication
self assert: '(x x)' is: #('x' 'x').
self assert: '(x y)' is: #('x' 'y').
self assert: '((x y) z)' is: #(('x' 'y') 'z').
self assert: '(x (y z))' is: #('x' ('y' 'z'))! !
!PPLambdaParserTest methodsFor: 'testing' stamp: 'lr 4/30/2008 09:33'!
testVariable
self assert: 'x' is: 'x'.
self assert: 'xy' is: 'xy'.
self assert: 'x12' is: 'x12'! !
!PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'!
testAnd
self assert: self parserClass and = #('p' ('q' (('p' 'q') 'p')))! !
!PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'!
testFalse
self assert: self parserClass false = #('x' ('y' 'y'))! !
!PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'!
testIfThenElse
self assert: self parserClass ifthenelse = #('p' 'p')! !
!PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'!
testNot
self assert: self parserClass not = #('p' ('a' ('b' (('p' 'b') 'a'))))! !
!PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'!
testOr
self assert: self parserClass or = #('p' ('q' (('p' 'p') 'q')))! !
!PPLambdaParserTest methodsFor: 'testing-curch' stamp: 'FirstnameLastname 11/26/2009 21:53'!
testTrue
self assert: self parserClass true = #('x' ('y' 'x'))! !
!PPLambdaParserTest methodsFor: 'testing-utilities' stamp: 'lr 11/29/2010 11:29'!
testParseOnError
| beenHere |
result := self parserClass
parse: '\x.y'
onError: [ self fail ].
self assert: result = #('x' 'y').
beenHere := false.
result := self parserClass
parse: '\x.'
onError: [ beenHere := true ].
self assert: beenHere.
beenHere := false.
result := self parserClass
parse: '\x.'
onError: [ :fail | beenHere := true. fail ].
self assert: beenHere.
self assert: (result message includesSubString: '$(').
self assert: (result message includesSubString: 'expected').
self assert: (result position = 0).
beenHere := false.
result := self parserClass
parse: '\x.'
onError: [ :msg :pos |
self assert: (msg includesSubString: '$(').
self assert: (msg includesSubString: 'expected').
self assert: (pos = 0).
beenHere := true ].
self assert: result.
self assert: beenHere! !
!PPLambdaParserTest methodsFor: 'testing-utilities' stamp: 'lr 11/29/2010 11:29'!
testParseStartingAtOnError
| beenHere |
result := self parserClass
parse: 'x'
startingAt: #variable
onError: [ self fail ].
self assert: result = 'x'.
beenHere := false.
result := self parserClass
parse: '\'
startingAt: #variable
onError: [ beenHere := true ].
self assert: beenHere.
beenHere := false.
result := self parserClass
parse: '\'
startingAt: #variable
onError: [ :fail | beenHere := true. fail ].
self assert: beenHere.
self assert: result message = 'letter expected'.
self assert: result position = 0.
beenHere := false.
result := self parserClass
parse: '\'
startingAt: #variable
onError: [ :msg :pos |
self assert: msg = 'letter expected'.
self assert: pos = 0.
beenHere := true ].
self assert: beenHere! !
!PPLambdaParserTest methodsFor: 'testing-utilities' stamp: 'FirstnameLastname 11/26/2009 21:56'!
testProductionAt
self assert: (parser productionAt: #foo) isNil.
self assert: (parser productionAt: #foo ifAbsent: [ true ]).
self assert: (parser productionAt: #start) notNil.
self assert: (parser productionAt: #start ifAbsent: [ true ]) notNil.
self assert: (parser productionAt: #variable) notNil.
self assert: (parser productionAt: #variable ifAbsent: [ true ]) notNil! !
!PPComposedTest methodsFor: 'accessing' stamp: 'lr 2/8/2010 16:44'!
comment
^ ($" asParser , $" asParser negate star , $" asParser) flatten! !
!PPComposedTest methodsFor: 'accessing' stamp: 'lr 2/8/2010 16:44'!
identifier
^ (#letter asParser , #word asParser star) flatten! !
!PPComposedTest methodsFor: 'accessing' stamp: 'lr 2/8/2010 16:44'!
number
^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten! !
!PPComposedTest methodsFor: 'testing-examples' stamp: 'lr 2/8/2010 16:44'!
testComment
self assert: self comment parse: '""' to: '""'.
self assert: self comment parse: '"a"' to: '"a"'.
self assert: self comment parse: '"ab"' to: '"ab"'.
self assert: self comment parse: '"abc"' to: '"abc"'.
self assert: self comment parse: '""a' to: '""' end: 2.
self assert: self comment parse: '"a"a' to: '"a"' end: 3.
self assert: self comment parse: '"ab"a' to: '"ab"' end: 4.
self assert: self comment parse: '"abc"a' to: '"abc"' end: 5.
self assert: self comment fail: '"'.
self assert: self comment fail: '"a'.
self assert: self comment fail: '"aa'.
self assert: self comment fail: 'a"'.
self assert: self comment fail: 'aa"'! !
!PPComposedTest methodsFor: 'testing-examples' stamp: 'lr 2/8/2010 16:44'!
testIdentifier
self assert: self identifier parse: 'a' to: 'a'.
self assert: self identifier parse: 'a1' to: 'a1'.
self assert: self identifier parse: 'a12' to: 'a12'.
self assert: self identifier parse: 'ab' to: 'ab'.
self assert: self identifier parse: 'a1b' to: 'a1b'.
self assert: self identifier parse: 'a_' to: 'a' end: 1.
self assert: self identifier parse: 'a1-' to: 'a1' end: 2.
self assert: self identifier parse: 'a12+' to: 'a12' end: 3.
self assert: self identifier parse: 'ab^' to: 'ab' end: 2.
self assert: self identifier parse: 'a1b*' to: 'a1b' end: 3.
self assert: self identifier fail: ''.
self assert: self identifier fail: '1'.
self assert: self identifier fail: '1a'! !
!PPComposedTest methodsFor: 'testing-examples' stamp: 'lr 2/8/2010 16:44'!
testNumber
self assert: self number parse: '1' to: '1'.
self assert: self number parse: '12' to: '12'.
self assert: self number parse: '12.3' to: '12.3'.
self assert: self number parse: '12.34' to: '12.34'.
self assert: self number parse: '1..' to: '1' end: 1.
self assert: self number parse: '12-' to: '12' end: 2.
self assert: self number parse: '12.3.' to: '12.3' end: 4.
self assert: self number parse: '12.34.' to: '12.34' end: 5.
self assert: self number parse: '-1' to: '-1'.
self assert: self number parse: '-12' to: '-12'.
self assert: self number parse: '-12.3' to: '-12.3'.
self assert: self number parse: '-12.34' to: '-12.34'.
self assert: self number fail: ''.
self assert: self number fail: '-'.
self assert: self number fail: '.'.
self assert: self number fail: '.1'! !
!PPComposedTest methodsFor: 'testing-examples' stamp: 'lr 6/3/2010 13:51'!
testReturn
| number spaces return |
number := #digit asParser plus token.
spaces := #space asParser star.
return := (spaces , $^ asParser token , spaces , number)
==> [ :nodes | Array with: #return with: (nodes at: 4) value ].
self assert: return parse: '^1' to: #(return '1').
self assert: return parse: '^12' to: #(return '12').
self assert: return parse: '^ 123' to: #(return '123').
self assert: return parse: '^ 1234' to: #(return '1234').
self assert: return fail: '1'.
self assert: return fail: '^'! !
!PPComposedTest methodsFor: 'testing' stamp: 'lr 7/6/2009 08:34'!
testDoubledString
| parser |
parser := ($' asParser , (($' asParser , $' asParser) / $' asParser negate) star flatten , $' asParser)
==> [ :nodes | nodes second copyReplaceAll: '''''' with: '''' ].
self assert: parser parse: '''''' to: ''.
self assert: parser parse: '''a''' to: 'a'.
self assert: parser parse: '''ab''' to: 'ab'.
self assert: parser parse: '''a''''b''' to: 'a''b'.
self assert: parser parse: '''a''''''''b''' to: 'a''''b'! !
!PPComposedTest methodsFor: 'testing' stamp: 'lr 12/5/2010 14:25'!
testEvenNumber
"Create a grammar that parses an even number of a's and b's."
| a as b bs s |
a := $a asParser ==> [ :char | as := as + 1 ].
b := $b asParser ==> [ :char | bs := bs + 1 ].
s := (a / b) star >=> [ :stream :cc |
as := bs := 0.
cc value.
(as even and: [ bs even ])
ifFalse: [ PPFailure message: 'Even number of a and b expected' at: 0 ] ].
self assert: s fail: 'a' end: 1.
self assert: s fail: 'b' end: 1.
self assert: s fail: 'ab' end: 2.
self assert: s fail: 'ba' end: 2.
self assert: s fail: 'aaa' end: 3.
self assert: s fail: 'bbb' end: 3.
self assert: s fail: 'aab' end: 3.
self assert: s fail: 'abb' end: 3.
self assert: s parse: ''.
self assert: s parse: 'aa'.
self assert: s parse: 'bb'.
self assert: s parse: 'aaaa'.
self assert: s parse: 'aabb'.
self assert: s parse: 'abab'.
self assert: s parse: 'baba'.
self assert: s parse: 'bbaa'.
self assert: s parse: 'bbbb'! !
!PPComposedTest methodsFor: 'testing' stamp: 'lr 6/24/2011 06:11'!
testIfThenElse
"S ::= if C then S else S | if C then S | X"
| start if then else cond expr parser |
start := PPDelegateParser new.
if := 'if' asParser token trim.
then := 'then' asParser token trim.
else := 'else' asParser token trim.
cond := 'C' asParser token trim.
expr := 'X' asParser token trim.
start setParser: (if , cond , then , start , else , start) / (if , cond , then , start) / expr.
parser := start end.
self assert: parser parse: 'X'.
self assert: parser parse: 'if C then X'.
self assert: parser parse: 'if C then X else X'.
self assert: parser parse: 'if C then if C then X'.
self assert: parser parse: 'if C then if C then X else if C then X'.
self assert: parser parse: 'if C then if C then X else X else if C then X'.
self assert: parser parse: 'if C then if C then X else X else if C then X else X'.
self assert: parser fail: 'if C'.
self assert: parser fail: 'if C else X'.
self assert: parser fail: 'if C then if C'! !
!PPComposedTest methodsFor: 'testing' stamp: 'lr 6/24/2011 06:09'!
testLeftRecursion
"S ::= S 'x' S / '1'"
| parser |
parser := PPDelegateParser new.
parser setParser: ((parser , $x asParser , parser) / $1 asParser) memoized flatten.
self assert: parser parse: '1' to: '1'.
self assert: parser parse: '1x1' to: '1x1'.
self assert: parser parse: '1x1x1' to: '1x1x1'.
self assert: parser parse: '1x1x1x1' to: '1x1x1x1'.
self assert: parser parse: '1x1x1x1x1' to: '1x1x1x1x1'.
self assert: parser parse: '1x1x1x1x1x1' to: '1x1x1x1x1x1'! !
!PPComposedTest methodsFor: 'testing' stamp: 'jmv 1/6/2021 11:57:31'!
testListOfIntegers
"S ::= S , number | number"
| number list parser |
number := #digit asParser plus token trim
==> [ :node | node value asNumber ].
list := (number separatedBy: $, asParser token trim)
==> [ :node | node select: [ :each | each isInteger ] ].
parser := list end.
self assert: parser parse: '1' to: (1 to: 1) asArray.
self assert: parser parse: '1,2' to: (1 to: 2) asArray.
self assert: parser parse: '1,2,3' to: (1 to: 3) asArray.
self assert: parser parse: '1,2,3,4' to: (1 to: 4) asArray.
self assert: parser parse: '1,2,3,4,5' to: (1 to: 5) asArray.
self assert: parser parse: '1' to: (1 to: 1) asArray.
self assert: parser parse: '1, 2' to: (1 to: 2) asArray.
self assert: parser parse: '1, 2, 3' to: (1 to: 3) asArray.
self assert: parser parse: '1, 2, 3, 4' to: (1 to: 4) asArray.
self assert: parser parse: '1, 2, 3, 4, 5' to: (1 to: 5) asArray.
self assert: parser parse: '1' to: (1 to: 1) asArray.
self assert: parser parse: '1 ,2' to: (1 to: 2) asArray.
self assert: parser parse: '1 ,2 ,3' to: (1 to: 3) asArray.
self assert: parser parse: '1 ,2 ,3 ,4' to: (1 to: 4) asArray.
self assert: parser parse: '1 ,2 ,3 ,4 ,5' to: (1 to: 5) asArray.
self assert: parser fail: ''.
self assert: parser fail: ','.
self assert: parser fail: '1,'.
self assert: parser fail: '1,,2'! !
!PPComposedTest methodsFor: 'testing' stamp: 'lr 6/24/2011 06:09'!
testNestedComments
"C ::= B I* E"
"I ::= !!E (C | T)"
"B ::= /*"
"E ::= */"
"T ::= ."
| begin end any inside parser |
begin := '/*' asParser.
end := '*/' asParser.
any := #any asParser.
parser := PPDelegateParser new.
inside := end not , (parser / any).
parser setParser: begin , inside star , end.
self assert: parser parse: '/*ab*/cd' end: 6.
self assert: parser parse: '/*a/*b*/c*/'.
self assert: parser fail: '/*a/*b*/c'! !
!PPComposedTest methodsFor: 'testing' stamp: 'lr 6/24/2011 06:10'!
testPalindrome
"S0 ::= a S1 a | b S1 b | ...
S1 ::= S0 | epsilon"
| s0 s1 parser |
s0 := PPDelegateParser new.
s1 := PPDelegateParser new.
s0 setParser: ($a asParser , s1 , $a asParser)
/ ($b asParser , s1 , $b asParser)
/ ($c asParser , s1 , $c asParser).
s1 setParser: s0 / nil asParser.
parser := s0 flatten end.
self assert: parser parse: 'aa' to: 'aa'.
self assert: parser parse: 'bb' to: 'bb'.
self assert: parser parse: 'cc' to: 'cc'.
self assert: parser parse: 'abba' to: 'abba'.
self assert: parser parse: 'baab' to: 'baab'.
self assert: parser parse: 'abccba' to: 'abccba'.
self assert: parser parse: 'abaaba' to: 'abaaba'.
self assert: parser parse: 'cbaabc' to: 'cbaabc'.
self assert: parser fail: 'a'.
self assert: parser fail: 'ab'.
self assert: parser fail: 'aab'.
self assert: parser fail: 'abccbb'! !
!PPComposedTest methodsFor: 'testing' stamp: 'lr 6/24/2011 06:10'!
testParseAaaBbb
"S0 ::= a S1 b
S1 ::= S0 | epsilon"
| s0 s1 parser |
s0 := PPDelegateParser new.
s1 := PPDelegateParser new.
s0 setParser: $a asParser , s1 , $b asParser.
s1 setParser: s0 / nil asParser.
parser := s0 flatten.
self assert: parser parse: 'ab' to: 'ab'.
self assert: parser parse: 'aabb' to: 'aabb'.
self assert: parser parse: 'aaabbb' to: 'aaabbb'.
self assert: parser parse: 'aaaabbbb' to: 'aaaabbbb'.
self assert: parser parse: 'abb' to: 'ab' end: 2.
self assert: parser parse: 'aabbb' to: 'aabb' end: 4.
self assert: parser parse: 'aaabbbb' to: 'aaabbb' end: 6.
self assert: parser parse: 'aaaabbbbb' to: 'aaaabbbb' end: 8.
self assert: parser fail: 'a'.
self assert: parser fail: 'b'.
self assert: parser fail: 'aab'.
self assert: parser fail: 'aaabb'! !
!PPComposedTest methodsFor: 'testing' stamp: 'lr 6/24/2011 06:10'!
testParseAaaaaa
"S ::= a a S | epsilon"
| s0 s1 parser |
s0 := PPDelegateParser new.
s1 := $a asParser , $a asParser , s0.
s0 setParser: s1 / nil asParser.
parser := s0 flatten.
self assert: parser parse: '' to: ''.
self assert: parser parse: 'aa' to: 'aa'.
self assert: parser parse: 'aaaa' to: 'aaaa'.
self assert: parser parse: 'aaaaaa' to: 'aaaaaa'.
self assert: parser parse: 'a' to: '' end: 0.
self assert: parser parse: 'aaa' to: 'aa' end: 2.
self assert: parser parse: 'aaaaa' to: 'aaaa' end: 4.
self assert: parser parse: 'aaaaaaa' to: 'aaaaaa' end: 6! !
!PPComposedTest methodsFor: 'testing' stamp: 'lr 9/18/2008 09:26'!
testParseAbAbAb
"S ::= (A B)+"
| parser |
parser := ($a asParser , $b asParser) plus flatten.
self assert: parser parse: 'ab' to: 'ab'.
self assert: parser parse: 'abab' to: 'abab'.
self assert: parser parse: 'ababab' to: 'ababab'.
self assert: parser parse: 'abababab' to: 'abababab'.
self assert: parser parse: 'abb' to: 'ab' end: 2.
self assert: parser parse: 'ababa' to: 'abab' end: 4.
self assert: parser parse: 'abababb' to: 'ababab' end: 6.
self assert: parser parse: 'ababababa' to: 'abababab' end: 8.
self assert: parser fail: ''.
self assert: parser fail: 'a'.
self assert: parser fail: 'bab'! !
!PPComposedTest methodsFor: 'testing' stamp: 'lr 9/18/2008 09:26'!
testParseAbabbb
"S ::= (A | B)+"
| parser |
parser := ($a asParser / $b asParser) plus flatten.
self assert: parser parse: 'a' to: 'a'.
self assert: parser parse: 'b' to: 'b'.
self assert: parser parse: 'ab' to: 'ab'.
self assert: parser parse: 'ba' to: 'ba'.
self assert: parser parse: 'aaa' to: 'aaa'.
self assert: parser parse: 'aab' to: 'aab'.
self assert: parser parse: 'aba' to: 'aba'.
self assert: parser parse: 'baa' to: 'baa'.
self assert: parser parse: 'abb' to: 'abb'.
self assert: parser parse: 'bab' to: 'bab'.
self assert: parser parse: 'bba' to: 'bba'.
self assert: parser parse: 'bbb' to: 'bbb'.
self assert: parser parse: 'ac' to: 'a' end: 1.
self assert: parser parse: 'bc' to: 'b' end: 1.
self assert: parser parse: 'abc' to: 'ab' end: 2.
self assert: parser parse: 'bac' to: 'ba' end: 2.
self assert: parser fail: ''.
self assert: parser fail: 'c'! !
!PPComposedTest methodsFor: 'testing' stamp: 'lr 6/24/2011 06:11'!
testParseAnBnCn
"PEGs for a non context- free language:
a^n , b^n , c^n
S <- &P1 P2
P1 <- AB 'c'
AB <- 'a' AB 'b' / epsilon
P2 <- 'a'* BC end
BC <- 'b' BC 'c' / epsilon"
| s p1 ab p2 bc |
s := PPDelegateParser new.
p1 := PPDelegateParser new.
ab := PPDelegateParser new.
p2 := PPDelegateParser new.
bc := PPDelegateParser new.
s setParser: (p1 and , p2 end) flatten.
p1 setParser: ab , $c asParser.
ab setParser: ($a asParser , ab , $b asParser) optional.
p2 setParser: $a asParser star , bc.
bc setParser: ($b asParser , bc , $c asParser) optional.
self assert: s parse: 'abc' to: 'abc'.
self assert: s parse: 'aabbcc' to: 'aabbcc'.
self assert: s parse: 'aaabbbccc' to: 'aaabbbccc'.
self assert: s fail: 'bc'.
self assert: s fail: 'ac'.
self assert: s fail: 'ab'.
self assert: s fail: 'abbcc'.
self assert: s fail: 'aabcc'.
self assert: s fail: 'aabbc'! !
!PPExtensionTest methodsFor: 'testing-parser' stamp: 'lr 5/2/2010 18:18'!
testCharacter
| parser |
parser := $a asParser.
self assert: parser parse: 'a' to: $a.
self assert: parser fail: 'b'! !
!PPExtensionTest methodsFor: 'testing-parser' stamp: 'lr 11/29/2011 20:38'!
testChoice
| parser |
parser := #(1 2) asChoiceParser.
self assert: parser parse: #(1) to: 1.
self assert: parser parse: #(2) to: 2.
self assert: parser parse: #(1 2) to: 1 end: 1.
self assert: parser parse: #(2 1) to: 2 end: 1.
self assert: parser fail: #().
self assert: parser fail: #(3)! !
!PPExtensionTest methodsFor: 'testing-parser' stamp: 'lr 5/5/2010 14:03'!
testClosure
| parser |
parser := [ :stream | stream upTo: $s ] asParser.
self assert: parser parse: '' to: ''.
self assert: parser parse: 'a' to: 'a'.
self assert: parser parse: 'aa' to: 'aa'.
self assert: parser parse: 's' to: ''.
self assert: parser parse: 'as' to: 'a'.
self assert: parser parse: 'aas' to: 'aa'.
self assert: parser parse: 'sa' to: '' end: 1.
self assert: parser parse: 'saa' to: '' end: 1.
parser := [ :stream | stream upTo: $s. PPFailure message: 'stream' at: stream position ] asParser.
self assert: parser fail: ''.
self assert: parser fail: 's'.
self assert: parser fail: 'as'
! !
!PPExtensionTest methodsFor: 'testing-parser' stamp: 'lr 11/20/2009 15:29'!
testEpsilon
| parser |
parser := nil asParser.
self assert: parser asParser = parser! !
!PPExtensionTest methodsFor: 'testing-parser' stamp: 'lr 11/20/2009 15:30'!
testParser
| parser |
parser := $a asParser.
self assert: parser asParser = parser! !
!PPExtensionTest methodsFor: 'testing-parser' stamp: 'lr 9/17/2008 22:48'!
testRange
| parser |
parser := $a - $c.
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'b' to: $b.
self assert: parser parse: 'c' to: $c.
self assert: parser fail: 'd'! !
!PPExtensionTest methodsFor: 'testing-parser' stamp: 'lr 11/29/2011 20:40'!
testSequence
| parser |
parser := #(1 2) asSequenceParser.
self assert: parser parse: #(1 2) to: #(1 2).
self assert: parser parse: #(1 2 3) to: #(1 2) end: 2.
self assert: parser fail: #().
self assert: parser fail: #(1).
self assert: parser fail: #(1 1).
self assert: parser fail: #(1 1 2)! !
!PPExtensionTest methodsFor: 'testing-parser' stamp: 'lr 5/2/2010 18:18'!
testString
| parser |
parser := 'ab' asParser.
self assert: parser parse: 'ab' to: 'ab'.
self assert: parser parse: 'aba' to: 'ab' end: 2.
self assert: parser parse: 'abb' to: 'ab' end: 2.
self assert: parser fail: 'a'.
self assert: parser fail: 'ac'! !
!PPExtensionTest methodsFor: 'testing-parser' stamp: 'lr 9/17/2008 22:03'!
testSymbol
| parser |
parser := #any asParser.
self assert: parser parse: 'a'.
self assert: parser fail: ''! !
!PPExtensionTest methodsFor: 'testing-stream' stamp: 'lr 9/30/2010 11:12'!
testStream
| stream |
stream := 'abc' readStream asPetitStream.
self assert: (stream class = PPStream).
self assert: (stream printString = '·abc').
self assert: (stream peek) = $a.
self assert: (stream uncheckedPeek = $a).
self assert: (stream next) = $a.
self assert: (stream printString = 'a·bc').
self assert: (stream asPetitStream = stream)! !
!PPExtensionTest methodsFor: 'testing-stream' stamp: 'lr 2/7/2010 20:53'!
testText
| stream |
stream := 'abc' asText asPetitStream.
self assert: stream class = PPStream! !
!PPObjectTest methodsFor: 'parsers' stamp: 'lr 12/9/2010 10:25'!
integer
^ PPPredicateObjectParser
on: [ :each | each isInteger ]
message: 'integer expected'! !
!PPObjectTest methodsFor: 'parsers' stamp: 'lr 10/30/2010 12:45'!
string
^ PPPredicateObjectParser
on: [ :each | each isString ]
message: 'string expected'! !
!PPObjectTest methodsFor: 'testing-operators' stamp: 'lr 12/9/2010 10:25'!
testChoice
| parser |
parser := self integer / self string.
self assert: parser parse: #(123) to: 123.
self assert: parser parse: #('abc') to: 'abc'! !
!PPObjectTest methodsFor: 'testing-operators' stamp: 'lr 12/9/2010 10:25'!
testSequence
| parser |
parser := self integer , self string.
self assert: parser parse: #(123 'abc') to: #(123 'abc').
self assert: parser fail: #(123 456).
self assert: parser fail: #('abc' 'def').
self assert: parser fail: #('abc' 123)
! !
!PPObjectTest methodsFor: 'testing-fancy' stamp: 'lr 12/9/2010 10:25'!
testFibonacci
"This parser accepts fibonacci sequences with arbitrary start pairs."
| parser |
parser := ((self integer , self integer) end ==> [ :pair | pair first + pair last ])
/ (self integer , (self integer , self integer) and >=> [ :stream :continuation |
| result |
result := continuation value.
(result isPetitFailure or: [ result first + result last first ~= result last last ])
ifFalse: [ parser parseOn: stream ]
ifTrue: [ PPFailure message: 'invalid fibonacci sequence' at: stream position ] ]).
self assert: parser parse: #(1 1) to: 2.
self assert: parser parse: #(1 1 2) to: 3.
self assert: parser parse: #(1 1 2 3) to: 5.
self assert: parser parse: #(1 1 2 3 5) to: 8.
self assert: parser parse: #(1 1 2 3 5 8) to: 13.
self assert: parser parse: #(1 1 2 3 5 8 13) to: 21.
self assert: parser fail: #().
self assert: parser fail: #(1).
self assert: parser fail: #(1 2 3 4) end: 2
! !
!PPObjectTest methodsFor: 'testing' stamp: 'lr 12/9/2010 10:25'!
testInteger
self assert: self integer parse: #(123) to: 123.
self assert: self integer fail: #('abc')! !
!PPObjectTest methodsFor: 'testing' stamp: 'lr 10/30/2010 12:47'!
testString
self assert: self string parse: #('abc') to: 'abc'.
self assert: self string fail: #(123)! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 5/2/2010 12:22'!
testAction
| block parser |
block := [ :char | char asUppercase ].
parser := #any asParser ==> block.
self assert: parser block = block.
self assert: parser parse: 'a' to: $A.
self assert: parser parse: 'b' to: $B! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 6/24/2011 06:16'!
testAnswer
| parser |
parser := $a asParser answer: $b.
self assert: parser parse: 'a' to: $b.
self assert: parser fail: ''.
self assert: parser fail: 'b'! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 5/2/2010 12:18'!
testFlatten
| parser |
parser := $a asParser flatten.
self assert: parser parse: 'a' to: 'a'.
self assert: parser parse: #($a) to: #($a).
self assert: parser fail: ''.
self assert: parser fail: 'b'! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 6/24/2011 06:16'!
testFoldLeft2
| parser |
parser := #any asParser star
foldLeft: [ :a :b | Array with: a with: b ].
self assert: parser parse: #(a) to: #a.
self assert: parser parse: #(a b) to: #(a b).
self assert: parser parse: #(a b c) to: #((a b) c).
self assert: parser parse: #(a b c d) to: #(((a b) c) d).
self assert: parser parse: #(a b c d e) to: #((((a b) c) d) e)! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 6/24/2011 06:16'!
testFoldLeft3
| parser |
parser := #any asParser star
foldLeft: [ :a :b :c | Array with: a with: b with: c ].
self assert: parser parse: #(a) to: #a.
self assert: parser parse: #(a b c) to: #(a b c).
self assert: parser parse: #(a b c d e) to: #((a b c) d e)! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 6/24/2011 06:16'!
testFoldRight2
| parser |
parser := #any asParser star
foldRight: [ :a :b | Array with: a with: b ].
self assert: parser parse: #(a) to: #a.
self assert: parser parse: #(a b) to: #(a b).
self assert: parser parse: #(a b c) to: #(a (b c)).
self assert: parser parse: #(a b c d) to: #(a (b (c d))).
self assert: parser parse: #(a b c d e) to: #(a (b (c (d e))))! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 6/24/2011 06:16'!
testFoldRight3
| parser |
parser := #any asParser star
foldRight: [ :a :b :c | Array with: a with: b with: c ].
self assert: parser parse: #(a) to: #a.
self assert: parser parse: #(a b c) to: #(a b c).
self assert: parser parse: #(a b c d e) to: #(a b (c d e))! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 6/24/2011 06:16'!
testMap1
| parser |
parser := #any asParser
map: [ :a | Array with: a ].
self assert: parser parse: #(a) to: #(a)! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 6/24/2011 06:16'!
testMap2
| parser |
parser := (#any asParser , #any asParser)
map: [ :a :b | Array with: b with: a ].
self assert: parser parse: #(a b) to: #(b a)! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 6/24/2011 06:16'!
testMap3
| parser |
parser := (#any asParser , #any asParser , #any asParser)
map: [ :a :b :c | Array with: c with: b with: a ].
self assert: parser parse: #(a b c) to: #(c b a)! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 6/24/2011 06:16'!
testMapFail1
self
should: [ #any asParser map: [ ] ]
raise: Error.
self
should: [ #any asParser map: [ :a :b | ] ]
raise: Error
! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 6/24/2011 06:16'!
testMapFail2
self
should: [ (#any asParser , #any asParser) map: [ :a | ] ]
raise: Error.
self
should: [ (#any asParser , #any asParser) map: [ :a :b :c | ] ]
raise: Error
! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 1/8/2010 12:09'!
testPermutation
| parser |
parser := #any asParser , #any asParser , #any asParser.
self assert: (parser permutation: #()) parse: '123' to: #().
self assert: (parser permutation: #(1)) parse: '123' to: #($1).
self assert: (parser permutation: #(1 3)) parse: '123' to: #($1 $3).
self assert: (parser permutation: #(3 1)) parse: '123' to: #($3 $1).
self assert: (parser permutation: #(2 2)) parse: '123' to: #($2 $2).
self assert: (parser permutation: #(3 2 1)) parse: '123' to: #($3 $2 $1).
self should: [ parser permutation: #(0) ] raise: Error.
self should: [ parser permutation: #(4) ] raise: Error.
self should: [ parser permutation: #($2) ] raise: Error! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 4/6/2010 19:47'!
testToken
| parser |
parser := $a asParser token.
self assert: parser tokenClass = PPToken.
self assert: parser parse: 'a' toToken: 1 stop: 1.
self assert: parser fail: 'b'.
self assert: parser fail: ''.
parser := $a asParser token: PPToken.
self assert: parser tokenClass = PPToken.
self assert: parser parse: 'a' toToken: 1 stop: 1.
self assert: parser fail: ''.
self assert: parser fail: 'b'! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 7/11/2011 11:05'!
testTrim
| parser |
parser := $a asParser token trim.
self assert: parser parse: 'a' toToken: 1 stop: 1.
self assert: parser parse: 'a ' toToken: 1 stop: 1.
self assert: parser parse: 'a ' toToken: 1 stop: 1.
self assert: parser parse: 'a ' toToken: 1 stop: 1.
self assert: parser parse: 'a
' toToken: 1 stop: 1.
self assert: parser parse: 'a' toToken: 1 stop: 1.
self assert: parser parse: ' a' toToken: 2 stop: 2.
self assert: parser parse: ' a' toToken: 2 stop: 2.
self assert: parser parse: ' a' toToken: 5 stop: 5.
self assert: parser parse: '
a' toToken: 5 stop: 5.
self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 2.
self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 3.
self assert: parser fail: ''.
self assert: parser fail: 'b'! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 7/31/2010 12:07'!
testTrimBlanks
| parser |
parser := $a asParser token trimBlanks.
self assert: parser parse: 'a' toToken: 1 stop: 1.
self assert: parser parse: 'a ' toToken: 1 stop: 1.
self assert: parser parse: 'a ' toToken: 1 stop: 1.
self assert: parser parse: 'a ' toToken: 1 stop: 1.
self assert: parser parse: 'a' toToken: 1 stop: 1.
self assert: parser parse: ' a' toToken: 2 stop: 2.
self assert: parser parse: ' a' toToken: 2 stop: 2.
self assert: parser parse: ' a' toToken: 5 stop: 5.
self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 2.
self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 3.
self assert: parser fail: ''.
self assert: parser fail: '
'.
self assert: parser fail: '
a'.
self assert: parser fail: 'b'.! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 7/11/2011 11:05'!
testTrimCustom
| parser |
parser := $a asParser token trim: $b asParser.
self assert: parser parse: 'a' toToken: 1 stop: 1.
self assert: parser parse: 'ab' toToken: 1 stop: 1.
self assert: parser parse: 'abb' toToken: 1 stop: 1.
self assert: parser parse: 'a' toToken: 1 stop: 1.
self assert: parser parse: 'ba' toToken: 2 stop: 2.
self assert: parser parse: 'bba' toToken: 3 stop: 3.
self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
self assert: parser parse: 'ab' toToken: 1 stop: 1 end: 2.
self assert: parser parse: 'abba' toToken: 1 stop: 1 end: 3.
self assert: parser fail: ''.
self assert: parser fail: 'b'! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 7/31/2010 12:07'!
testTrimSpaces
| parser |
parser := $a asParser token trimSpaces.
self assert: parser parse: 'a' toToken: 1 stop: 1.
self assert: parser parse: 'a ' toToken: 1 stop: 1.
self assert: parser parse: 'a ' toToken: 1 stop: 1.
self assert: parser parse: 'a ' toToken: 1 stop: 1.
self assert: parser parse: 'a
' toToken: 1 stop: 1.
self assert: parser parse: 'a' toToken: 1 stop: 1.
self assert: parser parse: ' a' toToken: 2 stop: 2.
self assert: parser parse: ' a' toToken: 2 stop: 2.
self assert: parser parse: ' a' toToken: 5 stop: 5.
self assert: parser parse: '
a' toToken: 5 stop: 5.
self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 2.
self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 3.
self assert: parser fail: ''.
self assert: parser fail: 'b'! !
!PPParserTest methodsFor: 'testing-mapping' stamp: 'lr 5/12/2010 20:40'!
testWrapping
| parser result |
parser := #digit asParser plus >=> [ :stream :cc |
Array
with: stream position
with: cc value
with: stream position ].
self assert: parser parse: '1' to: #(0 ($1) 1).
self assert: parser parse: '12' to: #(0 ($1 $2) 2).
self assert: parser parse: '123' to: #(0 ($1 $2 $3) 3).
result := parser parse: 'a'.
self assert: result first = 0.
self assert: result second isPetitFailure.
self assert: result last = 0! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 6/24/2011 06:15'!
testAnd
| parser |
parser := 'foo' asParser flatten , 'bar' asParser flatten and.
self assert: parser parse: 'foobar' to: #('foo' 'bar') end: 3.
self assert: parser fail: 'foobaz'.
parser := 'foo' asParser and.
self assert: parser and = parser! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/2/2009 19:56'!
testBlock
| parser |
parser := [ :s | s next ] asParser.
self assert: parser parse: 'ab' to: $a end: 1.
self assert: parser parse: 'b' to: $b.
self assert: parser parse: '' to: nil! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 9/15/2008 09:24'!
testChoice
| parser |
parser := $a asParser / $b asParser.
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'b' to: $b.
self assert: parser parse: 'ab' to: $a end: 1.
self assert: parser parse: 'ba' to: $b end: 1.
self assert: parser fail: ''.
self assert: parser fail: 'c'.
self assert: parser fail: 'ca'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 5/7/2008 08:58'!
testDelimitedBy
| parser |
parser := $a asParser delimitedBy: $b asParser.
self assert: parser parse: 'a' to: #($a).
self assert: parser parse: 'aba' to: #($a $b $a).
self assert: parser parse: 'ababa' to: #($a $b $a $b $a).
self assert: parser parse: 'ab' to: #($a $b).
self assert: parser parse: 'abab' to: #($a $b $a $b).
self assert: parser parse: 'ababab' to: #($a $b $a $b $a $b).
self assert: parser parse: 'ac' to: #($a) end: 1.
self assert: parser parse: 'abc' to: #($a $b) end: 2.
self assert: parser parse: 'abac' to: #($a $b $a) end: 3.
self assert: parser parse: 'ababc' to: #($a $b $a $b) end: 4.
self assert: parser fail: ''.
self assert: parser fail: 'b'.
self assert: parser fail: 'c'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 2/25/2012 16:56'!
testDelimitedByWithoutSeparators
| parser |
parser := ($a asParser delimitedBy: $b asParser)
withoutSeparators.
self assert: parser parse: 'a' to: #($a).
self assert: parser parse: 'aba' to: #($a $a).
self assert: parser parse: 'ababa' to: #($a $a $a).
self assert: parser parse: 'ab' to: #($a).
self assert: parser parse: 'abab' to: #($a $a).
self assert: parser parse: 'ababab' to: #($a $a $a).
self assert: parser parse: 'ac' to: #($a) end: 1.
self assert: parser parse: 'abc' to: #($a) end: 2.
self assert: parser parse: 'abac' to: #($a $a) end: 3.
self assert: parser parse: 'ababc' to: #($a $a) end: 4.
self assert: parser fail: ''.
self assert: parser fail: 'b'.
self assert: parser fail: 'c'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 1/29/2010 11:39'!
testEndOfInput
| parser |
parser := PPEndOfInputParser on: $a asParser.
self assert: parser end = parser.
self assert: parser parse: 'a' to: $a.
self assert: parser fail: ''.
self assert: parser fail: 'aa'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 9/17/2008 22:47'!
testEndOfInputAfterMatch
| parser |
parser := 'stuff' asParser end.
self assert: parser parse: 'stuff' to: 'stuff'.
self assert: parser fail: 'stufff'.
self assert: parser fail: 'fluff'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:31'!
testEpsilon
| parser |
parser := nil asParser.
self assert: parser parse: '' to: nil.
self assert: parser parse: 'a' to: nil end: 0.
self assert: parser parse: 'ab' to: nil end: 0! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 5/5/2010 14:10'!
testFailing
| parser result |
parser := PPFailingParser message: 'Plonk'.
self assert: parser message = 'Plonk'.
self assert: parser fail: ''.
self assert: parser fail: 'a'.
self assert: parser fail: 'aa'.
result := parser parse: 'a'.
self assert: result message = 'Plonk'.
self assert: result printString = 'Plonk at 0'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 18:20'!
testLiteralObject
| parser |
parser := PPLiteralObjectParser
on: $a
message: 'letter "a" expected'.
self assert: parser literal = $a.
self assert: parser message = 'letter "a" expected'.
self assert: parser parse: 'a' to: $a.
self assert: parser fail: 'b'
! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 6/1/2010 22:30'!
testLiteralObjectCaseInsensitive
| parser |
parser := $a asParser caseInsensitive.
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'A' to: $A.
self assert: parser fail: ''.
self assert: parser fail: 'b'.
self assert: parser fail: 'B'
! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 9/15/2010 12:00'!
testLiteralSequence
| parser |
parser := PPLiteralSequenceParser
on: 'abc'
message: 'sequence "abc" expected'.
self assert: parser size = 3.
self assert: parser literal = 'abc'.
self assert: parser message = 'sequence "abc" expected'.
self assert: parser parse: 'abc' to: 'abc'.
self assert: parser fail: 'ab'.
self assert: parser fail: 'abd'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 6/1/2010 22:31'!
testLiteralSequenceCaseInsensitive
| parser |
parser := 'abc' asParser caseInsensitive.
self assert: parser parse: 'abc' to: 'abc'.
self assert: parser parse: 'ABC' to: 'ABC'.
self assert: parser parse: 'abC' to: 'abC'.
self assert: parser parse: 'AbC' to: 'AbC'.
self assert: parser fail: 'ab'.
self assert: parser fail: 'abd'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:18'!
testMax
| parser |
parser := $a asParser max: 2.
self assert: parser min = 0.
self assert: parser max = 2.
self assert: parser parse: '' to: #().
self assert: parser parse: 'a' to: #($a).
self assert: parser parse: 'aa' to: #($a $a).
self assert: parser parse: 'aaa' to: #($a $a) end: 2.
self assert: parser parse: 'aaaa' to: #($a $a) end: 2.
self assert: (parser printString endsWith: '[0, 2]')! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/3/2011 21:02'!
testMaxGreedy
| parser |
parser := #word asParser max: 2 greedy: #digit asParser.
self assert: parser fail: ''.
self assert: parser fail: 'abc'.
self assert: parser parse: '1' to: #() end: 0.
self assert: parser parse: 'a1' to: #($a) end: 1.
self assert: parser parse: 'ab1' to: #($a $b) end: 2.
self assert: parser fail: 'abc1'.
self assert: parser parse: '12' to: #($1) end: 1.
self assert: parser parse: 'a12' to: #($a $1) end: 2.
self assert: parser parse: 'ab12' to: #($a $b) end: 2.
self assert: parser fail: 'abc12'.
self assert: parser parse: '123' to: #($1 $2) end: 2.
self assert: parser parse: 'a123' to: #($a $1) end: 2.
self assert: parser parse: 'ab123' to: #($a $b) end: 2.
self assert: parser fail: 'abc123'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/3/2011 21:03'!
testMaxLazy
| parser |
parser := #word asParser max: 2 lazy: #digit asParser.
self assert: parser fail: ''.
self assert: parser fail: 'abc'.
self assert: parser parse: '1' to: #() end: 0.
self assert: parser parse: 'a1' to: #($a) end: 1.
self assert: parser parse: 'ab1' to: #($a $b) end: 2.
self assert: parser fail: 'abc1'.
self assert: parser parse: '12' to: #() end: 0.
self assert: parser parse: 'a12' to: #($a) end: 1.
self assert: parser parse: 'ab12' to: #($a $b) end: 2.
self assert: parser fail: 'abc12'.
self assert: parser parse: '123' to: #() end: 0.
self assert: parser parse: 'a123' to: #($a) end: 1.
self assert: parser parse: 'ab123' to: #($a $b) end: 2.
self assert: parser fail: 'abc123'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/2/2009 20:35'!
testMemoized
| count parser twice |
count := 0.
parser := [ :s | count := count + 1. s next ] asParser memoized.
twice := parser and , parser.
count := 0.
self assert: parser parse: 'a' to: $a.
self assert: count = 1.
count := 0.
self assert: twice parse: 'a' to: #($a $a).
self assert: count = 1.
self assert: parser memoized = parser! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:18'!
testMin
| parser |
parser := $a asParser min: 2.
self assert: parser min = 2.
self assert: parser max > parser min.
self assert: parser fail: ''.
self assert: parser fail: 'a'.
self assert: parser parse: 'aa' to: #($a $a).
self assert: parser parse: 'aaa' to: #($a $a $a).
self assert: parser parse: 'aaaa' to: #($a $a $a $a).
self assert: (parser printString endsWith: '[2, *]')! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/3/2011 21:12'!
testMinGreedy
| parser |
parser := #word asParser min: 2 greedy: #digit asParser.
self assert: parser fail: ''.
self assert: parser fail: 'abcde'.
self assert: parser fail: '1'.
self assert: parser fail: 'a1'.
self assert: parser parse: 'ab1' to: #($a $b) end: 2.
self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
self assert: parser parse: 'abcde1' to: #($a $b $c $d $e) end: 5.
self assert: parser fail: '12'.
self assert: parser parse: 'a12' to: #($a $1) end: 2.
self assert: parser parse: 'ab12' to: #($a $b $1) end: 3.
self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4.
self assert: parser parse: 'abcd12' to: #($a $b $c $d $1) end: 5.
self assert: parser parse: 'abcde12' to: #($a $b $c $d $e $1) end: 6.
self assert: parser parse: '123' to: #($1 $2) end: 2.
self assert: parser parse: 'a123' to: #($a $1 $2) end: 3.
self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4.
self assert: parser parse: 'abc123' to: #($a $b $c $1 $2) end: 5.
self assert: parser parse: 'abcd123' to: #($a $b $c $d $1 $2) end: 6.
self assert: parser parse: 'abcde123' to: #($a $b $c $d $e $1 $2) end: 7.
self assert: parser parse: '1234' to: #($1 $2 $3) end: 3.
self assert: parser parse: 'a1234' to: #($a $1 $2 $3) end: 4.
self assert: parser parse: 'ab1234' to: #($a $b $1 $2 $3) end: 5.
self assert: parser parse: 'abc1234' to: #($a $b $c $1 $2 $3) end: 6.
self assert: parser parse: 'abcd1234' to: #($a $b $c $d $1 $2 $3) end: 7.
self assert: parser parse: 'abcde1234' to: #($a $b $c $d $e $1 $2 $3) end: 8! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/3/2011 21:15'!
testMinLazy
| parser |
parser := #word asParser min: 2 lazy: #digit asParser.
self assert: parser fail: ''.
self assert: parser fail: 'abcde'.
self assert: parser fail: '1'.
self assert: parser fail: 'a1'.
self assert: parser parse: 'ab1' to: #($a $b) end: 2.
self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
self assert: parser parse: 'abcde1' to: #($a $b $c $d $e) end: 5.
self assert: parser fail: '12'.
self assert: parser parse: 'a12' to: #($a $1) end: 2.
self assert: parser parse: 'ab12' to: #($a $b) end: 2.
self assert: parser parse: 'abc12' to: #($a $b $c) end: 3.
self assert: parser parse: 'abcd12' to: #($a $b $c $d) end: 4.
self assert: parser parse: 'abcde12' to: #($a $b $c $d $e) end: 5.
self assert: parser parse: '123' to: #($1 $2) end: 2.
self assert: parser parse: 'a123' to: #($a $1) end: 2.
self assert: parser parse: 'ab123' to: #($a $b) end: 2.
self assert: parser parse: 'abc123' to: #($a $b $c) end: 3.
self assert: parser parse: 'abcd123' to: #($a $b $c $d) end: 4.
self assert: parser parse: 'abcde123' to: #($a $b $c $d $e) end: 5.
self assert: parser parse: '1234' to: #($1 $2) end: 2.
self assert: parser parse: 'a1234' to: #($a $1) end: 2.
self assert: parser parse: 'ab1234' to: #($a $b) end: 2.
self assert: parser parse: 'abc1234' to: #($a $b $c) end: 3.
self assert: parser parse: 'abcd1234' to: #($a $b $c $d) end: 4.
self assert: parser parse: 'abcde1234' to: #($a $b $c $d $e) end: 5! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:19'!
testMinMax
| parser |
parser := $a asParser min: 2 max: 4.
self assert: parser min = 2.
self assert: parser max = 4.
self assert: parser fail: ''.
self assert: parser fail: 'a'.
self assert: parser parse: 'aa' to: #($a $a).
self assert: parser parse: 'aaa' to: #($a $a $a).
self assert: parser parse: 'aaaa' to: #($a $a $a $a).
self assert: parser parse: 'aaaaa' to: #($a $a $a $a) end: 4.
self assert: parser parse: 'aaaaaa' to: #($a $a $a $a) end: 4.
self assert: (parser printString endsWith: '[2, 4]')! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/3/2011 20:54'!
testMinMaxGreedy
| parser |
parser := #word asParser min: 2 max: 4 greedy: #digit asParser.
self assert: parser fail: ''.
self assert: parser fail: 'abcde'.
self assert: parser fail: '1'.
self assert: parser fail: 'a1'.
self assert: parser parse: 'ab1' to: #($a $b) end: 2.
self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
self assert: parser fail: 'abcde1'.
self assert: parser fail: '12'.
self assert: parser parse: 'a12' to: #($a $1) end: 2.
self assert: parser parse: 'ab12' to: #($a $b $1) end: 3.
self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4.
self assert: parser parse: 'abcd12' to: #($a $b $c $d) end: 4.
self assert: parser fail: 'abcde12'.
self assert: parser parse: '123' to: #($1 $2) end: 2.
self assert: parser parse: 'a123' to: #($a $1 $2) end: 3.
self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4.
self assert: parser parse: 'abc123' to: #($a $b $c $1) end: 4.
self assert: parser parse: 'abcd123' to: #($a $b $c $d) end: 4.
self assert: parser fail: 'abcde123'.
self assert: parser parse: '1234' to: #($1 $2 $3) end: 3.
self assert: parser parse: 'a1234' to: #($a $1 $2 $3) end: 4.
self assert: parser parse: 'ab1234' to: #($a $b $1 $2) end: 4.
self assert: parser parse: 'abc1234' to: #($a $b $c $1) end: 4.
self assert: parser parse: 'abcd1234' to: #($a $b $c $d) end: 4.
self assert: parser fail: 'abcde1234'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/3/2011 20:57'!
testMinMaxLazy
| parser |
parser := #word asParser min: 2 max: 4 lazy: #digit asParser.
self assert: parser fail: ''.
self assert: parser fail: 'abcde'.
self assert: parser fail: '1'.
self assert: parser fail: 'a1'.
self assert: parser parse: 'ab1' to: #($a $b) end: 2.
self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
self assert: parser fail: 'abcde1'.
self assert: parser fail: '12'.
self assert: parser parse: 'a12' to: #($a $1) end: 2.
self assert: parser parse: 'ab12' to: #($a $b) end: 2.
self assert: parser parse: 'abc12' to: #($a $b $c) end: 3.
self assert: parser parse: 'abcd12' to: #($a $b $c $d) end: 4.
self assert: parser fail: 'abcde12'.
self assert: parser parse: '123' to: #($1 $2) end: 2.
self assert: parser parse: 'a123' to: #($a $1) end: 2.
self assert: parser parse: 'ab123' to: #($a $b) end: 2.
self assert: parser parse: 'abc123' to: #($a $b $c) end: 3.
self assert: parser parse: 'abcd123' to: #($a $b $c $d) end: 4.
self assert: parser fail: 'abcde123'.
self assert: parser parse: '1234' to: #($1 $2) end: 2.
self assert: parser parse: 'a1234' to: #($a $1) end: 2.
self assert: parser parse: 'ab1234' to: #($a $b) end: 2.
self assert: parser parse: 'abc1234' to: #($a $b $c) end: 3.
self assert: parser parse: 'abcd1234' to: #($a $b $c $d) end: 4.
self assert: parser fail: 'abcde1234'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 2/7/2010 20:10'!
testNegate
| parser |
parser := 'foo' asParser negate.
self assert: parser parse: 'f' to: $f end: 1.
self assert: parser parse: 'fo' to: $f end: 1.
self assert: parser parse: 'fob' to: $f end: 1.
self assert: parser parse: 'ffoo' to: $f end: 1.
self assert: parser fail: ''.
self assert: parser fail: 'foo'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 8/26/2010 09:54'!
testNot
| parser |
parser := 'foo' asParser flatten , 'bar' asParser flatten not.
self assert: parser parse: 'foobaz' to: #('foo' nil) end: 3.
self assert: parser fail: 'foobar'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:32'!
testOptional
| parser |
parser := $a asParser optional.
self assert: parser parse: '' to: nil.
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'aa' to: $a end: 1.
self assert: parser parse: 'ab' to: $a end: 1.
self assert: parser parse: 'b' to: nil end: 0.
self assert: parser parse: 'bb' to: nil end: 0.
self assert: parser parse: 'ba' to: nil end: 0! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 5/2/2010 12:26'!
testPluggable
| block parser |
block := [ :stream | stream position ].
parser := block asParser.
self assert: parser block = block! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 8/17/2011 10:01'!
testPlus
| parser |
parser := $a asParser plus.
self assert: parser min = 1.
self assert: parser max > parser min.
self assert: parser parse: 'a' to: #($a).
self assert: parser parse: 'aa' to: #($a $a).
self assert: parser parse: 'aaa' to: #($a $a $a).
self assert: parser parse: 'ab' to: #($a) end: 1.
self assert: parser parse: 'aab' to: #($a $a) end: 2.
self assert: parser parse: 'aaab' to: #($a $a $a) end: 3.
self assert: parser fail: ''.
self assert: parser fail: 'b'.
self assert: parser fail: 'ba'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 8/17/2011 10:01'!
testPlusGreedy
| limit parser |
limit := #digit asParser.
parser := #word asParser plusGreedy: limit.
self assert: parser min = 1.
self assert: parser max > parser min.
self assert: parser limit = limit.
self assert: parser children size = 2.
self assert: parser children last = limit.
self assert: parser fail: ''.
self assert: parser fail: '1'.
self assert: parser fail: 'a'.
self assert: parser fail: 'ab'.
self assert: parser parse: 'a1' to: #($a) end: 1.
self assert: parser parse: 'ab1' to: #($a $b) end: 2.
self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
self assert: parser parse: 'a12' to: #($a $1) end: 2.
self assert: parser parse: 'ab12' to: #($a $b $1) end: 3.
self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4.
self assert: parser parse: 'a123' to: #($a $1 $2) end: 3.
self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4.
self assert: parser parse: 'abc123' to: #($a $b $c $1 $2) end: 5.! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 8/17/2011 10:01'!
testPlusLazy
| limit parser |
limit := #digit asParser.
parser := #word asParser plusLazy: limit.
self assert: parser min = 1.
self assert: parser max > parser min.
self assert: parser limit = limit.
self assert: parser children size = 2.
self assert: parser children last = limit.
self assert: parser fail: ''.
self assert: parser fail: '1'.
self assert: parser fail: 'a'.
self assert: parser fail: 'ab'.
self assert: parser parse: 'a1' to: #($a) end: 1.
self assert: parser parse: 'ab1' to: #($a $b) end: 2.
self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
self assert: parser parse: 'a12' to: #($a) end: 1.
self assert: parser parse: 'ab12' to: #($a $b) end: 2.
self assert: parser parse: 'abc12' to: #($a $b $c) end: 3.
self assert: parser parse: 'a123' to: #($a) end: 1.
self assert: parser parse: 'ab123' to: #($a $b) end: 2.
self assert: parser parse: 'abc123' to: #($a $b $c) end: 3! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:42'!
testSeparatedBy
| parser |
parser := $a asParser separatedBy: $b asParser.
self assert: parser parse: 'a' to: #($a).
self assert: parser parse: 'aba' to: #($a $b $a).
self assert: parser parse: 'ababa' to: #($a $b $a $b $a).
self assert: parser parse: 'ab' to: #($a) end: 1.
self assert: parser parse: 'abab' to: #($a $b $a) end: 3.
self assert: parser parse: 'ac' to: #($a) end: 1.
self assert: parser parse: 'abac' to: #($a $b $a) end: 3.
self assert: parser fail: ''.
self assert: parser fail: 'c'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 2/25/2012 16:55'!
testSeparatedByWithoutSeparators
| parser |
parser := ($a asParser separatedBy: $b asParser)
withoutSeparators.
self assert: parser parse: 'a' to: #($a).
self assert: parser parse: 'aba' to: #($a $a).
self assert: parser parse: 'ababa' to: #($a $a $a).
self assert: parser parse: 'ab' to: #($a) end: 1.
self assert: parser parse: 'abab' to: #($a $a) end: 3.
self assert: parser parse: 'ac' to: #($a) end: 1.
self assert: parser parse: 'abac' to: #($a $a) end: 3.
self assert: parser fail: ''.
self assert: parser fail: 'c'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/29/2008 11:33'!
testSequence
| parser |
parser := $a asParser , $b asParser.
self assert: parser parse: 'ab' to: #($a $b).
self assert: parser parse: 'aba' to: #($a $b) end: 2.
self assert: parser parse: 'abb' to: #($a $b) end: 2.
self assert: parser fail: ''.
self assert: parser fail: 'a'.
self assert: parser fail: 'aa'.
self assert: parser fail: 'ba'.
self assert: parser fail: 'bab'! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 8/17/2011 10:02'!
testStar
| parser |
parser := $a asParser star.
self assert: parser min = 0.
self assert: parser max > parser min.
self assert: parser parse: '' to: #().
self assert: parser parse: 'a' to: #($a).
self assert: parser parse: 'aa' to: #($a $a).
self assert: parser parse: 'aaa' to: #($a $a $a).
self assert: parser parse: 'b' to: #() end: 0.
self assert: parser parse: 'ab' to: #($a) end: 1.
self assert: parser parse: 'aab' to: #($a $a) end: 2.
self assert: parser parse: 'aaab' to: #($a $a $a) end: 3! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 8/17/2011 10:02'!
testStarGreedy
| limit parser |
limit := #digit asParser.
parser := #word asParser starGreedy: limit.
self assert: parser min = 0.
self assert: parser max > parser min.
self assert: parser limit = limit.
self assert: parser children size = 2.
self assert: parser children last = limit.
self assert: parser fail: ''.
self assert: parser fail: 'a'.
self assert: parser fail: 'ab'.
self assert: parser parse: '1' to: #() end: 0.
self assert: parser parse: 'a1' to: #($a) end: 1.
self assert: parser parse: 'ab1' to: #($a $b) end: 2.
self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
self assert: parser parse: '12' to: #($1) end: 1.
self assert: parser parse: 'a12' to: #($a $1) end: 2.
self assert: parser parse: 'ab12' to: #($a $b $1) end: 3.
self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4.
self assert: parser parse: '123' to: #($1 $2) end: 2.
self assert: parser parse: 'a123' to: #($a $1 $2) end: 3.
self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4.
self assert: parser parse: 'abc123' to: #($a $b $c $1 $2) end: 5! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 8/17/2011 10:02'!
testStarLazy
| limit parser |
limit := #digit asParser.
parser := #word asParser starLazy: limit.
self assert: parser min = 0.
self assert: parser max > parser min.
self assert: parser limit = limit.
self assert: parser children size = 2.
self assert: parser children last = limit.
self assert: parser fail: ''.
self assert: parser fail: 'a'.
self assert: parser fail: 'ab'.
self assert: parser parse: '1' to: #() end: 0.
self assert: parser parse: 'a1' to: #($a) end: 1.
self assert: parser parse: 'ab1' to: #($a $b) end: 2.
self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
self assert: parser parse: '12' to: #() end: 0.
self assert: parser parse: 'a12' to: #($a) end: 1.
self assert: parser parse: 'ab12' to: #($a $b) end: 2.
self assert: parser parse: 'abc12' to: #($a $b $c) end: 3.
self assert: parser parse: '123' to: #() end: 0.
self assert: parser parse: 'a123' to: #($a) end: 1.
self assert: parser parse: 'ab123' to: #($a $b) end: 2.
self assert: parser parse: 'abc123' to: #($a $b $c) end: 3! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 9/15/2010 09:53'!
testTimes
| parser |
parser := $a asParser times: 2.
self assert: parser fail: ''.
self assert: parser fail: 'a'.
self assert: parser parse: 'aa' to: #($a $a).
self assert: parser parse: 'aaa' to: #($a $a) end: 2! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 11/20/2009 15:31'!
testUnresolved
| parser |
parser := PPUnresolvedParser new.
self assert: parser isUnresolved.
self should: [ parser parse: '' ] raise: Error.
self should: [ parser parse: 'a' ] raise: Error.
self should: [ parser parse: 'ab' ] raise: Error.
parser := nil asParser.
self deny: parser isUnresolved! !
!PPParserTest methodsFor: 'testing' stamp: 'tg 7/29/2010 22:39'!
testWrapped
| parser |
parser := $a asParser wrapped.
self assert: parser parse: 'a' to: $a.
self assert: parser fail: 'b'.
parser := (($a asParser , $b asParser ) wrapped , $c asParser).
self assert: parser parse: 'abc' to: #(#($a $b) $c)! !
!PPParserTest methodsFor: 'testing' stamp: 'lr 4/14/2010 16:30'!
testXor
| parser |
parser := ($a asParser / $b asParser)
| ($b asParser / $c asParser).
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'c' to: $c.
self assert: parser fail: ''.
self assert: parser fail: 'b'.
self assert: parser fail: 'd'.
" truly symmetric "
parser := ($b asParser / $c asParser)
| ($a asParser / $b asParser).
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'c' to: $c.
self assert: parser fail: ''.
self assert: parser fail: 'b'.
self assert: parser fail: 'd'! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 2/7/2010 22:15'!
testChildren
| p1 p2 p3 |
p1 := #lowercase asParser.
p2 := p1 ==> #asUppercase.
p3 := PPUnresolvedParser new.
p3 def: p2 / p3.
self assert: p1 children isEmpty.
self assert: p2 children size = 1.
self assert: p3 children size = 2! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 5/5/2010 13:58'!
testFailure
| failure |
failure := PPFailure message: 'Error' at: 3.
self assert: failure message = 'Error'.
self assert: failure position = 3.
self assert: failure isPetitFailure.
self deny: 4 isPetitFailure.
self deny: 'foo' isPetitFailure! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 5/31/2010 19:27'!
testListConstructor
| p1 p2 p3 |
p1 := PPChoiceParser with: $a asParser.
p2 := PPChoiceParser with: $a asParser with: $b asParser.
p3 := PPChoiceParser withAll: (Array with: $a asParser with: $b asParser with: $c asParser).
self assert: p1 children size = 1.
self assert: p2 children size = 2.
self assert: p3 children size = 3! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 2/8/2010 00:32'!
testMatches
| parser |
parser := $a asParser.
self assert: (parser matches: 'a').
self deny: (parser matches: 'b').
self assert: (parser matches: 'a' readStream).
self deny: (parser matches: 'b' readStream)! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 2/8/2010 00:32'!
testMatchesIn
| parser result |
parser := $a asParser.
result := parser matchesIn: 'abba'.
self assert: result size = 2.
self assert: result first = $a.
self assert: result last = $a.
result := parser matchesIn: 'baaah'.
self assert: result size = 3.
self assert: result first = $a.
self assert: result last = $a! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 3/3/2010 15:33'!
testMatchesInEmpty
"Empty matches should properly advance and match at each position and at the end."
| parser result |
parser := [ :stream | stream position ] asParser.
result := parser matchesIn: '123'.
self assert: result asArray = #(0 1 2 3)! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 3/3/2010 15:31'!
testMatchesInOverlapping
"Matches that overlap should be properly reported."
| parser result |
parser := #digit asParser , #digit asParser.
result := parser matchesIn: 'a123b'.
self assert: result size = 2.
self assert: result first = #($1 $2).
self assert: result last = #($2 $3)! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 8/16/2011 07:27'!
testMatchesSkipIn
| parser result |
parser := $a asParser.
result := parser matchesSkipIn: 'abba'.
self assert: result size = 2.
self assert: result first = $a.
self assert: result last = $a.
result := parser matchesSkipIn: 'baaah'.
self assert: result size = 3.
self assert: result first = $a.
self assert: result last = $a! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 8/16/2011 07:28'!
testMatchesSkipInOverlapping
"Matches that overlap should be properly reported."
| parser result |
parser := #digit asParser , #digit asParser.
result := parser matchesSkipIn: 'a123b'.
self assert: result size = 1.
self assert: result first = #($1 $2)! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 10/30/2011 12:13'!
testMatchingRangesIn
| input parser result |
input := 'a12b3'.
parser := #digit asParser plus.
result := parser matchingRangesIn: input.
result := result collect: [ :each | input copyFrom: each first to: each last ].
self assert: result size = 3.
self assert: result first = '12'.
self assert: result second = '2'.
self assert: result last = '3'! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 10/30/2011 12:12'!
testMatchingSkipRangesIn
| input parser result |
input := 'a12b3'.
parser := #digit asParser plus.
result := parser matchingSkipRangesIn: input.
result := result collect: [ :each | input copyFrom: each first to: each last ].
self assert: result size = 2.
self assert: result first = '12'.
self assert: result last = '3'! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 8/14/2010 13:28'!
testParse
| parser result |
parser := $a asParser.
self assert: (parser parse: 'a') = $a.
self assert: (result := parser parse: 'b') isPetitFailure.
self assert: (result message includesSubString: '$a').
self assert: (result message includesSubString: 'expected').
self assert: (result position = 0).
self assert: (parser parse: 'a' readStream) = $a.
self assert: (result := parser parse: 'b' readStream) isPetitFailure.
self assert: (result message includesSubString: '$a').
self assert: (result message includesSubString: 'expected').
self assert: (result position = 0)! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 2/7/2010 23:00'!
testParseOnError0
| parser result seen |
parser := $a asParser.
result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
self assert: result = $a.
result := parser parse: 'b' onError: [ seen := true ].
self assert: result.
self assert: seen! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 8/14/2010 13:30'!
testParseOnError1
| parser result seen |
parser := $a asParser.
result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
self assert: result = $a.
result := parser parse: 'b' onError: [ :failure |
self assert: (failure position = 0).
self assert: (failure message includesSubString: '$a').
self assert: (failure message includesSubString: 'expected').
seen := true ].
self assert: result.
self assert: seen! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 8/14/2010 13:28'!
testParseOnError2
| parser result seen |
parser := $a asParser.
result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
self assert: result = $a.
result := parser parse: 'b' onError: [ :msg :pos |
self assert: (msg includesSubString: '$a').
self assert: (msg includesSubString: 'expected').
self assert: pos = 0.
seen := true ].
self assert: result.
self assert: seen! !
!PPParserTest methodsFor: 'testing-utilities' stamp: 'lr 8/6/2010 19:06'!
testParser
| parser |
parser := PPParser new.
self assert: parser isPetitParser.
self deny: 4 isPetitParser.
self deny: 'foo' isPetitParser! !
!PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:38'!
testHasProperty
| parser |
parser := PPParser new.
self deny: (parser hasProperty: #foo).
parser propertyAt: #foo put: 123.
self assert: (parser hasProperty: #foo)! !
!PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:41'!
testPostCopy
| parser copy |
parser := PPParser new.
parser propertyAt: #foo put: true.
copy := parser copy.
copy propertyAt: #foo put: false.
self assert: (parser propertyAt: #foo).
self deny: (copy propertyAt: #foo)! !
!PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:36'!
testPropertyAt
| parser |
parser := PPParser new.
self should: [ parser propertyAt: #foo ] raise: Error.
parser propertyAt: #foo put: true.
self assert: (parser propertyAt: #foo)! !
!PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:37'!
testPropertyAtIfAbsent
| parser |
parser := PPParser new.
self assert: (parser propertyAt: #foo ifAbsent: [ true ]).
parser propertyAt: #foo put: true.
self assert: (parser propertyAt: #foo ifAbsent: [ false ])! !
!PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:37'!
testPropertyAtIfAbsentPut
| parser |
parser := PPParser new.
self assert: (parser propertyAt: #foo ifAbsentPut: [ true ]).
self assert: (parser propertyAt: #foo ifAbsentPut: [ false ])! !
!PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:37'!
testRemoveProperty
| parser |
parser := PPParser new.
self should: [ parser removeProperty: #foo ] raise: Error.
parser propertyAt: #foo put: true.
self assert: (parser removeProperty: #foo)! !
!PPParserTest methodsFor: 'testing-properties' stamp: 'lr 4/19/2010 10:37'!
testRemovePropertyIfAbsent
| parser |
parser := PPParser new.
self assert: (parser removeProperty: #foo ifAbsent: [ true ]).
parser propertyAt: #foo put: true.
self assert: (parser removeProperty: #foo ifAbsent: [ false ])! !
!PPParserTest methodsFor: 'testing-accessing' stamp: 'lr 3/30/2009 16:36'!
testNamed
| parser |
parser := PPSequenceParser new.
self assert: parser name isNil.
parser := PPChoiceParser named: 'choice'.
self assert: parser name = 'choice'.
parser := $* asParser name: 'star'.
self assert: parser name = 'star'! !
!PPParserTest methodsFor: 'testing-accessing' stamp: 'lr 8/14/2010 13:16'!
testPrint
| parser |
parser := PPParser new.
self assert: (parser printString includesSubString: 'PPParser').
parser := PPParser named: 'choice'.
self assert: (parser printString includesSubString: 'PPParser(choice').
parser := PPLiteralObjectParser on: $a.
self assert: (parser printString includesSubString: '$a').
parser := PPFailingParser message: 'error'.
self assert: (parser printString includesSubString: 'error').
parser := PPPredicateObjectParser on: [ :c | true ] message: 'error'.
self assert: (parser printString includesSubString: 'error')! !
!PPParserTest methodsFor: 'testing-fixtures' stamp: 'lr 2/7/2010 22:00'!
testSideEffectChoice
"Adding another element to a choice should create a copy, otherwise we get unwanted side-effects."
| p1 p2 p3 |
p1 := $a asParser.
p2 := p1 / $b asParser.
p3 := p1 / $c asParser.
self assert: p1 parse: 'a'.
self assert: p1 fail: 'b'.
self assert: p1 fail: 'c'.
self assert: p2 parse: 'a'.
self assert: p2 parse: 'b'.
self assert: p2 fail: 'c'.
self assert: p3 parse: 'a'.
self assert: p3 fail: 'b'.
self assert: p3 parse: 'c'! !
!PPParserTest methodsFor: 'testing-fixtures' stamp: 'lr 5/31/2010 19:25'!
testSideEffectListCopy
| old new |
old := $a asParser , $b asParser.
new := old copy.
self deny: old == new.
self deny: old children == new children.
self assert: old children first == new children first.
self assert: old children last == new children last! !
!PPParserTest methodsFor: 'testing-fixtures' stamp: 'lr 4/14/2010 11:38'!
testSideEffectSequence
"Adding another element to a sequence should create a copy, otherwise we get unwanted side-effects."
| p1 p2 p3 |
p1 := $a asParser.
p2 := p1 , $b asParser.
p3 := p1 , $c asParser.
self assert: p1 parse: 'a'.
self assert: p1 parse: 'ab' end: 1.
self assert: p1 parse: 'ac' end: 1.
self assert: p2 fail: 'a'.
self assert: p2 parse: 'ab'.
self assert: p2 fail: 'ac'.
self assert: p3 fail: 'a'.
self assert: p3 fail: 'ab'.
self assert: p3 parse: 'ac'! !
!PPPredicateTest methodsFor: 'utilities' stamp: 'lr 6/12/2010 08:37'!
assertCharacterSets: aParser
"Assert the character set of aParser does not overlap with the character set with the negated parser, and that they both cover the complete character space."
| positives negatives |
positives := self parsedCharacterSet: aParser.
negatives := self parsedCharacterSet: aParser negate.
self charactersDo: [ :char |
| positive negative |
positive := positives includes: char.
negative := negatives includes: char.
self
assert: ((positive and: [ negative not ])
or: [ positive not and: [ negative ] ])
description: char printString , ' should be in exactly one set' ]! !
!PPPredicateTest methodsFor: 'utilities' stamp: 'lr 6/12/2010 08:37'!
parsedCharacterSet: aParser
| result |
result := WriteStream on: String new.
self charactersDo: [ :char |
(aParser matches: (String with: char))
ifTrue: [ result nextPut: char ] ].
^ result contents! !
!PPPredicateTest methodsFor: 'private' stamp: 'MM 3/3/2024 10:34:54'!
charactersDo: aBlock
0 to: 255 do: [ :index | aBlock value: (Character codePoint: index) ]! !
!PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 11/29/2009 09:32'!
testAny
| parser |
parser := #any asParser.
self assertCharacterSets: parser.
self assert: parser parse: ' ' to: $ .
self assert: parser parse: '1' to: $1.
self assert: parser parse: 'a' to: $a.
self assert: parser fail: ''! !
!PPPredicateTest methodsFor: 'testing-objects' stamp: 'tg 7/12/2010 11:26'!
testAnyExceptAnyOf
| parser |
parser := PPPredicateObjectParser anyExceptAnyOf: #($: $,).
self assertCharacterSets: parser.
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'z' to: $z.
self assert: parser fail: ':'.
self assert: parser fail: ','! !
!PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 6/12/2010 09:16'!
testAnyOf
| parser |
parser := PPPredicateObjectParser anyOf: #($a $z).
self assertCharacterSets: parser.
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'z' to: $z.
self assert: parser fail: 'x'! !
!PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 6/12/2010 09:16'!
testBetweenAnd
| parser |
parser := PPPredicateObjectParser between: $b and: $d.
self assertCharacterSets: parser.
self assert: parser fail: 'a'.
self assert: parser parse: 'b' to: $b.
self assert: parser parse: 'c' to: $c.
self assert: parser parse: 'd' to: $d.
self assert: parser fail: 'e'! !
!PPPredicateTest methodsFor: 'testing-objects' stamp: 'lr 6/12/2010 09:16'!
testExpect
| parser |
parser := PPPredicateObjectParser expect: $a.
self assertCharacterSets: parser.
self assert: parser parse: 'a' to: $a.
self assert: parser fail: 'b'.
self assert: parser fail: ''! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'jmv 1/9/2024 15:38:00'!
testBlank
| parser |
parser := #blank asParser.
self assertCharacterSets: parser.
self assert: parser parse: (String with: Character space) to: Character space.
self assert: parser parse: (String with: Character tab) to: Character tab.
self assert: parser fail: ''.
self assert: parser fail: '1'.
self assert: parser fail: (String with: Character cr)! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 5/2/2010 12:51'!
testChar
| parser |
parser := $* asParser.
self assertCharacterSets: parser.
self assert: parser parse: '*' to: $*.
self assert: parser parse: '**' to: $* end: 1.
self assert: parser fail: ''.
self assert: parser fail: '1'.
self assert: parser fail: 'a'! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'jmv 1/9/2024 15:38:06'!
testCr
| parser |
parser := #cr asParser.
self assertCharacterSets: parser.
self assert: parser parse: (String with: Character cr) to: Character cr! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'!
testDigit
| parser |
parser := #digit asParser.
self assertCharacterSets: parser.
self assert: parser parse: '0' to: $0.
self assert: parser parse: '9' to: $9.
self assert: parser fail: ''.
self assert: parser fail: 'a'! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'!
testHex
| parser |
parser := #hex asParser.
self assertCharacterSets: parser.
self assert: parser parse: '0' to: $0.
self assert: parser parse: '5' to: $5.
self assert: parser parse: '9' to: $9.
self assert: parser parse: 'A' to: $A.
self assert: parser parse: 'D' to: $D.
self assert: parser parse: 'F' to: $F.
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'e' to: $e.
self assert: parser parse: 'f' to: $f.
self assert: parser fail: ''.
self assert: parser fail: 'g'! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'!
testLetter
| parser |
parser := #letter asParser.
self assertCharacterSets: parser.
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'Z' to: $Z.
self assert: parser fail: ''.
self assert: parser fail: '0'! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'jmv 1/9/2024 15:39:56'!
testLf
| parser |
parser := #lf asParser.
self assertCharacterSets: parser.
self assert: parser parse: (String with: Character lf) to: Character lf! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'!
testLowercase
| parser |
parser := #lowercase asParser.
self assertCharacterSets: parser.
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'z' to: $z.
self assert: parser fail: ''.
self assert: parser fail: 'A'.
self assert: parser fail: '0'! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'jmv 1/9/2024 15:38:14'!
testNewline
| parser |
parser := #newline asParser.
self assertCharacterSets: parser.
self assert: parser parse: (String with: Character cr) to: Character cr.
self assert: parser parse: (String with: Character lf) to: Character lf.
self assert: parser fail: ' '! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 5/5/2010 14:14'!
testPunctuation
| parser |
parser := #punctuation asParser.
self assertCharacterSets: parser.
self assert: parser parse: '.' to: $..
self assert: parser parse: ',' to: $,.
self assert: parser fail: ''.
self assert: parser fail: 'a'.
self assert: parser fail: '1'! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'!
testSpace
| parser |
parser := #space asParser.
self assertCharacterSets: parser.
self assert: parser parse: (String with: Character tab) to: Character tab.
self assert: parser parse: ' ' to: Character space.
self assert: parser fail: ''.
self assert: parser fail: 'a'! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'!
testTab
| parser |
parser := #tab asParser.
self assertCharacterSets: parser.
self assert: parser parse: (String with: Character tab) to: Character tab! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'!
testUppercase
| parser |
parser := #uppercase asParser.
self assertCharacterSets: parser.
self assert: parser parse: 'A' to: $A.
self assert: parser parse: 'Z' to: $Z.
self assert: parser fail: ''.
self assert: parser fail: 'a'.
self assert: parser fail: '0'! !
!PPPredicateTest methodsFor: 'testing-chars' stamp: 'lr 11/29/2009 09:32'!
testWord
| parser |
parser := #word asParser.
self assertCharacterSets: parser.
self assert: parser parse: 'a' to: $a.
self assert: parser parse: 'A' to: $A.
self assert: parser parse: '0' to: $0.
self assert: parser fail: ''.
self assert: parser fail: '-'! !
!PPPredicateTest methodsFor: 'testing' stamp: 'lr 6/12/2010 09:17'!
testOnMessage
| block parser |
block := [ :char | char = $* ].
parser := PPPredicateObjectParser on: block message: 'starlet'.
self assert: parser block = block.
self assert: parser message = 'starlet'.
self assertCharacterSets: parser.
self assert: parser parse: '*' to: $*.
self assert: parser parse: '**' to: $* end: 1.
self assert: parser fail: ''.
self assert: parser fail: '1'.
self assert: parser fail: 'a'! !
!PPPredicateTest methodsFor: 'testing-sequence' stamp: 'lr 6/12/2010 09:27'!
testSequenceParser
| parser |
parser := PPPredicateSequenceParser
on: [ :value | value first isUppercase ]
message: 'uppercase 3 letter words'
size: 3.
self assert: parser size = 3.
self assert: parser parse: 'Abc'.
self assert: parser parse: 'ABc'.
self assert: parser parse: 'ABC'.
self assert: parser fail: 'abc'.
self assert: parser fail: 'aBC'.
self assert: parser fail: 'Ab'.
parser := parser negate.
self assert: parser size = 3.
self assert: parser fail: 'Abc'.
self assert: parser fail: 'ABc'.
self assert: parser fail: 'ABC'.
self assert: parser parse: 'abc'.
self assert: parser parse: 'aBC'.
self assert: parser fail: 'Ab'! !
!PPScriptingTest methodsFor: 'examples' stamp: 'pmon 5/31/2012 23:59'!
expressionInterpreter
"Same as #expressionInterpreter but with semantic actions."
| mul prim add dec |
add := PPUnresolvedParser new.
mul := PPUnresolvedParser new.
prim := PPUnresolvedParser new.
dec := ($0 - $9) ==> [ :token | token asciiValue - $0 asciiValue ].
add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ])
/ mul.
mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ])
/ prim.
prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ])
/ dec.
^ add end! !
!PPScriptingTest methodsFor: 'examples' stamp: 'lr 6/12/2010 08:30'!
expressionParser
"Simple demo of scripting an expression parser."
| mul prim add dec |
add := PPUnresolvedParser new.
mul := PPUnresolvedParser new.
prim := PPUnresolvedParser new.
dec := ($0 - $9).
add def: (mul , $+ asParser , add)
/ mul.
mul def: (prim , $* asParser , mul)
/ prim.
prim def: ($( asParser , add , $) asParser)
/ dec.
^ add end! !
!PPScriptingTest methodsFor: 'examples' stamp: 'lr 10/20/2008 13:27'!
straightLineParser
| goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper |
goal := PPUnresolvedParser new.
stmList := PPUnresolvedParser new.
stm := PPUnresolvedParser new.
exp := PPUnresolvedParser new.
expList := PPUnresolvedParser new.
mulExp := PPUnresolvedParser new.
primExp := PPUnresolvedParser new.
lower := $a - $z.
upper := $A - $Z.
char := lower / upper.
nonzero := $1 - $9.
dec := $0 - $9.
id := char, ( char / dec ) star.
num := $0 asParser / ( nonzero, dec star).
goal def: stmList end.
stmList def: stm , ( $; asParser, stm ) star.
stm def: ( id, ':=' asParser, exp )
/ ( 'print' asParser, $( asParser, expList, $) asParser ).
exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star.
expList def: exp, ( $, asParser, exp ) star.
mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star.
primExp def: id
/ num
/ ( $( asParser, stmList, $, asParser, exp, $) asParser ).
^ goal
! !
!PPScriptingTest methodsFor: 'tests' stamp: 'lr 6/12/2010 08:31'!
testExpressionInterpreter
self
assert: self expressionInterpreter
parse: '2*(3+4)'
to: 14! !
!PPScriptingTest methodsFor: 'tests' stamp: 'lr 6/12/2010 08:31'!
testExpressionParser
self
assert: self expressionParser
parse: '2*(3+4)'
to: #($2 $* ($( ($3 $+ $4) $)))! !
!PPScriptingTest methodsFor: 'tests' stamp: 'lr 9/17/2008 22:44'!
testSLassign
self assert: self straightLineParser
parse: 'abc:=1'
to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #())! !
!PPScriptingTest methodsFor: 'tests' stamp: 'lr 6/12/2010 08:27'!
testSLprint
self
assert: self straightLineParser
parse: 'print(3,4)'
to: #(('print' $( ((($3 ()) ()) () (($, ((($4 ()) ()) ())))) $)) ())! !
!PPTokenTest methodsFor: 'accessing' stamp: 'lr 4/3/2009 08:51'!
identifier
^ #word asParser plus token! !
!PPTokenTest methodsFor: 'utilities' stamp: 'lr 3/29/2010 15:34'!
parse: aString using: aParser
^ aParser parse: aString! !
!PPTokenTest methodsFor: 'testing' stamp: 'lr 4/3/2009 08:49'!
testCollection
| input result |
input := 'foo '.
result := self
parse: input
using: self identifier.
self assert: (result collection = input).
self assert: (result collection == input)! !
!PPTokenTest methodsFor: 'testing' stamp: 'lr 4/14/2010 11:44'!
testNew
self should: [ PPToken new ] raise: Error.
! !
!PPTokenTest methodsFor: 'testing' stamp: 'lr 8/14/2010 13:16'!
testPrinting
| result |
result := PPToken on: 'var'.
self assert: (result printString includesSubString: 'PPToken(var)')! !
!PPTokenTest methodsFor: 'testing' stamp: 'TestRunner 12/4/2009 19:16'!
testSize
| result |
result := self
parse: 'foo'
using: self identifier.
self assert: result size = 3! !
!PPTokenTest methodsFor: 'testing' stamp: 'TestRunner 12/4/2009 19:16'!
testStart
| result |
result := self
parse: 'foo'
using: self identifier.
self assert: result start = 1! !
!PPTokenTest methodsFor: 'testing' stamp: 'TestRunner 12/4/2009 19:16'!
testStop
| result |
result := self
parse: 'foo'
using: self identifier.
self assert: result stop = 3! !
!PPTokenTest methodsFor: 'testing' stamp: 'lr 4/3/2009 08:51'!
testValue
| input result |
input := 'foo'.
result := self
parse: input
using: self identifier.
self assert: result value = input.
self deny: result value == input! !
!PPTokenTest methodsFor: 'testing-querying' stamp: 'jmv 1/9/2024 15:38:27'!
testColumn
| input parser result |
input := '1' , (String with: Character cr) , '12' , (String with: Character cr with: Character lf) , '123' , (String with: Character lf) , '1234'.
parser := #any asParser token star.
result := parser parse: input.
result
with: #(1 2 1 2 3 4 1 2 3 4 1 2 3 4)
do: [ :token :line | self assert: token column = line ]! !
!PPTokenTest methodsFor: 'testing-querying' stamp: 'jmv 1/9/2024 15:38:45'!
testLine
| input parser result |
input := '1' , (String with: Character cr) , '12' , (String with: Character cr with: Character lf) , '123' , (String with: Character lf) , '1234'.
parser := #any asParser token star.
result := parser parse: input.
result
with: #(1 1 2 2 2 2 3 3 3 3 4 4 4 4)
do: [ :token :line | self assert: token line = line ]! !
!PPTokenTest methodsFor: 'testing-copying' stamp: 'lr 4/21/2009 08:50'!
testCopyFromTo
| result other |
result := PPToken on: 'abc'.
other := result copyFrom: 2 to: 2.
self assert: other size = 1.
self assert: other start = 2.
self assert: other stop = 2.
self assert: other collection = result collection! !
!PPTokenTest methodsFor: 'testing-comparing' stamp: 'lr 10/23/2009 11:37'!
testEquality
| token1 token2 |
token1 := self parse: 'foo' using: self identifier.
token2 := self parse: 'foo' using: self identifier.
self deny: token1 == token2.
self assert: token1 = token2.
self assert: token1 hash = token2 hash.! !
!PPParserResource methodsFor: 'accessing' stamp: 'lr 9/15/2010 12:12'!
parserAt: aParserClass
"Answer a cached instance of aParserClass."
^ parsers at: aParserClass name ifAbsentPut: [ aParserClass new ]! !
!PPParserResource methodsFor: 'running' stamp: 'lr 3/29/2010 15:20'!
setUp
super setUp.
parsers := Dictionary new! !
!PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 4/6/2010 19:38'!
addition
^ (factors separatedBy: ($+ asParser / $- asParser) token trim)
foldLeft: [ :a :op :b | a perform: op value asSymbol with: b ]! !
!PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 9/15/2008 09:28'!
factors
^ multiplication / power! !
!PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 4/6/2010 19:38'!
multiplication
^ (power separatedBy: ($* asParser / $/ asParser) token trim)
foldLeft: [ :a :op :b | a perform: op value asSymbol with: b ]! !
!PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 4/6/2010 19:38'!
number
^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) token trim ==> [ :token | token value asNumber ]! !
!PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 4/6/2010 19:38'!
parentheses
^ $( asParser flatten trim , terms , $) asParser flatten trim ==> #second! !
!PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 4/6/2010 19:38'!
power
^ (primary separatedBy: $^ asParser token trim) foldRight: [ :a :op :b | a raisedTo: b ]! !
!PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 9/15/2008 09:28'!
primary
^ number / parentheses! !
!PPArithmeticParser methodsFor: 'grammar' stamp: 'lr 9/15/2008 09:29'!
terms
^ addition / factors! !
!PPArithmeticParser methodsFor: 'accessing' stamp: 'lr 7/3/2008 17:06'!
start
^ terms end! !
!PPLambdaParser methodsFor: 'productions' stamp: 'lr 4/6/2010 19:38'!
abstraction
^ $\ asParser token trim , variable , $. asParser token trim , expression ==> [ :node | Array with: node second with: node fourth ]! !
!PPLambdaParser methodsFor: 'productions' stamp: 'lr 4/6/2010 19:38'!
application
^ $( asParser token trim , expression , expression , $) asParser token trim ==> [ :node | Array with: node second with: node third ]! !
!PPLambdaParser methodsFor: 'productions' stamp: 'lr 9/15/2008 09:29'!
expression
^ variable / abstraction / application! !
!PPLambdaParser methodsFor: 'productions' stamp: 'lr 4/6/2010 19:37'!
variable
^ (#letter asParser , #word asParser star) token trim ==> [ :token | token value ]! !
!PPLambdaParser methodsFor: 'accessing' stamp: 'lr 5/19/2008 11:35'!
start
^ expression end! !
!PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'!
and
^ self parse: '\p.\q.((p q) p)'! !
!PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'!
false
^ self parse: '\x.\y.y'! !
!PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'!
ifthenelse
^ self parse: '\p.p'! !
!PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'!
not
^ self parse: '\p.\a.\b.((p b) a)'! !
!PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'!
or
^ self parse: '\p.\q.((p p) q)'! !
!PPLambdaParser class methodsFor: 'curch-booleans' stamp: 'lr 4/3/2009 08:28'!
true
^ self parse: '\x.\y.x'! !
More information about the Cuis-dev
mailing list