--- a/analyzer/tests/Make.proto Sat Nov 08 02:08:45 2014 +0000
+++ b/analyzer/tests/Make.proto Wed Nov 19 10:52:37 2014 +0000
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/analyzer -I$(INCLUDE_TOP)/stx/goodies/petitparser/tests -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/libbasic
# if you need any additional defines for embedded C code,
@@ -102,13 +102,6 @@
# build all mandatory prerequisite packages (containing superclasses) for this package
prereq:
cd ../../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../ && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../tests && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
--- a/analyzer/tests/Make.spec Sat Nov 08 02:08:45 2014 +0000
+++ b/analyzer/tests/Make.spec Wed Nov 19 10:52:37 2014 +0000
@@ -42,6 +42,7 @@
# -warnNonStandard : no warnings about ST/X extensions
# -warnEOLComments : no warnings about EOL comment extension
# -warnPrivacy : no warnings about privateClass extension
+# -warnUnused : no warnings about unused variables
#
# ********** OPTIONAL: MODIFY the next line(s) ***
# STCWARNINGS=-warn
--- a/analyzer/tests/abbrev.stc Sat Nov 08 02:08:45 2014 +0000
+++ b/analyzer/tests/abbrev.stc Wed Nov 19 10:52:37 2014 +0000
@@ -1,7 +1,7 @@
# automagically generated by the project definition
# this file is needed for stc to be able to compile modules independently.
# it provides information about a classes filename, category and especially namespace.
+stx_goodies_petitparser_analyzer_tests stx_goodies_petitparser_analyzer_tests stx:goodies/petitparser/analyzer/tests '* Projects & Packages *' 3
PPAnalyzerTest PPAnalyzerTest stx:goodies/petitparser/analyzer/tests 'PetitAnalyzer-Tests' 1
PPRewriterTest PPRewriterTest stx:goodies/petitparser/analyzer/tests 'PetitAnalyzer-Tests' 1
PPSearcherTest PPSearcherTest stx:goodies/petitparser/analyzer/tests 'PetitAnalyzer-Tests' 1
-stx_goodies_petitparser_analyzer_tests stx_goodies_petitparser_analyzer_tests stx:goodies/petitparser/analyzer/tests '* Projects & Packages *' 3
--- a/analyzer/tests/bc.mak Sat Nov 08 02:08:45 2014 +0000
+++ b/analyzer/tests/bc.mak Wed Nov 19 10:52:37 2014 +0000
@@ -30,11 +30,12 @@
!INCLUDE Make.spec
LIBNAME=libstx_goodies_petitparser_analyzer_tests
+MODULE_PATH=goodies\petitparser\analyzer\tests
RESFILES=tests.$(RES)
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\analyzer -I$(INCLUDE_TOP)\stx\goodies\petitparser\tests -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\libbasic
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
@@ -51,13 +52,6 @@
# build all mandatory prerequisite packages (containing superclasses) for this package
prereq:
pushd ..\..\..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\.. & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\tests & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
--- a/analyzer/tests/stx_goodies_petitparser_analyzer_tests.st Sat Nov 08 02:08:45 2014 +0000
+++ b/analyzer/tests/stx_goodies_petitparser_analyzer_tests.st Wed Nov 19 10:52:37 2014 +0000
@@ -52,9 +52,7 @@
by searching along the inheritance chain of all of my classes."
^ #(
- #'stx:goodies/petitparser/tests' "PPAbstractParserTest - superclass of PPAnalyzerTest"
- #'stx:goodies/sunit' "TestAsserter - superclass of PPAnalyzerTest"
- #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_analyzer_tests"
+ #'stx:libbasic' "Autoload - superclass of PPAnalyzerTest"
)
!
@@ -66,8 +64,6 @@
by searching all classes (and their packages) which are referenced by my classes."
^ #(
- #'stx:goodies/petitparser' "PPAndParser - referenced by PPAnalyzerTest>>testIsNullable"
- #'stx:goodies/petitparser/analyzer' "PPListPattern - referenced by PPRewriterTest>>testDuplicationRemoval"
)
!
@@ -91,10 +87,10 @@
^ #(
"<className> or (<className> attributes...) in load order"
+ #'stx_goodies_petitparser_analyzer_tests'
(PPAnalyzerTest autoload)
(PPRewriterTest autoload)
(PPSearcherTest autoload)
- #'stx_goodies_petitparser_analyzer_tests'
)
!
--- a/analyzer/tests/tests.rc Sat Nov 08 02:08:45 2014 +0000
+++ b/analyzer/tests/tests.rc Wed Nov 19 10:52:37 2014 +0000
@@ -4,7 +4,7 @@
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 6,2,32767,32767
- PRODUCTVERSION 6,2,4,0
+ PRODUCTVERSION 6,2,5,0
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
@@ -24,8 +24,8 @@
VALUE "InternalName", "stx:goodies/petitparser/analyzer/tests\0"
VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2014\nCopyright eXept Software AG 1998-2014\0"
VALUE "ProductName", "Smalltalk/X\0"
- VALUE "ProductVersion", "6.2.4.0\0"
- VALUE "ProductDate", "Mon, 03 Nov 2014 09:07:05 GMT\0"
+ VALUE "ProductVersion", "6.2.5.0\0"
+ VALUE "ProductDate", "Wed, 19 Nov 2014 10:47:37 GMT\0"
END
END
--- a/compiler/Make.proto Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/Make.proto Wed Nov 19 10:52:37 2014 +0000
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2
# if you need any additional defines for embedded C code,
@@ -125,8 +125,6 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
-$(OUTDIR)PPCBenchmark.$(O) PPCBenchmark.$(H): PPCBenchmark.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
-$(OUTDIR)PPCBenchmarkResources.$(O) PPCBenchmarkResources.$(H): PPCBenchmarkResources.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCBridge.$(O) PPCBridge.$(H): PPCBridge.st $(INCLUDE_TOP)/stx/goodies/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompiledMethod.$(O) PPCCompiledMethod.$(H): PPCCompiledMethod.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompiler.$(O) PPCCompiler.$(H): PPCCompiler.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
--- a/compiler/Make.spec Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/Make.spec Wed Nov 19 10:52:37 2014 +0000
@@ -42,6 +42,7 @@
# -warnNonStandard : no warnings about ST/X extensions
# -warnEOLComments : no warnings about EOL comment extension
# -warnPrivacy : no warnings about privateClass extension
+# -warnUnused : no warnings about unused variables
#
# ********** OPTIONAL: MODIFY the next line(s) ***
# STCWARNINGS=-warn
@@ -50,8 +51,6 @@
STCWARNINGS=-warnNonStandard
COMMON_CLASSES= \
- PPCBenchmark \
- PPCBenchmarkResources \
PPCBridge \
PPCCompiledMethod \
PPCCompiler \
@@ -119,8 +118,6 @@
COMMON_OBJS= \
- $(OUTDIR_SLASH)PPCBenchmark.$(O) \
- $(OUTDIR_SLASH)PPCBenchmarkResources.$(O) \
$(OUTDIR_SLASH)PPCBridge.$(O) \
$(OUTDIR_SLASH)PPCCompiledMethod.$(O) \
$(OUTDIR_SLASH)PPCCompiler.$(O) \
--- a/compiler/PPCBenchmark.st Sat Nov 08 02:08:45 2014 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,435 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-Object subclass:#PPCBenchmark
- instanceVariableNames:'sources report contextClass compile parser context input'
- classVariableNames:''
- poolDictionaries:''
- category:'PetitCompiler-Benchmarks'
-!
-
-!PPCBenchmark class methodsFor:'instance creation'!
-
-new
- "return an initialized instance"
-
- ^ self basicNew initialize.
-! !
-
-!PPCBenchmark class methodsFor:'benchmarking-CalipeL'!
-
-run
- | benchmarkSuiteClass |
-
- benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.
- benchmarkSuiteClass isNil ifTrue:[
- self error: 'CalipeL is not loaded.'
- ].
- ^ (benchmarkSuiteClass class:self) run
-
- "
- PPCBenchmark run.
- "
-!
-
-run: selector
- | benchmarkSuiteClass |
-
- benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.
- benchmarkSuiteClass isNil ifTrue:[
- self error: 'CalipeL is not loaded.'
- ].
- ^ (benchmarkSuiteClass class:self selector: selector ) run
-
- "
- PPCBenchmark run: #benchmarkRBParserC
- "
-! !
-
-!PPCBenchmark methodsFor:'benchmark support'!
-
-createContext
- ^ contextClass new
-!
-
-endSuite
-!
-
-initialize
- super initialize.
- sources := PPCBenchmarkResources new.
- contextClass := PPCContext.
- compile := false.
-!
-
-measure: parser on: input
- self measure: parser on: input name: #unknown
-!
-
-measure: aParser on: anInput name: aString
- | time result p |
- context := self createContext.
-
- compile ifTrue: [
- p := (aParser end compile: #TmpBenchmark)
- ] ifFalse: [
- p := aParser end.
- ].
-
-
- time := Time millisecondsToRun: [ result := p parse: anInput withContext: context ].
-
- self assert: result isPetitFailure not.
- self reportFor: aParser context: context input: anInput time: time name: aString.
-!
-
-measure: parser onSources: inputs name: aString
- | time result context p totalInput |
-
- compile ifTrue: [
- p := (parser end compile: #TmpBenchmark)
- ] ifFalse: [
- p := parser end.
- ].
-
- totalInput := ''.
- time := 0.
- inputs do: [:input |
- context := self createContext.
- time := time + (Time millisecondsToRun: [ result := p parse: input withContext: context ]).
- totalInput := totalInput, input.
- self assert: result isPetitFailure not.
- ].
-
-
- self reportFor: parser context: context input: totalInput time: time name: aString.
-!
-
-reportFor: parser context: context input: input time: time
- self reportFor: parser context: context input: input time: time name: #unknown
-!
-
-reportFor: aParser context: aContext input: anInput time: time name: name
- Transcript crShow: (self getMetaInfo: name).
- Transcript crShow: ' Compile: ', compile asString.
-
- Transcript crShow: ' Total time: ', time asString, ' ms'.
-
- Transcript crShow: ' Time per character: ',
- (((time / anInput size) asFloat * 1000) asString truncateTo: 6),
- ' microseconds'.
-
-" Transcript crShow: ' Backtrack per character: ',
- ((aContext backtrackCount / anInput size) asFloat asString truncateTo: 6),
- '.'.
-
- Transcript crShow: ' Remembers per character: ',
- ((aContext rememberCount / input size) asFloat asString truncateTo: 6),
- '.'.
-"
-!
-
-startSuite
- Transcript crShow: Date current asString, ' ', Time current asString.
-! !
-
-!PPCBenchmark methodsFor:'benchmarks'!
-
-benchmarkAnyStar
-"
- self measure: self anyStar on: sources petitParserPackage.
-"
- self measure: self anyStar on: (sources changesSized: 1000*1000) name: #anyStar.
-!
-
-benchmarkAnyStarBlock
-"
- self measure: self anyStar on: sources petitParserPackage.
-"
- self measure: self anyStarBlock on: (sources changesSized: 1000*1000) name: #anyStarBlock.
-!
-
-benchmarkAttributes
- | string text allStyles |
- string := (self changesSized: 60000).
- text := string asText.
- allStyles := {
- 'Announcement' -> TextColor green.
- 'Collections' -> TextColor blue.
- 'File' -> TextColor blue.
- 'Metacello' -> TextColor red.
- 'Monticello' -> TextColor magenta.
- 'Morphic' -> TextColor orange.
- 'Mooose' -> TextColor green.
- 'FAMIX' -> TextColor green.
- 'Roassal' -> TextColor green.
- }.
-
- allStyles do: [ :assoc | | parser result time |
- parser := (assoc key asParser, #newline asParser negate star).
- time := Time millisecondsToRun: [
- result := parser matchingRangesIn: string.
- ].
- self reportFor: parser input: string time: time.
- ].
-!
-
-benchmarkBacktrack
-"
- self measure: self anyStar on: sources petitParserPackage.
-"
- | parser |
- parser := ((#any asParser, 'foo' asParser) / self tokenParser / #any asParser) plus.
- self measure: parser on: (self changesSized: 100*1000) name: #backtrack.
-!
-
-benchmarkJava
- | parser |
- parser := PPJavaParser new.
- self measure: parser on: sources javaLangMath name: #java.
-!
-
-benchmarkNegate
-"
- self measure: self anyStar on: sources petitParserPackage.
-"
- | parser |
- parser := ('a' asParser negate star, 'a' asParser) star, #any asParser star.
- self measure: parser on: (self changesSized: 1000*1000) name: #negate.
-!
-
-benchmarkOpalCompiler
- | parser time input |
- parser := OpalCompiler new.
- input := sources smalltalkSourcesBig.
- time := [ input do: [ :source | parser parse: source ]] timeToRun asMilliseconds.
-
- self reportInput: input time: time name: 'Opal'
-!
-
-benchmarkSmalltalkGrammar
- | time |
-
- parser := PPSmalltalkGrammar new.
- context := PPContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
-
- time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Smalltalk Grammar'.
-!
-
-benchmarkSmalltalkGrammarCompiled
- | time |
- parser := PPSmalltalkGrammar new compile.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
-
- time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Compiled Grammar'.
-
-"
- size := input inject: 0 into: [:r :e | r + e size ].
- Transcript crShow: 'Compiled Grammar time: ', time asString.
- Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
-"
-!
-
-benchmarkSmalltalkObject
- | parser |
- parser := PPSmalltalkGrammar new.
- self measure: parser onSources: sources smalltalkObjectMethods name: #smalltalkObject.
-!
-
-benchmarkSmalltalkParser
- | time |
- parser := PPSmalltalkParser new.
- context := PPContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
-
- time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Smalltalk Parser'.
-!
-
-benchmarkSmalltalkParserCompiled
- | time |
- parser := PPSmalltalkParser new compile.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
-
- time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
-
- self reportInput: input time: time name: 'Smalltalk Parser Compiled'.
-!
-
-benchmarkToken
-"
- self measure: self anyStar on: sources petitParserPackage.
-"
- | parser |
- parser := (self tokenParser / #any asParser) star.
- self measure: parser on: (self changesSized: 1000*1000) name: #token.
-!
-
-reportInput: input time: time name: name
- | size |
- size := input inject: 0 into: [:r :e | r + e size ].
- Transcript crShow: 'Size: ', size asString.
- Transcript crShow: name, ' time: ', time asString.
- Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
-! !
-
-!PPCBenchmark methodsFor:'benchmarks-CalipeL'!
-
-benchmarkRBParserC
- <setup: #setupRBParserC>
- <benchmark: 'RB Smalltalk Parser'>
-
- input do: [ :source | RBParser parseMethod: source ]
-!
-
-benchmarkSmalltalkParserC
- <setup: #setupSmalltalkParserC>
- <benchmark: 'Petit Smalltalk Parser - Standard'>
-
- input do: [ :source | parser parse: source withContext: context ]
-!
-
-benchmarkSmalltalkParserCompiledC
- <setup: #setupSmalltalkParserCompiledC>
- <teaddown: #teardownSmalltalkParserCompiledC>
- <benchmark: 'Petit Smalltalk Parser - Compiled'>
-
- input do: [ :source | parser parse: source withContext: context ]
-
-! !
-
-!PPCBenchmark methodsFor:'meta'!
-
-getMetaInfo: key
- | info |
- info := self metaInfo select: [ :each | each key = key ].
- info isEmpty ifTrue: [ ^ 'unknown benchmark' ].
- ^ info anyOne value
-!
-
-metaInfo
- ^ {
- #anyStar -> '.* Parser'.
- #token -> 'Token Parser'.
- #anyStarBlock -> 'context next in loop'.
- }
-! !
-
-!PPCBenchmark methodsFor:'parsers'!
-
-anyStar
- ^ #any asParser star
-!
-
-anyStarBlock
- ^ [ :ctx | [ctx atEnd] whileFalse: [ ctx next ] ] asParser
-!
-
-tokenParser
- ^ #letter asParser, (#letter asParser / #digit asParser) star trim
-! !
-
-!PPCBenchmark methodsFor:'settings'!
-
-compile: aBoolean
- compile := aBoolean
-!
-
-contextClass: aClass
- contextClass := aClass
-! !
-
-!PPCBenchmark methodsFor:'setup & teardown-CalipeL'!
-
-setupJavaSyntaxCompiledC
- parser := PPJavaSyntax new compile.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources javaSourcesBig.
-
-"
- size := input inject: 0 into: [:r :e | r + e size ].
- Transcript crShow: 'Compiled Grammar time: ', time asString.
- Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
-"
-!
-
-setupRBParserC
-
- input := sources smalltalkSourcesBig.
-!
-
-setupSmalltalkParserC
-
- parser := PPSmalltalkParser new.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
-!
-
-setupSmalltalkParserCompiledC
- parser := PPSmalltalkParser new compile.
- context := PPCContext new.
- context initializeFor: parser.
- input := sources smalltalkSourcesBig.
-
-"
- size := input inject: 0 into: [:r :e | r + e size ].
- Transcript crShow: 'Compiled Grammar time: ', time asString.
- Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
-"
-!
-
-teardownJavaSyntaxCompiledC
- parser class removeFromSystem.
-"
- size := input inject: 0 into: [:r :e | r + e size ].
- Transcript crShow: 'Compiled Grammar time: ', time asString.
- Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
-"
-!
-
-teardownSmalltalkParserCompiledC
- parser class removeFromSystem.
-"
- size := input inject: 0 into: [:r :e | r + e size ].
- Transcript crShow: 'Compiled Grammar time: ', time asString.
- Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
-"
-! !
-
-!PPCBenchmark methodsFor:'sources'!
-
-changesSized: size
- | string changes |
- changes := PharoFilesOpener default changesFileOrNil contents.
- string := changes copyFrom: 1 to: size.
- ^ string
-
-! !
-
-!PPCBenchmark methodsFor:'suites'!
-
-suite1
- self startSuite.
-
- self benchmarkNegate.
- self benchmarkBacktrack.
- self benchmarkToken.
- self benchmarkAnyStar.
- self benchmarkJava.
-
- self endSuite.
-! !
-
--- a/compiler/PPCBenchmarkResources.st Sat Nov 08 02:08:45 2014 +0000
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,5216 +0,0 @@
-"{ Package: 'stx:goodies/petitparser/compiler' }"
-
-Object subclass:#PPCBenchmarkResources
- instanceVariableNames:''
- classVariableNames:'javaCache'
- poolDictionaries:''
- category:'PetitCompiler-Benchmarks'
-!
-
-!PPCBenchmarkResources methodsFor:'as yet unclassified'!
-
-changesSized: size
- | string changes |
- changes := PharoFilesOpener default changesFileOrNil contents.
- string := changes copyFrom: 1 to: size.
- ^ string
-
-!
-
-javaInDirectory: directory
- | files |
- files := self readDirectory: directory.
- files := self files: files withExtension: 'java'.
-
- ^ files collect: [ :f | (FileStream fileNamed: f) contents ]
-!
-
-javaLangClass
-!
-
-javaLangMath
- ^ '/*
- * @(#)Math.java 1.69 04/06/14
- *
- * Copyright 2004 Sun Microsystems, Inc. All rights reserved.
- * SUN PROPRIETARY/CONFIDENTIAL. Use is subject to license terms.
- */
-
-package java.lang;
-import java.util.Random;
-
-
-/**
- * The class <code>Math</code> contains methods for performing basic
- * numeric operations such as the elementary exponential, logarithm,
- * square root, and trigonometric functions.
- *
- * <p>Unlike some of the numeric methods of class
- * <code>StrictMath</code>, all implementations of the equivalent
- * functions of class <code>Math</code> are not defined to return the
- * bit-for-bit same results. This relaxation permits
- * better-performing implementations where strict reproducibility is
- * not required.
- *
- * <p>By default many of the <code>Math</code> methods simply call
- * the equivalent method in <code>StrictMath</code> for their
- * implementation. Code generators are encouraged to use
- * platform-specific native libraries or microprocessor instructions,
- * where available, to provide higher-performance implementations of
- * <code>Math</code> methods. Such higher-performance
- * implementations still must conform to the specification for
- * <code>Math</code>.
- *
- * <p>The quality of implementation specifications concern two
- * properties, accuracy of the returned result and monotonicity of the
- * method. Accuracy of the floating-point <code>Math</code> methods
- * is measured in terms of <i>ulps</i>, units in the last place. For
- * a given floating-point format, an ulp of a specific real number
- * value is the distance between the two floating-point values
- * bracketing that numerical value. When discussing the accuracy of a
- * method as a whole rather than at a specific argument, the number of
- * ulps cited is for the worst-case error at any argument. If a
- * method always has an error less than 0.5 ulps, the method always
- * returns the floating-point number nearest the exact result; such a
- * method is <i>correctly rounded</i>. A correctly rounded method is
- * generally the best a floating-point approximation can be; however,
- * it is impractical for many floating-point methods to be correctly
- * rounded. Instead, for the <code>Math</code> class, a larger error
- * bound of 1 or 2 ulps is allowed for certain methods. Informally,
- * with a 1 ulp error bound, when the exact result is a representable
- * number, the exact result should be returned as the computed result;
- * otherwise, either of the two floating-point values which bracket
- * the exact result may be returned. For exact results large in
- * magnitude, one of the endpoints of the bracket may be infinite.
- * Besides accuracy at individual arguments, maintaining proper
- * relations between the method at different arguments is also
- * important. Therefore, most methods with more than 0.5 ulp errors
- * are required to be <i>semi-monotonic</i>: whenever the mathematical
- * function is non-decreasing, so is the floating-point approximation,
- * likewise, whenever the mathematical function is non-increasing, so
- * is the floating-point approximation. Not all approximations that
- * have 1 ulp accuracy will automatically meet the monotonicity
- * requirements.
- *
- * @author unascribed
- * @author Joseph D. Darcy
- * @version 1.69, 06/14/04
- * @since JDK1.0
- */
-
-public final class Math {
-
- /**
- * Don''t let anyone instantiate this class.
- */
- private Math() {}
-
- /**
- * The <code>double</code> value that is closer than any other to
- * <i>e</i>, the base of the natural logarithms.
- */
- public static final double E = 2.7182818284590452354;
-
- /**
- * The <code>double</code> value that is closer than any other to
- * <i>pi</i>, the ratio of the circumference of a circle to its
- * diameter.
- */
- public static final double PI = 3.14159265358979323846;
-
- /**
- * Returns the trigonometric sine of an angle. Special cases:
- * <ul><li>If the argument is NaN or an infinity, then the
- * result is NaN.
- * <li>If the argument is zero, then the result is a zero with the
- * same sign as the argument.</ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic.
- *
- * @param a an angle, in radians.
- * @return the sine of the argument.
- */
- public static double sin(double a) {
- return StrictMath.sin(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the trigonometric cosine of an angle. Special cases:
- * <ul><li>If the argument is NaN or an infinity, then the
- * result is NaN.</ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic.
- *
- * @param a an angle, in radians.
- * @return the cosine of the argument.
- */
- public static double cos(double a) {
- return StrictMath.cos(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the trigonometric tangent of an angle. Special cases:
- * <ul><li>If the argument is NaN or an infinity, then the result
- * is NaN.
- * <li>If the argument is zero, then the result is a zero with the
- * same sign as the argument.</ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic.
- *
- * @param a an angle, in radians.
- * @return the tangent of the argument.
- */
- public static double tan(double a) {
- return StrictMath.tan(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the arc sine of an angle, in the range of -<i>pi</i>/2 through
- * <i>pi</i>/2. Special cases:
- * <ul><li>If the argument is NaN or its absolute value is greater
- * than 1, then the result is NaN.
- * <li>If the argument is zero, then the result is a zero with the
- * same sign as the argument.</ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic.
- *
- * @param a the value whose arc sine is to be returned.
- * @return the arc sine of the argument.
- */
- public static double asin(double a) {
- return StrictMath.asin(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the arc cosine of an angle, in the range of 0.0 through
- * <i>pi</i>. Special case:
- * <ul><li>If the argument is NaN or its absolute value is greater
- * than 1, then the result is NaN.</ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic.
- *
- * @param a the value whose arc cosine is to be returned.
- * @return the arc cosine of the argument.
- */
- public static double acos(double a) {
- return StrictMath.acos(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the arc tangent of an angle, in the range of -<i>pi</i>/2
- * through <i>pi</i>/2. Special cases:
- * <ul><li>If the argument is NaN, then the result is NaN.
- * <li>If the argument is zero, then the result is a zero with the
- * same sign as the argument.</ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic.
- *
- * @param a the value whose arc tangent is to be returned.
- * @return the arc tangent of the argument.
- */
- public static double atan(double a) {
- return StrictMath.atan(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Converts an angle measured in degrees to an approximately
- * equivalent angle measured in radians. The conversion from
- * degrees to radians is generally inexact.
- *
- * @param angdeg an angle, in degrees
- * @return the measurement of the angle <code>angdeg</code>
- * in radians.
- * @since 1.2
- */
- public static double toRadians(double angdeg) {
- return angdeg / 180.0 * PI;
- }
-
- /**
- * Converts an angle measured in radians to an approximately
- * equivalent angle measured in degrees. The conversion from
- * radians to degrees is generally inexact; users should
- * <i>not</i> expect <code>cos(toRadians(90.0))</code> to exactly
- * equal <code>0.0</code>.
- *
- * @param angrad an angle, in radians
- * @return the measurement of the angle <code>angrad</code>
- * in degrees.
- * @since 1.2
- */
- public static double toDegrees(double angrad) {
- return angrad * 180.0 / PI;
- }
-
- /**
- * Returns Euler''s number <i>e</i> raised to the power of a
- * <code>double</code> value. Special cases:
- * <ul><li>If the argument is NaN, the result is NaN.
- * <li>If the argument is positive infinity, then the result is
- * positive infinity.
- * <li>If the argument is negative infinity, then the result is
- * positive zero.</ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic.
- *
- * @param a the exponent to raise <i>e</i> to.
- * @return the value <i>e</i><sup><code>a</code></sup>,
- * where <i>e</i> is the base of the natural logarithms.
- */
- public static double exp(double a) {
- return StrictMath.exp(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the natural logarithm (base <i>e</i>) of a <code>double</code>
- * value. Special cases:
- * <ul><li>If the argument is NaN or less than zero, then the result
- * is NaN.
- * <li>If the argument is positive infinity, then the result is
- * positive infinity.
- * <li>If the argument is positive zero or negative zero, then the
- * result is negative infinity.</ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic.
- *
- * @param a a value
- * @return the value ln <code>a</code>, the natural logarithm of
- * <code>a</code>.
- */
- public static double log(double a) {
- return StrictMath.log(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the base 10 logarithm of a <code>double</code> value.
- * Special cases:
- *
- * <ul><li>If the argument is NaN or less than zero, then the result
- * is NaN.
- * <li>If the argument is positive infinity, then the result is
- * positive infinity.
- * <li>If the argument is positive zero or negative zero, then the
- * result is negative infinity.
- * <li> If the argument is equal to 10<sup><i>n</i></sup> for
- * integer <i>n</i>, then the result is <i>n</i>.
- * </ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic.
- *
- * @param a a value
- * @return the base 10 logarithm of <code>a</code>.
- * @since 1.5
- */
- public static double log10(double a) {
- return StrictMath.log10(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the correctly rounded positive square root of a
- * <code>double</code> value.
- * Special cases:
- * <ul><li>If the argument is NaN or less than zero, then the result
- * is NaN.
- * <li>If the argument is positive infinity, then the result is positive
- * infinity.
- * <li>If the argument is positive zero or negative zero, then the
- * result is the same as the argument.</ul>
- * Otherwise, the result is the <code>double</code> value closest to
- * the true mathematical square root of the argument value.
- *
- * @param a a value.
- * @return the positive square root of <code>a</code>.
- * If the argument is NaN or less than zero, the result is NaN.
- */
- public static double sqrt(double a) {
- return StrictMath.sqrt(a); // default impl. delegates to StrictMath
- // Note that hardware sqrt instructions
- // frequently can be directly used by JITs
- // and should be much faster than doing
- // Math.sqrt in software.
- }
-
-
- /**
- * Returns the cube root of a <code>double</code> value. For
- * positive finite <code>x</code>, <code>cbrt(-x) ==
- * -cbrt(x)</code>; that is, the cube root of a negative value is
- * the negative of the cube root of that value''s magnitude.
- *
- * Special cases:
- *
- * <ul>
- *
- * <li>If the argument is NaN, then the result is NaN.
- *
- * <li>If the argument is infinite, then the result is an infinity
- * with the same sign as the argument.
- *
- * <li>If the argument is zero, then the result is a zero with the
- * same sign as the argument.
- *
- * </ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- *
- * @param a a value.
- * @return the cube root of <code>a</code>.
- * @since 1.5
- */
- public static double cbrt(double a) {
- return StrictMath.cbrt(a);
- }
-
- /**
- * Computes the remainder operation on two arguments as prescribed
- * by the IEEE 754 standard.
- * The remainder value is mathematically equal to
- * <code>f1 - f2</code> × <i>n</i>,
- * where <i>n</i> is the mathematical integer closest to the exact
- * mathematical value of the quotient <code>f1/f2</code>, and if two
- * mathematical integers are equally close to <code>f1/f2</code>,
- * then <i>n</i> is the integer that is even. If the remainder is
- * zero, its sign is the same as the sign of the first argument.
- * Special cases:
- * <ul><li>If either argument is NaN, or the first argument is infinite,
- * or the second argument is positive zero or negative zero, then the
- * result is NaN.
- * <li>If the first argument is finite and the second argument is
- * infinite, then the result is the same as the first argument.</ul>
- *
- * @param f1 the dividend.
- * @param f2 the divisor.
- * @return the remainder when <code>f1</code> is divided by
- * <code>f2</code>.
- */
- public static double IEEEremainder(double f1, double f2) {
- return StrictMath.IEEEremainder(f1, f2); // delegate to StrictMath
- }
-
- /**
- * Returns the smallest (closest to negative infinity)
- * <code>double</code> value that is greater than or equal to the
- * argument and is equal to a mathematical integer. Special cases:
- * <ul><li>If the argument value is already equal to a
- * mathematical integer, then the result is the same as the
- * argument. <li>If the argument is NaN or an infinity or
- * positive zero or negative zero, then the result is the same as
- * the argument. <li>If the argument value is less than zero but
- * greater than -1.0, then the result is negative zero.</ul> Note
- * that the value of <code>Math.ceil(x)</code> is exactly the
- * value of <code>-Math.floor(-x)</code>.
- *
- *
- * @param a a value.
- * @return the smallest (closest to negative infinity)
- * floating-point value that is greater than or equal to
- * the argument and is equal to a mathematical integer.
- */
- public static double ceil(double a) {
- return StrictMath.ceil(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the largest (closest to positive infinity)
- * <code>double</code> value that is less than or equal to the
- * argument and is equal to a mathematical integer. Special cases:
- * <ul><li>If the argument value is already equal to a
- * mathematical integer, then the result is the same as the
- * argument. <li>If the argument is NaN or an infinity or
- * positive zero or negative zero, then the result is the same as
- * the argument.</ul>
- *
- * @param a a value.
- * @return the largest (closest to positive infinity)
- * floating-point value that less than or equal to the argument
- * and is equal to a mathematical integer.
- */
- public static double floor(double a) {
- return StrictMath.floor(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the <code>double</code> value that is closest in value
- * to the argument and is equal to a mathematical integer. If two
- * <code>double</code> values that are mathematical integers are
- * equally close, the result is the integer value that is
- * even. Special cases:
- * <ul><li>If the argument value is already equal to a mathematical
- * integer, then the result is the same as the argument.
- * <li>If the argument is NaN or an infinity or positive zero or negative
- * zero, then the result is the same as the argument.</ul>
- *
- * @param a a <code>double</code> value.
- * @return the closest floating-point value to <code>a</code> that is
- * equal to a mathematical integer.
- */
- public static double rint(double a) {
- return StrictMath.rint(a); // default impl. delegates to StrictMath
- }
-
- /**
- * Converts rectangular coordinates (<code>x</code>, <code>y</code>)
- * to polar (r, <i>theta</i>).
- * This method computes the phase <i>theta</i> by computing an arc tangent
- * of <code>y/x</code> in the range of -<i>pi</i> to <i>pi</i>. Special
- * cases:
- * <ul><li>If either argument is NaN, then the result is NaN.
- * <li>If the first argument is positive zero and the second argument
- * is positive, or the first argument is positive and finite and the
- * second argument is positive infinity, then the result is positive
- * zero.
- * <li>If the first argument is negative zero and the second argument
- * is positive, or the first argument is negative and finite and the
- * second argument is positive infinity, then the result is negative zero.
- * <li>If the first argument is positive zero and the second argument
- * is negative, or the first argument is positive and finite and the
- * second argument is negative infinity, then the result is the
- * <code>double</code> value closest to <i>pi</i>.
- * <li>If the first argument is negative zero and the second argument
- * is negative, or the first argument is negative and finite and the
- * second argument is negative infinity, then the result is the
- * <code>double</code> value closest to -<i>pi</i>.
- * <li>If the first argument is positive and the second argument is
- * positive zero or negative zero, or the first argument is positive
- * infinity and the second argument is finite, then the result is the
- * <code>double</code> value closest to <i>pi</i>/2.
- * <li>If the first argument is negative and the second argument is
- * positive zero or negative zero, or the first argument is negative
- * infinity and the second argument is finite, then the result is the
- * <code>double</code> value closest to -<i>pi</i>/2.
- * <li>If both arguments are positive infinity, then the result is the
- * <code>double</code> value closest to <i>pi</i>/4.
- * <li>If the first argument is positive infinity and the second argument
- * is negative infinity, then the result is the <code>double</code>
- * value closest to 3*<i>pi</i>/4.
- * <li>If the first argument is negative infinity and the second argument
- * is positive infinity, then the result is the <code>double</code> value
- * closest to -<i>pi</i>/4.
- * <li>If both arguments are negative infinity, then the result is the
- * <code>double</code> value closest to -3*<i>pi</i>/4.</ul>
- *
- * <p>The computed result must be within 2 ulps of the exact result.
- * Results must be semi-monotonic.
- *
- * @param y the ordinate coordinate
- * @param x the abscissa coordinate
- * @return the <i>theta</i> component of the point
- * (<i>r</i>, <i>theta</i>)
- * in polar coordinates that corresponds to the point
- * (<i>x</i>, <i>y</i>) in Cartesian coordinates.
- */
- public static double atan2(double y, double x) {
- return StrictMath.atan2(y, x); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the value of the first argument raised to the power of the
- * second argument. Special cases:
- *
- * <ul><li>If the second argument is positive or negative zero, then the
- * result is 1.0.
- * <li>If the second argument is 1.0, then the result is the same as the
- * first argument.
- * <li>If the second argument is NaN, then the result is NaN.
- * <li>If the first argument is NaN and the second argument is nonzero,
- * then the result is NaN.
- *
- * <li>If
- * <ul>
- * <li>the absolute value of the first argument is greater than 1
- * and the second argument is positive infinity, or
- * <li>the absolute value of the first argument is less than 1 and
- * the second argument is negative infinity,
- * </ul>
- * then the result is positive infinity.
- *
- * <li>If
- * <ul>
- * <li>the absolute value of the first argument is greater than 1 and
- * the second argument is negative infinity, or
- * <li>the absolute value of the
- * first argument is less than 1 and the second argument is positive
- * infinity,
- * </ul>
- * then the result is positive zero.
- *
- * <li>If the absolute value of the first argument equals 1 and the
- * second argument is infinite, then the result is NaN.
- *
- * <li>If
- * <ul>
- * <li>the first argument is positive zero and the second argument
- * is greater than zero, or
- * <li>the first argument is positive infinity and the second
- * argument is less than zero,
- * </ul>
- * then the result is positive zero.
- *
- * <li>If
- * <ul>
- * <li>the first argument is positive zero and the second argument
- * is less than zero, or
- * <li>the first argument is positive infinity and the second
- * argument is greater than zero,
- * </ul>
- * then the result is positive infinity.
- *
- * <li>If
- * <ul>
- * <li>the first argument is negative zero and the second argument
- * is greater than zero but not a finite odd integer, or
- * <li>the first argument is negative infinity and the second
- * argument is less than zero but not a finite odd integer,
- * </ul>
- * then the result is positive zero.
- *
- * <li>If
- * <ul>
- * <li>the first argument is negative zero and the second argument
- * is a positive finite odd integer, or
- * <li>the first argument is negative infinity and the second
- * argument is a negative finite odd integer,
- * </ul>
- * then the result is negative zero.
- *
- * <li>If
- * <ul>
- * <li>the first argument is negative zero and the second argument
- * is less than zero but not a finite odd integer, or
- * <li>the first argument is negative infinity and the second
- * argument is greater than zero but not a finite odd integer,
- * </ul>
- * then the result is positive infinity.
- *
- * <li>If
- * <ul>
- * <li>the first argument is negative zero and the second argument
- * is a negative finite odd integer, or
- * <li>the first argument is negative infinity and the second
- * argument is a positive finite odd integer,
- * </ul>
- * then the result is negative infinity.
- *
- * <li>If the first argument is finite and less than zero
- * <ul>
- * <li> if the second argument is a finite even integer, the
- * result is equal to the result of raising the absolute value of
- * the first argument to the power of the second argument
- *
- * <li>if the second argument is a finite odd integer, the result
- * is equal to the negative of the result of raising the absolute
- * value of the first argument to the power of the second
- * argument
- *
- * <li>if the second argument is finite and not an integer, then
- * the result is NaN.
- * </ul>
- *
- * <li>If both arguments are integers, then the result is exactly equal
- * to the mathematical result of raising the first argument to the power
- * of the second argument if that result can in fact be represented
- * exactly as a <code>double</code> value.</ul>
- *
- * <p>(In the foregoing descriptions, a floating-point value is
- * considered to be an integer if and only if it is finite and a
- * fixed point of the method {@link #ceil <tt>ceil</tt>} or,
- * equivalently, a fixed point of the method {@link #floor
- * <tt>floor</tt>}. A value is a fixed point of a one-argument
- * method if and only if the result of applying the method to the
- * value is equal to the value.)
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic.
- *
- * @param a the base.
- * @param b the exponent.
- * @return the value <code>a<sup>b</sup></code>.
- */
- public static double pow(double a, double b) {
- return StrictMath.pow(a, b); // default impl. delegates to StrictMath
- }
-
- /**
- * Returns the closest <code>int</code> to the argument. The
- * result is rounded to an integer by adding 1/2, taking the
- * floor of the result, and casting the result to type <code>int</code>.
- * In other words, the result is equal to the value of the expression:
- * <p><pre>(int)Math.floor(a + 0.5f)</pre>
- * <p>
- * Special cases:
- * <ul><li>If the argument is NaN, the result is 0.
- * <li>If the argument is negative infinity or any value less than or
- * equal to the value of <code>Integer.MIN_VALUE</code>, the result is
- * equal to the value of <code>Integer.MIN_VALUE</code>.
- * <li>If the argument is positive infinity or any value greater than or
- * equal to the value of <code>Integer.MAX_VALUE</code>, the result is
- * equal to the value of <code>Integer.MAX_VALUE</code>.</ul>
- *
- * @param a a floating-point value to be rounded to an integer.
- * @return the value of the argument rounded to the nearest
- * <code>int</code> value.
- * @see java.lang.Integer#MAX_VALUE
- * @see java.lang.Integer#MIN_VALUE
- */
- public static int round(float a) {
- return (int)floor(a + 0.5f);
- }
-
- /**
- * Returns the closest <code>long</code> to the argument. The result
- * is rounded to an integer by adding 1/2, taking the floor of the
- * result, and casting the result to type <code>long</code>. In other
- * words, the result is equal to the value of the expression:
- * <p><pre>(long)Math.floor(a + 0.5d)</pre>
- * <p>
- * Special cases:
- * <ul><li>If the argument is NaN, the result is 0.
- * <li>If the argument is negative infinity or any value less than or
- * equal to the value of <code>Long.MIN_VALUE</code>, the result is
- * equal to the value of <code>Long.MIN_VALUE</code>.
- * <li>If the argument is positive infinity or any value greater than or
- * equal to the value of <code>Long.MAX_VALUE</code>, the result is
- * equal to the value of <code>Long.MAX_VALUE</code>.</ul>
- *
- * @param a a floating-point value to be rounded to a
- * <code>long</code>.
- * @return the value of the argument rounded to the nearest
- * <code>long</code> value.
- * @see java.lang.Long#MAX_VALUE
- * @see java.lang.Long#MIN_VALUE
- */
- public static long round(double a) {
- return (long)floor(a + 0.5d);
- }
-
- private static Random randomNumberGenerator;
-
- private static synchronized void initRNG() {
- if (randomNumberGenerator == null)
- randomNumberGenerator = new Random();
- }
-
- /**
- * Returns a <code>double</code> value with a positive sign, greater
- * than or equal to <code>0.0</code> and less than <code>1.0</code>.
- * Returned values are chosen pseudorandomly with (approximately)
- * uniform distribution from that range.
- *
- * <p>When this method is first called, it creates a single new
- * pseudorandom-number generator, exactly as if by the expression
- * <blockquote><pre>new java.util.Random</pre></blockquote> This
- * new pseudorandom-number generator is used thereafter for all
- * calls to this method and is used nowhere else.
- *
- * <p>This method is properly synchronized to allow correct use by
- * more than one thread. However, if many threads need to generate
- * pseudorandom numbers at a great rate, it may reduce contention
- * for each thread to have its own pseudorandom-number generator.
- *
- * @return a pseudorandom <code>double</code> greater than or equal
- * to <code>0.0</code> and less than <code>1.0</code>.
- * @see java.util.Random#nextDouble()
- */
- public static double random() {
- if (randomNumberGenerator == null) initRNG();
- return randomNumberGenerator.nextDouble();
- }
-
- /**
- * Returns the absolute value of an <code>int</code> value.
- * If the argument is not negative, the argument is returned.
- * If the argument is negative, the negation of the argument is returned.
- *
- * <p>Note that if the argument is equal to the value of
- * <code>Integer.MIN_VALUE</code>, the most negative representable
- * <code>int</code> value, the result is that same value, which is
- * negative.
- *
- * @param a the argument whose absolute value is to be determined
- * @return the absolute value of the argument.
- * @see java.lang.Integer#MIN_VALUE
- */
- public static int abs(int a) {
- return (a < 0) ? -a : a;
- }
-
- /**
- * Returns the absolute value of a <code>long</code> value.
- * If the argument is not negative, the argument is returned.
- * If the argument is negative, the negation of the argument is returned.
- *
- * <p>Note that if the argument is equal to the value of
- * <code>Long.MIN_VALUE</code>, the most negative representable
- * <code>long</code> value, the result is that same value, which
- * is negative.
- *
- * @param a the argument whose absolute value is to be determined
- * @return the absolute value of the argument.
- * @see java.lang.Long#MIN_VALUE
- */
- public static long abs(long a) {
- return (a < 0) ? -a : a;
- }
-
- /**
- * Returns the absolute value of a <code>float</code> value.
- * If the argument is not negative, the argument is returned.
- * If the argument is negative, the negation of the argument is returned.
- * Special cases:
- * <ul><li>If the argument is positive zero or negative zero, the
- * result is positive zero.
- * <li>If the argument is infinite, the result is positive infinity.
- * <li>If the argument is NaN, the result is NaN.</ul>
- * In other words, the result is the same as the value of the expression:
- * <p><pre>Float.intBitsToFloat(0x7fffffff & Float.floatToIntBits(a))</pre>
- *
- * @param a the argument whose absolute value is to be determined
- * @return the absolute value of the argument.
- */
- public static float abs(float a) {
- return (a <= 0.0F) ? 0.0F - a : a;
- }
-
- /**
- * Returns the absolute value of a <code>double</code> value.
- * If the argument is not negative, the argument is returned.
- * If the argument is negative, the negation of the argument is returned.
- * Special cases:
- * <ul><li>If the argument is positive zero or negative zero, the result
- * is positive zero.
- * <li>If the argument is infinite, the result is positive infinity.
- * <li>If the argument is NaN, the result is NaN.</ul>
- * In other words, the result is the same as the value of the expression:
- * <p><code>Double.longBitsToDouble((Double.doubleToLongBits(a)<<1)>>>1)</code>
- *
- * @param a the argument whose absolute value is to be determined
- * @return the absolute value of the argument.
- */
- public static double abs(double a) {
- return (a <= 0.0D) ? 0.0D - a : a;
- }
-
- /**
- * Returns the greater of two <code>int</code> values. That is, the
- * result is the argument closer to the value of
- * <code>Integer.MAX_VALUE</code>. If the arguments have the same value,
- * the result is that same value.
- *
- * @param a an argument.
- * @param b another argument.
- * @return the larger of <code>a</code> and <code>b</code>.
- * @see java.lang.Long#MAX_VALUE
- */
- public static int max(int a, int b) {
- return (a >= b) ? a : b;
- }
-
- /**
- * Returns the greater of two <code>long</code> values. That is, the
- * result is the argument closer to the value of
- * <code>Long.MAX_VALUE</code>. If the arguments have the same value,
- * the result is that same value.
- *
- * @param a an argument.
- * @param b another argument.
- * @return the larger of <code>a</code> and <code>b</code>.
- * @see java.lang.Long#MAX_VALUE
- */
- public static long max(long a, long b) {
- return (a >= b) ? a : b;
- }
-
- private static long negativeZeroFloatBits = Float.floatToIntBits(-0.0f);
- private static long negativeZeroDoubleBits = Double.doubleToLongBits(-0.0d);
-
- /**
- * Returns the greater of two <code>float</code> values. That is,
- * the result is the argument closer to positive infinity. If the
- * arguments have the same value, the result is that same
- * value. If either value is NaN, then the result is NaN. Unlike
- * the numerical comparison operators, this method considers
- * negative zero to be strictly smaller than positive zero. If one
- * argument is positive zero and the other negative zero, the
- * result is positive zero.
- *
- * @param a an argument.
- * @param b another argument.
- * @return the larger of <code>a</code> and <code>b</code>.
- */
- public static float max(float a, float b) {
- if (a !!= a) return a; // a is NaN
- if ((a == 0.0f) && (b == 0.0f)
- && (Float.floatToIntBits(a) == negativeZeroFloatBits)) {
- return b;
- }
- return (a >= b) ? a : b;
- }
-
- /**
- * Returns the greater of two <code>double</code> values. That
- * is, the result is the argument closer to positive infinity. If
- * the arguments have the same value, the result is that same
- * value. If either value is NaN, then the result is NaN. Unlike
- * the numerical comparison operators, this method considers
- * negative zero to be strictly smaller than positive zero. If one
- * argument is positive zero and the other negative zero, the
- * result is positive zero.
- *
- * @param a an argument.
- * @param b another argument.
- * @return the larger of <code>a</code> and <code>b</code>.
- */
- public static double max(double a, double b) {
- if (a !!= a) return a; // a is NaN
- if ((a == 0.0d) && (b == 0.0d)
- && (Double.doubleToLongBits(a) == negativeZeroDoubleBits)) {
- return b;
- }
- return (a >= b) ? a : b;
- }
-
- /**
- * Returns the smaller of two <code>int</code> values. That is,
- * the result the argument closer to the value of
- * <code>Integer.MIN_VALUE</code>. If the arguments have the same
- * value, the result is that same value.
- *
- * @param a an argument.
- * @param b another argument.
- * @return the smaller of <code>a</code> and <code>b</code>.
- * @see java.lang.Long#MIN_VALUE
- */
- public static int min(int a, int b) {
- return (a <= b) ? a : b;
- }
-
- /**
- * Returns the smaller of two <code>long</code> values. That is,
- * the result is the argument closer to the value of
- * <code>Long.MIN_VALUE</code>. If the arguments have the same
- * value, the result is that same value.
- *
- * @param a an argument.
- * @param b another argument.
- * @return the smaller of <code>a</code> and <code>b</code>.
- * @see java.lang.Long#MIN_VALUE
- */
- public static long min(long a, long b) {
- return (a <= b) ? a : b;
- }
-
- /**
- * Returns the smaller of two <code>float</code> values. That is,
- * the result is the value closer to negative infinity. If the
- * arguments have the same value, the result is that same
- * value. If either value is NaN, then the result is NaN. Unlike
- * the numerical comparison operators, this method considers
- * negative zero to be strictly smaller than positive zero. If
- * one argument is positive zero and the other is negative zero,
- * the result is negative zero.
- *
- * @param a an argument.
- * @param b another argument.
- * @return the smaller of <code>a</code> and <code>b.</code>
- */
- public static float min(float a, float b) {
- if (a !!= a) return a; // a is NaN
- if ((a == 0.0f) && (b == 0.0f)
- && (Float.floatToIntBits(b) == negativeZeroFloatBits)) {
- return b;
- }
- return (a <= b) ? a : b;
- }
-
- /**
- * Returns the smaller of two <code>double</code> values. That
- * is, the result is the value closer to negative infinity. If the
- * arguments have the same value, the result is that same
- * value. If either value is NaN, then the result is NaN. Unlike
- * the numerical comparison operators, this method considers
- * negative zero to be strictly smaller than positive zero. If one
- * argument is positive zero and the other is negative zero, the
- * result is negative zero.
- *
- * @param a an argument.
- * @param b another argument.
- * @return the smaller of <code>a</code> and <code>b</code>.
- */
- public static double min(double a, double b) {
- if (a !!= a) return a; // a is NaN
- if ((a == 0.0d) && (b == 0.0d)
- && (Double.doubleToLongBits(b) == negativeZeroDoubleBits)) {
- return b;
- }
- return (a <= b) ? a : b;
- }
-
- /**
- * Returns the size of an ulp of the argument. An ulp of a
- * <code>double</code> value is the positive distance between this
- * floating-point value and the <code>double</code> value next
- * larger in magnitude. Note that for non-NaN <i>x</i>,
- * <code>ulp(-<i>x</i>) == ulp(<i>x</i>)</code>.
- *
- * <p>Special Cases:
- * <ul>
- * <li> If the argument is NaN, then the result is NaN.
- * <li> If the argument is positive or negative infinity, then the
- * result is positive infinity.
- * <li> If the argument is positive or negative zero, then the result is
- * <code>Double.MIN_VALUE</code>.
- * <li> If the argument is ±<code>Double.MAX_VALUE</code>, then
- * the result is equal to 2<sup>971</sup>.
- * </ul>
- *
- * @param d the floating-point value whose ulp is to be returned
- * @return the size of an ulp of the argument
- * @author Joseph D. Darcy
- * @since 1.5
- */
- public static double ulp(double d) {
- return sun.misc.FpUtils.ulp(d);
- }
-
- /**
- * Returns the size of an ulp of the argument. An ulp of a
- * <code>float</code> value is the positive distance between this
- * floating-point value and the <code>float</code> value next
- * larger in magnitude. Note that for non-NaN <i>x</i>,
- * <code>ulp(-<i>x</i>) == ulp(<i>x</i>)</code>.
- *
- * <p>Special Cases:
- * <ul>
- * <li> If the argument is NaN, then the result is NaN.
- * <li> If the argument is positive or negative infinity, then the
- * result is positive infinity.
- * <li> If the argument is positive or negative zero, then the result is
- * <code>Float.MIN_VALUE</code>.
- * <li> If the argument is ±<code>Float.MAX_VALUE</code>, then
- * the result is equal to 2<sup>104</sup>.
- * </ul>
- *
- * @param f the floating-point value whose ulp is to be returned
- * @return the size of an ulp of the argument
- * @author Joseph D. Darcy
- * @since 1.5
- */
- public static float ulp(float f) {
- return sun.misc.FpUtils.ulp(f);
- }
-
- /**
- * Returns the signum function of the argument; zero if the argument
- * is zero, 1.0 if the argument is greater than zero, -1.0 if the
- * argument is less than zero.
- *
- * <p>Special Cases:
- * <ul>
- * <li> If the argument is NaN, then the result is NaN.
- * <li> If the argument is positive zero or negative zero, then the
- * result is the same as the argument.
- * </ul>
- *
- * @param d the floating-point value whose signum is to be returned
- * @return the signum function of the argument
- * @author Joseph D. Darcy
- * @since 1.5
- */
- public static double signum(double d) {
- return sun.misc.FpUtils.signum(d);
- }
-
- /**
- * Returns the signum function of the argument; zero if the argument
- * is zero, 1.0f if the argument is greater than zero, -1.0f if the
- * argument is less than zero.
- *
- * <p>Special Cases:
- * <ul>
- * <li> If the argument is NaN, then the result is NaN.
- * <li> If the argument is positive zero or negative zero, then the
- * result is the same as the argument.
- * </ul>
- *
- * @param f the floating-point value whose signum is to be returned
- * @return the signum function of the argument
- * @author Joseph D. Darcy
- * @since 1.5
- */
- public static float signum(float f) {
- return sun.misc.FpUtils.signum(f);
- }
-
- /**
- * Returns the hyperbolic sine of a <code>double</code> value.
- * The hyperbolic sine of <i>x</i> is defined to be
- * (<i>e<sup>x</sup> - e<sup>-x</sup></i>)/2
- * where <i>e</i> is {@linkplain Math#E Euler''s number}.
- *
- * <p>Special cases:
- * <ul>
- *
- * <li>If the argument is NaN, then the result is NaN.
- *
- * <li>If the argument is infinite, then the result is an infinity
- * with the same sign as the argument.
- *
- * <li>If the argument is zero, then the result is a zero with the
- * same sign as the argument.
- *
- * </ul>
- *
- * <p>The computed result must be within 2.5 ulps of the exact result.
- *
- * @param x The number whose hyperbolic sine is to be returned.
- * @return The hyperbolic sine of <code>x</code>.
- * @since 1.5
- */
- public static double sinh(double x) {
- return StrictMath.sinh(x);
- }
-
- /**
- * Returns the hyperbolic cosine of a <code>double</code> value.
- * The hyperbolic cosine of <i>x</i> is defined to be
- * (<i>e<sup>x</sup> + e<sup>-x</sup></i>)/2
- * where <i>e</i> is {@linkplain Math#E Euler''s number}.
- *
- * <p>Special cases:
- * <ul>
- *
- * <li>If the argument is NaN, then the result is NaN.
- *
- * <li>If the argument is infinite, then the result is positive
- * infinity.
- *
- * <li>If the argument is zero, then the result is <code>1.0</code>.
- *
- * </ul>
- *
- * <p>The computed result must be within 2.5 ulps of the exact result.
- *
- * @param x The number whose hyperbolic cosine is to be returned.
- * @return The hyperbolic cosine of <code>x</code>.
- * @since 1.5
- */
- public static double cosh(double x) {
- return StrictMath.cosh(x);
- }
-
- /**
- * Returns the hyperbolic tangent of a <code>double</code> value.
- * The hyperbolic tangent of <i>x</i> is defined to be
- * (<i>e<sup>x</sup> - e<sup>-x</sup></i>)/(<i>e<sup>x</sup> + e<sup>-x</sup></i>),
- * in other words, {@linkplain Math#sinh
- * sinh(<i>x</i>)}/{@linkplain Math#cosh cosh(<i>x</i>)}. Note
- * that the absolute value of the exact tanh is always less than
- * 1.
- *
- * <p>Special cases:
- * <ul>
- *
- * <li>If the argument is NaN, then the result is NaN.
- *
- * <li>If the argument is zero, then the result is a zero with the
- * same sign as the argument.
- *
- * <li>If the argument is positive infinity, then the result is
- * <code>+1.0</code>.
- *
- * <li>If the argument is negative infinity, then the result is
- * <code>-1.0</code>.
- *
- * </ul>
- *
- * <p>The computed result must be within 2.5 ulps of the exact result.
- * The result of <code>tanh</code> for any finite input must have
- * an absolute value less than or equal to 1. Note that once the
- * exact result of tanh is within 1/2 of an ulp of the limit value
- * of ±1, correctly signed ±<code>1.0</code> should
- * be returned.
- *
- * @param x The number whose hyperbolic tangent is to be returned.
- * @return The hyperbolic tangent of <code>x</code>.
- * @since 1.5
- */
- public static double tanh(double x) {
- return StrictMath.tanh(x);
- }
-
- /**
- * Returns sqrt(<i>x</i><sup>2</sup> +<i>y</i><sup>2</sup>)
- * without intermediate overflow or underflow.
- *
- * <p>Special cases:
- * <ul>
- *
- * <li> If either argument is infinite, then the result
- * is positive infinity.
- *
- * <li> If either argument is NaN and neither argument is infinite,
- * then the result is NaN.
- *
- * </ul>
- *
- * <p>The computed result must be within 1 ulp of the exact
- * result. If one parameter is held constant, the results must be
- * semi-monotonic in the other parameter.
- *
- * @param x a value
- * @param y a value
- * @return sqrt(<i>x</i><sup>2</sup> +<i>y</i><sup>2</sup>)
- * without intermediate overflow or underflow
- * @since 1.5
- */
- public static double hypot(double x, double y) {
- return StrictMath.hypot(x, y);
- }
-
- /**
- * Returns <i>e</i><sup>x</sup> -1. Note that for values of
- * <i>x</i> near 0, the exact sum of
- * <code>expm1(x)</code> + 1 is much closer to the true
- * result of <i>e</i><sup>x</sup> than <code>exp(x)</code>.
- *
- * <p>Special cases:
- * <ul>
- * <li>If the argument is NaN, the result is NaN.
- *
- * <li>If the argument is positive infinity, then the result is
- * positive infinity.
- *
- * <li>If the argument is negative infinity, then the result is
- * -1.0.
- *
- * <li>If the argument is zero, then the result is a zero with the
- * same sign as the argument.
- *
- * </ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic. The result of
- * <code>expm1</code> for any finite input must be greater than or
- * equal to <code>-1.0</code>. Note that once the exact result of
- * <i>e</i><sup><code>x</code></sup> - 1 is within 1/2
- * ulp of the limit value -1, <code>-1.0</code> should be
- * returned.
- *
- * @param x the exponent to raise <i>e</i> to in the computation of
- * <i>e</i><sup><code>x</code></sup> -1.
- * @return the value <i>e</i><sup><code>x</code></sup> - 1.
- */
- public static double expm1(double x) {
- return StrictMath.expm1(x);
- }
-
- /**
- * Returns the natural logarithm of the sum of the argument and 1.
- * Note that for small values <code>x</code>, the result of
- * <code>log1p(x)</code> is much closer to the true result of ln(1
- * + <code>x</code>) than the floating-point evaluation of
- * <code>log(1.0+x)</code>.
- *
- * <p>Special cases:
- *
- * <ul>
- *
- * <li>If the argument is NaN or less than -1, then the result is
- * NaN.
- *
- * <li>If the argument is positive infinity, then the result is
- * positive infinity.
- *
- * <li>If the argument is negative one, then the result is
- * negative infinity.
- *
- * <li>If the argument is zero, then the result is a zero with the
- * same sign as the argument.
- *
- * </ul>
- *
- * <p>The computed result must be within 1 ulp of the exact result.
- * Results must be semi-monotonic.
- *
- * @param x a value
- * @return the value ln(<code>x</code> + 1), the natural
- * log of <code>x</code> + 1
- */
- public static double log1p(double x) {
- return StrictMath.log1p(x);
- }
-}
-'
-!
-
-javaSourcesBig
- ^ self workingJavaInDirectory: '../java-src/java/util'
-!
-
-petitParserPackage
-^ '
-Object subclass: #PPCharSetPredicate
- instanceVariableNames: ''block classification''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Tools''!!
-!!PPCharSetPredicate commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPCharSetPredicate methodsFor: ''initialization'' stamp: ''lr 8/30/2010 12:19''!!
-initializeOn: aBlock
- block := aBlock.
- classification := Array new: 255.
- 1 to: classification size do: [ :index |
- classification at: index put: (block
- value: (Character value: index)) ]!! !!
-
-
-!!PPCharSetPredicate methodsFor: ''evaluating'' stamp: ''lr 8/30/2010 12:19''!!
-value: aCharacter
- | index |
- index := aCharacter asInteger.
- index == 0
- ifTrue: [ ^ block value: aCharacter ].
- index > 255
- ifTrue: [ ^ block value: aCharacter ].
- ^ classification at: index!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPCharSetPredicate class
- instanceVariableNames: ''''!!
-!!PPCharSetPredicate class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPCharSetPredicate class methodsFor: ''instance creation'' stamp: ''lr 8/25/2010 11:05''!!
-on: aBlock
- ^ self basicNew initializeOn: aBlock!! !!
-
-
-PPDelegateParser subclass: #PPExpressionParser
- instanceVariableNames: ''operators''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Tools''!!
-!!PPExpressionParser commentStamp: ''<historical>'' prior: 0!!
-A PPExpressionParser is a parser to conveniently define an expression grammar with prefix, postfix, and left- and right-associative infix operators.
-
-The following code initializes a parser for arithmetic expressions. First we instantiate an expression parser, a simple parser for expressions in parenthesis and a simple parser for integer numbers.
-
- expression := PPExpressionParser new.
- parens := $( asParser token trim , expression , $) asParser token trim
- ==> [ :nodes | nodes second ].
- integer := #digit asParser plus token trim
- ==> [ :token | token value asInteger ].
-
-Then we define on what term the expression grammar is built on:
-
- expression term: parens / integer.
-
-Finally we define the operator-groups in descending precedence. Note, that the action blocks receive both, the terms and the parsed operator in the order they appear in the parsed input.
-
- expression
- group: [ :g |
- g prefix: $- asParser token trim do: [ :op :a | a negated ] ];
- group: [ :g |
- g postfix: ''++'' asParser token trim do: [ :a :op | a + 1 ].
- g postfix: ''--'' asParser token trim do: [ :a :op | a - 1 ] ];
- group: [ :g |
- g right: $^ asParser token trim do: [ :a :op :b | a raisedTo: b ] ];
- group: [ :g |
- g left: $* asParser token trim do: [ :a :op :b | a * b ].
- g left: $/ asParser token trim do: [ :a :op :b | a / b ] ];
- group: [ :g |
- g left: $+ asParser token trim do: [ :a :op :b | a + b ].
- g left: $- asParser token trim do: [ :a :op :b | a - b ] ].
-
-After evaluating the above code the ''expression'' is an efficient parser that evaluates examples like:
-
- expression parse: ''-8++''.
- expression parse: ''1+2*3''.
- expression parse: ''1*2+3''.
- expression parse: ''(1+2)*3''.
- expression parse: ''8/4/2''.
- expression parse: ''8/(4/2)''.
- expression parse: ''2^2^3''.
- expression parse: ''(2^2)^3''.
-
-Instance Variables:
- operators <Dictionary> The operators defined in the current group.!!
-
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
-build: aParser right: aChoiceParser
- ^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
-build: aParser left: aChoiceParser
- ^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:38''!!
-build: aParser postfix: aChoiceParser
- ^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 21:15''!!
-buildOn: aParser
- ^ self buildSelectors inject: aParser into: [ :term :selector |
- | list |
- list := operators at: selector ifAbsent: [ #() ].
- list isEmpty
- ifTrue: [ term ]
- ifFalse: [
- self
- perform: selector with: term
- with: (list size = 1
- ifTrue: [ list first first ==> [ :operator | Array with: list first second with: operator ] ]
- ifFalse: [
- list
- inject: PPChoiceParser new
- into: [ :choice :each | choice / (each first ==> [ :operator | Array with: each second with: operator ]) ] ]) ] ]!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:39''!!
-build: aParser prefix: aChoiceParser
- ^ aChoiceParser star , aParser map: [ :ops :term | ops reversed inject: term into: [ :result :operator | operator first value: operator second value: result ] ]!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
-buildSelectors
- ^ #(build:prefix: build:postfix: build:right: build:left:)!! !!
-
-!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 2/7/2010 23:23''!!
-operator: aSymbol parser: aParser do: aBlock
- parser isNil
- ifTrue: [ ^ self error: ''You did not specify a term when creating the receiver.'' ].
- operators isNil
- ifTrue: [ ^ self error: ''Use #group: to define precedence groups in descending order.'' ].
- (operators at: aSymbol ifAbsentPut: [ OrderedCollection new ])
- addLast: (Array with: aParser asParser with: aBlock)!! !!
-
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 21:26''!!
-term: aParser
- "Defines the initial term aParser of the receiver."
-
- parser isNil
- ifTrue: [ parser := aParser ]
- ifFalse: [ self error: ''Unable to redefine the term.'' ]!! !!
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
-postfix: aParser do: aTwoArgumentBlock
- "Define a postfix operator aParser. Evaluate aTwoArgumentBlock with the term and the operator."
-
- self operator: #build:postfix: parser: aParser do: aTwoArgumentBlock!! !!
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
-left: aParser do: aThreeArgumentBlock
- "Define an operator aParser that is left-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."
-
- self operator: #build:left: parser: aParser do: aThreeArgumentBlock!! !!
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
-prefix: aParser do: aTwoArgumentBlock
- "Define a prefix operator aParser. Evaluate aTwoArgumentBlock with the operator and the term."
-
- self operator: #build:prefix: parser: aParser do: aTwoArgumentBlock!! !!
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
-right: aParser do: aThreeArgumentBlock
- "Define an operator aParser that is right-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."
-
- self operator: #build:right: parser: aParser do: aThreeArgumentBlock!! !!
-
-!!PPExpressionParser methodsFor: ''specifying'' stamp: ''lr 2/7/2010 23:20''!!
-group: aOneArgumentBlock
- "Defines a priority group by evaluating aOneArgumentBlock."
-
- operators := Dictionary new.
- parser := [
- aOneArgumentBlock value: self.
- self buildOn: parser ]
- ensure: [ operators := nil ]!! !!
-
-
-PPDelegateParser subclass: #PPCompositeParser
- instanceVariableNames: ''dependencies''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Tools''!!
-!!PPCompositeParser commentStamp: ''lr 12/4/2009 18:38'' prior: 0!!
-A PPCompositeParser is composed parser built from various primitive parsers.
-
-Every production in the receiver is specified as a method that returns its parser. Note that every production requires an instance variable of the same name, otherwise the production is not cached and cannot be used in recursive grammars. Productions should refer to each other by reading the respective inst-var. Note: these inst-vars are typically not written, as the assignment happens in the initialize method using reflection.
-
-The start production is defined in the method start. It is aliased to the inst-var parser defined in the superclass of PPCompositeParser.!!
-
-
-!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 6/4/2010 13:37''!!
-productionAt: aSymbol ifAbsent: aBlock
- "Answer the production named aSymbol, if there is no such production answer the result of evaluating aBlock."
-
- (self class ignoredNames includes: aSymbol asString)
- ifTrue: [ ^ aBlock value ].
- (self class startSymbol = aSymbol)
- ifTrue: [ ^ parser ].
- ^ self instVarAt: (self class allInstVarNames
- indexOf: aSymbol asString
- ifAbsent: [ ^ aBlock value ])!! !!
-
-!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 5/8/2011 15:45''!!
-productionNames
- "Answer a dictionary of slot indexes and production names."
-
- | productionNames ignoredNames |
- productionNames := Dictionary new.
- ignoredNames := self class ignoredNames
- collect: [ :each | each asSymbol ].
- self class allInstVarNames keysAndValuesDo: [ :key :value |
- (ignoredNames includes: value asSymbol)
- ifFalse: [ productionNames at: key put: value asSymbol ] ].
- ^ productionNames!! !!
-
-!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 3/16/2013 21:41''!!
-dependencyAt: aClass
- "Answer the dependent parser aClass. Throws an error if this parser class is not declared in the method #dependencies on the class-side of the receiver."
-
- ^ dependencies at: aClass ifAbsent: [ self error: ''Undeclared dependency in '' , self class name , '' to '' , aClass name ]!! !!
-
-!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 12/4/2009 18:39''!!
-productionAt: aSymbol
- "Answer the production named aSymbol."
-
- ^ self productionAt: aSymbol ifAbsent: [ nil ]!! !!
-
-
-!!PPCompositeParser methodsFor: ''initialization'' stamp: ''lr 3/16/2013 17:15''!!
-initializeStartingAt: aSymbol dependencies: aDictionary
- self initialize.
- parser := PPDelegateParser named: aSymbol.
- self productionNames keysAndValuesDo: [ :key :value |
- self instVarAt: key put: (PPDelegateParser named: value) ].
- dependencies := aDictionary!! !!
-
-
-!!PPCompositeParser methodsFor: ''accessing'' stamp: ''lr 5/16/2008 17:32''!!
-start
- "Answer the production to start this parser with."
-
- self subclassResponsibility!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPCompositeParser class
- instanceVariableNames: ''''!!
-!!PPCompositeParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 1/29/2010 11:35''!!
-ignoredNames
- "Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser."
-
- ^ PPCompositeParser allInstVarNames!! !!
-
-!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 12/7/2009 08:20''!!
-startSymbol
- "Answer the method that represents the default start symbol."
-
- ^ #start!! !!
-
-!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 3/16/2013 21:42''!!
-dependencies
- "Answer a collection of PPCompositeParser classes that this parser directly dependends on. Override this method in subclasses to declare dependent parsers. The default implementation does not depend on other PPCompositeParser."
-
- ^ #()!! !!
-
-
-!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!!
-debug: anObject startingAt: aSymbol onError: aBlock
- ^ (self newStartingAt: aSymbol) debug: anObject onError: aBlock!! !!
-
-!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!!
-debug: anObject startingAt: aSymbol
- ^ (self newStartingAt: aSymbol) debug: anObject!! !!
-
-!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!!
-debug: anObject onError: aBlock
- ^ self debug: anObject startingAt: self startSymbol onError: aBlock!! !!
-
-!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!!
-debug: anObject
- ^ self debug: anObject startingAt: self startSymbol!! !!
-
-
-!!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 3/16/2013 21:21''!!
-newStartingAt: aSymbol
- "Answer a new parser starting at aSymbol. The code makes sure to resolve all dependent parsers correctly."
-
- | parsers remaining |
- parsers := IdentityDictionary new.
- remaining := OrderedCollection with: self.
- [ remaining isEmpty ] whileFalse: [
- | dependency |
- dependency := remaining removeLast.
- (parsers includesKey: dependency) ifFalse: [
- parsers at: dependency put: dependency basicNew.
- remaining addAll: dependency dependencies ] ].
- parsers keysAndValuesDo: [ :class :parser |
- | dependencies |
- dependencies := IdentityDictionary new.
- class dependencies
- do: [ :dependency | dependencies at: dependency put: (parsers at: dependency) ].
- parser
- initializeStartingAt: (class == self
- ifTrue: [ aSymbol ]
- ifFalse: [ class startSymbol ])
- dependencies: dependencies ].
- parsers keysAndValuesDo: [ :class :parser |
- parser setParser: (parser perform: parser children first name).
- parser productionNames keysAndValuesDo: [ :key :value |
- (parser instVarAt: key) setParser: (parser perform: value) ] ].
- ^ parsers at: self!! !!
-
-!!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 12/7/2009 08:24''!!
-new
- "Answer a new parser starting at the default start symbol."
-
- ^ self newStartingAt: self startSymbol!! !!
-
-
-!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!!
-parse: anObject onError: aBlock
- ^ self parse: anObject startingAt: self startSymbol onError: aBlock!! !!
-
-!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!!
-parse: anObject startingAt: aSymbol onError: aBlock
- ^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock!! !!
-
-!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!!
-parse: anObject startingAt: aSymbol
- ^ (self newStartingAt: aSymbol) parse: anObject!! !!
-
-!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!!
-parse: anObject
- ^ self parse: anObject startingAt: self startSymbol!! !!
-
-
-PPParser subclass: #PPUnresolvedParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Tools''!!
-!!PPUnresolvedParser commentStamp: ''lr 11/28/2009 18:50'' prior: 0!!
-This is a temporary placeholder or forward reference to a parser that has not been defined yet. If everything goes well it will eventually be replaced with the real parser instance.!!
-
-
-!!PPUnresolvedParser methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:51''!!
-parseOn: aStream
- self error: self printString , '' need to be resolved before execution.''!! !!
-
-
-!!PPUnresolvedParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:15''!!
-displayColor
- ^ Color red!! !!
-
-
-!!PPUnresolvedParser methodsFor: ''testing'' stamp: ''lr 10/27/2008 11:29''!!
-isUnresolved
- ^ true!! !!
-Object subclass: #PPParser
- instanceVariableNames: ''properties''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPParser commentStamp: ''<historical>'' prior: 0!!
-An abstract parser for all parsers in PetitParser. Subclasses implement #parseOn: to perform the actual recursive-descent parsing. All parsers support a variety of methods to perform an actual parse, see the methods in the #parsing protocol. Parsers are combined with a series of operators that can be found in the #operations protocol.
-
-Instance Variables:
- properties <Dictionary> Stores additional state in the parser object.!!
-
-
-!!PPParser methodsFor: ''*petitjava-operations'' stamp: ''sback 9/2/2010 23:01''!!
-javaToken
- ^ PPJavaTokenParser on: self!! !!
-
-
-!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 12/18/2013 06:41''!!
-gtInspectorParserInspectorIn: composite
- <gtInspectorPresentationOrder: 30>
- composite custom: (
- PPVerticalParserInspector new
- title: ''Sampler'';
- startOn: self)!! !!
-
-!!PPParser methodsFor: ''*petitgui'' stamp: ''AlexandreBergel 12/18/2013 16:40''!!
-gtGraphViewIn: composite
- <gtInspectorPresentationOrder: 50>
-
- composite roassal
- title: ''Graph'';
- painting: [ :view |
- self visualizeStructureInGraphOn: view.
- ].!! !!
-
-!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!!
-gtNamedTreeViewIn: composite
- <gtInspectorPresentationOrder: 40>
-
- composite tree
- title: ''Named Tree'';
- children: [:n | n namedChildren ];
- format: [:n| n name ifNil: [ n asString ] ];
- shouldExpandToLevel: 3!! !!
-
-!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!!
-gtTreeViewIn: composite
- <gtInspectorPresentationOrder: 40>
-
- composite tree
- title: ''Tree'';
- children: [:n | n children ];
- format: [:n| n name ifNil: [ n asString ] ifNotNil: [n name] ];
- shouldExpandToLevel: 6!! !!
-
-
-!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 1/30/2013 19:35''!!
-morphicShapeDefault
- ^ self newRowMorph
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
- makeForwardArrow;
- yourself);
- addMorphBack: (self newRowMorph
- borderWidth: 1;
- layoutInset: 3;
- color: Color white;
- addMorphBack: (StringMorph new
- contents: self displayName;
- color: self displayColor;
- yourself);
- yourself);
- yourself!! !!
-
-!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 10:56''!!
-morphicProduction
- ^ self newRowMorph
- layoutInset: 4;
- addMorphBack: (self newRowMorph
- layoutInset: 4;
- addMorphBack: (StringMorph new
- contents: self displayName;
- emphasis: TextEmphasis bold emphasisCode;
- yourself);
- yourself);
- addMorphBack: (self morphicShapeSeen: IdentitySet new depth: 0);
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
- makeForwardArrow;
- yourself);
- yourself!! !!
-
-!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:24''!!
-morphicShapeSeen: aSet depth: anInteger
- ^ self morphicShapeDefault!! !!
-
-!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:43''!!
-morphicShapeSeen: aSet depth: anInteger do: aBlock
- " avoid recursion "
- (aSet includes: self)
- ifTrue: [ ^ self morphicShapeDefault ].
- " display nice name when possible "
- (anInteger > 0 and: [ self name notNil ])
- ifTrue: [ ^ self morphicShapeDefault ].
- " don''t do it too deep "
- (anInteger > 10)
- ifTrue: [ ^ self morphicShapeDefault ].
- aSet add: self.
- ^ aBlock value: [ :parser |
- parser
- morphicShapeSeen: aSet
- depth: anInteger + 1 ]!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 10/30/2010 11:54''!!
-transform: aBlock
- "Answer a copy of all parsers reachable from the receiver transformed using aBlock."
-
- | mapping root |
- mapping := IdentityDictionary new.
- self allParsersDo: [ :each |
- mapping
- at: each
- put: (aBlock value: each copy) ].
- root := mapping at: self.
- [ | changed |
- changed := false.
- root allParsersDo: [ :each |
- each children do: [ :old |
- mapping at: old ifPresent: [ :new |
- each replace: old with: new.
- changed := true ] ] ].
- changed ] whileTrue.
- ^ root!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/13/2010 09:38''!!
-replace: aParser with: anotherParser
- "Replace the references of the receiver pointing to aParser with anotherParser."!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
-namedChildrenDo: aBlock
- "Iterate over the named children of the receiver."
-
- self namedChildrenDo: aBlock seen: IdentitySet new!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:01''!!
-allNamedParsers
- "Answer all the named parse nodes of the receiver."
-
- | result |
- result := OrderedCollection new.
- self allNamedParsersDo: [ :parser | result addLast: parser ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
-namedChildrenDo: aBlock seen: aSet
- "Iterate over the named children of the receiver."
-
- self children do: [ :each |
- (aSet includes: each)
- ifTrue: [ ^ self ].
- aSet add: each.
- each name isNil
- ifTrue: [ each namedChildrenDo: aBlock seen: aSet ]
- ifFalse: [ aBlock value: each ] ]!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:45''!!
-innerChildren
- "Answer the inner children of the receiver."
-
- | result |
- result := OrderedCollection new.
- self innerChildrenDo: [ :parser | result addLast: parser ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:51''!!
-innerChildrenDo: aBlock seen: aSet
- "Iterate over the inner children of the receiver."
-
- self children do: [ :each |
- (aSet includes: each)
- ifTrue: [ ^ self ].
- aSet add: each.
- each name isNil ifTrue: [
- aBlock value: each.
- each innerChildrenDo: aBlock seen: aSet ] ]!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:48''!!
-innerChildrenDo: aBlock
- "Iterate over the inner children of the receiver."
-
- self innerChildrenDo: aBlock seen: IdentitySet new!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:12''!!
-allNamedParsersDo: aBlock
- "Iterate over all the named parse nodes of the receiver."
-
- self allParsersDo: [ :each |
- each name notNil
- ifTrue: [ aBlock value: each ] ]!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
-namedChildren
- "Answer the named children of the receiver."
-
- | result |
- result := OrderedCollection new.
- self namedChildrenDo: [ :parser | result addLast: parser ].
- ^ result!! !!
-
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
-trimBlanks
- "Answer a new parser that consumes blanks before and after the receiving parser."
-
- ^ self trim: #blank asParser!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 2/19/2010 07:42''!!
-answer: anObject
- "Answer a new parser that always returns anObject from a successful parse."
-
- ^ self ==> [ :nodes | anObject ]!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
-trim: aParser
- "Answer a new parser that consumes and ignores aParser repeatedly before and after the receiving parser."
-
- ^ PPTrimmingParser on: self trimmer: aParser!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/6/2011 20:28''!!
-map: aBlock
- "Answer a new parser that works on the receiving sequence an passes in each element as a block argument."
-
- ^ aBlock numArgs = 1
- ifTrue: [ self ==> aBlock ]
- ifFalse: [ self error: aBlock numArgs asString , '' arguments expected.'' ]
-!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 6/29/2010 14:25''!!
-token
- "Answer a new parser that transforms the input to a token."
-
- ^ PPTokenParser on: self!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/3/2011 14:59''!!
-foldRight: aBlock
- "Answer a new parser that that folds the result of the receiver from right-to-left into aBlock. The argument aBlock must take two or more arguments."
-
- | size args |
- size := aBlock numArgs.
- args := Array new: size.
- ^ self ==> [ :nodes |
- args at: size put: nodes last.
- nodes size - size + 1 to: 1 by: 1 - size do: [ :index |
- args
- replaceFrom: 1 to: size - 1 with: nodes startingAt: index;
- at: size put: (aBlock valueWithArguments: args) ].
- args at: size ]!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
-trimSpaces
- "Answer a new parser that consumes spaces before and after the receiving parser."
-
- ^ self trim: #space asParser!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/15/2008 16:08''!!
-flatten
- "Answer a new parser that flattens the underlying collection."
-
- ^ PPFlattenParser on: self!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/31/2010 12:06''!!
-trim
- "Answer a new parser that consumes spaces before and after the receiving parser."
-
- ^ self trimSpaces!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 6/12/2010 10:20''!!
->=> aBlock
- "Answer a new parser that wraps the receiving parser with a two argument block. The first argument is the parsed stream, the second argument a continuation block on the delegate parser."
-
- ^ PPWrappingParser on: self block: aBlock!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/12/2010 20:32''!!
-==> aBlock
- "Answer a new parser that performs aBlock as action handler on success."
-
- ^ PPActionParser on: self block: aBlock!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/3/2011 15:00''!!
-foldLeft: aBlock
- "Answer a new parser that that folds the result of the receiver from left-to-right into aBlock. The argument aBlock must take two or more arguments."
-
- | size args |
- size := aBlock numArgs.
- args := Array new: size.
- ^ self ==> [ :nodes |
- args at: 1 put: nodes first.
- 2 to: nodes size by: size - 1 do: [ :index |
- args
- replaceFrom: 2 to: size with: nodes startingAt: index;
- at: 1 put: (aBlock valueWithArguments: args) ].
- args first ]!! !!
-
-!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/6/2010 19:26''!!
-token: aTokenClass
- "Answer a new parser that transforms the input to a token of class aTokenClass."
-
- ^ self token tokenClass: aTokenClass!! !!
-
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
-max: anInteger lazy: aParser
- "Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed."
-
- ^ (self starLazy: aParser) setMax: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:01''!!
-starLazy: aParser
- "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed."
-
- ^ PPLazyRepeatingParser on: self limit: aParser!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 9/15/2010 09:34''!!
-times: anInteger
- "Answer a new parser that parses the receiver exactly anInteger times."
-
- ^ self min: anInteger max: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
-min: aMinInteger max: aMaxInteger greedy: aParser
- "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
-
- ^ (self starGreedy: aParser) setMin: aMinInteger; setMax: aMaxInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:02''!!
-star
- "Answer a new parser that parses the receiver zero or more times. This is a greedy and blind implementation that tries to consume as much input as possible and it does not consider what comes afterwards."
-
- ^ PPPossessiveRepeatingParser on: self!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:02''!!
-min: anInteger
- "Answer a new parser that parses the receiver at least anInteger times."
-
- ^ self star setMin: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
-min: aMinInteger max: aMaxInteger
- "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times."
-
- ^ self star setMin: aMinInteger; setMax: aMaxInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:01''!!
-starGreedy: aParser
- "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed."
-
- ^ PPGreedyRepeatingParser on: self limit: aParser!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
-min: aMinInteger max: aMaxInteger lazy: aParser
- "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
-
- ^ (self starLazy: aParser) setMin: aMinInteger; setMax: aMaxInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
-min: anInteger lazy: aParser
- "Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed."
-
- ^ (self starLazy: aParser) setMin: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
-max: anInteger greedy: aParser
- "Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
-
- ^ (self starGreedy: aParser) setMax: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
-plus
- "Answer a new parser that parses the receiver one or more times."
-
- ^ self star setMin: 1!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
-min: anInteger greedy: aParser
- "Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
-
- ^ (self starGreedy: aParser) setMin: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
-max: anInteger
- "Answer a new parser that parses the receiver at most anInteger times."
-
- ^ self star setMax: anInteger!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:04''!!
-plusGreedy: aParser
- "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed."
-
- ^ (self starGreedy: aParser) setMin: 1!! !!
-
-!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:04''!!
-plusLazy: aParser
- "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed."
-
- ^ (self starLazy: aParser) setMin: 1!! !!
-
-
-!!PPParser methodsFor: ''*petitsmalltalk-operations'' stamp: ''lr 6/29/2010 14:27''!!
-smalltalkToken
- ^ PPSmalltalkTokenParser on: self!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 5/22/2010 10:45''!!
-isTerminal
- "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
-
- ^ self children isEmpty!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''JanKurs 5/31/2013 11:49''!!
-isFirstSetTerminal
- "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
-
- ^ self children isEmpty!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 11/12/2009 17:25''!!
-isNullable
- "Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing."
-
- ^ false!! !!
-
-
-!!PPParser methodsFor: ''converting'' stamp: ''lr 11/29/2011 20:48''!!
-asParser
- "Answer the receiving parser."
-
- ^ self!! !!
-
-
-!!PPParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:36''!!
-printNameOn: aStream
- self name isNil
- ifTrue: [ aStream print: self hash ]
- ifFalse: [ aStream nextPutAll: self name ]!! !!
-
-!!PPParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:36''!!
-printOn: aStream
- super printOn: aStream.
- aStream nextPut: $(.
- self printNameOn: aStream.
- aStream nextPut: $)!! !!
-
-
-!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:37''!!
-example
- ^ String streamContents: [ :stream | self exampleOn: stream ] limitedTo: 1024!! !!
-
-!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:20''!!
-exampleOn: aStream!! !!
-
-!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 9/12/2011 18:34''!!
-displayColor
- ^ self isTerminal
- ifTrue: [ Color r: 0.5 g: 0.0 b: 0.5 ]
- ifFalse: [ Color blue ]!! !!
-
-!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:31''!!
-displayName
- ^ self name isNil
- ifFalse: [ self name asString ]
- ifTrue: [ self class name asString ]!! !!
-
-!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:11''!!
-backgroundForDepth: anInteger
- ^ Color gray: 1.0 - (anInteger / 20.0)!! !!
-
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 10/29/2010 17:05''!!
-parse: anObject onError: aBlock
- "Parse anObject with the receiving parser and answer the parse-result or answer the result of evaluating aBlock. Depending on the number of arguments of the block it is simply evaluated, evaluated with the failure object, or evaluated with the error message and position."
-
- | result |
- result := self parse: anObject.
- result isPetitFailure
- ifFalse: [ ^ result ].
- aBlock numArgs = 0
- ifTrue: [ ^ aBlock value ].
- aBlock numArgs = 1
- ifTrue: [ ^ aBlock value: result ].
- ^ aBlock value: result message value: result position!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 6/4/2011 18:12''!!
-matchesIn: anObject
- "Search anObject repeatedly for the matches of the receiver. Answered an OrderedCollection of the matched parse-trees."
-
- | result |
- result := OrderedCollection new.
- self
- matchesIn: anObject
- do: [ :each | result addLast: each ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 8/16/2011 07:26''!!
-matchesSkipIn: anObject
- "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of the matched parse-trees. Skip over matches."
-
- | result |
- result := OrderedCollection new.
- self
- matchesSkipIn: anObject
- do: [ :each | result addLast: each ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/25/2013 23:42''!!
-matchingSkipRangesIn: anObject do: aBlock
- "Search anObject repeatedly for the matches of the receiver. Skip over matches. Evaluate aBlock with the range of each match (index of first character to: index of last character)."
-
- self token
- matchesSkipIn: anObject
- do: [ :token | aBlock value: (token start to: token stop) ]!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''DamienCassou 10/29/2011 19:18''!!
-matchingSkipRangesIn: anObject
- "Search anObject repeatedly for the matches of the receiver. Skip over matches. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)."
-
- | result |
- result := OrderedCollection new.
- self
- matchingSkipRangesIn: anObject
- do: [ :value | result addLast: value ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 6/4/2011 18:12''!!
-matchingRangesIn: anObject
- "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)."
-
- | result |
- result := OrderedCollection new.
- self
- matchingRangesIn: anObject
- do: [ :value | result addLast: value ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 8/16/2011 07:26''!!
-matchesSkipIn: anObject do: aBlock
- "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Skip over matches."
-
- (self ==> aBlock / #any asParser) star parse: anObject!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/25/2013 23:41''!!
-matchingRangesIn: anObject do: aBlock
- "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock with the range of each match (index of first character to: index of last character)."
-
- self token
- matchesIn: anObject
- do: [ :token | aBlock value: (token start to: token stop) ]!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/8/2010 00:30''!!
-matches: anObject
- "Answer if anObject can be parsed by the receiver."
-
- ^ (self parse: anObject) isPetitFailure not!! !!
-
-!!PPParser methodsFor: ''parsing'' stamp: ''lr 3/1/2010 21:51''!!
-matchesIn: anObject do: aBlock
- "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Make sure to always consume exactly one character with each step, to not miss any match."
-
- ((self and ==> aBlock , #any asParser) / #any asParser) star parse: anObject!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 5/31/2010 18:37''!!
-matchList: matchList index: matchIndex against: parserList index: parserIndex inContext: aDictionary seen: aSet
- | parser currentIndex currentDictionary currentSeen parsers |
- matchList size < matchIndex
- ifTrue: [ ^ parserList size < parserIndex ].
- parser := matchList at: matchIndex.
- parser class = PPListPattern ifTrue: [
- currentIndex := parserIndex - 1.
- [ currentDictionary := aDictionary copy.
- currentSeen := aSet copy.
- parserList size < currentIndex or: [
- parsers := parserList copyFrom: parserIndex to: currentIndex.
- (currentDictionary at: parser ifAbsentPut: [ parsers ]) = parsers and: [
- (self
- matchList: matchList
- index: matchIndex + 1
- against: parserList
- index: currentIndex + 1
- inContext: currentDictionary
- seen: currentSeen)
- ifTrue: [
- currentDictionary keysAndValuesDo: [ :key :value | aDictionary at: key put: value ].
- ^ true ].
- false ] ] ] whileFalse: [ currentIndex := currentIndex + 1 ].
- ^ false ].
- parserList size < parserIndex
- ifTrue: [ ^ false ].
- (parser match: (parserList at: parserIndex) inContext: aDictionary seen: aSet)
- ifFalse: [ ^ false ].
- ^ self
- matchList: matchList
- index: matchIndex + 1
- against: parserList
- index: parserIndex + 1
- inContext: aDictionary
- seen: aSet!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 7/17/2011 11:53''!!
-copyInContext: aDictionary seen: aSeenDictionary
- | copy |
- aSeenDictionary
- at: self
- ifPresent: [ :value | ^ value ].
- copy := aSeenDictionary
- at: self
- put: self copy.
- copy children do: [ :each |
- copy
- replace: each
- with: (each copyInContext: aDictionary seen: aSeenDictionary) ].
- ^ copy!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 07:49''!!
-copyInContext: aDictionary
- ^ self copyInContext: aDictionary seen: IdentityDictionary new!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/29/2010 23:07''!!
-matchList: matchList against: parserList inContext: aDictionary seen: aSet
- ^ self matchList: matchList index: 1 against: parserList index: 1 inContext: aDictionary seen: aSet!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- "This is the default implementation to match two parsers. This code can properly handle recursion. This is code is supposed to be overridden in subclasses that add new state."
-
- (self == aParser or: [ anIdentitySet includes: self ])
- ifTrue: [ ^ true ].
- anIdentitySet add: self.
- ^ self class = aParser class and: [ self matchList: self children against: aParser children inContext: aDictionary seen: anIdentitySet ]!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/29/2010 23:14''!!
-match: aParser inContext: aDictionary
- ^ self match: aParser inContext: aDictionary seen: IdentitySet new!! !!
-
-
-!!PPParser methodsFor: ''testing'' stamp: ''lr 10/27/2008 11:28''!!
-isUnresolved
- ^ false!! !!
-
-!!PPParser methodsFor: ''testing'' stamp: ''lr 8/6/2010 16:44''!!
-isPetitParser
- ^ true!! !!
-
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
-propertyAt: aKey ifAbsentPut: aBlock
- "Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value."
-
- ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
-removeProperty: aKey ifAbsent: aBlock
- "Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock."
-
- | answer |
- properties isNil ifTrue: [ ^ aBlock value ].
- answer := properties removeKey: aKey ifAbsent: aBlock.
- properties isEmpty ifTrue: [ properties := nil ].
- ^ answer!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
-propertyAt: aKey
- "Answer the property value associated with aKey."
-
- ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
-propertyAt: aKey ifAbsent: aBlock
- "Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock."
-
- ^ properties isNil
- ifTrue: [ aBlock value ]
- ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
-propertyAt: aKey put: anObject
- "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
-
- ^ (properties ifNil: [ properties := Dictionary new: 1 ])
- at: aKey put: anObject!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
-hasProperty: aKey
- "Test if the property aKey is present."
-
- ^ properties notNil and: [ properties includesKey: aKey ]!! !!
-
-!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
-removeProperty: aKey
- "Remove the property with aKey. Answer the property or raise an error if aKey isn''t found."
-
- ^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
-
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:41''!!
-visualizationGraphType
- ^ nil!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:26''!!
-visualizeStructureInGraphOn: view
- view shape rectangle
- borderWidth: 1;
- if: [ :p | p name isNil ] fillColor: Color lightGray.
-
- view interaction
- item: ''Explore'' action: #explore;
- highlightWhenOver: [ :p |
- self allParsers select: [ :ch | ch children includes: p ]
- ] color: Color orange muchLighter;
- highlightWhenOver: [ :p | |children|
- children := p namedChildren.
- ] color: Color orange muchDarker;
- highlightWhenOver: [ :p | Array with: p ] color: Color orange;
- popupText: [:p | p class name asString ].
-
- view
- nodes: self allParsers
- forEach: [ :aParser | |labels|
- labels := OrderedCollection new.
- aParser name notNil ifTrue: [ labels add: aParser name ].
- aParser visualizationGraphType notNil ifTrue: [ labels add: aParser visualizationGraphType ].
- labels isEmpty ifFalse: [
- view shape label.
- view interaction forwarder.
- view nodes: labels asArray ].
- ].
-
- view shape: (ROLine new add: (ROArrow new size: 4) offset: 0.1).
- view edgesToAll: #children.
- view treeLayout
- layered;
- on: ROLayoutEnd do: [ :evt | ROFocusView on: (view raw elementFromModel: self) ].
-
- view zoomInButton.
- view zoomOutButton.!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''tg 8/25/2010 00:32''!!
-namedParsersDo: aBlock
- self namedParsersDo: aBlock seen: IdentitySet new!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''VincentBlondeau 2/14/2014 17:06''!!
-viewAllNamedParsersWithSelection: aCollectionOfNames previewing: aBlock on: view
- view shape label
- color: [ :each |
- (aCollectionOfNames includes: each name)
- ifFalse: [ Color black ]
- ifTrue: [ Color red ] ];
- text: [ :each | each displayName ].
- view interaction popupText: aBlock.
- view interaction item: ''Explore'' action: #explore.
- view nodes: (self allParsers reject: [ :each | each name isEmptyOrNil ]).
- view edges: (self allParsers reject: [ :each | each name isEmptyOrNil ]) from: #yourself toAll: #namedParsers.
- view horizontalDominanceTreeLayout
- verticalGap: 10;
- layered!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:21''!!
-visualizeStructureInGraph
-
- "
- PPSmalltalkParser new visualize
-
-
- "
- | view |
-
- view := ROMondrianViewBuilder new.
- self visualizeStructureInGraphOn: view.
- view open.
- ^ view!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''VincentBlondeau 2/14/2014 17:06''!!
-viewAllNamedParsersOn: view
- view shape
- rectangleWithoutBorder;
- withText: #displayName.
- view nodes: (self allParsers reject: [ :each | each name isEmptyOrNil ]).
- view edgesToAll: #namedParsers.
- view horizontalDominanceTreeLayout layered!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 12/6/2011 07:43''!!
-viewAllNamedParsersWithSelection: aCollectionOfNames on: view
- self viewAllNamedParsersWithSelection: aCollectionOfNames previewing: [ :each | each name ] on: view!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 12/14/2011 12:40''!!
-namedParsersDo: aBlock seen: aSet
- self children do: [ :each |
- (aSet includes: each)
- ifFalse: [
- aSet add: each.
- each name isEmptyOrNil
- ifFalse: [ aBlock value: each ]
- ifTrue: [ each namedParsersDo: aBlock seen: aSet ] ] ]!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 6/5/2013 23:01''!!
-viewAllNamedParsers
- | view |
- view := ROMondrianViewBuilder new.
- self viewAllNamedParsersOn: view.
- ^ view open setLabel: ''All named parsers''!! !!
-
-!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''tg 8/25/2010 00:31''!!
-namedParsers
- | result |
- result := OrderedCollection new.
- self namedParsersDo: [ :parser | result addLast: parser ].
- ^ result!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:36''!!
-allParsers
- "Answer all the parse nodes of the receiver."
-
- | result |
- result := OrderedCollection new.
- self allParsersDo: [ :parser | result addLast: parser ].
- ^ result!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:36''!!
-allParsersDo: aBlock
- "Iterate over all the parse nodes of the receiver."
-
- self allParsersDo: aBlock seen: IdentitySet new!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:35''!!
-allParsersDo: aBlock seen: aSet
- "Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."
-
- (aSet includes: self)
- ifTrue: [ ^ self ].
- aSet add: self.
- aBlock value: self.
- self children
- do: [ :each | each allParsersDo: aBlock seen: aSet ]!! !!
-
-
-!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/19/2010 07:56''!!
-separatedBy: aParser
- "Answer a new parser that parses the receiver one or more times, separated by aParser."
-
- ^ (PPSequenceParser with: self with: (PPSequenceParser with: aParser with: self) star) ==> [ :nodes |
- | result |
- result := Array new: 2 * nodes second size + 1.
- result at: 1 put: nodes first.
- nodes second
- keysAndValuesDo: [ :index :pair | result replaceFrom: 2 * index to: 2 * index + 1 with: pair startingAt: 1 ].
- result ]!! !!
-
-!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/19/2010 07:42''!!
-delimitedBy: aParser
- "Answer a new parser that parses the receiver one or more times, separated and possibly ended by aParser."
-
- ^ (self separatedBy: aParser) , (aParser optional) ==> [ :node |
- node second isNil
- ifTrue: [ node first ]
- ifFalse: [ node first copyWith: node second ] ]!! !!
-
-!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/25/2012 16:54''!!
-withoutSeparators
- "Filters out the separators from a parse result produced by one of the productions #delimitedBy: or #separatedBy:."
-
- ^ self ==> [ :items |
- | result |
- result := Array new: items size + 1 // 2.
- 1 to: result size do: [ :index | result at: index put: (items at: 2 * index - 1) ].
- result ]!! !!
-
-
-!!PPParser methodsFor: ''copying'' stamp: ''lr 4/19/2010 10:33''!!
-postCopy
- super postCopy.
- properties := properties copy!! !!
-
-
-!!PPParser methodsFor: ''initialization'' stamp: ''lr 4/24/2008 10:33''!!
-initialize!! !!
-
-
-!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 21:58''!!
-newColumnMorph
- ^ AlignmentMorph newColumn
- cellPositioning: #topLeft;
- color: Color transparent;
- listCentering: #topLeft;
- vResizing: #shrinkWrap;
- hResizing: #shrinkWrap;
- layoutInset: 0;
- yourself!! !!
-
-!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 21:57''!!
-newRowMorph
- ^ AlignmentMorph newRow
- cellPositioning: #topLeft;
- color: Color transparent;
- listCentering: #topLeft;
- vResizing: #shrinkWrap;
- hResizing: #shrinkWrap;
- layoutInset: 0;
- yourself!! !!
-
-!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 22:03''!!
-newSpacerMorph
- ^ Morph new
- color: Color transparent;
- borderWidth: 0;
- extent: 7 @ 7;
- yourself!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 9/16/2010 17:55''!!
-followSets
- "Answer a dictionary with all the parsers reachable from the receiver as key and their follow-set as value. The follow-set of a parser is the list of terminal parsers that can appear immediately to the right of that parser."
-
- | current previous continue firstSets followSets |
- current := previous := 0.
- firstSets := self firstSets.
- followSets := IdentityDictionary new.
- self allParsersDo: [ :each | followSets at: each put: IdentitySet new ].
- (followSets at: self) add: PPSentinel instance.
- [ followSets keysAndValuesDo: [ :parser :follow |
- parser
- followSets: followSets
- firstSets: firstSets
- into: follow ].
- current := followSets
- inject: 0
- into: [ :result :each | result + each size ].
- continue := previous < current.
- previous := current.
- continue ] whileTrue.
- ^ followSets!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 10/22/2009 19:59''!!
-firstSet
- "Answer the first-set of the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #firstSets to calculate the first-sets at once."
-
- ^ self firstSets at: self!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 11/19/2009 23:49''!!
-cycleSet
- "Answer a set of all nodes that are within one or more cycles of left-recursion. This is generally not a problem if at least one of the nodes is memoized, but it might make the grammar very inefficient and should be avoided if possible."
-
- | cycles |
- cycles := IdentitySet new.
- self cycleSet: OrderedCollection new firstSets: self firstSets into: cycles.
- ^ cycles!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''JanKurs 5/31/2013 11:49''!!
-firstSets
- "Answer a dictionary with all the parsers reachable from the receiver as key and their first-set as value. The first-set of a parser is the list of terminal parsers that begin the parser derivable from that parser."
-
- | firstSets |
- firstSets := IdentityDictionary new.
- self allParsersDo: [ :each |
- firstSets at: each put: (each isFirstSetTerminal
- ifTrue: [ IdentitySet with: each ]
- ifFalse: [ IdentitySet new ]).
- each isNullable
- ifTrue: [ (firstSets at: each) add: PPSentinel instance ] ].
- [ | changed tally |
- changed := false.
- firstSets keysAndValuesDo: [ :parser :first |
- tally := first size.
- parser firstSets: firstSets into: first.
- changed := changed or: [ tally ~= first size ] ].
- changed ] whileTrue.
- ^ firstSets!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 11/12/2009 21:13''!!
-followSet
- "Answer the follow-set of the receiver starting at the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #followSets to calculate the follow-sets at once."
-
- ^ self followSets at: self!! !!
-
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:30''!!
-parseOn: aPPContext
- "Parse aStream with the receiving parser and answer the parse-result or an instance of PPFailure. Override this method in subclasses to specify custom parse behavior. Do not call this method from outside, instead use #parse:."
-
- self subclassResponsibility!! !!
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/17/2014 13:15''!!
-debugWithContext: aPPContext
-
- ^ self enableDebug parseWithContext: aPPContext !! !!
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/11/2014 13:33''!!
-updateContext: aPPContext
- "nothing to do"!! !!
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:26''!!
-parse: anObject withContext: aPPContext
- "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
-
- aPPContext stream: anObject asPetitStream.
- ^ self parseWithContext: aPPContext.
-!! !!
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:25''!!
-parse: anObject
- "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
-
- ^ self parse: anObject withContext: PPContext new!! !!
-
-!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/19/2014 16:34''!!
-parseWithContext: context
- context root: self.
- self updateContext: context.
- ^ self parseOn: context!! !!
-
-
-!!PPParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:38''!!
-children
- "Answer a set of child parsers that could follow the receiver."
-
- ^ #()!! !!
-
-!!PPParser methodsFor: ''accessing'' stamp: ''lr 4/19/2010 10:38''!!
-name: aString
- self propertyAt: #name put: aString!! !!
-
-!!PPParser methodsFor: ''accessing'' stamp: ''lr 4/19/2010 10:35''!!
-name
- "Answer the production name of the receiver."
-
- ^ self propertyAt: #name ifAbsent: [ nil ]!! !!
-
-
-!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/19/2009 23:47''!!
-cycleSet: aDictionary
- "PRIVATE: Answer the children that could be part of a cycle-set with the receiver, subclasses might restrict the number of children returned. aDictionary is pre-calcualted first-sets."
-
- ^ self children!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 5/22/2010 10:45''!!
-cycleSet: aStack firstSets: aDictionary into: aSet
- "PRIVATE: Try to find a cycle, where aStack contains the previously visited parsers. The method returns quickly when the receiver is a terminal, terminals cannot be part of a cycle. If aStack already contains the receiver, then we are in a cycle. In this case we don''t process the children further and add the nodes to aSet."
-
- | index |
- self isTerminal
- ifTrue: [ ^ self ].
- (index := aStack indexOf: self) > 0
- ifTrue: [ ^ aSet addAll: (aStack copyFrom: index to: aStack size) ].
- aStack addLast: self.
- (self cycleSet: aDictionary)
- do: [ :each | each cycleSet: aStack firstSets: aDictionary into: aSet ].
- aStack removeLast!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/12/2009 21:25''!!
-firstSets: aFirstDictionary into: aSet
- "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."
-
- self children do: [ :parser | aSet addAll: (aFirstDictionary at: parser) ]!! !!
-
-!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/12/2009 21:25''!!
-followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
- "PRIVATE: Try to add additional elements to the follow-set aSet of the receiver, use the incomplete aFollowDictionary and the complete aFirstDictionary."
-
- self children do: [ :parser | (aFollowDictionary at: parser) addAll: aSet ]!! !!
-
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 1/16/2014 15:41''!!
-debug: anObject
- "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
-
- ^ self enableDebug parse: anObject asPetitStream!! !!
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 12:21''!!
-enableDebuggerOutput
- self debuggerOutput: true.!! !!
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 4/22/2013 18:04''!!
-debuggerOutput: aBoolean
- self propertyAt: #debuggerOutput put: aBoolean!! !!
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 12:21''!!
-disableDebuggerOutput
- self debuggerOutput: false. !! !!
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 17:01''!!
-enableDebug
- | root newParser |
- root := PPParserDebuggerResult new.
-
- newParser := self transform: [:each |
- each >=> [:stream :continuation |
- | result child |
- child := PPParserDebuggerResult new
- parser: each;
- parent: root.
- root := root children add: child.
- child start: stream position + 1.
- child showChildren: each debuggerOutput.
- result := continuation value.
- child end: stream position.
- root result: result.
- root := root parent.
- result
- ]
- ].
-
- ^ PPDebugParser on: newParser root: root.
-!! !!
-
-!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 4/22/2013 18:04''!!
-debuggerOutput
- ^ self propertyAt: #debuggerOutput ifAbsentPut: true.!! !!
-
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 2/19/2010 07:36''!!
-negate
- "Answer a new parser consumes any input token but the receiver."
-
- ^ self not , #any asParser ==> #second!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 9/1/2010 22:03''!!
-optional
- "Answer a new parser that parses the receiver, if possible."
-
- ^ PPOptionalParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 12/3/2010 11:34''!!
-def: aParser
- "Redefine the receiver as the argument aParser. This method is useful when defining recursive parsers: instantiate a PPUnresolvedParser and later redefine it with another one."
-
- ^ self becomeForward: (aParser name: self name)!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 10/23/2008 14:05''!!
-wrapped
- "Answer a new parser that is simply wrapped."
-
- ^ PPDelegateParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 16:34''!!
-memoized
- "Answer a new memoized parser, for refraining redundant computations. This ensures polynomial time O(n^4) for left-recursive grammars and O(n^3) for non left-recursive grammars in the worst case. Not necessary for most grammars that are carefully written and in O(n) anyway."
-
- ^ PPMemoizedParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 15:12''!!
-and
- "Answer a new parser (logical and-predicate) that succeeds whenever the receiver does, but never consumes input."
-
- ^ PPAndParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 4/14/2010 11:46''!!
-/ aParser
- "Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice)."
-
- ^ PPChoiceParser with: self with: aParser!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 4/30/2010 12:13''!!
-end
- "Answer a new parser that succeeds at the end of the input and return the result of the receiver."
-
- ^ PPEndOfInputParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 15:12''!!
-not
- "Answer a new parser (logical not-predicate) that succeeds whenever the receiver fails, but never consumes input."
-
- ^ PPNotParser on: self!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 4/14/2010 11:53''!!
-| aParser
- "Answer a new parser that either parses the receiver or aParser. Fail if both pass or fail (exclusive choice, unordered choice)."
-
- ^ (self not , aParser) / (aParser not , self) ==> #second!! !!
-
-!!PPParser methodsFor: ''operators'' stamp: ''lr 9/23/2008 18:32''!!
-, aParser
- "Answer a new parser that parses the receiver followed by aParser."
-
- ^ PPSequenceParser with: self with: aParser!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPParser class
- instanceVariableNames: ''''!!
-!!PPParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPParser class methodsFor: ''instance creation'' stamp: ''lr 10/27/2008 11:17''!!
-named: aString
- ^ self new name: aString!! !!
-
-!!PPParser class methodsFor: ''instance creation'' stamp: ''lr 4/18/2008 14:00''!!
-new
- ^ self basicNew initialize!! !!
-
-
-PPParser subclass: #PPPluggableParser
- instanceVariableNames: ''block''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPPluggableParser commentStamp: ''<historical>'' prior: 0!!
-A pluggable parser that passes the parser stream into a block. This enables users to perform manual parsing or to embed other parser frameworks into PetitParser.
-
-Instance Variables:
- block <BlockClosure> The pluggable one-argument block.
-!!
-
-
-!!PPPluggableParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]!! !!
-
-
-!!PPPluggableParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 16:52''!!
-initializeOn: aBlock
- block := aBlock!! !!
-
-
-!!PPPluggableParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:42''!!
-parseOn: aPPContext
- | position result |
- position := aPPContext remember.
- result := block value: aPPContext.
- result isPetitFailure
- ifTrue: [ aPPContext restore: position ].
- ^ result!! !!
-
-
-!!PPPluggableParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:41''!!
-displayName
- ^ String streamContents: [ :stream | block decompile shortPrintOn: stream ]!! !!
-
-
-!!PPPluggableParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
-block
- "Answer the pluggable block."
-
- ^ block!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPPluggableParser class
- instanceVariableNames: ''''!!
-!!PPPluggableParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPPluggableParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 16:52''!!
-on: aBlock
- ^ self new initializeOn: aBlock!! !!
-
-
-PPParser subclass: #PPFailingParser
- instanceVariableNames: ''message''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPFailingParser commentStamp: ''<historical>'' prior: 0!!
-A parser that consumes nothing and always fails.
-
-Instance Variables:
- message <String> The failure message.!!
-
-
-!!PPFailingParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 19:16''!!
-setMessage: aString
- message := aString!! !!
-
-
-!!PPFailingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:59''!!
-parseOn: aPPContext
- ^ PPFailure message: message context: aPPContext!! !!
-
-
-!!PPFailingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:43''!!
-displayName
- ^ message!! !!
-
-!!PPFailingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:16''!!
-displayColor
- ^ Color red!! !!
-
-
-!!PPFailingParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 21:27''!!
-printNameOn: aStream
- super printNameOn: aStream.
- aStream nextPutAll: '', ''; print: message!! !!
-
-
-!!PPFailingParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 12:01''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self message = aParser message ]!! !!
-
-
-!!PPFailingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
-message
- "Answer the error message of the receiving parser."
-
- ^ message!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPFailingParser class
- instanceVariableNames: ''''!!
-!!PPFailingParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPFailingParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 19:16''!!
-message: aString
- ^ self new setMessage: aString!! !!
-
-
-PPParser subclass: #PPLiteralParser
- instanceVariableNames: ''literal message''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPLiteralParser commentStamp: ''<historical>'' prior: 0!!
-Abstract literal parser that parses some kind of literal type (to be specified by subclasses).
-
-Instance Variables:
- literal <Object> The literal object to be parsed.
- message <String> The error message to be generated.
-!!
-
-
-!!PPLiteralParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 9/15/2010 12:08''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self literal = aParser literal and: [ self message = aParser message ] ]!! !!
-
-
-!!PPLiteralParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:25''!!
-visualizationGraphType
- ^ literal printString!! !!
-
-
-!!PPLiteralParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:19''!!
-displayName
- ^ literal printString!! !!
-
-
-!!PPLiteralParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:26''!!
-message
- "Answer the failure message."
-
- ^ message!! !!
-
-!!PPLiteralParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:26''!!
-literal
- "Answer the parsed literal."
-
- ^ literal!! !!
-
-
-!!PPLiteralParser methodsFor: ''operators'' stamp: ''lr 6/1/2010 22:24''!!
-caseInsensitive
- "Answer a parser that can parse the receiver case-insensitive."
-
- self subclassResponsibility!! !!
-
-
-!!PPLiteralParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 13:25''!!
-initializeOn: anObject message: aString
- literal := anObject.
- message := aString!! !!
-
-
-!!PPLiteralParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:38''!!
-printNameOn: aStream
- super printNameOn: aStream.
- aStream nextPutAll: '', ''; print: literal!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPLiteralParser class
- instanceVariableNames: ''''!!
-!!PPLiteralParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPLiteralParser class methodsFor: ''instance creation'' stamp: ''lr 1/7/2010 15:29''!!
-on: anObject message: aString
- ^ self new initializeOn: anObject message: aString!! !!
-
-!!PPLiteralParser class methodsFor: ''instance creation'' stamp: ''lr 1/7/2010 15:30''!!
-on: anObject
- ^ self on: anObject message: anObject printString , '' expected''!! !!
-
-
-PPLiteralParser subclass: #PPLiteralObjectParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPLiteralObjectParser commentStamp: ''<historical>'' prior: 0!!
-A parser that accepts a single literal object, such as a character. This is the same as the predicate parser ''PPPredicateParser expect: literal'' but slightly more efficient.!!
-
-
-!!PPLiteralObjectParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:25''!!
-exampleOn: aStream
- aStream nextPut: literal!! !!
-
-
-!!PPLiteralObjectParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
-parseOn: aPPContext
- ^ (aPPContext stream atEnd not and: [ literal = aPPContext stream uncheckedPeek ])
- ifFalse: [ PPFailure message: message context: aPPContext ]
- ifTrue: [ aPPContext stream next ]!! !!
-
-
-!!PPLiteralObjectParser methodsFor: ''operators'' stamp: ''lr 8/18/2010 20:16''!!
-caseInsensitive
- "Answer a parser that can parse the receiver case-insensitive."
-
- literal asUppercase = literal asLowercase ifTrue: [ ^ self ].
- ^ PPPredicateObjectParser on: [ :value | literal sameAs: value ] message: message!! !!
-
-!!PPLiteralObjectParser methodsFor: ''operators'' stamp: ''lr 4/28/2011 20:02''!!
-negate
- ^ (PPPredicateObjectParser expect: literal message: message) negate!! !!
-
-
-PPParser subclass: #PPPredicateParser
- instanceVariableNames: ''predicate predicateMessage negated negatedMessage''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPPredicateParser commentStamp: ''<historical>'' prior: 0!!
-An abstract parser that accepts if a given predicate holds.
-
-Instance Variables:
- predicate <BlockClosure> The block testing for the predicate.
- predicateMessage <String> The error message of the predicate.
- negated <BlockClosure> The block testing for the negation of the predicate.
- negatedMessage <String> The error message of the negated predicate.!!
-
-
-!!PPPredicateParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 9/15/2010 11:56''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block and: [ self message = aParser message ] ]!! !!
-
-
-!!PPPredicateParser methodsFor: ''printing'' stamp: ''lr 5/2/2010 13:37''!!
-printNameOn: aStream
- super printNameOn: aStream.
- aStream nextPutAll: '', ''; print: predicateMessage!! !!
-
-
-!!PPPredicateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/1/2010 17:05''!!
-exampleOn: aStream
- "Produce a random character that is valid. If there are characters in the alpha-numeric range prefer those over all others."
-
- | valid normal |
- valid := Character allCharacters
- select: [ :char | self matches: (String with: char) ].
- normal := valid
- select: [ :char | char asInteger < 127 and: [ char isAlphaNumeric ] ].
- aStream nextPut: (normal isEmpty
- ifTrue: [ valid atRandom ]
- ifFalse: [ normal atRandom ])!! !!
-
-!!PPPredicateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/2/2010 19:35''!!
-displayName
- ^ predicateMessage!! !!
-
-
-!!PPPredicateParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:36''!!
-message
- "Answer the failure message."
-
- ^ predicateMessage!! !!
-
-!!PPPredicateParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:36''!!
-block
- "Answer the predicate block of the receiver."
-
- ^ predicate!! !!
-
-
-PPPredicateParser subclass: #PPPredicateObjectParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPPredicateObjectParser commentStamp: ''<historical>'' prior: 0!!
-A parser that accepts if a given predicate on one element of the input sequence holds.!!
-
-
-!!PPPredicateObjectParser methodsFor: ''operators'' stamp: ''lr 6/12/2010 09:12''!!
-negate
- "Answer a parser that is the negation of the receiving predicate parser."
-
- ^ self class
- on: negated message: negatedMessage
- negated: predicate message: predicateMessage!! !!
-
-
-!!PPPredicateObjectParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:03''!!
-parseOn: aPPContext
- ^ (aPPContext stream atEnd not and: [ predicate value: aPPContext stream uncheckedPeek ])
- ifFalse: [ PPFailure message: predicateMessage context: aPPContext ]
- ifTrue: [ aPPContext stream next ]!! !!
-
-
-!!PPPredicateObjectParser methodsFor: ''initialization'' stamp: ''lr 6/12/2010 09:12''!!
-initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString
- predicate := aBlock.
- predicateMessage := aString.
- negated := aNegatedBlock.
- negatedMessage := aNegatedString!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPPredicateObjectParser class
- instanceVariableNames: ''''!!
-!!PPPredicateObjectParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPPredicateObjectParser class methodsFor: ''*petitregex-chars'' stamp: ''lr 8/30/2010 14:48''!!
-control
- ^ self chars: ((0 to: 31) collect: [ :each | Character value: each ]) message: ''control character expected''!! !!
-
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 8/25/2010 10:57''!!
-expect: anObject
- ^ self expect: anObject message: anObject printString , '' expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 4/1/2011 20:05''!!
-anyExceptAnyOf: aCollection
- ^ self
- on: [ :each | (aCollection includes: each) not ] message: ''any except '' , aCollection printString , '' expected''
- negated: [ :each | aCollection includes: each ] message: aCollection printString , '' not expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 4/1/2011 20:05''!!
-anyOf: aCollection
- ^ self
- on: [ :each | aCollection includes: each ] message: ''any of '' , aCollection printString , '' expected''
- negated: [ :each | (aCollection includes: each) not ] message: ''none of '' , aCollection printString , ''expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 6/12/2010 09:10''!!
-any
- ^ self
- on: [ :each | true ] message: ''input expected''
- negated: [ :each | false ] message: ''no input expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 6/12/2010 09:10''!!
-between: min and: max
- ^ self
- on: [ :each | each >= min and: [ each <= max ] ] message: min printString , ''..'' , max printString , '' expected''
- negated: [ :each | each < min or: [ each > max ] ] message: min printString , ''..'' , max printString , '' not expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 8/25/2010 10:57''!!
-expect: anObject message: aString
- ^ self
- on: [ :each | each = anObject ] message: aString
- negated: [ :each | each ~= anObject ] message: ''no '' , aString!! !!
-
-
-!!PPPredicateObjectParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:10''!!
-on: aBlock message: aString
- ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: ''no '' , aString!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:10''!!
-on: aBlock message: aString negated: aNegatedBlock message: aNegatedString
- ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString!! !!
-
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
-char: aCharacter
- ^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , '' expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
-punctuation
- ^ self chars: ''.,"''''?!!!!;:#$%&()*+-/<>=@[]\^_{}|~'' message: ''punctuation expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
-blank
- ^ self chars: (String with: Character space with: Character tab) message: ''blank expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-hex
- ^ self
- on: (PPCharSetPredicate on: [ :char |
- (char between: $0 and: $9)
- or: [ (char between: $a and: $f)
- or: [ (char between: $A and: $F) ] ] ])
- message: ''hex digit expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
-newline
- ^ self chars: (String with: Character cr with: Character lf) message: ''newline expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-word
- ^ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: ''letter or digit expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 6/12/2010 09:10''!!
-lf
- ^ self char: Character lf!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-digit
- ^ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: ''digit expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:05''!!
-letter
- ^ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: ''letter expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-uppercase
- ^ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: ''uppercase letter expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
-cr
- ^ self char: Character cr message: ''carriage return expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-space
- ^ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: ''separator expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-lowercase
- ^ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: ''lowercase letter expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
-tab
- ^ self char: Character tab message: ''tab expected''!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
-chars: aCollection message: aString
- ^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString!! !!
-
-!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 10:57''!!
-char: aCharacter message: aString
- ^ self expect: aCharacter message: aString!! !!
-
-
-PPPredicateParser subclass: #PPPredicateSequenceParser
- instanceVariableNames: ''size''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPPredicateSequenceParser commentStamp: ''<historical>'' prior: 0!!
-A parser that accepts if a given predicate on an arbitrary number of elements of the input sequence holds.
-
-Instance Variables:
- size <Integer> The number of elements to consume.!!
-
-
-!!PPPredicateSequenceParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self size = aParser size ]!! !!
-
-
-!!PPPredicateSequenceParser methodsFor: ''operators'' stamp: ''lr 6/12/2010 09:14''!!
-negate
- "Answer a parser that is the negation of the receiving predicate parser."
-
- ^ self class
- on: negated message: negatedMessage
- negated: predicate message: predicateMessage
- size: size!! !!
-
-
-!!PPPredicateSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:03''!!
-parseOn: aPPContext
- | position result |
- position := aPPContext remember.
- result := aPPContext stream next: size.
- (result size = size and: [ predicate value: result ])
- ifTrue: [ ^ result ].
- aPPContext restore: position.
- ^ PPFailure message: predicateMessage context: aPPContext!! !!
-
-
-!!PPPredicateSequenceParser methodsFor: ''accessing'' stamp: ''lr 6/12/2010 08:58''!!
-size
- "Answer the sequence size of the receiver."
-
- ^ size!! !!
-
-
-!!PPPredicateSequenceParser methodsFor: ''initialization'' stamp: ''lr 6/12/2010 09:13''!!
-initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
- predicate := aBlock.
- predicateMessage := aString.
- negated := aNegatedBlock.
- negatedMessage := aNegatedString.
- size := anInteger !! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPPredicateSequenceParser class
- instanceVariableNames: ''''!!
-!!PPPredicateSequenceParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPPredicateSequenceParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:14''!!
-on: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
- ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger!! !!
-
-!!PPPredicateSequenceParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:14''!!
-on: aBlock message: aString size: anInteger
- ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: ''no '' , aString size: anInteger !! !!
-
-
-PPParser subclass: #PPDelegateParser
- instanceVariableNames: ''parser''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPDelegateParser commentStamp: ''<historical>'' prior: 0!!
-A parser that delegates to another parser.
-
-Instance Variables:
- parser <PPParser> The parser to delegate to.!!
-
-
-!!PPDelegateParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:37''!!
-children
- ^ Array with: parser!! !!
-
-
-!!PPDelegateParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/13/2010 09:39''!!
-replace: aParser with: anotherParser
- super replace: aParser with: anotherParser.
- parser == aParser ifTrue: [ parser := anotherParser ]!! !!
-
-
-!!PPDelegateParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
-parseOn: aPPContext
- ^ parser parseOn: aPPContext!! !!
-
-
-!!PPDelegateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:27''!!
-exampleOn: aStream
- parser exampleOn: aStream!! !!
-
-!!PPDelegateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:20''!!
-displayDescription
- ^ nil!! !!
-
-
-!!PPDelegateParser methodsFor: ''initialization'' stamp: ''lr 4/20/2008 16:23''!!
-setParser: aParser
- parser := aParser!! !!
-
-
-!!PPDelegateParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:21''!!
-morphicShapeSeen: aSet depth: anInteger
- ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
- self displayDescription isNil
- ifTrue: [ cc value: parser ]
- ifFalse: [
- self newRowMorph
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph height: 10);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
- yourself);
- addMorphBack: (self newRowMorph
- color: (self backgroundForDepth: anInteger);
- addMorphBack: (self newColumnMorph
- addMorphBack: (cc value: parser);
- addMorphBack: (self newRowMorph
- hResizing: #spaceFill;
- addMorphBack: (self newSpacerMorph
- width: 20;
- yourself);
- addMorphBack: (self newColumnMorph
- hResizing: #spaceFill;
- listCentering: #center;
- addMorphBack: (self newSpacerMorph);
- addMorphBack: (StringMorph new
- contents: self displayDescription;
- yourself);
- yourself);
- yourself);
- yourself);
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph height: 10);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
- yourself);
- yourself);
- yourself ] ]!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPDelegateParser class
- instanceVariableNames: ''''!!
-!!PPDelegateParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPDelegateParser class methodsFor: ''instance creation'' stamp: ''lr 4/20/2008 16:22''!!
-on: aParser
- ^ self new setParser: aParser!! !!
-
-
-PPDelegateParser subclass: #PPAndParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPAndParser commentStamp: ''TudorGirba 2/27/2011 22:22'' prior: 0!!
-The and-predicate, a parser that succeeds whenever its delegate does, but does not consume the input stream [Parr 1994, 1995].!!
-
-
-!!PPAndParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/1/2010 16:16''!!
-exampleOn: aStream!! !!
-
-!!PPAndParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:17''!!
-displayDescription
- ^ ''and''!! !!
-
-
-!!PPAndParser methodsFor: ''operators'' stamp: ''lr 5/1/2010 16:16''!!
-and
- ^ self!! !!
-
-
-!!PPAndParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:50''!!
-parseOn: aPPContext
- | element position |
- position := aPPContext remember.
- element := parser parseOn: aPPContext.
- aPPContext restore: position.
- ^ element!! !!
-
-
-PPDelegateParser subclass: #PPTrimmingParser
- instanceVariableNames: ''trimmer''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPTrimmingParser commentStamp: ''lr 4/6/2010 19:27'' prior: 0!!
-A parser that silently consumes spaces before and after the delegate parser.!!
-
-
-!!PPTrimmingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 4/14/2010 20:48''!!
-exampleOn: aStream
- super exampleOn: aStream.
- aStream nextPut: Character space!! !!
-
-
-!!PPTrimmingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:42''!!
-parseOn: aPPContext
- | position element |
- position := aPPContext remember.
- [ (trimmer parseOn: aPPContext) isPetitFailure ]
- whileFalse.
- element := parser parseOn: aPPContext.
- element isPetitFailure ifTrue: [
- aPPContext restore: position.
- ^ element ].
- [ (trimmer parseOn: aPPContext) isPetitFailure ]
- whileFalse.
- ^ element!! !!
-
-
-!!PPTrimmingParser methodsFor: ''initialization'' stamp: ''lr 7/31/2010 12:00''!!
-setTrimmer: aParser
- trimmer := aParser!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPTrimmingParser class
- instanceVariableNames: ''''!!
-!!PPTrimmingParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPTrimmingParser class methodsFor: ''instance creation'' stamp: ''lr 7/31/2010 12:01''!!
-on: aParser trimmer: aTrimParser
- ^ self new
- setParser: aParser;
- setTrimmer: aTrimParser;
- yourself!! !!
-
-
-PPDelegateParser subclass: #PPMemoizedParser
- instanceVariableNames: ''buffer context''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPMemoizedParser commentStamp: ''<historical>'' prior: 0!!
-A memoized parser, for refraining redundant computations.
-
-Instance Variables:
- stream <PositionableStream> The stream of the associated memento objects.
- buffer <Array of: PPMemento> The buffer of memento objects.
-!!
-
-
-!!PPMemoizedParser methodsFor: ''operators'' stamp: ''lr 4/2/2009 19:48''!!
-memoized
- "Ther is no point in memoizing more than once."
-
- ^ self!! !!
-
-
-!!PPMemoizedParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:20''!!
-reset: aPPContext
- context := aPPContext.
- buffer := Dictionary new.!! !!
-
-!!PPMemoizedParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
-parseOn: aPPContext
- | memento contextMemento aStream |
- "TODO: JK memoizing needs review!!!!"
-
- contextMemento := aPPContext remember.
- context == aPPContext
- ifFalse: [ self reset: aPPContext ].
- memento := (buffer at: contextMemento ifAbsentPut: [ PPMemento new ]).
-
- memento contextMemento isNil
- ifTrue: [
- aStream := aPPContext stream.
- memento result: (aStream size - aStream position + 2 < memento count
- ifTrue: [ PPFailure message: ''overflow'' context: aPPContext ]
- ifFalse: [ memento increment. parser parseOn: aPPContext ]).
- memento contextMemento: aPPContext remember ]
- ifFalse: [ context restore: memento contextMemento ].
- ^ memento result.!! !!
-
-
-PPDelegateParser subclass: #PPEndOfInputParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPEndOfInputParser commentStamp: ''lr 4/18/2008 13:46'' prior: 0!!
-A parser that succeeds only at the end of the input stream.!!
-
-
-!!PPEndOfInputParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:58''!!
-parseOn: aPPContext
- | position result |
- position := aPPContext remember.
- result := parser parseOn: aPPContext.
- (result isPetitFailure or: [ aPPContext stream atEnd ])
- ifTrue: [ ^ result ].
- result := PPFailure
- message: ''end of input expected''
- context: aPPContext.
- aPPContext restore: position.
- ^ result!! !!
-
-
-!!PPEndOfInputParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:18''!!
-displayDescription
- ^ ''end of input''!! !!
-
-
-!!PPEndOfInputParser methodsFor: ''operators'' stamp: ''lr 12/7/2009 08:53''!!
-end
- ^ self!! !!
-
-
-PPDelegateParser subclass: #PPActionParser
- instanceVariableNames: ''block''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPActionParser commentStamp: ''<historical>'' prior: 0!!
-A parser that performs an action block with the successful parse result of the delegate.
-
-Instance Variables:
- block <BlockClosure> The action block to be executed.
-!!
-
-
-!!PPActionParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 16:58''!!
-setBlock: aBlock
- block := aBlock!! !!
-
-
-!!PPActionParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:41''!!
-visualizationGraphType
- ^ ''[]''!! !!
-
-
-!!PPActionParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
-parseOn: aPPContext
- | element |
- ^ (element := parser parseOn: aPPContext) isPetitFailure
- ifFalse: [ block value: element ]
- ifTrue: [ element ]!! !!
-
-
-!!PPActionParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
-block
- "Answer the action block of the receiver."
-
- ^ block!! !!
-
-
-!!PPActionParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 5/7/2011 15:08''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPActionParser class
- instanceVariableNames: ''''!!
-!!PPActionParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPActionParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 16:58''!!
-on: aParser block: aBlock
- ^ (self on: aParser) setBlock: aBlock!! !!
-
-
-PPActionParser subclass: #PPWrappingParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPWrappingParser commentStamp: ''<historical>'' prior: 0!!
-A parser that performs an action block upon activation with the stream and a continuation block.!!
-
-
-!!PPWrappingParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
-parseOn: aPPContext
- ^ block value: aPPContext value: [ parser parseOn: aPPContext ]!! !!
-
-
-PPParser subclass: #PPListParser
- instanceVariableNames: ''parsers''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPListParser commentStamp: ''<historical>'' prior: 0!!
-Abstract parser that parses a list of things in some way (to be specified by the subclasses).
-
-Instance Variables:
- parsers <SequenceableCollection of: PPParser> A sequence of other parsers to delegate to.!!
-
-
-!!PPListParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 08:15''!!
-copyInContext: aDictionary seen: aSeenDictionary
- | copy copies |
- aSeenDictionary at: self ifPresent: [ :value | ^ value ].
- copy := aSeenDictionary at: self put: self copy.
- copies := OrderedCollection new.
- parsers do: [ :each |
- | result |
- result := each
- copyInContext: aDictionary
- seen: aSeenDictionary.
- result isCollection
- ifTrue: [ copies addAll: result ]
- ifFalse: [ copies add: result ] ].
- ^ copy
- setParsers: copies;
- yourself!! !!
-
-
-!!PPListParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 5/22/2010 10:24''!!
-replace: aParser with: anotherParser
- super replace: aParser with: anotherParser.
- parsers keysAndValuesDo: [ :index :parser |
- parser == aParser
- ifTrue: [ parsers at: index put: anotherParser ] ]!! !!
-
-
-!!PPListParser methodsFor: ''initialization'' stamp: ''lr 4/29/2010 10:12''!!
-setParsers: aCollection
- parsers := aCollection asArray!! !!
-
-!!PPListParser methodsFor: ''initialization'' stamp: ''lr 4/29/2010 10:12''!!
-initialize
- super initialize.
- self setParsers: #()!! !!
-
-
-!!PPListParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:37''!!
-children
- ^ parsers!! !!
-
-
-!!PPListParser methodsFor: ''copying'' stamp: ''lr 9/17/2008 22:36''!!
-copyWith: aParser
- ^ self species withAll: (parsers copyWith: aParser)!! !!
-
-!!PPListParser methodsFor: ''copying'' stamp: ''lr 5/22/2010 10:26''!!
-postCopy
- super postCopy.
- parsers := parsers copy!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPListParser class
- instanceVariableNames: ''''!!
-!!PPListParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 9/23/2008 18:32''!!
-with: aFirstParser with: aSecondParser
- ^ self withAll: (Array with: aFirstParser with: aSecondParser)!! !!
-
-!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 5/3/2010 20:26''!!
-with: aParser
- ^ self withAll: (Array with: aParser)!! !!
-
-!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 4/29/2010 10:12''!!
-withAll: aCollection
- ^ self basicNew setParsers: aCollection!! !!
-
-
-PPListParser subclass: #PPChoiceParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPChoiceParser commentStamp: ''lr 4/18/2008 15:35'' prior: 0!!
-A parser that uses the first parser that succeeds.!!
-
-
-!!PPChoiceParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:42''!!
-visualizationGraphType
- ^ ''/''!! !!
-
-
-!!PPChoiceParser methodsFor: ''operators'' stamp: ''lr 9/17/2008 00:16''!!
-/ aRule
- ^ self copyWith: aRule!! !!
-
-
-!!PPChoiceParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
-parseOn: aPPContext
- "This is optimized code that avoids unnecessary block activations, do not change. When all choices fail, the last failure is answered."
-
- | element |
- 1 to: parsers size do: [ :index |
- element := (parsers at: index)
- parseOn: aPPContext.
- element isPetitFailure
- ifFalse: [ ^ element ] ].
- ^ element!! !!
-
-
-!!PPChoiceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 5/2/2010 20:15''!!
-exampleOn: aStream
- "If there is already a lot written, try to pick an empty possiblity."
-
- aStream position > 512 ifTrue: [
- (parsers anySatisfy: [ :each | each isNullable ])
- ifTrue: [ ^ self ] ].
- parsers atRandom exampleOn: aStream!! !!
-
-!!PPChoiceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:14''!!
-morphicShapeSeen: aSet depth: anInteger
- ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
- | morph |
- morph := self newColumnMorph
- cellInset: 5;
- yourself.
- self children do: [ :each |
- morph addMorphBack: (self newRowMorph
- hResizing: #spaceFill;
- addMorphBack: (cc value: each);
- addMorphBack: (self newColumnMorph
- hResizing: #spaceFill;
- addMorphBack: (self newSpacerMorph height: 10);
- addMorphBack: ((LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
- hResizing: #spaceFill;
- minWidth: 20;
- yourself);
- yourself);
- yourself) ].
- morph fullBounds.
- self newRowMorph
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph height: 10);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
- yourself);
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph width: 1; height: 10);
- addMorphBack: (LineMorph from: 0 @ 0 to: 0 @ (morph height - 23) color: Color black width: 1);
- yourself);
- addMorphBack: morph;
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph width: 1; height: 10);
- addMorphBack: (LineMorph from: 0 @ (morph height - 23) to: 0 @ 0 color: Color black width: 1)
- makeForwardArrow;
- width: 1;
- yourself);
- yourself ]!! !!
-
-
-PPDelegateParser subclass: #PPNotParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPNotParser commentStamp: ''<historical>'' prior: 0!!
-The not-predicate, a parser that succeeds whenever its delegate does not, but consumes no input [Parr 1994, 1995].!!
-
-
-!!PPNotParser methodsFor: ''*petitanalyzer-testing'' stamp: ''JanKurs 5/31/2013 11:50''!!
-isFirstSetTerminal
- ^ true!! !!
-
-
-!!PPNotParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:01''!!
-parseOn: aPPContext
- | element position |
- position := aPPContext remember.
- element := parser parseOn: aPPContext.
- aPPContext restore: position.
- ^ element isPetitFailure
- ifFalse: [ PPFailure message: '''' context: aPPContext ]!! !!
-
-
-!!PPNotParser methodsFor: ''*petitanalyzer-private'' stamp: ''JanKurs 5/31/2013 11:50''!!
-firstSets: aFirstDictionary into: aSet
- !! !!
-
-
-!!PPNotParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/11/2009 21:09''!!
-exampleOn: aStream!! !!
-
-!!PPNotParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:17''!!
-displayDescription
- ^ ''not''!! !!
-
-
-PPLiteralParser subclass: #PPLiteralSequenceParser
- instanceVariableNames: ''size''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPLiteralSequenceParser commentStamp: ''lr 12/4/2009 18:39'' prior: 0!!
-A parser accepts a sequence of literal objects, such as a String. This is an optimization to avoid having to compose longer sequences from PPSequenceParser.!!
-
-
-!!PPLiteralSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:38''!!
-parseOn: aPPContext
- | memento result |
- memento := aPPContext remember.
- result := aPPContext stream next: size.
- literal = result ifTrue: [ ^ result ].
- aPPContext restore: memento.
- ^ PPFailure message: message context: aPPContext!! !!
-
-
-!!PPLiteralSequenceParser methodsFor: ''initialization'' stamp: ''lr 6/1/2010 22:21''!!
-initializeOn: anObject message: aString
- super initializeOn: anObject message: aString.
- size := literal size!! !!
-
-
-!!PPLiteralSequenceParser methodsFor: ''accessing'' stamp: ''lr 9/15/2010 11:16''!!
-size
- "Answer the sequence size of the receiver."
-
- ^ size!! !!
-
-
-!!PPLiteralSequenceParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:25''!!
-exampleOn: aStream
- aStream nextPutAll: literal!! !!
-
-
-!!PPLiteralSequenceParser methodsFor: ''operators'' stamp: ''lr 8/18/2010 20:16''!!
-caseInsensitive
- "Answer a parser that can parse the receiver case-insensitive."
-
- literal asUppercase = literal asLowercase ifTrue: [ ^ self ].
- ^ PPPredicateSequenceParser on: [ :value | literal sameAs: value ] message: message size: size!! !!
-
-
-PPDelegateParser subclass: #PPOptionalParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPOptionalParser commentStamp: ''lr 4/3/2011 14:46'' prior: 0!!
-A parser that optionally parsers its delegate, or answers nil.!!
-
-
-!!PPOptionalParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 9/1/2010 22:10''!!
-isNullable
- ^ true!! !!
-
-
-!!PPOptionalParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
-visualizationGraphType
- ^ ''?''!! !!
-
-
-!!PPOptionalParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/19/2014 15:12''!!
-parseOn: aPPContext
- | element |
- element := parser parseOn: aPPContext.
- ^ element isPetitFailure ifFalse: [ element ]!! !!
-
-
-PPDelegateParser subclass: #PPFlattenParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPFlattenParser commentStamp: ''lr 11/22/2009 13:09'' prior: 0!!
-A parser that answers a flat copy of the range my delegate parses.!!
-
-
-!!PPFlattenParser methodsFor: ''private'' stamp: ''lr 2/25/2013 23:31''!!
-on: aCollection start: aStartInteger stop: aStopInteger value: anObject
- ^ aCollection copyFrom: aStartInteger to: aStopInteger!! !!
-
-
-!!PPFlattenParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:42''!!
-parseOn: aPPContext
- | start element |
- start := aPPContext stream position.
- element := parser parseOn: aPPContext.
- element isPetitFailure ifTrue: [ ^ element ].
- ^ self on: aPPContext stream collection start: start + 1 stop: aPPContext stream position value: element!! !!
-
-
-PPFlattenParser subclass: #PPTokenParser
- instanceVariableNames: ''tokenClass''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPTokenParser commentStamp: ''lr 2/25/2013 23:31'' prior: 0!!
-A parser that answers a token with the value of my delegate parses.
-
-Instance Variables:
- tokenClass <PPToken class> The token sub-class to be used.!!
-
-
-!!PPTokenParser methodsFor: ''private'' stamp: ''lr 4/6/2010 19:18''!!
-defaultTokenClass
- ^ PPToken!! !!
-
-!!PPTokenParser methodsFor: ''private'' stamp: ''lr 2/25/2013 23:32''!!
-on: aCollection start: aStartInteger stop: aStopInteger value: anObject
- ^ self tokenClass on: aCollection start: aStartInteger stop: aStopInteger value: anObject!! !!
-
-
-!!PPTokenParser methodsFor: ''initialization'' stamp: ''lr 4/6/2010 19:19''!!
-initialize
- tokenClass := self defaultTokenClass
- !! !!
-
-
-!!PPTokenParser methodsFor: ''accessing'' stamp: ''lr 4/6/2010 19:23''!!
-tokenClass
- ^ tokenClass!! !!
-
-!!PPTokenParser methodsFor: ''accessing'' stamp: ''lr 4/6/2010 19:24''!!
-tokenClass: aTokenClass
- tokenClass := aTokenClass!! !!
-
-
-!!PPTokenParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self tokenClass = aParser tokenClass ]!! !!
-
-
-PPDelegateParser subclass: #PPRepeatingParser
- instanceVariableNames: ''min max''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPRepeatingParser commentStamp: ''lr 4/3/2011 14:45'' prior: 0!!
-An abstract parser that repeatedly parses between ''min'' and ''max'' instances of its delegate. The default configuration parses an infinite number of elements, as ''min'' is set to 0 and ''max'' to infinity (SmallInteger maxVal).
-
-Instance Variables:
- min <Integer> The minimum number of repetitions.
- max <Integer> The maximum number of repetitions.!!
-
-
-!!PPRepeatingParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
-match: aParser inContext: aDictionary seen: anIdentitySet
- ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self min = aParser min and: [ self max = aParser max ] ]!! !!
-
-
-!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:00''!!
-setMax: anInteger
- max := anInteger!! !!
-
-!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:01''!!
-setMin: anInteger
- min := anInteger!! !!
-
-!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:06''!!
-initialize
- super initialize.
- self setMin: 0; setMax: SmallInteger maxVal!! !!
-
-
-!!PPRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:08''!!
-max
- "Answer the maximum number of repetitions."
-
- ^ max!! !!
-
-!!PPRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:08''!!
-min
- "Answer the minimum number of repetitions."
-
- ^ min!! !!
-
-
-!!PPRepeatingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/11/2009 20:57''!!
-exampleOn: aStream
- "Perform the minimal repeatitions required, and a random amount of more if possible and if not that much output has been produced yet."
-
- min timesRepeat: [
- super exampleOn: aStream ].
- (max - min min: 5) atRandom timesRepeat: [
- aStream position > 512
- ifTrue: [ ^ self ].
- super exampleOn: aStream ]!! !!
-
-!!PPRepeatingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:18''!!
-displayDescription
- ^ String streamContents: [ :stream |
- min = 0
- ifFalse: [ stream print: min; nextPutAll: ''..'' ].
- max = SmallInteger maxVal
- ifTrue: [ stream nextPut: $* ]
- ifFalse: [ stream print: max ] ]!! !!
-
-
-!!PPRepeatingParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 10/21/2009 12:13''!!
-isNullable
- ^ min = 0!! !!
-
-
-!!PPRepeatingParser methodsFor: ''*petitanalyzer-private'' stamp: ''JanKurs 5/31/2013 11:51''!!
-followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
- | firstSet |
- super followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet.
-
- firstSet := aFirstDictionary at: self.
- self children do: [:p | (aFollowDictionary at: p) addAll: (firstSet reject: [:each | each isNullable]) ]!! !!
-
-
-!!PPRepeatingParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
-visualizationGraphType
- ^ ''*''!! !!
-
-
-!!PPRepeatingParser methodsFor: ''printing'' stamp: ''lr 6/3/2010 14:00''!!
-printOn: aStream
- super printOn: aStream.
- aStream nextPutAll: '' [''; print: min; nextPutAll: '', ''; nextPutAll: (max = SmallInteger maxVal
- ifTrue: [ ''*'' ] ifFalse: [ max printString ]); nextPut: $]!! !!
-
-
-PPRepeatingParser subclass: #PPPossessiveRepeatingParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPPossessiveRepeatingParser commentStamp: ''lr 4/3/2011 14:35'' prior: 0!!
-The default repeating parser with standard PEG semantics (i.e. possessive, blind, eager).!!
-
-
-!!PPPossessiveRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:43''!!
-parseOn: aPPContext
- | start element elements |
- start := aPPContext remember.
- elements := OrderedCollection new.
- [ elements size < min ] whileTrue: [
- (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements addLast: element ].
- [ elements size < max ] whileTrue: [
- (element := parser parseOn: aPPContext) isPetitFailure
- ifTrue: [ ^ elements asArray ].
- elements addLast: element ].
- ^ elements asArray!! !!
-
-
-PPRepeatingParser subclass: #PPLimitedRepeatingParser
- instanceVariableNames: ''limit''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPLimitedRepeatingParser commentStamp: ''lr 4/3/2011 14:37'' prior: 0!!
-An abstract parser that repeatedly parses between ''min'' and ''max'' instances of my delegate and that requires the input to be completed with a specified parser ''limit''. Subclasses provide repeating behavior as typically seen in regular expression implementations (non-blind).
-
-Instance Variables:
- limit <PPParser> The parser to complete the input with.!!
-
-
-!!PPLimitedRepeatingParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/4/2011 18:46''!!
-replace: aParser with: anotherParser
- super replace: aParser with: anotherParser.
- limit == aParser ifTrue: [ limit := anotherParser ]!! !!
-
-
-!!PPLimitedRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/2/2011 10:00''!!
-setLimit: aParser
- limit := aParser!! !!
-
-
-!!PPLimitedRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/4/2011 18:46''!!
-children
- ^ Array with: parser with: limit!! !!
-
-!!PPLimitedRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/2/2011 10:00''!!
-limit
- "Answer the parser that limits (or ends) this repetition."
-
- ^ limit!! !!
-
-
-!!PPLimitedRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 16:04''!!
-matchesLimitOn: aPPContext
- | element position |
- position := aPPContext remember.
- element := limit parseOn: aPPContext.
- aPPContext restore: position.
- ^ element isPetitFailure not!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPLimitedRepeatingParser class
- instanceVariableNames: ''''!!
-!!PPLimitedRepeatingParser class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPLimitedRepeatingParser class methodsFor: ''instance creation'' stamp: ''lr 4/3/2011 14:58''!!
-on: aParser limit: aLimitParser
- ^ (self on: aParser) setLimit: aLimitParser!! !!
-
-
-PPLimitedRepeatingParser subclass: #PPGreedyRepeatingParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPGreedyRepeatingParser commentStamp: ''lr 4/3/2011 15:08'' prior: 0!!
-A greedy repeating parser, commonly seen in regular expression implementations. It aggressively consumes as much input as possible and then backtracks to meet the ''limit'' condition.
-
-This class essentially implements the iterative version of the following recursive parser composition:
-
- | parser |
- parser := PPChoiceParser new.
- parser setParsers: (Array
- with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])
- with: (limit and ==> [ :each | OrderedCollection new ])).
- ^ parser ==> [ :rest | rest asArray ]!!
-
-
-!!PPGreedyRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:59''!!
-parseOn: aPPContext
- | start element elements positions |
- start := aPPContext remember.
- elements := OrderedCollection new.
- [ elements size < min ] whileTrue: [
- (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements addLast: element ].
- positions := OrderedCollection with: aPPContext remember.
- [ elements size < max and: [ (element := parser parseOn: aPPContext) isPetitFailure not ] ] whileTrue: [
- elements addLast: element.
- positions addLast: aPPContext remember ].
- [ positions isEmpty ] whileFalse: [
- aPPContext restore: positions last.
- element := limit parseOn: aPPContext.
- element isPetitFailure ifFalse: [
- aPPContext restore: positions last.
- ^ elements asArray ].
- elements isEmpty ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements removeLast.
- positions removeLast ].
- aPPContext restore: start.
- ^ PPFailure message: ''overflow'' context: aPPContext at: start!! !!
-
-
-PPParser subclass: #PPEpsilonParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPEpsilonParser commentStamp: ''lr 5/15/2008 15:09'' prior: 0!!
-A parser that consumes nothing and always succeeds.!!
-
-
-!!PPEpsilonParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 10/21/2009 12:11''!!
-isNullable
- ^ true!! !!
-
-
-!!PPEpsilonParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:15''!!
-morphicShapeSeen: aSet depth: anInteger
- ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
- self newRowMorph
- addMorphBack: (self newColumnMorph
- addMorphBack: (self newSpacerMorph height: 10);
- addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
- yourself);
- yourself ]!! !!
-
-
-!!PPEpsilonParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:42''!!
-displayName
- ^ ''epsilon''!! !!
-
-
-!!PPEpsilonParser methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:49''!!
-parseOn: aStream
- ^ nil!! !!
-
-
-PPLimitedRepeatingParser subclass: #PPLazyRepeatingParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPLazyRepeatingParser commentStamp: ''lr 4/3/2011 15:08'' prior: 0!!
-A lazy repeating parser, commonly seen in regular expression implementations. It limits its consumption to meet the ''limit'' condition as early as possible.
-
-This class essentially implements the iterative version of the following recursive parser composition:
-
- | parser |
- parser := PPChoiceParser new.
- parser setParsers: (Array
- with: (limit and ==> [ :each | OrderedCollection new ])
- with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])).
- ^ parser ==> [ :rest | rest asArray ]!!
-
-
-!!PPLazyRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
-parseOn: aPPContext
- | start element elements |
- start := aPPContext remember.
- elements := OrderedCollection new.
- [ elements size < min ] whileTrue: [
- (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements addLast: element ].
- [ self matchesLimitOn: aPPContext ] whileFalse: [
- elements size < max ifFalse: [
- aPPContext restore: start.
- ^ PPFailure message: ''overflow'' context: aPPContext at: start ].
- element := parser parseOn: aPPContext.
- element isPetitFailure ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements addLast: element ].
- ^ elements asArray!! !!
-
-
-PPListParser subclass: #PPSequenceParser
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Parsers''!!
-!!PPSequenceParser commentStamp: ''lr 4/18/2008 15:34'' prior: 0!!
-A parser that parses a sequence of parsers.!!
-
-
-!!PPSequenceParser methodsFor: ''operators-mapping'' stamp: ''lr 5/6/2011 20:27''!!
-map: aBlock
- ^ aBlock numArgs = self children size
- ifTrue: [ self ==> [ :nodes | aBlock valueWithArguments: nodes ] ]
- ifFalse: [ self error: aBlock numArgs asString , '' arguments expected.'' ]!! !!
-
-!!PPSequenceParser methodsFor: ''operators-mapping'' stamp: ''lr 1/8/2010 12:01''!!
-permutation: anArrayOfIntegers
- "Answer a permutation of the receivers sequence."
-
- anArrayOfIntegers do: [ :index |
- (index isInteger and: [ index between: 1 and: parsers size ])
- ifFalse: [ self error: ''Invalid permutation index: '' , index printString ] ].
- ^ self ==> [ :nodes | anArrayOfIntegers collect: [ :index | nodes at: index ] ]!! !!
-
-
-!!PPSequenceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/17/2009 21:54''!!
-morphicShapeSeen: aSet depth: anInteger
- ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
- self children
- inject: self newRowMorph
- into: [ :result :each |
- result
- addMorphBack: (cc value: each);
- yourself ] ]!! !!
-
-
-!!PPSequenceParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:24''!!
-exampleOn: aStream
- parsers do: [ :each | each exampleOn: aStream ]!! !!
-
-
-!!PPSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:43''!!
-parseOn: aPPContext
- "This is optimized code that avoids unnecessary block activations, do not change."
-
- | start elements element |
- start := aPPContext remember.
- elements := Array new: parsers size.
- 1 to: parsers size do: [ :index |
- element := (parsers at: index)
- parseOn: aPPContext.
- element isPetitFailure ifTrue: [
- aPPContext restore: start.
- ^ element ].
- elements at: index put: element ].
- ^ elements!! !!
-
-
-!!PPSequenceParser methodsFor: ''operators'' stamp: ''lr 9/17/2008 00:17''!!
-, aRule
- ^ self copyWith: aRule!! !!
-
-
-!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 12/9/2010 10:37''!!
-cycleSet: aDictionary
- | firstSet |
- 1 to: parsers size do: [ :index |
- firstSet := aDictionary at: (parsers at: index).
- (firstSet anySatisfy: [ :each | each isNullable ])
- ifFalse: [ ^ parsers copyFrom: 1 to: index ] ].
- ^ parsers!! !!
-
-!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 9/16/2010 17:56''!!
-firstSets: aFirstDictionary into: aSet
- | nullable |
- parsers do: [ :parser |
- nullable := false.
- (aFirstDictionary at: parser) do: [ :each |
- each isNullable
- ifTrue: [ nullable := true ]
- ifFalse: [ aSet add: each ] ].
- nullable
- ifFalse: [ ^ self ] ].
- aSet add: PPSentinel instance!! !!
-
-!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 8/14/2010 13:51''!!
-followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
- parsers keysAndValuesDo: [ :index :parser |
- | followSet firstSet |
- followSet := aFollowDictionary at: parser.
- index = parsers size
- ifTrue: [ followSet addAll: aSet ]
- ifFalse: [
- (self class withAll: (parsers
- copyFrom: index + 1 to: parsers size))
- firstSets: aFirstDictionary
- into: (firstSet := IdentitySet new).
- (firstSet anySatisfy: [ :each | each isNullable ])
- ifTrue: [ followSet addAll: aSet ].
- followSet addAll: (firstSet
- reject: [ :each | each isNullable ]) ] ]!! !!
-
-
-!!PPSequenceParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
-visualizationGraphType
- ^ '',''!! !!
-Object subclass: #PPFailure
- instanceVariableNames: ''message context position''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPFailure commentStamp: ''<historical>'' prior: 0!!
-The failure object in PetitParser. It is the only class that responds to #isPetitFailure with true. It contains an error message and a position of the occurrence of the failure.
-
-Instance Variables:
- message <String> The error message of this failure.
- position <Integer> The position of this failure in the input stream.
-!!
-
-
-!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:39''!!
-sampleIn: composite
-
- (composite text)
- title: ''Sample'';
- display: [:res | res findStream contents ifNil: [''''] ];
- allowNil.!! !!
-
-!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:40''!!
-treeViewIn: composite
- composite tree
- title: ''Execution Traces'';
- format: [:resultNode | resultNode formattedText ];
- children: [:resultNode | resultNode showChildren
- ifTrue: [ resultNode children ]
- ifFalse: [ #() ] ]. !! !!
-
-!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:53''!!
-gtDebugView: composite
- <gtInspectorPresentationOrder: 40>
-
- | browser |
- browser :=
- composite tabulator.
-
- browser title: ''Debug View''.
- browser row: #tree;
- row: #source.
- browser transmit
- fromOutsideEntityPort;
- toOutsidePort: #debugResult;
- transformed: [ :failure | failure debugResult ].
-
- browser transmit
- from: #tree;
- to: #source port: #selectionInterval;
- transformed: [:debuggingResult |
- debuggingResult ifNotNil: [
- debuggingResult start to: debuggingResult end]
- ].
-
- browser transmit
- fromOutsidePort: #debugResult;
- to: #source;
- andShow: [ :a | self sampleIn: a ].
-
- browser transmit
- fromOutsidePort: #debugResult;
- to: #tree;
- andShow: [ :a | self treeViewIn: a ].
-
- browser startOn: self!! !!
-
-!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:54''!!
-debugResult
- ^ context root enableDebug parse: context stream reset!! !!
-
-
-!!PPFailure methodsFor: ''testing'' stamp: ''lr 2/7/2010 20:54''!!
-isPetitFailure
- "I am the only class that should implement this method to return true."
-
- ^ true!! !!
-
-
-!!PPFailure methodsFor: ''printing'' stamp: ''JanKurs 8/19/2014 16:30''!!
-printOn: aStream
- aStream nextPutAll: self message; nextPutAll: '' at ''; print: self position!! !!
-
-
-!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:57''!!
-initializeMessage: aString context: aPPContext
- self initializeMessage: aString context: aPPContext position: aPPContext position!! !!
-
-!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:33''!!
-initializeMessage: aString at: anInteger
- self halt: ''deprecated''.!! !!
-
-!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:57''!!
-initializeMessage: aString context: aPPContext position: position
- message := aString.
- context := aPPContext.
- position := position.!! !!
-
-
-!!PPFailure methodsFor: ''accessing'' stamp: ''lr 5/5/2010 13:56''!!
-message
- "Answer a human readable error message of this parse failure."
-
- ^ message!! !!
-
-!!PPFailure methodsFor: ''accessing'' stamp: ''lr 5/5/2010 13:55''!!
-position
- "Answer the position in the source string that caused this parse failure."
-
- ^ position!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPFailure class
- instanceVariableNames: ''''!!
-!!PPFailure class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:33''!!
-message: aString at: anInteger
- self halt: ''deprecated, use message:context:''.
- ^ self basicNew initializeMessage: aString at: anInteger!! !!
-
-!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:32''!!
-message: aString context: aPPContext
- ^ self basicNew initializeMessage: aString context: aPPContext!! !!
-
-!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:57''!!
-message: aString context: aPPContext at: position
- ^ self basicNew initializeMessage: aString context: aPPContext position: position!! !!
-
-
-ReadStream subclass: #PPStream
- instanceVariableNames: ''''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPStream commentStamp: ''<historical>'' prior: 0!!
-A positional stream implementation used for parsing. It overrides some methods for optimization reasons.!!
-
-
-!!PPStream methodsFor: ''accessing'' stamp: ''lr 4/29/2008 21:48''!!
-peek
- "An improved version of peek, that is slightly faster than the built in version."
-
- ^ self atEnd ifFalse: [ collection at: position + 1 ]!! !!
-
-!!PPStream methodsFor: ''accessing'' stamp: ''lr 10/5/2010 16:29''!!
-uncheckedPeek
- "An unchecked version of peek that throws an error if we try to peek over the end of the stream, even faster than #peek."
-
- ^ collection at: position + 1!! !!
-
-!!PPStream methodsFor: ''accessing'' stamp: ''lr 2/13/2012 20:25''!!
-collection
- "Answer the underlying collection."
-
- ^ collection!! !!
-
-!!PPStream methodsFor: ''accessing'' stamp: ''lr 8/25/2010 11:36''!!
-position: anInteger
- "The receiver does not check for invalid arguments passed to this method, as it is solely used with valid indexes for backtracking."
-
- position := anInteger!! !!
-
-
-!!PPStream methodsFor: ''printing'' stamp: ''lr 11/4/2010 19:23''!!
-printOn: aStream
- collection isString
- ifFalse: [ ^ super printOn: aStream ].
- aStream
- nextPutAll: (collection copyFrom: 1 to: position);
- nextPutAll: ''·'';
- nextPutAll: (collection copyFrom: position + 1 to: readLimit)!! !!
-
-
-!!PPStream methodsFor: ''converting'' stamp: ''lr 2/7/2010 20:53''!!
-asPetitStream
- ^ self!! !!
-
-
-Object subclass: #PPToken
- instanceVariableNames: ''collection start stop value''
- classVariableNames: ''NewLineParser''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPToken commentStamp: ''lr 2/25/2013 23:34'' prior: 0!!
-PPToken represents a parsed part of the input stream. Contrary to a simple String it remembers where it came from, the original collection, its start and stop position and its parse value.
-
-Instance Variables:
- collection <SequenceableCollection> The collection this token comes from.
- start <Integer> The start position in the collection.
- stop <Integer> The stop position in the collection.
- value <Object> The parse result.!!
-
-
-!!PPToken methodsFor: ''querying'' stamp: ''lr 9/7/2011 20:41''!!
-line
- "Answer the line number of this token in the underlying collection."
-
- | line |
- line := 1.
- (NewLineParser , [ :stream |
- start <= stream position
- ifTrue: [ ^ line ].
- line := line + 1 ] asParser
- / #any asParser) star
- parse: collection.
- ^ line!! !!
-
-!!PPToken methodsFor: ''querying'' stamp: ''lr 9/7/2011 20:40''!!
-column
- "Answer the column number of this token in the underlying collection."
-
- | position |
- position := 0.
- (NewLineParser , [ :stream |
- start <= stream position
- ifTrue: [ ^ start - position ].
- position := stream position ] asParser
- / #any asParser) star
- parse: collection.
- ^ start - position!! !!
-
-
-!!PPToken methodsFor: ''initialization'' stamp: ''lr 2/25/2013 23:36''!!
-initializeOn: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject
- collection := aSequenceableCollection.
- start := aStartInteger.
- stop := aStopInteger.
- value := anObject!! !!
-
-
-!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:33''!!
-stop
- "Answer the stop position of this token in the underlying collection."
-
- ^ stop!! !!
-
-!!PPToken methodsFor: ''accessing'' stamp: ''lr 2/25/2013 23:56''!!
-size
- "Answer the size of this token in the underlying collection."
-
- ^ stop - start + 1!! !!
-
-!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:34''!!
-collection
- "Answer the underlying collection of this token."
-
- ^ collection!! !!
-
-!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:33''!!
-start
- "Answer the start position of this token in the underlying collection."
-
- ^ start!! !!
-
-
-!!PPToken methodsFor: ''printing'' stamp: ''lr 2/26/2013 00:37''!!
-printOn: aStream
- super printOn: aStream.
- aStream nextPut: $[; print: self start; nextPut: $,; print: self stop; nextPut: $].
- aStream nextPut: $(; print: self parsedValue; nextPut: $)!! !!
-
-
-!!PPToken methodsFor: ''copying'' stamp: ''lr 2/26/2013 00:34''!!
-copyFrom: aStartInteger to: aStopInteger
- ^ self class on: collection start: start + aStartInteger - 1 stop: stop + aStopInteger - 3 value: value!! !!
-
-
-!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:34''!!
-value
- self notify: ''Token>>#value is no longer supported. Instead use Token>>#inputValue or the more pragmatic #parsedValue.''.
- ^ self inputValue!! !!
-
-!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:32''!!
-inputValue
- "Answer the consumed input of this token."
-
- ^ collection copyFrom: start to: stop!! !!
-
-!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:32''!!
-parsedValue
- "Answer the parsed value of this token."
-
- ^ value!! !!
-
-
-!!PPToken methodsFor: ''comparing'' stamp: ''lr 2/26/2013 00:34''!!
-= anObject
- ^ self class = anObject class and: [ self parsedValue = anObject parsedValue ]!! !!
-
-!!PPToken methodsFor: ''comparing'' stamp: ''lr 2/26/2013 00:34''!!
-hash
- ^ self parsedValue hash!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPToken class
- instanceVariableNames: ''''!!
-!!PPToken class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPToken class methodsFor: ''initialization'' stamp: ''lr 11/29/2011 20:42''!!
-initialize
- "Platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple."
-
- NewLineParser := (Character lf asParser) / (Character cr asParser , Character lf asParser optional)!! !!
-
-
-!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 2/25/2013 23:39''!!
-on: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject
- ^ self basicNew
- initializeOn: aSequenceableCollection
- start: aStartInteger stop: aStopInteger
- value: anObject!! !!
-
-!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 2/25/2013 23:36''!!
-on: aSequenceableCollection
- ^ self on: aSequenceableCollection start: 1 stop: aSequenceableCollection size value: nil!! !!
-
-!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 4/6/2010 20:58''!!
-new
- self error: ''Token can only be created using a dedicated constructor.''!! !!
-
-
-Object subclass: #PPContextMemento
- instanceVariableNames: ''stream position properties''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPContextMemento commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPContextMemento methodsFor: ''comparing'' stamp: ''JanKurs 3/19/2014 13:03''!!
-= anObject
-
- (self == anObject) ifTrue: [ ^ true ].
- (anObject class = PPContextMemento) ifFalse: [ ^ false ].
-
- (anObject stream == stream) ifFalse: [ ^ false ].
- (anObject position = position) ifFalse: [ ^ false ].
- (anObject properties = properties) ifFalse: [ ^ false ].
-
- ^ true.
-!! !!
-
-!!PPContextMemento methodsFor: ''comparing'' stamp: ''JanKurs 3/19/2014 13:04''!!
-hash
- ^ (position hash bitXor: stream hash) bitXor: properties hash.!! !!
-
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
-propertyAt: aKey ifAbsentPut: aBlock
- "Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value."
-
- ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
-removeProperty: aKey ifAbsent: aBlock
- "Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock."
-
- | answer |
- properties isNil ifTrue: [ ^ aBlock value ].
- answer := properties removeKey: aKey ifAbsent: aBlock.
- properties isEmpty ifTrue: [ properties := nil ].
- ^ answer!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:14''!!
-propertyAt: aKey
- "Answer the property value associated with aKey."
-
- ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
-propertyAt: aKey ifAbsent: aBlock
- "Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock."
-
- ^ properties isNil
- ifTrue: [ aBlock value ]
- ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
-propertyAt: aKey put: anObject
- "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
-
- ^ (properties ifNil: [ properties := Dictionary new: 1 ])
- at: aKey put: anObject!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:14''!!
-hasProperty: aKey
- "Test if the property aKey is present."
-
- ^ properties notNil and: [ properties includesKey: aKey ]!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
-removeProperty: aKey
- "Remove the property with aKey. Answer the property or raise an error if aKey isn''t found."
-
- ^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
-
-!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 13:04''!!
-properties
- ^ properties !! !!
-
-
-!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:52''!!
-stream: aStream
- stream := aStream!! !!
-
-!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:51''!!
-position
- ^ position!! !!
-
-!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:52''!!
-position: anInteger
- position := anInteger !! !!
-
-!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:51''!!
-stream
- ^ stream!! !!
-
-
-Object subclass: #PPContext
- instanceVariableNames: ''stream root properties''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPContext commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:27''!!
-remember
- | memento |
- memento := PPContextMemento new
- stream: stream;
- position: stream position;
- yourself.
-
- self rememberProperties: memento.
- ^ memento!! !!
-
-!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:26''!!
-restore: aPPContextMemento
- aPPContextMemento stream == stream ifFalse: [ self error: ''Oops!!!!'' ].
-
- stream position: aPPContextMemento position.
- self restoreProperties: aPPContextMemento.!! !!
-
-!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:29''!!
-restoreProperties: aPPContextMemento
- aPPContextMemento stream == stream ifFalse: [ self error: ''Oops!!!!'' ].
-
- aPPContextMemento class selectorsAndMethodsDo: [ :selector :method |
- (selector beginsWith: ''restore'') ifTrue: [
- aPPContextMemento withArgs: (Array with: self) executeMethod: method.
- ]
- ]!! !!
-
-!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:28''!!
-rememberProperties: aPPContextMemento
- aPPContextMemento class selectorsAndMethodsDo: [ :selector :method |
- (selector beginsWith: ''remember'') ifTrue: [
- aPPContextMemento withArgs: (Array with: self) executeMethod: method.
- ]
- ]
-!! !!
-
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:25''!!
-peekTwice
- ^ stream peekTwice!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:02''!!
-position
- ^ stream position!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
-uncheckedPeek
- ^ stream uncheckedPeek!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:11''!!
-upTo: anObject
- ^ stream upTo: anObject!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
-collection
- ^ stream collection !! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/16/2014 12:13''!!
-atEnd
- ^ stream atEnd!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:24''!!
-peek
- ^ stream peek!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:29''!!
-upToAll: whatever
- ^ stream upToAll: whatever!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
-skip: anInteger
- ^ stream skip: anInteger !! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:31''!!
-upToAnyOf: whatever
- ^ stream upToAnyOf: whatever!! !!
-
-!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:02''!!
-next
- ^ stream next!! !!
-
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-propertyAt: aKey ifAbsentPut: aBlock
- "Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value."
-
- ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-removeProperty: aKey ifAbsent: aBlock
- "Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock."
-
- | answer |
- properties isNil ifTrue: [ ^ aBlock value ].
- answer := properties removeKey: aKey ifAbsent: aBlock.
- properties isEmpty ifTrue: [ properties := nil ].
- ^ answer!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-propertyAt: aKey
- "Answer the property value associated with aKey."
-
- ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-propertyAt: aKey ifAbsent: aBlock
- "Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock."
-
- ^ properties isNil
- ifTrue: [ aBlock value ]
- ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-propertyAt: aKey put: anObject
- "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
-
- ^ (properties ifNil: [ properties := Dictionary new: 1 ])
- at: aKey put: anObject!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-hasProperty: aKey
- "Test if the property aKey is present."
-
- ^ properties notNil and: [ properties includesKey: aKey ]!! !!
-
-!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
-removeProperty: aKey
- "Remove the property with aKey. Answer the property or raise an error if aKey isn''t found."
-
- ^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
-
-
-!!PPContext methodsFor: ''initialization'' stamp: ''JanKurs 1/16/2014 11:24''!!
-initialize
- stream := nil.!! !!
-
-
-!!PPContext methodsFor: ''as yet unclassified'' stamp: ''JanKurs 3/19/2014 16:26''!!
-parsed: aPPParser at: anInteger result: anObject
- self halt.
- ^ anObject!! !!
-
-
-!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 10/29/2013 10:13''!!
-root: aPPParser
- root := aPPParser !! !!
-
-!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 10/29/2013 10:13''!!
-root
- ^ root !! !!
-
-!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 1/15/2014 15:36''!!
-stream: aStream
- stream := aStream.!! !!
-
-!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 1/16/2014 15:12''!!
-stream
- ^ stream!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPContext class
- instanceVariableNames: ''''!!
-!!PPContext class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPContext class methodsFor: ''as yet unclassified'' stamp: ''JanKurs 1/16/2014 14:38''!!
-on: aPPParser stream: aStream
- ^ self basicNew
- initialize;
- root: aPPParser;
- stream: aStream asPetitStream;
- yourself!! !!
-
-
-Object subclass: #PPMemento
- instanceVariableNames: ''result count context''
- classVariableNames: ''''
- poolDictionaries: ''''
- category: ''PetitParser-Core''!!
-!!PPMemento commentStamp: ''<historical>'' prior: 0!!
-PPMemento is an internal class used by PPMemoizedParser to cache results and detect left-recursive calls.
-
-Instance Variables:
- result <Object> The cached result.
- count <Integer> The number of recursive cycles followed.
- position <Integer> The position of the cached result in the input stream.!!
-
-
-!!PPMemento methodsFor: ''accessing'' stamp: ''JanKurs 1/15/2014 16:09''!!
-contextMemento: aPPContextMemento
- context := aPPContextMemento
-!! !!
-
-!!PPMemento methodsFor: ''accessing'' stamp: ''JanKurs 1/15/2014 16:09''!!
-contextMemento
- ^ context!! !!
-
-!!PPMemento methodsFor: ''accessing'' stamp: ''lr 4/24/2008 10:15''!!
-result
- ^ result!! !!
-
-!!PPMemento methodsFor: ''accessing'' stamp: ''lr 4/22/2008 18:23''!!
-result: anObject
- result := anObject!! !!
-
-
-!!PPMemento methodsFor: ''accessing-readonly'' stamp: ''lr 4/22/2008 18:23''!!
-count
- ^ count!! !!
-
-
-!!PPMemento methodsFor: ''initialization'' stamp: ''lr 4/22/2008 18:21''!!
-initialize
- count := 0
- !! !!
-
-
-!!PPMemento methodsFor: ''actions'' stamp: ''lr 4/22/2008 18:20''!!
-increment
- count := count + 1!! !!
-
-"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
-
-PPMemento class
- instanceVariableNames: ''''!!
-!!PPMemento class commentStamp: ''<historical>'' prior: 0!!
-!!
-
-
-!!PPMemento class methodsFor: ''instance creation'' stamp: ''lr 4/22/2008 18:21''!!
-new
- ^ self basicNew initialize!! !!
-
-PPToken initialize!!''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!SequenceableCollection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 2/7/2010 20:53''!!
-asPetitStream
- ^ PPStream on: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Character methodsFor: ''*petitparser-core-operators'' stamp: ''lr 6/12/2010 09:04''!!
-- aCharacter
- "Create a range of characters between the receiver and the argument."
-
- ^ PPPredicateObjectParser between: self and: aCharacter!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Character methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
-asParser
- "Answer a parser that accepts the receiving character."
-
- ^ PPLiteralObjectParser on: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!PositionableStream methodsFor: ''*petitparser-core'' stamp: ''sback 9/3/2010 10:00''!!
-peekTwice
- "Answer what would be returned if the message next were sent to the
- receiver. If the receiver is at the end, answer nil."
-
- | array |
- self atEnd
- ifTrue: [^Array with: nil with: nil].
- array := Array with: (self next) with: (self peek).
- position := position - 1.
- ^array!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Stream methodsFor: ''*petitparser-core-converting'' stamp: ''lr 4/8/2010 14:46''!!
-asPetitStream
- ^ self contents asPetitStream!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Symbol methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
-asParser
- "Answer a predicate parser named after the receiving symbol. Possible symbols are the method selectors on the class-side of PPPredicateObjectParser."
-
- ^ PPPredicateObjectParser perform: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!String methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:48''!!
-asParser
- "Answer a parser that accepts the receiving string."
-
- ^ PPLiteralSequenceParser on: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!BlockClosure methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:48''!!
-asParser
- "Answer a parser implemented in the receiving one-argument block."
-
- ^ PPPluggableParser on: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!UndefinedObject methodsFor: ''*petitparser-converting'' stamp: ''lr 11/29/2011 20:49''!!
-asParser
- "Answer a parser that succeeds and does not consume anything."
-
- ^ PPEpsilonParser new!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Text methodsFor: ''*petitparser-core-converting'' stamp: ''lr 2/7/2010 20:53''!!
-asPetitStream
- ^ string asPetitStream!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Collection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:38''!!
-asChoiceParser
- ^ PPChoiceParser withAll: (self collect: [ :each | each asParser ])!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Collection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:38''!!
-asSequenceParser
- ^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Object methodsFor: ''*petitparser-core-testing'' stamp: ''lr 8/6/2010 16:44''!!
-isPetitParser
- ^ false!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
-
-!!Object methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
-asParser
- "Answer a parser accepting the receiving object."
-
- ^ PPPredicateObjectParser expect: self!! !!
-''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.314418 pm''!!
-
-!!Object methodsFor: ''*petitparser-core-testing'' stamp: ''lr 2/7/2010 20:54''!!
-isPetitFailure
- ^ false!! !!
-'
-!
-
-smalltalkObjectMethods
- ^ Object allMethods collect: [ :m | m sourceCode ].
-!
-
-smalltalkSourcesBig
- ^ ((Smalltalk allClasses copyFrom: 1 to: 30) collect: [ :c |
- c allMethods collect: [ :m | m sourceCode ]
- ]) gather: [:each | each ].
-!
-
-workingJavaInDirectory: directory
- | sources parser |
- "return only such a files, that can be parsed by PPJavaSyntax"
-
- javaCache ifNil: [ javaCache := Dictionary new ].
-
- ^ javaCache at: directory ifAbsentPut: [
- sources := self javaInDirectory: directory.
- parser := PPJavaSyntax new.
-
- sources select: [ :source | ([parser parse: source ] on: Error do: [ PPFailure new ]) isPetitFailure not ]
- ]
-! !
-
-!PPCBenchmarkResources methodsFor:'private utilities'!
-
-files: files withExtension: extension
- ^ files select: [ :f | f extension = extension ]
-!
-
-readDirectory: directory
- | file |
- file := directory asFileReference.
- file exists ifTrue: [
- ^ file allFiles
- ].
- ^ #()
-! !
-
--- a/compiler/PPCProfilingContext.st Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/PPCProfilingContext.st Wed Nov 19 10:52:37 2014 +0000
@@ -7,6 +7,7 @@
category:'PetitCompiler-Context'
!
+
!PPCProfilingContext methodsFor:'gt'!
gtReport: composite
@@ -137,3 +138,10 @@
^ restores size
! !
+!PPCProfilingContext class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/compiler/abbrev.stc Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/abbrev.stc Wed Nov 19 10:52:37 2014 +0000
@@ -1,8 +1,6 @@
# automagically generated by the project definition
# this file is needed for stc to be able to compile modules independently.
# it provides information about a classes filename, category and especially namespace.
-PPCBenchmark PPCBenchmark stx:goodies/petitparser/compiler 'PetitCompiler-Benchmarks' 0
-PPCBenchmarkResources PPCBenchmarkResources stx:goodies/petitparser/compiler 'PetitCompiler-Benchmarks' 0
PPCBridge PPCBridge stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCCompiledMethod PPCCompiledMethod stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
PPCCompiler PPCCompiler stx:goodies/petitparser/compiler 'PetitCompiler-Core' 0
--- a/compiler/bc.mak Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/bc.mak Wed Nov 19 10:52:37 2014 +0000
@@ -30,11 +30,12 @@
!INCLUDE Make.spec
LIBNAME=libstx_goodies_petitparser_compiler
+MODULE_PATH=goodies\petitparser\compiler
RESFILES=compiler.$(RES)
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
@@ -71,8 +72,6 @@
# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
-$(OUTDIR)PPCBenchmark.$(O) PPCBenchmark.$(H): PPCBenchmark.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
-$(OUTDIR)PPCBenchmarkResources.$(O) PPCBenchmarkResources.$(H): PPCBenchmarkResources.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCBridge.$(O) PPCBridge.$(H): PPCBridge.st $(INCLUDE_TOP)\stx\goodies\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompiledMethod.$(O) PPCCompiledMethod.$(H): PPCCompiledMethod.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
$(OUTDIR)PPCCompiler.$(O) PPCCompiler.$(H): PPCCompiler.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/Make.proto Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,129 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_petitparser_compiler_benchmarks.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# The Makefile as generated by this Make.proto supports the following targets:
+# make - compile all st-files to a classLib
+# make clean - clean all temp files
+# make clobber - clean all
+#
+# This file contains definitions for Unix based platforms.
+# It shares common definitions with the win32-make in Make.spec.
+
+#
+# position (of this package) in directory hierarchy:
+# (must point to ST/X top directory, for tools and includes)
+TOP=../../../..
+INCLUDE_TOP=$(TOP)/..
+
+# subdirectories where targets are to be made:
+SUBDIRS=
+
+
+# subdirectories where Makefiles are to be made:
+# (only define if different from SUBDIRS)
+# ALLSUBDIRS=
+
+REQUIRED_SUPPORT_DIRS=
+
+# if your embedded C code requires any system includes,
+# add the path(es) here:,
+# ********** OPTIONAL: MODIFY the next lines ***
+# LOCALINCLUDES=-Ifoo -Ibar
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/compiler -I$(INCLUDE_TOP)/stx/goodies/petitparser/parsers/smalltalk -I$(INCLUDE_TOP)/stx/goodies/refactoryBrowser/parser -I$(INCLUDE_TOP)/stx/libbasic
+
+
+# if you need any additional defines for embedded C code,
+# add them here:,
+# ********** OPTIONAL: MODIFY the next lines ***
+# LOCALDEFINES=-Dfoo -Dbar -DDEBUG
+LOCALDEFINES=
+
+LIBNAME=libstx_goodies_petitparser_compiler_benchmarks
+STCLOCALOPT='-package=$(PACKAGE)' -I. $(LOCALINCLUDES) $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -headerDir=. -varPrefix=$(LIBNAME)
+
+
+# ********** OPTIONAL: MODIFY the next line ***
+# additional C-libraries that should be pre-linked with the class-objects
+LD_OBJ_LIBS=
+LOCAL_SHARED_LIBS=
+
+
+# ********** OPTIONAL: MODIFY the next line ***
+# additional C targets or libraries should be added below
+LOCAL_EXTRA_TARGETS=
+
+OBJS= $(COMMON_OBJS) $(UNIX_OBJS)
+
+
+
+all:: preMake classLibRule postMake
+
+pre_objs::
+
+
+
+
+
+
+# Enforce recompilation of package definition class if Mercurial working
+# copy state changes. Together with --guessVersion it ensures that package
+# definition class always contains correct binary revision string.
+ifneq (**NOHG**, $(shell hg root 2> /dev/null || echo -n '**NOHG**'))
+stx_goodies_petitparser_compiler_benchmarks.$(O): $(shell hg root)/.hg/dirstate
+endif
+
+
+
+
+# run default testsuite for this package
+test: $(TOP)/goodies/builder/reports
+ $(MAKE) -C $(TOP)/goodies/builder/reports -f Makefile.init
+ $(TOP)/goodies/builder/reports/report-runner.sh -D . -r Builder::TestReport -p $(PACKAGE)
+
+
+
+# add more install actions here
+install::
+
+# add more install actions for aux-files (resources) here
+installAux::
+
+# add more preMake actions here
+preMake::
+
+# add more postMake actions here
+postMake:: cleanjunk
+
+# build all mandatory prerequisite packages (containing superclasses) for this package
+prereq:
+ cd ../../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+
+
+
+# build all packages containing referenced classes for this package
+# they are nor needed to compile the package
+references:
+
+
+cleanjunk::
+ -rm -f *.s *.s2
+
+clean::
+ -rm -f *.o *.H
+
+clobber:: clean
+ -rm -f *.so *.dll
+
+
+# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PPCBenchmark.$(O) PPCBenchmark.$(H): PPCBenchmark.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCBenchmarkResources.$(O) PPCBenchmarkResources.$(H): PPCBenchmarkResources.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)stx_goodies_petitparser_compiler_benchmarks.$(O) stx_goodies_petitparser_compiler_benchmarks.$(H): stx_goodies_petitparser_compiler_benchmarks.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(STCHDR)
+
+# ENDMAKEDEPEND --- do not remove this line
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/Make.spec Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,67 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_petitparser_compiler_benchmarks.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# This file contains specifications which are common to all platforms.
+#
+
+# Do NOT CHANGE THESE DEFINITIONS
+# (otherwise, ST/X will have a hard time to find out the packages location from its packageID,
+# to find the source code of a class and to find the library for a package)
+MODULE=stx
+MODULE_DIR=goodies/petitparser/compiler/benchmarks
+PACKAGE=$(MODULE):$(MODULE_DIR)
+
+
+# Argument(s) to the stc compiler (stc --usage).
+# -headerDir=. : create header files locally
+# (if removed, they will be created as common
+# -Pxxx : defines the package
+# -Zxxx : a prefix for variables within the classLib
+# -Dxxx : defines passed to to CC for inline C-code
+# -Ixxx : include path passed to CC for inline C-code
+# +optspace : optimized for space
+# +optspace2 : optimized more for space
+# +optspace3 : optimized even more for space
+# +optinline : generate inline code for some ST constructs
+# +inlineNew : additionally inline new
+# +inlineMath : additionally inline some floatPnt math stuff
+#
+# ********** OPTIONAL: MODIFY the next line(s) ***
+# STCLOCALOPTIMIZATIONS=+optinline +inlineNew
+# STCLOCALOPTIMIZATIONS=+optspace3
+STCLOCALOPTIMIZATIONS=+optspace3
+
+
+# Argument(s) to the stc compiler (stc --usage).
+# -warn : no warnings
+# -warnNonStandard : no warnings about ST/X extensions
+# -warnEOLComments : no warnings about EOL comment extension
+# -warnPrivacy : no warnings about privateClass extension
+# -warnUnused : no warnings about unused variables
+#
+# ********** OPTIONAL: MODIFY the next line(s) ***
+# STCWARNINGS=-warn
+# STCWARNINGS=-warnNonStandard
+# STCWARNINGS=-warnEOLComments
+STCWARNINGS=-warnNonStandard
+
+COMMON_CLASSES= \
+ PPCBenchmark \
+ PPCBenchmarkResources \
+ stx_goodies_petitparser_compiler_benchmarks \
+
+
+
+
+COMMON_OBJS= \
+ $(OUTDIR_SLASH)PPCBenchmark.$(O) \
+ $(OUTDIR_SLASH)PPCBenchmarkResources.$(O) \
+ $(OUTDIR_SLASH)stx_goodies_petitparser_compiler_benchmarks.$(O) \
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/Makefile.init Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,27 @@
+#
+# DO NOT EDIT
+#
+# make uses this file (Makefile) only, if there is no
+# file named "makefile" (lower-case m) in the same directory.
+# My only task is to generate the real makefile and call make again.
+# Thereafter, I am no longer used and needed.
+#
+# MACOSX caveat:
+# as filenames are not case sensitive (in a default setup),
+# we cannot use the above trick. Therefore, this file is now named
+# "Makefile.init", and you have to execute "make -f Makefile.init" to
+# get the initial makefile. This is now also done by the toplevel CONFIG
+# script.
+
+.PHONY: run
+
+run: makefile
+ $(MAKE) -f makefile
+
+#only needed for the definition of $(TOP)
+include Make.proto
+
+makefile: mf
+
+mf:
+ $(TOP)/rules/stmkmf
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/PPCBenchmark.st Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,435 @@
+"{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }"
+
+Object subclass:#PPCBenchmark
+ instanceVariableNames:'sources report contextClass compile parser context input'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitCompiler-Benchmarks'
+!
+
+!PPCBenchmark class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
+! !
+
+!PPCBenchmark class methodsFor:'benchmarking-CalipeL'!
+
+run
+ | benchmarkSuiteClass |
+
+ benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.
+ benchmarkSuiteClass isNil ifTrue:[
+ self error: 'CalipeL is not loaded.'
+ ].
+ ^ (benchmarkSuiteClass class:self) run
+
+ "
+ PPCBenchmark run.
+ "
+!
+
+run: selector
+ | benchmarkSuiteClass |
+
+ benchmarkSuiteClass := Smalltalk at: #BenchmarkSuite.
+ benchmarkSuiteClass isNil ifTrue:[
+ self error: 'CalipeL is not loaded.'
+ ].
+ ^ (benchmarkSuiteClass class:self selector: selector ) run
+
+ "
+ PPCBenchmark run: #benchmarkRBParserC
+ "
+! !
+
+!PPCBenchmark methodsFor:'benchmark support'!
+
+createContext
+ ^ contextClass new
+!
+
+endSuite
+!
+
+initialize
+ super initialize.
+ sources := PPCBenchmarkResources new.
+ contextClass := PPCContext.
+ compile := false.
+!
+
+measure: parser on: input
+ self measure: parser on: input name: #unknown
+!
+
+measure: aParser on: anInput name: aString
+ | time result p |
+ context := self createContext.
+
+ compile ifTrue: [
+ p := (aParser end compile: #TmpBenchmark)
+ ] ifFalse: [
+ p := aParser end.
+ ].
+
+
+ time := Time millisecondsToRun: [ result := p parse: anInput withContext: context ].
+
+ self assert: result isPetitFailure not.
+ self reportFor: aParser context: context input: anInput time: time name: aString.
+!
+
+measure: parser onSources: inputs name: aString
+ | time result context p totalInput |
+
+ compile ifTrue: [
+ p := (parser end compile: #TmpBenchmark)
+ ] ifFalse: [
+ p := parser end.
+ ].
+
+ totalInput := ''.
+ time := 0.
+ inputs do: [:input |
+ context := self createContext.
+ time := time + (Time millisecondsToRun: [ result := p parse: input withContext: context ]).
+ totalInput := totalInput, input.
+ self assert: result isPetitFailure not.
+ ].
+
+
+ self reportFor: parser context: context input: totalInput time: time name: aString.
+!
+
+reportFor: parser context: context input: input time: time
+ self reportFor: parser context: context input: input time: time name: #unknown
+!
+
+reportFor: aParser context: aContext input: anInput time: time name: name
+ Transcript crShow: (self getMetaInfo: name).
+ Transcript crShow: ' Compile: ', compile asString.
+
+ Transcript crShow: ' Total time: ', time asString, ' ms'.
+
+ Transcript crShow: ' Time per character: ',
+ (((time / anInput size) asFloat * 1000) asString truncateTo: 6),
+ ' microseconds'.
+
+" Transcript crShow: ' Backtrack per character: ',
+ ((aContext backtrackCount / anInput size) asFloat asString truncateTo: 6),
+ '.'.
+
+ Transcript crShow: ' Remembers per character: ',
+ ((aContext rememberCount / input size) asFloat asString truncateTo: 6),
+ '.'.
+"
+!
+
+startSuite
+ Transcript crShow: Date current asString, ' ', Time current asString.
+! !
+
+!PPCBenchmark methodsFor:'benchmarks'!
+
+benchmarkAnyStar
+"
+ self measure: self anyStar on: sources petitParserPackage.
+"
+ self measure: self anyStar on: (sources changesSized: 1000*1000) name: #anyStar.
+!
+
+benchmarkAnyStarBlock
+"
+ self measure: self anyStar on: sources petitParserPackage.
+"
+ self measure: self anyStarBlock on: (sources changesSized: 1000*1000) name: #anyStarBlock.
+!
+
+benchmarkAttributes
+ | string text allStyles |
+ string := (self changesSized: 60000).
+ text := string asText.
+ allStyles := {
+ 'Announcement' -> TextColor green.
+ 'Collections' -> TextColor blue.
+ 'File' -> TextColor blue.
+ 'Metacello' -> TextColor red.
+ 'Monticello' -> TextColor magenta.
+ 'Morphic' -> TextColor orange.
+ 'Mooose' -> TextColor green.
+ 'FAMIX' -> TextColor green.
+ 'Roassal' -> TextColor green.
+ }.
+
+ allStyles do: [ :assoc | | parser result time |
+ parser := (assoc key asParser, #newline asParser negate star).
+ time := Time millisecondsToRun: [
+ result := parser matchingRangesIn: string.
+ ].
+ self reportFor: parser input: string time: time.
+ ].
+!
+
+benchmarkBacktrack
+"
+ self measure: self anyStar on: sources petitParserPackage.
+"
+ | parser |
+ parser := ((#any asParser, 'foo' asParser) / self tokenParser / #any asParser) plus.
+ self measure: parser on: (self changesSized: 100*1000) name: #backtrack.
+!
+
+benchmarkJava
+ | parser |
+ parser := PPJavaParser new.
+ self measure: parser on: sources javaLangMath name: #java.
+!
+
+benchmarkNegate
+"
+ self measure: self anyStar on: sources petitParserPackage.
+"
+ | parser |
+ parser := ('a' asParser negate star, 'a' asParser) star, #any asParser star.
+ self measure: parser on: (self changesSized: 1000*1000) name: #negate.
+!
+
+benchmarkOpalCompiler
+ | parser time input |
+ parser := OpalCompiler new.
+ input := sources smalltalkSourcesBig.
+ time := [ input do: [ :source | parser parse: source ]] timeToRun asMilliseconds.
+
+ self reportInput: input time: time name: 'Opal'
+!
+
+benchmarkSmalltalkGrammar
+ | time |
+
+ parser := PPSmalltalkGrammar new.
+ context := PPContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+
+ time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+
+ self reportInput: input time: time name: 'Smalltalk Grammar'.
+!
+
+benchmarkSmalltalkGrammarCompiled
+ | time |
+ parser := PPSmalltalkGrammar new compile.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+
+ time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+
+ self reportInput: input time: time name: 'Compiled Grammar'.
+
+"
+ size := input inject: 0 into: [:r :e | r + e size ].
+ Transcript crShow: 'Compiled Grammar time: ', time asString.
+ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
+!
+
+benchmarkSmalltalkObject
+ | parser |
+ parser := PPSmalltalkGrammar new.
+ self measure: parser onSources: sources smalltalkObjectMethods name: #smalltalkObject.
+!
+
+benchmarkSmalltalkParser
+ | time |
+ parser := PPSmalltalkParser new.
+ context := PPContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+
+ time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+
+ self reportInput: input time: time name: 'Smalltalk Parser'.
+!
+
+benchmarkSmalltalkParserCompiled
+ | time |
+ parser := PPSmalltalkParser new compile.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+
+ time := [ input do: [ :source | parser parse: source withContext: context ]] timeToRun asMilliSeconds.
+
+ self reportInput: input time: time name: 'Smalltalk Parser Compiled'.
+!
+
+benchmarkToken
+"
+ self measure: self anyStar on: sources petitParserPackage.
+"
+ | parser |
+ parser := (self tokenParser / #any asParser) star.
+ self measure: parser on: (self changesSized: 1000*1000) name: #token.
+!
+
+reportInput: input time: time name: name
+ | size |
+ size := input inject: 0 into: [:r :e | r + e size ].
+ Transcript crShow: 'Size: ', size asString.
+ Transcript crShow: name, ' time: ', time asString.
+ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+! !
+
+!PPCBenchmark methodsFor:'benchmarks-CalipeL'!
+
+benchmarkRBParserC
+ <setup: #setupRBParserC>
+ <benchmark: 'RB Smalltalk Parser'>
+
+ input do: [ :source | RBParser parseMethod: source ]
+!
+
+benchmarkSmalltalkParserC
+ <setup: #setupSmalltalkParserC>
+ <benchmark: 'Petit Smalltalk Parser - Standard'>
+
+ input do: [ :source | parser parse: source withContext: context ]
+!
+
+benchmarkSmalltalkParserCompiledC
+ <setup: #setupSmalltalkParserCompiledC>
+ <teaddown: #teardownSmalltalkParserCompiledC>
+ <benchmark: 'Petit Smalltalk Parser - Compiled'>
+
+ input do: [ :source | parser parse: source withContext: context ]
+
+! !
+
+!PPCBenchmark methodsFor:'meta'!
+
+getMetaInfo: key
+ | info |
+ info := self metaInfo select: [ :each | each key = key ].
+ info isEmpty ifTrue: [ ^ 'unknown benchmark' ].
+ ^ info anyOne value
+!
+
+metaInfo
+ ^ {
+ #anyStar -> '.* Parser'.
+ #token -> 'Token Parser'.
+ #anyStarBlock -> 'context next in loop'.
+ }
+! !
+
+!PPCBenchmark methodsFor:'parsers'!
+
+anyStar
+ ^ #any asParser star
+!
+
+anyStarBlock
+ ^ [ :ctx | [ctx atEnd] whileFalse: [ ctx next ] ] asParser
+!
+
+tokenParser
+ ^ #letter asParser, (#letter asParser / #digit asParser) star trim
+! !
+
+!PPCBenchmark methodsFor:'settings'!
+
+compile: aBoolean
+ compile := aBoolean
+!
+
+contextClass: aClass
+ contextClass := aClass
+! !
+
+!PPCBenchmark methodsFor:'setup & teardown-CalipeL'!
+
+setupJavaSyntaxCompiledC
+ parser := PPJavaSyntax new compile.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources javaSourcesBig.
+
+"
+ size := input inject: 0 into: [:r :e | r + e size ].
+ Transcript crShow: 'Compiled Grammar time: ', time asString.
+ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
+!
+
+setupRBParserC
+
+ input := sources smalltalkSourcesBig.
+!
+
+setupSmalltalkParserC
+
+ parser := PPSmalltalkParser new.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+!
+
+setupSmalltalkParserCompiledC
+ parser := PPSmalltalkParser new compile.
+ context := PPCContext new.
+ context initializeFor: parser.
+ input := sources smalltalkSourcesBig.
+
+"
+ size := input inject: 0 into: [:r :e | r + e size ].
+ Transcript crShow: 'Compiled Grammar time: ', time asString.
+ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
+!
+
+teardownJavaSyntaxCompiledC
+ parser class removeFromSystem.
+"
+ size := input inject: 0 into: [:r :e | r + e size ].
+ Transcript crShow: 'Compiled Grammar time: ', time asString.
+ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
+!
+
+teardownSmalltalkParserCompiledC
+ parser class removeFromSystem.
+"
+ size := input inject: 0 into: [:r :e | r + e size ].
+ Transcript crShow: 'Compiled Grammar time: ', time asString.
+ Transcript crShow: 'Time per character: ', (time / size * 1000.0) asString, ' microseconds'.
+"
+! !
+
+!PPCBenchmark methodsFor:'sources'!
+
+changesSized: size
+ | string changes |
+ changes := PharoFilesOpener default changesFileOrNil contents.
+ string := changes copyFrom: 1 to: size.
+ ^ string
+
+! !
+
+!PPCBenchmark methodsFor:'suites'!
+
+suite1
+ self startSuite.
+
+ self benchmarkNegate.
+ self benchmarkBacktrack.
+ self benchmarkToken.
+ self benchmarkAnyStar.
+ self benchmarkJava.
+
+ self endSuite.
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/PPCBenchmarkResources.st Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,5216 @@
+"{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }"
+
+Object subclass:#PPCBenchmarkResources
+ instanceVariableNames:''
+ classVariableNames:'javaCache'
+ poolDictionaries:''
+ category:'PetitCompiler-Benchmarks'
+!
+
+!PPCBenchmarkResources methodsFor:'as yet unclassified'!
+
+changesSized: size
+ | string changes |
+ changes := PharoFilesOpener default changesFileOrNil contents.
+ string := changes copyFrom: 1 to: size.
+ ^ string
+
+!
+
+javaInDirectory: directory
+ | files |
+ files := self readDirectory: directory.
+ files := self files: files withExtension: 'java'.
+
+ ^ files collect: [ :f | (FileStream fileNamed: f) contents ]
+!
+
+javaLangClass
+!
+
+javaLangMath
+ ^ '/*
+ * @(#)Math.java 1.69 04/06/14
+ *
+ * Copyright 2004 Sun Microsystems, Inc. All rights reserved.
+ * SUN PROPRIETARY/CONFIDENTIAL. Use is subject to license terms.
+ */
+
+package java.lang;
+import java.util.Random;
+
+
+/**
+ * The class <code>Math</code> contains methods for performing basic
+ * numeric operations such as the elementary exponential, logarithm,
+ * square root, and trigonometric functions.
+ *
+ * <p>Unlike some of the numeric methods of class
+ * <code>StrictMath</code>, all implementations of the equivalent
+ * functions of class <code>Math</code> are not defined to return the
+ * bit-for-bit same results. This relaxation permits
+ * better-performing implementations where strict reproducibility is
+ * not required.
+ *
+ * <p>By default many of the <code>Math</code> methods simply call
+ * the equivalent method in <code>StrictMath</code> for their
+ * implementation. Code generators are encouraged to use
+ * platform-specific native libraries or microprocessor instructions,
+ * where available, to provide higher-performance implementations of
+ * <code>Math</code> methods. Such higher-performance
+ * implementations still must conform to the specification for
+ * <code>Math</code>.
+ *
+ * <p>The quality of implementation specifications concern two
+ * properties, accuracy of the returned result and monotonicity of the
+ * method. Accuracy of the floating-point <code>Math</code> methods
+ * is measured in terms of <i>ulps</i>, units in the last place. For
+ * a given floating-point format, an ulp of a specific real number
+ * value is the distance between the two floating-point values
+ * bracketing that numerical value. When discussing the accuracy of a
+ * method as a whole rather than at a specific argument, the number of
+ * ulps cited is for the worst-case error at any argument. If a
+ * method always has an error less than 0.5 ulps, the method always
+ * returns the floating-point number nearest the exact result; such a
+ * method is <i>correctly rounded</i>. A correctly rounded method is
+ * generally the best a floating-point approximation can be; however,
+ * it is impractical for many floating-point methods to be correctly
+ * rounded. Instead, for the <code>Math</code> class, a larger error
+ * bound of 1 or 2 ulps is allowed for certain methods. Informally,
+ * with a 1 ulp error bound, when the exact result is a representable
+ * number, the exact result should be returned as the computed result;
+ * otherwise, either of the two floating-point values which bracket
+ * the exact result may be returned. For exact results large in
+ * magnitude, one of the endpoints of the bracket may be infinite.
+ * Besides accuracy at individual arguments, maintaining proper
+ * relations between the method at different arguments is also
+ * important. Therefore, most methods with more than 0.5 ulp errors
+ * are required to be <i>semi-monotonic</i>: whenever the mathematical
+ * function is non-decreasing, so is the floating-point approximation,
+ * likewise, whenever the mathematical function is non-increasing, so
+ * is the floating-point approximation. Not all approximations that
+ * have 1 ulp accuracy will automatically meet the monotonicity
+ * requirements.
+ *
+ * @author unascribed
+ * @author Joseph D. Darcy
+ * @version 1.69, 06/14/04
+ * @since JDK1.0
+ */
+
+public final class Math {
+
+ /**
+ * Don''t let anyone instantiate this class.
+ */
+ private Math() {}
+
+ /**
+ * The <code>double</code> value that is closer than any other to
+ * <i>e</i>, the base of the natural logarithms.
+ */
+ public static final double E = 2.7182818284590452354;
+
+ /**
+ * The <code>double</code> value that is closer than any other to
+ * <i>pi</i>, the ratio of the circumference of a circle to its
+ * diameter.
+ */
+ public static final double PI = 3.14159265358979323846;
+
+ /**
+ * Returns the trigonometric sine of an angle. Special cases:
+ * <ul><li>If the argument is NaN or an infinity, then the
+ * result is NaN.
+ * <li>If the argument is zero, then the result is a zero with the
+ * same sign as the argument.</ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param a an angle, in radians.
+ * @return the sine of the argument.
+ */
+ public static double sin(double a) {
+ return StrictMath.sin(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the trigonometric cosine of an angle. Special cases:
+ * <ul><li>If the argument is NaN or an infinity, then the
+ * result is NaN.</ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param a an angle, in radians.
+ * @return the cosine of the argument.
+ */
+ public static double cos(double a) {
+ return StrictMath.cos(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the trigonometric tangent of an angle. Special cases:
+ * <ul><li>If the argument is NaN or an infinity, then the result
+ * is NaN.
+ * <li>If the argument is zero, then the result is a zero with the
+ * same sign as the argument.</ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param a an angle, in radians.
+ * @return the tangent of the argument.
+ */
+ public static double tan(double a) {
+ return StrictMath.tan(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the arc sine of an angle, in the range of -<i>pi</i>/2 through
+ * <i>pi</i>/2. Special cases:
+ * <ul><li>If the argument is NaN or its absolute value is greater
+ * than 1, then the result is NaN.
+ * <li>If the argument is zero, then the result is a zero with the
+ * same sign as the argument.</ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param a the value whose arc sine is to be returned.
+ * @return the arc sine of the argument.
+ */
+ public static double asin(double a) {
+ return StrictMath.asin(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the arc cosine of an angle, in the range of 0.0 through
+ * <i>pi</i>. Special case:
+ * <ul><li>If the argument is NaN or its absolute value is greater
+ * than 1, then the result is NaN.</ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param a the value whose arc cosine is to be returned.
+ * @return the arc cosine of the argument.
+ */
+ public static double acos(double a) {
+ return StrictMath.acos(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the arc tangent of an angle, in the range of -<i>pi</i>/2
+ * through <i>pi</i>/2. Special cases:
+ * <ul><li>If the argument is NaN, then the result is NaN.
+ * <li>If the argument is zero, then the result is a zero with the
+ * same sign as the argument.</ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param a the value whose arc tangent is to be returned.
+ * @return the arc tangent of the argument.
+ */
+ public static double atan(double a) {
+ return StrictMath.atan(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Converts an angle measured in degrees to an approximately
+ * equivalent angle measured in radians. The conversion from
+ * degrees to radians is generally inexact.
+ *
+ * @param angdeg an angle, in degrees
+ * @return the measurement of the angle <code>angdeg</code>
+ * in radians.
+ * @since 1.2
+ */
+ public static double toRadians(double angdeg) {
+ return angdeg / 180.0 * PI;
+ }
+
+ /**
+ * Converts an angle measured in radians to an approximately
+ * equivalent angle measured in degrees. The conversion from
+ * radians to degrees is generally inexact; users should
+ * <i>not</i> expect <code>cos(toRadians(90.0))</code> to exactly
+ * equal <code>0.0</code>.
+ *
+ * @param angrad an angle, in radians
+ * @return the measurement of the angle <code>angrad</code>
+ * in degrees.
+ * @since 1.2
+ */
+ public static double toDegrees(double angrad) {
+ return angrad * 180.0 / PI;
+ }
+
+ /**
+ * Returns Euler''s number <i>e</i> raised to the power of a
+ * <code>double</code> value. Special cases:
+ * <ul><li>If the argument is NaN, the result is NaN.
+ * <li>If the argument is positive infinity, then the result is
+ * positive infinity.
+ * <li>If the argument is negative infinity, then the result is
+ * positive zero.</ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param a the exponent to raise <i>e</i> to.
+ * @return the value <i>e</i><sup><code>a</code></sup>,
+ * where <i>e</i> is the base of the natural logarithms.
+ */
+ public static double exp(double a) {
+ return StrictMath.exp(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the natural logarithm (base <i>e</i>) of a <code>double</code>
+ * value. Special cases:
+ * <ul><li>If the argument is NaN or less than zero, then the result
+ * is NaN.
+ * <li>If the argument is positive infinity, then the result is
+ * positive infinity.
+ * <li>If the argument is positive zero or negative zero, then the
+ * result is negative infinity.</ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param a a value
+ * @return the value ln <code>a</code>, the natural logarithm of
+ * <code>a</code>.
+ */
+ public static double log(double a) {
+ return StrictMath.log(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the base 10 logarithm of a <code>double</code> value.
+ * Special cases:
+ *
+ * <ul><li>If the argument is NaN or less than zero, then the result
+ * is NaN.
+ * <li>If the argument is positive infinity, then the result is
+ * positive infinity.
+ * <li>If the argument is positive zero or negative zero, then the
+ * result is negative infinity.
+ * <li> If the argument is equal to 10<sup><i>n</i></sup> for
+ * integer <i>n</i>, then the result is <i>n</i>.
+ * </ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param a a value
+ * @return the base 10 logarithm of <code>a</code>.
+ * @since 1.5
+ */
+ public static double log10(double a) {
+ return StrictMath.log10(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the correctly rounded positive square root of a
+ * <code>double</code> value.
+ * Special cases:
+ * <ul><li>If the argument is NaN or less than zero, then the result
+ * is NaN.
+ * <li>If the argument is positive infinity, then the result is positive
+ * infinity.
+ * <li>If the argument is positive zero or negative zero, then the
+ * result is the same as the argument.</ul>
+ * Otherwise, the result is the <code>double</code> value closest to
+ * the true mathematical square root of the argument value.
+ *
+ * @param a a value.
+ * @return the positive square root of <code>a</code>.
+ * If the argument is NaN or less than zero, the result is NaN.
+ */
+ public static double sqrt(double a) {
+ return StrictMath.sqrt(a); // default impl. delegates to StrictMath
+ // Note that hardware sqrt instructions
+ // frequently can be directly used by JITs
+ // and should be much faster than doing
+ // Math.sqrt in software.
+ }
+
+
+ /**
+ * Returns the cube root of a <code>double</code> value. For
+ * positive finite <code>x</code>, <code>cbrt(-x) ==
+ * -cbrt(x)</code>; that is, the cube root of a negative value is
+ * the negative of the cube root of that value''s magnitude.
+ *
+ * Special cases:
+ *
+ * <ul>
+ *
+ * <li>If the argument is NaN, then the result is NaN.
+ *
+ * <li>If the argument is infinite, then the result is an infinity
+ * with the same sign as the argument.
+ *
+ * <li>If the argument is zero, then the result is a zero with the
+ * same sign as the argument.
+ *
+ * </ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ *
+ * @param a a value.
+ * @return the cube root of <code>a</code>.
+ * @since 1.5
+ */
+ public static double cbrt(double a) {
+ return StrictMath.cbrt(a);
+ }
+
+ /**
+ * Computes the remainder operation on two arguments as prescribed
+ * by the IEEE 754 standard.
+ * The remainder value is mathematically equal to
+ * <code>f1 - f2</code> × <i>n</i>,
+ * where <i>n</i> is the mathematical integer closest to the exact
+ * mathematical value of the quotient <code>f1/f2</code>, and if two
+ * mathematical integers are equally close to <code>f1/f2</code>,
+ * then <i>n</i> is the integer that is even. If the remainder is
+ * zero, its sign is the same as the sign of the first argument.
+ * Special cases:
+ * <ul><li>If either argument is NaN, or the first argument is infinite,
+ * or the second argument is positive zero or negative zero, then the
+ * result is NaN.
+ * <li>If the first argument is finite and the second argument is
+ * infinite, then the result is the same as the first argument.</ul>
+ *
+ * @param f1 the dividend.
+ * @param f2 the divisor.
+ * @return the remainder when <code>f1</code> is divided by
+ * <code>f2</code>.
+ */
+ public static double IEEEremainder(double f1, double f2) {
+ return StrictMath.IEEEremainder(f1, f2); // delegate to StrictMath
+ }
+
+ /**
+ * Returns the smallest (closest to negative infinity)
+ * <code>double</code> value that is greater than or equal to the
+ * argument and is equal to a mathematical integer. Special cases:
+ * <ul><li>If the argument value is already equal to a
+ * mathematical integer, then the result is the same as the
+ * argument. <li>If the argument is NaN or an infinity or
+ * positive zero or negative zero, then the result is the same as
+ * the argument. <li>If the argument value is less than zero but
+ * greater than -1.0, then the result is negative zero.</ul> Note
+ * that the value of <code>Math.ceil(x)</code> is exactly the
+ * value of <code>-Math.floor(-x)</code>.
+ *
+ *
+ * @param a a value.
+ * @return the smallest (closest to negative infinity)
+ * floating-point value that is greater than or equal to
+ * the argument and is equal to a mathematical integer.
+ */
+ public static double ceil(double a) {
+ return StrictMath.ceil(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the largest (closest to positive infinity)
+ * <code>double</code> value that is less than or equal to the
+ * argument and is equal to a mathematical integer. Special cases:
+ * <ul><li>If the argument value is already equal to a
+ * mathematical integer, then the result is the same as the
+ * argument. <li>If the argument is NaN or an infinity or
+ * positive zero or negative zero, then the result is the same as
+ * the argument.</ul>
+ *
+ * @param a a value.
+ * @return the largest (closest to positive infinity)
+ * floating-point value that less than or equal to the argument
+ * and is equal to a mathematical integer.
+ */
+ public static double floor(double a) {
+ return StrictMath.floor(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the <code>double</code> value that is closest in value
+ * to the argument and is equal to a mathematical integer. If two
+ * <code>double</code> values that are mathematical integers are
+ * equally close, the result is the integer value that is
+ * even. Special cases:
+ * <ul><li>If the argument value is already equal to a mathematical
+ * integer, then the result is the same as the argument.
+ * <li>If the argument is NaN or an infinity or positive zero or negative
+ * zero, then the result is the same as the argument.</ul>
+ *
+ * @param a a <code>double</code> value.
+ * @return the closest floating-point value to <code>a</code> that is
+ * equal to a mathematical integer.
+ */
+ public static double rint(double a) {
+ return StrictMath.rint(a); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Converts rectangular coordinates (<code>x</code>, <code>y</code>)
+ * to polar (r, <i>theta</i>).
+ * This method computes the phase <i>theta</i> by computing an arc tangent
+ * of <code>y/x</code> in the range of -<i>pi</i> to <i>pi</i>. Special
+ * cases:
+ * <ul><li>If either argument is NaN, then the result is NaN.
+ * <li>If the first argument is positive zero and the second argument
+ * is positive, or the first argument is positive and finite and the
+ * second argument is positive infinity, then the result is positive
+ * zero.
+ * <li>If the first argument is negative zero and the second argument
+ * is positive, or the first argument is negative and finite and the
+ * second argument is positive infinity, then the result is negative zero.
+ * <li>If the first argument is positive zero and the second argument
+ * is negative, or the first argument is positive and finite and the
+ * second argument is negative infinity, then the result is the
+ * <code>double</code> value closest to <i>pi</i>.
+ * <li>If the first argument is negative zero and the second argument
+ * is negative, or the first argument is negative and finite and the
+ * second argument is negative infinity, then the result is the
+ * <code>double</code> value closest to -<i>pi</i>.
+ * <li>If the first argument is positive and the second argument is
+ * positive zero or negative zero, or the first argument is positive
+ * infinity and the second argument is finite, then the result is the
+ * <code>double</code> value closest to <i>pi</i>/2.
+ * <li>If the first argument is negative and the second argument is
+ * positive zero or negative zero, or the first argument is negative
+ * infinity and the second argument is finite, then the result is the
+ * <code>double</code> value closest to -<i>pi</i>/2.
+ * <li>If both arguments are positive infinity, then the result is the
+ * <code>double</code> value closest to <i>pi</i>/4.
+ * <li>If the first argument is positive infinity and the second argument
+ * is negative infinity, then the result is the <code>double</code>
+ * value closest to 3*<i>pi</i>/4.
+ * <li>If the first argument is negative infinity and the second argument
+ * is positive infinity, then the result is the <code>double</code> value
+ * closest to -<i>pi</i>/4.
+ * <li>If both arguments are negative infinity, then the result is the
+ * <code>double</code> value closest to -3*<i>pi</i>/4.</ul>
+ *
+ * <p>The computed result must be within 2 ulps of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param y the ordinate coordinate
+ * @param x the abscissa coordinate
+ * @return the <i>theta</i> component of the point
+ * (<i>r</i>, <i>theta</i>)
+ * in polar coordinates that corresponds to the point
+ * (<i>x</i>, <i>y</i>) in Cartesian coordinates.
+ */
+ public static double atan2(double y, double x) {
+ return StrictMath.atan2(y, x); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the value of the first argument raised to the power of the
+ * second argument. Special cases:
+ *
+ * <ul><li>If the second argument is positive or negative zero, then the
+ * result is 1.0.
+ * <li>If the second argument is 1.0, then the result is the same as the
+ * first argument.
+ * <li>If the second argument is NaN, then the result is NaN.
+ * <li>If the first argument is NaN and the second argument is nonzero,
+ * then the result is NaN.
+ *
+ * <li>If
+ * <ul>
+ * <li>the absolute value of the first argument is greater than 1
+ * and the second argument is positive infinity, or
+ * <li>the absolute value of the first argument is less than 1 and
+ * the second argument is negative infinity,
+ * </ul>
+ * then the result is positive infinity.
+ *
+ * <li>If
+ * <ul>
+ * <li>the absolute value of the first argument is greater than 1 and
+ * the second argument is negative infinity, or
+ * <li>the absolute value of the
+ * first argument is less than 1 and the second argument is positive
+ * infinity,
+ * </ul>
+ * then the result is positive zero.
+ *
+ * <li>If the absolute value of the first argument equals 1 and the
+ * second argument is infinite, then the result is NaN.
+ *
+ * <li>If
+ * <ul>
+ * <li>the first argument is positive zero and the second argument
+ * is greater than zero, or
+ * <li>the first argument is positive infinity and the second
+ * argument is less than zero,
+ * </ul>
+ * then the result is positive zero.
+ *
+ * <li>If
+ * <ul>
+ * <li>the first argument is positive zero and the second argument
+ * is less than zero, or
+ * <li>the first argument is positive infinity and the second
+ * argument is greater than zero,
+ * </ul>
+ * then the result is positive infinity.
+ *
+ * <li>If
+ * <ul>
+ * <li>the first argument is negative zero and the second argument
+ * is greater than zero but not a finite odd integer, or
+ * <li>the first argument is negative infinity and the second
+ * argument is less than zero but not a finite odd integer,
+ * </ul>
+ * then the result is positive zero.
+ *
+ * <li>If
+ * <ul>
+ * <li>the first argument is negative zero and the second argument
+ * is a positive finite odd integer, or
+ * <li>the first argument is negative infinity and the second
+ * argument is a negative finite odd integer,
+ * </ul>
+ * then the result is negative zero.
+ *
+ * <li>If
+ * <ul>
+ * <li>the first argument is negative zero and the second argument
+ * is less than zero but not a finite odd integer, or
+ * <li>the first argument is negative infinity and the second
+ * argument is greater than zero but not a finite odd integer,
+ * </ul>
+ * then the result is positive infinity.
+ *
+ * <li>If
+ * <ul>
+ * <li>the first argument is negative zero and the second argument
+ * is a negative finite odd integer, or
+ * <li>the first argument is negative infinity and the second
+ * argument is a positive finite odd integer,
+ * </ul>
+ * then the result is negative infinity.
+ *
+ * <li>If the first argument is finite and less than zero
+ * <ul>
+ * <li> if the second argument is a finite even integer, the
+ * result is equal to the result of raising the absolute value of
+ * the first argument to the power of the second argument
+ *
+ * <li>if the second argument is a finite odd integer, the result
+ * is equal to the negative of the result of raising the absolute
+ * value of the first argument to the power of the second
+ * argument
+ *
+ * <li>if the second argument is finite and not an integer, then
+ * the result is NaN.
+ * </ul>
+ *
+ * <li>If both arguments are integers, then the result is exactly equal
+ * to the mathematical result of raising the first argument to the power
+ * of the second argument if that result can in fact be represented
+ * exactly as a <code>double</code> value.</ul>
+ *
+ * <p>(In the foregoing descriptions, a floating-point value is
+ * considered to be an integer if and only if it is finite and a
+ * fixed point of the method {@link #ceil <tt>ceil</tt>} or,
+ * equivalently, a fixed point of the method {@link #floor
+ * <tt>floor</tt>}. A value is a fixed point of a one-argument
+ * method if and only if the result of applying the method to the
+ * value is equal to the value.)
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param a the base.
+ * @param b the exponent.
+ * @return the value <code>a<sup>b</sup></code>.
+ */
+ public static double pow(double a, double b) {
+ return StrictMath.pow(a, b); // default impl. delegates to StrictMath
+ }
+
+ /**
+ * Returns the closest <code>int</code> to the argument. The
+ * result is rounded to an integer by adding 1/2, taking the
+ * floor of the result, and casting the result to type <code>int</code>.
+ * In other words, the result is equal to the value of the expression:
+ * <p><pre>(int)Math.floor(a + 0.5f)</pre>
+ * <p>
+ * Special cases:
+ * <ul><li>If the argument is NaN, the result is 0.
+ * <li>If the argument is negative infinity or any value less than or
+ * equal to the value of <code>Integer.MIN_VALUE</code>, the result is
+ * equal to the value of <code>Integer.MIN_VALUE</code>.
+ * <li>If the argument is positive infinity or any value greater than or
+ * equal to the value of <code>Integer.MAX_VALUE</code>, the result is
+ * equal to the value of <code>Integer.MAX_VALUE</code>.</ul>
+ *
+ * @param a a floating-point value to be rounded to an integer.
+ * @return the value of the argument rounded to the nearest
+ * <code>int</code> value.
+ * @see java.lang.Integer#MAX_VALUE
+ * @see java.lang.Integer#MIN_VALUE
+ */
+ public static int round(float a) {
+ return (int)floor(a + 0.5f);
+ }
+
+ /**
+ * Returns the closest <code>long</code> to the argument. The result
+ * is rounded to an integer by adding 1/2, taking the floor of the
+ * result, and casting the result to type <code>long</code>. In other
+ * words, the result is equal to the value of the expression:
+ * <p><pre>(long)Math.floor(a + 0.5d)</pre>
+ * <p>
+ * Special cases:
+ * <ul><li>If the argument is NaN, the result is 0.
+ * <li>If the argument is negative infinity or any value less than or
+ * equal to the value of <code>Long.MIN_VALUE</code>, the result is
+ * equal to the value of <code>Long.MIN_VALUE</code>.
+ * <li>If the argument is positive infinity or any value greater than or
+ * equal to the value of <code>Long.MAX_VALUE</code>, the result is
+ * equal to the value of <code>Long.MAX_VALUE</code>.</ul>
+ *
+ * @param a a floating-point value to be rounded to a
+ * <code>long</code>.
+ * @return the value of the argument rounded to the nearest
+ * <code>long</code> value.
+ * @see java.lang.Long#MAX_VALUE
+ * @see java.lang.Long#MIN_VALUE
+ */
+ public static long round(double a) {
+ return (long)floor(a + 0.5d);
+ }
+
+ private static Random randomNumberGenerator;
+
+ private static synchronized void initRNG() {
+ if (randomNumberGenerator == null)
+ randomNumberGenerator = new Random();
+ }
+
+ /**
+ * Returns a <code>double</code> value with a positive sign, greater
+ * than or equal to <code>0.0</code> and less than <code>1.0</code>.
+ * Returned values are chosen pseudorandomly with (approximately)
+ * uniform distribution from that range.
+ *
+ * <p>When this method is first called, it creates a single new
+ * pseudorandom-number generator, exactly as if by the expression
+ * <blockquote><pre>new java.util.Random</pre></blockquote> This
+ * new pseudorandom-number generator is used thereafter for all
+ * calls to this method and is used nowhere else.
+ *
+ * <p>This method is properly synchronized to allow correct use by
+ * more than one thread. However, if many threads need to generate
+ * pseudorandom numbers at a great rate, it may reduce contention
+ * for each thread to have its own pseudorandom-number generator.
+ *
+ * @return a pseudorandom <code>double</code> greater than or equal
+ * to <code>0.0</code> and less than <code>1.0</code>.
+ * @see java.util.Random#nextDouble()
+ */
+ public static double random() {
+ if (randomNumberGenerator == null) initRNG();
+ return randomNumberGenerator.nextDouble();
+ }
+
+ /**
+ * Returns the absolute value of an <code>int</code> value.
+ * If the argument is not negative, the argument is returned.
+ * If the argument is negative, the negation of the argument is returned.
+ *
+ * <p>Note that if the argument is equal to the value of
+ * <code>Integer.MIN_VALUE</code>, the most negative representable
+ * <code>int</code> value, the result is that same value, which is
+ * negative.
+ *
+ * @param a the argument whose absolute value is to be determined
+ * @return the absolute value of the argument.
+ * @see java.lang.Integer#MIN_VALUE
+ */
+ public static int abs(int a) {
+ return (a < 0) ? -a : a;
+ }
+
+ /**
+ * Returns the absolute value of a <code>long</code> value.
+ * If the argument is not negative, the argument is returned.
+ * If the argument is negative, the negation of the argument is returned.
+ *
+ * <p>Note that if the argument is equal to the value of
+ * <code>Long.MIN_VALUE</code>, the most negative representable
+ * <code>long</code> value, the result is that same value, which
+ * is negative.
+ *
+ * @param a the argument whose absolute value is to be determined
+ * @return the absolute value of the argument.
+ * @see java.lang.Long#MIN_VALUE
+ */
+ public static long abs(long a) {
+ return (a < 0) ? -a : a;
+ }
+
+ /**
+ * Returns the absolute value of a <code>float</code> value.
+ * If the argument is not negative, the argument is returned.
+ * If the argument is negative, the negation of the argument is returned.
+ * Special cases:
+ * <ul><li>If the argument is positive zero or negative zero, the
+ * result is positive zero.
+ * <li>If the argument is infinite, the result is positive infinity.
+ * <li>If the argument is NaN, the result is NaN.</ul>
+ * In other words, the result is the same as the value of the expression:
+ * <p><pre>Float.intBitsToFloat(0x7fffffff & Float.floatToIntBits(a))</pre>
+ *
+ * @param a the argument whose absolute value is to be determined
+ * @return the absolute value of the argument.
+ */
+ public static float abs(float a) {
+ return (a <= 0.0F) ? 0.0F - a : a;
+ }
+
+ /**
+ * Returns the absolute value of a <code>double</code> value.
+ * If the argument is not negative, the argument is returned.
+ * If the argument is negative, the negation of the argument is returned.
+ * Special cases:
+ * <ul><li>If the argument is positive zero or negative zero, the result
+ * is positive zero.
+ * <li>If the argument is infinite, the result is positive infinity.
+ * <li>If the argument is NaN, the result is NaN.</ul>
+ * In other words, the result is the same as the value of the expression:
+ * <p><code>Double.longBitsToDouble((Double.doubleToLongBits(a)<<1)>>>1)</code>
+ *
+ * @param a the argument whose absolute value is to be determined
+ * @return the absolute value of the argument.
+ */
+ public static double abs(double a) {
+ return (a <= 0.0D) ? 0.0D - a : a;
+ }
+
+ /**
+ * Returns the greater of two <code>int</code> values. That is, the
+ * result is the argument closer to the value of
+ * <code>Integer.MAX_VALUE</code>. If the arguments have the same value,
+ * the result is that same value.
+ *
+ * @param a an argument.
+ * @param b another argument.
+ * @return the larger of <code>a</code> and <code>b</code>.
+ * @see java.lang.Long#MAX_VALUE
+ */
+ public static int max(int a, int b) {
+ return (a >= b) ? a : b;
+ }
+
+ /**
+ * Returns the greater of two <code>long</code> values. That is, the
+ * result is the argument closer to the value of
+ * <code>Long.MAX_VALUE</code>. If the arguments have the same value,
+ * the result is that same value.
+ *
+ * @param a an argument.
+ * @param b another argument.
+ * @return the larger of <code>a</code> and <code>b</code>.
+ * @see java.lang.Long#MAX_VALUE
+ */
+ public static long max(long a, long b) {
+ return (a >= b) ? a : b;
+ }
+
+ private static long negativeZeroFloatBits = Float.floatToIntBits(-0.0f);
+ private static long negativeZeroDoubleBits = Double.doubleToLongBits(-0.0d);
+
+ /**
+ * Returns the greater of two <code>float</code> values. That is,
+ * the result is the argument closer to positive infinity. If the
+ * arguments have the same value, the result is that same
+ * value. If either value is NaN, then the result is NaN. Unlike
+ * the numerical comparison operators, this method considers
+ * negative zero to be strictly smaller than positive zero. If one
+ * argument is positive zero and the other negative zero, the
+ * result is positive zero.
+ *
+ * @param a an argument.
+ * @param b another argument.
+ * @return the larger of <code>a</code> and <code>b</code>.
+ */
+ public static float max(float a, float b) {
+ if (a !!= a) return a; // a is NaN
+ if ((a == 0.0f) && (b == 0.0f)
+ && (Float.floatToIntBits(a) == negativeZeroFloatBits)) {
+ return b;
+ }
+ return (a >= b) ? a : b;
+ }
+
+ /**
+ * Returns the greater of two <code>double</code> values. That
+ * is, the result is the argument closer to positive infinity. If
+ * the arguments have the same value, the result is that same
+ * value. If either value is NaN, then the result is NaN. Unlike
+ * the numerical comparison operators, this method considers
+ * negative zero to be strictly smaller than positive zero. If one
+ * argument is positive zero and the other negative zero, the
+ * result is positive zero.
+ *
+ * @param a an argument.
+ * @param b another argument.
+ * @return the larger of <code>a</code> and <code>b</code>.
+ */
+ public static double max(double a, double b) {
+ if (a !!= a) return a; // a is NaN
+ if ((a == 0.0d) && (b == 0.0d)
+ && (Double.doubleToLongBits(a) == negativeZeroDoubleBits)) {
+ return b;
+ }
+ return (a >= b) ? a : b;
+ }
+
+ /**
+ * Returns the smaller of two <code>int</code> values. That is,
+ * the result the argument closer to the value of
+ * <code>Integer.MIN_VALUE</code>. If the arguments have the same
+ * value, the result is that same value.
+ *
+ * @param a an argument.
+ * @param b another argument.
+ * @return the smaller of <code>a</code> and <code>b</code>.
+ * @see java.lang.Long#MIN_VALUE
+ */
+ public static int min(int a, int b) {
+ return (a <= b) ? a : b;
+ }
+
+ /**
+ * Returns the smaller of two <code>long</code> values. That is,
+ * the result is the argument closer to the value of
+ * <code>Long.MIN_VALUE</code>. If the arguments have the same
+ * value, the result is that same value.
+ *
+ * @param a an argument.
+ * @param b another argument.
+ * @return the smaller of <code>a</code> and <code>b</code>.
+ * @see java.lang.Long#MIN_VALUE
+ */
+ public static long min(long a, long b) {
+ return (a <= b) ? a : b;
+ }
+
+ /**
+ * Returns the smaller of two <code>float</code> values. That is,
+ * the result is the value closer to negative infinity. If the
+ * arguments have the same value, the result is that same
+ * value. If either value is NaN, then the result is NaN. Unlike
+ * the numerical comparison operators, this method considers
+ * negative zero to be strictly smaller than positive zero. If
+ * one argument is positive zero and the other is negative zero,
+ * the result is negative zero.
+ *
+ * @param a an argument.
+ * @param b another argument.
+ * @return the smaller of <code>a</code> and <code>b.</code>
+ */
+ public static float min(float a, float b) {
+ if (a !!= a) return a; // a is NaN
+ if ((a == 0.0f) && (b == 0.0f)
+ && (Float.floatToIntBits(b) == negativeZeroFloatBits)) {
+ return b;
+ }
+ return (a <= b) ? a : b;
+ }
+
+ /**
+ * Returns the smaller of two <code>double</code> values. That
+ * is, the result is the value closer to negative infinity. If the
+ * arguments have the same value, the result is that same
+ * value. If either value is NaN, then the result is NaN. Unlike
+ * the numerical comparison operators, this method considers
+ * negative zero to be strictly smaller than positive zero. If one
+ * argument is positive zero and the other is negative zero, the
+ * result is negative zero.
+ *
+ * @param a an argument.
+ * @param b another argument.
+ * @return the smaller of <code>a</code> and <code>b</code>.
+ */
+ public static double min(double a, double b) {
+ if (a !!= a) return a; // a is NaN
+ if ((a == 0.0d) && (b == 0.0d)
+ && (Double.doubleToLongBits(b) == negativeZeroDoubleBits)) {
+ return b;
+ }
+ return (a <= b) ? a : b;
+ }
+
+ /**
+ * Returns the size of an ulp of the argument. An ulp of a
+ * <code>double</code> value is the positive distance between this
+ * floating-point value and the <code>double</code> value next
+ * larger in magnitude. Note that for non-NaN <i>x</i>,
+ * <code>ulp(-<i>x</i>) == ulp(<i>x</i>)</code>.
+ *
+ * <p>Special Cases:
+ * <ul>
+ * <li> If the argument is NaN, then the result is NaN.
+ * <li> If the argument is positive or negative infinity, then the
+ * result is positive infinity.
+ * <li> If the argument is positive or negative zero, then the result is
+ * <code>Double.MIN_VALUE</code>.
+ * <li> If the argument is ±<code>Double.MAX_VALUE</code>, then
+ * the result is equal to 2<sup>971</sup>.
+ * </ul>
+ *
+ * @param d the floating-point value whose ulp is to be returned
+ * @return the size of an ulp of the argument
+ * @author Joseph D. Darcy
+ * @since 1.5
+ */
+ public static double ulp(double d) {
+ return sun.misc.FpUtils.ulp(d);
+ }
+
+ /**
+ * Returns the size of an ulp of the argument. An ulp of a
+ * <code>float</code> value is the positive distance between this
+ * floating-point value and the <code>float</code> value next
+ * larger in magnitude. Note that for non-NaN <i>x</i>,
+ * <code>ulp(-<i>x</i>) == ulp(<i>x</i>)</code>.
+ *
+ * <p>Special Cases:
+ * <ul>
+ * <li> If the argument is NaN, then the result is NaN.
+ * <li> If the argument is positive or negative infinity, then the
+ * result is positive infinity.
+ * <li> If the argument is positive or negative zero, then the result is
+ * <code>Float.MIN_VALUE</code>.
+ * <li> If the argument is ±<code>Float.MAX_VALUE</code>, then
+ * the result is equal to 2<sup>104</sup>.
+ * </ul>
+ *
+ * @param f the floating-point value whose ulp is to be returned
+ * @return the size of an ulp of the argument
+ * @author Joseph D. Darcy
+ * @since 1.5
+ */
+ public static float ulp(float f) {
+ return sun.misc.FpUtils.ulp(f);
+ }
+
+ /**
+ * Returns the signum function of the argument; zero if the argument
+ * is zero, 1.0 if the argument is greater than zero, -1.0 if the
+ * argument is less than zero.
+ *
+ * <p>Special Cases:
+ * <ul>
+ * <li> If the argument is NaN, then the result is NaN.
+ * <li> If the argument is positive zero or negative zero, then the
+ * result is the same as the argument.
+ * </ul>
+ *
+ * @param d the floating-point value whose signum is to be returned
+ * @return the signum function of the argument
+ * @author Joseph D. Darcy
+ * @since 1.5
+ */
+ public static double signum(double d) {
+ return sun.misc.FpUtils.signum(d);
+ }
+
+ /**
+ * Returns the signum function of the argument; zero if the argument
+ * is zero, 1.0f if the argument is greater than zero, -1.0f if the
+ * argument is less than zero.
+ *
+ * <p>Special Cases:
+ * <ul>
+ * <li> If the argument is NaN, then the result is NaN.
+ * <li> If the argument is positive zero or negative zero, then the
+ * result is the same as the argument.
+ * </ul>
+ *
+ * @param f the floating-point value whose signum is to be returned
+ * @return the signum function of the argument
+ * @author Joseph D. Darcy
+ * @since 1.5
+ */
+ public static float signum(float f) {
+ return sun.misc.FpUtils.signum(f);
+ }
+
+ /**
+ * Returns the hyperbolic sine of a <code>double</code> value.
+ * The hyperbolic sine of <i>x</i> is defined to be
+ * (<i>e<sup>x</sup> - e<sup>-x</sup></i>)/2
+ * where <i>e</i> is {@linkplain Math#E Euler''s number}.
+ *
+ * <p>Special cases:
+ * <ul>
+ *
+ * <li>If the argument is NaN, then the result is NaN.
+ *
+ * <li>If the argument is infinite, then the result is an infinity
+ * with the same sign as the argument.
+ *
+ * <li>If the argument is zero, then the result is a zero with the
+ * same sign as the argument.
+ *
+ * </ul>
+ *
+ * <p>The computed result must be within 2.5 ulps of the exact result.
+ *
+ * @param x The number whose hyperbolic sine is to be returned.
+ * @return The hyperbolic sine of <code>x</code>.
+ * @since 1.5
+ */
+ public static double sinh(double x) {
+ return StrictMath.sinh(x);
+ }
+
+ /**
+ * Returns the hyperbolic cosine of a <code>double</code> value.
+ * The hyperbolic cosine of <i>x</i> is defined to be
+ * (<i>e<sup>x</sup> + e<sup>-x</sup></i>)/2
+ * where <i>e</i> is {@linkplain Math#E Euler''s number}.
+ *
+ * <p>Special cases:
+ * <ul>
+ *
+ * <li>If the argument is NaN, then the result is NaN.
+ *
+ * <li>If the argument is infinite, then the result is positive
+ * infinity.
+ *
+ * <li>If the argument is zero, then the result is <code>1.0</code>.
+ *
+ * </ul>
+ *
+ * <p>The computed result must be within 2.5 ulps of the exact result.
+ *
+ * @param x The number whose hyperbolic cosine is to be returned.
+ * @return The hyperbolic cosine of <code>x</code>.
+ * @since 1.5
+ */
+ public static double cosh(double x) {
+ return StrictMath.cosh(x);
+ }
+
+ /**
+ * Returns the hyperbolic tangent of a <code>double</code> value.
+ * The hyperbolic tangent of <i>x</i> is defined to be
+ * (<i>e<sup>x</sup> - e<sup>-x</sup></i>)/(<i>e<sup>x</sup> + e<sup>-x</sup></i>),
+ * in other words, {@linkplain Math#sinh
+ * sinh(<i>x</i>)}/{@linkplain Math#cosh cosh(<i>x</i>)}. Note
+ * that the absolute value of the exact tanh is always less than
+ * 1.
+ *
+ * <p>Special cases:
+ * <ul>
+ *
+ * <li>If the argument is NaN, then the result is NaN.
+ *
+ * <li>If the argument is zero, then the result is a zero with the
+ * same sign as the argument.
+ *
+ * <li>If the argument is positive infinity, then the result is
+ * <code>+1.0</code>.
+ *
+ * <li>If the argument is negative infinity, then the result is
+ * <code>-1.0</code>.
+ *
+ * </ul>
+ *
+ * <p>The computed result must be within 2.5 ulps of the exact result.
+ * The result of <code>tanh</code> for any finite input must have
+ * an absolute value less than or equal to 1. Note that once the
+ * exact result of tanh is within 1/2 of an ulp of the limit value
+ * of ±1, correctly signed ±<code>1.0</code> should
+ * be returned.
+ *
+ * @param x The number whose hyperbolic tangent is to be returned.
+ * @return The hyperbolic tangent of <code>x</code>.
+ * @since 1.5
+ */
+ public static double tanh(double x) {
+ return StrictMath.tanh(x);
+ }
+
+ /**
+ * Returns sqrt(<i>x</i><sup>2</sup> +<i>y</i><sup>2</sup>)
+ * without intermediate overflow or underflow.
+ *
+ * <p>Special cases:
+ * <ul>
+ *
+ * <li> If either argument is infinite, then the result
+ * is positive infinity.
+ *
+ * <li> If either argument is NaN and neither argument is infinite,
+ * then the result is NaN.
+ *
+ * </ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact
+ * result. If one parameter is held constant, the results must be
+ * semi-monotonic in the other parameter.
+ *
+ * @param x a value
+ * @param y a value
+ * @return sqrt(<i>x</i><sup>2</sup> +<i>y</i><sup>2</sup>)
+ * without intermediate overflow or underflow
+ * @since 1.5
+ */
+ public static double hypot(double x, double y) {
+ return StrictMath.hypot(x, y);
+ }
+
+ /**
+ * Returns <i>e</i><sup>x</sup> -1. Note that for values of
+ * <i>x</i> near 0, the exact sum of
+ * <code>expm1(x)</code> + 1 is much closer to the true
+ * result of <i>e</i><sup>x</sup> than <code>exp(x)</code>.
+ *
+ * <p>Special cases:
+ * <ul>
+ * <li>If the argument is NaN, the result is NaN.
+ *
+ * <li>If the argument is positive infinity, then the result is
+ * positive infinity.
+ *
+ * <li>If the argument is negative infinity, then the result is
+ * -1.0.
+ *
+ * <li>If the argument is zero, then the result is a zero with the
+ * same sign as the argument.
+ *
+ * </ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic. The result of
+ * <code>expm1</code> for any finite input must be greater than or
+ * equal to <code>-1.0</code>. Note that once the exact result of
+ * <i>e</i><sup><code>x</code></sup> - 1 is within 1/2
+ * ulp of the limit value -1, <code>-1.0</code> should be
+ * returned.
+ *
+ * @param x the exponent to raise <i>e</i> to in the computation of
+ * <i>e</i><sup><code>x</code></sup> -1.
+ * @return the value <i>e</i><sup><code>x</code></sup> - 1.
+ */
+ public static double expm1(double x) {
+ return StrictMath.expm1(x);
+ }
+
+ /**
+ * Returns the natural logarithm of the sum of the argument and 1.
+ * Note that for small values <code>x</code>, the result of
+ * <code>log1p(x)</code> is much closer to the true result of ln(1
+ * + <code>x</code>) than the floating-point evaluation of
+ * <code>log(1.0+x)</code>.
+ *
+ * <p>Special cases:
+ *
+ * <ul>
+ *
+ * <li>If the argument is NaN or less than -1, then the result is
+ * NaN.
+ *
+ * <li>If the argument is positive infinity, then the result is
+ * positive infinity.
+ *
+ * <li>If the argument is negative one, then the result is
+ * negative infinity.
+ *
+ * <li>If the argument is zero, then the result is a zero with the
+ * same sign as the argument.
+ *
+ * </ul>
+ *
+ * <p>The computed result must be within 1 ulp of the exact result.
+ * Results must be semi-monotonic.
+ *
+ * @param x a value
+ * @return the value ln(<code>x</code> + 1), the natural
+ * log of <code>x</code> + 1
+ */
+ public static double log1p(double x) {
+ return StrictMath.log1p(x);
+ }
+}
+'
+!
+
+javaSourcesBig
+ ^ self workingJavaInDirectory: '../java-src/java/util'
+!
+
+petitParserPackage
+^ '
+Object subclass: #PPCharSetPredicate
+ instanceVariableNames: ''block classification''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Tools''!!
+!!PPCharSetPredicate commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPCharSetPredicate methodsFor: ''initialization'' stamp: ''lr 8/30/2010 12:19''!!
+initializeOn: aBlock
+ block := aBlock.
+ classification := Array new: 255.
+ 1 to: classification size do: [ :index |
+ classification at: index put: (block
+ value: (Character value: index)) ]!! !!
+
+
+!!PPCharSetPredicate methodsFor: ''evaluating'' stamp: ''lr 8/30/2010 12:19''!!
+value: aCharacter
+ | index |
+ index := aCharacter asInteger.
+ index == 0
+ ifTrue: [ ^ block value: aCharacter ].
+ index > 255
+ ifTrue: [ ^ block value: aCharacter ].
+ ^ classification at: index!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPCharSetPredicate class
+ instanceVariableNames: ''''!!
+!!PPCharSetPredicate class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPCharSetPredicate class methodsFor: ''instance creation'' stamp: ''lr 8/25/2010 11:05''!!
+on: aBlock
+ ^ self basicNew initializeOn: aBlock!! !!
+
+
+PPDelegateParser subclass: #PPExpressionParser
+ instanceVariableNames: ''operators''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Tools''!!
+!!PPExpressionParser commentStamp: ''<historical>'' prior: 0!!
+A PPExpressionParser is a parser to conveniently define an expression grammar with prefix, postfix, and left- and right-associative infix operators.
+
+The following code initializes a parser for arithmetic expressions. First we instantiate an expression parser, a simple parser for expressions in parenthesis and a simple parser for integer numbers.
+
+ expression := PPExpressionParser new.
+ parens := $( asParser token trim , expression , $) asParser token trim
+ ==> [ :nodes | nodes second ].
+ integer := #digit asParser plus token trim
+ ==> [ :token | token value asInteger ].
+
+Then we define on what term the expression grammar is built on:
+
+ expression term: parens / integer.
+
+Finally we define the operator-groups in descending precedence. Note, that the action blocks receive both, the terms and the parsed operator in the order they appear in the parsed input.
+
+ expression
+ group: [ :g |
+ g prefix: $- asParser token trim do: [ :op :a | a negated ] ];
+ group: [ :g |
+ g postfix: ''++'' asParser token trim do: [ :a :op | a + 1 ].
+ g postfix: ''--'' asParser token trim do: [ :a :op | a - 1 ] ];
+ group: [ :g |
+ g right: $^ asParser token trim do: [ :a :op :b | a raisedTo: b ] ];
+ group: [ :g |
+ g left: $* asParser token trim do: [ :a :op :b | a * b ].
+ g left: $/ asParser token trim do: [ :a :op :b | a / b ] ];
+ group: [ :g |
+ g left: $+ asParser token trim do: [ :a :op :b | a + b ].
+ g left: $- asParser token trim do: [ :a :op :b | a - b ] ].
+
+After evaluating the above code the ''expression'' is an efficient parser that evaluates examples like:
+
+ expression parse: ''-8++''.
+ expression parse: ''1+2*3''.
+ expression parse: ''1*2+3''.
+ expression parse: ''(1+2)*3''.
+ expression parse: ''8/4/2''.
+ expression parse: ''8/(4/2)''.
+ expression parse: ''2^2^3''.
+ expression parse: ''(2^2)^3''.
+
+Instance Variables:
+ operators <Dictionary> The operators defined in the current group.!!
+
+
+!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
+build: aParser right: aChoiceParser
+ ^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]!! !!
+
+!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
+build: aParser left: aChoiceParser
+ ^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]!! !!
+
+!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:38''!!
+build: aParser postfix: aChoiceParser
+ ^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]!! !!
+
+!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 21:15''!!
+buildOn: aParser
+ ^ self buildSelectors inject: aParser into: [ :term :selector |
+ | list |
+ list := operators at: selector ifAbsent: [ #() ].
+ list isEmpty
+ ifTrue: [ term ]
+ ifFalse: [
+ self
+ perform: selector with: term
+ with: (list size = 1
+ ifTrue: [ list first first ==> [ :operator | Array with: list first second with: operator ] ]
+ ifFalse: [
+ list
+ inject: PPChoiceParser new
+ into: [ :choice :each | choice / (each first ==> [ :operator | Array with: each second with: operator ]) ] ]) ] ]!! !!
+
+!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 12/4/2009 17:39''!!
+build: aParser prefix: aChoiceParser
+ ^ aChoiceParser star , aParser map: [ :ops :term | ops reversed inject: term into: [ :result :operator | operator first value: operator second value: result ] ]!! !!
+
+!!PPExpressionParser methodsFor: ''private'' stamp: ''FirstnameLastname 11/26/2009 20:48''!!
+buildSelectors
+ ^ #(build:prefix: build:postfix: build:right: build:left:)!! !!
+
+!!PPExpressionParser methodsFor: ''private'' stamp: ''lr 2/7/2010 23:23''!!
+operator: aSymbol parser: aParser do: aBlock
+ parser isNil
+ ifTrue: [ ^ self error: ''You did not specify a term when creating the receiver.'' ].
+ operators isNil
+ ifTrue: [ ^ self error: ''Use #group: to define precedence groups in descending order.'' ].
+ (operators at: aSymbol ifAbsentPut: [ OrderedCollection new ])
+ addLast: (Array with: aParser asParser with: aBlock)!! !!
+
+
+!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 21:26''!!
+term: aParser
+ "Defines the initial term aParser of the receiver."
+
+ parser isNil
+ ifTrue: [ parser := aParser ]
+ ifFalse: [ self error: ''Unable to redefine the term.'' ]!! !!
+
+!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
+postfix: aParser do: aTwoArgumentBlock
+ "Define a postfix operator aParser. Evaluate aTwoArgumentBlock with the term and the operator."
+
+ self operator: #build:postfix: parser: aParser do: aTwoArgumentBlock!! !!
+
+!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
+left: aParser do: aThreeArgumentBlock
+ "Define an operator aParser that is left-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."
+
+ self operator: #build:left: parser: aParser do: aThreeArgumentBlock!! !!
+
+!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
+prefix: aParser do: aTwoArgumentBlock
+ "Define a prefix operator aParser. Evaluate aTwoArgumentBlock with the operator and the term."
+
+ self operator: #build:prefix: parser: aParser do: aTwoArgumentBlock!! !!
+
+!!PPExpressionParser methodsFor: ''specifying'' stamp: ''FirstnameLastname 11/26/2009 20:49''!!
+right: aParser do: aThreeArgumentBlock
+ "Define an operator aParser that is right-associative. Evaluate aThreeArgumentBlock with the first term, the operator, and the second term."
+
+ self operator: #build:right: parser: aParser do: aThreeArgumentBlock!! !!
+
+!!PPExpressionParser methodsFor: ''specifying'' stamp: ''lr 2/7/2010 23:20''!!
+group: aOneArgumentBlock
+ "Defines a priority group by evaluating aOneArgumentBlock."
+
+ operators := Dictionary new.
+ parser := [
+ aOneArgumentBlock value: self.
+ self buildOn: parser ]
+ ensure: [ operators := nil ]!! !!
+
+
+PPDelegateParser subclass: #PPCompositeParser
+ instanceVariableNames: ''dependencies''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Tools''!!
+!!PPCompositeParser commentStamp: ''lr 12/4/2009 18:38'' prior: 0!!
+A PPCompositeParser is composed parser built from various primitive parsers.
+
+Every production in the receiver is specified as a method that returns its parser. Note that every production requires an instance variable of the same name, otherwise the production is not cached and cannot be used in recursive grammars. Productions should refer to each other by reading the respective inst-var. Note: these inst-vars are typically not written, as the assignment happens in the initialize method using reflection.
+
+The start production is defined in the method start. It is aliased to the inst-var parser defined in the superclass of PPCompositeParser.!!
+
+
+!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 6/4/2010 13:37''!!
+productionAt: aSymbol ifAbsent: aBlock
+ "Answer the production named aSymbol, if there is no such production answer the result of evaluating aBlock."
+
+ (self class ignoredNames includes: aSymbol asString)
+ ifTrue: [ ^ aBlock value ].
+ (self class startSymbol = aSymbol)
+ ifTrue: [ ^ parser ].
+ ^ self instVarAt: (self class allInstVarNames
+ indexOf: aSymbol asString
+ ifAbsent: [ ^ aBlock value ])!! !!
+
+!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 5/8/2011 15:45''!!
+productionNames
+ "Answer a dictionary of slot indexes and production names."
+
+ | productionNames ignoredNames |
+ productionNames := Dictionary new.
+ ignoredNames := self class ignoredNames
+ collect: [ :each | each asSymbol ].
+ self class allInstVarNames keysAndValuesDo: [ :key :value |
+ (ignoredNames includes: value asSymbol)
+ ifFalse: [ productionNames at: key put: value asSymbol ] ].
+ ^ productionNames!! !!
+
+!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 3/16/2013 21:41''!!
+dependencyAt: aClass
+ "Answer the dependent parser aClass. Throws an error if this parser class is not declared in the method #dependencies on the class-side of the receiver."
+
+ ^ dependencies at: aClass ifAbsent: [ self error: ''Undeclared dependency in '' , self class name , '' to '' , aClass name ]!! !!
+
+!!PPCompositeParser methodsFor: ''querying'' stamp: ''lr 12/4/2009 18:39''!!
+productionAt: aSymbol
+ "Answer the production named aSymbol."
+
+ ^ self productionAt: aSymbol ifAbsent: [ nil ]!! !!
+
+
+!!PPCompositeParser methodsFor: ''initialization'' stamp: ''lr 3/16/2013 17:15''!!
+initializeStartingAt: aSymbol dependencies: aDictionary
+ self initialize.
+ parser := PPDelegateParser named: aSymbol.
+ self productionNames keysAndValuesDo: [ :key :value |
+ self instVarAt: key put: (PPDelegateParser named: value) ].
+ dependencies := aDictionary!! !!
+
+
+!!PPCompositeParser methodsFor: ''accessing'' stamp: ''lr 5/16/2008 17:32''!!
+start
+ "Answer the production to start this parser with."
+
+ self subclassResponsibility!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPCompositeParser class
+ instanceVariableNames: ''''!!
+!!PPCompositeParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 1/29/2010 11:35''!!
+ignoredNames
+ "Answer a collection of instance-variables that should not be automatically initialized with productions, but that are used internal to the composite parser."
+
+ ^ PPCompositeParser allInstVarNames!! !!
+
+!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 12/7/2009 08:20''!!
+startSymbol
+ "Answer the method that represents the default start symbol."
+
+ ^ #start!! !!
+
+!!PPCompositeParser class methodsFor: ''accessing'' stamp: ''lr 3/16/2013 21:42''!!
+dependencies
+ "Answer a collection of PPCompositeParser classes that this parser directly dependends on. Override this method in subclasses to declare dependent parsers. The default implementation does not depend on other PPCompositeParser."
+
+ ^ #()!! !!
+
+
+!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!!
+debug: anObject startingAt: aSymbol onError: aBlock
+ ^ (self newStartingAt: aSymbol) debug: anObject onError: aBlock!! !!
+
+!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!!
+debug: anObject startingAt: aSymbol
+ ^ (self newStartingAt: aSymbol) debug: anObject!! !!
+
+!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:40''!!
+debug: anObject onError: aBlock
+ ^ self debug: anObject startingAt: self startSymbol onError: aBlock!! !!
+
+!!PPCompositeParser class methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 12/19/2013 15:39''!!
+debug: anObject
+ ^ self debug: anObject startingAt: self startSymbol!! !!
+
+
+!!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 3/16/2013 21:21''!!
+newStartingAt: aSymbol
+ "Answer a new parser starting at aSymbol. The code makes sure to resolve all dependent parsers correctly."
+
+ | parsers remaining |
+ parsers := IdentityDictionary new.
+ remaining := OrderedCollection with: self.
+ [ remaining isEmpty ] whileFalse: [
+ | dependency |
+ dependency := remaining removeLast.
+ (parsers includesKey: dependency) ifFalse: [
+ parsers at: dependency put: dependency basicNew.
+ remaining addAll: dependency dependencies ] ].
+ parsers keysAndValuesDo: [ :class :parser |
+ | dependencies |
+ dependencies := IdentityDictionary new.
+ class dependencies
+ do: [ :dependency | dependencies at: dependency put: (parsers at: dependency) ].
+ parser
+ initializeStartingAt: (class == self
+ ifTrue: [ aSymbol ]
+ ifFalse: [ class startSymbol ])
+ dependencies: dependencies ].
+ parsers keysAndValuesDo: [ :class :parser |
+ parser setParser: (parser perform: parser children first name).
+ parser productionNames keysAndValuesDo: [ :key :value |
+ (parser instVarAt: key) setParser: (parser perform: value) ] ].
+ ^ parsers at: self!! !!
+
+!!PPCompositeParser class methodsFor: ''instance creation'' stamp: ''lr 12/7/2009 08:24''!!
+new
+ "Answer a new parser starting at the default start symbol."
+
+ ^ self newStartingAt: self startSymbol!! !!
+
+
+!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!!
+parse: anObject onError: aBlock
+ ^ self parse: anObject startingAt: self startSymbol onError: aBlock!! !!
+
+!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 21:02''!!
+parse: anObject startingAt: aSymbol onError: aBlock
+ ^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock!! !!
+
+!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!!
+parse: anObject startingAt: aSymbol
+ ^ (self newStartingAt: aSymbol) parse: anObject!! !!
+
+!!PPCompositeParser class methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:57''!!
+parse: anObject
+ ^ self parse: anObject startingAt: self startSymbol!! !!
+
+
+PPParser subclass: #PPUnresolvedParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Tools''!!
+!!PPUnresolvedParser commentStamp: ''lr 11/28/2009 18:50'' prior: 0!!
+This is a temporary placeholder or forward reference to a parser that has not been defined yet. If everything goes well it will eventually be replaced with the real parser instance.!!
+
+
+!!PPUnresolvedParser methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:51''!!
+parseOn: aStream
+ self error: self printString , '' need to be resolved before execution.''!! !!
+
+
+!!PPUnresolvedParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:15''!!
+displayColor
+ ^ Color red!! !!
+
+
+!!PPUnresolvedParser methodsFor: ''testing'' stamp: ''lr 10/27/2008 11:29''!!
+isUnresolved
+ ^ true!! !!
+Object subclass: #PPParser
+ instanceVariableNames: ''properties''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPParser commentStamp: ''<historical>'' prior: 0!!
+An abstract parser for all parsers in PetitParser. Subclasses implement #parseOn: to perform the actual recursive-descent parsing. All parsers support a variety of methods to perform an actual parse, see the methods in the #parsing protocol. Parsers are combined with a series of operators that can be found in the #operations protocol.
+
+Instance Variables:
+ properties <Dictionary> Stores additional state in the parser object.!!
+
+
+!!PPParser methodsFor: ''*petitjava-operations'' stamp: ''sback 9/2/2010 23:01''!!
+javaToken
+ ^ PPJavaTokenParser on: self!! !!
+
+
+!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 12/18/2013 06:41''!!
+gtInspectorParserInspectorIn: composite
+ <gtInspectorPresentationOrder: 30>
+ composite custom: (
+ PPVerticalParserInspector new
+ title: ''Sampler'';
+ startOn: self)!! !!
+
+!!PPParser methodsFor: ''*petitgui'' stamp: ''AlexandreBergel 12/18/2013 16:40''!!
+gtGraphViewIn: composite
+ <gtInspectorPresentationOrder: 50>
+
+ composite roassal
+ title: ''Graph'';
+ painting: [ :view |
+ self visualizeStructureInGraphOn: view.
+ ].!! !!
+
+!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!!
+gtNamedTreeViewIn: composite
+ <gtInspectorPresentationOrder: 40>
+
+ composite tree
+ title: ''Named Tree'';
+ children: [:n | n namedChildren ];
+ format: [:n| n name ifNil: [ n asString ] ];
+ shouldExpandToLevel: 3!! !!
+
+!!PPParser methodsFor: ''*petitgui'' stamp: ''TudorGirba 6/24/2013 23:44''!!
+gtTreeViewIn: composite
+ <gtInspectorPresentationOrder: 40>
+
+ composite tree
+ title: ''Tree'';
+ children: [:n | n children ];
+ format: [:n| n name ifNil: [ n asString ] ifNotNil: [n name] ];
+ shouldExpandToLevel: 6!! !!
+
+
+!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 1/30/2013 19:35''!!
+morphicShapeDefault
+ ^ self newRowMorph
+ addMorphBack: (self newColumnMorph
+ addMorphBack: (self newSpacerMorph);
+ addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
+ makeForwardArrow;
+ yourself);
+ addMorphBack: (self newRowMorph
+ borderWidth: 1;
+ layoutInset: 3;
+ color: Color white;
+ addMorphBack: (StringMorph new
+ contents: self displayName;
+ color: self displayColor;
+ yourself);
+ yourself);
+ yourself!! !!
+
+!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 10:56''!!
+morphicProduction
+ ^ self newRowMorph
+ layoutInset: 4;
+ addMorphBack: (self newRowMorph
+ layoutInset: 4;
+ addMorphBack: (StringMorph new
+ contents: self displayName;
+ emphasis: TextEmphasis bold emphasisCode;
+ yourself);
+ yourself);
+ addMorphBack: (self morphicShapeSeen: IdentitySet new depth: 0);
+ addMorphBack: (self newColumnMorph
+ addMorphBack: (self newSpacerMorph);
+ addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
+ makeForwardArrow;
+ yourself);
+ yourself!! !!
+
+!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:24''!!
+morphicShapeSeen: aSet depth: anInteger
+ ^ self morphicShapeDefault!! !!
+
+!!PPParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/13/2009 13:43''!!
+morphicShapeSeen: aSet depth: anInteger do: aBlock
+ " avoid recursion "
+ (aSet includes: self)
+ ifTrue: [ ^ self morphicShapeDefault ].
+ " display nice name when possible "
+ (anInteger > 0 and: [ self name notNil ])
+ ifTrue: [ ^ self morphicShapeDefault ].
+ " don''t do it too deep "
+ (anInteger > 10)
+ ifTrue: [ ^ self morphicShapeDefault ].
+ aSet add: self.
+ ^ aBlock value: [ :parser |
+ parser
+ morphicShapeSeen: aSet
+ depth: anInteger + 1 ]!! !!
+
+
+!!PPParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 10/30/2010 11:54''!!
+transform: aBlock
+ "Answer a copy of all parsers reachable from the receiver transformed using aBlock."
+
+ | mapping root |
+ mapping := IdentityDictionary new.
+ self allParsersDo: [ :each |
+ mapping
+ at: each
+ put: (aBlock value: each copy) ].
+ root := mapping at: self.
+ [ | changed |
+ changed := false.
+ root allParsersDo: [ :each |
+ each children do: [ :old |
+ mapping at: old ifPresent: [ :new |
+ each replace: old with: new.
+ changed := true ] ] ].
+ changed ] whileTrue.
+ ^ root!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/13/2010 09:38''!!
+replace: aParser with: anotherParser
+ "Replace the references of the receiver pointing to aParser with anotherParser."!! !!
+
+
+!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
+namedChildrenDo: aBlock
+ "Iterate over the named children of the receiver."
+
+ self namedChildrenDo: aBlock seen: IdentitySet new!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:01''!!
+allNamedParsers
+ "Answer all the named parse nodes of the receiver."
+
+ | result |
+ result := OrderedCollection new.
+ self allNamedParsersDo: [ :parser | result addLast: parser ].
+ ^ result!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
+namedChildrenDo: aBlock seen: aSet
+ "Iterate over the named children of the receiver."
+
+ self children do: [ :each |
+ (aSet includes: each)
+ ifTrue: [ ^ self ].
+ aSet add: each.
+ each name isNil
+ ifTrue: [ each namedChildrenDo: aBlock seen: aSet ]
+ ifFalse: [ aBlock value: each ] ]!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:45''!!
+innerChildren
+ "Answer the inner children of the receiver."
+
+ | result |
+ result := OrderedCollection new.
+ self innerChildrenDo: [ :parser | result addLast: parser ].
+ ^ result!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:51''!!
+innerChildrenDo: aBlock seen: aSet
+ "Iterate over the inner children of the receiver."
+
+ self children do: [ :each |
+ (aSet includes: each)
+ ifTrue: [ ^ self ].
+ aSet add: each.
+ each name isNil ifTrue: [
+ aBlock value: each.
+ each innerChildrenDo: aBlock seen: aSet ] ]!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 12/3/2010 16:48''!!
+innerChildrenDo: aBlock
+ "Iterate over the inner children of the receiver."
+
+ self innerChildrenDo: aBlock seen: IdentitySet new!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:12''!!
+allNamedParsersDo: aBlock
+ "Iterate over all the named parse nodes of the receiver."
+
+ self allParsersDo: [ :each |
+ each name notNil
+ ifTrue: [ aBlock value: each ] ]!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-named'' stamp: ''lr 11/23/2010 10:55''!!
+namedChildren
+ "Answer the named children of the receiver."
+
+ | result |
+ result := OrderedCollection new.
+ self namedChildrenDo: [ :parser | result addLast: parser ].
+ ^ result!! !!
+
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
+trimBlanks
+ "Answer a new parser that consumes blanks before and after the receiving parser."
+
+ ^ self trim: #blank asParser!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 2/19/2010 07:42''!!
+answer: anObject
+ "Answer a new parser that always returns anObject from a successful parse."
+
+ ^ self ==> [ :nodes | anObject ]!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
+trim: aParser
+ "Answer a new parser that consumes and ignores aParser repeatedly before and after the receiving parser."
+
+ ^ PPTrimmingParser on: self trimmer: aParser!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/6/2011 20:28''!!
+map: aBlock
+ "Answer a new parser that works on the receiving sequence an passes in each element as a block argument."
+
+ ^ aBlock numArgs = 1
+ ifTrue: [ self ==> aBlock ]
+ ifFalse: [ self error: aBlock numArgs asString , '' arguments expected.'' ]
+!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 6/29/2010 14:25''!!
+token
+ "Answer a new parser that transforms the input to a token."
+
+ ^ PPTokenParser on: self!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/3/2011 14:59''!!
+foldRight: aBlock
+ "Answer a new parser that that folds the result of the receiver from right-to-left into aBlock. The argument aBlock must take two or more arguments."
+
+ | size args |
+ size := aBlock numArgs.
+ args := Array new: size.
+ ^ self ==> [ :nodes |
+ args at: size put: nodes last.
+ nodes size - size + 1 to: 1 by: 1 - size do: [ :index |
+ args
+ replaceFrom: 1 to: size - 1 with: nodes startingAt: index;
+ at: size put: (aBlock valueWithArguments: args) ].
+ args at: size ]!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/11/2011 11:03''!!
+trimSpaces
+ "Answer a new parser that consumes spaces before and after the receiving parser."
+
+ ^ self trim: #space asParser!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/15/2008 16:08''!!
+flatten
+ "Answer a new parser that flattens the underlying collection."
+
+ ^ PPFlattenParser on: self!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 7/31/2010 12:06''!!
+trim
+ "Answer a new parser that consumes spaces before and after the receiving parser."
+
+ ^ self trimSpaces!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 6/12/2010 10:20''!!
+>=> aBlock
+ "Answer a new parser that wraps the receiving parser with a two argument block. The first argument is the parsed stream, the second argument a continuation block on the delegate parser."
+
+ ^ PPWrappingParser on: self block: aBlock!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 5/12/2010 20:32''!!
+==> aBlock
+ "Answer a new parser that performs aBlock as action handler on success."
+
+ ^ PPActionParser on: self block: aBlock!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/3/2011 15:00''!!
+foldLeft: aBlock
+ "Answer a new parser that that folds the result of the receiver from left-to-right into aBlock. The argument aBlock must take two or more arguments."
+
+ | size args |
+ size := aBlock numArgs.
+ args := Array new: size.
+ ^ self ==> [ :nodes |
+ args at: 1 put: nodes first.
+ 2 to: nodes size by: size - 1 do: [ :index |
+ args
+ replaceFrom: 2 to: size with: nodes startingAt: index;
+ at: 1 put: (aBlock valueWithArguments: args) ].
+ args first ]!! !!
+
+!!PPParser methodsFor: ''operators-mapping'' stamp: ''lr 4/6/2010 19:26''!!
+token: aTokenClass
+ "Answer a new parser that transforms the input to a token of class aTokenClass."
+
+ ^ self token tokenClass: aTokenClass!! !!
+
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
+max: anInteger lazy: aParser
+ "Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed."
+
+ ^ (self starLazy: aParser) setMax: anInteger!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:01''!!
+starLazy: aParser
+ "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed."
+
+ ^ PPLazyRepeatingParser on: self limit: aParser!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 9/15/2010 09:34''!!
+times: anInteger
+ "Answer a new parser that parses the receiver exactly anInteger times."
+
+ ^ self min: anInteger max: anInteger!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
+min: aMinInteger max: aMaxInteger greedy: aParser
+ "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
+
+ ^ (self starGreedy: aParser) setMin: aMinInteger; setMax: aMaxInteger!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:02''!!
+star
+ "Answer a new parser that parses the receiver zero or more times. This is a greedy and blind implementation that tries to consume as much input as possible and it does not consider what comes afterwards."
+
+ ^ PPPossessiveRepeatingParser on: self!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:02''!!
+min: anInteger
+ "Answer a new parser that parses the receiver at least anInteger times."
+
+ ^ self star setMin: anInteger!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
+min: aMinInteger max: aMaxInteger
+ "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times."
+
+ ^ self star setMin: aMinInteger; setMax: aMaxInteger!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/2/2011 10:01''!!
+starGreedy: aParser
+ "Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed."
+
+ ^ PPGreedyRepeatingParser on: self limit: aParser!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
+min: aMinInteger max: aMaxInteger lazy: aParser
+ "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
+
+ ^ (self starLazy: aParser) setMin: aMinInteger; setMax: aMaxInteger!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:57''!!
+min: anInteger lazy: aParser
+ "Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed."
+
+ ^ (self starLazy: aParser) setMin: anInteger!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
+max: anInteger greedy: aParser
+ "Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
+
+ ^ (self starGreedy: aParser) setMax: anInteger!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
+plus
+ "Answer a new parser that parses the receiver one or more times."
+
+ ^ self star setMin: 1!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/3/2011 14:56''!!
+min: anInteger greedy: aParser
+ "Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
+
+ ^ (self starGreedy: aParser) setMin: anInteger!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:03''!!
+max: anInteger
+ "Answer a new parser that parses the receiver at most anInteger times."
+
+ ^ self star setMax: anInteger!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:04''!!
+plusGreedy: aParser
+ "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed."
+
+ ^ (self starGreedy: aParser) setMin: 1!! !!
+
+!!PPParser methodsFor: ''operators-repeating'' stamp: ''lr 4/1/2011 21:04''!!
+plusLazy: aParser
+ "Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed."
+
+ ^ (self starLazy: aParser) setMin: 1!! !!
+
+
+!!PPParser methodsFor: ''*petitsmalltalk-operations'' stamp: ''lr 6/29/2010 14:27''!!
+smalltalkToken
+ ^ PPSmalltalkTokenParser on: self!! !!
+
+
+!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 5/22/2010 10:45''!!
+isTerminal
+ "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
+
+ ^ self children isEmpty!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''JanKurs 5/31/2013 11:49''!!
+isFirstSetTerminal
+ "Answer true if the receiver is a terminal or leaf parser, that means it does not delegate to any other parser."
+
+ ^ self children isEmpty!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 11/12/2009 17:25''!!
+isNullable
+ "Answer true if the receiver is a nullable parser, e.g. it can successfully parse nothing."
+
+ ^ false!! !!
+
+
+!!PPParser methodsFor: ''converting'' stamp: ''lr 11/29/2011 20:48''!!
+asParser
+ "Answer the receiving parser."
+
+ ^ self!! !!
+
+
+!!PPParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:36''!!
+printNameOn: aStream
+ self name isNil
+ ifTrue: [ aStream print: self hash ]
+ ifFalse: [ aStream nextPutAll: self name ]!! !!
+
+!!PPParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:36''!!
+printOn: aStream
+ super printOn: aStream.
+ aStream nextPut: $(.
+ self printNameOn: aStream.
+ aStream nextPut: $)!! !!
+
+
+!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:37''!!
+example
+ ^ String streamContents: [ :stream | self exampleOn: stream ] limitedTo: 1024!! !!
+
+!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:20''!!
+exampleOn: aStream!! !!
+
+!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 9/12/2011 18:34''!!
+displayColor
+ ^ self isTerminal
+ ifTrue: [ Color r: 0.5 g: 0.0 b: 0.5 ]
+ ifFalse: [ Color blue ]!! !!
+
+!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:31''!!
+displayName
+ ^ self name isNil
+ ifFalse: [ self name asString ]
+ ifTrue: [ self class name asString ]!! !!
+
+!!PPParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:11''!!
+backgroundForDepth: anInteger
+ ^ Color gray: 1.0 - (anInteger / 20.0)!! !!
+
+
+!!PPParser methodsFor: ''parsing'' stamp: ''lr 10/29/2010 17:05''!!
+parse: anObject onError: aBlock
+ "Parse anObject with the receiving parser and answer the parse-result or answer the result of evaluating aBlock. Depending on the number of arguments of the block it is simply evaluated, evaluated with the failure object, or evaluated with the error message and position."
+
+ | result |
+ result := self parse: anObject.
+ result isPetitFailure
+ ifFalse: [ ^ result ].
+ aBlock numArgs = 0
+ ifTrue: [ ^ aBlock value ].
+ aBlock numArgs = 1
+ ifTrue: [ ^ aBlock value: result ].
+ ^ aBlock value: result message value: result position!! !!
+
+!!PPParser methodsFor: ''parsing'' stamp: ''lr 6/4/2011 18:12''!!
+matchesIn: anObject
+ "Search anObject repeatedly for the matches of the receiver. Answered an OrderedCollection of the matched parse-trees."
+
+ | result |
+ result := OrderedCollection new.
+ self
+ matchesIn: anObject
+ do: [ :each | result addLast: each ].
+ ^ result!! !!
+
+!!PPParser methodsFor: ''parsing'' stamp: ''lr 8/16/2011 07:26''!!
+matchesSkipIn: anObject
+ "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of the matched parse-trees. Skip over matches."
+
+ | result |
+ result := OrderedCollection new.
+ self
+ matchesSkipIn: anObject
+ do: [ :each | result addLast: each ].
+ ^ result!! !!
+
+!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/25/2013 23:42''!!
+matchingSkipRangesIn: anObject do: aBlock
+ "Search anObject repeatedly for the matches of the receiver. Skip over matches. Evaluate aBlock with the range of each match (index of first character to: index of last character)."
+
+ self token
+ matchesSkipIn: anObject
+ do: [ :token | aBlock value: (token start to: token stop) ]!! !!
+
+!!PPParser methodsFor: ''parsing'' stamp: ''DamienCassou 10/29/2011 19:18''!!
+matchingSkipRangesIn: anObject
+ "Search anObject repeatedly for the matches of the receiver. Skip over matches. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)."
+
+ | result |
+ result := OrderedCollection new.
+ self
+ matchingSkipRangesIn: anObject
+ do: [ :value | result addLast: value ].
+ ^ result!! !!
+
+!!PPParser methodsFor: ''parsing'' stamp: ''lr 6/4/2011 18:12''!!
+matchingRangesIn: anObject
+ "Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)."
+
+ | result |
+ result := OrderedCollection new.
+ self
+ matchingRangesIn: anObject
+ do: [ :value | result addLast: value ].
+ ^ result!! !!
+
+!!PPParser methodsFor: ''parsing'' stamp: ''lr 8/16/2011 07:26''!!
+matchesSkipIn: anObject do: aBlock
+ "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Skip over matches."
+
+ (self ==> aBlock / #any asParser) star parse: anObject!! !!
+
+!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/25/2013 23:41''!!
+matchingRangesIn: anObject do: aBlock
+ "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock with the range of each match (index of first character to: index of last character)."
+
+ self token
+ matchesIn: anObject
+ do: [ :token | aBlock value: (token start to: token stop) ]!! !!
+
+!!PPParser methodsFor: ''parsing'' stamp: ''lr 2/8/2010 00:30''!!
+matches: anObject
+ "Answer if anObject can be parsed by the receiver."
+
+ ^ (self parse: anObject) isPetitFailure not!! !!
+
+!!PPParser methodsFor: ''parsing'' stamp: ''lr 3/1/2010 21:51''!!
+matchesIn: anObject do: aBlock
+ "Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Make sure to always consume exactly one character with each step, to not miss any match."
+
+ ((self and ==> aBlock , #any asParser) / #any asParser) star parse: anObject!! !!
+
+
+!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 5/31/2010 18:37''!!
+matchList: matchList index: matchIndex against: parserList index: parserIndex inContext: aDictionary seen: aSet
+ | parser currentIndex currentDictionary currentSeen parsers |
+ matchList size < matchIndex
+ ifTrue: [ ^ parserList size < parserIndex ].
+ parser := matchList at: matchIndex.
+ parser class = PPListPattern ifTrue: [
+ currentIndex := parserIndex - 1.
+ [ currentDictionary := aDictionary copy.
+ currentSeen := aSet copy.
+ parserList size < currentIndex or: [
+ parsers := parserList copyFrom: parserIndex to: currentIndex.
+ (currentDictionary at: parser ifAbsentPut: [ parsers ]) = parsers and: [
+ (self
+ matchList: matchList
+ index: matchIndex + 1
+ against: parserList
+ index: currentIndex + 1
+ inContext: currentDictionary
+ seen: currentSeen)
+ ifTrue: [
+ currentDictionary keysAndValuesDo: [ :key :value | aDictionary at: key put: value ].
+ ^ true ].
+ false ] ] ] whileFalse: [ currentIndex := currentIndex + 1 ].
+ ^ false ].
+ parserList size < parserIndex
+ ifTrue: [ ^ false ].
+ (parser match: (parserList at: parserIndex) inContext: aDictionary seen: aSet)
+ ifFalse: [ ^ false ].
+ ^ self
+ matchList: matchList
+ index: matchIndex + 1
+ against: parserList
+ index: parserIndex + 1
+ inContext: aDictionary
+ seen: aSet!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 7/17/2011 11:53''!!
+copyInContext: aDictionary seen: aSeenDictionary
+ | copy |
+ aSeenDictionary
+ at: self
+ ifPresent: [ :value | ^ value ].
+ copy := aSeenDictionary
+ at: self
+ put: self copy.
+ copy children do: [ :each |
+ copy
+ replace: each
+ with: (each copyInContext: aDictionary seen: aSeenDictionary) ].
+ ^ copy!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 07:49''!!
+copyInContext: aDictionary
+ ^ self copyInContext: aDictionary seen: IdentityDictionary new!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/29/2010 23:07''!!
+matchList: matchList against: parserList inContext: aDictionary seen: aSet
+ ^ self matchList: matchList index: 1 against: parserList index: 1 inContext: aDictionary seen: aSet!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
+match: aParser inContext: aDictionary seen: anIdentitySet
+ "This is the default implementation to match two parsers. This code can properly handle recursion. This is code is supposed to be overridden in subclasses that add new state."
+
+ (self == aParser or: [ anIdentitySet includes: self ])
+ ifTrue: [ ^ true ].
+ anIdentitySet add: self.
+ ^ self class = aParser class and: [ self matchList: self children against: aParser children inContext: aDictionary seen: anIdentitySet ]!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/29/2010 23:14''!!
+match: aParser inContext: aDictionary
+ ^ self match: aParser inContext: aDictionary seen: IdentitySet new!! !!
+
+
+!!PPParser methodsFor: ''testing'' stamp: ''lr 10/27/2008 11:28''!!
+isUnresolved
+ ^ false!! !!
+
+!!PPParser methodsFor: ''testing'' stamp: ''lr 8/6/2010 16:44''!!
+isPetitParser
+ ^ true!! !!
+
+
+!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
+propertyAt: aKey ifAbsentPut: aBlock
+ "Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value."
+
+ ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !!
+
+!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
+removeProperty: aKey ifAbsent: aBlock
+ "Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock."
+
+ | answer |
+ properties isNil ifTrue: [ ^ aBlock value ].
+ answer := properties removeKey: aKey ifAbsent: aBlock.
+ properties isEmpty ifTrue: [ properties := nil ].
+ ^ answer!! !!
+
+!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
+propertyAt: aKey
+ "Answer the property value associated with aKey."
+
+ ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
+
+!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
+propertyAt: aKey ifAbsent: aBlock
+ "Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock."
+
+ ^ properties isNil
+ ifTrue: [ aBlock value ]
+ ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !!
+
+!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
+propertyAt: aKey put: anObject
+ "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
+
+ ^ (properties ifNil: [ properties := Dictionary new: 1 ])
+ at: aKey put: anObject!! !!
+
+!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:32''!!
+hasProperty: aKey
+ "Test if the property aKey is present."
+
+ ^ properties notNil and: [ properties includesKey: aKey ]!! !!
+
+!!PPParser methodsFor: ''accessing-properties'' stamp: ''lr 4/19/2010 10:33''!!
+removeProperty: aKey
+ "Remove the property with aKey. Answer the property or raise an error if aKey isn''t found."
+
+ ^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
+
+
+!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:41''!!
+visualizationGraphType
+ ^ nil!! !!
+
+!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:26''!!
+visualizeStructureInGraphOn: view
+ view shape rectangle
+ borderWidth: 1;
+ if: [ :p | p name isNil ] fillColor: Color lightGray.
+
+ view interaction
+ item: ''Explore'' action: #explore;
+ highlightWhenOver: [ :p |
+ self allParsers select: [ :ch | ch children includes: p ]
+ ] color: Color orange muchLighter;
+ highlightWhenOver: [ :p | |children|
+ children := p namedChildren.
+ ] color: Color orange muchDarker;
+ highlightWhenOver: [ :p | Array with: p ] color: Color orange;
+ popupText: [:p | p class name asString ].
+
+ view
+ nodes: self allParsers
+ forEach: [ :aParser | |labels|
+ labels := OrderedCollection new.
+ aParser name notNil ifTrue: [ labels add: aParser name ].
+ aParser visualizationGraphType notNil ifTrue: [ labels add: aParser visualizationGraphType ].
+ labels isEmpty ifFalse: [
+ view shape label.
+ view interaction forwarder.
+ view nodes: labels asArray ].
+ ].
+
+ view shape: (ROLine new add: (ROArrow new size: 4) offset: 0.1).
+ view edgesToAll: #children.
+ view treeLayout
+ layered;
+ on: ROLayoutEnd do: [ :evt | ROFocusView on: (view raw elementFromModel: self) ].
+
+ view zoomInButton.
+ view zoomOutButton.!! !!
+
+!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''tg 8/25/2010 00:32''!!
+namedParsersDo: aBlock
+ self namedParsersDo: aBlock seen: IdentitySet new!! !!
+
+!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''VincentBlondeau 2/14/2014 17:06''!!
+viewAllNamedParsersWithSelection: aCollectionOfNames previewing: aBlock on: view
+ view shape label
+ color: [ :each |
+ (aCollectionOfNames includes: each name)
+ ifFalse: [ Color black ]
+ ifTrue: [ Color red ] ];
+ text: [ :each | each displayName ].
+ view interaction popupText: aBlock.
+ view interaction item: ''Explore'' action: #explore.
+ view nodes: (self allParsers reject: [ :each | each name isEmptyOrNil ]).
+ view edges: (self allParsers reject: [ :each | each name isEmptyOrNil ]) from: #yourself toAll: #namedParsers.
+ view horizontalDominanceTreeLayout
+ verticalGap: 10;
+ layered!! !!
+
+!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:21''!!
+visualizeStructureInGraph
+
+ "
+ PPSmalltalkParser new visualize
+
+
+ "
+ | view |
+
+ view := ROMondrianViewBuilder new.
+ self visualizeStructureInGraphOn: view.
+ view open.
+ ^ view!! !!
+
+!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''VincentBlondeau 2/14/2014 17:06''!!
+viewAllNamedParsersOn: view
+ view shape
+ rectangleWithoutBorder;
+ withText: #displayName.
+ view nodes: (self allParsers reject: [ :each | each name isEmptyOrNil ]).
+ view edgesToAll: #namedParsers.
+ view horizontalDominanceTreeLayout layered!! !!
+
+!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 12/6/2011 07:43''!!
+viewAllNamedParsersWithSelection: aCollectionOfNames on: view
+ self viewAllNamedParsersWithSelection: aCollectionOfNames previewing: [ :each | each name ] on: view!! !!
+
+!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 12/14/2011 12:40''!!
+namedParsersDo: aBlock seen: aSet
+ self children do: [ :each |
+ (aSet includes: each)
+ ifFalse: [
+ aSet add: each.
+ each name isEmptyOrNil
+ ifFalse: [ aBlock value: each ]
+ ifTrue: [ each namedParsersDo: aBlock seen: aSet ] ] ]!! !!
+
+!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''TudorGirba 6/5/2013 23:01''!!
+viewAllNamedParsers
+ | view |
+ view := ROMondrianViewBuilder new.
+ self viewAllNamedParsersOn: view.
+ ^ view open setLabel: ''All named parsers''!! !!
+
+!!PPParser methodsFor: ''*petitgui-mondrian'' stamp: ''tg 8/25/2010 00:31''!!
+namedParsers
+ | result |
+ result := OrderedCollection new.
+ self namedParsersDo: [ :parser | result addLast: parser ].
+ ^ result!! !!
+
+
+!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:36''!!
+allParsers
+ "Answer all the parse nodes of the receiver."
+
+ | result |
+ result := OrderedCollection new.
+ self allParsersDo: [ :parser | result addLast: parser ].
+ ^ result!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:36''!!
+allParsersDo: aBlock
+ "Iterate over all the parse nodes of the receiver."
+
+ self allParsersDo: aBlock seen: IdentitySet new!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-enumerating'' stamp: ''lr 4/13/2010 08:35''!!
+allParsersDo: aBlock seen: aSet
+ "Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."
+
+ (aSet includes: self)
+ ifTrue: [ ^ self ].
+ aSet add: self.
+ aBlock value: self.
+ self children
+ do: [ :each | each allParsersDo: aBlock seen: aSet ]!! !!
+
+
+!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/19/2010 07:56''!!
+separatedBy: aParser
+ "Answer a new parser that parses the receiver one or more times, separated by aParser."
+
+ ^ (PPSequenceParser with: self with: (PPSequenceParser with: aParser with: self) star) ==> [ :nodes |
+ | result |
+ result := Array new: 2 * nodes second size + 1.
+ result at: 1 put: nodes first.
+ nodes second
+ keysAndValuesDo: [ :index :pair | result replaceFrom: 2 * index to: 2 * index + 1 with: pair startingAt: 1 ].
+ result ]!! !!
+
+!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/19/2010 07:42''!!
+delimitedBy: aParser
+ "Answer a new parser that parses the receiver one or more times, separated and possibly ended by aParser."
+
+ ^ (self separatedBy: aParser) , (aParser optional) ==> [ :node |
+ node second isNil
+ ifTrue: [ node first ]
+ ifFalse: [ node first copyWith: node second ] ]!! !!
+
+!!PPParser methodsFor: ''operators-convenience'' stamp: ''lr 2/25/2012 16:54''!!
+withoutSeparators
+ "Filters out the separators from a parse result produced by one of the productions #delimitedBy: or #separatedBy:."
+
+ ^ self ==> [ :items |
+ | result |
+ result := Array new: items size + 1 // 2.
+ 1 to: result size do: [ :index | result at: index put: (items at: 2 * index - 1) ].
+ result ]!! !!
+
+
+!!PPParser methodsFor: ''copying'' stamp: ''lr 4/19/2010 10:33''!!
+postCopy
+ super postCopy.
+ properties := properties copy!! !!
+
+
+!!PPParser methodsFor: ''initialization'' stamp: ''lr 4/24/2008 10:33''!!
+initialize!! !!
+
+
+!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 21:58''!!
+newColumnMorph
+ ^ AlignmentMorph newColumn
+ cellPositioning: #topLeft;
+ color: Color transparent;
+ listCentering: #topLeft;
+ vResizing: #shrinkWrap;
+ hResizing: #shrinkWrap;
+ layoutInset: 0;
+ yourself!! !!
+
+!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 21:57''!!
+newRowMorph
+ ^ AlignmentMorph newRow
+ cellPositioning: #topLeft;
+ color: Color transparent;
+ listCentering: #topLeft;
+ vResizing: #shrinkWrap;
+ hResizing: #shrinkWrap;
+ layoutInset: 0;
+ yourself!! !!
+
+!!PPParser methodsFor: ''*petitgui-morphic-creational'' stamp: ''lr 11/17/2009 22:03''!!
+newSpacerMorph
+ ^ Morph new
+ color: Color transparent;
+ borderWidth: 0;
+ extent: 7 @ 7;
+ yourself!! !!
+
+
+!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 9/16/2010 17:55''!!
+followSets
+ "Answer a dictionary with all the parsers reachable from the receiver as key and their follow-set as value. The follow-set of a parser is the list of terminal parsers that can appear immediately to the right of that parser."
+
+ | current previous continue firstSets followSets |
+ current := previous := 0.
+ firstSets := self firstSets.
+ followSets := IdentityDictionary new.
+ self allParsersDo: [ :each | followSets at: each put: IdentitySet new ].
+ (followSets at: self) add: PPSentinel instance.
+ [ followSets keysAndValuesDo: [ :parser :follow |
+ parser
+ followSets: followSets
+ firstSets: firstSets
+ into: follow ].
+ current := followSets
+ inject: 0
+ into: [ :result :each | result + each size ].
+ continue := previous < current.
+ previous := current.
+ continue ] whileTrue.
+ ^ followSets!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 10/22/2009 19:59''!!
+firstSet
+ "Answer the first-set of the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #firstSets to calculate the first-sets at once."
+
+ ^ self firstSets at: self!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 11/19/2009 23:49''!!
+cycleSet
+ "Answer a set of all nodes that are within one or more cycles of left-recursion. This is generally not a problem if at least one of the nodes is memoized, but it might make the grammar very inefficient and should be avoided if possible."
+
+ | cycles |
+ cycles := IdentitySet new.
+ self cycleSet: OrderedCollection new firstSets: self firstSets into: cycles.
+ ^ cycles!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''JanKurs 5/31/2013 11:49''!!
+firstSets
+ "Answer a dictionary with all the parsers reachable from the receiver as key and their first-set as value. The first-set of a parser is the list of terminal parsers that begin the parser derivable from that parser."
+
+ | firstSets |
+ firstSets := IdentityDictionary new.
+ self allParsersDo: [ :each |
+ firstSets at: each put: (each isFirstSetTerminal
+ ifTrue: [ IdentitySet with: each ]
+ ifFalse: [ IdentitySet new ]).
+ each isNullable
+ ifTrue: [ (firstSets at: each) add: PPSentinel instance ] ].
+ [ | changed tally |
+ changed := false.
+ firstSets keysAndValuesDo: [ :parser :first |
+ tally := first size.
+ parser firstSets: firstSets into: first.
+ changed := changed or: [ tally ~= first size ] ].
+ changed ] whileTrue.
+ ^ firstSets!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-querying'' stamp: ''lr 11/12/2009 21:13''!!
+followSet
+ "Answer the follow-set of the receiver starting at the receiver. Note, this implementation is inefficient when called on different receivers of the same grammar, instead use #followSets to calculate the follow-sets at once."
+
+ ^ self followSets at: self!! !!
+
+
+!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:30''!!
+parseOn: aPPContext
+ "Parse aStream with the receiving parser and answer the parse-result or an instance of PPFailure. Override this method in subclasses to specify custom parse behavior. Do not call this method from outside, instead use #parse:."
+
+ self subclassResponsibility!! !!
+
+!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/17/2014 13:15''!!
+debugWithContext: aPPContext
+
+ ^ self enableDebug parseWithContext: aPPContext !! !!
+
+!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/11/2014 13:33''!!
+updateContext: aPPContext
+ "nothing to do"!! !!
+
+!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:26''!!
+parse: anObject withContext: aPPContext
+ "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
+
+ aPPContext stream: anObject asPetitStream.
+ ^ self parseWithContext: aPPContext.
+!! !!
+
+!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:25''!!
+parse: anObject
+ "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
+
+ ^ self parse: anObject withContext: PPContext new!! !!
+
+!!PPParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/19/2014 16:34''!!
+parseWithContext: context
+ context root: self.
+ self updateContext: context.
+ ^ self parseOn: context!! !!
+
+
+!!PPParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:38''!!
+children
+ "Answer a set of child parsers that could follow the receiver."
+
+ ^ #()!! !!
+
+!!PPParser methodsFor: ''accessing'' stamp: ''lr 4/19/2010 10:38''!!
+name: aString
+ self propertyAt: #name put: aString!! !!
+
+!!PPParser methodsFor: ''accessing'' stamp: ''lr 4/19/2010 10:35''!!
+name
+ "Answer the production name of the receiver."
+
+ ^ self propertyAt: #name ifAbsent: [ nil ]!! !!
+
+
+!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/19/2009 23:47''!!
+cycleSet: aDictionary
+ "PRIVATE: Answer the children that could be part of a cycle-set with the receiver, subclasses might restrict the number of children returned. aDictionary is pre-calcualted first-sets."
+
+ ^ self children!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 5/22/2010 10:45''!!
+cycleSet: aStack firstSets: aDictionary into: aSet
+ "PRIVATE: Try to find a cycle, where aStack contains the previously visited parsers. The method returns quickly when the receiver is a terminal, terminals cannot be part of a cycle. If aStack already contains the receiver, then we are in a cycle. In this case we don''t process the children further and add the nodes to aSet."
+
+ | index |
+ self isTerminal
+ ifTrue: [ ^ self ].
+ (index := aStack indexOf: self) > 0
+ ifTrue: [ ^ aSet addAll: (aStack copyFrom: index to: aStack size) ].
+ aStack addLast: self.
+ (self cycleSet: aDictionary)
+ do: [ :each | each cycleSet: aStack firstSets: aDictionary into: aSet ].
+ aStack removeLast!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/12/2009 21:25''!!
+firstSets: aFirstDictionary into: aSet
+ "PRIVATE: Try to add additional elements to the first-set aSet of the receiver, use the incomplete aFirstDictionary."
+
+ self children do: [ :parser | aSet addAll: (aFirstDictionary at: parser) ]!! !!
+
+!!PPParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 11/12/2009 21:25''!!
+followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
+ "PRIVATE: Try to add additional elements to the follow-set aSet of the receiver, use the incomplete aFollowDictionary and the complete aFirstDictionary."
+
+ self children do: [ :parser | (aFollowDictionary at: parser) addAll: aSet ]!! !!
+
+
+!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 1/16/2014 15:41''!!
+debug: anObject
+ "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
+
+ ^ self enableDebug parse: anObject asPetitStream!! !!
+
+!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 12:21''!!
+enableDebuggerOutput
+ self debuggerOutput: true.!! !!
+
+!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 4/22/2013 18:04''!!
+debuggerOutput: aBoolean
+ self propertyAt: #debuggerOutput put: aBoolean!! !!
+
+!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 12:21''!!
+disableDebuggerOutput
+ self debuggerOutput: false. !! !!
+
+!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 3/18/2014 17:01''!!
+enableDebug
+ | root newParser |
+ root := PPParserDebuggerResult new.
+
+ newParser := self transform: [:each |
+ each >=> [:stream :continuation |
+ | result child |
+ child := PPParserDebuggerResult new
+ parser: each;
+ parent: root.
+ root := root children add: child.
+ child start: stream position + 1.
+ child showChildren: each debuggerOutput.
+ result := continuation value.
+ child end: stream position.
+ root result: result.
+ root := root parent.
+ result
+ ]
+ ].
+
+ ^ PPDebugParser on: newParser root: root.
+!! !!
+
+!!PPParser methodsFor: ''*petitgui-debug'' stamp: ''JanKurs 4/22/2013 18:04''!!
+debuggerOutput
+ ^ self propertyAt: #debuggerOutput ifAbsentPut: true.!! !!
+
+
+!!PPParser methodsFor: ''operators'' stamp: ''lr 2/19/2010 07:36''!!
+negate
+ "Answer a new parser consumes any input token but the receiver."
+
+ ^ self not , #any asParser ==> #second!! !!
+
+!!PPParser methodsFor: ''operators'' stamp: ''lr 9/1/2010 22:03''!!
+optional
+ "Answer a new parser that parses the receiver, if possible."
+
+ ^ PPOptionalParser on: self!! !!
+
+!!PPParser methodsFor: ''operators'' stamp: ''lr 12/3/2010 11:34''!!
+def: aParser
+ "Redefine the receiver as the argument aParser. This method is useful when defining recursive parsers: instantiate a PPUnresolvedParser and later redefine it with another one."
+
+ ^ self becomeForward: (aParser name: self name)!! !!
+
+!!PPParser methodsFor: ''operators'' stamp: ''lr 10/23/2008 14:05''!!
+wrapped
+ "Answer a new parser that is simply wrapped."
+
+ ^ PPDelegateParser on: self!! !!
+
+!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 16:34''!!
+memoized
+ "Answer a new memoized parser, for refraining redundant computations. This ensures polynomial time O(n^4) for left-recursive grammars and O(n^3) for non left-recursive grammars in the worst case. Not necessary for most grammars that are carefully written and in O(n) anyway."
+
+ ^ PPMemoizedParser on: self!! !!
+
+!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 15:12''!!
+and
+ "Answer a new parser (logical and-predicate) that succeeds whenever the receiver does, but never consumes input."
+
+ ^ PPAndParser on: self!! !!
+
+!!PPParser methodsFor: ''operators'' stamp: ''lr 4/14/2010 11:46''!!
+/ aParser
+ "Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice)."
+
+ ^ PPChoiceParser with: self with: aParser!! !!
+
+!!PPParser methodsFor: ''operators'' stamp: ''lr 4/30/2010 12:13''!!
+end
+ "Answer a new parser that succeeds at the end of the input and return the result of the receiver."
+
+ ^ PPEndOfInputParser on: self!! !!
+
+!!PPParser methodsFor: ''operators'' stamp: ''lr 5/31/2010 15:12''!!
+not
+ "Answer a new parser (logical not-predicate) that succeeds whenever the receiver fails, but never consumes input."
+
+ ^ PPNotParser on: self!! !!
+
+!!PPParser methodsFor: ''operators'' stamp: ''lr 4/14/2010 11:53''!!
+| aParser
+ "Answer a new parser that either parses the receiver or aParser. Fail if both pass or fail (exclusive choice, unordered choice)."
+
+ ^ (self not , aParser) / (aParser not , self) ==> #second!! !!
+
+!!PPParser methodsFor: ''operators'' stamp: ''lr 9/23/2008 18:32''!!
+, aParser
+ "Answer a new parser that parses the receiver followed by aParser."
+
+ ^ PPSequenceParser with: self with: aParser!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPParser class
+ instanceVariableNames: ''''!!
+!!PPParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPParser class methodsFor: ''instance creation'' stamp: ''lr 10/27/2008 11:17''!!
+named: aString
+ ^ self new name: aString!! !!
+
+!!PPParser class methodsFor: ''instance creation'' stamp: ''lr 4/18/2008 14:00''!!
+new
+ ^ self basicNew initialize!! !!
+
+
+PPParser subclass: #PPPluggableParser
+ instanceVariableNames: ''block''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPPluggableParser commentStamp: ''<historical>'' prior: 0!!
+A pluggable parser that passes the parser stream into a block. This enables users to perform manual parsing or to embed other parser frameworks into PetitParser.
+
+Instance Variables:
+ block <BlockClosure> The pluggable one-argument block.
+!!
+
+
+!!PPPluggableParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
+match: aParser inContext: aDictionary seen: anIdentitySet
+ ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]!! !!
+
+
+!!PPPluggableParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 16:52''!!
+initializeOn: aBlock
+ block := aBlock!! !!
+
+
+!!PPPluggableParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:42''!!
+parseOn: aPPContext
+ | position result |
+ position := aPPContext remember.
+ result := block value: aPPContext.
+ result isPetitFailure
+ ifTrue: [ aPPContext restore: position ].
+ ^ result!! !!
+
+
+!!PPPluggableParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:41''!!
+displayName
+ ^ String streamContents: [ :stream | block decompile shortPrintOn: stream ]!! !!
+
+
+!!PPPluggableParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
+block
+ "Answer the pluggable block."
+
+ ^ block!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPPluggableParser class
+ instanceVariableNames: ''''!!
+!!PPPluggableParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPPluggableParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 16:52''!!
+on: aBlock
+ ^ self new initializeOn: aBlock!! !!
+
+
+PPParser subclass: #PPFailingParser
+ instanceVariableNames: ''message''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPFailingParser commentStamp: ''<historical>'' prior: 0!!
+A parser that consumes nothing and always fails.
+
+Instance Variables:
+ message <String> The failure message.!!
+
+
+!!PPFailingParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 19:16''!!
+setMessage: aString
+ message := aString!! !!
+
+
+!!PPFailingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:59''!!
+parseOn: aPPContext
+ ^ PPFailure message: message context: aPPContext!! !!
+
+
+!!PPFailingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:43''!!
+displayName
+ ^ message!! !!
+
+!!PPFailingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:16''!!
+displayColor
+ ^ Color red!! !!
+
+
+!!PPFailingParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 21:27''!!
+printNameOn: aStream
+ super printNameOn: aStream.
+ aStream nextPutAll: '', ''; print: message!! !!
+
+
+!!PPFailingParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 12:01''!!
+match: aParser inContext: aDictionary seen: anIdentitySet
+ ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self message = aParser message ]!! !!
+
+
+!!PPFailingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
+message
+ "Answer the error message of the receiving parser."
+
+ ^ message!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPFailingParser class
+ instanceVariableNames: ''''!!
+!!PPFailingParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPFailingParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 19:16''!!
+message: aString
+ ^ self new setMessage: aString!! !!
+
+
+PPParser subclass: #PPLiteralParser
+ instanceVariableNames: ''literal message''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPLiteralParser commentStamp: ''<historical>'' prior: 0!!
+Abstract literal parser that parses some kind of literal type (to be specified by subclasses).
+
+Instance Variables:
+ literal <Object> The literal object to be parsed.
+ message <String> The error message to be generated.
+!!
+
+
+!!PPLiteralParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 9/15/2010 12:08''!!
+match: aParser inContext: aDictionary seen: anIdentitySet
+ ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self literal = aParser literal and: [ self message = aParser message ] ]!! !!
+
+
+!!PPLiteralParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 17:25''!!
+visualizationGraphType
+ ^ literal printString!! !!
+
+
+!!PPLiteralParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:19''!!
+displayName
+ ^ literal printString!! !!
+
+
+!!PPLiteralParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:26''!!
+message
+ "Answer the failure message."
+
+ ^ message!! !!
+
+!!PPLiteralParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:26''!!
+literal
+ "Answer the parsed literal."
+
+ ^ literal!! !!
+
+
+!!PPLiteralParser methodsFor: ''operators'' stamp: ''lr 6/1/2010 22:24''!!
+caseInsensitive
+ "Answer a parser that can parse the receiver case-insensitive."
+
+ self subclassResponsibility!! !!
+
+
+!!PPLiteralParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 13:25''!!
+initializeOn: anObject message: aString
+ literal := anObject.
+ message := aString!! !!
+
+
+!!PPLiteralParser methodsFor: ''printing'' stamp: ''lr 4/16/2010 16:38''!!
+printNameOn: aStream
+ super printNameOn: aStream.
+ aStream nextPutAll: '', ''; print: literal!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPLiteralParser class
+ instanceVariableNames: ''''!!
+!!PPLiteralParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPLiteralParser class methodsFor: ''instance creation'' stamp: ''lr 1/7/2010 15:29''!!
+on: anObject message: aString
+ ^ self new initializeOn: anObject message: aString!! !!
+
+!!PPLiteralParser class methodsFor: ''instance creation'' stamp: ''lr 1/7/2010 15:30''!!
+on: anObject
+ ^ self on: anObject message: anObject printString , '' expected''!! !!
+
+
+PPLiteralParser subclass: #PPLiteralObjectParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPLiteralObjectParser commentStamp: ''<historical>'' prior: 0!!
+A parser that accepts a single literal object, such as a character. This is the same as the predicate parser ''PPPredicateParser expect: literal'' but slightly more efficient.!!
+
+
+!!PPLiteralObjectParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:25''!!
+exampleOn: aStream
+ aStream nextPut: literal!! !!
+
+
+!!PPLiteralObjectParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
+parseOn: aPPContext
+ ^ (aPPContext stream atEnd not and: [ literal = aPPContext stream uncheckedPeek ])
+ ifFalse: [ PPFailure message: message context: aPPContext ]
+ ifTrue: [ aPPContext stream next ]!! !!
+
+
+!!PPLiteralObjectParser methodsFor: ''operators'' stamp: ''lr 8/18/2010 20:16''!!
+caseInsensitive
+ "Answer a parser that can parse the receiver case-insensitive."
+
+ literal asUppercase = literal asLowercase ifTrue: [ ^ self ].
+ ^ PPPredicateObjectParser on: [ :value | literal sameAs: value ] message: message!! !!
+
+!!PPLiteralObjectParser methodsFor: ''operators'' stamp: ''lr 4/28/2011 20:02''!!
+negate
+ ^ (PPPredicateObjectParser expect: literal message: message) negate!! !!
+
+
+PPParser subclass: #PPPredicateParser
+ instanceVariableNames: ''predicate predicateMessage negated negatedMessage''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPPredicateParser commentStamp: ''<historical>'' prior: 0!!
+An abstract parser that accepts if a given predicate holds.
+
+Instance Variables:
+ predicate <BlockClosure> The block testing for the predicate.
+ predicateMessage <String> The error message of the predicate.
+ negated <BlockClosure> The block testing for the negation of the predicate.
+ negatedMessage <String> The error message of the negated predicate.!!
+
+
+!!PPPredicateParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 9/15/2010 11:56''!!
+match: aParser inContext: aDictionary seen: anIdentitySet
+ ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block and: [ self message = aParser message ] ]!! !!
+
+
+!!PPPredicateParser methodsFor: ''printing'' stamp: ''lr 5/2/2010 13:37''!!
+printNameOn: aStream
+ super printNameOn: aStream.
+ aStream nextPutAll: '', ''; print: predicateMessage!! !!
+
+
+!!PPPredicateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/1/2010 17:05''!!
+exampleOn: aStream
+ "Produce a random character that is valid. If there are characters in the alpha-numeric range prefer those over all others."
+
+ | valid normal |
+ valid := Character allCharacters
+ select: [ :char | self matches: (String with: char) ].
+ normal := valid
+ select: [ :char | char asInteger < 127 and: [ char isAlphaNumeric ] ].
+ aStream nextPut: (normal isEmpty
+ ifTrue: [ valid atRandom ]
+ ifFalse: [ normal atRandom ])!! !!
+
+!!PPPredicateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/2/2010 19:35''!!
+displayName
+ ^ predicateMessage!! !!
+
+
+!!PPPredicateParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:36''!!
+message
+ "Answer the failure message."
+
+ ^ predicateMessage!! !!
+
+!!PPPredicateParser methodsFor: ''accessing'' stamp: ''lr 5/2/2010 13:36''!!
+block
+ "Answer the predicate block of the receiver."
+
+ ^ predicate!! !!
+
+
+PPPredicateParser subclass: #PPPredicateObjectParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPPredicateObjectParser commentStamp: ''<historical>'' prior: 0!!
+A parser that accepts if a given predicate on one element of the input sequence holds.!!
+
+
+!!PPPredicateObjectParser methodsFor: ''operators'' stamp: ''lr 6/12/2010 09:12''!!
+negate
+ "Answer a parser that is the negation of the receiving predicate parser."
+
+ ^ self class
+ on: negated message: negatedMessage
+ negated: predicate message: predicateMessage!! !!
+
+
+!!PPPredicateObjectParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:03''!!
+parseOn: aPPContext
+ ^ (aPPContext stream atEnd not and: [ predicate value: aPPContext stream uncheckedPeek ])
+ ifFalse: [ PPFailure message: predicateMessage context: aPPContext ]
+ ifTrue: [ aPPContext stream next ]!! !!
+
+
+!!PPPredicateObjectParser methodsFor: ''initialization'' stamp: ''lr 6/12/2010 09:12''!!
+initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString
+ predicate := aBlock.
+ predicateMessage := aString.
+ negated := aNegatedBlock.
+ negatedMessage := aNegatedString!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPPredicateObjectParser class
+ instanceVariableNames: ''''!!
+!!PPPredicateObjectParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPPredicateObjectParser class methodsFor: ''*petitregex-chars'' stamp: ''lr 8/30/2010 14:48''!!
+control
+ ^ self chars: ((0 to: 31) collect: [ :each | Character value: each ]) message: ''control character expected''!! !!
+
+
+!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 8/25/2010 10:57''!!
+expect: anObject
+ ^ self expect: anObject message: anObject printString , '' expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 4/1/2011 20:05''!!
+anyExceptAnyOf: aCollection
+ ^ self
+ on: [ :each | (aCollection includes: each) not ] message: ''any except '' , aCollection printString , '' expected''
+ negated: [ :each | aCollection includes: each ] message: aCollection printString , '' not expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 4/1/2011 20:05''!!
+anyOf: aCollection
+ ^ self
+ on: [ :each | aCollection includes: each ] message: ''any of '' , aCollection printString , '' expected''
+ negated: [ :each | (aCollection includes: each) not ] message: ''none of '' , aCollection printString , ''expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 6/12/2010 09:10''!!
+any
+ ^ self
+ on: [ :each | true ] message: ''input expected''
+ negated: [ :each | false ] message: ''no input expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 6/12/2010 09:10''!!
+between: min and: max
+ ^ self
+ on: [ :each | each >= min and: [ each <= max ] ] message: min printString , ''..'' , max printString , '' expected''
+ negated: [ :each | each < min or: [ each > max ] ] message: min printString , ''..'' , max printString , '' not expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-objects'' stamp: ''lr 8/25/2010 10:57''!!
+expect: anObject message: aString
+ ^ self
+ on: [ :each | each = anObject ] message: aString
+ negated: [ :each | each ~= anObject ] message: ''no '' , aString!! !!
+
+
+!!PPPredicateObjectParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:10''!!
+on: aBlock message: aString
+ ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: ''no '' , aString!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:10''!!
+on: aBlock message: aString negated: aNegatedBlock message: aNegatedString
+ ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString!! !!
+
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
+char: aCharacter
+ ^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , '' expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
+punctuation
+ ^ self chars: ''.,"''''?!!!!;:#$%&()*+-/<>=@[]\^_{}|~'' message: ''punctuation expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
+blank
+ ^ self chars: (String with: Character space with: Character tab) message: ''blank expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
+hex
+ ^ self
+ on: (PPCharSetPredicate on: [ :char |
+ (char between: $0 and: $9)
+ or: [ (char between: $a and: $f)
+ or: [ (char between: $A and: $F) ] ] ])
+ message: ''hex digit expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
+newline
+ ^ self chars: (String with: Character cr with: Character lf) message: ''newline expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
+word
+ ^ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: ''letter or digit expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 6/12/2010 09:10''!!
+lf
+ ^ self char: Character lf!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
+digit
+ ^ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: ''digit expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:05''!!
+letter
+ ^ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: ''letter expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
+uppercase
+ ^ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: ''uppercase letter expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:02''!!
+cr
+ ^ self char: Character cr message: ''carriage return expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
+space
+ ^ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: ''separator expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
+lowercase
+ ^ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: ''lowercase letter expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:04''!!
+tab
+ ^ self char: Character tab message: ''tab expected''!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 11:06''!!
+chars: aCollection message: aString
+ ^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString!! !!
+
+!!PPPredicateObjectParser class methodsFor: ''factory-chars'' stamp: ''lr 8/25/2010 10:57''!!
+char: aCharacter message: aString
+ ^ self expect: aCharacter message: aString!! !!
+
+
+PPPredicateParser subclass: #PPPredicateSequenceParser
+ instanceVariableNames: ''size''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPPredicateSequenceParser commentStamp: ''<historical>'' prior: 0!!
+A parser that accepts if a given predicate on an arbitrary number of elements of the input sequence holds.
+
+Instance Variables:
+ size <Integer> The number of elements to consume.!!
+
+
+!!PPPredicateSequenceParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
+match: aParser inContext: aDictionary seen: anIdentitySet
+ ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self size = aParser size ]!! !!
+
+
+!!PPPredicateSequenceParser methodsFor: ''operators'' stamp: ''lr 6/12/2010 09:14''!!
+negate
+ "Answer a parser that is the negation of the receiving predicate parser."
+
+ ^ self class
+ on: negated message: negatedMessage
+ negated: predicate message: predicateMessage
+ size: size!! !!
+
+
+!!PPPredicateSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:03''!!
+parseOn: aPPContext
+ | position result |
+ position := aPPContext remember.
+ result := aPPContext stream next: size.
+ (result size = size and: [ predicate value: result ])
+ ifTrue: [ ^ result ].
+ aPPContext restore: position.
+ ^ PPFailure message: predicateMessage context: aPPContext!! !!
+
+
+!!PPPredicateSequenceParser methodsFor: ''accessing'' stamp: ''lr 6/12/2010 08:58''!!
+size
+ "Answer the sequence size of the receiver."
+
+ ^ size!! !!
+
+
+!!PPPredicateSequenceParser methodsFor: ''initialization'' stamp: ''lr 6/12/2010 09:13''!!
+initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
+ predicate := aBlock.
+ predicateMessage := aString.
+ negated := aNegatedBlock.
+ negatedMessage := aNegatedString.
+ size := anInteger !! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPPredicateSequenceParser class
+ instanceVariableNames: ''''!!
+!!PPPredicateSequenceParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPPredicateSequenceParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:14''!!
+on: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
+ ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger!! !!
+
+!!PPPredicateSequenceParser class methodsFor: ''instance creation'' stamp: ''lr 6/12/2010 09:14''!!
+on: aBlock message: aString size: anInteger
+ ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: ''no '' , aString size: anInteger !! !!
+
+
+PPParser subclass: #PPDelegateParser
+ instanceVariableNames: ''parser''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPDelegateParser commentStamp: ''<historical>'' prior: 0!!
+A parser that delegates to another parser.
+
+Instance Variables:
+ parser <PPParser> The parser to delegate to.!!
+
+
+!!PPDelegateParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:37''!!
+children
+ ^ Array with: parser!! !!
+
+
+!!PPDelegateParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/13/2010 09:39''!!
+replace: aParser with: anotherParser
+ super replace: aParser with: anotherParser.
+ parser == aParser ifTrue: [ parser := anotherParser ]!! !!
+
+
+!!PPDelegateParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
+parseOn: aPPContext
+ ^ parser parseOn: aPPContext!! !!
+
+
+!!PPDelegateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:27''!!
+exampleOn: aStream
+ parser exampleOn: aStream!! !!
+
+!!PPDelegateParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:20''!!
+displayDescription
+ ^ nil!! !!
+
+
+!!PPDelegateParser methodsFor: ''initialization'' stamp: ''lr 4/20/2008 16:23''!!
+setParser: aParser
+ parser := aParser!! !!
+
+
+!!PPDelegateParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:21''!!
+morphicShapeSeen: aSet depth: anInteger
+ ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
+ self displayDescription isNil
+ ifTrue: [ cc value: parser ]
+ ifFalse: [
+ self newRowMorph
+ addMorphBack: (self newColumnMorph
+ addMorphBack: (self newSpacerMorph height: 10);
+ addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
+ yourself);
+ addMorphBack: (self newRowMorph
+ color: (self backgroundForDepth: anInteger);
+ addMorphBack: (self newColumnMorph
+ addMorphBack: (cc value: parser);
+ addMorphBack: (self newRowMorph
+ hResizing: #spaceFill;
+ addMorphBack: (self newSpacerMorph
+ width: 20;
+ yourself);
+ addMorphBack: (self newColumnMorph
+ hResizing: #spaceFill;
+ listCentering: #center;
+ addMorphBack: (self newSpacerMorph);
+ addMorphBack: (StringMorph new
+ contents: self displayDescription;
+ yourself);
+ yourself);
+ yourself);
+ yourself);
+ addMorphBack: (self newColumnMorph
+ addMorphBack: (self newSpacerMorph height: 10);
+ addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
+ yourself);
+ yourself);
+ yourself ] ]!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPDelegateParser class
+ instanceVariableNames: ''''!!
+!!PPDelegateParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPDelegateParser class methodsFor: ''instance creation'' stamp: ''lr 4/20/2008 16:22''!!
+on: aParser
+ ^ self new setParser: aParser!! !!
+
+
+PPDelegateParser subclass: #PPAndParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPAndParser commentStamp: ''TudorGirba 2/27/2011 22:22'' prior: 0!!
+The and-predicate, a parser that succeeds whenever its delegate does, but does not consume the input stream [Parr 1994, 1995].!!
+
+
+!!PPAndParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 5/1/2010 16:16''!!
+exampleOn: aStream!! !!
+
+!!PPAndParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:17''!!
+displayDescription
+ ^ ''and''!! !!
+
+
+!!PPAndParser methodsFor: ''operators'' stamp: ''lr 5/1/2010 16:16''!!
+and
+ ^ self!! !!
+
+
+!!PPAndParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:50''!!
+parseOn: aPPContext
+ | element position |
+ position := aPPContext remember.
+ element := parser parseOn: aPPContext.
+ aPPContext restore: position.
+ ^ element!! !!
+
+
+PPDelegateParser subclass: #PPTrimmingParser
+ instanceVariableNames: ''trimmer''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPTrimmingParser commentStamp: ''lr 4/6/2010 19:27'' prior: 0!!
+A parser that silently consumes spaces before and after the delegate parser.!!
+
+
+!!PPTrimmingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 4/14/2010 20:48''!!
+exampleOn: aStream
+ super exampleOn: aStream.
+ aStream nextPut: Character space!! !!
+
+
+!!PPTrimmingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:42''!!
+parseOn: aPPContext
+ | position element |
+ position := aPPContext remember.
+ [ (trimmer parseOn: aPPContext) isPetitFailure ]
+ whileFalse.
+ element := parser parseOn: aPPContext.
+ element isPetitFailure ifTrue: [
+ aPPContext restore: position.
+ ^ element ].
+ [ (trimmer parseOn: aPPContext) isPetitFailure ]
+ whileFalse.
+ ^ element!! !!
+
+
+!!PPTrimmingParser methodsFor: ''initialization'' stamp: ''lr 7/31/2010 12:00''!!
+setTrimmer: aParser
+ trimmer := aParser!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPTrimmingParser class
+ instanceVariableNames: ''''!!
+!!PPTrimmingParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPTrimmingParser class methodsFor: ''instance creation'' stamp: ''lr 7/31/2010 12:01''!!
+on: aParser trimmer: aTrimParser
+ ^ self new
+ setParser: aParser;
+ setTrimmer: aTrimParser;
+ yourself!! !!
+
+
+PPDelegateParser subclass: #PPMemoizedParser
+ instanceVariableNames: ''buffer context''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPMemoizedParser commentStamp: ''<historical>'' prior: 0!!
+A memoized parser, for refraining redundant computations.
+
+Instance Variables:
+ stream <PositionableStream> The stream of the associated memento objects.
+ buffer <Array of: PPMemento> The buffer of memento objects.
+!!
+
+
+!!PPMemoizedParser methodsFor: ''operators'' stamp: ''lr 4/2/2009 19:48''!!
+memoized
+ "Ther is no point in memoizing more than once."
+
+ ^ self!! !!
+
+
+!!PPMemoizedParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 13:20''!!
+reset: aPPContext
+ context := aPPContext.
+ buffer := Dictionary new.!! !!
+
+!!PPMemoizedParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
+parseOn: aPPContext
+ | memento contextMemento aStream |
+ "TODO: JK memoizing needs review!!!!"
+
+ contextMemento := aPPContext remember.
+ context == aPPContext
+ ifFalse: [ self reset: aPPContext ].
+ memento := (buffer at: contextMemento ifAbsentPut: [ PPMemento new ]).
+
+ memento contextMemento isNil
+ ifTrue: [
+ aStream := aPPContext stream.
+ memento result: (aStream size - aStream position + 2 < memento count
+ ifTrue: [ PPFailure message: ''overflow'' context: aPPContext ]
+ ifFalse: [ memento increment. parser parseOn: aPPContext ]).
+ memento contextMemento: aPPContext remember ]
+ ifFalse: [ context restore: memento contextMemento ].
+ ^ memento result.!! !!
+
+
+PPDelegateParser subclass: #PPEndOfInputParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPEndOfInputParser commentStamp: ''lr 4/18/2008 13:46'' prior: 0!!
+A parser that succeeds only at the end of the input stream.!!
+
+
+!!PPEndOfInputParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:58''!!
+parseOn: aPPContext
+ | position result |
+ position := aPPContext remember.
+ result := parser parseOn: aPPContext.
+ (result isPetitFailure or: [ aPPContext stream atEnd ])
+ ifTrue: [ ^ result ].
+ result := PPFailure
+ message: ''end of input expected''
+ context: aPPContext.
+ aPPContext restore: position.
+ ^ result!! !!
+
+
+!!PPEndOfInputParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:18''!!
+displayDescription
+ ^ ''end of input''!! !!
+
+
+!!PPEndOfInputParser methodsFor: ''operators'' stamp: ''lr 12/7/2009 08:53''!!
+end
+ ^ self!! !!
+
+
+PPDelegateParser subclass: #PPActionParser
+ instanceVariableNames: ''block''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPActionParser commentStamp: ''<historical>'' prior: 0!!
+A parser that performs an action block with the successful parse result of the delegate.
+
+Instance Variables:
+ block <BlockClosure> The action block to be executed.
+!!
+
+
+!!PPActionParser methodsFor: ''initialization'' stamp: ''lr 5/2/2010 16:58''!!
+setBlock: aBlock
+ block := aBlock!! !!
+
+
+!!PPActionParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:41''!!
+visualizationGraphType
+ ^ ''[]''!! !!
+
+
+!!PPActionParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
+parseOn: aPPContext
+ | element |
+ ^ (element := parser parseOn: aPPContext) isPetitFailure
+ ifFalse: [ block value: element ]
+ ifTrue: [ element ]!! !!
+
+
+!!PPActionParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:10''!!
+block
+ "Answer the action block of the receiver."
+
+ ^ block!! !!
+
+
+!!PPActionParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 5/7/2011 15:08''!!
+match: aParser inContext: aDictionary seen: anIdentitySet
+ ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self block = aParser block ]!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPActionParser class
+ instanceVariableNames: ''''!!
+!!PPActionParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPActionParser class methodsFor: ''instance creation'' stamp: ''lr 5/2/2010 16:58''!!
+on: aParser block: aBlock
+ ^ (self on: aParser) setBlock: aBlock!! !!
+
+
+PPActionParser subclass: #PPWrappingParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPWrappingParser commentStamp: ''<historical>'' prior: 0!!
+A parser that performs an action block upon activation with the stream and a continuation block.!!
+
+
+!!PPWrappingParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
+parseOn: aPPContext
+ ^ block value: aPPContext value: [ parser parseOn: aPPContext ]!! !!
+
+
+PPParser subclass: #PPListParser
+ instanceVariableNames: ''parsers''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPListParser commentStamp: ''<historical>'' prior: 0!!
+Abstract parser that parses a list of things in some way (to be specified by the subclasses).
+
+Instance Variables:
+ parsers <SequenceableCollection of: PPParser> A sequence of other parsers to delegate to.!!
+
+
+!!PPListParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 4/30/2010 08:15''!!
+copyInContext: aDictionary seen: aSeenDictionary
+ | copy copies |
+ aSeenDictionary at: self ifPresent: [ :value | ^ value ].
+ copy := aSeenDictionary at: self put: self copy.
+ copies := OrderedCollection new.
+ parsers do: [ :each |
+ | result |
+ result := each
+ copyInContext: aDictionary
+ seen: aSeenDictionary.
+ result isCollection
+ ifTrue: [ copies addAll: result ]
+ ifFalse: [ copies add: result ] ].
+ ^ copy
+ setParsers: copies;
+ yourself!! !!
+
+
+!!PPListParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 5/22/2010 10:24''!!
+replace: aParser with: anotherParser
+ super replace: aParser with: anotherParser.
+ parsers keysAndValuesDo: [ :index :parser |
+ parser == aParser
+ ifTrue: [ parsers at: index put: anotherParser ] ]!! !!
+
+
+!!PPListParser methodsFor: ''initialization'' stamp: ''lr 4/29/2010 10:12''!!
+setParsers: aCollection
+ parsers := aCollection asArray!! !!
+
+!!PPListParser methodsFor: ''initialization'' stamp: ''lr 4/29/2010 10:12''!!
+initialize
+ super initialize.
+ self setParsers: #()!! !!
+
+
+!!PPListParser methodsFor: ''accessing'' stamp: ''lr 10/21/2009 16:37''!!
+children
+ ^ parsers!! !!
+
+
+!!PPListParser methodsFor: ''copying'' stamp: ''lr 9/17/2008 22:36''!!
+copyWith: aParser
+ ^ self species withAll: (parsers copyWith: aParser)!! !!
+
+!!PPListParser methodsFor: ''copying'' stamp: ''lr 5/22/2010 10:26''!!
+postCopy
+ super postCopy.
+ parsers := parsers copy!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPListParser class
+ instanceVariableNames: ''''!!
+!!PPListParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 9/23/2008 18:32''!!
+with: aFirstParser with: aSecondParser
+ ^ self withAll: (Array with: aFirstParser with: aSecondParser)!! !!
+
+!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 5/3/2010 20:26''!!
+with: aParser
+ ^ self withAll: (Array with: aParser)!! !!
+
+!!PPListParser class methodsFor: ''instance creation'' stamp: ''lr 4/29/2010 10:12''!!
+withAll: aCollection
+ ^ self basicNew setParsers: aCollection!! !!
+
+
+PPListParser subclass: #PPChoiceParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPChoiceParser commentStamp: ''lr 4/18/2008 15:35'' prior: 0!!
+A parser that uses the first parser that succeeds.!!
+
+
+!!PPChoiceParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:42''!!
+visualizationGraphType
+ ^ ''/''!! !!
+
+
+!!PPChoiceParser methodsFor: ''operators'' stamp: ''lr 9/17/2008 00:16''!!
+/ aRule
+ ^ self copyWith: aRule!! !!
+
+
+!!PPChoiceParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:31''!!
+parseOn: aPPContext
+ "This is optimized code that avoids unnecessary block activations, do not change. When all choices fail, the last failure is answered."
+
+ | element |
+ 1 to: parsers size do: [ :index |
+ element := (parsers at: index)
+ parseOn: aPPContext.
+ element isPetitFailure
+ ifFalse: [ ^ element ] ].
+ ^ element!! !!
+
+
+!!PPChoiceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 5/2/2010 20:15''!!
+exampleOn: aStream
+ "If there is already a lot written, try to pick an empty possiblity."
+
+ aStream position > 512 ifTrue: [
+ (parsers anySatisfy: [ :each | each isNullable ])
+ ifTrue: [ ^ self ] ].
+ parsers atRandom exampleOn: aStream!! !!
+
+!!PPChoiceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:14''!!
+morphicShapeSeen: aSet depth: anInteger
+ ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
+ | morph |
+ morph := self newColumnMorph
+ cellInset: 5;
+ yourself.
+ self children do: [ :each |
+ morph addMorphBack: (self newRowMorph
+ hResizing: #spaceFill;
+ addMorphBack: (cc value: each);
+ addMorphBack: (self newColumnMorph
+ hResizing: #spaceFill;
+ addMorphBack: (self newSpacerMorph height: 10);
+ addMorphBack: ((LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1)
+ hResizing: #spaceFill;
+ minWidth: 20;
+ yourself);
+ yourself);
+ yourself) ].
+ morph fullBounds.
+ self newRowMorph
+ addMorphBack: (self newColumnMorph
+ addMorphBack: (self newSpacerMorph height: 10);
+ addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
+ yourself);
+ addMorphBack: (self newColumnMorph
+ addMorphBack: (self newSpacerMorph width: 1; height: 10);
+ addMorphBack: (LineMorph from: 0 @ 0 to: 0 @ (morph height - 23) color: Color black width: 1);
+ yourself);
+ addMorphBack: morph;
+ addMorphBack: (self newColumnMorph
+ addMorphBack: (self newSpacerMorph width: 1; height: 10);
+ addMorphBack: (LineMorph from: 0 @ (morph height - 23) to: 0 @ 0 color: Color black width: 1)
+ makeForwardArrow;
+ width: 1;
+ yourself);
+ yourself ]!! !!
+
+
+PPDelegateParser subclass: #PPNotParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPNotParser commentStamp: ''<historical>'' prior: 0!!
+The not-predicate, a parser that succeeds whenever its delegate does not, but consumes no input [Parr 1994, 1995].!!
+
+
+!!PPNotParser methodsFor: ''*petitanalyzer-testing'' stamp: ''JanKurs 5/31/2013 11:50''!!
+isFirstSetTerminal
+ ^ true!! !!
+
+
+!!PPNotParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:01''!!
+parseOn: aPPContext
+ | element position |
+ position := aPPContext remember.
+ element := parser parseOn: aPPContext.
+ aPPContext restore: position.
+ ^ element isPetitFailure
+ ifFalse: [ PPFailure message: '''' context: aPPContext ]!! !!
+
+
+!!PPNotParser methodsFor: ''*petitanalyzer-private'' stamp: ''JanKurs 5/31/2013 11:50''!!
+firstSets: aFirstDictionary into: aSet
+ !! !!
+
+
+!!PPNotParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/11/2009 21:09''!!
+exampleOn: aStream!! !!
+
+!!PPNotParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:17''!!
+displayDescription
+ ^ ''not''!! !!
+
+
+PPLiteralParser subclass: #PPLiteralSequenceParser
+ instanceVariableNames: ''size''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPLiteralSequenceParser commentStamp: ''lr 12/4/2009 18:39'' prior: 0!!
+A parser accepts a sequence of literal objects, such as a String. This is an optimization to avoid having to compose longer sequences from PPSequenceParser.!!
+
+
+!!PPLiteralSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:38''!!
+parseOn: aPPContext
+ | memento result |
+ memento := aPPContext remember.
+ result := aPPContext stream next: size.
+ literal = result ifTrue: [ ^ result ].
+ aPPContext restore: memento.
+ ^ PPFailure message: message context: aPPContext!! !!
+
+
+!!PPLiteralSequenceParser methodsFor: ''initialization'' stamp: ''lr 6/1/2010 22:21''!!
+initializeOn: anObject message: aString
+ super initializeOn: anObject message: aString.
+ size := literal size!! !!
+
+
+!!PPLiteralSequenceParser methodsFor: ''accessing'' stamp: ''lr 9/15/2010 11:16''!!
+size
+ "Answer the sequence size of the receiver."
+
+ ^ size!! !!
+
+
+!!PPLiteralSequenceParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:25''!!
+exampleOn: aStream
+ aStream nextPutAll: literal!! !!
+
+
+!!PPLiteralSequenceParser methodsFor: ''operators'' stamp: ''lr 8/18/2010 20:16''!!
+caseInsensitive
+ "Answer a parser that can parse the receiver case-insensitive."
+
+ literal asUppercase = literal asLowercase ifTrue: [ ^ self ].
+ ^ PPPredicateSequenceParser on: [ :value | literal sameAs: value ] message: message size: size!! !!
+
+
+PPDelegateParser subclass: #PPOptionalParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPOptionalParser commentStamp: ''lr 4/3/2011 14:46'' prior: 0!!
+A parser that optionally parsers its delegate, or answers nil.!!
+
+
+!!PPOptionalParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 9/1/2010 22:10''!!
+isNullable
+ ^ true!! !!
+
+
+!!PPOptionalParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
+visualizationGraphType
+ ^ ''?''!! !!
+
+
+!!PPOptionalParser methodsFor: ''pp-context'' stamp: ''JanKurs 3/19/2014 15:12''!!
+parseOn: aPPContext
+ | element |
+ element := parser parseOn: aPPContext.
+ ^ element isPetitFailure ifFalse: [ element ]!! !!
+
+
+PPDelegateParser subclass: #PPFlattenParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPFlattenParser commentStamp: ''lr 11/22/2009 13:09'' prior: 0!!
+A parser that answers a flat copy of the range my delegate parses.!!
+
+
+!!PPFlattenParser methodsFor: ''private'' stamp: ''lr 2/25/2013 23:31''!!
+on: aCollection start: aStartInteger stop: aStopInteger value: anObject
+ ^ aCollection copyFrom: aStartInteger to: aStopInteger!! !!
+
+
+!!PPFlattenParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:42''!!
+parseOn: aPPContext
+ | start element |
+ start := aPPContext stream position.
+ element := parser parseOn: aPPContext.
+ element isPetitFailure ifTrue: [ ^ element ].
+ ^ self on: aPPContext stream collection start: start + 1 stop: aPPContext stream position value: element!! !!
+
+
+PPFlattenParser subclass: #PPTokenParser
+ instanceVariableNames: ''tokenClass''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPTokenParser commentStamp: ''lr 2/25/2013 23:31'' prior: 0!!
+A parser that answers a token with the value of my delegate parses.
+
+Instance Variables:
+ tokenClass <PPToken class> The token sub-class to be used.!!
+
+
+!!PPTokenParser methodsFor: ''private'' stamp: ''lr 4/6/2010 19:18''!!
+defaultTokenClass
+ ^ PPToken!! !!
+
+!!PPTokenParser methodsFor: ''private'' stamp: ''lr 2/25/2013 23:32''!!
+on: aCollection start: aStartInteger stop: aStopInteger value: anObject
+ ^ self tokenClass on: aCollection start: aStartInteger stop: aStopInteger value: anObject!! !!
+
+
+!!PPTokenParser methodsFor: ''initialization'' stamp: ''lr 4/6/2010 19:19''!!
+initialize
+ tokenClass := self defaultTokenClass
+ !! !!
+
+
+!!PPTokenParser methodsFor: ''accessing'' stamp: ''lr 4/6/2010 19:23''!!
+tokenClass
+ ^ tokenClass!! !!
+
+!!PPTokenParser methodsFor: ''accessing'' stamp: ''lr 4/6/2010 19:24''!!
+tokenClass: aTokenClass
+ tokenClass := aTokenClass!! !!
+
+
+!!PPTokenParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
+match: aParser inContext: aDictionary seen: anIdentitySet
+ ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self tokenClass = aParser tokenClass ]!! !!
+
+
+PPDelegateParser subclass: #PPRepeatingParser
+ instanceVariableNames: ''min max''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPRepeatingParser commentStamp: ''lr 4/3/2011 14:45'' prior: 0!!
+An abstract parser that repeatedly parses between ''min'' and ''max'' instances of its delegate. The default configuration parses an infinite number of elements, as ''min'' is set to 0 and ''max'' to infinity (SmallInteger maxVal).
+
+Instance Variables:
+ min <Integer> The minimum number of repetitions.
+ max <Integer> The maximum number of repetitions.!!
+
+
+!!PPRepeatingParser methodsFor: ''*petitanalyzer-matching'' stamp: ''lr 6/18/2010 14:09''!!
+match: aParser inContext: aDictionary seen: anIdentitySet
+ ^ (super match: aParser inContext: aDictionary seen: anIdentitySet) and: [ self min = aParser min and: [ self max = aParser max ] ]!! !!
+
+
+!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:00''!!
+setMax: anInteger
+ max := anInteger!! !!
+
+!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:01''!!
+setMin: anInteger
+ min := anInteger!! !!
+
+!!PPRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/1/2011 21:06''!!
+initialize
+ super initialize.
+ self setMin: 0; setMax: SmallInteger maxVal!! !!
+
+
+!!PPRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:08''!!
+max
+ "Answer the maximum number of repetitions."
+
+ ^ max!! !!
+
+!!PPRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/30/2010 11:08''!!
+min
+ "Answer the minimum number of repetitions."
+
+ ^ min!! !!
+
+
+!!PPRepeatingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/11/2009 20:57''!!
+exampleOn: aStream
+ "Perform the minimal repeatitions required, and a random amount of more if possible and if not that much output has been produced yet."
+
+ min timesRepeat: [
+ super exampleOn: aStream ].
+ (max - min min: 5) atRandom timesRepeat: [
+ aStream position > 512
+ ifTrue: [ ^ self ].
+ super exampleOn: aStream ]!! !!
+
+!!PPRepeatingParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/13/2009 14:18''!!
+displayDescription
+ ^ String streamContents: [ :stream |
+ min = 0
+ ifFalse: [ stream print: min; nextPutAll: ''..'' ].
+ max = SmallInteger maxVal
+ ifTrue: [ stream nextPut: $* ]
+ ifFalse: [ stream print: max ] ]!! !!
+
+
+!!PPRepeatingParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 10/21/2009 12:13''!!
+isNullable
+ ^ min = 0!! !!
+
+
+!!PPRepeatingParser methodsFor: ''*petitanalyzer-private'' stamp: ''JanKurs 5/31/2013 11:51''!!
+followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
+ | firstSet |
+ super followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet.
+
+ firstSet := aFirstDictionary at: self.
+ self children do: [:p | (aFollowDictionary at: p) addAll: (firstSet reject: [:each | each isNullable]) ]!! !!
+
+
+!!PPRepeatingParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
+visualizationGraphType
+ ^ ''*''!! !!
+
+
+!!PPRepeatingParser methodsFor: ''printing'' stamp: ''lr 6/3/2010 14:00''!!
+printOn: aStream
+ super printOn: aStream.
+ aStream nextPutAll: '' [''; print: min; nextPutAll: '', ''; nextPutAll: (max = SmallInteger maxVal
+ ifTrue: [ ''*'' ] ifFalse: [ max printString ]); nextPut: $]!! !!
+
+
+PPRepeatingParser subclass: #PPPossessiveRepeatingParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPPossessiveRepeatingParser commentStamp: ''lr 4/3/2011 14:35'' prior: 0!!
+The default repeating parser with standard PEG semantics (i.e. possessive, blind, eager).!!
+
+
+!!PPPossessiveRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 15:43''!!
+parseOn: aPPContext
+ | start element elements |
+ start := aPPContext remember.
+ elements := OrderedCollection new.
+ [ elements size < min ] whileTrue: [
+ (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
+ aPPContext restore: start.
+ ^ element ].
+ elements addLast: element ].
+ [ elements size < max ] whileTrue: [
+ (element := parser parseOn: aPPContext) isPetitFailure
+ ifTrue: [ ^ elements asArray ].
+ elements addLast: element ].
+ ^ elements asArray!! !!
+
+
+PPRepeatingParser subclass: #PPLimitedRepeatingParser
+ instanceVariableNames: ''limit''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPLimitedRepeatingParser commentStamp: ''lr 4/3/2011 14:37'' prior: 0!!
+An abstract parser that repeatedly parses between ''min'' and ''max'' instances of my delegate and that requires the input to be completed with a specified parser ''limit''. Subclasses provide repeating behavior as typically seen in regular expression implementations (non-blind).
+
+Instance Variables:
+ limit <PPParser> The parser to complete the input with.!!
+
+
+!!PPLimitedRepeatingParser methodsFor: ''*petitanalyzer-transforming'' stamp: ''lr 4/4/2011 18:46''!!
+replace: aParser with: anotherParser
+ super replace: aParser with: anotherParser.
+ limit == aParser ifTrue: [ limit := anotherParser ]!! !!
+
+
+!!PPLimitedRepeatingParser methodsFor: ''initialization'' stamp: ''lr 4/2/2011 10:00''!!
+setLimit: aParser
+ limit := aParser!! !!
+
+
+!!PPLimitedRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/4/2011 18:46''!!
+children
+ ^ Array with: parser with: limit!! !!
+
+!!PPLimitedRepeatingParser methodsFor: ''accessing'' stamp: ''lr 4/2/2011 10:00''!!
+limit
+ "Answer the parser that limits (or ends) this repetition."
+
+ ^ limit!! !!
+
+
+!!PPLimitedRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 1/15/2014 16:04''!!
+matchesLimitOn: aPPContext
+ | element position |
+ position := aPPContext remember.
+ element := limit parseOn: aPPContext.
+ aPPContext restore: position.
+ ^ element isPetitFailure not!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPLimitedRepeatingParser class
+ instanceVariableNames: ''''!!
+!!PPLimitedRepeatingParser class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPLimitedRepeatingParser class methodsFor: ''instance creation'' stamp: ''lr 4/3/2011 14:58''!!
+on: aParser limit: aLimitParser
+ ^ (self on: aParser) setLimit: aLimitParser!! !!
+
+
+PPLimitedRepeatingParser subclass: #PPGreedyRepeatingParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPGreedyRepeatingParser commentStamp: ''lr 4/3/2011 15:08'' prior: 0!!
+A greedy repeating parser, commonly seen in regular expression implementations. It aggressively consumes as much input as possible and then backtracks to meet the ''limit'' condition.
+
+This class essentially implements the iterative version of the following recursive parser composition:
+
+ | parser |
+ parser := PPChoiceParser new.
+ parser setParsers: (Array
+ with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])
+ with: (limit and ==> [ :each | OrderedCollection new ])).
+ ^ parser ==> [ :rest | rest asArray ]!!
+
+
+!!PPGreedyRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 16:59''!!
+parseOn: aPPContext
+ | start element elements positions |
+ start := aPPContext remember.
+ elements := OrderedCollection new.
+ [ elements size < min ] whileTrue: [
+ (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
+ aPPContext restore: start.
+ ^ element ].
+ elements addLast: element ].
+ positions := OrderedCollection with: aPPContext remember.
+ [ elements size < max and: [ (element := parser parseOn: aPPContext) isPetitFailure not ] ] whileTrue: [
+ elements addLast: element.
+ positions addLast: aPPContext remember ].
+ [ positions isEmpty ] whileFalse: [
+ aPPContext restore: positions last.
+ element := limit parseOn: aPPContext.
+ element isPetitFailure ifFalse: [
+ aPPContext restore: positions last.
+ ^ elements asArray ].
+ elements isEmpty ifTrue: [
+ aPPContext restore: start.
+ ^ element ].
+ elements removeLast.
+ positions removeLast ].
+ aPPContext restore: start.
+ ^ PPFailure message: ''overflow'' context: aPPContext at: start!! !!
+
+
+PPParser subclass: #PPEpsilonParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPEpsilonParser commentStamp: ''lr 5/15/2008 15:09'' prior: 0!!
+A parser that consumes nothing and always succeeds.!!
+
+
+!!PPEpsilonParser methodsFor: ''*petitanalyzer-testing'' stamp: ''lr 10/21/2009 12:11''!!
+isNullable
+ ^ true!! !!
+
+
+!!PPEpsilonParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/18/2009 11:15''!!
+morphicShapeSeen: aSet depth: anInteger
+ ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
+ self newRowMorph
+ addMorphBack: (self newColumnMorph
+ addMorphBack: (self newSpacerMorph height: 10);
+ addMorphBack: (LineMorph from: 0 @ 0 to: 20 @ 0 color: Color black width: 1);
+ yourself);
+ yourself ]!! !!
+
+
+!!PPEpsilonParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/6/2009 18:42''!!
+displayName
+ ^ ''epsilon''!! !!
+
+
+!!PPEpsilonParser methodsFor: ''parsing'' stamp: ''lr 2/7/2010 20:49''!!
+parseOn: aStream
+ ^ nil!! !!
+
+
+PPLimitedRepeatingParser subclass: #PPLazyRepeatingParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPLazyRepeatingParser commentStamp: ''lr 4/3/2011 15:08'' prior: 0!!
+A lazy repeating parser, commonly seen in regular expression implementations. It limits its consumption to meet the ''limit'' condition as early as possible.
+
+This class essentially implements the iterative version of the following recursive parser composition:
+
+ | parser |
+ parser := PPChoiceParser new.
+ parser setParsers: (Array
+ with: (limit and ==> [ :each | OrderedCollection new ])
+ with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])).
+ ^ parser ==> [ :rest | rest asArray ]!!
+
+
+!!PPLazyRepeatingParser methodsFor: ''pp-context'' stamp: ''JanKurs 8/19/2014 17:00''!!
+parseOn: aPPContext
+ | start element elements |
+ start := aPPContext remember.
+ elements := OrderedCollection new.
+ [ elements size < min ] whileTrue: [
+ (element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
+ aPPContext restore: start.
+ ^ element ].
+ elements addLast: element ].
+ [ self matchesLimitOn: aPPContext ] whileFalse: [
+ elements size < max ifFalse: [
+ aPPContext restore: start.
+ ^ PPFailure message: ''overflow'' context: aPPContext at: start ].
+ element := parser parseOn: aPPContext.
+ element isPetitFailure ifTrue: [
+ aPPContext restore: start.
+ ^ element ].
+ elements addLast: element ].
+ ^ elements asArray!! !!
+
+
+PPListParser subclass: #PPSequenceParser
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Parsers''!!
+!!PPSequenceParser commentStamp: ''lr 4/18/2008 15:34'' prior: 0!!
+A parser that parses a sequence of parsers.!!
+
+
+!!PPSequenceParser methodsFor: ''operators-mapping'' stamp: ''lr 5/6/2011 20:27''!!
+map: aBlock
+ ^ aBlock numArgs = self children size
+ ifTrue: [ self ==> [ :nodes | aBlock valueWithArguments: nodes ] ]
+ ifFalse: [ self error: aBlock numArgs asString , '' arguments expected.'' ]!! !!
+
+!!PPSequenceParser methodsFor: ''operators-mapping'' stamp: ''lr 1/8/2010 12:01''!!
+permutation: anArrayOfIntegers
+ "Answer a permutation of the receivers sequence."
+
+ anArrayOfIntegers do: [ :index |
+ (index isInteger and: [ index between: 1 and: parsers size ])
+ ifFalse: [ self error: ''Invalid permutation index: '' , index printString ] ].
+ ^ self ==> [ :nodes | anArrayOfIntegers collect: [ :index | nodes at: index ] ]!! !!
+
+
+!!PPSequenceParser methodsFor: ''*petitgui-morphic'' stamp: ''lr 11/17/2009 21:54''!!
+morphicShapeSeen: aSet depth: anInteger
+ ^ self morphicShapeSeen: aSet depth: anInteger do: [ :cc |
+ self children
+ inject: self newRowMorph
+ into: [ :result :each |
+ result
+ addMorphBack: (cc value: each);
+ yourself ] ]!! !!
+
+
+!!PPSequenceParser methodsFor: ''*petitgui-accessing'' stamp: ''lr 11/9/2009 14:24''!!
+exampleOn: aStream
+ parsers do: [ :each | each exampleOn: aStream ]!! !!
+
+
+!!PPSequenceParser methodsFor: ''pp-context'' stamp: ''JanKurs 11/11/2013 09:43''!!
+parseOn: aPPContext
+ "This is optimized code that avoids unnecessary block activations, do not change."
+
+ | start elements element |
+ start := aPPContext remember.
+ elements := Array new: parsers size.
+ 1 to: parsers size do: [ :index |
+ element := (parsers at: index)
+ parseOn: aPPContext.
+ element isPetitFailure ifTrue: [
+ aPPContext restore: start.
+ ^ element ].
+ elements at: index put: element ].
+ ^ elements!! !!
+
+
+!!PPSequenceParser methodsFor: ''operators'' stamp: ''lr 9/17/2008 00:17''!!
+, aRule
+ ^ self copyWith: aRule!! !!
+
+
+!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 12/9/2010 10:37''!!
+cycleSet: aDictionary
+ | firstSet |
+ 1 to: parsers size do: [ :index |
+ firstSet := aDictionary at: (parsers at: index).
+ (firstSet anySatisfy: [ :each | each isNullable ])
+ ifFalse: [ ^ parsers copyFrom: 1 to: index ] ].
+ ^ parsers!! !!
+
+!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 9/16/2010 17:56''!!
+firstSets: aFirstDictionary into: aSet
+ | nullable |
+ parsers do: [ :parser |
+ nullable := false.
+ (aFirstDictionary at: parser) do: [ :each |
+ each isNullable
+ ifTrue: [ nullable := true ]
+ ifFalse: [ aSet add: each ] ].
+ nullable
+ ifFalse: [ ^ self ] ].
+ aSet add: PPSentinel instance!! !!
+
+!!PPSequenceParser methodsFor: ''*petitanalyzer-private'' stamp: ''lr 8/14/2010 13:51''!!
+followSets: aFollowDictionary firstSets: aFirstDictionary into: aSet
+ parsers keysAndValuesDo: [ :index :parser |
+ | followSet firstSet |
+ followSet := aFollowDictionary at: parser.
+ index = parsers size
+ ifTrue: [ followSet addAll: aSet ]
+ ifFalse: [
+ (self class withAll: (parsers
+ copyFrom: index + 1 to: parsers size))
+ firstSets: aFirstDictionary
+ into: (firstSet := IdentitySet new).
+ (firstSet anySatisfy: [ :each | each isNullable ])
+ ifTrue: [ followSet addAll: aSet ].
+ followSet addAll: (firstSet
+ reject: [ :each | each isNullable ]) ] ]!! !!
+
+
+!!PPSequenceParser methodsFor: ''*petitgui-mondrian'' stamp: ''AlexandreBergel 12/18/2013 16:44''!!
+visualizationGraphType
+ ^ '',''!! !!
+Object subclass: #PPFailure
+ instanceVariableNames: ''message context position''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Core''!!
+!!PPFailure commentStamp: ''<historical>'' prior: 0!!
+The failure object in PetitParser. It is the only class that responds to #isPetitFailure with true. It contains an error message and a position of the occurrence of the failure.
+
+Instance Variables:
+ message <String> The error message of this failure.
+ position <Integer> The position of this failure in the input stream.
+!!
+
+
+!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:39''!!
+sampleIn: composite
+
+ (composite text)
+ title: ''Sample'';
+ display: [:res | res findStream contents ifNil: [''''] ];
+ allowNil.!! !!
+
+!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:40''!!
+treeViewIn: composite
+ composite tree
+ title: ''Execution Traces'';
+ format: [:resultNode | resultNode formattedText ];
+ children: [:resultNode | resultNode showChildren
+ ifTrue: [ resultNode children ]
+ ifFalse: [ #() ] ]. !! !!
+
+!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:53''!!
+gtDebugView: composite
+ <gtInspectorPresentationOrder: 40>
+
+ | browser |
+ browser :=
+ composite tabulator.
+
+ browser title: ''Debug View''.
+ browser row: #tree;
+ row: #source.
+ browser transmit
+ fromOutsideEntityPort;
+ toOutsidePort: #debugResult;
+ transformed: [ :failure | failure debugResult ].
+
+ browser transmit
+ from: #tree;
+ to: #source port: #selectionInterval;
+ transformed: [:debuggingResult |
+ debuggingResult ifNotNil: [
+ debuggingResult start to: debuggingResult end]
+ ].
+
+ browser transmit
+ fromOutsidePort: #debugResult;
+ to: #source;
+ andShow: [ :a | self sampleIn: a ].
+
+ browser transmit
+ fromOutsidePort: #debugResult;
+ to: #tree;
+ andShow: [ :a | self treeViewIn: a ].
+
+ browser startOn: self!! !!
+
+!!PPFailure methodsFor: ''*petitgui'' stamp: ''JanKurs 8/19/2014 16:54''!!
+debugResult
+ ^ context root enableDebug parse: context stream reset!! !!
+
+
+!!PPFailure methodsFor: ''testing'' stamp: ''lr 2/7/2010 20:54''!!
+isPetitFailure
+ "I am the only class that should implement this method to return true."
+
+ ^ true!! !!
+
+
+!!PPFailure methodsFor: ''printing'' stamp: ''JanKurs 8/19/2014 16:30''!!
+printOn: aStream
+ aStream nextPutAll: self message; nextPutAll: '' at ''; print: self position!! !!
+
+
+!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:57''!!
+initializeMessage: aString context: aPPContext
+ self initializeMessage: aString context: aPPContext position: aPPContext position!! !!
+
+!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:33''!!
+initializeMessage: aString at: anInteger
+ self halt: ''deprecated''.!! !!
+
+!!PPFailure methodsFor: ''initialization'' stamp: ''JanKurs 8/19/2014 16:57''!!
+initializeMessage: aString context: aPPContext position: position
+ message := aString.
+ context := aPPContext.
+ position := position.!! !!
+
+
+!!PPFailure methodsFor: ''accessing'' stamp: ''lr 5/5/2010 13:56''!!
+message
+ "Answer a human readable error message of this parse failure."
+
+ ^ message!! !!
+
+!!PPFailure methodsFor: ''accessing'' stamp: ''lr 5/5/2010 13:55''!!
+position
+ "Answer the position in the source string that caused this parse failure."
+
+ ^ position!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPFailure class
+ instanceVariableNames: ''''!!
+!!PPFailure class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:33''!!
+message: aString at: anInteger
+ self halt: ''deprecated, use message:context:''.
+ ^ self basicNew initializeMessage: aString at: anInteger!! !!
+
+!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:32''!!
+message: aString context: aPPContext
+ ^ self basicNew initializeMessage: aString context: aPPContext!! !!
+
+!!PPFailure class methodsFor: ''instance creation'' stamp: ''JanKurs 8/19/2014 16:57''!!
+message: aString context: aPPContext at: position
+ ^ self basicNew initializeMessage: aString context: aPPContext position: position!! !!
+
+
+ReadStream subclass: #PPStream
+ instanceVariableNames: ''''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Core''!!
+!!PPStream commentStamp: ''<historical>'' prior: 0!!
+A positional stream implementation used for parsing. It overrides some methods for optimization reasons.!!
+
+
+!!PPStream methodsFor: ''accessing'' stamp: ''lr 4/29/2008 21:48''!!
+peek
+ "An improved version of peek, that is slightly faster than the built in version."
+
+ ^ self atEnd ifFalse: [ collection at: position + 1 ]!! !!
+
+!!PPStream methodsFor: ''accessing'' stamp: ''lr 10/5/2010 16:29''!!
+uncheckedPeek
+ "An unchecked version of peek that throws an error if we try to peek over the end of the stream, even faster than #peek."
+
+ ^ collection at: position + 1!! !!
+
+!!PPStream methodsFor: ''accessing'' stamp: ''lr 2/13/2012 20:25''!!
+collection
+ "Answer the underlying collection."
+
+ ^ collection!! !!
+
+!!PPStream methodsFor: ''accessing'' stamp: ''lr 8/25/2010 11:36''!!
+position: anInteger
+ "The receiver does not check for invalid arguments passed to this method, as it is solely used with valid indexes for backtracking."
+
+ position := anInteger!! !!
+
+
+!!PPStream methodsFor: ''printing'' stamp: ''lr 11/4/2010 19:23''!!
+printOn: aStream
+ collection isString
+ ifFalse: [ ^ super printOn: aStream ].
+ aStream
+ nextPutAll: (collection copyFrom: 1 to: position);
+ nextPutAll: ''·'';
+ nextPutAll: (collection copyFrom: position + 1 to: readLimit)!! !!
+
+
+!!PPStream methodsFor: ''converting'' stamp: ''lr 2/7/2010 20:53''!!
+asPetitStream
+ ^ self!! !!
+
+
+Object subclass: #PPToken
+ instanceVariableNames: ''collection start stop value''
+ classVariableNames: ''NewLineParser''
+ poolDictionaries: ''''
+ category: ''PetitParser-Core''!!
+!!PPToken commentStamp: ''lr 2/25/2013 23:34'' prior: 0!!
+PPToken represents a parsed part of the input stream. Contrary to a simple String it remembers where it came from, the original collection, its start and stop position and its parse value.
+
+Instance Variables:
+ collection <SequenceableCollection> The collection this token comes from.
+ start <Integer> The start position in the collection.
+ stop <Integer> The stop position in the collection.
+ value <Object> The parse result.!!
+
+
+!!PPToken methodsFor: ''querying'' stamp: ''lr 9/7/2011 20:41''!!
+line
+ "Answer the line number of this token in the underlying collection."
+
+ | line |
+ line := 1.
+ (NewLineParser , [ :stream |
+ start <= stream position
+ ifTrue: [ ^ line ].
+ line := line + 1 ] asParser
+ / #any asParser) star
+ parse: collection.
+ ^ line!! !!
+
+!!PPToken methodsFor: ''querying'' stamp: ''lr 9/7/2011 20:40''!!
+column
+ "Answer the column number of this token in the underlying collection."
+
+ | position |
+ position := 0.
+ (NewLineParser , [ :stream |
+ start <= stream position
+ ifTrue: [ ^ start - position ].
+ position := stream position ] asParser
+ / #any asParser) star
+ parse: collection.
+ ^ start - position!! !!
+
+
+!!PPToken methodsFor: ''initialization'' stamp: ''lr 2/25/2013 23:36''!!
+initializeOn: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject
+ collection := aSequenceableCollection.
+ start := aStartInteger.
+ stop := aStopInteger.
+ value := anObject!! !!
+
+
+!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:33''!!
+stop
+ "Answer the stop position of this token in the underlying collection."
+
+ ^ stop!! !!
+
+!!PPToken methodsFor: ''accessing'' stamp: ''lr 2/25/2013 23:56''!!
+size
+ "Answer the size of this token in the underlying collection."
+
+ ^ stop - start + 1!! !!
+
+!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:34''!!
+collection
+ "Answer the underlying collection of this token."
+
+ ^ collection!! !!
+
+!!PPToken methodsFor: ''accessing'' stamp: ''lr 6/15/2010 23:33''!!
+start
+ "Answer the start position of this token in the underlying collection."
+
+ ^ start!! !!
+
+
+!!PPToken methodsFor: ''printing'' stamp: ''lr 2/26/2013 00:37''!!
+printOn: aStream
+ super printOn: aStream.
+ aStream nextPut: $[; print: self start; nextPut: $,; print: self stop; nextPut: $].
+ aStream nextPut: $(; print: self parsedValue; nextPut: $)!! !!
+
+
+!!PPToken methodsFor: ''copying'' stamp: ''lr 2/26/2013 00:34''!!
+copyFrom: aStartInteger to: aStopInteger
+ ^ self class on: collection start: start + aStartInteger - 1 stop: stop + aStopInteger - 3 value: value!! !!
+
+
+!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:34''!!
+value
+ self notify: ''Token>>#value is no longer supported. Instead use Token>>#inputValue or the more pragmatic #parsedValue.''.
+ ^ self inputValue!! !!
+
+!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:32''!!
+inputValue
+ "Answer the consumed input of this token."
+
+ ^ collection copyFrom: start to: stop!! !!
+
+!!PPToken methodsFor: ''accessing-values'' stamp: ''lr 2/26/2013 00:32''!!
+parsedValue
+ "Answer the parsed value of this token."
+
+ ^ value!! !!
+
+
+!!PPToken methodsFor: ''comparing'' stamp: ''lr 2/26/2013 00:34''!!
+= anObject
+ ^ self class = anObject class and: [ self parsedValue = anObject parsedValue ]!! !!
+
+!!PPToken methodsFor: ''comparing'' stamp: ''lr 2/26/2013 00:34''!!
+hash
+ ^ self parsedValue hash!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPToken class
+ instanceVariableNames: ''''!!
+!!PPToken class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPToken class methodsFor: ''initialization'' stamp: ''lr 11/29/2011 20:42''!!
+initialize
+ "Platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple."
+
+ NewLineParser := (Character lf asParser) / (Character cr asParser , Character lf asParser optional)!! !!
+
+
+!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 2/25/2013 23:39''!!
+on: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject
+ ^ self basicNew
+ initializeOn: aSequenceableCollection
+ start: aStartInteger stop: aStopInteger
+ value: anObject!! !!
+
+!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 2/25/2013 23:36''!!
+on: aSequenceableCollection
+ ^ self on: aSequenceableCollection start: 1 stop: aSequenceableCollection size value: nil!! !!
+
+!!PPToken class methodsFor: ''instance creation'' stamp: ''lr 4/6/2010 20:58''!!
+new
+ self error: ''Token can only be created using a dedicated constructor.''!! !!
+
+
+Object subclass: #PPContextMemento
+ instanceVariableNames: ''stream position properties''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Core''!!
+!!PPContextMemento commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPContextMemento methodsFor: ''comparing'' stamp: ''JanKurs 3/19/2014 13:03''!!
+= anObject
+
+ (self == anObject) ifTrue: [ ^ true ].
+ (anObject class = PPContextMemento) ifFalse: [ ^ false ].
+
+ (anObject stream == stream) ifFalse: [ ^ false ].
+ (anObject position = position) ifFalse: [ ^ false ].
+ (anObject properties = properties) ifFalse: [ ^ false ].
+
+ ^ true.
+!! !!
+
+!!PPContextMemento methodsFor: ''comparing'' stamp: ''JanKurs 3/19/2014 13:04''!!
+hash
+ ^ (position hash bitXor: stream hash) bitXor: properties hash.!! !!
+
+
+!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
+propertyAt: aKey ifAbsentPut: aBlock
+ "Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value."
+
+ ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !!
+
+!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
+removeProperty: aKey ifAbsent: aBlock
+ "Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock."
+
+ | answer |
+ properties isNil ifTrue: [ ^ aBlock value ].
+ answer := properties removeKey: aKey ifAbsent: aBlock.
+ properties isEmpty ifTrue: [ properties := nil ].
+ ^ answer!! !!
+
+!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:14''!!
+propertyAt: aKey
+ "Answer the property value associated with aKey."
+
+ ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
+
+!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
+propertyAt: aKey ifAbsent: aBlock
+ "Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock."
+
+ ^ properties isNil
+ ifTrue: [ aBlock value ]
+ ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !!
+
+!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
+propertyAt: aKey put: anObject
+ "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
+
+ ^ (properties ifNil: [ properties := Dictionary new: 1 ])
+ at: aKey put: anObject!! !!
+
+!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:14''!!
+hasProperty: aKey
+ "Test if the property aKey is present."
+
+ ^ properties notNil and: [ properties includesKey: aKey ]!! !!
+
+!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 12:15''!!
+removeProperty: aKey
+ "Remove the property with aKey. Answer the property or raise an error if aKey isn''t found."
+
+ ^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
+
+!!PPContextMemento methodsFor: ''accessing - properties'' stamp: ''JanKurs 3/19/2014 13:04''!!
+properties
+ ^ properties !! !!
+
+
+!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:52''!!
+stream: aStream
+ stream := aStream!! !!
+
+!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:51''!!
+position
+ ^ position!! !!
+
+!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:52''!!
+position: anInteger
+ position := anInteger !! !!
+
+!!PPContextMemento methodsFor: ''as yet unclassified'' stamp: ''JanKurs 10/28/2013 16:51''!!
+stream
+ ^ stream!! !!
+
+
+Object subclass: #PPContext
+ instanceVariableNames: ''stream root properties''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Core''!!
+!!PPContext commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:27''!!
+remember
+ | memento |
+ memento := PPContextMemento new
+ stream: stream;
+ position: stream position;
+ yourself.
+
+ self rememberProperties: memento.
+ ^ memento!! !!
+
+!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:26''!!
+restore: aPPContextMemento
+ aPPContextMemento stream == stream ifFalse: [ self error: ''Oops!!!!'' ].
+
+ stream position: aPPContextMemento position.
+ self restoreProperties: aPPContextMemento.!! !!
+
+!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:29''!!
+restoreProperties: aPPContextMemento
+ aPPContextMemento stream == stream ifFalse: [ self error: ''Oops!!!!'' ].
+
+ aPPContextMemento class selectorsAndMethodsDo: [ :selector :method |
+ (selector beginsWith: ''restore'') ifTrue: [
+ aPPContextMemento withArgs: (Array with: self) executeMethod: method.
+ ]
+ ]!! !!
+
+!!PPContext methodsFor: ''memoization'' stamp: ''JanKurs 3/19/2014 16:28''!!
+rememberProperties: aPPContextMemento
+ aPPContextMemento class selectorsAndMethodsDo: [ :selector :method |
+ (selector beginsWith: ''remember'') ifTrue: [
+ aPPContextMemento withArgs: (Array with: self) executeMethod: method.
+ ]
+ ]
+!! !!
+
+
+!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:25''!!
+peekTwice
+ ^ stream peekTwice!! !!
+
+!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:02''!!
+position
+ ^ stream position!! !!
+
+!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
+uncheckedPeek
+ ^ stream uncheckedPeek!! !!
+
+!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:11''!!
+upTo: anObject
+ ^ stream upTo: anObject!! !!
+
+!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
+collection
+ ^ stream collection !! !!
+
+!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/16/2014 12:13''!!
+atEnd
+ ^ stream atEnd!! !!
+
+!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:24''!!
+peek
+ ^ stream peek!! !!
+
+!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:29''!!
+upToAll: whatever
+ ^ stream upToAll: whatever!! !!
+
+!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 8/19/2014 14:08''!!
+skip: anInteger
+ ^ stream skip: anInteger !! !!
+
+!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 4/29/2014 16:31''!!
+upToAnyOf: whatever
+ ^ stream upToAnyOf: whatever!! !!
+
+!!PPContext methodsFor: ''stream mimicry'' stamp: ''JanKurs 1/15/2014 16:02''!!
+next
+ ^ stream next!! !!
+
+
+!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
+propertyAt: aKey ifAbsentPut: aBlock
+ "Answer the property associated with aKey or, if aKey isn''t found store the result of evaluating aBlock as new value."
+
+ ^ self propertyAt: aKey ifAbsent: [ self propertyAt: aKey put: aBlock value ]!! !!
+
+!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
+removeProperty: aKey ifAbsent: aBlock
+ "Remove the property with aKey. Answer the value or, if aKey isn''t found, answer the result of evaluating aBlock."
+
+ | answer |
+ properties isNil ifTrue: [ ^ aBlock value ].
+ answer := properties removeKey: aKey ifAbsent: aBlock.
+ properties isEmpty ifTrue: [ properties := nil ].
+ ^ answer!! !!
+
+!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
+propertyAt: aKey
+ "Answer the property value associated with aKey."
+
+ ^ self propertyAt: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
+
+!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
+propertyAt: aKey ifAbsent: aBlock
+ "Answer the property value associated with aKey or, if aKey isn''t found, answer the result of evaluating aBlock."
+
+ ^ properties isNil
+ ifTrue: [ aBlock value ]
+ ifFalse: [ properties at: aKey ifAbsent: aBlock ]!! !!
+
+!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
+propertyAt: aKey put: anObject
+ "Set the property at aKey to be anObject. If aKey is not found, create a new entry for aKey and set is value to anObject. Answer anObject."
+
+ ^ (properties ifNil: [ properties := Dictionary new: 1 ])
+ at: aKey put: anObject!! !!
+
+!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
+hasProperty: aKey
+ "Test if the property aKey is present."
+
+ ^ properties notNil and: [ properties includesKey: aKey ]!! !!
+
+!!PPContext methodsFor: ''accessing-properties'' stamp: ''JanKurs 1/16/2014 11:25''!!
+removeProperty: aKey
+ "Remove the property with aKey. Answer the property or raise an error if aKey isn''t found."
+
+ ^ self removeProperty: aKey ifAbsent: [ self error: ''Property not found'' ]!! !!
+
+
+!!PPContext methodsFor: ''initialization'' stamp: ''JanKurs 1/16/2014 11:24''!!
+initialize
+ stream := nil.!! !!
+
+
+!!PPContext methodsFor: ''as yet unclassified'' stamp: ''JanKurs 3/19/2014 16:26''!!
+parsed: aPPParser at: anInteger result: anObject
+ self halt.
+ ^ anObject!! !!
+
+
+!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 10/29/2013 10:13''!!
+root: aPPParser
+ root := aPPParser !! !!
+
+!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 10/29/2013 10:13''!!
+root
+ ^ root !! !!
+
+!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 1/15/2014 15:36''!!
+stream: aStream
+ stream := aStream.!! !!
+
+!!PPContext methodsFor: ''acessing'' stamp: ''JanKurs 1/16/2014 15:12''!!
+stream
+ ^ stream!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPContext class
+ instanceVariableNames: ''''!!
+!!PPContext class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPContext class methodsFor: ''as yet unclassified'' stamp: ''JanKurs 1/16/2014 14:38''!!
+on: aPPParser stream: aStream
+ ^ self basicNew
+ initialize;
+ root: aPPParser;
+ stream: aStream asPetitStream;
+ yourself!! !!
+
+
+Object subclass: #PPMemento
+ instanceVariableNames: ''result count context''
+ classVariableNames: ''''
+ poolDictionaries: ''''
+ category: ''PetitParser-Core''!!
+!!PPMemento commentStamp: ''<historical>'' prior: 0!!
+PPMemento is an internal class used by PPMemoizedParser to cache results and detect left-recursive calls.
+
+Instance Variables:
+ result <Object> The cached result.
+ count <Integer> The number of recursive cycles followed.
+ position <Integer> The position of the cached result in the input stream.!!
+
+
+!!PPMemento methodsFor: ''accessing'' stamp: ''JanKurs 1/15/2014 16:09''!!
+contextMemento: aPPContextMemento
+ context := aPPContextMemento
+!! !!
+
+!!PPMemento methodsFor: ''accessing'' stamp: ''JanKurs 1/15/2014 16:09''!!
+contextMemento
+ ^ context!! !!
+
+!!PPMemento methodsFor: ''accessing'' stamp: ''lr 4/24/2008 10:15''!!
+result
+ ^ result!! !!
+
+!!PPMemento methodsFor: ''accessing'' stamp: ''lr 4/22/2008 18:23''!!
+result: anObject
+ result := anObject!! !!
+
+
+!!PPMemento methodsFor: ''accessing-readonly'' stamp: ''lr 4/22/2008 18:23''!!
+count
+ ^ count!! !!
+
+
+!!PPMemento methodsFor: ''initialization'' stamp: ''lr 4/22/2008 18:21''!!
+initialize
+ count := 0
+ !! !!
+
+
+!!PPMemento methodsFor: ''actions'' stamp: ''lr 4/22/2008 18:20''!!
+increment
+ count := count + 1!! !!
+
+"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!!
+
+PPMemento class
+ instanceVariableNames: ''''!!
+!!PPMemento class commentStamp: ''<historical>'' prior: 0!!
+!!
+
+
+!!PPMemento class methodsFor: ''instance creation'' stamp: ''lr 4/22/2008 18:21''!!
+new
+ ^ self basicNew initialize!! !!
+
+PPToken initialize!!''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!SequenceableCollection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 2/7/2010 20:53''!!
+asPetitStream
+ ^ PPStream on: self!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!Character methodsFor: ''*petitparser-core-operators'' stamp: ''lr 6/12/2010 09:04''!!
+- aCharacter
+ "Create a range of characters between the receiver and the argument."
+
+ ^ PPPredicateObjectParser between: self and: aCharacter!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!Character methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
+asParser
+ "Answer a parser that accepts the receiving character."
+
+ ^ PPLiteralObjectParser on: self!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!PositionableStream methodsFor: ''*petitparser-core'' stamp: ''sback 9/3/2010 10:00''!!
+peekTwice
+ "Answer what would be returned if the message next were sent to the
+ receiver. If the receiver is at the end, answer nil."
+
+ | array |
+ self atEnd
+ ifTrue: [^Array with: nil with: nil].
+ array := Array with: (self next) with: (self peek).
+ position := position - 1.
+ ^array!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!Stream methodsFor: ''*petitparser-core-converting'' stamp: ''lr 4/8/2010 14:46''!!
+asPetitStream
+ ^ self contents asPetitStream!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!Symbol methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
+asParser
+ "Answer a predicate parser named after the receiving symbol. Possible symbols are the method selectors on the class-side of PPPredicateObjectParser."
+
+ ^ PPPredicateObjectParser perform: self!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!String methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:48''!!
+asParser
+ "Answer a parser that accepts the receiving string."
+
+ ^ PPLiteralSequenceParser on: self!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!BlockClosure methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:48''!!
+asParser
+ "Answer a parser implemented in the receiving one-argument block."
+
+ ^ PPPluggableParser on: self!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!UndefinedObject methodsFor: ''*petitparser-converting'' stamp: ''lr 11/29/2011 20:49''!!
+asParser
+ "Answer a parser that succeeds and does not consume anything."
+
+ ^ PPEpsilonParser new!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!Text methodsFor: ''*petitparser-core-converting'' stamp: ''lr 2/7/2010 20:53''!!
+asPetitStream
+ ^ string asPetitStream!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!Collection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:38''!!
+asChoiceParser
+ ^ PPChoiceParser withAll: (self collect: [ :each | each asParser ])!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!Collection methodsFor: ''*petitparser-core-converting'' stamp: ''lr 11/29/2011 20:38''!!
+asSequenceParser
+ ^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!Object methodsFor: ''*petitparser-core-testing'' stamp: ''lr 8/6/2010 16:44''!!
+isPetitParser
+ ^ false!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.312417 pm''!!
+
+!!Object methodsFor: ''*petitparser-core-converting'' stamp: ''lr 12/18/2011 15:58''!!
+asParser
+ "Answer a parser accepting the receiving object."
+
+ ^ PPPredicateObjectParser expect: self!! !!
+''From Pharo3.0 of 18 March 2013 [Latest update: #30854] on 22 August 2014 at 8:49:56.314418 pm''!!
+
+!!Object methodsFor: ''*petitparser-core-testing'' stamp: ''lr 2/7/2010 20:54''!!
+isPetitFailure
+ ^ false!! !!
+'
+!
+
+smalltalkObjectMethods
+ ^ Object allMethods collect: [ :m | m sourceCode ].
+!
+
+smalltalkSourcesBig
+ ^ ((Smalltalk allClasses copyFrom: 1 to: 30) collect: [ :c |
+ c allMethods collect: [ :m | m sourceCode ]
+ ]) gather: [:each | each ].
+!
+
+workingJavaInDirectory: directory
+ | sources parser |
+ "return only such a files, that can be parsed by PPJavaSyntax"
+
+ javaCache ifNil: [ javaCache := Dictionary new ].
+
+ ^ javaCache at: directory ifAbsentPut: [
+ sources := self javaInDirectory: directory.
+ parser := PPJavaSyntax new.
+
+ sources select: [ :source | ([parser parse: source ] on: Error do: [ PPFailure new ]) isPetitFailure not ]
+ ]
+! !
+
+!PPCBenchmarkResources methodsFor:'private utilities'!
+
+files: files withExtension: extension
+ ^ files select: [ :f | f extension = extension ]
+!
+
+readDirectory: directory
+ | file |
+ file := directory asFileReference.
+ file exists ifTrue: [
+ ^ file allFiles
+ ].
+ ^ #()
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/abbrev.stc Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,6 @@
+# automagically generated by the project definition
+# this file is needed for stc to be able to compile modules independently.
+# it provides information about a classes filename, category and especially namespace.
+PPCBenchmark PPCBenchmark stx:goodies/petitparser/compiler/benchmarks 'PetitCompiler-Benchmarks' 0
+PPCBenchmarkResources PPCBenchmarkResources stx:goodies/petitparser/compiler/benchmarks 'PetitCompiler-Benchmarks' 0
+stx_goodies_petitparser_compiler_benchmarks stx_goodies_petitparser_compiler_benchmarks stx:goodies/petitparser/compiler/benchmarks '* Projects & Packages *' 3
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/bc.mak Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,84 @@
+# $Header$
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: stx_goodies_petitparser_compiler_benchmarks.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# Notice, that the name bc.mak is historical (from times, when only borland c was supported).
+# This file contains make rules for the win32 platform using either borland-bcc or visual-c.
+# It shares common definitions with the unix-make in Make.spec.
+# The bc.mak supports the following targets:
+# bmake - compile all st-files to a classLib (dll)
+# bmake clean - clean all temp files
+# bmake clobber - clean all
+#
+# Historic Note:
+# this used to contain only rules to make with borland
+# (called via bmake, by "make.exe -f bc.mak")
+# this has changed; it is now also possible to build using microsoft visual c
+# (called via vcmake, by "make.exe -f bc.mak -DUSEVC")
+#
+TOP=..\..\..\..
+INCLUDE_TOP=$(TOP)\..
+
+
+
+!INCLUDE $(TOP)\rules\stdHeader_bc
+
+!INCLUDE Make.spec
+
+LIBNAME=libstx_goodies_petitparser_compiler_benchmarks
+MODULE_PATH=goodies\petitparser\compiler\benchmarks
+RESFILES=benchmarks.$(RES)
+
+
+
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\compiler -I$(INCLUDE_TOP)\stx\goodies\petitparser\parsers\smalltalk -I$(INCLUDE_TOP)\stx\goodies\refactoryBrowser\parser -I$(INCLUDE_TOP)\stx\libbasic
+LOCALDEFINES=
+
+STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
+LOCALLIBS=
+
+OBJS= $(COMMON_OBJS) $(WIN32_OBJS)
+
+ALL:: classLibRule
+
+classLibRule: $(OUTDIR) $(OUTDIR)$(LIBNAME).dll
+
+!INCLUDE $(TOP)\rules\stdRules_bc
+
+# build all mandatory prerequisite packages (containing superclasses) for this package
+prereq:
+ pushd ..\..\..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+
+
+
+
+
+
+
+test: $(TOP)\goodies\builder\reports\NUL
+ pushd $(TOP)\goodies\builder\reports & $(MAKE_BAT)
+ $(TOP)\goodies\builder\reports\report-runner.bat -D . -r Builder::TestReport -p $(PACKAGE)
+
+clean::
+ del *.$(CSUFFIX)
+
+
+# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PPCBenchmark.$(O) PPCBenchmark.$(H): PPCBenchmark.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCBenchmarkResources.$(O) PPCBenchmarkResources.$(H): PPCBenchmarkResources.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)stx_goodies_petitparser_compiler_benchmarks.$(O) stx_goodies_petitparser_compiler_benchmarks.$(H): stx_goodies_petitparser_compiler_benchmarks.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(STCHDR)
+
+# ENDMAKEDEPEND --- do not remove this line
+
+# **Must be at end**
+
+# Enforce recompilation of package definition class if Mercurial working
+# copy state changes. Together with --guessVersion it ensures that package
+# definition class always contains correct binary revision string.
+!IFDEF HGROOT
+$(OUTDIR)stx_goodies_petitparser_compiler_benchmarks.$(O): $(HGROOT)\.hg\dirstate
+!ENDIF
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/benchmarks.rc Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,37 @@
+//
+// DO NOT EDIT
+// automagically generated from the projectDefinition: stx_goodies_petitparser_compiler_benchmarks.
+//
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION 6,2,32767,32767
+ PRODUCTVERSION 6,2,5,0
+#if (__BORLANDC__)
+ FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
+ FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
+ FILEOS VOS_NT_WINDOWS32
+ FILETYPE VFT_DLL
+ FILESUBTYPE VS_USER_DEFINED
+#endif
+
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904E4"
+ BEGIN
+ VALUE "CompanyName", "eXept Software AG\0"
+ VALUE "FileDescription", "Smalltalk/X Class library (LIB)\0"
+ VALUE "FileVersion", "6.2.32767.32767\0"
+ VALUE "InternalName", "stx:goodies/petitparser/compiler/benchmarks\0"
+ VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2014\nCopyright eXept Software AG 1998-2014\0"
+ VALUE "ProductName", "Smalltalk/X\0"
+ VALUE "ProductVersion", "6.2.5.0\0"
+ VALUE "ProductDate", "Wed, 19 Nov 2014 10:47:33 GMT\0"
+ END
+
+ END
+
+ BLOCK "VarFileInfo"
+ BEGIN // Language | Translation
+ VALUE "Translation", 0x409, 0x4E4 // U.S. English, Windows Multilingual
+ END
+END
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/bmake.bat Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,12 @@
+@REM -------
+@REM make using Borland bcc32
+@REM type bmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+make.exe -N -f bc.mak %DEFINES% %*
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/lccmake.bat Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,8 @@
+@REM -------
+@REM make using lcc compiler
+@REM type lccmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+make.exe -N -f bc.mak -DUSELCC=1 %*
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/libInit.cc Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,36 @@
+/*
+ * $Header$
+ *
+ * DO NOT EDIT
+ * automagically generated from the projectDefinition: stx_goodies_petitparser_compiler_benchmarks.
+ */
+#define __INDIRECTVMINITCALLS__
+#include <stc.h>
+
+#ifdef WIN32
+# pragma codeseg INITCODE "INITCODE"
+#endif
+
+#if defined(INIT_TEXT_SECTION) || defined(DLL_EXPORT)
+DLL_EXPORT void _libstx_goodies_petitparser_compiler_benchmarks_Init() INIT_TEXT_SECTION;
+DLL_EXPORT void _libstx_goodies_petitparser_compiler_benchmarks_InitDefinition() INIT_TEXT_SECTION;
+#endif
+
+void _libstx_goodies_petitparser_compiler_benchmarks_InitDefinition(pass, __pRT__, snd)
+OBJ snd; struct __vmData__ *__pRT__; {
+__BEGIN_PACKAGE2__("libstx_goodies_petitparser_compiler_benchmarks__DFN", _libstx_goodies_petitparser_compiler_benchmarks_InitDefinition, "stx:goodies/petitparser/compiler/benchmarks");
+_stx_137goodies_137petitparser_137compiler_137benchmarks_Init(pass,__pRT__,snd);
+
+__END_PACKAGE__();
+}
+
+void _libstx_goodies_petitparser_compiler_benchmarks_Init(pass, __pRT__, snd)
+OBJ snd; struct __vmData__ *__pRT__; {
+__BEGIN_PACKAGE2__("libstx_goodies_petitparser_compiler_benchmarks", _libstx_goodies_petitparser_compiler_benchmarks_Init, "stx:goodies/petitparser/compiler/benchmarks");
+_PPCBenchmark_Init(pass,__pRT__,snd);
+_PPCBenchmarkResources_Init(pass,__pRT__,snd);
+_stx_137goodies_137petitparser_137compiler_137benchmarks_Init(pass,__pRT__,snd);
+
+
+__END_PACKAGE__();
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/mingwmake.bat Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,16 @@
+@REM -------
+@REM make using mingw gnu compiler
+@REM type mingwmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+
+@pushd ..\..\..\..\rules
+@call find_mingw.bat
+@popd
+make.exe -N -f bc.mak %DEFINES% %USEMINGW_ARG% %*
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/stx_goodies_petitparser_compiler_benchmarks.st Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,119 @@
+"{ Package: 'stx:goodies/petitparser/compiler/benchmarks' }"
+
+LibraryDefinition subclass:#stx_goodies_petitparser_compiler_benchmarks
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'* Projects & Packages *'
+!
+
+
+!stx_goodies_petitparser_compiler_benchmarks class methodsFor:'description'!
+
+excludedFromPreRequisites
+ "list packages which are to be explicitely excluded from the automatic constructed
+ prerequisites list. If empty, everything that is found along the inheritance of any of
+ my classes is considered to be a prerequisite package."
+
+ ^ #(
+ )
+!
+
+mandatoryPreRequisites
+ "list packages which are mandatory as a prerequisite.
+ This are packages containing superclasses of my classes and classes which
+ are extended by myself.
+ They are mandatory, because we need these packages as a prerequisite for loading and compiling.
+ This method is generated automatically,
+ by searching along the inheritance chain of all of my classes."
+
+ ^ #(
+ #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_compiler_benchmarks"
+ )
+!
+
+referencedPreRequisites
+ "list packages which are a prerequisite, because they contain
+ classes which are referenced by my classes.
+ We do not need these packages as a prerequisite for loading or compiling.
+ This method is generated automatically,
+ by searching all classes (and their packages) which are referenced by my classes."
+
+ ^ #(
+ #'stx:goodies/petitparser' "PPContext - referenced by PPCBenchmark>>benchmarkSmalltalkGrammar"
+ #'stx:goodies/petitparser/compiler' "PPCContext - referenced by PPCBenchmark>>benchmarkSmalltalkGrammarCompiled"
+ #'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - referenced by PPCBenchmark>>benchmarkSmalltalkGrammar"
+ #'stx:goodies/refactoryBrowser/parser' "RBParser - referenced by PPCBenchmark>>benchmarkRBParserC"
+ )
+!
+
+subProjects
+ "list packages which are known as subprojects.
+ The generated makefile will enter those and make there as well.
+ However: they are not forced to be loaded when a package is loaded;
+ for those, redefine requiredPrerequisites."
+
+ ^ #(
+ )
+! !
+
+!stx_goodies_petitparser_compiler_benchmarks class methodsFor:'description - contents'!
+
+classNamesAndAttributes
+ "lists the classes which are to be included in the project.
+ Each entry in the list may be: a single class-name (symbol),
+ or an array-literal consisting of class name and attributes.
+ Attributes are: #autoload or #<os> where os is one of win32, unix,..."
+
+ ^ #(
+ "<className> or (<className> attributes...) in load order"
+ PPCBenchmark
+ PPCBenchmarkResources
+ #'stx_goodies_petitparser_compiler_benchmarks'
+ )
+!
+
+extensionMethodNames
+ "list class/selector pairs of extensions.
+ A correponding method with real names must be present in my concrete subclasses"
+
+ ^ #(
+ )
+! !
+
+!stx_goodies_petitparser_compiler_benchmarks class methodsFor:'description - project information'!
+
+companyName
+ "Returns a company string which will appear in <lib>.rc.
+ Under win32, this is placed into the dlls file-info"
+
+ ^ 'eXept Software AG'
+!
+
+description
+ "Returns a description string which will appear in nt.def / bc.def"
+
+ ^ 'Smalltalk/X Class library'
+!
+
+legalCopyright
+ "Returns a copyright string which will appear in <lib>.rc.
+ Under win32, this is placed into the dlls file-info"
+
+ ^ 'Copyright Claus Gittinger 1988-2014\nCopyright eXept Software AG 1998-2014'
+!
+
+productName
+ "Returns a product name which will appear in <lib>.rc.
+ Under win32, this is placed into the dlls file-info.
+ This method is usually redefined in a concrete application definition"
+
+ ^ 'Smalltalk/X'
+! !
+
+!stx_goodies_petitparser_compiler_benchmarks class methodsFor:'documentation'!
+
+version_HG
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/benchmarks/vcmake.bat Wed Nov 19 10:52:37 2014 +0000
@@ -0,0 +1,20 @@
+@REM -------
+@REM make using Microsoft Visual C compiler
+@REM type vcmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+
+@if not defined VSINSTALLDIR (
+ pushd ..\..\..\..\rules
+ call vcsetup.bat
+ popd
+)
+@SET DEFINES=
+@REM Kludge got Mercurial, cannot be implemented in Borland make
+@FOR /F "tokens=*" %%i in ('hg root') do SET HGROOT=%%i
+@IF "%HGROOT%" NEQ "" SET DEFINES=%DEFINES% "-DHGROOT=%HGROOT%"
+make.exe -N -f bc.mak -DUSEVC=1 %DEFINES% %*
+
+
+
+
--- a/compiler/compiler.rc Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/compiler.rc Wed Nov 19 10:52:37 2014 +0000
@@ -4,7 +4,7 @@
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 6,2,32767,32767
- PRODUCTVERSION 6,2,4,0
+ PRODUCTVERSION 6,2,5,0
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
@@ -24,8 +24,8 @@
VALUE "InternalName", "stx:goodies/petitparser/compiler\0"
VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2014\nCopyright eXept Software AG 1998-2014\0"
VALUE "ProductName", "Smalltalk/X\0"
- VALUE "ProductVersion", "6.2.4.0\0"
- VALUE "ProductDate", "Thu, 06 Nov 2014 01:40:03 GMT\0"
+ VALUE "ProductVersion", "6.2.5.0\0"
+ VALUE "ProductDate", "Wed, 19 Nov 2014 10:47:27 GMT\0"
END
END
--- a/compiler/libInit.cc Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/libInit.cc Wed Nov 19 10:52:37 2014 +0000
@@ -27,8 +27,6 @@
void _libstx_goodies_petitparser_compiler_Init(pass, __pRT__, snd)
OBJ snd; struct __vmData__ *__pRT__; {
__BEGIN_PACKAGE2__("libstx_goodies_petitparser_compiler", _libstx_goodies_petitparser_compiler_Init, "stx:goodies/petitparser/compiler");
-_PPCBenchmark_Init(pass,__pRT__,snd);
-_PPCBenchmarkResources_Init(pass,__pRT__,snd);
_PPCBridge_Init(pass,__pRT__,snd);
_PPCCompiledMethod_Init(pass,__pRT__,snd);
_PPCCompiler_Init(pass,__pRT__,snd);
--- a/compiler/stx_goodies_petitparser_compiler.st Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/stx_goodies_petitparser_compiler.st Wed Nov 19 10:52:37 2014 +0000
@@ -75,7 +75,6 @@
by searching all classes (and their packages) which are referenced by my classes."
^ #(
- #'stx:goodies/refactoryBrowser/parser' "RBParser - referenced by PPCBenchmark>>benchmarkRBParserC"
#'stx:libbasic2' "Stack - referenced by PPCCompiler>>initialize"
)
!
@@ -100,8 +99,6 @@
^ #(
"<className> or (<className> attributes...) in load order"
- PPCBenchmark
- PPCBenchmarkResources
PPCBridge
PPCCompiledMethod
PPCCompiler
--- a/compiler/tests/Make.spec Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/tests/Make.spec Wed Nov 19 10:52:37 2014 +0000
@@ -42,6 +42,7 @@
# -warnNonStandard : no warnings about ST/X extensions
# -warnEOLComments : no warnings about EOL comment extension
# -warnPrivacy : no warnings about privateClass extension
+# -warnUnused : no warnings about unused variables
#
# ********** OPTIONAL: MODIFY the next line(s) ***
# STCWARNINGS=-warn
--- a/compiler/tests/PPCContextMementoTest.st Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/tests/PPCContextMementoTest.st Wed Nov 19 10:52:37 2014 +0000
@@ -7,9 +7,17 @@
category:'PetitCompiler-Tests-Context'
!
+
!PPCContextMementoTest methodsFor:'as yet unclassified'!
memento
^ PPCContextMemento new
! !
+!PPCContextMementoTest class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
--- a/compiler/tests/abbrev.stc Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/tests/abbrev.stc Wed Nov 19 10:52:37 2014 +0000
@@ -6,9 +6,9 @@
PPCContextTest PPCContextTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Context' 1
PPCGuardTest PPCGuardTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 1
PPCMockCompiler PPCMockCompiler stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Core' 0
-PPCNodeCompilingTest PPCNodeCompilingTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
PPCNodeTest PPCNodeTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
PPCOptimizingTest PPCOptimizingTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
PPCompiledSmalltalkGrammarResource PPCompiledSmalltalkGrammarResource stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Smalltalk' 1
+stx_goodies_petitparser_compiler_tests stx_goodies_petitparser_compiler_tests stx:goodies/petitparser/compiler/tests '* Projects & Packages *' 3
+PPCNodeCompilingTest PPCNodeCompilingTest stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Nodes' 1
PPCompiledSmalltalkGrammarTests PPCompiledSmalltalkGrammarTests stx:goodies/petitparser/compiler/tests 'PetitCompiler-Tests-Smalltalk' 1
-stx_goodies_petitparser_compiler_tests stx_goodies_petitparser_compiler_tests stx:goodies/petitparser/compiler/tests '* Projects & Packages *' 3
--- a/compiler/tests/bc.mak Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/tests/bc.mak Wed Nov 19 10:52:37 2014 +0000
@@ -30,6 +30,7 @@
!INCLUDE Make.spec
LIBNAME=libstx_goodies_petitparser_compiler_tests
+MODULE_PATH=goodies\petitparser\compiler\tests
RESFILES=tests.$(RES)
--- a/compiler/tests/stx_goodies_petitparser_compiler_tests.st Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/tests/stx_goodies_petitparser_compiler_tests.st Wed Nov 19 10:52:37 2014 +0000
@@ -57,7 +57,7 @@
^ #(
#'stx:goodies/petitparser/tests' "PPAbstractParserTest - superclass of PPCCompilerTest"
#'stx:goodies/sunit' "TestAsserter - superclass of PPCCompilerTest"
- #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_compiler_tests"
+ #'stx:libbasic' "Autoload - superclass of PPCNodeCompilingTest"
)
!
@@ -70,7 +70,7 @@
^ #(
#'stx:goodies/petitparser' "PPCharSetPredicate - referenced by PPCCompilerTest>>testGuard1"
- #'stx:goodies/petitparser/compiler' "PPCActionNode - referenced by PPCNodeCompilingTest>>testCompileAction"
+ #'stx:goodies/petitparser/compiler' "PPCActionNode - referenced by PPCOptimizingTest>>testSymbolAction"
#'stx:goodies/petitparser/parsers/smalltalk' "PPSmalltalkGrammar - referenced by PPCCompilerTest>>testClass"
)
!
@@ -100,12 +100,12 @@
PPCContextTest
PPCGuardTest
PPCMockCompiler
- (PPCNodeCompilingTest autoload)
PPCNodeTest
PPCOptimizingTest
PPCompiledSmalltalkGrammarResource
+ #'stx_goodies_petitparser_compiler_tests'
+ (PPCNodeCompilingTest autoload)
(PPCompiledSmalltalkGrammarTests autoload)
- #'stx_goodies_petitparser_compiler_tests'
)
!
--- a/compiler/tests/tests.rc Sat Nov 08 02:08:45 2014 +0000
+++ b/compiler/tests/tests.rc Wed Nov 19 10:52:37 2014 +0000
@@ -4,7 +4,7 @@
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 6,2,32767,32767
- PRODUCTVERSION 6,2,4,0
+ PRODUCTVERSION 6,2,5,0
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
@@ -24,8 +24,8 @@
VALUE "InternalName", "stx:goodies/petitparser/compiler/tests\0"
VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2014\nCopyright eXept Software AG 1998-2014\0"
VALUE "ProductName", "Smalltalk/X\0"
- VALUE "ProductVersion", "6.2.4.0\0"
- VALUE "ProductDate", "Thu, 06 Nov 2014 01:40:05 GMT\0"
+ VALUE "ProductVersion", "6.2.5.0\0"
+ VALUE "ProductDate", "Wed, 19 Nov 2014 10:47:30 GMT\0"
END
END
--- a/islands/Make.spec Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/Make.spec Wed Nov 19 10:52:37 2014 +0000
@@ -42,6 +42,7 @@
# -warnNonStandard : no warnings about ST/X extensions
# -warnEOLComments : no warnings about EOL comment extension
# -warnPrivacy : no warnings about privateClass extension
+# -warnUnused : no warnings about unused variables
#
# ********** OPTIONAL: MODIFY the next line(s) ***
# STCWARNINGS=-warn
--- a/islands/PPMemoizingIsland.st Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/PPMemoizingIsland.st Wed Nov 19 10:52:37 2014 +0000
@@ -10,6 +10,7 @@
PPMemoizingIsland comment:'A PPMemoizingIsland is memoized version of PPIsland. Use this one, unless you don''t mind really bad performance. If the memoized version is not working flawlessly, its a bug!!
Please see help of the PPIsland for how to use...
Instance Variables
memoizationDictionaries: <Object>
rootParser: <Object>
memoizationDictionaries
- memoization cache
rootParser
- used for memoizing, once the root changes, flushes the caches
'
!
+
!PPMemoizingIsland class methodsFor:'as yet unclassified'!
initialize
@@ -88,5 +89,12 @@
! !
+!PPMemoizingIsland class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
PPMemoizingIsland initialize!
--- a/islands/abbrev.stc Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/abbrev.stc Wed Nov 19 10:52:37 2014 +0000
@@ -1,12 +1,12 @@
# automagically generated by the project definition
# this file is needed for stc to be able to compile modules independently.
# it provides information about a classes filename, category and especially namespace.
-JavaParser JavaParser stx:goodies/petitparser/islands 'PetitIslands-Examples' 0
PPInputEnds PPInputEnds stx:goodies/petitparser/islands 'PetitIslands-Parsers' 0
PPIsland PPIsland stx:goodies/petitparser/islands 'PetitIslands-Parsers' 0
PPNonEmptyParser PPNonEmptyParser stx:goodies/petitparser/islands 'PetitIslands-Parsers' 0
PPWater PPWater stx:goodies/petitparser/islands 'PetitIslands-Parsers' 0
-XmlFeedParser XmlFeedParser stx:goodies/petitparser/islands 'PetitIslands-Examples' 0
stx_goodies_petitparser_islands stx_goodies_petitparser_islands stx:goodies/petitparser/islands '* Projects & Packages *' 3
PPMemoizingIsland PPMemoizingIsland stx:goodies/petitparser/islands 'PetitIslands-Parsers' 0
+JavaParser JavaParser stx:goodies/petitparser/islands 'PetitIslands-Examples' 0
RobustXmlFeedParser RobustXmlFeedParser stx:goodies/petitparser/islands 'PetitIslands-Examples' 0
+XmlFeedParser XmlFeedParser stx:goodies/petitparser/islands 'PetitIslands-Examples' 0
--- a/islands/bc.mak Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/bc.mak Wed Nov 19 10:52:37 2014 +0000
@@ -30,6 +30,7 @@
!INCLUDE Make.spec
LIBNAME=libstx_goodies_petitparser_islands
+MODULE_PATH=goodies\petitparser\islands
RESFILES=islands.$(RES)
--- a/islands/islands.rc Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/islands.rc Wed Nov 19 10:52:37 2014 +0000
@@ -4,7 +4,7 @@
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 6,2,32767,32767
- PRODUCTVERSION 6,2,4,0
+ PRODUCTVERSION 6,2,5,0
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
@@ -24,8 +24,8 @@
VALUE "InternalName", "stx:goodies/petitparser/islands\0"
VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2014\nCopyright eXept Software AG 1998-2014\0"
VALUE "ProductName", "Smalltalk/X\0"
- VALUE "ProductVersion", "6.2.4.0\0"
- VALUE "ProductDate", "Mon, 03 Nov 2014 09:06:55 GMT\0"
+ VALUE "ProductVersion", "6.2.5.0\0"
+ VALUE "ProductDate", "Wed, 19 Nov 2014 10:47:20 GMT\0"
END
END
--- a/islands/stx_goodies_petitparser_islands.st Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/stx_goodies_petitparser_islands.st Wed Nov 19 10:52:37 2014 +0000
@@ -72,7 +72,7 @@
^ #(
#'stx:goodies/petitparser' "PPChoiceParser - extended"
- #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_islands"
+ #'stx:libbasic' "Autoload - superclass of JavaParser"
)
!
@@ -108,15 +108,15 @@
^ #(
"<className> or (<className> attributes...) in load order"
- (JavaParser autoload)
PPInputEnds
PPIsland
PPNonEmptyParser
PPWater
- (XmlFeedParser autoload)
#'stx_goodies_petitparser_islands'
PPMemoizingIsland
+ (JavaParser autoload)
(RobustXmlFeedParser autoload)
+ (XmlFeedParser autoload)
)
!
--- a/islands/tests/Make.proto Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/tests/Make.proto Wed Nov 19 10:52:37 2014 +0000
@@ -34,7 +34,7 @@
# add the path(es) here:,
# ********** OPTIONAL: MODIFY the next lines ***
# LOCALINCLUDES=-Ifoo -Ibar
-LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/goodies/petitparser -I$(INCLUDE_TOP)/stx/goodies/petitparser/islands -I$(INCLUDE_TOP)/stx/goodies/petitparser/tests -I$(INCLUDE_TOP)/stx/goodies/sunit -I$(INCLUDE_TOP)/stx/libbasic
+LOCALINCLUDES= -I$(INCLUDE_TOP)/stx/libbasic
# if you need any additional defines for embedded C code,
@@ -102,13 +102,6 @@
# build all mandatory prerequisite packages (containing superclasses) for this package
prereq:
cd ../../../../libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../../../libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../../../libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../../../libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../ && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../../../libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../../sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
- cd ../../tests && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
--- a/islands/tests/Make.spec Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/tests/Make.spec Wed Nov 19 10:52:37 2014 +0000
@@ -42,6 +42,7 @@
# -warnNonStandard : no warnings about ST/X extensions
# -warnEOLComments : no warnings about EOL comment extension
# -warnPrivacy : no warnings about privateClass extension
+# -warnUnused : no warnings about unused variables
#
# ********** OPTIONAL: MODIFY the next line(s) ***
# STCWARNINGS=-warn
--- a/islands/tests/abbrev.stc Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/tests/abbrev.stc Wed Nov 19 10:52:37 2014 +0000
@@ -1,10 +1,10 @@
# automagically generated by the project definition
# this file is needed for stc to be able to compile modules independently.
# it provides information about a classes filename, category and especially namespace.
+stx_goodies_petitparser_islands_tests stx_goodies_petitparser_islands_tests stx:goodies/petitparser/islands/tests '* Projects & Packages *' 3
FirstFollowNextTests FirstFollowNextTests stx:goodies/petitparser/islands/tests 'PetitIslands-Tests' 1
JavaParserTest JavaParserTest stx:goodies/petitparser/islands/tests 'PetitIslands-Examples' 1
PPIslandTest PPIslandTest stx:goodies/petitparser/islands/tests 'PetitIslands-Tests' 1
+PPMemoizingIslandTest PPMemoizingIslandTest stx:goodies/petitparser/islands/tests 'PetitIslands-Tests' 1
RobustXmlFeedParserTest RobustXmlFeedParserTest stx:goodies/petitparser/islands/tests 'PetitIslands-Examples' 1
XmlFeedParserTest XmlFeedParserTest stx:goodies/petitparser/islands/tests 'PetitIslands-Examples' 1
-stx_goodies_petitparser_islands_tests stx_goodies_petitparser_islands_tests stx:goodies/petitparser/islands/tests '* Projects & Packages *' 3
-PPMemoizingIslandTest PPMemoizingIslandTest stx:goodies/petitparser/islands/tests 'PetitIslands-Tests' 1
--- a/islands/tests/bc.mak Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/tests/bc.mak Wed Nov 19 10:52:37 2014 +0000
@@ -30,11 +30,12 @@
!INCLUDE Make.spec
LIBNAME=libstx_goodies_petitparser_islands_tests
+MODULE_PATH=goodies\petitparser\islands\tests
RESFILES=tests.$(RES)
-LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\petitparser -I$(INCLUDE_TOP)\stx\goodies\petitparser\islands -I$(INCLUDE_TOP)\stx\goodies\petitparser\tests -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\libbasic
LOCALDEFINES=
STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -headerDir=. $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -varPrefix=$(LIBNAME)
@@ -51,13 +52,6 @@
# build all mandatory prerequisite packages (containing superclasses) for this package
prereq:
pushd ..\..\..\..\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\..\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\..\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\..\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\.. & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\..\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\..\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
- pushd ..\..\tests & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
--- a/islands/tests/stx_goodies_petitparser_islands_tests.st Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/tests/stx_goodies_petitparser_islands_tests.st Wed Nov 19 10:52:37 2014 +0000
@@ -54,9 +54,7 @@
by searching along the inheritance chain of all of my classes."
^ #(
- #'stx:goodies/petitparser/tests' "PPAbstractParserTest - superclass of JavaParserTest"
- #'stx:goodies/sunit' "TestAsserter - superclass of FirstFollowNextTests"
- #'stx:libbasic' "LibraryDefinition - superclass of stx_goodies_petitparser_islands_tests"
+ #'stx:libbasic' "Autoload - superclass of FirstFollowNextTests"
)
!
@@ -68,8 +66,6 @@
by searching all classes (and their packages) which are referenced by my classes."
^ #(
- #'stx:goodies/petitparser' "PPContext - referenced by JavaParserTest>>context"
- #'stx:goodies/petitparser/islands' "JavaParser - referenced by JavaParserTest>>parserClass"
)
!
@@ -93,13 +89,13 @@
^ #(
"<className> or (<className> attributes...) in load order"
+ #'stx_goodies_petitparser_islands_tests'
(FirstFollowNextTests autoload)
(JavaParserTest autoload)
(PPIslandTest autoload)
+ (PPMemoizingIslandTest autoload)
(RobustXmlFeedParserTest autoload)
(XmlFeedParserTest autoload)
- #'stx_goodies_petitparser_islands_tests'
- (PPMemoizingIslandTest autoload)
)
!
--- a/islands/tests/tests.rc Sat Nov 08 02:08:45 2014 +0000
+++ b/islands/tests/tests.rc Wed Nov 19 10:52:37 2014 +0000
@@ -4,7 +4,7 @@
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION 6,2,32767,32767
- PRODUCTVERSION 6,2,4,0
+ PRODUCTVERSION 6,2,5,0
#if (__BORLANDC__)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
@@ -24,8 +24,8 @@
VALUE "InternalName", "stx:goodies/petitparser/islands/tests\0"
VALUE "LegalCopyright", "Copyright Claus Gittinger 1988-2014\nCopyright eXept Software AG 1998-2014\0"
VALUE "ProductName", "Smalltalk/X\0"
- VALUE "ProductVersion", "6.2.4.0\0"
- VALUE "ProductDate", "Mon, 03 Nov 2014 09:06:56 GMT\0"
+ VALUE "ProductVersion", "6.2.5.0\0"
+ VALUE "ProductDate", "Wed, 19 Nov 2014 10:47:23 GMT\0"
END
END