--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Make.proto Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,155 @@
+# $Header: /cvs/stx/stx/goodies/petitparser/Make.proto,v 1.1 2011-08-18 18:56:17 cg Exp $
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: squeak_petitparser.
+#
+# 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=../../stx
+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/sunit -I$(INCLUDE_TOP)/stx/libbasic -I$(INCLUDE_TOP)/stx/libbasic2
+
+
+# if you need any additional defines for embedded C code,
+# add them here:,
+# ********** OPTIONAL: MODIFY the next lines ***
+# LOCALDEFINES=-Dfoo -Dbar -DDEBUG
+LOCALDEFINES=
+
+LIBNAME=libsqueak_petitparser
+STCLOCALOPT='-package=$(PACKAGE)' -I. $(LOCALINCLUDES) $(STCLOCALOPTIMIZATIONS) $(STCWARNINGS) $(LOCALDEFINES) -H. -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:: update-svn-revision
+
+
+
+update-svn-revision:
+ sed -i -e "s/\"\$$SVN\-Revision:\".*\"\$$\"/\"\$$SVN-Revision:\"'$(shell svnversion -n)'\"\$$\"/g" \
+ squeak_petitparser.st
+.PHONY: update-svn-revision
+
+
+# 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
+
+prereq: $(REQUIRED_SUPPORT_DIRS)
+ cd $(TOP)/libbasic && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/goodies/refactoryBrowser/parser && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/libbasic2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/libcomp && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/libview && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/libbasic3 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/libview2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/libboss && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/libui && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/libwidg && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/libwidg2 && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/libtool && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/goodies/sunit && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+ cd $(TOP)/librun && $(MAKE) "CFLAGS_LOCAL=$(GLOBALDEFINES)"
+
+
+
+cleanjunk::
+
+clean::
+ -rm -f *.o *.H
+
+clobber:: clean
+ -rm -f *.so *.dll
+
+
+# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PPCharSetPredicate.$(O) PPCharSetPredicate.$(H): PPCharSetPredicate.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPFailure.$(O) PPFailure.$(H): PPFailure.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPMemento.$(O) PPMemento.$(H): PPMemento.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPParser.$(O) PPParser.$(H): PPParser.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPStream.$(O) PPStream.$(H): PPStream.st $(INCLUDE_TOP)/stx/libbasic/ReadStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPToken.$(O) PPToken.$(H): PPToken.st $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)squeak_petitparser.$(O) squeak_petitparser.$(H): squeak_petitparser.st $(INCLUDE_TOP)/stx/libbasic/LibraryDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/ProjectDefinition.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPDelegateParser.$(O) PPDelegateParser.$(H): PPDelegateParser.st $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPEpsilonParser.$(O) PPEpsilonParser.$(H): PPEpsilonParser.st $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPFailingParser.$(O) PPFailingParser.$(H): PPFailingParser.st $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPListParser.$(O) PPListParser.$(H): PPListParser.st $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPLiteralParser.$(O) PPLiteralParser.$(H): PPLiteralParser.st $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPPluggableParser.$(O) PPPluggableParser.$(H): PPPluggableParser.st $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPPredicateParser.$(O) PPPredicateParser.$(H): PPPredicateParser.st $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPUnresolvedParser.$(O) PPUnresolvedParser.$(H): PPUnresolvedParser.st $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPActionParser.$(O) PPActionParser.$(H): PPActionParser.st $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPAndParser.$(O) PPAndParser.$(H): PPAndParser.st $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPChoiceParser.$(O) PPChoiceParser.$(H): PPChoiceParser.st $(INCLUDE_TOP)/squeak/petitparser/PPListParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPCompositeParser.$(O) PPCompositeParser.$(H): PPCompositeParser.st $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPEndOfInputParser.$(O) PPEndOfInputParser.$(H): PPEndOfInputParser.st $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPExpressionParser.$(O) PPExpressionParser.$(H): PPExpressionParser.st $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPFlattenParser.$(O) PPFlattenParser.$(H): PPFlattenParser.st $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPLiteralObjectParser.$(O) PPLiteralObjectParser.$(H): PPLiteralObjectParser.st $(INCLUDE_TOP)/squeak/petitparser/PPLiteralParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPLiteralSequenceParser.$(O) PPLiteralSequenceParser.$(H): PPLiteralSequenceParser.st $(INCLUDE_TOP)/squeak/petitparser/PPLiteralParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPMemoizedParser.$(O) PPMemoizedParser.$(H): PPMemoizedParser.st $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPNotParser.$(O) PPNotParser.$(H): PPNotParser.st $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPOptionalParser.$(O) PPOptionalParser.$(H): PPOptionalParser.st $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPPredicateObjectParser.$(O) PPPredicateObjectParser.$(H): PPPredicateObjectParser.st $(INCLUDE_TOP)/squeak/petitparser/PPPredicateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPPredicateSequenceParser.$(O) PPPredicateSequenceParser.$(H): PPPredicateSequenceParser.st $(INCLUDE_TOP)/squeak/petitparser/PPPredicateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPRepeatingParser.$(O) PPRepeatingParser.$(H): PPRepeatingParser.st $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPSequenceParser.$(O) PPSequenceParser.$(H): PPSequenceParser.st $(INCLUDE_TOP)/squeak/petitparser/PPListParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPTrimmingParser.$(O) PPTrimmingParser.$(H): PPTrimmingParser.st $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPArithmeticParser.$(O) PPArithmeticParser.$(H): PPArithmeticParser.st $(INCLUDE_TOP)/squeak/petitparser/PPCompositeParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPLambdaParser.$(O) PPLambdaParser.$(H): PPLambdaParser.st $(INCLUDE_TOP)/squeak/petitparser/PPCompositeParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPTokenParser.$(O) PPTokenParser.$(H): PPTokenParser.st $(INCLUDE_TOP)/squeak/petitparser/PPFlattenParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)PPWrappingParser.$(O) PPWrappingParser.$(H): PPWrappingParser.st $(INCLUDE_TOP)/squeak/petitparser/PPActionParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPDelegateParser.$(H) $(INCLUDE_TOP)/squeak/petitparser/PPParser.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(STCHDR)
+$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)/stx/libbasic/Block.$(H) $(INCLUDE_TOP)/stx/libbasic/CompiledCode.$(H) $(INCLUDE_TOP)/stx/libbasic/ExecutableFunction.$(H) $(INCLUDE_TOP)/stx/libbasic/Object.$(H) $(INCLUDE_TOP)/stx/libbasic/BlockContext.$(H) $(INCLUDE_TOP)/stx/libbasic/Context.$(H) $(INCLUDE_TOP)/stx/libbasic/Character.$(H) $(INCLUDE_TOP)/stx/libbasic/Magnitude.$(H) $(INCLUDE_TOP)/stx/libbasic/PositionableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/PeekableStream.$(H) $(INCLUDE_TOP)/stx/libbasic/Stream.$(H) $(INCLUDE_TOP)/stx/libbasic/SequenceableCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Collection.$(H) $(INCLUDE_TOP)/stx/libbasic/Set.$(H) $(INCLUDE_TOP)/stx/libbasic/String.$(H) $(INCLUDE_TOP)/stx/libbasic/CharacterArray.$(H) $(INCLUDE_TOP)/stx/libbasic/ByteArray.$(H) $(INCLUDE_TOP)/stx/libbasic/UninterpretedBytes.$(H) $(INCLUDE_TOP)/stx/libbasic/ArrayedCollection.$(H) $(INCLUDE_TOP)/stx/libbasic/Symbol.$(H) $(INCLUDE_TOP)/stx/libbasic/UndefinedObject.$(H) $(STCHDR)
+
+# ENDMAKEDEPEND --- do not remove this line
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Make.spec Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,133 @@
+# $Header: /cvs/stx/stx/goodies/petitparser/Make.spec,v 1.1 2011-08-18 18:56:17 cg Exp $
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: squeak_petitparser.
+#
+# 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=squeak
+MODULE_DIR=petitparser
+PACKAGE=$(MODULE):$(MODULE_DIR)
+
+
+# Argument(s) to the stc compiler (stc --usage).
+# -H. : 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
+#
+# ********** OPTIONAL: MODIFY the next line(s) ***
+# STCWARNINGS=-warn
+# STCWARNINGS=-warnNonStandard
+# STCWARNINGS=-warnEOLComments
+STCWARNINGS=-warnNonStandard
+
+COMMON_CLASSES= \
+ PPCharSetPredicate \
+ PPFailure \
+ PPMemento \
+ PPParser \
+ PPStream \
+ PPToken \
+ squeak_petitparser \
+ PPDelegateParser \
+ PPEpsilonParser \
+ PPFailingParser \
+ PPListParser \
+ PPLiteralParser \
+ PPPluggableParser \
+ PPPredicateParser \
+ PPUnresolvedParser \
+ PPActionParser \
+ PPAndParser \
+ PPChoiceParser \
+ PPCompositeParser \
+ PPEndOfInputParser \
+ PPExpressionParser \
+ PPFlattenParser \
+ PPLiteralObjectParser \
+ PPLiteralSequenceParser \
+ PPMemoizedParser \
+ PPNotParser \
+ PPOptionalParser \
+ PPPredicateObjectParser \
+ PPPredicateSequenceParser \
+ PPRepeatingParser \
+ PPSequenceParser \
+ PPTrimmingParser \
+ PPArithmeticParser \
+ PPLambdaParser \
+ PPTokenParser \
+ PPWrappingParser \
+
+
+
+
+COMMON_OBJS= \
+ $(OUTDIR)PPCharSetPredicate.$(O) \
+ $(OUTDIR)PPFailure.$(O) \
+ $(OUTDIR)PPMemento.$(O) \
+ $(OUTDIR)PPParser.$(O) \
+ $(OUTDIR)PPStream.$(O) \
+ $(OUTDIR)PPToken.$(O) \
+ $(OUTDIR)squeak_petitparser.$(O) \
+ $(OUTDIR)PPDelegateParser.$(O) \
+ $(OUTDIR)PPEpsilonParser.$(O) \
+ $(OUTDIR)PPFailingParser.$(O) \
+ $(OUTDIR)PPListParser.$(O) \
+ $(OUTDIR)PPLiteralParser.$(O) \
+ $(OUTDIR)PPPluggableParser.$(O) \
+ $(OUTDIR)PPPredicateParser.$(O) \
+ $(OUTDIR)PPUnresolvedParser.$(O) \
+ $(OUTDIR)PPActionParser.$(O) \
+ $(OUTDIR)PPAndParser.$(O) \
+ $(OUTDIR)PPChoiceParser.$(O) \
+ $(OUTDIR)PPCompositeParser.$(O) \
+ $(OUTDIR)PPEndOfInputParser.$(O) \
+ $(OUTDIR)PPExpressionParser.$(O) \
+ $(OUTDIR)PPFlattenParser.$(O) \
+ $(OUTDIR)PPLiteralObjectParser.$(O) \
+ $(OUTDIR)PPLiteralSequenceParser.$(O) \
+ $(OUTDIR)PPMemoizedParser.$(O) \
+ $(OUTDIR)PPNotParser.$(O) \
+ $(OUTDIR)PPOptionalParser.$(O) \
+ $(OUTDIR)PPPredicateObjectParser.$(O) \
+ $(OUTDIR)PPPredicateSequenceParser.$(O) \
+ $(OUTDIR)PPRepeatingParser.$(O) \
+ $(OUTDIR)PPSequenceParser.$(O) \
+ $(OUTDIR)PPTrimmingParser.$(O) \
+ $(OUTDIR)PPArithmeticParser.$(O) \
+ $(OUTDIR)PPLambdaParser.$(O) \
+ $(OUTDIR)PPTokenParser.$(O) \
+ $(OUTDIR)PPWrappingParser.$(O) \
+ $(OUTDIR)extensions.$(O) \
+
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPAbstractParseTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,89 @@
+"{ Package: 'squeak:petitparser' }"
+
+TestCase subclass:#PPAbstractParseTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Core'
+!
+
+
+!PPAbstractParseTest class methodsFor:'accessing'!
+
+packageNamesUnderTest
+ ^ #('PetitParser' 'PetitTests')
+! !
+
+!PPAbstractParseTest class methodsFor:'testing'!
+
+isAbstract
+ ^ self name = #PPAbstractParseTest
+! !
+
+!PPAbstractParseTest methodsFor:'utilities'!
+
+assert: aParser fail: aCollection
+ self assert: aParser fail: aCollection end: 0
+!
+
+assert: aParser fail: aCollection end: anInteger
+ | stream result |
+ self
+ assert: aParser isPetitParser
+ description: 'Parser invalid'.
+ stream := aCollection asPetitStream.
+ result := aParser parse: stream.
+ self
+ assert: result isPetitFailure
+ description: 'Parser did not fail'.
+ self
+ assert: stream position = anInteger
+ description: 'Parser failed at wrong position'
+!
+
+assert: aParser parse: aCollection
+ self assert: aParser parse: aCollection to: nil end: aCollection size
+!
+
+assert: aParser parse: aCollection end: anInteger
+ self assert: aParser parse: aCollection to: nil end: anInteger
+!
+
+assert: aParser parse: aCollection to: anObject
+ self assert: aParser parse: aCollection to: anObject end: aCollection size
+!
+
+assert: aParser parse: aParseObject to: aTargetObject end: anInteger
+ | stream result |
+ self
+ assert: aParser isPetitParser
+ description: 'Parser invalid'.
+ stream := aParseObject asPetitStream.
+ result := aParser parse: stream.
+ aTargetObject isNil
+ ifTrue: [ self deny: result isPetitFailure ]
+ ifFalse: [ self assert: result = aTargetObject ].
+ self
+ assert: stream position = anInteger
+ description: 'Parser accepted at wrong position'
+
+ "Modified: / 18-12-2010 / 18:01:30 / Jan Kurs <kurs.jan@post.cz>"
+!
+
+assert: aParser parse: aParserObject toToken: from stop: to
+ | token |
+ token := PPToken on: aParserObject start: from stop: to.
+ ^ self assert: aParser parse: aParserObject to: token
+!
+
+assert: aParser parse: aParserObject toToken: from stop: to end: end
+ | token |
+ token := PPToken on: aParserObject start: from stop: to.
+ ^ self assert: aParser parse: aParserObject to: token end: end
+! !
+
+!PPAbstractParseTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPAbstractParseTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPActionParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,50 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPDelegateParser subclass:#PPActionParser
+ instanceVariableNames:'block'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPActionParser comment:'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 class methodsFor:'instance creation'!
+
+on: aParser block: aBlock
+ ^ (self on: aParser) setBlock: aBlock
+! !
+
+!PPActionParser methodsFor:'accessing'!
+
+block
+ "Answer the action block of the receiver."
+
+ ^ block
+! !
+
+!PPActionParser methodsFor:'initialization'!
+
+setBlock: aBlock
+ block := aBlock
+! !
+
+!PPActionParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | element |
+ ^ (element := parser parseOn: aStream) isPetitFailure
+ ifFalse: [ block value: element ]
+ ifTrue: [ element ]
+! !
+
+!PPActionParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPActionParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPAndParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,34 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPDelegateParser subclass:#PPAndParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPAndParser comment:'The and-predicate, a parser that succeeds whenever its delegate does, but consumes the input stream [Parr 1994, 1995].'
+!
+
+
+!PPAndParser methodsFor:'operations'!
+
+and
+ ^ self
+! !
+
+!PPAndParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | element position |
+ position := aStream position.
+ element := parser parseOn: aStream.
+ aStream position: position.
+ ^ element
+! !
+
+!PPAndParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPAndParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPArithmeticParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,58 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPCompositeParser subclass:#PPArithmeticParser
+ instanceVariableNames:'terms addition factors multiplication power primary parentheses
+ number'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Examples'
+!
+
+
+!PPArithmeticParser methodsFor:'accessing'!
+
+start
+ ^ terms end
+! !
+
+!PPArithmeticParser methodsFor:'grammar'!
+
+addition
+ ^ (factors separatedBy: ($+ asParser / $- asParser) token trim)
+ foldLeft: [ :a :op :b | a perform: op value asSymbol with: b ]
+!
+
+factors
+ ^ multiplication / power
+!
+
+multiplication
+ ^ (power separatedBy: ($* asParser / $/ asParser) token trim)
+ foldLeft: [ :a :op :b | a perform: op value asSymbol with: b ]
+!
+
+number
+ ^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) token trim ==> [ :token | token value asNumber ]
+!
+
+parentheses
+ ^ $( asParser flatten trim , terms , $) asParser flatten trim ==> #second
+!
+
+power
+ ^ (primary separatedBy: $^ asParser token trim) foldRight: [ :a :op :b | a raisedTo: b ]
+!
+
+primary
+ ^ number / parentheses
+!
+
+terms
+ ^ addition / factors
+! !
+
+!PPArithmeticParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPArithmeticParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPArithmeticParserTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,128 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPCompositeParserTest subclass:#PPArithmeticParserTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Tests'
+!
+
+
+!PPArithmeticParserTest methodsFor:'accessing'!
+
+parserClass
+ ^ PPArithmeticParser
+! !
+
+!PPArithmeticParserTest methodsFor:'testing'!
+
+testNum
+ self assert: '0' is: 0.
+ self assert: '0.0' is: 0.0.
+ self assert: '1' is: 1.
+ self assert: '1.2' is: 1.2.
+ self assert: '34' is: 34.
+ self assert: '56.78' is: 56.78.
+ self assert: '-9' is: -9.
+ self assert: '-9.9' is: -9.9
+! !
+
+!PPArithmeticParserTest methodsFor:'testing-expression'!
+
+testBrackets
+ self assert: '(1)' is: 1.
+ self assert: '(1 + 2)' is: 3.
+
+ self assert: '((1))' is: 1.
+ self assert: '((1 + 2))' is: 3.
+
+ self assert: '2 * (3 + 4)' is: 14.
+ self assert: '(2 + 3) * 4' is: 20.
+ self assert: '6 / (2 + 4)' is: 1.
+ self assert: '(2 + 6) / 2' is: 4
+!
+
+testPriority
+ self assert: '2 * 3 + 4' is: 10.
+ self assert: '2 + 3 * 4' is: 14.
+ self assert: '6 / 3 + 4' is: 6.
+ self assert: '2 + 6 / 2' is: 5
+! !
+
+!PPArithmeticParserTest methodsFor:'testing-operations'!
+
+testAdd
+ self assert: '1 + 2' is: 3.
+ self assert: '2 + 1' is: 3.
+ self assert: '1 + 2.3' is: 3.3.
+ self assert: '2.3 + 1' is: 3.3.
+ self assert: '1 + -2' is: -1.
+ self assert: '-2 + 1' is: -1
+!
+
+testAddMany
+ self assert: '1' is: 1.
+ self assert: '1 + 2' is: 3.
+ self assert: '1 + 2 + 3' is: 6.
+ self assert: '1 + 2 + 3 + 4' is: 10.
+ self assert: '1 + 2 + 3 + 4 + 5' is: 15
+!
+
+testDiv
+ self assert: '12 / 3' is: 4.
+ self assert: '-16 / -4' is: 4
+!
+
+testDivMany
+ self assert: '100 / 2' is: 50.
+ self assert: '100 / 2 / 2' is: 25.
+ self assert: '100 / 2 / 2 / 5' is: 5.
+ self assert: '100 / 2 / 2 / 5 / 5' is: 1
+
+!
+
+testMul
+ self assert: '2 * 3' is: 6.
+ self assert: '2 * -4' is: -8
+!
+
+testMulMany
+ self assert: '1 * 2' is: 2.
+ self assert: '1 * 2 * 3' is: 6.
+ self assert: '1 * 2 * 3 * 4' is: 24.
+ self assert: '1 * 2 * 3 * 4 * 5' is: 120
+!
+
+testPow
+ self assert: '2 ^ 3' is: 8.
+ self assert: '-2 ^ 3' is: -8.
+ self assert: '-2 ^ -3' is: -0.125
+!
+
+testPowMany
+ self assert: '4 ^ 3' is: 64.
+ self assert: '4 ^ 3 ^ 2' is: 262144.
+ self assert: '4 ^ 3 ^ 2 ^ 1' is: 262144.
+ self assert: '4 ^ 3 ^ 2 ^ 1 ^ 0' is: 262144
+!
+
+testSub
+ self assert: '1 - 2' is: -1.
+ self assert: '1.2 - 1.2' is: 0.
+ self assert: '1 - -2' is: 3.
+ self assert: '-1 - -2' is: 1
+!
+
+testSubMany
+ self assert: '1' is: 1.
+ self assert: '1 - 2' is: -1.
+ self assert: '1 - 2 - 3' is: -4.
+ self assert: '1 - 2 - 3 - 4' is: -8.
+ self assert: '1 - 2 - 3 - 4 - 5' is: -13
+! !
+
+!PPArithmeticParserTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPArithmeticParserTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPCharSetPredicate.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,43 @@
+"{ Package: 'squeak:petitparser' }"
+
+Object subclass:#PPCharSetPredicate
+ instanceVariableNames:'block classification'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Tools'
+!
+
+
+!PPCharSetPredicate class methodsFor:'instance creation'!
+
+on: aBlock
+ ^ self basicNew initializeOn: aBlock
+! !
+
+!PPCharSetPredicate methodsFor:'evaluating'!
+
+value: aCharacter
+ | index |
+ index := aCharacter asInteger.
+ index == 0
+ ifTrue: [ ^ block value: aCharacter ].
+ index > 255
+ ifTrue: [ ^ block value: aCharacter ].
+ ^ classification at: index
+! !
+
+!PPCharSetPredicate methodsFor:'initialization'!
+
+initializeOn: aBlock
+ block := aBlock.
+ classification := Array new: 255.
+ 1 to: classification size do: [ :index |
+ classification at: index put: (block
+ value: (Character value: index)) ]
+! !
+
+!PPCharSetPredicate class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPCharSetPredicate.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPChoiceParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,38 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPListParser subclass:#PPChoiceParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPChoiceParser comment:'A parser that uses the first parser that succeeds.'
+!
+
+
+!PPChoiceParser methodsFor:'operations'!
+
+/ aRule
+ ^ self copyWith: aRule
+! !
+
+!PPChoiceParser methodsFor:'parsing'!
+
+parseOn: aStream
+ "This is optimized code that avoids unnecessary block activations, do not change. When all choices fail, the last failure is answered."
+
+ | element |
+ 1 to: parsers size do: [ :index |
+ element := (parsers at: index)
+ parseOn: aStream.
+ element isPetitFailure
+ ifFalse: [ ^ element ] ].
+ ^ element
+! !
+
+!PPChoiceParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPChoiceParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPComposedTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,409 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPAbstractParseTest subclass:#PPComposedTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Tests'
+!
+
+
+!PPComposedTest methodsFor:'accessing'!
+
+comment
+ ^ ($" asParser , $" asParser negate star , $" asParser) flatten
+!
+
+identifier
+ ^ (#letter asParser , #word asParser star) flatten
+!
+
+number
+ ^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten
+! !
+
+!PPComposedTest methodsFor:'testing'!
+
+testDoubledString
+ | parser |
+ parser := ($' asParser , (($' asParser , $' asParser) / $' asParser negate) star flatten , $' asParser)
+ ==> [ :nodes | nodes second copyReplaceAll: '''''' with: '''' ].
+
+ self assert: parser parse: '''''' to: ''.
+ self assert: parser parse: '''a''' to: 'a'.
+ self assert: parser parse: '''ab''' to: 'ab'.
+ self assert: parser parse: '''a''''b''' to: 'a''b'.
+ self assert: parser parse: '''a''''''''b''' to: 'a''''b'
+
+ "Modified: / 18-12-2010 / 18:00:16 / Jan Kurs <kurs.jan@post.cz>"
+!
+
+testEvenNumber
+ "Create a grammar that parses an even number of a's and b's."
+
+ | a as b bs s |
+ a := $a asParser ==> [ :char | as := as + 1 ].
+ b := $b asParser ==> [ :char | bs := bs + 1 ].
+ s := (a / b) star >=> [ :stream :cc |
+ as := bs := 0.
+ cc value.
+ (as even and: [ bs even ])
+ ifFalse: [ PPFailure message: 'Even number of a and b expected' at: 0 ] ].
+
+ self assert: s fail: 'a' end: 1.
+ self assert: s fail: 'b' end: 1.
+ self assert: s fail: 'ab' end: 2.
+ self assert: s fail: 'ba' end: 2.
+ self assert: s fail: 'aaa' end: 3.
+ self assert: s fail: 'bbb' end: 3.
+ self assert: s fail: 'aab' end: 3.
+ self assert: s fail: 'abb' end: 3.
+
+ self assert: s parse: ''.
+ self assert: s parse: 'aa'.
+ self assert: s parse: 'bb'.
+ self assert: s parse: 'aaaa'.
+ self assert: s parse: 'aabb'.
+ self assert: s parse: 'abab'.
+ self assert: s parse: 'baba'.
+ self assert: s parse: 'bbaa'.
+ self assert: s parse: 'bbbb'
+!
+
+testIfThenElse
+ "S ::= if C then S else S | if C then S | X"
+
+ | start if then else cond expr parser |
+ start := PPUnresolvedParser new.
+ if := 'if' asParser token trim.
+ then := 'then' asParser token trim.
+ else := 'else' asParser token trim.
+ cond := 'C' asParser token trim.
+ expr := 'X' asParser token trim.
+ start def: (if , cond , then , start , else , start) / (if , cond , then , start) / expr.
+ parser := start end.
+ self assert: parser parse: 'X'.
+ self assert: parser parse: 'if C then X'.
+ self assert: parser parse: 'if C then X else X'.
+ self assert: parser parse: 'if C then if C then X'.
+ self assert: parser parse: 'if C then if C then X else if C then X'.
+ self assert: parser parse: 'if C then if C then X else X else if C then X'.
+ self assert: parser parse: 'if C then if C then X else X else if C then X else X'.
+ self assert: parser fail: 'if C'.
+ self assert: parser fail: 'if C else X'.
+ self assert: parser fail: 'if C then if C'
+!
+
+testLeftRecursion
+ "S ::= S 'x' S / '1'"
+
+ | parser |
+ parser := PPUnresolvedParser new.
+ parser def: ((parser , $x asParser , parser) / $1 asParser) memoized flatten.
+
+ self assert: parser parse: '1' to: '1'.
+ self assert: parser parse: '1x1' to: '1x1'.
+ self assert: parser parse: '1x1x1' to: '1x1x1'.
+ self assert: parser parse: '1x1x1x1' to: '1x1x1x1'.
+ self assert: parser parse: '1x1x1x1x1' to: '1x1x1x1x1'.
+ self assert: parser parse: '1x1x1x1x1x1' to: '1x1x1x1x1x1'
+!
+
+testListOfIntegers
+ "S ::= S , number | number"
+
+ | number list parser |
+ number := #digit asParser plus token trim
+ ==> [ :node | node value asInteger ].
+ list := (number separatedBy: $, asParser token trim)
+ ==> [ :node | node select: [ :each | each isInteger ] ].
+ parser := list end.
+
+ self assert: parser parse: '1' to: (1 to: 1) asArray.
+ self assert: parser parse: '1,2' to: (1 to: 2) asArray.
+ self assert: parser parse: '1,2,3' to: (1 to: 3) asArray.
+ self assert: parser parse: '1,2,3,4' to: (1 to: 4) asArray.
+ self assert: parser parse: '1,2,3,4,5' to: (1 to: 5) asArray.
+
+ self assert: parser parse: '1' to: (1 to: 1) asArray.
+ self assert: parser parse: '1, 2' to: (1 to: 2) asArray.
+ self assert: parser parse: '1, 2, 3' to: (1 to: 3) asArray.
+ self assert: parser parse: '1, 2, 3, 4' to: (1 to: 4) asArray.
+ self assert: parser parse: '1, 2, 3, 4, 5' to: (1 to: 5) asArray.
+
+ self assert: parser parse: '1' to: (1 to: 1) asArray.
+ self assert: parser parse: '1 ,2' to: (1 to: 2) asArray.
+ self assert: parser parse: '1 ,2 ,3' to: (1 to: 3) asArray.
+ self assert: parser parse: '1 ,2 ,3 ,4' to: (1 to: 4) asArray.
+ self assert: parser parse: '1 ,2 ,3 ,4 ,5' to: (1 to: 5) asArray.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: ','.
+ self assert: parser fail: '1,'.
+ self assert: parser fail: '1,,2'
+!
+
+testNestedComments
+ "C ::= B I* E"
+ "I ::= !!E (C | T)"
+ "B ::= /*"
+ "E ::= */"
+ "T ::= ."
+
+ | begin end any inside parser |
+ begin := '/*' asParser.
+ end := '*/' asParser.
+ any := #any asParser.
+
+ parser := PPUnresolvedParser new.
+ inside := end not , (parser / any).
+ parser def: begin , inside star , end.
+
+ self assert: parser parse: '/*ab*/cd' end: 6.
+ self assert: parser parse: '/*a/*b*/c*/'.
+ self assert: parser fail: '/*a/*b*/c'
+!
+
+testPalindrome
+ "S0 ::= a S1 a | b S1 b | ...
+ S1 ::= S0 | epsilon"
+
+ | s0 s1 parser |
+ s0 := PPUnresolvedParser new.
+ s1 := PPUnresolvedParser new.
+ s0 def: ($a asParser , s1 , $a asParser)
+ / ($b asParser , s1 , $b asParser)
+ / ($c asParser , s1 , $c asParser).
+ s1 def: s0 / nil asParser.
+ parser := s0 flatten end.
+
+ self assert: parser parse: 'aa' to: 'aa'.
+ self assert: parser parse: 'bb' to: 'bb'.
+ self assert: parser parse: 'cc' to: 'cc'.
+
+ self assert: parser parse: 'abba' to: 'abba'.
+ self assert: parser parse: 'baab' to: 'baab'.
+
+ self assert: parser parse: 'abccba' to: 'abccba'.
+ self assert: parser parse: 'abaaba' to: 'abaaba'.
+ self assert: parser parse: 'cbaabc' to: 'cbaabc'.
+
+ self assert: parser fail: 'a'.
+ self assert: parser fail: 'ab'.
+ self assert: parser fail: 'aab'.
+ self assert: parser fail: 'abccbb'
+!
+
+testParseAaaBbb
+ "S0 ::= a S1 b
+ S1 ::= S0 | epsilon"
+
+ | s0 s1 parser |
+ s0 := PPUnresolvedParser new.
+ s1 := PPUnresolvedParser new.
+ s0 def: $a asParser , s1 , $b asParser.
+ s1 def: s0 / nil asParser.
+ parser := s0 flatten.
+
+ self assert: parser parse: 'ab' to: 'ab'.
+ self assert: parser parse: 'aabb' to: 'aabb'.
+ self assert: parser parse: 'aaabbb' to: 'aaabbb'.
+ self assert: parser parse: 'aaaabbbb' to: 'aaaabbbb'.
+
+ self assert: parser parse: 'abb' to: 'ab' end: 2.
+ self assert: parser parse: 'aabbb' to: 'aabb' end: 4.
+ self assert: parser parse: 'aaabbbb' to: 'aaabbb' end: 6.
+ self assert: parser parse: 'aaaabbbbb' to: 'aaaabbbb' end: 8.
+
+ self assert: parser fail: 'a'.
+ self assert: parser fail: 'b'.
+ self assert: parser fail: 'aab'.
+ self assert: parser fail: 'aaabb'
+!
+
+testParseAaaaaa
+ "S ::= a a S | epsilon"
+
+ | s0 s1 parser |
+ s0 := PPUnresolvedParser new.
+ s1 := $a asParser , $a asParser , s0.
+ s0 def: s1 / nil asParser.
+ parser := s0 flatten.
+
+ self assert: parser parse: '' to: ''.
+ self assert: parser parse: 'aa' to: 'aa'.
+ self assert: parser parse: 'aaaa' to: 'aaaa'.
+ self assert: parser parse: 'aaaaaa' to: 'aaaaaa'.
+
+ self assert: parser parse: 'a' to: '' end: 0.
+ self assert: parser parse: 'aaa' to: 'aa' end: 2.
+ self assert: parser parse: 'aaaaa' to: 'aaaa' end: 4.
+ self assert: parser parse: 'aaaaaaa' to: 'aaaaaa' end: 6
+!
+
+testParseAbAbAb
+ "S ::= (A B)+"
+
+ | parser |
+ parser := ($a asParser , $b asParser) plus flatten.
+
+ self assert: parser parse: 'ab' to: 'ab'.
+ self assert: parser parse: 'abab' to: 'abab'.
+ self assert: parser parse: 'ababab' to: 'ababab'.
+ self assert: parser parse: 'abababab' to: 'abababab'.
+
+ self assert: parser parse: 'abb' to: 'ab' end: 2.
+ self assert: parser parse: 'ababa' to: 'abab' end: 4.
+ self assert: parser parse: 'abababb' to: 'ababab' end: 6.
+ self assert: parser parse: 'ababababa' to: 'abababab' end: 8.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: 'bab'
+!
+
+testParseAbabbb
+ "S ::= (A | B)+"
+
+ | parser |
+ parser := ($a asParser / $b asParser) plus flatten.
+
+ self assert: parser parse: 'a' to: 'a'.
+ self assert: parser parse: 'b' to: 'b'.
+ self assert: parser parse: 'ab' to: 'ab'.
+ self assert: parser parse: 'ba' to: 'ba'.
+ self assert: parser parse: 'aaa' to: 'aaa'.
+ self assert: parser parse: 'aab' to: 'aab'.
+ self assert: parser parse: 'aba' to: 'aba'.
+ self assert: parser parse: 'baa' to: 'baa'.
+ self assert: parser parse: 'abb' to: 'abb'.
+ self assert: parser parse: 'bab' to: 'bab'.
+ self assert: parser parse: 'bba' to: 'bba'.
+ self assert: parser parse: 'bbb' to: 'bbb'.
+
+ self assert: parser parse: 'ac' to: 'a' end: 1.
+ self assert: parser parse: 'bc' to: 'b' end: 1.
+ self assert: parser parse: 'abc' to: 'ab' end: 2.
+ self assert: parser parse: 'bac' to: 'ba' end: 2.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'c'
+!
+
+testParseAnBnCn
+ "PEGs for a non context- free language:
+
+ a^n , b^n , c^n
+
+ S <- &P1 P2
+ P1 <- AB 'c'
+ AB <- 'a' AB 'b' / epsilon
+ P2 <- 'a'* BC end
+ BC <- 'b' BC 'c' / epsilon"
+
+ | s p1 ab p2 bc |
+ s := PPUnresolvedParser new.
+ p1 := PPUnresolvedParser new.
+ ab := PPUnresolvedParser new.
+ p2 := PPUnresolvedParser new.
+ bc := PPUnresolvedParser new.
+
+ s def: (p1 and , p2 end) flatten.
+ p1 def: ab , $c asParser.
+ ab def: ($a asParser , ab , $b asParser) optional.
+ p2 def: $a asParser star , bc.
+ bc def: ($b asParser , bc , $c asParser) optional.
+
+ self assert: s parse: 'abc' to: 'abc'.
+ self assert: s parse: 'aabbcc' to: 'aabbcc'.
+ self assert: s parse: 'aaabbbccc' to: 'aaabbbccc'.
+
+ self assert: s fail: 'bc'.
+ self assert: s fail: 'ac'.
+ self assert: s fail: 'ab'.
+ self assert: s fail: 'abbcc'.
+ self assert: s fail: 'aabcc'.
+ self assert: s fail: 'aabbc'
+! !
+
+!PPComposedTest methodsFor:'testing-examples'!
+
+testComment
+ self assert: self comment parse: '""' to: '""'.
+ self assert: self comment parse: '"a"' to: '"a"'.
+ self assert: self comment parse: '"ab"' to: '"ab"'.
+ self assert: self comment parse: '"abc"' to: '"abc"'.
+
+ self assert: self comment parse: '""a' to: '""' end: 2.
+ self assert: self comment parse: '"a"a' to: '"a"' end: 3.
+ self assert: self comment parse: '"ab"a' to: '"ab"' end: 4.
+ self assert: self comment parse: '"abc"a' to: '"abc"' end: 5.
+
+ self assert: self comment fail: '"'.
+ self assert: self comment fail: '"a'.
+ self assert: self comment fail: '"aa'.
+ self assert: self comment fail: 'a"'.
+ self assert: self comment fail: 'aa"'
+!
+
+testIdentifier
+ self assert: self identifier parse: 'a' to: 'a'.
+ self assert: self identifier parse: 'a1' to: 'a1'.
+ self assert: self identifier parse: 'a12' to: 'a12'.
+ self assert: self identifier parse: 'ab' to: 'ab'.
+ self assert: self identifier parse: 'a1b' to: 'a1b'.
+
+ self assert: self identifier parse: 'a_' to: 'a' end: 1.
+ self assert: self identifier parse: 'a1-' to: 'a1' end: 2.
+ self assert: self identifier parse: 'a12+' to: 'a12' end: 3.
+ self assert: self identifier parse: 'ab^' to: 'ab' end: 2.
+ self assert: self identifier parse: 'a1b*' to: 'a1b' end: 3.
+
+ self assert: self identifier fail: ''.
+ self assert: self identifier fail: '1'.
+ self assert: self identifier fail: '1a'
+!
+
+testNumber
+ self assert: self number parse: '1' to: '1'.
+ self assert: self number parse: '12' to: '12'.
+ self assert: self number parse: '12.3' to: '12.3'.
+ self assert: self number parse: '12.34' to: '12.34'.
+
+ self assert: self number parse: '1..' to: '1' end: 1.
+ self assert: self number parse: '12-' to: '12' end: 2.
+ self assert: self number parse: '12.3.' to: '12.3' end: 4.
+ self assert: self number parse: '12.34.' to: '12.34' end: 5.
+
+ self assert: self number parse: '-1' to: '-1'.
+ self assert: self number parse: '-12' to: '-12'.
+ self assert: self number parse: '-12.3' to: '-12.3'.
+ self assert: self number parse: '-12.34' to: '-12.34'.
+
+ self assert: self number fail: ''.
+ self assert: self number fail: '-'.
+ self assert: self number fail: '.'.
+ self assert: self number fail: '.1'
+!
+
+testReturn
+ | number spaces return |
+ number := #digit asParser plus token.
+ spaces := #space asParser star.
+ return := (spaces , $^ asParser token , spaces , number)
+ ==> [ :nodes | Array with: #return with: (nodes at: 4) value ].
+
+ self assert: return parse: '^1' to: #(return '1').
+ self assert: return parse: '^12' to: #(return '12').
+ self assert: return parse: '^ 123' to: #(return '123').
+ self assert: return parse: '^ 1234' to: #(return '1234').
+
+ self assert: return fail: '1'.
+ self assert: return fail: '^'
+! !
+
+!PPComposedTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPComposedTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPCompositeParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,122 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPDelegateParser subclass:#PPCompositeParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Tools'
+!
+
+PPCompositeParser comment:'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 class methodsFor:'instance creation'!
+
+new
+ "Answer a new parser starting at the default start symbol."
+
+ ^ self newStartingAt: self startSymbol
+!
+
+newStartingAt: aSymbol
+ "Answer a new parser starting at aSymbol."
+
+ ^ self basicNew initializeStartingAt: aSymbol
+! !
+
+!PPCompositeParser class methodsFor:'accessing'!
+
+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
+!
+
+startSymbol
+ "Answer the method that represents the default start symbol."
+
+ ^ #start
+! !
+
+!PPCompositeParser class methodsFor:'parsing'!
+
+parse: anObject
+ ^ self parse: anObject startingAt: self startSymbol
+!
+
+parse: anObject onError: aBlock
+ ^ self parse: anObject startingAt: self startSymbol onError: aBlock
+!
+
+parse: anObject startingAt: aSymbol
+ ^ (self newStartingAt: aSymbol) parse: anObject
+!
+
+parse: anObject startingAt: aSymbol onError: aBlock
+ ^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock
+! !
+
+!PPCompositeParser methodsFor:'accessing'!
+
+start
+ "Answer the production to start this parser with."
+
+ self subclassResponsibility
+! !
+
+!PPCompositeParser methodsFor:'initialization'!
+
+initializeStartingAt: aSymbol
+ | allVariableNames ignoredVariableNames productionIndexesAndNames |
+ self initialize.
+
+ "find all the productions that need to be initialized"
+ allVariableNames := self class allInstVarNames
+ collect: [ :each | each asSymbol ].
+ ignoredVariableNames := self class ignoredNames
+ collect: [ :each | each asSymbol ].
+ productionIndexesAndNames := ((1 to: self class instSize)
+ collect: [ :index | index -> (allVariableNames at: index) ])
+ reject: [ :assoc | ignoredVariableNames includes: assoc value ].
+
+ "initialize productions with an undefined parser to be replaced later"
+ parser := PPUnresolvedParser named: aSymbol.
+ productionIndexesAndNames do: [ :assoc |
+ self instVarAt: assoc key put: (PPUnresolvedParser named: assoc value) ].
+ parser def: (self perform: aSymbol).
+
+ "resolve unresolved parsers with their actual implementation"
+ productionIndexesAndNames do: [ :assoc |
+ (self respondsTo: assoc value)
+ ifFalse: [ self error: 'Unable to initialize ' , assoc value printString ]
+ ifTrue: [ (self instVarAt: assoc key) def: (self perform: assoc value) ] ]
+! !
+
+!PPCompositeParser methodsFor:'querying'!
+
+productionAt: aSymbol
+ "Answer the production named aSymbol."
+
+ ^ self productionAt: aSymbol ifAbsent: [ nil ]
+!
+
+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 class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPCompositeParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPCompositeParserTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,90 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPAbstractParseTest subclass:#PPCompositeParserTest
+ instanceVariableNames:'parser result'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Core'
+!
+
+
+!PPCompositeParserTest class methodsFor:'accessing'!
+
+resources
+ ^ Array with: PPParserResource
+! !
+
+!PPCompositeParserTest class methodsFor:'testing'!
+
+isAbstract
+ ^ self name = #PPCompositeParserTest
+! !
+
+!PPCompositeParserTest methodsFor:'accessing'!
+
+parserClass
+ self subclassResponsibility
+!
+
+parserInstance
+ ^ PPParserResource current parserAt: self parserClass
+! !
+
+!PPCompositeParserTest methodsFor:'parsing'!
+
+fail: aString rule: aSymbol
+ | production |
+ production := self parserInstance
+ productionAt: aSymbol.
+ result := production end
+ parse: aString.
+ self
+ assert: result isPetitFailure
+ description: 'Able to parse ' , aString printString.
+ ^ result
+!
+
+parse: aString
+ ^ self parse: aString rule: #start
+!
+
+parse: aString rule: aSymbol
+ | production |
+ production := self parserInstance.
+ aSymbol = #start
+ ifFalse: [ production := production productionAt: aSymbol ].
+ result := production parse: aString.
+ self
+ deny: result isPetitFailure
+ description: 'Unable to parse ' , aString printString
+ resumable: true.
+ ^ result
+! !
+
+!PPCompositeParserTest methodsFor:'running'!
+
+setUp
+ super setUp.
+ parser := self parserInstance
+!
+
+tearDown
+ super tearDown.
+ parser := result := nil
+! !
+
+!PPCompositeParserTest methodsFor:'utilities'!
+
+assert: aCollection is: anObject
+ self parse: aCollection.
+ self
+ assert: result = anObject
+ description: 'Got: ' , result printString , '; Expected: ' , anObject printString
+ resumable: true
+! !
+
+!PPCompositeParserTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPCompositeParserTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPDelegateParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,44 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPParser subclass:#PPDelegateParser
+ instanceVariableNames:'parser'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPDelegateParser comment:'A parser that delegates to another parser.
+Instance Variables:
+ parser <PPParser> The parser to delegate to.'
+!
+
+
+!PPDelegateParser class methodsFor:'instance creation'!
+
+on: aParser
+ ^ self new setParser: aParser
+! !
+
+!PPDelegateParser methodsFor:'accessing'!
+
+children
+ ^ Array with: parser
+! !
+
+!PPDelegateParser methodsFor:'initialization'!
+
+setParser: aParser
+ parser := aParser
+! !
+
+!PPDelegateParser methodsFor:'parsing'!
+
+parseOn: aStream
+ ^ parser parseOn: aStream
+! !
+
+!PPDelegateParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPDelegateParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPEndOfInputParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,39 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPDelegateParser subclass:#PPEndOfInputParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPEndOfInputParser comment:'A parser that succeeds only at the end of the input stream.'
+!
+
+
+!PPEndOfInputParser methodsFor:'operations'!
+
+end
+ ^ self
+! !
+
+!PPEndOfInputParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | position result |
+ position := aStream position.
+ result := parser parseOn: aStream.
+ (result isPetitFailure or: [ aStream atEnd ])
+ ifTrue: [ ^ result ].
+ result := PPFailure
+ message: 'end of input expected'
+ at: aStream position.
+ aStream position: position.
+ ^ result
+! !
+
+!PPEndOfInputParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPEndOfInputParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPEpsilonParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,24 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPParser subclass:#PPEpsilonParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPEpsilonParser comment:'A parser that consumes nothing and always succeeds.'
+!
+
+
+!PPEpsilonParser methodsFor:'parsing'!
+
+parseOn: aStream
+ ^ nil
+! !
+
+!PPEpsilonParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPEpsilonParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPExpressionParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,149 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPDelegateParser subclass:#PPExpressionParser
+ instanceVariableNames:'operators'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Tools'
+!
+
+PPExpressionParser comment:'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'!
+
+build: aParser left: aChoiceParser
+ ^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]
+!
+
+build: aParser postfix: aChoiceParser
+ ^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]
+!
+
+build: aParser prefix: aChoiceParser
+ ^ aChoiceParser star , aParser map: [ :ops :term | ops reversed inject: term into: [ :result :operator | operator first value: operator second value: result ] ]
+!
+
+build: aParser right: aChoiceParser
+ ^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]
+!
+
+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 ]) ] ]) ] ]
+!
+
+buildSelectors
+ ^ #(build:prefix: build:postfix: build:right: build:left:)
+!
+
+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'!
+
+group: aOneArgumentBlock
+ "Defines a priority group by evaluating aOneArgumentBlock."
+
+ operators := Dictionary new.
+ parser := [
+ aOneArgumentBlock value: self.
+ self buildOn: parser ]
+ ensure: [ operators := nil ]
+!
+
+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
+!
+
+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
+!
+
+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
+!
+
+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
+!
+
+term: aParser
+ "Defines the initial term aParser of the receiver."
+
+ parser isNil
+ ifTrue: [ parser := aParser ]
+ ifFalse: [ self error: 'Unable to redefine the term.' ]
+! !
+
+!PPExpressionParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPExpressionParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPExpressionParserTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,77 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPArithmeticParserTest subclass:#PPExpressionParserTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Tests'
+!
+
+
+!PPExpressionParserTest class methodsFor:'testing'!
+
+shouldInheritSelectors
+ ^ true
+! !
+
+!PPExpressionParserTest methodsFor:'accessing'!
+
+parserInstance
+ | expression parens number |
+ expression := PPExpressionParser new.
+ parens := $( asParser token trim , expression , $) asParser token trim
+ ==> [ :nodes | nodes second ].
+ number := (#digit asParser plus , ($. asParser , #digit asParser plus) optional) token trim
+ ==> [ :token | token value asNumber ].
+ expression term: parens / number.
+ expression
+ group: [ :g |
+ g prefix: $- asParser token trim do: [ :op :a | a negated ] ];
+ group: [ :g |
+ g postfix: '++' asParser token trim do: [ :a :op | a + 1 ].
+ g postfix: '--' asParser token trim do: [ :a :op | a - 1 ] ];
+ group: [ :g |
+ g right: $^ asParser token trim do: [ :a :op :b | a raisedTo: b ] ];
+ group: [ :g |
+ g left: $* asParser token trim do: [ :a :op :b | a * b ].
+ g left: $/ asParser token trim do: [ :a :op :b | a / b ] ];
+ group: [ :g |
+ g left: $+ asParser token trim do: [ :a :op :b | a + b ].
+ g left: $- asParser token trim do: [ :a :op :b | a - b ] ].
+ ^ expression end
+! !
+
+!PPExpressionParserTest methodsFor:'testing'!
+
+testPostfixAdd
+ self assert: '0++' is: 1.
+ self assert: '0++++' is: 2.
+ self assert: '0++++++' is: 3.
+
+ self assert: '0+++1' is: 2.
+ self assert: '0+++++1' is: 3.
+ self assert: '0+++++++1' is: 4
+!
+
+testPostfixSub
+ self assert: '1--' is: 0.
+ self assert: '2----' is: 0.
+ self assert: '3------' is: 0.
+
+ self assert: '2---1' is: 0.
+ self assert: '3-----1' is: 0.
+ self assert: '4-------1' is: 0.
+!
+
+testPrefixNegate
+ self assert: '1' is: 1.
+ self assert: '-1' is: -1.
+ self assert: '--1' is: 1.
+ self assert: '---1' is: -1
+! !
+
+!PPExpressionParserTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPExpressionParserTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPExtensionTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,125 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPAbstractParseTest subclass:#PPExtensionTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Tests'
+!
+
+
+!PPExtensionTest methodsFor:'testing-parser'!
+
+testCharacter
+ | parser |
+ parser := $a asParser.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: 'b'
+!
+
+testClosure
+ | parser |
+ parser := [ :stream | stream upTo: $s ] asParser.
+ self assert: parser parse: '' to: ''.
+ self assert: parser parse: 'a' to: 'a'.
+ self assert: parser parse: 'aa' to: 'aa'.
+ self assert: parser parse: 's' to: ''.
+ self assert: parser parse: 'as' to: 'a'.
+ self assert: parser parse: 'aas' to: 'aa'.
+ self assert: parser parse: 'sa' to: '' end: 1.
+ self assert: parser parse: 'saa' to: '' end: 1.
+
+ parser := [ :stream | stream upTo: $s. PPFailure message: 'stream' at: stream position ] asParser.
+ self assert: parser fail: ''.
+ self assert: parser fail: 's'.
+ self assert: parser fail: 'as'
+
+!
+
+testEpsilon
+ | parser |
+ parser := nil asParser.
+ self assert: parser asParser = parser
+!
+
+testOrdered
+ | parser |
+ parser := #(1 2) asParser.
+ self assert: parser parse: #(1 2) to: #(1 2).
+ self assert: parser parse: #(1 2 3) to: #(1 2) end: 2.
+ self assert: parser fail: #().
+ self assert: parser fail: #(1).
+ self assert: parser fail: #(1 1).
+ self assert: parser fail: #(1 1 2)
+!
+
+testParser
+ | parser |
+ parser := $a asParser.
+ self assert: parser asParser = parser
+!
+
+testRange
+ | parser |
+ parser := $a ppMinus: $c.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'b' to: $b.
+ self assert: parser parse: 'c' to: $c.
+ self assert: parser fail: 'd'
+
+ "Modified: / 19-12-2010 / 18:15:45 / Jan Kurs <kurs.jan@post.cz>"
+!
+
+testString
+ | parser |
+ parser := 'ab' asParser.
+ self assert: parser parse: 'ab' to: 'ab'.
+ self assert: parser parse: 'aba' to: 'ab' end: 2.
+ self assert: parser parse: 'abb' to: 'ab' end: 2.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: 'ac'
+!
+
+testSymbol
+ | parser |
+ parser := #any asParser.
+ self assert: parser parse: 'a'.
+ self assert: parser fail: ''
+!
+
+testUnordered
+ | parser |
+ parser := #(1 2) asSet asParser.
+ self assert: parser parse: #(1) to: 1.
+ self assert: parser parse: #(2) to: 2.
+ self assert: parser parse: #(1 2) to: 1 end: 1.
+ self assert: parser parse: #(2 1) to: 2 end: 1.
+ self assert: parser fail: #().
+ self assert: parser fail: #(3)
+! !
+
+!PPExtensionTest methodsFor:'testing-stream'!
+
+testStream
+ | stream |
+ stream := 'abc' readStream asPetitStream.
+ self assert: (stream class = PPStream).
+ self assert: (stream printString = '·abc').
+ self assert: (stream peek) = $a.
+ self assert: (stream uncheckedPeek = $a).
+ self assert: (stream next) = $a.
+ self assert: (stream printString = 'a·bc').
+ self assert: (stream asPetitStream = stream)
+!
+
+testText
+ | stream |
+ stream := 'abc' asText asPetitStream.
+ self assert: stream class = PPStream
+! !
+
+!PPExtensionTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPExtensionTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPFailingParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,53 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPParser subclass:#PPFailingParser
+ instanceVariableNames:'message'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPFailingParser comment:'A parser that consumes nothing and always fails.
+Instance Variables:
+ message <String> The failure message.'
+!
+
+
+!PPFailingParser class methodsFor:'instance creation'!
+
+message: aString
+ ^ self new setMessage: aString
+! !
+
+!PPFailingParser methodsFor:'accessing'!
+
+message
+ "Answer the error message of the receiving parser."
+
+ ^ message
+! !
+
+!PPFailingParser methodsFor:'initialization'!
+
+setMessage: aString
+ message := aString
+! !
+
+!PPFailingParser methodsFor:'parsing'!
+
+parseOn: aStream
+ ^ PPFailure message: message at: aStream position
+! !
+
+!PPFailingParser methodsFor:'printing'!
+
+printNameOn: aStream
+ super printNameOn: aStream.
+ aStream nextPutAll: ', '; print: message
+! !
+
+!PPFailingParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPFailingParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPFailure.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,63 @@
+"{ Package: 'squeak:petitparser' }"
+
+Object subclass:#PPFailure
+ instanceVariableNames:'message position'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Core'
+!
+
+PPFailure comment:'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 class methodsFor:'instance creation'!
+
+message: aString at: anInteger
+ ^ self basicNew initializeMessage: aString at: anInteger
+! !
+
+!PPFailure methodsFor:'accessing'!
+
+message
+ "Answer a human readable error message of this parse failure."
+
+ ^ message
+!
+
+position
+ "Answer the position in the source string that caused this parse failure."
+
+ ^ position
+! !
+
+!PPFailure methodsFor:'initialization'!
+
+initializeMessage: aString at: anInteger
+ message := aString.
+ position := anInteger
+! !
+
+!PPFailure methodsFor:'printing'!
+
+printOn: aStream
+ aStream nextPutAll: self message; nextPutAll: ' at '; print: position
+! !
+
+!PPFailure methodsFor:'testing'!
+
+isPetitFailure
+ "I am the only class that should implement this method to return true."
+
+ ^ true
+! !
+
+!PPFailure class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPFailure.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPFlattenParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,37 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPDelegateParser subclass:#PPFlattenParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPFlattenParser comment:'A parser that answers a flat copy of the range my delegate parses.'
+!
+
+
+!PPFlattenParser methodsFor:'hooks'!
+
+create: aCollection start: aStartInteger stop: aStopInteger
+ ^ aCollection copyFrom: aStartInteger to: aStopInteger
+! !
+
+!PPFlattenParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | start element stop |
+ start := aStream position.
+ element := parser parseOn: aStream.
+ element isPetitFailure ifTrue: [
+ aStream position: start.
+ ^ element ].
+ stop := aStream position.
+ ^ self create: aStream collection start: start + 1 stop: stop
+! !
+
+!PPFlattenParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPFlattenParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPLambdaParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,65 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPCompositeParser subclass:#PPLambdaParser
+ instanceVariableNames:'expression abstraction application variable'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Examples'
+!
+
+
+!PPLambdaParser class methodsFor:'curch-booleans'!
+
+and
+ ^ self parse: '\p.\q.((p q) p)'
+!
+
+false
+ ^ self parse: '\x.\y.y'
+!
+
+ifthenelse
+ ^ self parse: '\p.p'
+!
+
+not
+ ^ self parse: '\p.\a.\b.((p b) a)'
+!
+
+or
+ ^ self parse: '\p.\q.((p p) q)'
+!
+
+true
+ ^ self parse: '\x.\y.x'
+! !
+
+!PPLambdaParser methodsFor:'accessing'!
+
+start
+ ^ expression end
+! !
+
+!PPLambdaParser methodsFor:'productions'!
+
+abstraction
+ ^ $\ asParser token trim , variable , $. asParser token trim , expression ==> [ :node | Array with: node second with: node fourth ]
+!
+
+application
+ ^ $( asParser token trim , expression , expression , $) asParser token trim ==> [ :node | Array with: node second with: node third ]
+!
+
+expression
+ ^ variable / abstraction / application
+!
+
+variable
+ ^ (#letter asParser , #word asParser star) token trim ==> [ :token | token value ]
+! !
+
+!PPLambdaParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPLambdaParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPLambdaParserTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,155 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPCompositeParserTest subclass:#PPLambdaParserTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Tests'
+!
+
+
+!PPLambdaParserTest methodsFor:'accessing'!
+
+parserClass
+ ^ PPLambdaParser
+! !
+
+!PPLambdaParserTest methodsFor:'testing'!
+
+testAbstraction
+ self assert: '\x.y' is: #('x' 'y').
+ self assert: '\x.\y.z' is: #('x' ('y' 'z'))
+!
+
+testApplication
+ self assert: '(x x)' is: #('x' 'x').
+ self assert: '(x y)' is: #('x' 'y').
+ self assert: '((x y) z)' is: #(('x' 'y') 'z').
+ self assert: '(x (y z))' is: #('x' ('y' 'z'))
+!
+
+testVariable
+ self assert: 'x' is: 'x'.
+ self assert: 'xy' is: 'xy'.
+ self assert: 'x12' is: 'x12'
+! !
+
+!PPLambdaParserTest methodsFor:'testing-curch'!
+
+testAnd
+ self assert: self parserClass and = #('p' ('q' (('p' 'q') 'p')))
+!
+
+testFalse
+ self assert: self parserClass false = #('x' ('y' 'y'))
+!
+
+testIfThenElse
+ self assert: self parserClass ifthenelse = #('p' 'p')
+!
+
+testNot
+ self assert: self parserClass not = #('p' ('a' ('b' (('p' 'b') 'a'))))
+!
+
+testOr
+ self assert: self parserClass or = #('p' ('q' (('p' 'p') 'q')))
+!
+
+testTrue
+ self assert: self parserClass true = #('x' ('y' 'x'))
+! !
+
+!PPLambdaParserTest methodsFor:'testing-utilities'!
+
+testParseOnError
+ | beenHere |
+ result := self parserClass
+ parse: '\x.y'
+ onError: [ self fail ].
+ self assert: result = #('x' 'y').
+
+ beenHere := false.
+ result := self parserClass
+ parse: '\x.'
+ onError: [ beenHere := true ].
+ self assert: beenHere.
+
+ beenHere := false.
+ result := self parserClass
+ parse: '\x.'
+ onError: [ :fail | beenHere := true. fail ].
+ self assert: beenHere.
+ "We don't use $ before character sign in ST/X"
+ self assert: (result message includesSubString: '(').
+"/ self assert: (result message includesSubString: '$(').
+ self assert: (result message includesSubString: 'expected').
+ self assert: (result position = 0).
+
+ beenHere := false.
+ result := self parserClass
+ parse: '\x.'
+ onError: [ :msg :pos |
+ "We don't use $ before character sign in ST/X"
+ self assert: (msg includesSubString: '(').
+"/ self assert: (msg includesSubString: '$(').
+ self assert: (msg includesSubString: 'expected').
+ self assert: (pos = 0).
+ beenHere := true ].
+ self assert: result.
+ self assert: beenHere
+
+ "Modified: / 19-12-2010 / 16:52:33 / Jan Kurs <kurs.jan@post.cz>"
+!
+
+testParseStartingAtOnError
+ | beenHere |
+ result := self parserClass
+ parse: 'x'
+ startingAt: #variable
+ onError: [ self fail ].
+ self assert: result = 'x'.
+
+ beenHere := false.
+ result := self parserClass
+ parse: '\'
+ startingAt: #variable
+ onError: [ beenHere := true ].
+ self assert: beenHere.
+
+ beenHere := false.
+ result := self parserClass
+ parse: '\'
+ startingAt: #variable
+ onError: [ :fail | beenHere := true. fail ].
+ self assert: beenHere.
+ self assert: result message = 'letter expected'.
+ self assert: result position = 0.
+
+ beenHere := false.
+ result := self parserClass
+ parse: '\'
+ startingAt: #variable
+ onError: [ :msg :pos |
+ self assert: msg = 'letter expected'.
+ self assert: pos = 0.
+ beenHere := true ].
+ self assert: beenHere
+!
+
+testProductionAt
+ self assert: (parser productionAt: #foo) isNil.
+ self assert: (parser productionAt: #foo ifAbsent: [ true ]).
+
+ self assert: (parser productionAt: #start) notNil.
+ self assert: (parser productionAt: #start ifAbsent: [ true ]) notNil.
+
+ self assert: (parser productionAt: #variable) notNil.
+ self assert: (parser productionAt: #variable ifAbsent: [ true ]) notNil
+! !
+
+!PPLambdaParserTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPLambdaParserTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPListParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,62 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPParser subclass:#PPListParser
+ instanceVariableNames:'parsers'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPListParser comment:'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 class methodsFor:'instance creation'!
+
+with: aParser
+ ^ self withAll: (Array with: aParser)
+!
+
+with: aFirstParser with: aSecondParser
+ ^ self withAll: (Array with: aFirstParser with: aSecondParser)
+!
+
+withAll: aCollection
+ ^ self basicNew setParsers: aCollection
+! !
+
+!PPListParser methodsFor:'accessing'!
+
+children
+ ^ parsers
+! !
+
+!PPListParser methodsFor:'copying'!
+
+copyWith: aParser
+ ^ self species withAll: (parsers copyWith: aParser)
+!
+
+postCopy
+ super postCopy.
+ parsers := parsers copy
+! !
+
+!PPListParser methodsFor:'initialization'!
+
+initialize
+ super initialize.
+ self setParsers: #()
+!
+
+setParsers: aCollection
+ parsers := aCollection asArray
+! !
+
+!PPListParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPListParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPLiteralObjectParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,35 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPLiteralParser subclass:#PPLiteralObjectParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPLiteralObjectParser comment:'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:'operators'!
+
+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:'parsing'!
+
+parseOn: aStream
+ ^ (aStream atEnd not and: [ literal = aStream uncheckedPeek ])
+ ifFalse: [ PPFailure message: message at: aStream position ]
+ ifTrue: [ aStream next ]
+! !
+
+!PPLiteralObjectParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPLiteralObjectParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPLiteralParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,68 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPParser subclass:#PPLiteralParser
+ instanceVariableNames:'literal message'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPLiteralParser comment:'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 class methodsFor:'instance creation'!
+
+on: anObject
+ ^ self on: anObject message: anObject printString , ' expected'
+!
+
+on: anObject message: aString
+ ^ self new initializeOn: anObject message: aString
+! !
+
+!PPLiteralParser methodsFor:'accessing'!
+
+literal
+ "Answer the parsed literal."
+
+ ^ literal
+!
+
+message
+ "Answer the failure message."
+
+ ^ message
+! !
+
+!PPLiteralParser methodsFor:'initialization'!
+
+initializeOn: anObject message: aString
+ literal := anObject.
+ message := aString
+! !
+
+!PPLiteralParser methodsFor:'operators'!
+
+caseInsensitive
+ "Answer a parser that can parse the receiver case-insensitive."
+
+ self subclassResponsibility
+! !
+
+!PPLiteralParser methodsFor:'printing'!
+
+printNameOn: aStream
+ super printNameOn: aStream.
+ aStream nextPutAll: ', '; print: literal
+! !
+
+!PPLiteralParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPLiteralParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPLiteralSequenceParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,53 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPLiteralParser subclass:#PPLiteralSequenceParser
+ instanceVariableNames:'size'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPLiteralSequenceParser comment:'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:'accessing'!
+
+size
+ "Answer the sequence size of the receiver."
+
+ ^ size
+! !
+
+!PPLiteralSequenceParser methodsFor:'initialization'!
+
+initializeOn: anObject message: aString
+ super initializeOn: anObject message: aString.
+ size := literal size
+! !
+
+!PPLiteralSequenceParser methodsFor:'operators'!
+
+caseInsensitive
+ "Answer a parser that can parse the receiver case-insensitive."
+
+ literal asUppercase = literal asLowercase ifTrue: [ ^ self ].
+ ^ PPPredicateSequenceParser on: [ :value | literal sameAs: value ] message: message size: size
+! !
+
+!PPLiteralSequenceParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | position result |
+ position := aStream position.
+ result := aStream next: size.
+ literal = result ifTrue: [ ^ result ].
+ aStream position: position.
+ ^ PPFailure message: message at: aStream position
+! !
+
+!PPLiteralSequenceParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPLiteralSequenceParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPMappingTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,85 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPAbstractParseTest subclass:#PPMappingTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Tests'
+!
+
+
+!PPMappingTest methodsFor:'testing'!
+
+testFoldLeft2
+ | parser |
+ parser := #any asParser star
+ foldLeft: [ :a :b | Array with: a with: b ].
+
+ self assert: parser parse: #(a) to: #a.
+ self assert: parser parse: #(a b) to: #(a b).
+ self assert: parser parse: #(a b c) to: #((a b) c).
+ self assert: parser parse: #(a b c d) to: #(((a b) c) d).
+ self assert: parser parse: #(a b c d e) to: #((((a b) c) d) e)
+!
+
+testFoldLeft3
+ | parser |
+ parser := #any asParser star
+ foldLeft: [ :a :b :c | Array with: a with: b with: c ].
+
+ self assert: parser parse: #(a) to: #a.
+ self assert: parser parse: #(a b c) to: #(a b c).
+ self assert: parser parse: #(a b c d e) to: #((a b c) d e)
+!
+
+testFoldRight2
+ | parser |
+ parser := #any asParser star
+ foldRight: [ :a :b | Array with: a with: b ].
+
+ self assert: parser parse: #(a) to: #a.
+ self assert: parser parse: #(a b) to: #(a b).
+ self assert: parser parse: #(a b c) to: #(a (b c)).
+ self assert: parser parse: #(a b c d) to: #(a (b (c d))).
+ self assert: parser parse: #(a b c d e) to: #(a (b (c (d e))))
+!
+
+testFoldRight3
+ | parser |
+ parser := #any asParser star
+ foldRight: [ :a :b :c | Array with: a with: b with: c ].
+
+ self assert: parser parse: #(a) to: #a.
+ self assert: parser parse: #(a b c) to: #(a b c).
+ self assert: parser parse: #(a b c d e) to: #(a b (c d e))
+!
+
+testMap1
+ | parser |
+ parser := #any asParser
+ map: [ :a | Array with: a ].
+
+ self assert: parser parse: #(a) to: #(a)
+!
+
+testMap2
+ | parser |
+ parser := (#any asParser , #any asParser)
+ map: [ :a :b | Array with: b with: a ].
+
+ self assert: parser parse: #(a b) to: #(b a)
+!
+
+testMap3
+ | parser |
+ parser := (#any asParser , #any asParser , #any asParser)
+ map: [ :a :b :c | Array with: c with: b with: a ].
+
+ self assert: parser parse: #(a b c) to: #(c b a)
+! !
+
+!PPMappingTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPMappingTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPMemento.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,65 @@
+"{ Package: 'squeak:petitparser' }"
+
+Object subclass:#PPMemento
+ instanceVariableNames:'result count position'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Core'
+!
+
+PPMemento comment:'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 class methodsFor:'instance creation'!
+
+new
+ ^ self basicNew initialize
+! !
+
+!PPMemento methodsFor:'accessing'!
+
+position
+ ^ position
+!
+
+position: anInteger
+ position := anInteger
+!
+
+result
+ ^ result
+!
+
+result: anObject
+ result := anObject
+! !
+
+!PPMemento methodsFor:'accessing-readonly'!
+
+count
+ ^ count
+! !
+
+!PPMemento methodsFor:'actions'!
+
+increment
+ count := count + 1
+! !
+
+!PPMemento methodsFor:'initialization'!
+
+initialize
+ count := 0
+
+! !
+
+!PPMemento class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPMemento.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPMemoizedParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,55 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPDelegateParser subclass:#PPMemoizedParser
+ instanceVariableNames:'stream buffer'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPMemoizedParser comment:'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:'operations'!
+
+memoized
+ "Ther is no point in memoizing more than once."
+
+ ^ self
+! !
+
+!PPMemoizedParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | memento |
+ stream == aStream
+ ifFalse: [ self reset: aStream ].
+ memento := (buffer at: stream position + 1)
+ ifNil: [ buffer at: stream position + 1 put: PPMemento new ].
+ memento position isNil
+ ifTrue: [
+ memento result: (stream size - stream position + 2 < memento count
+ ifTrue: [ PPFailure message: 'overflow' at: stream position ]
+ ifFalse: [ memento increment. parser parseOn: stream ]).
+ memento position: stream position ]
+ ifFalse: [ stream position: memento position ].
+ ^ memento result
+! !
+
+!PPMemoizedParser methodsFor:'private'!
+
+reset: aStream
+ stream := aStream.
+ buffer := Array new: aStream size + 1
+! !
+
+!PPMemoizedParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPMemoizedParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPNotParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,29 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPDelegateParser subclass:#PPNotParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPNotParser comment:'The not-predicate, a parser that succeeds whenever its delegate does not, but consumes no input [Parr 1994, 1995].'
+!
+
+
+!PPNotParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | element position |
+ position := aStream position.
+ element := parser parseOn: aStream.
+ aStream position: position.
+ ^ element isPetitFailure
+ ifFalse: [ PPFailure message: '' at: aStream position ]
+! !
+
+!PPNotParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPNotParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPObjectTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,85 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPAbstractParseTest subclass:#PPObjectTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Tests'
+!
+
+
+!PPObjectTest methodsFor:'parsers'!
+
+integer
+ ^ PPPredicateObjectParser
+ on: [ :each | each isInteger ]
+ message: 'integer expected'
+!
+
+string
+ ^ PPPredicateObjectParser
+ on: [ :each | each isString ]
+ message: 'string expected'
+! !
+
+!PPObjectTest methodsFor:'testing'!
+
+testInteger
+ self assert: self integer parse: #(123) to: 123.
+ self assert: self integer fail: #('abc')
+!
+
+testString
+ self assert: self string parse: #('abc') to: 'abc'.
+ self assert: self string fail: #(123)
+! !
+
+!PPObjectTest methodsFor:'testing-fancy'!
+
+testFibonacci
+ "This parser accepts fibonacci sequences with arbitrary start pairs."
+
+ | parser |
+ parser := ((self integer , self integer) end ==> [ :pair | pair first + pair last ])
+ / (self integer , (self integer , self integer) and >=> [ :stream :continuation |
+ | result |
+ result := continuation value.
+ (result isPetitFailure or: [ result first + result last first ~= result last last ])
+ ifFalse: [ parser parseOn: stream ]
+ ifTrue: [ PPFailure message: 'invalid fibonacci sequence' at: stream position ] ]).
+ self assert: parser parse: #(1 1) to: 2.
+ self assert: parser parse: #(1 1 2) to: 3.
+ self assert: parser parse: #(1 1 2 3) to: 5.
+ self assert: parser parse: #(1 1 2 3 5) to: 8.
+ self assert: parser parse: #(1 1 2 3 5 8) to: 13.
+ self assert: parser parse: #(1 1 2 3 5 8 13) to: 21.
+ self assert: parser fail: #().
+ self assert: parser fail: #(1).
+ self assert: parser fail: #(1 2 3 4) end: 2
+
+! !
+
+!PPObjectTest methodsFor:'testing-operators'!
+
+testChoice
+ | parser |
+ parser := self integer / self string.
+ self assert: parser parse: #(123) to: 123.
+ self assert: parser parse: #('abc') to: 'abc'
+!
+
+testSequence
+ | parser |
+ parser := self integer , self string.
+ self assert: parser parse: #(123 'abc') to: #(123 'abc').
+ self assert: parser fail: #(123 456).
+ self assert: parser fail: #('abc' 'def').
+ self assert: parser fail: #('abc' 123)
+
+! !
+
+!PPObjectTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPObjectTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPOptionalParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,23 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPDelegateParser subclass:#PPOptionalParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+
+!PPOptionalParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | element |
+ element := parser parseOn: aStream.
+ ^ element isPetitFailure ifFalse: [ ^ element ]
+! !
+
+!PPOptionalParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPOptionalParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,468 @@
+"{ Package: 'squeak:petitparser' }"
+
+Object subclass:#PPParser
+ instanceVariableNames:'properties'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPParser comment:'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 class methodsFor:'instance creation'!
+
+named: aString
+ ^ self new name: aString
+!
+
+new
+ ^ self basicNew initialize
+! !
+
+!PPParser methodsFor:'accessing'!
+
+children
+ "Answer a set of child parsers that could follow the receiver."
+
+ ^ #()
+!
+
+name
+ "Answer the production name of the receiver."
+
+ ^ self propertyAt: #name ifAbsent: [ nil ]
+!
+
+name: aString
+ self propertyAt: #name put: aString
+! !
+
+!PPParser methodsFor:'accessing-properties'!
+
+hasProperty: aKey
+ "Test if the property aKey is present."
+
+ ^ properties notNil and: [ properties includesKey: aKey ]
+!
+
+propertyAt: aKey
+ "Answer the property value associated with aKey."
+
+ ^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]
+!
+
+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 ]
+!
+
+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 ]
+!
+
+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
+!
+
+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' ]
+!
+
+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:'converting'!
+
+asParser
+ ^ self
+! !
+
+!PPParser methodsFor:'copying'!
+
+postCopy
+ super postCopy.
+ properties := properties copy
+! !
+
+!PPParser methodsFor:'initialization'!
+
+initialize
+! !
+
+!PPParser methodsFor:'operations'!
+
+, aParser
+ "Answer a new parser that parses the receiver followed by aParser."
+
+ ^ PPSequenceParser with: self with: aParser
+!
+
+/ aParser
+ "Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice)."
+
+ ^ PPChoiceParser with: self with: aParser
+!
+
+and
+ "Answer a new parser (logical and-predicate) that succeeds whenever the receiver does, but never consumes input."
+
+ ^ PPAndParser on: self
+!
+
+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)
+!
+
+end
+ "Answer a new parser that succeeds at the end of the input and return the result of the receiver."
+
+ ^ PPEndOfInputParser on: self
+!
+
+max: anInteger
+ "Answer a new parser that parses the receiver at most anInteger times."
+
+ ^ PPRepeatingParser on: self max: anInteger
+!
+
+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
+!
+
+min: anInteger
+ "Answer a new parser that parses the receiver at least anInteger times."
+
+ ^ PPRepeatingParser on: self min: anInteger
+!
+
+min: aMinInteger max: aMaxInteger
+ "Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times."
+
+ ^ PPRepeatingParser on: self min: aMinInteger max: aMaxInteger
+!
+
+negate
+ "Answer a new parser consumes any input token but the receiver."
+
+ ^ self not , #any asParser ==> #second
+!
+
+not
+ "Answer a new parser (logical not-predicate) that succeeds whenever the receiver fails, but never consumes input."
+
+ ^ PPNotParser on: self
+!
+
+optional
+ "Answer a new parser that parses the receiver, if possible."
+
+ ^ PPOptionalParser on: self
+!
+
+plus
+ "Answer a new parser that parses the receiver one or more times."
+
+ ^ self min: 1
+!
+
+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 , (self starGreedy: aParser) map: [ :first :rest | rest copyWithFirst: first ]
+!
+
+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 , (self starLazy: aParser) map: [ :first :rest | rest copyWithFirst: first ]
+!
+
+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."
+
+ ^ PPRepeatingParser on: self
+!
+
+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."
+
+ | parser |
+ parser := PPChoiceParser new.
+ parser setParsers: (Array
+ with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])
+ with: (aParser and ==> [ :each | OrderedCollection new ])).
+ ^ parser ==> [ :rest | rest asArray ]
+!
+
+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."
+
+ | parser |
+ parser := PPChoiceParser new.
+ parser setParsers: (Array
+ with: (aParser and ==> [ :each | OrderedCollection new ])
+ with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])).
+ ^ parser ==> [ :rest | rest asArray ]
+!
+
+times: anInteger
+ "Answer a new parser that parses the receiver exactly anInteger times."
+
+ ^ self min: anInteger max: anInteger
+!
+
+wrapped
+ "Answer a new parser that is simply wrapped."
+
+ ^ PPDelegateParser on: self
+!
+
+| 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:'operations-convenience'!
+
+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 ] ]
+!
+
+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:'operations-mapping'!
+
+==> aBlock
+ "Answer a new parser that performs aBlock as action handler on success."
+
+ ^ PPActionParser on: self block: aBlock
+!
+
+>=> 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
+!
+
+answer: anObject
+ "Answer a new parser that always returns anObject from a successful parse."
+
+ ^ self ==> [ :nodes | anObject ]
+!
+
+flatten
+ "Answer a new parser that flattens the underlying collection."
+
+ ^ PPFlattenParser on: self
+!
+
+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 at: 1).
+ 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 at: 1 ]
+!
+
+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 at: nodes size).
+ 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 ]
+!
+
+map: aBlock
+ "Answer a new parser that works on the receiving sequence an passes in each element as a block argument."
+
+ ^ self ==> aBlock
+!
+
+token
+ "Answer a new parser that transforms the input to a token."
+
+ ^ PPTokenParser on: self
+!
+
+token: aTokenClass
+ "Answer a new parser that transforms the input to a token of class aTokenClass."
+
+ ^ self token tokenClass: aTokenClass
+!
+
+trim
+ "Answer a new parser that consumes spaces before and after the receiving parser."
+
+ ^ self trimSpaces
+!
+
+trimBlanks
+ "Answer a new parser that consumes blanks before and after the receiving parser."
+
+ ^ PPTrimmingParser on: self trimmer: #blank asParser
+!
+
+trimSpaces
+ "Answer a new parser that consumes spaces before and after the receiving parser."
+
+ ^ PPTrimmingParser on: self trimmer: #space asParser
+! !
+
+!PPParser methodsFor:'parsing'!
+
+matches: anObject
+ "Answer if anObject can be parsed by the receiver."
+
+ ^ (self parse: anObject) isPetitFailure not
+!
+
+matchesIn: anObject
+ "Search anObject repeatedly for the matches of the receiver."
+
+ | result |
+ result := OrderedCollection new.
+ self
+ matchesIn: anObject
+ do: [ :each | result addLast: each ].
+ ^ result
+!
+
+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
+!
+
+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
+!
+
+matchingRangesIn: anObject do: aBlock
+ "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.
+ [ :stream | stream position + 1 ] asParser , self , [ :stream | stream position ] asParser
+ matchesIn: anObject
+ do: [ :value | aBlock value: (value first to: value last) ].
+ ^ result
+!
+
+parse: anObject
+ "Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
+
+ ^ self parseOn: anObject asPetitStream
+!
+
+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
+!
+
+parseOn: aStream
+ "Parse aStream with the receiving parser and answer the parse-result or an instance of PPFailure. Override this method in subclasses to specify custom parse behavior. Do not call this method from outside, instead use #parse:."
+
+ self subclassResponsibility
+! !
+
+!PPParser methodsFor:'printing'!
+
+printNameOn: aStream
+ self name isNil
+ ifTrue: [ aStream print: self hash ]
+ ifFalse: [ aStream nextPutAll: self name ]
+!
+
+printOn: aStream
+ super printOn: aStream.
+ aStream nextPut: $(.
+ self printNameOn: aStream.
+ aStream nextPut: $)
+! !
+
+!PPParser methodsFor:'testing'!
+
+isPetitParser
+ ^ true
+!
+
+isUnresolved
+ ^ false
+! !
+
+!PPParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPParserResource.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,30 @@
+"{ Package: 'squeak:petitparser' }"
+
+TestResource subclass:#PPParserResource
+ instanceVariableNames:'parsers'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Core'
+!
+
+
+!PPParserResource methodsFor:'accessing'!
+
+parserAt: aParserClass
+ "Answer a cached instance of aParserClass."
+
+ ^ parsers at: aParserClass name ifAbsentPut: [ aParserClass new ]
+! !
+
+!PPParserResource methodsFor:'running'!
+
+setUp
+ super setUp.
+ parsers := Dictionary new
+! !
+
+!PPParserResource class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPParserResource.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPParserTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,972 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPAbstractParseTest subclass:#PPParserTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Tests'
+!
+
+
+!PPParserTest methodsFor:'testing'!
+
+testAction
+ | block parser |
+ block := [ :char | char asUppercase ].
+ parser := #any asParser ==> block.
+ self assert: parser block = block.
+
+ self assert: parser parse: 'a' to: $A.
+ self assert: parser parse: 'b' to: $B
+!
+
+testAnd
+ | parser |
+ parser := 'foo' asParser flatten , 'bar' asParser flatten and.
+
+ self assert: parser parse: 'foobar' to: #('foo' 'bar') end: 3.
+ self assert: parser fail: 'foobaz'.
+
+ parser := 'foo' asParser and.
+ self assert: parser and = parser
+!
+
+testAnswer
+ | parser |
+ parser := $a asParser answer: $b.
+
+ self assert: parser parse: 'a' to: $b.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'b'
+!
+
+testBlock
+ | parser |
+ parser := [ :s | s next ] asParser.
+
+ self assert: parser parse: 'ab' to: $a end: 1.
+ self assert: parser parse: 'b' to: $b.
+ self assert: parser parse: '' to: nil
+!
+
+testChoice
+ | parser |
+ parser := $a asParser / $b asParser.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'b' to: $b.
+
+ self assert: parser parse: 'ab' to: $a end: 1.
+ self assert: parser parse: 'ba' to: $b end: 1.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'c'.
+ self assert: parser fail: 'ca'
+!
+
+testDelimitedBy
+ | parser |
+ parser := $a asParser delimitedBy: $b asParser.
+
+ self assert: parser parse: 'a' to: #($a).
+ self assert: parser parse: 'aba' to: #($a $b $a).
+ self assert: parser parse: 'ababa' to: #($a $b $a $b $a).
+
+ self assert: parser parse: 'ab' to: #($a $b).
+ self assert: parser parse: 'abab' to: #($a $b $a $b).
+ self assert: parser parse: 'ababab' to: #($a $b $a $b $a $b).
+
+ self assert: parser parse: 'ac' to: #($a) end: 1.
+ self assert: parser parse: 'abc' to: #($a $b) end: 2.
+ self assert: parser parse: 'abac' to: #($a $b $a) end: 3.
+ self assert: parser parse: 'ababc' to: #($a $b $a $b) end: 4.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'b'.
+ self assert: parser fail: 'c'
+!
+
+testEndOfInput
+ | parser |
+ parser := PPEndOfInputParser on: $a asParser.
+ self assert: parser end = parser.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: ''.
+ self assert: parser fail: 'aa'
+!
+
+testEndOfInputAfterMatch
+ | parser |
+ parser := 'stuff' asParser end.
+ self assert: parser parse: 'stuff' to: 'stuff'.
+ self assert: parser fail: 'stufff'.
+ self assert: parser fail: 'fluff'
+!
+
+testEpsilon
+ | parser |
+ parser := nil asParser.
+
+ self assert: parser parse: '' to: nil.
+
+ self assert: parser parse: 'a' to: nil end: 0.
+ self assert: parser parse: 'ab' to: nil end: 0
+!
+
+testFailing
+ | parser result |
+ parser := PPFailingParser message: 'Plonk'.
+ self assert: parser message = 'Plonk'.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: 'aa'.
+
+ result := parser parse: 'a'.
+ self assert: result message = 'Plonk'.
+ self assert: result printString = 'Plonk at 0'
+!
+
+testFlatten
+ | parser |
+ parser := $a asParser flatten.
+
+ self assert: parser parse: 'a' to: 'a'.
+ self assert: parser parse: #($a) to: #($a).
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'b'
+!
+
+testLiteralObject
+ | parser |
+ parser := PPLiteralObjectParser
+ on: $a
+ message: 'letter "a" expected'.
+ self assert: parser literal = $a.
+ self assert: parser message = 'letter "a" expected'.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: 'b'
+
+!
+
+testLiteralObjectCaseInsensitive
+ | parser |
+ parser := $a asParser caseInsensitive.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'A' to: $A.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'b'.
+ self assert: parser fail: 'B'
+
+!
+
+testLiteralSequence
+ | parser |
+ parser := PPLiteralSequenceParser
+ on: 'abc'
+ message: 'sequence "abc" expected'.
+ self assert: parser size = 3.
+ self assert: parser literal = 'abc'.
+ self assert: parser message = 'sequence "abc" expected'.
+
+ self assert: parser parse: 'abc' to: 'abc'.
+ self assert: parser fail: 'ab'.
+ self assert: parser fail: 'abd'
+!
+
+testLiteralSequenceCaseInsensitive
+ | parser |
+ parser := 'abc' asParser caseInsensitive.
+
+ self assert: parser parse: 'abc' to: 'abc'.
+ self assert: parser parse: 'ABC' to: 'ABC'.
+ self assert: parser parse: 'abC' to: 'abC'.
+ self assert: parser parse: 'AbC' to: 'AbC'.
+
+ self assert: parser fail: 'ab'.
+ self assert: parser fail: 'abd'
+!
+
+testMax
+ | parser |
+ parser := $a asParser max: 2.
+ self assert: parser min = 0.
+ self assert: parser max = 2.
+
+ self assert: parser parse: '' to: #().
+ self assert: parser parse: 'a' to: #($a).
+ self assert: parser parse: 'aa' to: #($a $a).
+ self assert: parser parse: 'aaa' to: #($a $a) end: 2.
+ self assert: parser parse: 'aaaa' to: #($a $a) end: 2.
+
+ self assert: (parser printString endsWith: '[0, 2]')
+!
+
+testMemoized
+ | count parser twice |
+ count := 0.
+ parser := [ :s | count := count + 1. s next ] asParser memoized.
+ twice := parser and , parser.
+
+ count := 0.
+ self assert: parser parse: 'a' to: $a.
+ self assert: count = 1.
+
+ count := 0.
+ self assert: twice parse: 'a' to: #($a $a).
+ self assert: count = 1.
+
+ self assert: parser memoized = parser
+!
+
+testMin
+ | parser |
+ parser := $a asParser min: 2.
+ self assert: parser min = 2.
+ self assert: parser max > parser min.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'.
+ self assert: parser parse: 'aa' to: #($a $a).
+ self assert: parser parse: 'aaa' to: #($a $a $a).
+ self assert: parser parse: 'aaaa' to: #($a $a $a $a).
+
+ self assert: (parser printString endsWith: '[2, *]')
+!
+
+testMinMax
+ | parser |
+ parser := $a asParser min: 2 max: 4.
+ self assert: parser min = 2.
+ self assert: parser max = 4.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'.
+ self assert: parser parse: 'aa' to: #($a $a).
+ self assert: parser parse: 'aaa' to: #($a $a $a).
+ self assert: parser parse: 'aaaa' to: #($a $a $a $a).
+ self assert: parser parse: 'aaaaa' to: #($a $a $a $a) end: 4.
+ self assert: parser parse: 'aaaaaa' to: #($a $a $a $a) end: 4.
+
+ self assert: (parser printString endsWith: '[2, 4]')
+!
+
+testNegate
+ | parser |
+ parser := 'foo' asParser negate.
+
+ self assert: parser parse: 'f' to: $f end: 1.
+ self assert: parser parse: 'fo' to: $f end: 1.
+ self assert: parser parse: 'fob' to: $f end: 1.
+ self assert: parser parse: 'ffoo' to: $f end: 1.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'foo'
+!
+
+testNot
+ | parser |
+ parser := 'foo' asParser flatten , 'bar' asParser flatten not.
+
+ self assert: parser parse: 'foobaz' to: #('foo' nil) end: 3.
+ self assert: parser fail: 'foobar'
+!
+
+testOptional
+ | parser |
+ parser := $a asParser optional.
+
+ self assert: parser parse: '' to: nil.
+ self assert: parser parse: 'a' to: $a.
+
+ self assert: parser parse: 'aa' to: $a end: 1.
+ self assert: parser parse: 'ab' to: $a end: 1.
+ self assert: parser parse: 'b' to: nil end: 0.
+ self assert: parser parse: 'bb' to: nil end: 0.
+ self assert: parser parse: 'ba' to: nil end: 0
+!
+
+testPermutation
+ | parser |
+ parser := #any asParser , #any asParser , #any asParser.
+
+ self assert: (parser permutation: #()) parse: '123' to: #().
+ self assert: (parser permutation: #(1)) parse: '123' to: #($1).
+ self assert: (parser permutation: #(1 3)) parse: '123' to: #($1 $3).
+ self assert: (parser permutation: #(3 1)) parse: '123' to: #($3 $1).
+ self assert: (parser permutation: #(2 2)) parse: '123' to: #($2 $2).
+ self assert: (parser permutation: #(3 2 1)) parse: '123' to: #($3 $2 $1).
+
+ self should: [ parser permutation: #(0) ] raise: Error.
+ self should: [ parser permutation: #(4) ] raise: Error.
+ self should: [ parser permutation: #($2) ] raise: Error
+!
+
+testPluggable
+ | block parser |
+ block := [ :stream | stream position ].
+ parser := block asParser.
+ self assert: parser block = block
+!
+
+testPlus
+ | parser |
+ parser := $a asParser plus.
+ self assert: parser min = 1.
+ self assert: parser max > parser min.
+
+ self assert: parser parse: 'a' to: #($a).
+ self assert: parser parse: 'aa' to: #($a $a).
+ self assert: parser parse: 'aaa' to: #($a $a $a).
+
+ self assert: parser parse: 'ab' to: #($a) end: 1.
+ self assert: parser parse: 'aab' to: #($a $a) end: 2.
+ self assert: parser parse: 'aaab' to: #($a $a $a) end: 3.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'b'.
+ self assert: parser fail: 'ba'
+!
+
+testPlusGreedy
+ | parser |
+ parser := #word asParser plusGreedy: #digit asParser.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: '1'.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: 'ab'.
+
+ self assert: parser parse: 'a1' to: #($a) end: 1.
+ self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+ self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+ self assert: parser parse: 'a12' to: #($a $1) end: 2.
+ self assert: parser parse: 'ab12' to: #($a $b $1) end: 3.
+ self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4.
+ self assert: parser parse: 'a123' to: #($a $1 $2) end: 3.
+ self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4.
+ self assert: parser parse: 'abc123' to: #($a $b $c $1 $2) end: 5.
+!
+
+testPlusLazy
+ | parser |
+ parser := #word asParser plusLazy: #digit asParser.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: '1'.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: 'ab'.
+
+ self assert: parser parse: 'a1' to: #($a) end: 1.
+ self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+ self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+ self assert: parser parse: 'a12' to: #($a) end: 1.
+ self assert: parser parse: 'ab12' to: #($a $b) end: 2.
+ self assert: parser parse: 'abc12' to: #($a $b $c) end: 3.
+ self assert: parser parse: 'a123' to: #($a) end: 1.
+ self assert: parser parse: 'ab123' to: #($a $b) end: 2.
+ self assert: parser parse: 'abc123' to: #($a $b $c) end: 3
+!
+
+testSeparatedBy
+ | parser |
+ parser := $a asParser separatedBy: $b asParser.
+
+ self assert: parser parse: 'a' to: #($a).
+ self assert: parser parse: 'aba' to: #($a $b $a).
+ self assert: parser parse: 'ababa' to: #($a $b $a $b $a).
+
+ self assert: parser parse: 'ab' to: #($a) end: 1.
+ self assert: parser parse: 'abab' to: #($a $b $a) end: 3.
+ self assert: parser parse: 'ac' to: #($a) end: 1.
+ self assert: parser parse: 'abac' to: #($a $b $a) end: 3.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'c'
+!
+
+testSequence
+ | parser |
+ parser := $a asParser , $b asParser.
+
+ self assert: parser parse: 'ab' to: #($a $b).
+
+ self assert: parser parse: 'aba' to: #($a $b) end: 2.
+ self assert: parser parse: 'abb' to: #($a $b) end: 2.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: 'aa'.
+ self assert: parser fail: 'ba'.
+ self assert: parser fail: 'bab'
+!
+
+testStar
+ | parser |
+ parser := $a asParser star.
+ self assert: parser min = 0.
+ self assert: parser max > parser min.
+
+ self assert: parser parse: '' to: #().
+ self assert: parser parse: 'a' to: #($a).
+ self assert: parser parse: 'aa' to: #($a $a).
+ self assert: parser parse: 'aaa' to: #($a $a $a).
+
+ self assert: parser parse: 'b' to: #() end: 0.
+ self assert: parser parse: 'ab' to: #($a) end: 1.
+ self assert: parser parse: 'aab' to: #($a $a) end: 2.
+ self assert: parser parse: 'aaab' to: #($a $a $a) end: 3
+!
+
+testStarGreedy
+ | parser |
+ parser := #word asParser starGreedy: #digit asParser.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: 'ab'.
+
+ self assert: parser parse: '1' to: #() end: 0.
+ self assert: parser parse: 'a1' to: #($a) end: 1.
+ self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+ self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+ self assert: parser parse: '12' to: #($1) end: 1.
+ self assert: parser parse: 'a12' to: #($a $1) end: 2.
+ self assert: parser parse: 'ab12' to: #($a $b $1) end: 3.
+ self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4.
+ self assert: parser parse: '123' to: #($1 $2) end: 2.
+ self assert: parser parse: 'a123' to: #($a $1 $2) end: 3.
+ self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4.
+ self assert: parser parse: 'abc123' to: #($a $b $c $1 $2) end: 5
+!
+
+testStarLazy
+ | parser |
+ parser := #word asParser starLazy: #digit asParser.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: 'ab'.
+
+ self assert: parser parse: '1' to: #() end: 0.
+ self assert: parser parse: 'a1' to: #($a) end: 1.
+ self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+ self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+ self assert: parser parse: '12' to: #() end: 0.
+ self assert: parser parse: 'a12' to: #($a) end: 1.
+ self assert: parser parse: 'ab12' to: #($a $b) end: 2.
+ self assert: parser parse: 'abc12' to: #($a $b $c) end: 3.
+ self assert: parser parse: '123' to: #() end: 0.
+ self assert: parser parse: 'a123' to: #($a) end: 1.
+ self assert: parser parse: 'ab123' to: #($a $b) end: 2.
+ self assert: parser parse: 'abc123' to: #($a $b $c) end: 3
+!
+
+testTimes
+ | parser |
+ parser := $a asParser times: 2.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'.
+ self assert: parser parse: 'aa' to: #($a $a).
+ self assert: parser parse: 'aaa' to: #($a $a) end: 2
+!
+
+testToken
+ | parser |
+ parser := $a asParser token.
+ self assert: parser tokenClass = PPToken.
+ self assert: parser parse: 'a' toToken: 1 stop: 1.
+ self assert: parser fail: 'b'.
+ self assert: parser fail: ''.
+
+ parser := $a asParser token: PPToken.
+ self assert: parser tokenClass = PPToken.
+ self assert: parser parse: 'a' toToken: 1 stop: 1.
+ self assert: parser fail: ''.
+ self assert: parser fail: 'b'
+!
+
+testTrim
+ | parser |
+ parser := $a asParser token trim.
+ self assert: parser trim = parser.
+
+ self assert: parser parse: 'a' toToken: 1 stop: 1.
+ self assert: parser parse: 'a ' toToken: 1 stop: 1.
+ self assert: parser parse: 'a ' toToken: 1 stop: 1.
+ self assert: parser parse: 'a ' toToken: 1 stop: 1.
+ self assert: parser parse: 'a
+ ' toToken: 1 stop: 1.
+
+ self assert: parser parse: 'a' toToken: 1 stop: 1.
+ self assert: parser parse: ' a' toToken: 2 stop: 2.
+ self assert: parser parse: ' a' toToken: 2 stop: 2.
+ self assert: parser parse: ' a' toToken: 5 stop: 5.
+ self assert: parser parse: '
+a' toToken: 5 stop: 5.
+
+ self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
+ self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 2.
+ self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 3.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'b'
+!
+
+testTrimBlanks
+ | parser |
+ parser := $a asParser token trimBlanks.
+
+ self assert: parser parse: 'a' toToken: 1 stop: 1.
+ self assert: parser parse: 'a ' toToken: 1 stop: 1.
+ self assert: parser parse: 'a ' toToken: 1 stop: 1.
+ self assert: parser parse: 'a ' toToken: 1 stop: 1.
+
+ self assert: parser parse: 'a' toToken: 1 stop: 1.
+ self assert: parser parse: ' a' toToken: 2 stop: 2.
+ self assert: parser parse: ' a' toToken: 2 stop: 2.
+ self assert: parser parse: ' a' toToken: 5 stop: 5.
+
+ self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
+ self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 2.
+ self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 3.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: '
+'.
+ self assert: parser fail: '
+a'.
+ self assert: parser fail: 'b'.
+!
+
+testTrimSpaces
+ | parser |
+ parser := $a asParser token trimSpaces.
+
+ self assert: parser parse: 'a' toToken: 1 stop: 1.
+ self assert: parser parse: 'a ' toToken: 1 stop: 1.
+ self assert: parser parse: 'a ' toToken: 1 stop: 1.
+ self assert: parser parse: 'a ' toToken: 1 stop: 1.
+ self assert: parser parse: 'a
+ ' toToken: 1 stop: 1.
+
+ self assert: parser parse: 'a' toToken: 1 stop: 1.
+ self assert: parser parse: ' a' toToken: 2 stop: 2.
+ self assert: parser parse: ' a' toToken: 2 stop: 2.
+ self assert: parser parse: ' a' toToken: 5 stop: 5.
+ self assert: parser parse: '
+a' toToken: 5 stop: 5.
+
+ self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
+ self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 2.
+ self assert: parser parse: 'a a' toToken: 1 stop: 1 end: 3.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'b'
+!
+
+testUnresolved
+ | parser |
+ parser := PPUnresolvedParser new.
+
+ self assert: parser isUnresolved.
+ self should: [ parser parse: '' ] raise: Error.
+ self should: [ parser parse: 'a' ] raise: Error.
+ self should: [ parser parse: 'ab' ] raise: Error.
+
+ parser := nil asParser.
+ self deny: parser isUnresolved
+!
+
+testWrapped
+ | parser |
+ parser := $a asParser wrapped.
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: 'b'.
+
+ parser := (($a asParser , $b asParser ) wrapped , $c asParser).
+ self assert: parser parse: 'abc' to: #(#($a $b) $c)
+!
+
+testWrapping
+ | parser result |
+ parser := #digit asParser plus >=> [ :stream :cc |
+ Array
+ with: stream position
+ with: cc value
+ with: stream position ].
+
+ self assert: parser parse: '1' to: #(0 ($1) 1).
+ self assert: parser parse: '12' to: #(0 ($1 $2) 2).
+ self assert: parser parse: '123' to: #(0 ($1 $2 $3) 3).
+
+ result := parser parse: 'a'.
+ self assert: result first = 0.
+ self assert: result second isPetitFailure.
+ self assert: result last = 0
+!
+
+testXor
+ | parser |
+ parser := ($a asParser / $b asParser)
+ | ($b asParser / $c asParser).
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'c' to: $c.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'b'.
+ self assert: parser fail: 'd'.
+
+ " truly symmetric "
+ parser := ($b asParser / $c asParser)
+ | ($a asParser / $b asParser).
+
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'c' to: $c.
+
+ self assert: parser fail: ''.
+ self assert: parser fail: 'b'.
+ self assert: parser fail: 'd'
+! !
+
+!PPParserTest methodsFor:'testing-accessing'!
+
+testNamed
+ | parser |
+ parser := PPSequenceParser new.
+ self assert: parser name isNil.
+
+ parser := PPChoiceParser named: 'choice'.
+ self assert: parser name = 'choice'.
+
+ parser := $* asParser name: 'star'.
+ self assert: parser name = 'star'
+!
+
+testPrint
+ | parser |
+ parser := PPParser new.
+ self assert: (parser printString includesSubString: 'PPParser').
+
+ parser := PPParser named: 'choice'.
+ self assert: (parser printString includesSubString: 'PPParser(choice').
+
+ parser := PPLiteralObjectParser on: $a.
+"/ self assert: (parser printString includesSubString: '$a').
+ self assert: (parser printString includesSubString: 'a').
+
+ parser := PPFailingParser message: 'error'.
+ self assert: (parser printString includesSubString: 'error').
+
+ parser := PPPredicateObjectParser on: [ :c | true ] message: 'error'.
+ self assert: (parser printString includesSubString: 'error')
+
+ "Modified: / 19-12-2010 / 18:30:54 / Jan Kurs <kurs.jan@post.cz>"
+! !
+
+!PPParserTest methodsFor:'testing-fixtures'!
+
+testSideEffectChoice
+ "Adding another element to a choice should create a copy, otherwise we get unwanted side-effects."
+
+ | p1 p2 p3 |
+ p1 := $a asParser.
+ p2 := p1 / $b asParser.
+ p3 := p1 / $c asParser.
+
+ self assert: p1 parse: 'a'.
+ self assert: p1 fail: 'b'.
+ self assert: p1 fail: 'c'.
+
+ self assert: p2 parse: 'a'.
+ self assert: p2 parse: 'b'.
+ self assert: p2 fail: 'c'.
+
+ self assert: p3 parse: 'a'.
+ self assert: p3 fail: 'b'.
+ self assert: p3 parse: 'c'
+!
+
+testSideEffectListCopy
+ | old new |
+ old := $a asParser , $b asParser.
+ new := old copy.
+
+ self deny: old == new.
+ self deny: old children == new children.
+ self assert: old children first == new children first.
+ self assert: old children last == new children last
+!
+
+testSideEffectSequence
+ "Adding another element to a sequence should create a copy, otherwise we get unwanted side-effects."
+
+ | p1 p2 p3 |
+ p1 := $a asParser.
+ p2 := p1 , $b asParser.
+ p3 := p1 , $c asParser.
+
+ self assert: p1 parse: 'a'.
+ self assert: p1 parse: 'ab' end: 1.
+ self assert: p1 parse: 'ac' end: 1.
+
+ self assert: p2 fail: 'a'.
+ self assert: p2 parse: 'ab'.
+ self assert: p2 fail: 'ac'.
+
+ self assert: p3 fail: 'a'.
+ self assert: p3 fail: 'ab'.
+ self assert: p3 parse: 'ac'
+! !
+
+!PPParserTest methodsFor:'testing-properties'!
+
+testHasProperty
+ | parser |
+ parser := PPParser new.
+ self deny: (parser hasProperty: #foo).
+ parser propertyAt: #foo put: 123.
+ self assert: (parser hasProperty: #foo)
+!
+
+testPostCopy
+ | parser copy |
+ parser := PPParser new.
+ parser propertyAt: #foo put: true.
+ copy := parser copy.
+ copy propertyAt: #foo put: false.
+ self assert: (parser propertyAt: #foo).
+ self deny: (copy propertyAt: #foo)
+!
+
+testPropertyAt
+ | parser |
+ parser := PPParser new.
+ self should: [ parser propertyAt: #foo ] raise: Error.
+ parser propertyAt: #foo put: true.
+ self assert: (parser propertyAt: #foo)
+!
+
+testPropertyAtIfAbsent
+ | parser |
+ parser := PPParser new.
+ self assert: (parser propertyAt: #foo ifAbsent: [ true ]).
+ parser propertyAt: #foo put: true.
+ self assert: (parser propertyAt: #foo ifAbsent: [ false ])
+!
+
+testPropertyAtIfAbsentPut
+ | parser |
+ parser := PPParser new.
+ self assert: (parser propertyAt: #foo ifAbsentPut: [ true ]).
+ self assert: (parser propertyAt: #foo ifAbsentPut: [ false ])
+!
+
+testRemoveProperty
+ | parser |
+ parser := PPParser new.
+ self should: [ parser removeProperty: #foo ] raise: Error.
+ parser propertyAt: #foo put: true.
+ self assert: (parser removeProperty: #foo)
+!
+
+testRemovePropertyIfAbsent
+ | parser |
+ parser := PPParser new.
+ self assert: (parser removeProperty: #foo ifAbsent: [ true ]).
+ parser propertyAt: #foo put: true.
+ self assert: (parser removeProperty: #foo ifAbsent: [ false ])
+! !
+
+!PPParserTest methodsFor:'testing-utilities'!
+
+testChildren
+ | p1 p2 p3 |
+ p1 := #lowercase asParser.
+ p2 := p1 ==> #asUppercase.
+ p3 := PPUnresolvedParser new.
+ p3 def: p2 / p3.
+ self assert: p1 children isEmpty.
+ self assert: p2 children size = 1.
+ self assert: p3 children size = 2
+!
+
+testFailure
+ | failure |
+ failure := PPFailure message: 'Error' at: 3.
+
+ self assert: failure message = 'Error'.
+ self assert: failure position = 3.
+ self assert: failure isPetitFailure.
+
+ self deny: 4 isPetitFailure.
+ self deny: 'foo' isPetitFailure
+!
+
+testListConstructor
+ | p1 p2 p3 |
+ p1 := PPChoiceParser with: $a asParser.
+ p2 := PPChoiceParser with: $a asParser with: $b asParser.
+ p3 := PPChoiceParser withAll: (Array with: $a asParser with: $b asParser with: $c asParser).
+
+ self assert: p1 children size = 1.
+ self assert: p2 children size = 2.
+ self assert: p3 children size = 3
+!
+
+testMatches
+ | parser |
+ parser := $a asParser.
+
+ self assert: (parser matches: 'a').
+ self deny: (parser matches: 'b').
+
+ self assert: (parser matches: 'a' readStream).
+ self deny: (parser matches: 'b' readStream)
+!
+
+testMatchesIn
+ | parser result |
+ parser := $a asParser.
+
+ result := parser matchesIn: 'abba'.
+ self assert: result size = 2.
+ self assert: result first = $a.
+ self assert: result last = $a.
+
+ result := parser matchesIn: 'baaah'.
+ self assert: result size = 3.
+ self assert: result first = $a.
+ self assert: result last = $a
+!
+
+testMatchesInEmpty
+ "Empty matches should properly advance and match at each position and at the end."
+
+ | parser result |
+ parser := [ :stream | stream position ] asParser.
+
+ result := parser matchesIn: '123'.
+ self assert: result asArray = #(0 1 2 3)
+!
+
+testMatchesInOverlapping
+ "Matches that overlap should be properly reported."
+
+ | parser result |
+ parser := #digit asParser , #digit asParser.
+
+ result := parser matchesIn: 'a123b'.
+ self assert: result size = 2.
+ self assert: result first = #($1 $2).
+ self assert: result last = #($2 $3)
+!
+
+testMatchingRangesIn
+ | input parser result |
+ input := 'a12b1'.
+ parser := #digit asParser plus.
+ result := parser matchingRangesIn: input.
+ self assert: result size = 3.
+ result do: [ :each | self assert: (parser matches: (input copyFrom: each first to: each last)) ]
+!
+
+testParse
+ | parser result |
+ parser := $a asParser.
+
+ self assert: (parser parse: 'a') = $a.
+ self assert: (result := parser parse: 'b') isPetitFailure.
+ "is it Character printString differs: we return only 'a', not '$a'"
+ self breakPoint: #petitparser.
+"/ self assert: (result message includesSubString: '$a').
+ self assert: (result message includesSubString: 'a').
+ self assert: (result message includesSubString: 'expected').
+ self assert: (result position = 0).
+
+ self assert: (parser parse: 'a' readStream) = $a.
+ self assert: (result := parser parse: 'b' readStream) isPetitFailure.
+"/ self assert: (result message includesSubString: '$a').
+ self assert: (result message includesSubString: 'a').
+ self assert: (result message includesSubString: 'expected').
+ self assert: (result position = 0)
+
+ "Modified: / 18-12-2010 / 17:05:13 / Jan Kurs <kurs.jan@post.cz>"
+!
+
+testParseOnError0
+ | parser result seen |
+ parser := $a asParser.
+
+ result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
+ self assert: result = $a.
+
+ result := parser parse: 'b' onError: [ seen := true ].
+ self assert: result.
+ self assert: seen
+!
+
+testParseOnError1
+ | parser result seen |
+ parser := $a asParser.
+
+ result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
+ self assert: result = $a.
+
+ result := parser parse: 'b' onError: [ :failure |
+ self assert: (failure position = 0).
+ "We don't use $ in ST/X for Characters"
+ self assert: (failure message includesSubString: 'a').
+"/ self assert: (failure message includesSubString: '$a').
+ self assert: (failure message includesSubString: 'expected').
+ seen := true ].
+ self assert: result.
+ self assert: seen
+
+ "Modified: / 19-12-2010 / 18:18:01 / Jan Kurs <kurs.jan@post.cz>"
+!
+
+testParseOnError2
+ | parser result seen |
+ parser := $a asParser.
+
+ result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
+ self assert: result = $a.
+
+ result := parser parse: 'b' onError: [ :msg :pos |
+ "We don't use $ in ST/X for Characters"
+ self assert: (msg includesSubString: 'a').
+"/ self assert: (msg includesSubString: '$a').
+ self assert: (msg includesSubString: 'expected').
+ self assert: pos = 0.
+ seen := true ].
+ self assert: result.
+ self assert: seen
+
+ "Modified: / 19-12-2010 / 18:18:31 / Jan Kurs <kurs.jan@post.cz>"
+!
+
+testParser
+ | parser |
+ parser := PPParser new.
+
+ self assert: parser isPetitParser.
+
+ self deny: 4 isPetitParser.
+ self deny: 'foo' isPetitParser
+! !
+
+!PPParserTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPParserTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPPluggableParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,52 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPParser subclass:#PPPluggableParser
+ instanceVariableNames:'block'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPPluggableParser comment:'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 class methodsFor:'instance creation'!
+
+on: aBlock
+ ^ self new initializeOn: aBlock
+! !
+
+!PPPluggableParser methodsFor:'accessing'!
+
+block
+ "Answer the pluggable block."
+
+ ^ block
+! !
+
+!PPPluggableParser methodsFor:'initialization'!
+
+initializeOn: aBlock
+ block := aBlock
+! !
+
+!PPPluggableParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | position result |
+ position := aStream position.
+ result := block value: aStream.
+ result isPetitFailure
+ ifTrue: [ aStream position: position ].
+ ^ result
+! !
+
+!PPPluggableParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPPluggableParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPPredicateObjectParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,162 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPPredicateParser subclass:#PPPredicateObjectParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPPredicateObjectParser comment:'A parser that accepts if a given predicate on one element of the input sequence holds.'
+!
+
+
+!PPPredicateObjectParser class methodsFor:'instance creation'!
+
+on: aBlock message: aString
+ ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString
+!
+
+on: aBlock message: aString negated: aNegatedBlock message: aNegatedString
+ ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString
+! !
+
+!PPPredicateObjectParser class methodsFor:'factory-chars'!
+
+blank
+ ^ self chars: (String with: Character space with: Character tab) message: 'blank expected'
+!
+
+char: aCharacter
+ ^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , ' expected'
+!
+
+char: aCharacter message: aString
+ ^ self expect: aCharacter message: aString
+!
+
+chars: aCollection message: aString
+ ^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString
+!
+
+cr
+ ^ self char: Character cr message: 'carriage return expected'
+!
+
+digit
+ ^ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: 'digit expected'
+!
+
+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'
+!
+
+letter
+ ^ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: 'letter expected'
+!
+
+lf
+ ^ self char: Character lf
+!
+
+lowercase
+ ^ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: 'lowercase letter expected'
+!
+
+newline
+ ^ self chars: (String with: Character cr with: Character lf) message: 'newline expected'
+!
+
+punctuation
+ ^ self chars: '.,"''?!!;:#$%&()*+-/<>=@[]\^_{}|~' message: 'punctuation expected'
+!
+
+space
+ ^ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: 'separator expected'
+!
+
+tab
+ ^ self char: Character tab message: 'tab expected'
+!
+
+uppercase
+ ^ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: 'uppercase letter expected'
+!
+
+word
+ ^ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: 'letter or digit expected'
+! !
+
+!PPPredicateObjectParser class methodsFor:'factory-objects'!
+
+any
+ ^ self
+ on: [ :each | true ] message: 'input expected'
+ negated: [ :each | false ] message: 'no input expected'
+!
+
+anyExceptAnyOf: aCollectionOfChars
+ ^ self
+ on: [ :each | (aCollectionOfChars includes: each) not ] message: 'any except ' , aCollectionOfChars printString , ' expected'
+ negated: [ :each | aCollectionOfChars includes: each ] message: aCollectionOfChars printString , ' not expected'
+!
+
+anyOf: anArray
+ ^ self
+ on: [ :each | anArray includes: each ] message: 'any of ' , anArray printString , ' expected'
+ negated: [ :each | (anArray includes: each) not ] message: 'none of ' , anArray printString , 'expected'
+!
+
+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'
+!
+
+expect: anObject
+ ^ self expect: anObject message: anObject printString , ' expected'
+!
+
+expect: anObject message: aString
+ ^ self
+ on: [ :each | each = anObject ] message: aString
+ negated: [ :each | each ~= anObject ] message: 'no ' , aString
+! !
+
+!PPPredicateObjectParser methodsFor:'initialization'!
+
+initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString
+ predicate := aBlock.
+ predicateMessage := aString.
+ negated := aNegatedBlock.
+ negatedMessage := aNegatedString
+! !
+
+!PPPredicateObjectParser methodsFor:'operators'!
+
+negate
+ "Answer a parser that is the negation of the receiving predicate parser."
+
+ ^ self class
+ on: negated message: negatedMessage
+ negated: predicate message: predicateMessage
+! !
+
+!PPPredicateObjectParser methodsFor:'parsing'!
+
+parseOn: aStream
+ ^ (aStream atEnd not and: [ predicate value: aStream uncheckedPeek ])
+ ifFalse: [ PPFailure message: predicateMessage at: aStream position ]
+ ifTrue: [ aStream next ]
+! !
+
+!PPPredicateObjectParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPPredicateObjectParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPPredicateParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,44 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPParser subclass:#PPPredicateParser
+ instanceVariableNames:'predicate predicateMessage negated negatedMessage'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPPredicateParser comment:'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:'accessing'!
+
+block
+ "Answer the predicate block of the receiver."
+
+ ^ predicate
+!
+
+message
+ "Answer the failure message."
+
+ ^ predicateMessage
+! !
+
+!PPPredicateParser methodsFor:'printing'!
+
+printNameOn: aStream
+ super printNameOn: aStream.
+ aStream nextPutAll: ', '; print: predicateMessage
+! !
+
+!PPPredicateParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPPredicateParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPPredicateSequenceParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,71 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPPredicateParser subclass:#PPPredicateSequenceParser
+ instanceVariableNames:'size'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPPredicateSequenceParser comment:'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 class methodsFor:'instance creation'!
+
+on: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
+ ^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
+!
+
+on: aBlock message: aString size: anInteger
+ ^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString size: anInteger
+! !
+
+!PPPredicateSequenceParser methodsFor:'accessing'!
+
+size
+ "Answer the sequence size of the receiver."
+
+ ^ size
+! !
+
+!PPPredicateSequenceParser methodsFor:'initialization'!
+
+initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
+ predicate := aBlock.
+ predicateMessage := aString.
+ negated := aNegatedBlock.
+ negatedMessage := aNegatedString.
+ size := anInteger
+! !
+
+!PPPredicateSequenceParser methodsFor:'operators'!
+
+negate
+ "Answer a parser that is the negation of the receiving predicate parser."
+
+ ^ self class
+ on: negated message: negatedMessage
+ negated: predicate message: predicateMessage
+ size: size
+! !
+
+!PPPredicateSequenceParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | position result |
+ position := aStream position.
+ result := aStream next: size.
+ (result size = size and: [ predicate value: result ])
+ ifTrue: [ ^ result ].
+ aStream position: position.
+ ^ PPFailure message: predicateMessage at: aStream position
+! !
+
+!PPPredicateSequenceParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPPredicateSequenceParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPPredicateTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,292 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPAbstractParseTest subclass:#PPPredicateTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Tests'
+!
+
+
+!PPPredicateTest methodsFor:'private'!
+
+charactersDo: aBlock
+ "The limits are 1-255 as far as I know"
+ self breakPoint: #petitparser.
+ 1 to: 255 do: [ :index | aBlock value: (Character codePoint: index) ]
+"/ 1 to: 256 do: [ :index | aBlock value: (Character codePoint: index) ]
+
+ "Modified: / 19-12-2010 / 16:58:58 / Jan Kurs <kurs.jan@post.cz>"
+! !
+
+!PPPredicateTest methodsFor:'testing'!
+
+testOnMessage
+ | block parser |
+ block := [ :char | char = $* ].
+ parser := PPPredicateObjectParser on: block message: 'starlet'.
+ self assert: parser block = block.
+ self assert: parser message = 'starlet'.
+
+ self assertCharacterSets: parser.
+ self assert: parser parse: '*' to: $*.
+ self assert: parser parse: '**' to: $* end: 1.
+ self assert: parser fail: ''.
+ self assert: parser fail: '1'.
+ self assert: parser fail: 'a'
+! !
+
+!PPPredicateTest methodsFor:'testing-chars'!
+
+testBlank
+ | parser |
+ parser := #blank asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: (String with: Character space) to: Character space.
+ self assert: parser parse: (String with: Character tab) to: Character tab.
+ self assert: parser fail: ''.
+ self assert: parser fail: '1'.
+ self assert: parser fail: (String with: Character cr)
+!
+
+testChar
+ | parser |
+ parser := $* asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: '*' to: $*.
+ self assert: parser parse: '**' to: $* end: 1.
+ self assert: parser fail: ''.
+ self assert: parser fail: '1'.
+ self assert: parser fail: 'a'
+!
+
+testCr
+ | parser |
+ parser := #cr asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: (String with: Character cr) to: Character cr
+!
+
+testDigit
+ | parser |
+ parser := #digit asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: '0' to: $0.
+ self assert: parser parse: '9' to: $9.
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'
+!
+
+testHex
+ | parser |
+ parser := #hex asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: '0' to: $0.
+ self assert: parser parse: '5' to: $5.
+ self assert: parser parse: '9' to: $9.
+ self assert: parser parse: 'A' to: $A.
+ self assert: parser parse: 'D' to: $D.
+ self assert: parser parse: 'F' to: $F.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'e' to: $e.
+ self assert: parser parse: 'f' to: $f.
+ self assert: parser fail: ''.
+ self assert: parser fail: 'g'
+!
+
+testLetter
+ | parser |
+ parser := #letter asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'Z' to: $Z.
+ self assert: parser fail: ''.
+ self assert: parser fail: '0'
+!
+
+testLf
+ | parser |
+ parser := #lf asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: (String with: Character lf) to: Character lf
+!
+
+testLowercase
+ | parser |
+ parser := #lowercase asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'z' to: $z.
+ self assert: parser fail: ''.
+ self assert: parser fail: 'A'.
+ self assert: parser fail: '0'
+!
+
+testNewline
+ | parser |
+ parser := #newline asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: (String with: Character cr) to: Character cr.
+ self assert: parser parse: (String with: Character lf) to: Character lf.
+ self assert: parser fail: ' '
+!
+
+testPunctuation
+ | parser |
+ parser := #punctuation asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: '.' to: $..
+ self assert: parser parse: ',' to: $,.
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: '1'
+!
+
+testSpace
+ | parser |
+ parser := #space asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: (String with: Character tab) to: Character tab.
+ self assert: parser parse: ' ' to: Character space.
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'
+!
+
+testTab
+ | parser |
+ parser := #tab asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: (String with: Character tab) to: Character tab
+!
+
+testUppercase
+ | parser |
+ parser := #uppercase asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: 'A' to: $A.
+ self assert: parser parse: 'Z' to: $Z.
+ self assert: parser fail: ''.
+ self assert: parser fail: 'a'.
+ self assert: parser fail: '0'
+!
+
+testWord
+ | parser |
+ parser := #word asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'A' to: $A.
+ self assert: parser parse: '0' to: $0.
+ self assert: parser fail: ''.
+ self assert: parser fail: '-'
+! !
+
+!PPPredicateTest methodsFor:'testing-objects'!
+
+testAny
+ | parser |
+ parser := #any asParser.
+ self assertCharacterSets: parser.
+ self assert: parser parse: ' ' to: $ .
+ self assert: parser parse: '1' to: $1.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: ''
+!
+
+testAnyExceptAnyOf
+ | parser |
+ parser := PPPredicateObjectParser anyExceptAnyOf: #($: $,).
+ self assertCharacterSets: parser.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'z' to: $z.
+ self assert: parser fail: ':'.
+ self assert: parser fail: ','
+!
+
+testAnyOf
+ | parser |
+ parser := PPPredicateObjectParser anyOf: #($a $z).
+ self assertCharacterSets: parser.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser parse: 'z' to: $z.
+ self assert: parser fail: 'x'
+!
+
+testBetweenAnd
+ | parser |
+ parser := PPPredicateObjectParser between: $b and: $d.
+ self assertCharacterSets: parser.
+ self assert: parser fail: 'a'.
+ self assert: parser parse: 'b' to: $b.
+ self assert: parser parse: 'c' to: $c.
+ self assert: parser parse: 'd' to: $d.
+ self assert: parser fail: 'e'
+!
+
+testExpect
+ | parser |
+ parser := PPPredicateObjectParser expect: $a.
+ self assertCharacterSets: parser.
+ self assert: parser parse: 'a' to: $a.
+ self assert: parser fail: 'b'.
+ self assert: parser fail: ''
+! !
+
+!PPPredicateTest methodsFor:'testing-sequence'!
+
+testSequenceParser
+ | parser |
+ parser := PPPredicateSequenceParser
+ on: [ :value | value first isUppercase ]
+ message: 'uppercase 3 letter words'
+ size: 3.
+ self assert: parser size = 3.
+ self assert: parser parse: 'Abc'.
+ self assert: parser parse: 'ABc'.
+ self assert: parser parse: 'ABC'.
+ self assert: parser fail: 'abc'.
+ self assert: parser fail: 'aBC'.
+ self assert: parser fail: 'Ab'.
+
+ parser := parser negate.
+ self assert: parser size = 3.
+ self assert: parser fail: 'Abc'.
+ self assert: parser fail: 'ABc'.
+ self assert: parser fail: 'ABC'.
+ self assert: parser parse: 'abc'.
+ self assert: parser parse: 'aBC'.
+ self assert: parser fail: 'Ab'
+! !
+
+!PPPredicateTest methodsFor:'utilities'!
+
+assertCharacterSets: aParser
+ "Assert the character set of aParser does not overlap with the character set with the negated parser, and that they both cover the complete character space."
+
+ | positives negatives |
+ positives := self parsedCharacterSet: aParser.
+ negatives := self parsedCharacterSet: aParser negate.
+ self charactersDo: [ :char |
+ | positive negative |
+ positive := positives includes: char.
+ negative := negatives includes: char.
+ self
+ assert: ((positive and: [ negative not ])
+ or: [ positive not and: [ negative ] ])
+ description: char printString , ' should be in exactly one set' ]
+!
+
+parsedCharacterSet: aParser
+ | result |
+ result := WriteStream on: String new.
+ self charactersDo: [ :char |
+ (aParser matches: (String with: char))
+ ifTrue: [ result nextPut: char ] ].
+ ^ result contents
+! !
+
+!PPPredicateTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPPredicateTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPRepeatingParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,86 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPDelegateParser subclass:#PPRepeatingParser
+ instanceVariableNames:'min max'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPRepeatingParser comment:'A parser that eagerly parses min to max instances of my delegate. The default instance parses eagerly 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 class methodsFor:'instance creation'!
+
+on: aParser
+ ^ (super on: aParser) setMin: 0 max: SmallInteger maxVal
+!
+
+on: aParser max: aMaxInteger
+ ^ (self on: aParser) setMin: 0 max: aMaxInteger
+!
+
+on: aParser min: aMinInteger
+ ^ (self on: aParser) setMin: aMinInteger max: SmallInteger maxVal
+!
+
+on: aParser min: aMinInteger max: aMaxInteger
+ ^ (self on: aParser) setMin: aMinInteger max: aMaxInteger
+! !
+
+!PPRepeatingParser methodsFor:'accessing'!
+
+max
+ "Answer the maximum number of repetitions."
+
+ ^ max
+!
+
+min
+ "Answer the minimum number of repetitions."
+
+ ^ min
+! !
+
+!PPRepeatingParser methodsFor:'initialization'!
+
+setMin: aMinInteger max: aMaxInteger
+ min := aMinInteger.
+ max := aMaxInteger
+! !
+
+!PPRepeatingParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | start element elements |
+ start := aStream position.
+ elements := OrderedCollection new.
+ [ elements size < min ] whileTrue: [
+ (element := parser parseOn: aStream) isPetitFailure ifTrue: [
+ aStream position: start.
+ ^ element ].
+ elements addLast: element ].
+ [ elements size < max ] whileTrue: [
+ (element := parser parseOn: aStream) isPetitFailure
+ ifTrue: [ ^ elements asArray ].
+ elements addLast: element ].
+ ^ elements asArray
+! !
+
+!PPRepeatingParser methodsFor:'printing'!
+
+printOn: aStream
+ super printOn: aStream.
+ aStream nextPutAll: ' ['; print: min; nextPutAll: ', '; nextPutAll: (max = SmallInteger maxVal
+ ifTrue: [ '*' ] ifFalse: [ max printString ]); nextPut: $]
+! !
+
+!PPRepeatingParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPRepeatingParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPScriptingTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,122 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPAbstractParseTest subclass:#PPScriptingTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Tests'
+!
+
+PPScriptingTest comment:'These are some simple demo-scripts of parser combinators for the compiler construction course.
+http://www.iam.unibe.ch/~scg/Teaching/CC/index.html'
+!
+
+
+!PPScriptingTest methodsFor:'examples'!
+
+expressionInterpreter
+ "Same as #expressionInterpreter but with semantic actions."
+
+ | mul prim add dec |
+ add := PPUnresolvedParser new.
+ mul := PPUnresolvedParser new.
+ prim := PPUnresolvedParser new.
+ dec := ($0 ppMinus: $9) ==> [ :token | token codePoint - $0 codePoint ].
+ add def: ((mul , $+ asParser , add) ==> [ :nodes | (nodes at: 1) + (nodes at: 3) ])
+ / mul.
+ mul def: ((prim , $* asParser , mul) ==> [ :nodes | (nodes at: 1) * (nodes at: 3) ])
+ / prim.
+ prim def: (($( asParser , add , $) asParser) ==> [ :nodes | nodes at: 2 ])
+ / dec.
+ ^ add end
+
+ "Modified: / 19-12-2010 / 18:13:51 / Jan Kurs <kurs.jan@post.cz>"
+!
+
+expressionParser
+ "Simple demo of scripting an expression parser."
+
+ | mul prim add dec |
+ add := PPUnresolvedParser new.
+ mul := PPUnresolvedParser new.
+ prim := PPUnresolvedParser new.
+ dec := ($0 ppMinus: $9).
+ add def: (mul , $+ asParser , add)
+ / mul.
+ mul def: (prim , $* asParser , mul)
+ / prim.
+ prim def: ($( asParser , add , $) asParser)
+ / dec.
+ ^ add end
+
+ "Modified: / 19-12-2010 / 18:14:18 / Jan Kurs <kurs.jan@post.cz>"
+!
+
+straightLineParser
+ | goal stm stmList id char dec exp expList mulExp primExp nonzero num lower upper |
+ goal := PPUnresolvedParser new.
+ stmList := PPUnresolvedParser new.
+ stm := PPUnresolvedParser new.
+ exp := PPUnresolvedParser new.
+ expList := PPUnresolvedParser new.
+ mulExp := PPUnresolvedParser new.
+ primExp := PPUnresolvedParser new.
+
+ lower := $a ppMinus: $z.
+ upper := $A ppMinus: $Z.
+ char := lower / upper.
+ nonzero := $1 ppMinus: $9.
+ dec := $0 ppMinus: $9.
+ id := char, ( char / dec ) star.
+ num := $0 asParser / ( nonzero, dec star).
+
+ goal def: stmList end.
+ stmList def: stm , ( $; asParser, stm ) star.
+ stm def: ( id, ':=' asParser, exp )
+ / ( 'print' asParser, $( asParser, expList, $) asParser ).
+ exp def: mulExp, ( ( $+ asParser / $- asParser ), mulExp ) star.
+ expList def: exp, ( $, asParser, exp ) star.
+ mulExp def: primExp, ( ( $* asParser / $/ asParser ), primExp ) star.
+ primExp def: id
+ / num
+ / ( $( asParser, stmList, $, asParser, exp, $) asParser ).
+ ^ goal
+
+ "Modified: / 19-12-2010 / 18:15:14 / Jan Kurs <kurs.jan@post.cz>"
+! !
+
+!PPScriptingTest methodsFor:'tests'!
+
+testExpressionInterpreter
+ self
+ assert: self expressionInterpreter
+ parse: '2*(3+4)'
+ to: 14
+!
+
+testExpressionParser
+ self
+ assert: self expressionParser
+ parse: '2*(3+4)'
+ to: #($2 $* ($( ($3 $+ $4) $)))
+!
+
+testSLassign
+
+ self assert: self straightLineParser
+ parse: 'abc:=1'
+ to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #())
+!
+
+testSLprint
+ self
+ assert: self straightLineParser
+ parse: 'print(3,4)'
+ to: #(('print' $( ((($3 ()) ()) () (($, ((($4 ()) ()) ())))) $)) ())
+! !
+
+!PPScriptingTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPScriptingTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPSequenceParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,55 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPListParser subclass:#PPSequenceParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPSequenceParser comment:'A parser that parses a sequence of parsers.'
+!
+
+
+!PPSequenceParser methodsFor:'operations'!
+
+, aRule
+ ^ self copyWith: aRule
+!
+
+map: aBlock
+ ^ self ==> [ :nodes | aBlock valueWithArguments: nodes ]
+!
+
+permutation: anArrayOfIntegers
+ "Answer a permutation of the receivers sequence."
+
+ anArrayOfIntegers do: [ :index |
+ (index isInteger and: [ index between: 1 and: parsers size ])
+ ifFalse: [ self error: 'Invalid permutation index: ' , index printString ] ].
+ ^ self ==> [ :nodes | anArrayOfIntegers collect: [ :index | nodes at: index ] ]
+! !
+
+!PPSequenceParser methodsFor:'parsing'!
+
+parseOn: aStream
+ "This is optimized code that avoids unnecessary block activations, do not change."
+
+ | start elements element |
+ start := aStream position.
+ elements := Array new: parsers size.
+ 1 to: parsers size do: [ :index |
+ element := (parsers at: index)
+ parseOn: aStream.
+ element isPetitFailure ifTrue: [
+ aStream position: start.
+ ^ element ].
+ elements at: index put: element ].
+ ^ elements
+! !
+
+!PPSequenceParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPSequenceParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPStream.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,65 @@
+"{ Package: 'squeak:petitparser' }"
+
+ReadStream subclass:#PPStream
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Core'
+!
+
+PPStream comment:'A positional stream implementation used for parsing. It overrides some methods for optimization reasons.'
+!
+
+
+!PPStream methodsFor:'accessing'!
+
+next: anInteger
+ "Answer up to anInteger elements of my collection. Overridden for efficiency."
+
+ | answer endPosition |
+ endPosition := position + anInteger min: readLimit.
+ answer := collection copyFrom: position + 1 to: endPosition.
+ position := endPosition.
+ ^ answer
+!
+
+peek
+ "An improved version of peek, that is slightly faster than the built in version."
+
+ ^ self atEnd ifFalse: [ collection at: position + 1 ]
+!
+
+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
+!
+
+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:'converting'!
+
+asPetitStream
+ ^ self
+! !
+
+!PPStream methodsFor:'printing'!
+
+printOn: aStream
+ collection isString
+ ifFalse: [ ^ super printOn: aStream ].
+ aStream
+ nextPutAll: (collection copyFrom: 1 to: position);
+ nextPutAll: '·';
+ nextPutAll: (collection copyFrom: position + 1 to: readLimit)
+! !
+
+!PPStream class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPStream.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPToken.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,140 @@
+"{ Package: 'squeak:petitparser' }"
+
+Object subclass:#PPToken
+ instanceVariableNames:'collection start stop'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Core'
+!
+
+PPToken comment:'PPToken represents a parsed part of the input stream. Contrary to a simple String it remembers where it came from, the original collection and its start and stop position.
+Instance Variables:
+ collection <SequenceableCollection> The collection this token comes from.
+ start <Integer> The start position in the collection.
+ stop <Integer> The stop position in the collection.'
+!
+
+
+!PPToken class methodsFor:'instance creation'!
+
+new
+ self error: 'Token can only be created using a dedicated constructor.'
+!
+
+on: aSequenceableCollection
+ ^ self on: aSequenceableCollection start: 1 stop: aSequenceableCollection size
+!
+
+on: aSequenceableCollection start: aStartInteger stop: aStopInteger
+ ^ self basicNew
+ initializeOn: aSequenceableCollection
+ start: aStartInteger stop: aStopInteger
+! !
+
+!PPToken methodsFor:'accessing'!
+
+collection
+ "Answer the underlying collection of this token."
+
+ ^ collection
+!
+
+size
+ "Answer the size of this token."
+
+ ^ stop - start + 1
+!
+
+start
+ "Answer the start position of this token in the underlying collection."
+
+ ^ start
+!
+
+stop
+ "Answer the stop position of this token in the underlying collection."
+
+ ^ stop
+!
+
+value
+ "Answer the contents of this token."
+
+ ^ collection copyFrom: start to: stop
+! !
+
+!PPToken methodsFor:'comparing'!
+
+= anObject
+ ^ self class = anObject class and: [ self value = anObject value ]
+!
+
+hash
+ ^ self value hash
+! !
+
+!PPToken methodsFor:'copying'!
+
+copyFrom: aStartInteger to: aStopInteger
+ ^ self class on: collection start: start + aStartInteger - 1 stop: stop + aStopInteger - 3
+! !
+
+!PPToken methodsFor:'initialization'!
+
+initializeOn: aSequenceableCollection start: aStartInteger stop: aStopInteger
+ collection := aSequenceableCollection.
+ start := aStartInteger.
+ stop := aStopInteger
+! !
+
+!PPToken methodsFor:'printing'!
+
+printOn: aStream
+ super printOn: aStream.
+ aStream nextPut: $(; nextPutAll: self value; nextPut: $)
+! !
+
+!PPToken methodsFor:'private'!
+
+newline
+ "Parser a platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple."
+
+ ^ (Character lf asParser)
+ / (Character cr asParser , Character lf asParser optional)
+! !
+
+!PPToken methodsFor:'querying'!
+
+column
+ "Answer the column number of this token in the underlying collection."
+
+ | position |
+ position := 0.
+ (self newline , [ :stream |
+ start <= stream position
+ ifTrue: [ ^ start - position ].
+ position := stream position ] asParser
+ / #any asParser) star
+ parse: collection.
+ ^ start - position
+!
+
+line
+ "Answer the line number of this token in the underlying collection."
+
+ | line |
+ line := 1.
+ (self newline , [ :stream |
+ start <= stream position
+ ifTrue: [ ^ line ].
+ line := line + 1 ] asParser
+ / #any asParser) star
+ parse: collection.
+ ^ line
+! !
+
+!PPToken class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPToken.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPTokenParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,47 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPFlattenParser subclass:#PPTokenParser
+ instanceVariableNames:'tokenClass'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPTokenParser comment:'A parser that answers a token of the range my delegate parses.
+Instance Variables:
+ tokenClass <PPToken class> The token sub-class to be used.'
+!
+
+
+!PPTokenParser methodsFor:'accessing'!
+
+tokenClass
+ ^ tokenClass
+!
+
+tokenClass: aTokenClass
+ tokenClass := aTokenClass
+! !
+
+!PPTokenParser methodsFor:'initialization'!
+
+initialize
+ tokenClass := self defaultTokenClass
+
+! !
+
+!PPTokenParser methodsFor:'private'!
+
+create: aCollection start: aStartInteger stop: aStopInteger
+ ^ self tokenClass on: aCollection start: aStartInteger stop: aStopInteger
+!
+
+defaultTokenClass
+ ^ PPToken
+! !
+
+!PPTokenParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPTokenParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPTokenTest.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,130 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPAbstractParseTest subclass:#PPTokenTest
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitTests-Tests'
+!
+
+
+!PPTokenTest methodsFor:'accessing'!
+
+identifier
+ ^ #word asParser plus token
+! !
+
+!PPTokenTest methodsFor:'testing'!
+
+testCollection
+ | input result |
+ input := 'foo '.
+ result := self
+ parse: input
+ using: self identifier.
+ self assert: (result collection = input).
+ self assert: (result collection == input)
+!
+
+testNew
+ self should: [ PPToken new ] raise: Error.
+
+!
+
+testPrinting
+ | result |
+ result := PPToken on: 'var'.
+ self assert: (result printString includesSubString: 'PPToken(var)')
+!
+
+testSize
+ | result |
+ result := self
+ parse: 'foo'
+ using: self identifier.
+ self assert: result size = 3
+!
+
+testStart
+ | result |
+ result := self
+ parse: 'foo'
+ using: self identifier.
+ self assert: result start = 1
+!
+
+testStop
+ | result |
+ result := self
+ parse: 'foo'
+ using: self identifier.
+ self assert: result stop = 3
+!
+
+testValue
+ | input result |
+ input := 'foo'.
+ result := self
+ parse: input
+ using: self identifier.
+ self assert: result value = input.
+ self deny: result value == input
+! !
+
+!PPTokenTest methodsFor:'testing-comparing'!
+
+testEquality
+ | token1 token2 |
+ token1 := self parse: 'foo' using: self identifier.
+ token2 := self parse: 'foo' using: self identifier.
+ self deny: token1 == token2.
+ self assert: token1 = token2.
+ self assert: token1 hash = token2 hash.
+! !
+
+!PPTokenTest methodsFor:'testing-copying'!
+
+testCopyFromTo
+ | result other |
+ result := PPToken on: 'abc'.
+ other := result copyFrom: 2 to: 2.
+
+ self assert: other size = 1.
+ self assert: other start = 2.
+ self assert: other stop = 2.
+ self assert: other collection = result collection
+! !
+
+!PPTokenTest methodsFor:'testing-querying'!
+
+testColumn
+ | input parser result |
+ input := '1' , (String with: Character cr) , '12' , (String with: Character cr with: Character lf) , '123' , (String with: Character lf) , '1234'.
+ parser := #any asParser token star.
+ result := parser parse: input.
+ result
+ with: #(1 2 1 2 3 4 1 2 3 4 1 2 3 4)
+ do: [ :token :line | self assert: token column = line ]
+!
+
+testLine
+ | input parser result |
+ input := '1' , (String with: Character cr) , '12' , (String with: Character cr with: Character lf) , '123' , (String with: Character lf) , '1234'.
+ parser := #any asParser token star.
+ result := parser parse: input.
+ result
+ with: #(1 1 2 2 2 2 3 3 3 3 4 4 4 4)
+ do: [ :token :line | self assert: token line = line ]
+! !
+
+!PPTokenTest methodsFor:'utilities'!
+
+parse: aString using: aParser
+ ^ aParser parse: aString
+! !
+
+!PPTokenTest class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPTokenTest.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPTrimmingParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,57 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPDelegateParser subclass:#PPTrimmingParser
+ instanceVariableNames:'trimmer'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPTrimmingParser comment:'A parser that silently consumes spaces before and after the delegate parser.'
+!
+
+
+!PPTrimmingParser class methodsFor:'instance creation'!
+
+on: aParser trimmer: aTrimParser
+ ^ self new
+ setParser: aParser;
+ setTrimmer: aTrimParser;
+ yourself
+! !
+
+!PPTrimmingParser methodsFor:'initialization'!
+
+setTrimmer: aParser
+ trimmer := aParser
+! !
+
+!PPTrimmingParser methodsFor:'operations'!
+
+trim
+ "There is no point in trimming more than once."
+
+ ^ self
+! !
+
+!PPTrimmingParser methodsFor:'parsing'!
+
+parseOn: aStream
+ | position element |
+ position := aStream position.
+ [ (trimmer parseOn: aStream) isPetitFailure ]
+ whileFalse.
+ element := parser parseOn: aStream.
+ element isPetitFailure ifTrue: [
+ aStream position: position.
+ ^ element ].
+ [ (trimmer parseOn: aStream) isPetitFailure ]
+ whileFalse.
+ ^ element
+! !
+
+!PPTrimmingParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPTrimmingParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPUnresolvedParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,30 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPParser subclass:#PPUnresolvedParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Tools'
+!
+
+PPUnresolvedParser comment:'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'!
+
+parseOn: aStream
+ self error: self printString , ' need to be resolved before execution.'
+! !
+
+!PPUnresolvedParser methodsFor:'testing'!
+
+isUnresolved
+ ^ true
+! !
+
+!PPUnresolvedParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPUnresolvedParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PPWrappingParser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,24 @@
+"{ Package: 'squeak:petitparser' }"
+
+PPActionParser subclass:#PPWrappingParser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'PetitParser-Parsers'
+!
+
+PPWrappingParser comment:'A parser that performs an action block upon activation with the stream and a continuation block.'
+!
+
+
+!PPWrappingParser methodsFor:'parsing'!
+
+parseOn: aStream
+ ^ block value: aStream value: [ parser parseOn: aStream ]
+! !
+
+!PPWrappingParser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: PPWrappingParser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/abbrev.stc Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,50 @@
+PPAbstractParseTest PPAbstractParseTest squeak:petitparser 'PetitTests-Core' 4
+PPCharSetPredicate PPCharSetPredicate squeak:petitparser 'PetitParser-Tools' 0
+PPFailure PPFailure squeak:petitparser 'PetitParser-Core' 0
+PPMemento PPMemento squeak:petitparser 'PetitParser-Core' 0
+PPParser PPParser squeak:petitparser 'PetitParser-Parsers' 0
+PPParserResource PPParserResource squeak:petitparser 'PetitTests-Core' 1
+PPStream PPStream squeak:petitparser 'PetitParser-Core' 0
+PPToken PPToken squeak:petitparser 'PetitParser-Core' 0
+squeak_petitparser squeak_petitparser squeak:petitparser '* Projects & Packages *' 3
+PPComposedTest PPComposedTest squeak:petitparser 'PetitTests-Tests' 4
+PPCompositeParserTest PPCompositeParserTest squeak:petitparser 'PetitTests-Core' 4
+PPDelegateParser PPDelegateParser squeak:petitparser 'PetitParser-Parsers' 0
+PPEpsilonParser PPEpsilonParser squeak:petitparser 'PetitParser-Parsers' 0
+PPExtensionTest PPExtensionTest squeak:petitparser 'PetitTests-Tests' 4
+PPFailingParser PPFailingParser squeak:petitparser 'PetitParser-Parsers' 0
+PPListParser PPListParser squeak:petitparser 'PetitParser-Parsers' 0
+PPLiteralParser PPLiteralParser squeak:petitparser 'PetitParser-Parsers' 0
+PPMappingTest PPMappingTest squeak:petitparser 'PetitTests-Tests' 4
+PPObjectTest PPObjectTest squeak:petitparser 'PetitTests-Tests' 4
+PPParserTest PPParserTest squeak:petitparser 'PetitTests-Tests' 4
+PPPluggableParser PPPluggableParser squeak:petitparser 'PetitParser-Parsers' 0
+PPPredicateParser PPPredicateParser squeak:petitparser 'PetitParser-Parsers' 0
+PPPredicateTest PPPredicateTest squeak:petitparser 'PetitTests-Tests' 4
+PPScriptingTest PPScriptingTest squeak:petitparser 'PetitTests-Tests' 4
+PPTokenTest PPTokenTest squeak:petitparser 'PetitTests-Tests' 4
+PPUnresolvedParser PPUnresolvedParser squeak:petitparser 'PetitParser-Tools' 0
+PPActionParser PPActionParser squeak:petitparser 'PetitParser-Parsers' 0
+PPAndParser PPAndParser squeak:petitparser 'PetitParser-Parsers' 0
+PPArithmeticParserTest PPArithmeticParserTest squeak:petitparser 'PetitTests-Tests' 4
+PPChoiceParser PPChoiceParser squeak:petitparser 'PetitParser-Parsers' 0
+PPCompositeParser PPCompositeParser squeak:petitparser 'PetitParser-Tools' 0
+PPEndOfInputParser PPEndOfInputParser squeak:petitparser 'PetitParser-Parsers' 0
+PPExpressionParser PPExpressionParser squeak:petitparser 'PetitParser-Tools' 0
+PPFlattenParser PPFlattenParser squeak:petitparser 'PetitParser-Parsers' 0
+PPLambdaParserTest PPLambdaParserTest squeak:petitparser 'PetitTests-Tests' 4
+PPLiteralObjectParser PPLiteralObjectParser squeak:petitparser 'PetitParser-Parsers' 0
+PPLiteralSequenceParser PPLiteralSequenceParser squeak:petitparser 'PetitParser-Parsers' 0
+PPMemoizedParser PPMemoizedParser squeak:petitparser 'PetitParser-Parsers' 0
+PPNotParser PPNotParser squeak:petitparser 'PetitParser-Parsers' 0
+PPOptionalParser PPOptionalParser squeak:petitparser 'PetitParser-Parsers' 0
+PPPredicateObjectParser PPPredicateObjectParser squeak:petitparser 'PetitParser-Parsers' 0
+PPPredicateSequenceParser PPPredicateSequenceParser squeak:petitparser 'PetitParser-Parsers' 0
+PPRepeatingParser PPRepeatingParser squeak:petitparser 'PetitParser-Parsers' 0
+PPSequenceParser PPSequenceParser squeak:petitparser 'PetitParser-Parsers' 0
+PPTrimmingParser PPTrimmingParser squeak:petitparser 'PetitParser-Parsers' 0
+PPArithmeticParser PPArithmeticParser squeak:petitparser 'PetitTests-Examples' 0
+PPExpressionParserTest PPExpressionParserTest squeak:petitparser 'PetitTests-Tests' 4
+PPLambdaParser PPLambdaParser squeak:petitparser 'PetitTests-Examples' 0
+PPTokenParser PPTokenParser squeak:petitparser 'PetitParser-Parsers' 0
+PPWrappingParser PPWrappingParser squeak:petitparser 'PetitParser-Parsers' 0
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bc.mak Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,104 @@
+# $Header: /cvs/stx/stx/goodies/petitparser/bc.mak,v 1.1 2011-08-18 18:56:17 cg Exp $
+#
+# DO NOT EDIT
+# automagically generated from the projectDefinition: squeak_petitparser.
+#
+# Warning: once you modify this file, do not rerun
+# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
+#
+# This file contains make rules for the win32 platform (using borland-bcc).
+# It shares common definitions with the unix-make in Make.spec.
+# The nt.mak supports the following targets:
+# bmake - compile all st-files to a classLib (dll)
+# bmake clean - clean all temp files
+# bmake clobber - clean all
+#
+#
+TOP=..\..\stx
+INCLUDE_TOP=$(TOP)\..
+
+
+
+!INCLUDE $(TOP)\rules\stdHeader_bc
+
+!INCLUDE Make.spec
+
+LIBNAME=libsqueak_petitparser
+RESFILES=petitparser.res
+
+
+
+LOCALINCLUDES= -I$(INCLUDE_TOP)\stx\goodies\sunit -I$(INCLUDE_TOP)\stx\libbasic -I$(INCLUDE_TOP)\stx\libbasic2
+LOCALDEFINES=
+
+STCLOCALOPT=-package=$(PACKAGE) -I. $(LOCALINCLUDES) -H. $(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 prerequisite packages for this package
+prereq:
+ pushd ..\..\stx\libbasic & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\goodies\refactoryBrowser\parser & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\libbasic2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\libcomp & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\libview & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\libbasic3 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\libview2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\libboss & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\libui & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\libwidg & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\libwidg2 & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\libtool & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\goodies\sunit & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+ pushd ..\..\stx\librun & $(MAKE_BAT) "CFLAGS_LOCAL=$(GLOBALDEFINES) "
+
+
+
+
+# BEGINMAKEDEPEND --- do not remove this line; make depend needs it
+$(OUTDIR)PPCharSetPredicate.$(O) PPCharSetPredicate.$(H): PPCharSetPredicate.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPFailure.$(O) PPFailure.$(H): PPFailure.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPMemento.$(O) PPMemento.$(H): PPMemento.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPParser.$(O) PPParser.$(H): PPParser.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPStream.$(O) PPStream.$(H): PPStream.st $(INCLUDE_TOP)\stx\libbasic\ReadStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPToken.$(O) PPToken.$(H): PPToken.st $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)squeak_petitparser.$(O) squeak_petitparser.$(H): squeak_petitparser.st $(INCLUDE_TOP)\stx\libbasic\LibraryDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\ProjectDefinition.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPDelegateParser.$(O) PPDelegateParser.$(H): PPDelegateParser.st $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPEpsilonParser.$(O) PPEpsilonParser.$(H): PPEpsilonParser.st $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPFailingParser.$(O) PPFailingParser.$(H): PPFailingParser.st $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPListParser.$(O) PPListParser.$(H): PPListParser.st $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPLiteralParser.$(O) PPLiteralParser.$(H): PPLiteralParser.st $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPPluggableParser.$(O) PPPluggableParser.$(H): PPPluggableParser.st $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPPredicateParser.$(O) PPPredicateParser.$(H): PPPredicateParser.st $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPUnresolvedParser.$(O) PPUnresolvedParser.$(H): PPUnresolvedParser.st $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPActionParser.$(O) PPActionParser.$(H): PPActionParser.st $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPAndParser.$(O) PPAndParser.$(H): PPAndParser.st $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPChoiceParser.$(O) PPChoiceParser.$(H): PPChoiceParser.st $(INCLUDE_TOP)\squeak\petitparser\PPListParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPCompositeParser.$(O) PPCompositeParser.$(H): PPCompositeParser.st $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPEndOfInputParser.$(O) PPEndOfInputParser.$(H): PPEndOfInputParser.st $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPExpressionParser.$(O) PPExpressionParser.$(H): PPExpressionParser.st $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPFlattenParser.$(O) PPFlattenParser.$(H): PPFlattenParser.st $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPLiteralObjectParser.$(O) PPLiteralObjectParser.$(H): PPLiteralObjectParser.st $(INCLUDE_TOP)\squeak\petitparser\PPLiteralParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPLiteralSequenceParser.$(O) PPLiteralSequenceParser.$(H): PPLiteralSequenceParser.st $(INCLUDE_TOP)\squeak\petitparser\PPLiteralParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPMemoizedParser.$(O) PPMemoizedParser.$(H): PPMemoizedParser.st $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPNotParser.$(O) PPNotParser.$(H): PPNotParser.st $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPOptionalParser.$(O) PPOptionalParser.$(H): PPOptionalParser.st $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPPredicateObjectParser.$(O) PPPredicateObjectParser.$(H): PPPredicateObjectParser.st $(INCLUDE_TOP)\squeak\petitparser\PPPredicateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPPredicateSequenceParser.$(O) PPPredicateSequenceParser.$(H): PPPredicateSequenceParser.st $(INCLUDE_TOP)\squeak\petitparser\PPPredicateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPRepeatingParser.$(O) PPRepeatingParser.$(H): PPRepeatingParser.st $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPSequenceParser.$(O) PPSequenceParser.$(H): PPSequenceParser.st $(INCLUDE_TOP)\squeak\petitparser\PPListParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPTrimmingParser.$(O) PPTrimmingParser.$(H): PPTrimmingParser.st $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPArithmeticParser.$(O) PPArithmeticParser.$(H): PPArithmeticParser.st $(INCLUDE_TOP)\squeak\petitparser\PPCompositeParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPLambdaParser.$(O) PPLambdaParser.$(H): PPLambdaParser.st $(INCLUDE_TOP)\squeak\petitparser\PPCompositeParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPTokenParser.$(O) PPTokenParser.$(H): PPTokenParser.st $(INCLUDE_TOP)\squeak\petitparser\PPFlattenParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)PPWrappingParser.$(O) PPWrappingParser.$(H): PPWrappingParser.st $(INCLUDE_TOP)\squeak\petitparser\PPActionParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPDelegateParser.$(H) $(INCLUDE_TOP)\squeak\petitparser\PPParser.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(STCHDR)
+$(OUTDIR)extensions.$(O): extensions.st $(INCLUDE_TOP)\stx\libbasic\Block.$(H) $(INCLUDE_TOP)\stx\libbasic\CompiledCode.$(H) $(INCLUDE_TOP)\stx\libbasic\ExecutableFunction.$(H) $(INCLUDE_TOP)\stx\libbasic\Object.$(H) $(INCLUDE_TOP)\stx\libbasic\BlockContext.$(H) $(INCLUDE_TOP)\stx\libbasic\Context.$(H) $(INCLUDE_TOP)\stx\libbasic\Character.$(H) $(INCLUDE_TOP)\stx\libbasic\Magnitude.$(H) $(INCLUDE_TOP)\stx\libbasic\PositionableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\PeekableStream.$(H) $(INCLUDE_TOP)\stx\libbasic\Stream.$(H) $(INCLUDE_TOP)\stx\libbasic\SequenceableCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Collection.$(H) $(INCLUDE_TOP)\stx\libbasic\Set.$(H) $(INCLUDE_TOP)\stx\libbasic\String.$(H) $(INCLUDE_TOP)\stx\libbasic\CharacterArray.$(H) $(INCLUDE_TOP)\stx\libbasic\ByteArray.$(H) $(INCLUDE_TOP)\stx\libbasic\UninterpretedBytes.$(H) $(INCLUDE_TOP)\stx\libbasic\ArrayedCollection.$(H) $(INCLUDE_TOP)\stx\libbasic\Symbol.$(H) $(INCLUDE_TOP)\stx\libbasic\UndefinedObject.$(H) $(STCHDR)
+
+# ENDMAKEDEPEND --- do not remove this line
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bmake.bat Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,8 @@
+@REM -------
+@REM make using borland bcc
+@REM type bmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+make.exe -N -f bc.mak %1 %2
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/extensions.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,132 @@
+"{ Package: 'squeak:petitparser' }"
+
+!
+
+!Block methodsFor:'*petitparser-core-converting'!
+
+asParser
+ ^ PPPluggableParser on: self
+! !
+!BlockContext methodsFor:'*petitparser-core-converting'!
+
+asParser
+ ^ PPPluggableParser on: self
+! !
+!Character methodsFor:'arithmetic'!
+
+- aMagnitude
+ "Return the Character that is <aMagnitude> lower than the receiver.
+ Wrap if the resulting value is not a legal Character value. (JS)
+ claus:
+ modified to return the difference as integer, if the argument
+ is another character. If the argument is a number, a character is
+ returned."
+
+ aMagnitude isCharacter ifTrue:[
+ ^ asciivalue - aMagnitude asInteger
+ ].
+ ^ Character codePoint:((asciivalue - aMagnitude asInteger) \\ 16r3FFFFFFF)
+
+ "
+ $z - $a
+ $d - 3
+ "
+
+ "Modified: / 27-06-1996 / 12:35:34 / cg"
+ "Modified: / 19-12-2010 / 18:36:56 / Jan Kurs <kurs.jan@post.cz>"
+! !
+!Character methodsFor:'*petitparser-converting'!
+
+asParser
+ ^ PPLiteralObjectParser on: self
+! !
+!Character methodsFor:'arithmetic'!
+
+ppMinus: aCharacter
+ "Create a range of characters between the receiver and the argument."
+
+ ^ PPPredicateObjectParser between: self and: aCharacter
+
+ "Created: / 19-12-2010 / 18:13:19 / Jan Kurs <kurs.jan@post.cz>"
+! !
+!Object methodsFor:'*petitparser-core-converting'!
+
+asParser
+ ^ PPPredicateObjectParser expect: self
+! !
+!Object methodsFor:'*petitparser-core-testing'!
+
+isPetitFailure
+ ^ false
+! !
+!Object methodsFor:'*petitparser-core-testing'!
+
+isPetitParser
+ ^ false
+! !
+!PositionableStream methodsFor:'*petitparser-core-converting'!
+
+asPetitStream
+ "Some of my subclasses do not use the instance-variables collection, position and readLimit but instead have a completely different internal representation. In these cases just use the super implementation that is inefficient but should work in all cases."
+
+ "DUNNO WHY, but on: collection from: position to: last set the start to position -1"
+ self breakPoint: #petitparser.
+
+ ^ (collection isNil or: [ position isNil or: [ readLimit isNil ] ])
+ ifFalse: [ PPStream on: collection from: (position +1) to: readLimit ]
+ ifTrue: [ super asPetitStream ]
+
+
+"/ ^ (collection isNil or: [ position isNil or: [ readLimit isNil ] ])
+"/ ifFalse: [ PPStream on: collection from: position to: readLimit ]
+"/ ifTrue: [ super asPetitStream ]
+
+ "Modified: / 18-12-2010 / 17:38:01 / Jan Kurs <kurs.jan@post.cz>"
+! !
+!SequenceableCollection methodsFor:'*petitparser-core-converting'!
+
+asParser
+ ^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])
+! !
+!SequenceableCollection methodsFor:'*petitparser-core-converting'!
+
+asPetitStream
+ ^ PPStream on: self
+! !
+!Set methodsFor:'*petitparser-core-converting'!
+
+asParser
+ ^ PPChoiceParser withAll: (self collect: [ :each | each asParser ])
+! !
+!Stream methodsFor:'*petitparser-core-converting'!
+
+asPetitStream
+ ^ self contents asPetitStream
+! !
+!String methodsFor:'*petitparser-core-converting'!
+
+asParser
+ ^ PPLiteralSequenceParser on: self
+! !
+!Symbol methodsFor:'*petitparser-core-converting'!
+
+asParser
+ ^ PPPredicateObjectParser perform: self
+! !
+!Symbol methodsFor:'Compatibility-Squeak'!
+
+value:anObject
+ ^ anObject perform: self.
+
+ "Created: / 18-12-2010 / 16:47:22 / Jan Kurs <kurs.jan@post.cz>"
+! !
+!Text methodsFor:'*petitparser-core'!
+
+asPetitStream
+ ^ string asPetitStream
+! !
+!UndefinedObject methodsFor:'*petitparser-converting'!
+
+asParser
+ ^ PPEpsilonParser new
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lcmake.bat Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,8 @@
+@REM -------
+@REM make using lcc compiler
+@REM type lcmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+make.exe -N -f bc.mak USELCC=1 %1 %2
+
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/libInit.cc Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,69 @@
+/*
+ * $Header: /cvs/stx/stx/goodies/petitparser/libInit.cc,v 1.1 2011-08-18 18:56:17 cg Exp $
+ *
+ * DO NOT EDIT
+ * automagically generated from the projectDefinition: squeak_petitparser.
+ */
+#define __INDIRECTVMINITCALLS__
+#include <stc.h>
+
+#ifdef WIN32
+# pragma codeseg INITCODE "INITCODE"
+#endif
+
+#if defined(INIT_TEXT_SECTION) || defined(DLL_EXPORT)
+DLL_EXPORT void _libsqueak_petitparser_Init() INIT_TEXT_SECTION;
+// DLL_EXPORT void _libsqueak_petitparser_InitDefinition() INIT_TEXT_SECTION;
+#endif
+
+// void _libsqueak_petitparser_InitDefinition(pass, __pRT__, snd)
+// OBJ snd; struct __vmData__ *__pRT__; {
+// __BEGIN_PACKAGE2__("libsqueak_petitparser__DFN", _libsqueak_petitparser_InitDefinition, "squeak:petitparser");
+// _squeak_137petitparser_Init(pass,__pRT__,snd);
+
+// __END_PACKAGE__();
+// }
+
+void _libsqueak_petitparser_Init(pass, __pRT__, snd)
+OBJ snd; struct __vmData__ *__pRT__; {
+__BEGIN_PACKAGE2__("libsqueak_petitparser", _libsqueak_petitparser_Init, "squeak:petitparser");
+_PPCharSetPredicate_Init(pass,__pRT__,snd);
+_PPFailure_Init(pass,__pRT__,snd);
+_PPMemento_Init(pass,__pRT__,snd);
+_PPParser_Init(pass,__pRT__,snd);
+_PPStream_Init(pass,__pRT__,snd);
+_PPToken_Init(pass,__pRT__,snd);
+_squeak_137petitparser_Init(pass,__pRT__,snd);
+_PPDelegateParser_Init(pass,__pRT__,snd);
+_PPEpsilonParser_Init(pass,__pRT__,snd);
+_PPFailingParser_Init(pass,__pRT__,snd);
+_PPListParser_Init(pass,__pRT__,snd);
+_PPLiteralParser_Init(pass,__pRT__,snd);
+_PPPluggableParser_Init(pass,__pRT__,snd);
+_PPPredicateParser_Init(pass,__pRT__,snd);
+_PPUnresolvedParser_Init(pass,__pRT__,snd);
+_PPActionParser_Init(pass,__pRT__,snd);
+_PPAndParser_Init(pass,__pRT__,snd);
+_PPChoiceParser_Init(pass,__pRT__,snd);
+_PPCompositeParser_Init(pass,__pRT__,snd);
+_PPEndOfInputParser_Init(pass,__pRT__,snd);
+_PPExpressionParser_Init(pass,__pRT__,snd);
+_PPFlattenParser_Init(pass,__pRT__,snd);
+_PPLiteralObjectParser_Init(pass,__pRT__,snd);
+_PPLiteralSequenceParser_Init(pass,__pRT__,snd);
+_PPMemoizedParser_Init(pass,__pRT__,snd);
+_PPNotParser_Init(pass,__pRT__,snd);
+_PPOptionalParser_Init(pass,__pRT__,snd);
+_PPPredicateObjectParser_Init(pass,__pRT__,snd);
+_PPPredicateSequenceParser_Init(pass,__pRT__,snd);
+_PPRepeatingParser_Init(pass,__pRT__,snd);
+_PPSequenceParser_Init(pass,__pRT__,snd);
+_PPTrimmingParser_Init(pass,__pRT__,snd);
+_PPArithmeticParser_Init(pass,__pRT__,snd);
+_PPLambdaParser_Init(pass,__pRT__,snd);
+_PPTokenParser_Init(pass,__pRT__,snd);
+_PPWrappingParser_Init(pass,__pRT__,snd);
+
+_squeak_137petitparser_extensions_Init(pass,__pRT__,snd);
+__END_PACKAGE__();
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/petitparser.rc Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,35 @@
+//
+// DO NOT EDIT
+// automagically generated from the projectDefinition: squeak_petitparser.
+//
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION 6,1,0,1
+ PRODUCTVERSION 6,1,2,1
+ 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
+
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904E4"
+ BEGIN
+ VALUE "CompanyName", "Lukas Renggli & SWING Research Group\0"
+ VALUE "FileDescription", "Scanner-less parser & parser combinator library (LIB)\0"
+ VALUE "FileVersion", "6.1.0.1\0"
+ VALUE "InternalName", "squeak:petitparser\0"
+ VALUE "LegalCopyright", "(C) Lukas Renggli\0"
+ VALUE "ProductName", "Petit Parser\0"
+ VALUE "ProductVersion", "6.1.2.1\0"
+ VALUE "ProductDate", "Fri, 17 Dec 2010 18:45:48 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/squeak_petitparser.st Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,198 @@
+"{ Package: 'squeak:petitparser' }"
+
+LibraryDefinition subclass:#squeak_petitparser
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'* Projects & Packages *'
+!
+
+
+!squeak_petitparser class methodsFor:'accessing'!
+
+monticelloPackageName
+ "hook for packages which have been loaded from monticello"
+
+ ^ 'PetitParser'
+
+ "Created: / 17-12-2010 / 19:44:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!squeak_petitparser class methodsFor:'description'!
+
+excludedFromPreRequisites
+ "list all packages which should be ignored in the automatic
+ preRequisites scan. See #preRequisites for more."
+
+ ^ #(
+ )
+!
+
+preRequisites
+ "list all required packages.
+ This list can be maintained manually or (better) generated and
+ updated by scanning the superclass hierarchies and looking for
+ global variable accesses. (the browser has a menu function for that)
+ Howevery, often too much is found, and you may want to explicitely
+ exclude individual packages in the #excludedFromPrerequisites method."
+
+ ^ #(
+ #'stx:goodies/sunit' "TestCase - superclass of PPTokenTest "
+ #'stx:libbasic' "Object - superclass of PPFailure "
+ #'stx:libbasic2' "Text"
+ )
+! !
+
+!squeak_petitparser class methodsFor:'description - actions'!
+
+postLoadAction
+
+ self classes do: [:cls|cls isLoaded ifFalse:[cls autoload]]
+
+ "Created: / 17-12-2010 / 19:55:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!squeak_petitparser 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"
+ (PPAbstractParseTest autoload)
+ PPCharSetPredicate
+ PPFailure
+ PPMemento
+ PPParser
+ (PPParserResource autoload)
+ PPStream
+ PPToken
+ #'squeak_petitparser'
+ (PPComposedTest autoload)
+ (PPCompositeParserTest autoload)
+ PPDelegateParser
+ PPEpsilonParser
+ (PPExtensionTest autoload)
+ PPFailingParser
+ PPListParser
+ PPLiteralParser
+ (PPMappingTest autoload)
+ (PPObjectTest autoload)
+ (PPParserTest autoload)
+ PPPluggableParser
+ PPPredicateParser
+ (PPPredicateTest autoload)
+ (PPScriptingTest autoload)
+ (PPTokenTest autoload)
+ PPUnresolvedParser
+ PPActionParser
+ PPAndParser
+ (PPArithmeticParserTest autoload)
+ PPChoiceParser
+ PPCompositeParser
+ PPEndOfInputParser
+ PPExpressionParser
+ PPFlattenParser
+ (PPLambdaParserTest autoload)
+ PPLiteralObjectParser
+ PPLiteralSequenceParser
+ PPMemoizedParser
+ PPNotParser
+ PPOptionalParser
+ PPPredicateObjectParser
+ PPPredicateSequenceParser
+ PPRepeatingParser
+ PPSequenceParser
+ PPTrimmingParser
+ PPArithmeticParser
+ (PPExpressionParserTest autoload)
+ PPLambdaParser
+ PPTokenParser
+ PPWrappingParser
+ )
+!
+
+extensionMethodNames
+ "lists the extension methods which are to be included in the project.
+ Entries are 2-element array literals, consisting of class-name and selector."
+
+ ^ #(
+ Block asParser
+ BlockContext asParser
+ Character #'-'
+ Character asParser
+ Character ppMinus:
+ Object asParser
+ Object isPetitFailure
+ Object isPetitParser
+ PositionableStream asPetitStream
+ SequenceableCollection asParser
+ SequenceableCollection asPetitStream
+ Set asParser
+ Stream asPetitStream
+ String asParser
+ Symbol asParser
+ Symbol value:
+ Text asPetitStream
+ UndefinedObject asParser
+ )
+! !
+
+!squeak_petitparser class methodsFor:'description - project information'!
+
+applicationIconFileName
+ "Return the name (without suffix) of an icon-file (the app's icon); will be included in the rc-resource file"
+
+ ^ nil
+ "/ ^ self applicationName
+!
+
+companyName
+ "Return a companyname which will appear in <lib>.rc"
+
+ ^ 'Lukas Renggli & SWING Research Group'
+
+ "Modified: / 17-12-2010 / 19:43:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+description
+ "Return a description string which will appear in vc.def / bc.def"
+
+ ^ 'Scanner-less parser & parser combinator library'
+
+ "Modified: / 17-12-2010 / 19:43:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+legalCopyright
+ "Return a copyright string which will appear in <lib>.rc"
+
+ ^ '(C) Lukas Renggli'
+
+ "Modified: / 17-12-2010 / 19:43:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+productName
+ "Return a product name which will appear in <lib>.rc"
+
+ ^ 'Petit Parser'
+
+ "Modified: / 17-12-2010 / 19:43:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!squeak_petitparser class methodsFor:'description - svn'!
+
+svnRevisionNr
+ "Return a SVN revision number of myself.
+ This number is updated after a commit"
+
+ ^ "$SVN-Revision:"'5M'"$"
+! !
+
+!squeak_petitparser class methodsFor:'documentation'!
+
+version_SVN
+ ^ '$Id: squeak_petitparser.st,v 1.1 2011-08-18 18:56:17 cg Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/vcmake.bat Thu Aug 18 20:56:17 2011 +0200
@@ -0,0 +1,8 @@
+@REM -------
+@REM make using microsoft visual c
+@REM type vcmake, and wait...
+@REM do not edit - automatically generated from ProjectDefinition
+@REM -------
+make.exe -N -f bc.mak -DUSEVC %1 %2
+
+