diff --git a/software/PetitParser/BlockClosure.extension.st b/software/PetitParser/BlockClosure.extension.st
new file mode 100644
index 0000000..4a465d9
--- /dev/null
+++ b/software/PetitParser/BlockClosure.extension.st
@@ -0,0 +1,8 @@
+Extension { #name : 'BlockClosure' }
+
+{ #category : '*petitparser-core-converting' }
+BlockClosure >> asParser [
+	"Answer a parser implemented in the receiving one-argument block."
+
+	^ PPPluggableParser on: self
+]
diff --git a/software/PetitParser/Character.extension.st b/software/PetitParser/Character.extension.st
new file mode 100644
index 0000000..5178f81
--- /dev/null
+++ b/software/PetitParser/Character.extension.st
@@ -0,0 +1,8 @@
+Extension { #name : 'Character' }
+
+{ #category : '*petitparser-core-converting' }
+Character >> asParser [
+	"Answer a parser that accepts the receiving character."
+	
+	^ PPLiteralObjectParser on: self
+]
diff --git a/software/PetitParser/Collection.extension.st b/software/PetitParser/Collection.extension.st
new file mode 100644
index 0000000..783f36c
--- /dev/null
+++ b/software/PetitParser/Collection.extension.st
@@ -0,0 +1,30 @@
+Extension { #name : 'Collection' }
+
+{ #category : '*petitparser-core-converting' }
+Collection >> asChoiceParser [
+	^ PPChoiceParser withAll: (self collect: [ :each | each asParser ])
+]
+
+{ #category : '*petitparser-converting' }
+Collection >> asParser [    
+	"Create a range of characters between start and stop."
+
+	(self allSatisfy: [ :e | e isCharacter ]) ifTrue: [ 
+		| charSet |
+		charSet := PPCharSetPredicate on: [ :char | self includes: char ] .
+     	^ PPPredicateObjectParser on: charSet message: 'One of these charactes expected: ', self printString.
+	].
+
+
+	^ super asParser
+	"
+		($a to:$f) asParser parse:'a'
+		($a to:$f) asParser parse:'g'
+	"
+
+]
+
+{ #category : '*petitparser-core-converting' }
+Collection >> asSequenceParser [
+	^ PPSequenceParser withAll: (self collect: [ :each | each asParser ])
+]
diff --git a/software/PetitParser/Interval.extension.st b/software/PetitParser/Interval.extension.st
new file mode 100644
index 0000000..20903be
--- /dev/null
+++ b/software/PetitParser/Interval.extension.st
@@ -0,0 +1,16 @@
+Extension { #name : 'Interval' }
+
+{ #category : '*petitparser-core-converting' }
+Interval >> asParser [    
+	"Create a range of characters between start and stop."
+
+    self assert:start isCharacter.
+    self assert:stop isCharacter.
+    self assert:step == 1.
+    ^ PPPredicateObjectParser between: start and: stop
+
+    "
+		($a to: $f) asParser parse: 'a'
+		($a to: $f) asParser parse: 'g'
+    "
+]
diff --git a/software/PetitParser/Object.extension.st b/software/PetitParser/Object.extension.st
new file mode 100644
index 0000000..384d098
--- /dev/null
+++ b/software/PetitParser/Object.extension.st
@@ -0,0 +1,23 @@
+Extension { #name : 'Object' }
+
+{ #category : '*petitparser-core-converting' }
+Object >> asParser [
+	"Answer a parser accepting the receiving object."
+
+	^ PPPredicateObjectParser expect: self
+]
+
+{ #category : '*petitparser-core-testing' }
+Object >> isPetitFailure [
+	^ false
+]
+
+{ #category : '*petitparser-core-testing' }
+Object >> isPetitParser [
+	^ false
+]
+
+{ #category : '*PetitParser' }
+Object >> isPetitToken [
+	^ false
+]
diff --git a/software/PetitParser/PPActionParser.class.st b/software/PetitParser/PPActionParser.class.st
new file mode 100644
index 0000000..6d61090
--- /dev/null
+++ b/software/PetitParser/PPActionParser.class.st
@@ -0,0 +1,40 @@
+"
+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.
+
+"
+Class {
+	#name : 'PPActionParser',
+	#superclass : 'PPDelegateParser',
+	#instVars : [
+		'block'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'instance creation' }
+PPActionParser class >> on: aParser block: aBlock [
+	^ (self on: aParser) setBlock: aBlock
+]
+
+{ #category : 'accessing' }
+PPActionParser >> block [
+	"Answer the action block of the receiver."
+
+	^ block
+]
+
+{ #category : 'parsing' }
+PPActionParser >> parseOn: aPPContext [
+	| element |
+	^ (element := parser parseOn: aPPContext) isPetitFailure
+		ifFalse: [ block value: element ]
+		ifTrue: [ element ]
+]
+
+{ #category : 'initialization' }
+PPActionParser >> setBlock: aBlock [
+	block := aBlock
+]
diff --git a/software/PetitParser/PPAndParser.class.st b/software/PetitParser/PPAndParser.class.st
new file mode 100644
index 0000000..8a46ee2
--- /dev/null
+++ b/software/PetitParser/PPAndParser.class.st
@@ -0,0 +1,22 @@
+"
+The and-predicate, a parser that succeeds whenever its delegate does, but does not consume the input stream [Parr 1994, 1995].
+"
+Class {
+	#name : 'PPAndParser',
+	#superclass : 'PPDelegateParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'operators' }
+PPAndParser >> and [
+	^ self
+]
+
+{ #category : 'parsing' }
+PPAndParser >> parseOn: aPPContext [
+	| element memento |
+	memento := aPPContext remember.
+	element := parser parseOn: aPPContext.
+	aPPContext restore: memento.
+	^ element
+]
diff --git a/software/PetitParser/PPCharSetPredicate.class.st b/software/PetitParser/PPCharSetPredicate.class.st
new file mode 100644
index 0000000..88fea53
--- /dev/null
+++ b/software/PetitParser/PPCharSetPredicate.class.st
@@ -0,0 +1,46 @@
+"
+I am a predicate allowing to check if a character is included in the set of char described by the Block this object is initialized with.
+
+I work efficiently on characters for which the code point is between 1 and 255 using a lookup table.
+
+For example,
+[[[
+charSetPredicate := PPCharSetPredicate on: [ :char | #($a $b $c) includes: char ].
+charSetPredicate value: $a. ""true""
+charSetPredicate value: $z. ""false""
+]]]
+"
+Class {
+	#name : 'PPCharSetPredicate',
+	#superclass : 'Object',
+	#instVars : [
+		'block',
+		'classification'
+	],
+	#category : 'PetitParser-Tools'
+}
+
+{ #category : 'instance creation' }
+PPCharSetPredicate class >> on: aBlock [
+	^ self basicNew initializeOn: aBlock
+]
+
+{ #category : 'initialization' }
+PPCharSetPredicate >> initializeOn: aBlock [
+	block := aBlock.
+	classification := Array new: 255.
+	1 to: classification size do: [ :index |
+		classification at: index put: (block
+			value: (Character codePoint: index)) ]
+]
+
+{ #category : 'evaluating' }
+PPCharSetPredicate >> value: aCharacter [
+	| index |
+	index := aCharacter asInteger.
+	index == 0
+		ifTrue: [ ^ block value: aCharacter ].
+	index > 255
+		ifTrue: [ ^ block value: aCharacter ].
+	^ classification at: index
+]
diff --git a/software/PetitParser/PPChoiceParser.class.st b/software/PetitParser/PPChoiceParser.class.st
new file mode 100644
index 0000000..be2bc4c
--- /dev/null
+++ b/software/PetitParser/PPChoiceParser.class.st
@@ -0,0 +1,26 @@
+"
+A parser that uses the first parser that succeeds.
+"
+Class {
+	#name : 'PPChoiceParser',
+	#superclass : 'PPListParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'operators' }
+PPChoiceParser >> / aRule [ 
+	^ self copyWith: aRule
+]
+
+{ #category : 'parsing' }
+PPChoiceParser >> parseOn: aPPContext [
+	"This is optimized code that avoids unnecessary block activations, do not change. When all choices fail, the last failure is answered."
+
+	| element |
+	1 to: parsers size do: [ :index |
+		element := (parsers at: index)
+			parseOn: aPPContext.
+		element isPetitFailure
+			ifFalse: [ ^ element ] ].
+	^ element
+]
diff --git a/software/PetitParser/PPCompositeParser.class.st b/software/PetitParser/PPCompositeParser.class.st
new file mode 100644
index 0000000..6f15d4c
--- /dev/null
+++ b/software/PetitParser/PPCompositeParser.class.st
@@ -0,0 +1,150 @@
+"
+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.
+"
+Class {
+	#name : 'PPCompositeParser',
+	#superclass : 'PPDelegateParser',
+	#instVars : [
+		'dependencies'
+	],
+	#category : 'PetitParser-Tools'
+}
+
+{ #category : 'accessing' }
+PPCompositeParser class >> dependencies [
+	"Answer a collection of PPCompositeParser classes that this parser directly dependends on. Override this method in subclasses to declare dependent parsers. The default implementation does not depend on other PPCompositeParser."
+
+	^ #()
+]
+
+{ #category : 'accessing' }
+PPCompositeParser class >> 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
+]
+
+{ #category : 'instance creation' }
+PPCompositeParser class >> new [
+	"Answer a new parser starting at the default start symbol."
+
+	^ self newStartingAt: self startSymbol
+]
+
+{ #category : 'instance creation' }
+PPCompositeParser class >> newStartingAt: aSymbol [
+	"Answer a new parser starting at aSymbol. The code makes sure to resolve all dependent parsers correctly."
+
+	| parsers remaining |
+	parsers := IdentityDictionary new.
+	remaining := OrderedCollection with: self.
+	[ remaining isEmpty ] whileFalse: [
+		| dependency |
+		dependency := remaining removeLast.
+		(parsers includesKey: dependency) ifFalse: [
+			parsers at: dependency put: dependency basicNew.
+			remaining addAll: dependency dependencies ] ].
+	parsers keysAndValuesDo: [ :class :parser |
+		| dependencies |
+		dependencies := IdentityDictionary new.
+		class dependencies 
+			do: [ :dependency | dependencies at: dependency put: (parsers at: dependency) ].
+		parser 
+			initializeStartingAt: (class == self
+				ifTrue: [ aSymbol ]
+				ifFalse: [ class startSymbol ]) 
+			dependencies: dependencies ].
+	parsers keysAndValuesDo: [ :class :parser |
+		parser setParser: (parser perform: parser children first name).
+		parser productionNames keysAndValuesDo: [ :key :value |
+			(parser instVarAt: key) setParser: (parser perform: value) ] ].
+	^ parsers at: self
+]
+
+{ #category : 'parsing' }
+PPCompositeParser class >> parse: anObject [
+	^ self parse: anObject startingAt: self startSymbol
+]
+
+{ #category : 'parsing' }
+PPCompositeParser class >> parse: anObject onError: aBlock [
+	^ self parse: anObject startingAt: self startSymbol onError: aBlock
+]
+
+{ #category : 'parsing' }
+PPCompositeParser class >> parse: anObject startingAt: aSymbol [
+	^ (self newStartingAt: aSymbol) parse: anObject
+]
+
+{ #category : 'parsing' }
+PPCompositeParser class >> parse: anObject startingAt: aSymbol onError: aBlock [
+	^ (self newStartingAt: aSymbol) parse: anObject onError: aBlock
+]
+
+{ #category : 'accessing' }
+PPCompositeParser class >> startSymbol [
+	"Answer the method that represents the default start symbol."
+
+	^ #start
+]
+
+{ #category : 'querying' }
+PPCompositeParser >> dependencyAt: aClass [
+	"Answer the dependent parser aClass. Throws an error if this parser class is not declared in the method #dependencies on the class-side of the receiver."
+	
+	^ dependencies at: aClass ifAbsent: [ self error: 'Undeclared dependency in ' , self class name , ' to ' , aClass name ]
+]
+
+{ #category : 'initialization' }
+PPCompositeParser >> initializeStartingAt: aSymbol dependencies: aDictionary [
+	self initialize.
+	parser := PPDelegateParser named: aSymbol.
+	self productionNames keysAndValuesDo: [ :key :value |
+		self instVarAt: key put: (PPDelegateParser named: value) ].
+	dependencies := aDictionary
+]
+
+{ #category : 'querying' }
+PPCompositeParser >> productionAt: aSymbol [
+	"Answer the production named aSymbol."
+	
+	^ self productionAt: aSymbol ifAbsent: [ nil ]
+]
+
+{ #category : 'querying' }
+PPCompositeParser >> 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 ])
+]
+
+{ #category : 'querying' }
+PPCompositeParser >> productionNames [
+	"Answer a dictionary of slot indexes and production names."
+	
+	| productionNames ignoredNames |
+	productionNames := Dictionary new.
+	ignoredNames := self class ignoredNames
+		collect: [ :each | each asSymbol ].
+	self class allInstVarNames keysAndValuesDo: [ :key :value |
+		(ignoredNames includes: value asSymbol)
+			ifFalse: [ productionNames at: key put: value asSymbol ] ].
+	^ productionNames
+]
+
+{ #category : 'accessing' }
+PPCompositeParser >> start [
+	"Answer the production to start this parser with."
+	
+	self subclassResponsibility
+]
diff --git a/software/PetitParser/PPConditionalParser.class.st b/software/PetitParser/PPConditionalParser.class.st
new file mode 100644
index 0000000..a515db9
--- /dev/null
+++ b/software/PetitParser/PPConditionalParser.class.st
@@ -0,0 +1,35 @@
+"
+A PPConditionalParser is a delegate parser that evaluates a block and if that returns true, the delegate parser is invoked and its result returned. If the block evaluates to false, the PPFailure is returned.
+
+The block accepts one argument, context.
+
+E.g.
+    ('a' asParser if: [ :ctx | (ctx propertyAt: #myProperty) isNotNil ]) parse: 'a'
+"
+Class {
+	#name : 'PPConditionalParser',
+	#superclass : 'PPDelegateParser',
+	#instVars : [
+		'block'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'instance creation' }
+PPConditionalParser class >> on: aPPParser block: block [
+	^ (PPConditionalParser on: aPPParser)
+		block: block;
+		yourself
+]
+
+{ #category : 'accessing' }
+PPConditionalParser >> block: aBlock [
+	block := aBlock
+]
+
+{ #category : 'parsing' }
+PPConditionalParser >> parseOn: aPPContext [
+	^ (block value: aPPContext) 
+		ifTrue: [ parser parseOn: aPPContext ]
+		ifFalse: [ PPFailure message: block asString, ' was not evaluated to true.' context: aPPContext ]
+]
diff --git a/software/PetitParser/PPContext.class.st b/software/PetitParser/PPContext.class.st
new file mode 100644
index 0000000..d6f601f
--- /dev/null
+++ b/software/PetitParser/PPContext.class.st
@@ -0,0 +1,430 @@
+"
+A PPContext is provides contextual information to the parsing function.
+
+Instance Variables
+	globals:		<Dictionary>
+	properties:		<Dictionar>
+	root:		<PPParser>
+	stream:		<PPStream>
+
+globals
+	- properties that are not restored after backtracking
+
+properties
+	- properties that are restored after backtracking
+
+root
+	- the root parser
+
+stream
+	- input stream
+
+"
+Class {
+	#name : 'PPContext',
+	#superclass : 'Object',
+	#instVars : [
+		'stream',
+		'root',
+		'properties',
+		'globals',
+		'furthestFailure'
+	],
+	#category : 'PetitParser-Core'
+}
+
+{ #category : 'stream mimicry' }
+PPContext >> atEnd [
+	^ stream atEnd
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> back [
+	^ stream back
+]
+
+{ #category : 'checking' }
+PPContext >> checkMementoStreamIsSameAsMine: aPPContextMemento [
+	aPPContextMemento stream == stream ifFalse: [ 
+		self error: 'The stream held by the PPContextMemento must be identity-equals to the stream I hold.' ]
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> collection [
+	^ stream collection  
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> contents [ 
+	^ stream contents
+]
+
+{ #category : 'failures' }
+PPContext >> furthestFailure [
+	" the furthest failure encountered while parsing the input stream "
+	
+	"^ self globalAt: #furthestFailure ifAbsent: [ nil ]"
+	"performance optimization:"
+	^ furthestFailure
+]
+
+{ #category : 'accessing-globals' }
+PPContext >> globalAt: aKey [
+	"Answer the global property value associated with aKey."
+	
+	^ self globalAt: aKey ifAbsent: [ self error: 'Property not found' ]
+]
+
+{ #category : 'accessing-globals' }
+PPContext >> globalAt: aKey ifAbsent: aBlock [
+	"Answer the global property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
+	
+	^ globals isNil
+		ifTrue: [ aBlock value ]
+		ifFalse: [ globals at: aKey ifAbsent: aBlock ]
+]
+
+{ #category : 'accessing-globals' }
+PPContext >> globalAt: aKey ifAbsentPut: aBlock [
+	"Answer the global property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
+	
+	^ self globalAt: aKey ifAbsent: [ self globalAt: aKey put: aBlock value ]
+]
+
+{ #category : 'accessing-globals' }
+PPContext >> globalAt: aKey put: anObject [
+	"Set the global 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."
+
+	^ (globals ifNil: [ globals := Dictionary new: 1 ])
+		at: aKey put: anObject
+]
+
+{ #category : 'accessing-globals' }
+PPContext >> globals [
+	^ globals
+]
+
+{ #category : 'accessing-globals' }
+PPContext >> hasGlobal: aKey [
+	"Test if the global property aKey is present."
+	
+	^ globals notNil and: [ globals includesKey: aKey ]
+]
+
+{ #category : 'accessing-properties' }
+PPContext >> hasProperty: aKey [
+	"Test if the property aKey is present."
+	
+	^ properties notNil and: [ properties includesKey: aKey ]
+]
+
+{ #category : '*PetitParser-Ruby-Parser' }
+PPContext >> heredocId [
+	^ self globalAt: #heredocId ifAbsent: nil
+]
+
+{ #category : '*PetitParser-Ruby-Parser' }
+PPContext >> heredocId: value [
+	self globalAt: #heredocId put: value
+]
+
+{ #category : 'memoization' }
+PPContext >> identifier [
+	"
+		I provide an identifier that is used by memoizing parser to figure out if the
+		cache should be flushed or not.
+	"
+	^ stream
+]
+
+{ #category : 'initialization' }
+PPContext >> initialize [
+	stream := nil.
+]
+
+{ #category : 'initialization' }
+PPContext >> initializeFor: parser [
+	root := parser.
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> isEndOfLine [
+	^ stream isEndOfLine
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> isStartOfLine [
+	^ stream isStartOfLine
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> next [
+	^ stream next
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> next: anInteger [
+	^ stream next: anInteger
+]
+
+{ #category : 'failures' }
+PPContext >> noteFailure: aPPFailure [
+	"record the furthest failure encountered while parsing the input stream "
+
+	( furthestFailure isNil or: [ aPPFailure position > furthestFailure position ]) 
+		ifTrue: [ furthestFailure := aPPFailure ].
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> peek [
+	^ stream peek
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> peekTwice [
+	^ stream peekTwice
+]
+
+{ #category : '*PetitParser-Ruby-Parser' }
+PPContext >> percentStringEnd [
+	^ self globalAt: #percentStringEnd ifAbsent: nil
+]
+
+{ #category : '*PetitParser-Ruby-Parser' }
+PPContext >> percentStringStart: value [
+	| endValue |
+	endValue := value.
+	(value == $[) ifTrue: [ endValue := $] ].
+	(value == $() ifTrue: [ endValue := $) ].
+	(value == ${) ifTrue: [ endValue := $} ].
+
+	self globalAt: #percentStringStart put: value.
+	self globalAt: #percentStringEnd put: endValue
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> position [
+	^ stream position
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> position: anInteger [
+	^ stream position: anInteger
+]
+
+{ #category : 'initialization' }
+PPContext >> postCopy [
+	super postCopy.
+	globals := globals copy.
+	
+]
+
+{ #category : 'printing' }
+PPContext >> printOn: aStream [
+	super printOn: aStream.
+	aStream nextPut: $:.
+	aStream nextPut: $ .
+	stream printOn: aStream
+]
+
+{ #category : 'accessing-properties' }
+PPContext >> properties [
+	^ properties 
+]
+
+{ #category : 'accessing-properties' }
+PPContext >> propertyAt: aKey [
+	"Answer the property value associated with aKey."
+	
+	^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]
+]
+
+{ #category : 'accessing-properties' }
+PPContext >> 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 ]
+]
+
+{ #category : 'accessing-properties' }
+PPContext >> 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 ]
+]
+
+{ #category : 'accessing-properties' }
+PPContext >> 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
+]
+
+{ #category : 'memoization' }
+PPContext >> remember [
+	| memento |
+	memento := PPContextMemento new
+		stream: stream;
+		position: stream position;
+		yourself.
+		
+	self rememberProperties: memento.
+	^ memento
+]
+
+{ #category : 'memoization' }
+PPContext >> rememberProperties: aPPContextMemento [
+	properties ifNil: [ ^ self ].
+	
+	properties keysAndValuesDo: [ :key :value |
+		aPPContextMemento propertyAt: key put: value
+	].
+]
+
+{ #category : 'accessing-globals' }
+PPContext >> removeGlobal: aKey [
+	"Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
+	
+	^ self removeGlobal: aKey ifAbsent: [ self error: 'Property not found' ]
+]
+
+{ #category : 'accessing-globals' }
+PPContext >> removeGlobal: aKey ifAbsent: aBlock [
+	"Remove the global property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
+	
+	| answer |
+	globals isNil ifTrue: [ ^ aBlock value ].
+	answer := globals removeKey: aKey ifAbsent: aBlock.
+	globals isEmpty ifTrue: [ globals := nil ].
+	^ answer
+]
+
+{ #category : 'accessing-properties' }
+PPContext >> 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' ]
+]
+
+{ #category : 'accessing-properties' }
+PPContext >> 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
+]
+
+{ #category : 'initialization' }
+PPContext >> reset [
+	properties := nil.
+	globals := nil.
+]
+
+{ #category : 'memoization' }
+PPContext >> restore: aPPContextMemento [
+	aPPContextMemento stream == stream ifFalse: [ self error: 'Oops!' ].
+
+	stream position: aPPContextMemento position.
+	self restoreProperties: aPPContextMemento.
+]
+
+{ #category : 'memoization' }
+PPContext >> restoreProperties: aPPContextMemento [
+	aPPContextMemento stream == stream ifFalse: [ self error: 'Oops!' ].
+	
+	properties ifNil: [ ^ self ].
+	
+	properties keysDo: [ :key |
+		(aPPContextMemento hasProperty: key)
+			ifTrue: [ properties at: key put: (aPPContextMemento propertyAt: key) ]
+			ifFalse: [ properties removeKey: key  ]. 
+	].
+
+	aPPContextMemento keysAndValuesDo: [ :key :value |
+		properties at: key put: value
+	]
+]
+
+{ #category : 'acessing' }
+PPContext >> root [
+	^ root 
+]
+
+{ #category : 'memoization' }
+PPContext >> size [
+	^ stream size
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> skip: anInteger [ 
+	^ stream skip: anInteger 
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> skipTo: anObject [ 
+	^ stream skipTo: anObject 
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> skipToAll: aString [
+	"Set the access position of the receiver to be past the next occurrence of the subCollection. Answer whether subCollection is found.  No wildcards, and case does matter."
+	| pattern startMatch |
+	pattern := aString readStream.
+	startMatch := nil.
+	[ pattern atEnd ] whileFalse: 
+		[ stream atEnd ifTrue: [ ^ false ].
+		stream next = pattern next 
+			ifTrue: [ pattern position = 1 ifTrue: [ startMatch := stream position ] ]
+			ifFalse: 
+				[ pattern position: 0.
+				startMatch ifNotNil: 
+					[ stream position: startMatch.
+					startMatch := nil ] ] ].
+	^ true
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> skipToAnyOf: aCharacterSet [ 
+	"Set the access position of the receiver to be past the next occurrence of
+	a character in the character set. Answer whether a fitting character is found."
+
+	[stream atEnd]
+		whileFalse: [ (aCharacterSet includes: stream next) ifTrue: [^true]].
+	^false
+]
+
+{ #category : 'acessing' }
+PPContext >> stream [
+	^ stream
+]
+
+{ #category : 'acessing' }
+PPContext >> stream: aStream [
+	stream := aStream.
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> uncheckedPeek [
+	^ stream uncheckedPeek
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> upTo: anObject [
+	^ stream upTo: anObject
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> upToAll: whatever [
+	^ stream upToAll: whatever
+]
+
+{ #category : 'stream mimicry' }
+PPContext >> upToAnyOf: whatever [
+	^ stream upToAnyOf: whatever
+]
diff --git a/software/PetitParser/PPContext.extension.st b/software/PetitParser/PPContext.extension.st
new file mode 100644
index 0000000..017cc48
--- /dev/null
+++ b/software/PetitParser/PPContext.extension.st
@@ -0,0 +1,28 @@
+Extension { #name : 'PPContext' }
+
+{ #category : '*PetitParser-Ruby-Parser' }
+PPContext >> heredocId [
+	^ self globalAt: #heredocId ifAbsent: nil
+]
+
+{ #category : '*PetitParser-Ruby-Parser' }
+PPContext >> heredocId: value [
+	self globalAt: #heredocId put: value
+]
+
+{ #category : '*PetitParser-Ruby-Parser' }
+PPContext >> percentStringEnd [
+	^ self globalAt: #percentStringEnd ifAbsent: nil
+]
+
+{ #category : '*PetitParser-Ruby-Parser' }
+PPContext >> percentStringStart: value [
+	| endValue |
+	endValue := value.
+	(value == $[) ifTrue: [ endValue := $] ].
+	(value == $() ifTrue: [ endValue := $) ].
+	(value == ${) ifTrue: [ endValue := $} ].
+
+	self globalAt: #percentStringStart put: value.
+	self globalAt: #percentStringEnd put: endValue
+]
diff --git a/software/PetitParser/PPContextMemento.class.st b/software/PetitParser/PPContextMemento.class.st
new file mode 100644
index 0000000..997ab4a
--- /dev/null
+++ b/software/PetitParser/PPContextMemento.class.st
@@ -0,0 +1,137 @@
+"
+I am an implementation of the memento design pattern.
+
+My goal is to remember the state of a PPContext to eventually be able to restore its state later.
+
+I should be instantiated using PPContext>>#memorize method.
+
+A PPContext can restore its state by providing the memento to PPContext>>#restore:.
+"
+Class {
+	#name : 'PPContextMemento',
+	#superclass : 'Object',
+	#instVars : [
+		'stream',
+		'position',
+		'properties'
+	],
+	#category : 'PetitParser-Core'
+}
+
+{ #category : 'comparing' }
+PPContextMemento >> = anObject [
+	
+	(self == anObject) ifTrue: [ ^ true ].
+	(anObject class = PPContextMemento) ifFalse: [ ^ false ].
+	
+	(anObject stream == stream) ifFalse: [ ^ false ].
+	(anObject position == position) ifFalse: [ ^ false ].
+	
+	(self propertiesSize == anObject propertiesSize) ifFalse: [ ^ false ].
+
+	self keysAndValuesDo: [ :key :value |
+		(anObject hasProperty: key) ifFalse: [ ^ false ].
+		((anObject propertyAt: key) = value) ifFalse: [ ^ false ]. 
+ 	].
+	
+	^ true.
+
+]
+
+{ #category : 'accessing - properties' }
+PPContextMemento >> hasProperty: aKey [
+	"Test if the property aKey is present."
+	
+	^ properties notNil and: [ properties includesKey: aKey ]
+]
+
+{ #category : 'comparing' }
+PPContextMemento >> hash [
+	^ (position hash bitXor: stream hash) bitXor: properties hash.
+]
+
+{ #category : 'accessing - properties' }
+PPContextMemento >> keysAndValuesDo: aBlock [
+	properties ifNil: [ ^ self ].
+	properties keysAndValuesDo: [ :key :value | aBlock value: key value: value copy ] 
+]
+
+{ #category : 'accessing' }
+PPContextMemento >> position [
+	^ position
+]
+
+{ #category : 'accessing' }
+PPContextMemento >> position: anInteger [
+	position := anInteger 
+]
+
+{ #category : 'accessing - properties' }
+PPContextMemento >> propertiesSize [
+	properties ifNil: [ ^ 0 ].
+	^ properties size.
+]
+
+{ #category : 'accessing - properties' }
+PPContextMemento >> propertyAt: aKey [
+	"Answer the property value associated with aKey."
+	
+	^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]
+]
+
+{ #category : 'accessing - properties' }
+PPContextMemento >> 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 includesKey: aKey) ifTrue: [ 
+				^ (properties at: aKey) copy
+			].
+			^ aBlock value
+		]
+]
+
+{ #category : 'accessing - properties' }
+PPContextMemento >> 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 ]
+]
+
+{ #category : 'accessing - properties' }
+PPContextMemento >> 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 copy)
+]
+
+{ #category : 'accessing - properties' }
+PPContextMemento >> 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' ]
+]
+
+{ #category : 'accessing - properties' }
+PPContextMemento >> 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
+]
+
+{ #category : 'accessing' }
+PPContextMemento >> stream [
+	^ stream
+]
+
+{ #category : 'accessing' }
+PPContextMemento >> stream: aStream [
+	stream := aStream
+]
diff --git a/software/PetitParser/PPDelegateParser.class.st b/software/PetitParser/PPDelegateParser.class.st
new file mode 100644
index 0000000..ce74c2f
--- /dev/null
+++ b/software/PetitParser/PPDelegateParser.class.st
@@ -0,0 +1,34 @@
+"
+A parser that delegates to another parser.
+
+Instance Variables:
+	parser	<PPParser>	The parser to delegate to.
+"
+Class {
+	#name : 'PPDelegateParser',
+	#superclass : 'PPParser',
+	#instVars : [
+		'parser'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'instance creation' }
+PPDelegateParser class >> on: aParser [
+	^ self new setParser: aParser
+]
+
+{ #category : 'accessing' }
+PPDelegateParser >> children [
+	^ Array with: parser
+]
+
+{ #category : 'parsing' }
+PPDelegateParser >> parseOn: aPPContext [
+	^ parser parseOn: aPPContext
+]
+
+{ #category : 'initialization' }
+PPDelegateParser >> setParser: aParser [
+	parser := aParser
+]
diff --git a/software/PetitParser/PPEndOfFileParser.class.st b/software/PetitParser/PPEndOfFileParser.class.st
new file mode 100644
index 0000000..c268ee3
--- /dev/null
+++ b/software/PetitParser/PPEndOfFileParser.class.st
@@ -0,0 +1,29 @@
+"
+A PPEndOfFileParser is parser that will will return true if the stream position is at the end, returns failure otherwise.
+
+The diffirenece between PPEndOfFIleParser and PPEndOfInputParser is:
+ - PPEndOfFileParser can be created using #eof asParser
+ - PPEndOfInputParser can be created by using parser end
+ - PPEndOfFileParser does not delegate to any other parser
+ - PPEndOfInputParser parsers its delegate and then decides if the input is at the end.
+
+The PPEndOfFileParser can be used to accept some input only if it is at the end of the input, e.g:
+
+   ('a' asParser, #eof asParser) parse: 'a'
+   ('a' asParser, #eof asParser) parse: 'aa'
+
+"
+Class {
+	#name : 'PPEndOfFileParser',
+	#superclass : 'PPParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'parsing' }
+PPEndOfFileParser >> parseOn: aPPContext [
+	(aPPContext atEnd) ifFalse:
+	[
+		^ PPFailure message: 'end of input expected' context: aPPContext.
+	].
+	^ #'end-of-input'
+]
diff --git a/software/PetitParser/PPEndOfInputParser.class.st b/software/PetitParser/PPEndOfInputParser.class.st
new file mode 100644
index 0000000..650377c
--- /dev/null
+++ b/software/PetitParser/PPEndOfInputParser.class.st
@@ -0,0 +1,27 @@
+"
+A parser that succeeds only at the end of the input stream.
+"
+Class {
+	#name : 'PPEndOfInputParser',
+	#superclass : 'PPDelegateParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'operators' }
+PPEndOfInputParser >> end [
+	^ self
+]
+
+{ #category : 'parsing' }
+PPEndOfInputParser >> parseOn: aPPContext [
+	| memento result |
+	memento := aPPContext remember.
+	result := parser parseOn: aPPContext.
+	(result isPetitFailure or: [ aPPContext stream atEnd ])
+		ifTrue: [ ^ result ].
+	result := PPFailure
+		message: 'end of input expected'
+		context: aPPContext.
+	aPPContext restore: memento.
+	^ result
+]
diff --git a/software/PetitParser/PPEndOfLineParser.class.st b/software/PetitParser/PPEndOfLineParser.class.st
new file mode 100644
index 0000000..6a12793
--- /dev/null
+++ b/software/PetitParser/PPEndOfLineParser.class.st
@@ -0,0 +1,16 @@
+"
+A PPEndOfLineParser is a parser that does not fail, if the stream position is at the end of a line. It does not consume anything.
+"
+Class {
+	#name : 'PPEndOfLineParser',
+	#superclass : 'PPParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'parsing' }
+PPEndOfLineParser >> parseOn: aPPContext [
+	(aPPContext isEndOfLine) ifTrue: [ 
+		^ #endOfLine
+	].
+	^ PPFailure message: 'End of line expected' context: aPPContext at: aPPContext position
+]
diff --git a/software/PetitParser/PPEpsilonParser.class.st b/software/PetitParser/PPEpsilonParser.class.st
new file mode 100644
index 0000000..1a3dd4f
--- /dev/null
+++ b/software/PetitParser/PPEpsilonParser.class.st
@@ -0,0 +1,13 @@
+"
+A parser that consumes nothing and always succeeds.
+"
+Class {
+	#name : 'PPEpsilonParser',
+	#superclass : 'PPParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'parsing' }
+PPEpsilonParser >> parseOn: aStream [
+	^ nil
+]
diff --git a/software/PetitParser/PPExpressionParser.class.st b/software/PetitParser/PPExpressionParser.class.st
new file mode 100644
index 0000000..5a476de
--- /dev/null
+++ b/software/PetitParser/PPExpressionParser.class.st
@@ -0,0 +1,155 @@
+"
+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.
+"
+Class {
+	#name : 'PPExpressionParser',
+	#superclass : 'PPDelegateParser',
+	#instVars : [
+		'operators'
+	],
+	#category : 'PetitParser-Tools'
+}
+
+{ #category : 'private' }
+PPExpressionParser >> build: aParser left: aChoiceParser [
+	^ (aParser separatedBy: aChoiceParser) foldLeft: [ :a :op :b | op first value: a value: op second value: b ]
+]
+
+{ #category : 'private' }
+PPExpressionParser >> build: aParser postfix: aChoiceParser [
+	^ aParser , aChoiceParser star map: [ :term :ops | ops inject: term into: [ :result :operator | operator first value: result value: operator second ] ]
+]
+
+{ #category : 'private' }
+PPExpressionParser >> build: aParser prefix: aChoiceParser [
+	^ aChoiceParser star , aParser map: [ :ops :term | ops reverse inject: term into: [ :result :operator | operator first value: operator second value: result ] ]
+]
+
+{ #category : 'private' }
+PPExpressionParser >> build: aParser right: aChoiceParser [
+	^ (aParser separatedBy: aChoiceParser) foldRight: [ :a :op :b | op first value: a value: op second value: b ]
+]
+
+{ #category : 'private' }
+PPExpressionParser >> 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 ]) ] ]) ] ]
+]
+
+{ #category : 'private' }
+PPExpressionParser >> buildSelectors [
+	^ #(build:prefix: build:postfix: build:right: build:left:)
+]
+
+{ #category : 'specifying' }
+PPExpressionParser >> group: aOneArgumentBlock [
+	"Defines a priority group by evaluating aOneArgumentBlock."
+	
+	operators := Dictionary new.
+	parser := [ 
+		aOneArgumentBlock value: self.
+	 	self buildOn: parser ]
+			ensure: [ operators := nil ]
+]
+
+{ #category : 'specifying' }
+PPExpressionParser >> 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
+]
+
+{ #category : 'private' }
+PPExpressionParser >> 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)
+]
+
+{ #category : 'specifying' }
+PPExpressionParser >> 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
+]
+
+{ #category : 'specifying' }
+PPExpressionParser >> 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
+]
+
+{ #category : 'specifying' }
+PPExpressionParser >> 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
+]
+
+{ #category : 'specifying' }
+PPExpressionParser >> term: aParser [
+	"Defines the initial term aParser of the receiver."
+	
+	parser isNil
+		ifTrue: [ parser := aParser ]
+		ifFalse: [ self error: 'Unable to redefine the term.' ]
+]
diff --git a/software/PetitParser/PPFailingParser.class.st b/software/PetitParser/PPFailingParser.class.st
new file mode 100644
index 0000000..c05c162
--- /dev/null
+++ b/software/PetitParser/PPFailingParser.class.st
@@ -0,0 +1,43 @@
+"
+A parser that consumes nothing and always fails.
+
+Instance Variables:
+	message <String>	The failure message.
+
+"
+Class {
+	#name : 'PPFailingParser',
+	#superclass : 'PPParser',
+	#instVars : [
+		'message'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'instance creation' }
+PPFailingParser class >> message: aString [
+	^ self new setMessage: aString
+]
+
+{ #category : 'accessing' }
+PPFailingParser >> message [
+	"Answer the error message of the receiving parser."
+
+	^ message
+]
+
+{ #category : 'pp-context' }
+PPFailingParser >> parseOn: aPPContext [
+	^ PPFailure message: message context: aPPContext
+]
+
+{ #category : 'printing' }
+PPFailingParser >> printNameOn: aStream [
+	super printNameOn: aStream.
+	aStream nextPutAll: ', '; print: message
+]
+
+{ #category : 'initialization' }
+PPFailingParser >> setMessage: aString [
+	message := aString
+]
diff --git a/software/PetitParser/PPFailure.class.st b/software/PetitParser/PPFailure.class.st
new file mode 100644
index 0000000..d6a5fed
--- /dev/null
+++ b/software/PetitParser/PPFailure.class.st
@@ -0,0 +1,95 @@
+"
+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.
+
+"
+Class {
+	#name : 'PPFailure',
+	#superclass : 'Object',
+	#instVars : [
+		'message',
+		'context',
+		'position'
+	],
+	#category : 'PetitParser-Core'
+}
+
+{ #category : 'instance creation' }
+PPFailure class >> message: aString [
+	^ self basicNew initializeMessage: aString 
+]
+
+{ #category : 'instance creation' }
+PPFailure class >> message: aString at: anInteger [
+	"One should not use this method if the furthest failure is supposed to be reported correctly"
+	^ self basicNew initializeMessage: aString at: anInteger
+]
+
+{ #category : 'instance creation' }
+PPFailure class >> message: aString context: aPPContext [
+	^ self basicNew initializeMessage: aString context: aPPContext
+]
+
+{ #category : 'instance creation' }
+PPFailure class >> message: aString context: aPPContext at: position [
+	^ self basicNew initializeMessage: aString context: aPPContext position: position
+]
+
+{ #category : 'initialization' }
+PPFailure >> initializeMessage: aString [	
+	message := aString.
+
+]
+
+{ #category : 'initialization' }
+PPFailure >> initializeMessage: aString at: anInteger [
+	"One should not use this method if the furthest failure is supposed to be reported correctly"
+	message := aString.
+	position := anInteger.
+]
+
+{ #category : 'initialization' }
+PPFailure >> initializeMessage: aString context: aPPContext [
+	self initializeMessage: aString context:  aPPContext position: aPPContext position
+]
+
+{ #category : 'initialization' }
+PPFailure >> initializeMessage: aString context: aPPContext position: anInteger [
+	message := aString.
+	context := aPPContext.
+	position := anInteger.
+	
+	"record the furthest failure encountered while parsing the input stream "
+	aPPContext noteFailure: self.	
+]
+
+{ #category : 'testing' }
+PPFailure >> isPetitFailure [
+	"I am the only class that should implement this method to return true."
+
+	^ true
+]
+
+{ #category : 'accessing' }
+PPFailure >> message [
+	"Answer a human readable error message of this parse failure."
+	
+	^ message
+]
+
+{ #category : 'accessing' }
+PPFailure >> position [
+	"Answer the position in the source string that caused this parse failure."
+
+	^ position
+]
+
+{ #category : 'printing' }
+PPFailure >> printOn: aStream [
+	aStream 
+		nextPutAll: (self message ifNil: ['<message not specified>']); 
+		nextPutAll: ' at '; print: self position
+]
diff --git a/software/PetitParser/PPFlattenParser.class.st b/software/PetitParser/PPFlattenParser.class.st
new file mode 100644
index 0000000..ffe84c6
--- /dev/null
+++ b/software/PetitParser/PPFlattenParser.class.st
@@ -0,0 +1,22 @@
+"
+A parser that answers a flat copy of the range my delegate parses.
+"
+Class {
+	#name : 'PPFlattenParser',
+	#superclass : 'PPDelegateParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'private' }
+PPFlattenParser >> on: aCollection start: aStartInteger stop: aStopInteger value: anObject [
+	^ aCollection copyFrom: aStartInteger to: aStopInteger
+]
+
+{ #category : 'parsing' }
+PPFlattenParser >> parseOn: aPPContext [
+	| start element |
+	start := aPPContext position.
+	element := parser parseOn: aPPContext.
+	element isPetitFailure ifTrue: [ ^ element ].
+	^ self on: aPPContext stream collection start: start + 1 stop: aPPContext position value: element
+]
diff --git a/software/PetitParser/PPGreedyRepeatingParser.class.st b/software/PetitParser/PPGreedyRepeatingParser.class.st
new file mode 100644
index 0000000..85822dc
--- /dev/null
+++ b/software/PetitParser/PPGreedyRepeatingParser.class.st
@@ -0,0 +1,46 @@
+"
+A greedy repeating parser, commonly seen in regular expression implementations. It aggressively consumes as much input as possible and then backtracks to meet the 'limit' condition.
+
+This class essentially implements the iterative version of the following recursive parser composition:
+
+	| parser |
+	parser := PPChoiceParser new.
+	parser setParsers: (Array
+		with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])
+		with: (limit and ==> [ :each | OrderedCollection new ])).
+	^ parser ==> [ :rest | rest asArray ]
+"
+Class {
+	#name : 'PPGreedyRepeatingParser',
+	#superclass : 'PPLimitedRepeatingParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'parsing' }
+PPGreedyRepeatingParser >> parseOn: aPPContext [
+	| memento element elements positions |
+	memento := aPPContext remember.
+	elements := OrderedCollection new.
+	[ elements size < min ] whileTrue: [ 
+		(element := parser parseOn: aPPContext) isPetitFailure ifTrue: [ 
+			aPPContext restore: memento.
+			^ element ].
+		elements addLast: element ].
+	positions := OrderedCollection with: aPPContext remember.
+	[ elements size < max and: [ (element := parser parseOn: aPPContext) isPetitFailure not ] ] whileTrue: [
+		elements addLast: element.
+		positions addLast: aPPContext remember ].
+	[ positions isEmpty ] whileFalse: [
+		aPPContext restore: positions last.
+		element := limit parseOn: aPPContext.
+		element isPetitFailure ifFalse: [
+			aPPContext restore: positions last.
+			^ elements asArray ].
+		elements isEmpty ifTrue: [
+			aPPContext restore: memento.
+			^ element ].
+		elements removeLast.
+		positions removeLast ].
+	aPPContext restore: memento.
+	^ PPFailure message: 'overflow' context: aPPContext at: memento position
+]
diff --git a/software/PetitParser/PPLazyRepeatingParser.class.st b/software/PetitParser/PPLazyRepeatingParser.class.st
new file mode 100644
index 0000000..31aad76
--- /dev/null
+++ b/software/PetitParser/PPLazyRepeatingParser.class.st
@@ -0,0 +1,39 @@
+"
+A lazy repeating parser, commonly seen in regular expression implementations. It limits its consumption to meet the 'limit' condition as early as possible.
+
+This class essentially implements the iterative version of the following recursive parser composition:
+
+	| parser |
+	parser := PPChoiceParser new.
+	parser setParsers: (Array
+		with: (limit and ==> [ :each | OrderedCollection new ])
+		with: (self , parser map: [ :each :rest | rest addFirst: each; yourself ])).
+	^ parser ==> [ :rest | rest asArray ]
+"
+Class {
+	#name : 'PPLazyRepeatingParser',
+	#superclass : 'PPLimitedRepeatingParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'parsing' }
+PPLazyRepeatingParser >> parseOn: aPPContext [
+	| memento element elements |
+	memento := aPPContext remember.
+	elements := OrderedCollection new.
+	[ elements size < min ] whileTrue: [
+		(element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
+			aPPContext restore: memento.
+			^ element ].
+		elements addLast: element ].
+	[ self matchesLimitOn: aPPContext ] whileFalse: [
+		elements size < max ifFalse: [
+			aPPContext restore: memento.
+			^ PPFailure message: 'overflow' context: aPPContext at: memento position ].
+		element := parser parseOn: aPPContext.
+		element isPetitFailure ifTrue: [
+			aPPContext restore: memento.
+			^ element ].
+		elements addLast: element ].
+	^ elements asArray
+]
diff --git a/software/PetitParser/PPLimitedChoiceParser.class.st b/software/PetitParser/PPLimitedChoiceParser.class.st
new file mode 100644
index 0000000..e38d4a3
--- /dev/null
+++ b/software/PetitParser/PPLimitedChoiceParser.class.st
@@ -0,0 +1,72 @@
+"
+A PPLimitedChoiceParser is similar to the choice parser except for the fact, that limit must pass if one of the choices passes. This is similar strategy as with the PPLimitedRepeatingParsers.
+
+This way, one can implement choices that successfully parse this (if limit is filled with 'a'):
+
+('aa' // 'a') 'a' parse: 'aa'
+
+The limit can be automatically filled using elements from either follow or next set (see methods  PPParser>>followSets or PPParser>>nextSets).
+
+Limit is by default epsilon and therefore it behaves as an ordinary ordered choice.
+
+Instance Variables
+	limit:		<Object>
+
+limit
+	- xxxxx
+
+"
+Class {
+	#name : 'PPLimitedChoiceParser',
+	#superclass : 'PPChoiceParser',
+	#instVars : [
+		'limit'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'operators' }
+PPLimitedChoiceParser >> // aRule [ 
+	^ self copyWith: aRule
+]
+
+{ #category : 'initialization' }
+PPLimitedChoiceParser >> initialize [
+	limit := nil asParser
+]
+
+{ #category : 'accessing' }
+PPLimitedChoiceParser >> limit [
+	
+	^ limit
+]
+
+{ #category : 'accessing' }
+PPLimitedChoiceParser >> limit: anObject [
+	
+	limit := anObject
+]
+
+{ #category : 'parsing' }
+PPLimitedChoiceParser >> parseOn: aPPContext [
+	"This is optimized code that avoids unnecessary block activations, do not change. When all choices fail, the last failure is answered."
+
+	| element limitResult memento |
+	"self halt."
+	1 to: parsers size do: [ :index |
+		memento := aPPContext remember.
+		
+		element := (parsers at: index)
+			parseOn: aPPContext.
+		
+		(element isPetitFailure not) ifTrue: [ 
+			"check limit"
+			limitResult := limit parseOn: aPPContext.
+			limitResult isPetitFailure ifTrue: [ 
+				element := PPFailure message: 'limit failed' at: aPPContext position .
+				aPPContext restore: memento.
+			] ifFalse: [ ^ element ].
+		].
+	].	
+	^ element
+]
diff --git a/software/PetitParser/PPLimitedRepeatingParser.class.st b/software/PetitParser/PPLimitedRepeatingParser.class.st
new file mode 100644
index 0000000..c1374c3
--- /dev/null
+++ b/software/PetitParser/PPLimitedRepeatingParser.class.st
@@ -0,0 +1,45 @@
+"
+An abstract parser that repeatedly parses between 'min' and 'max' instances of my delegate and that requires the input to be completed with a specified parser 'limit'. Subclasses provide repeating behavior as typically seen in regular expression implementations (non-blind).
+
+Instance Variables:
+	limit	<PPParser>	The parser to complete the input with.
+"
+Class {
+	#name : 'PPLimitedRepeatingParser',
+	#superclass : 'PPRepeatingParser',
+	#instVars : [
+		'limit'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'instance creation' }
+PPLimitedRepeatingParser class >> on: aParser limit: aLimitParser [
+	^ (self on: aParser) setLimit: aLimitParser
+]
+
+{ #category : 'accessing' }
+PPLimitedRepeatingParser >> children [
+	^ Array with: parser with: limit
+]
+
+{ #category : 'accessing' }
+PPLimitedRepeatingParser >> limit [
+	"Answer the parser that limits (or ends) this repetition."
+	
+	^ limit
+]
+
+{ #category : 'parsing' }
+PPLimitedRepeatingParser >> matchesLimitOn: aPPContext [
+	| element position |
+	position := aPPContext remember.
+	element := limit parseOn: aPPContext.
+	aPPContext restore: position.
+	^ element isPetitFailure not
+]
+
+{ #category : 'initialization' }
+PPLimitedRepeatingParser >> setLimit: aParser [
+	limit := aParser
+]
diff --git a/software/PetitParser/PPListParser.class.st b/software/PetitParser/PPListParser.class.st
new file mode 100644
index 0000000..a3e5019
--- /dev/null
+++ b/software/PetitParser/PPListParser.class.st
@@ -0,0 +1,58 @@
+"
+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.
+
+"
+Class {
+	#name : 'PPListParser',
+	#superclass : 'PPParser',
+	#instVars : [
+		'parsers'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'instance creation' }
+PPListParser class >> with: aParser [
+	^ self withAll: (Array with: aParser)
+]
+
+{ #category : 'instance creation' }
+PPListParser class >> with: aFirstParser with: aSecondParser [
+	^ self withAll: (Array with: aFirstParser with: aSecondParser)
+]
+
+{ #category : 'instance creation' }
+PPListParser class >> withAll: aCollection [
+	^ self basicNew initialize;
+		setParsers: aCollection
+]
+
+{ #category : 'accessing' }
+PPListParser >> children [
+	^ parsers
+]
+
+{ #category : 'copying' }
+PPListParser >> copyWith: aParser [
+	^ self species withAll: (parsers copyWith: aParser)
+]
+
+{ #category : 'initialization' }
+PPListParser >> initialize [
+	super initialize.
+	self setParsers: #()
+]
+
+{ #category : 'copying' }
+PPListParser >> postCopy [
+	super postCopy.
+	parsers := parsers copy
+]
+
+{ #category : 'initialization' }
+PPListParser >> setParsers: aCollection [
+	parsers := aCollection asArray
+]
diff --git a/software/PetitParser/PPLiteralObjectParser.class.st b/software/PetitParser/PPLiteralObjectParser.class.st
new file mode 100644
index 0000000..4188e26
--- /dev/null
+++ b/software/PetitParser/PPLiteralObjectParser.class.st
@@ -0,0 +1,28 @@
+"
+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.
+"
+Class {
+	#name : 'PPLiteralObjectParser',
+	#superclass : 'PPLiteralParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'operators' }
+PPLiteralObjectParser >> 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
+]
+
+{ #category : 'operators' }
+PPLiteralObjectParser >> negate [
+	^ (PPPredicateObjectParser expect: literal message: message) negate
+]
+
+{ #category : 'parsing' }
+PPLiteralObjectParser >> parseOn: aPPContext [
+	^ (aPPContext stream atEnd not and: [ literal = aPPContext stream uncheckedPeek ])
+		ifFalse: [ PPFailure message: message context: aPPContext ]
+		ifTrue: [ aPPContext next ]
+]
diff --git a/software/PetitParser/PPLiteralParser.class.st b/software/PetitParser/PPLiteralParser.class.st
new file mode 100644
index 0000000..c1f7e7a
--- /dev/null
+++ b/software/PetitParser/PPLiteralParser.class.st
@@ -0,0 +1,61 @@
+"
+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.
+
+
+"
+Class {
+	#name : 'PPLiteralParser',
+	#superclass : 'PPParser',
+	#instVars : [
+		'literal',
+		'message'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'instance creation' }
+PPLiteralParser class >> on: anObject [
+	^ self on: anObject message: anObject printString , ' expected'
+]
+
+{ #category : 'instance creation' }
+PPLiteralParser class >> on: anObject message: aString [
+	^ self new initializeOn: anObject message: aString
+]
+
+{ #category : 'operators' }
+PPLiteralParser >> caseInsensitive [
+	"Answer a parser that can parse the receiver case-insensitive."
+	
+	self subclassResponsibility
+]
+
+{ #category : 'initialization' }
+PPLiteralParser >> initializeOn: anObject message: aString [
+	literal := anObject.
+	message := aString
+]
+
+{ #category : 'accessing' }
+PPLiteralParser >> literal [
+	"Answer the parsed literal."
+
+	^ literal
+]
+
+{ #category : 'accessing' }
+PPLiteralParser >> message [
+	"Answer the failure message."
+	
+	^ message
+]
+
+{ #category : 'printing' }
+PPLiteralParser >> printNameOn: aStream [
+	super printNameOn: aStream.
+	aStream nextPutAll: ', '; print: literal
+]
diff --git a/software/PetitParser/PPLiteralSequenceParser.class.st b/software/PetitParser/PPLiteralSequenceParser.class.st
new file mode 100644
index 0000000..72fe468
--- /dev/null
+++ b/software/PetitParser/PPLiteralSequenceParser.class.st
@@ -0,0 +1,42 @@
+"
+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.
+"
+Class {
+	#name : 'PPLiteralSequenceParser',
+	#superclass : 'PPLiteralParser',
+	#instVars : [
+		'size'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'operators' }
+PPLiteralSequenceParser >> 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
+]
+
+{ #category : 'initialization' }
+PPLiteralSequenceParser >> initializeOn: anObject message: aString [
+	super initializeOn: anObject message: aString.
+	size := literal size
+]
+
+{ #category : 'parsing' }
+PPLiteralSequenceParser >> parseOn: aPPContext [
+	| memento result |
+	memento := aPPContext remember.
+	result := aPPContext next: size.
+	literal = result ifTrue: [ ^ result ].
+	aPPContext restore: memento.
+	^ PPFailure message: message context: aPPContext
+]
+
+{ #category : 'accessing' }
+PPLiteralSequenceParser >> size [
+	"Answer the sequence size of the receiver."
+
+	^ size
+]
diff --git a/software/PetitParser/PPMemento.class.st b/software/PetitParser/PPMemento.class.st
new file mode 100644
index 0000000..b28ce2d
--- /dev/null
+++ b/software/PetitParser/PPMemento.class.st
@@ -0,0 +1,60 @@
+"
+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.
+	
+"
+Class {
+	#name : 'PPMemento',
+	#superclass : 'Object',
+	#instVars : [
+		'result',
+		'count',
+		'context'
+	],
+	#category : 'PetitParser-Core'
+}
+
+{ #category : 'instance creation' }
+PPMemento class >> new [
+	^ self basicNew initialize
+]
+
+{ #category : 'accessing' }
+PPMemento >> contextMemento [
+	^ context
+]
+
+{ #category : 'accessing' }
+PPMemento >> contextMemento: aPPContextMemento [
+	context  := aPPContextMemento 
+
+]
+
+{ #category : 'accessing-readonly' }
+PPMemento >> count [
+	^ count
+]
+
+{ #category : 'actions' }
+PPMemento >> increment [
+	count := count + 1
+]
+
+{ #category : 'initialization' }
+PPMemento >> initialize [
+	count := 0
+	
+]
+
+{ #category : 'accessing' }
+PPMemento >> result [
+	^ result
+]
+
+{ #category : 'accessing' }
+PPMemento >> result: anObject [
+	result := anObject
+]
diff --git a/software/PetitParser/PPMemoizedParser.class.st b/software/PetitParser/PPMemoizedParser.class.st
new file mode 100644
index 0000000..3a0adcb
--- /dev/null
+++ b/software/PetitParser/PPMemoizedParser.class.st
@@ -0,0 +1,60 @@
+"
+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.
+
+"
+Class {
+	#name : 'PPMemoizedParser',
+	#superclass : 'PPDelegateParser',
+	#instVars : [
+		'buffer',
+		'identifier'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'parsing' }
+PPMemoizedParser >> check: aPPContext [
+	(identifier == aPPContext identifier)
+		ifFalse: [ self reset: aPPContext ].
+]
+
+{ #category : 'operators' }
+PPMemoizedParser >> memoized [
+	"Ther is no point in memoizing more than once."
+
+	^ self
+]
+
+{ #category : 'operators' }
+PPMemoizedParser >> nonMemoized [
+	^ parser
+]
+
+{ #category : 'parsing' }
+PPMemoizedParser >> parseOn: aPPContext [
+	| memento contextMemento  aStream |
+	"TODO: JK memoizing needs review!"
+	self check: aPPContext.
+	contextMemento := aPPContext remember.
+	memento := (buffer at: contextMemento ifAbsentPut: [ PPMemento new ]).
+	
+	memento contextMemento isNil
+		ifTrue: [
+			aStream := aPPContext stream.
+			memento result: (aStream size - aStream position + 2 < memento count
+				ifTrue: [ PPFailure message: 'overflow' context: aPPContext ]
+				ifFalse: [ memento increment. parser parseOn: aPPContext ]).
+			memento contextMemento: aPPContext remember ]
+		ifFalse: [ aPPContext restore: memento contextMemento ].
+	^ memento result.
+]
+
+{ #category : 'parsing' }
+PPMemoizedParser >> reset: aPPContext [
+	buffer := Dictionary new.
+	identifier := aPPContext identifier.
+]
diff --git a/software/PetitParser/PPNotParser.class.st b/software/PetitParser/PPNotParser.class.st
new file mode 100644
index 0000000..09c6d08
--- /dev/null
+++ b/software/PetitParser/PPNotParser.class.st
@@ -0,0 +1,18 @@
+"
+The not-predicate, a parser that succeeds whenever its delegate does not, but consumes no input [Parr 1994, 1995].
+"
+Class {
+	#name : 'PPNotParser',
+	#superclass : 'PPDelegateParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'parsing' }
+PPNotParser >> parseOn: aPPContext [
+	| element memento |
+	memento := aPPContext remember.
+	element := parser parseOn: aPPContext.
+	aPPContext restore: memento.
+	^ element isPetitFailure
+		ifFalse: [ PPFailure message: '' context: aPPContext ]
+]
diff --git a/software/PetitParser/PPOptionalParser.class.st b/software/PetitParser/PPOptionalParser.class.st
new file mode 100644
index 0000000..71dec04
--- /dev/null
+++ b/software/PetitParser/PPOptionalParser.class.st
@@ -0,0 +1,15 @@
+"
+A parser that optionally parsers its delegate, or answers nil.
+"
+Class {
+	#name : 'PPOptionalParser',
+	#superclass : 'PPDelegateParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'parsing' }
+PPOptionalParser >> parseOn: aPPContext [
+	| element |
+	element := parser parseOn: aPPContext.
+	^ element isPetitFailure ifFalse: [ element ]
+]
diff --git a/software/PetitParser/PPParser.class.st b/software/PetitParser/PPParser.class.st
new file mode 100644
index 0000000..ea04327
--- /dev/null
+++ b/software/PetitParser/PPParser.class.st
@@ -0,0 +1,710 @@
+"
+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.
+
+"
+Class {
+	#name : 'PPParser',
+	#superclass : 'Object',
+	#instVars : [
+		'properties'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'instance creation' }
+PPParser class >> named: aString [
+	^ self new name: aString
+]
+
+{ #category : 'instance creation' }
+PPParser class >> new [
+	^ self basicNew initialize
+]
+
+{ #category : 'operators' }
+PPParser >> , aParser [ 
+	"Answer a new parser that parses the receiver followed by aParser."
+
+	^ PPSequenceParser with: self with: aParser
+]
+
+{ #category : 'operators' }
+PPParser >> / aParser [ 
+	"Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice)."
+	
+	^ PPChoiceParser with: self with: aParser
+]
+
+{ #category : 'operators' }
+PPParser >> // aParser [ 
+	"
+		Answer a new parser that parses the receiver, if the receiver fails try with aParser (ordered-choice).
+		If the receiver passes, limit must pass as well.
+	"
+	
+	^ PPLimitedChoiceParser with: self with: aParser
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> ==> aBlock [
+	"Answer a new parser that performs aBlock as action handler on success."
+
+	^ PPActionParser on: self block: aBlock
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> >=> 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
+]
+
+{ #category : 'enumerating' }
+PPParser >> allParsers [
+	"Answer all the parse nodes of the receiver."
+
+	| result |
+	result := OrderedCollection new.
+	self allParsersDo: [ :parser | result addLast: parser ].
+	^ result
+]
+
+{ #category : 'enumerating' }
+PPParser >> allParsersDo: aBlock [
+	"Iterate over all the parse nodes of the receiver."
+
+	self allParsersDo: aBlock seen: IdentitySet new
+]
+
+{ #category : 'enumerating' }
+PPParser >> allParsersDo: aBlock seen: aSet [
+	"Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."
+
+	(aSet includes: self)
+		ifTrue: [ ^ self ].
+	aSet add: self.
+	aBlock value: self.
+	self children
+		do: [ :each | each allParsersDo: aBlock seen: aSet ]
+]
+
+{ #category : 'operators' }
+PPParser >> and [
+	"Answer a new parser (logical and-predicate) that succeeds whenever the receiver does, but never consumes input."
+
+	^ PPAndParser on: self
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> answer: anObject [
+	"Answer a new parser that always returns anObject from a successful parse."
+
+	^ self ==> [ :nodes | anObject ]
+]
+
+{ #category : 'converting' }
+PPParser >> asParser [
+	"Answer the receiving parser."
+	
+	^ self
+]
+
+{ #category : 'accessing' }
+PPParser >> child [
+	self assert: (self children size == 1).
+	^ self children first
+]
+
+{ #category : 'accessing' }
+PPParser >> children [
+	"Answer a set of child parsers that could follow the receiver."
+
+	^ #()
+]
+
+{ #category : 'operators' }
+PPParser >> 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)
+]
+
+{ #category : 'operators-convenience' }
+PPParser >> 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 ] ]
+]
+
+{ #category : 'operators' }
+PPParser >> end [
+	"Answer a new parser that succeeds at the end of the input and return the result of the receiver."
+
+	^ PPEndOfInputParser on: self
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> flatten [
+	"Answer a new parser that flattens the underlying collection."
+	
+	^ PPFlattenParser on: self
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> foldLeft: aBlock [
+	"Answer a new parser that that folds the result of the receiver from left-to-right into aBlock. The argument aBlock must take two or more arguments."
+	
+	| size args |
+	size := aBlock numArgs.
+	args := Array new: size.
+	^ self ==> [ :nodes |
+		args at: 1 put: nodes first.
+		2 to: nodes size by: size - 1 do: [ :index |
+			args
+				replaceFrom: 2 to: size with: nodes startingAt: index;
+				at: 1 put: (aBlock valueWithArguments: args) ].
+		args first ]
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> foldRight: aBlock [
+	"Answer a new parser that that folds the result of the receiver from right-to-left into aBlock. The argument aBlock must take two or more arguments."
+
+	| size args |
+	size := aBlock numArgs.
+	args := Array new: size.
+	^ self ==> [ :nodes |
+		args at: size put: nodes last.
+		nodes size - size + 1 to: 1 by: 1 - size do: [ :index |
+			args
+				replaceFrom: 1 to: size - 1 with: nodes startingAt: index;
+				at: size put: (aBlock valueWithArguments: args) ].
+		args at: size ]
+]
+
+{ #category : 'accessing-properties' }
+PPParser >> hasProperty: aKey [
+	"Test if the property aKey is present."
+	
+	^ properties notNil and: [ properties includesKey: aKey ]
+]
+
+{ #category : 'operators' }
+PPParser >> if: aBlock [
+	^ PPConditionalParser on: self block: aBlock
+]
+
+{ #category : 'initialization' }
+PPParser >> initialize [
+]
+
+{ #category : 'testing' }
+PPParser >> isPetitParser [
+	^ true
+]
+
+{ #category : 'testing' }
+PPParser >> isUnresolved [
+	^ false
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> map: aBlock [
+	"Answer a new parser that works on the receiving sequence an passes in each element as a block argument."
+	
+	^ aBlock numArgs = 1
+		ifTrue: [ self ==> aBlock ]
+		ifFalse: [ self error: aBlock numArgs asString , ' arguments expected.' ]
+
+]
+
+{ #category : 'parsing' }
+PPParser >> matches: anObject [
+	"Answer if anObject can be parsed by the receiver."
+	
+	^ (self parse: anObject) isPetitFailure not
+]
+
+{ #category : 'parsing' }
+PPParser >> matchesIn: anObject [
+	"Search anObject repeatedly for the matches of the receiver. Answered an OrderedCollection of the matched parse-trees."
+
+	| result |
+	result := OrderedCollection new.
+	self 
+		matchesIn: anObject
+		do: [ :each | result addLast: each ].
+	^ result
+]
+
+{ #category : 'parsing' }
+PPParser >> 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
+]
+
+{ #category : 'parsing' }
+PPParser >> matchesSkipIn: anObject [
+	"Search anObject repeatedly for the matches of the receiver. Answer an OrderedCollection of the matched parse-trees. Skip over matches."
+
+	| result |
+	result := OrderedCollection new.
+	self 
+		matchesSkipIn: anObject
+		do: [ :each | result addLast: each ].
+	^ result
+]
+
+{ #category : 'parsing' }
+PPParser >> matchesSkipIn: anObject do: aBlock [
+	"Search anObject repeatedly for the matches of the receiver. Evaluate aBlock for each match with the matched parse-tree as the argument. Skip over matches."
+
+	(self ==> aBlock / #any asParser) star parse: anObject
+]
+
+{ #category : 'parsing' }
+PPParser >> 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
+]
+
+{ #category : 'parsing' }
+PPParser >> matchingRangesIn: anObject do: aBlock [
+	"Search anObject repeatedly for the matches of the receiver. Evaluate aBlock with the range of each match (index of first character to: index of last character)."
+
+	self token
+		matchesIn: anObject
+		do: [ :token | aBlock value: (token start to: token stop) ]
+]
+
+{ #category : 'parsing' }
+PPParser >> matchingSkipRangesIn: anObject [
+	"Search anObject repeatedly for the matches of the receiver. Skip over matches. Answer an OrderedCollection of ranges of each match (index of first character to: index of last character)."
+	
+	| result |
+	result := OrderedCollection new.
+	self
+		matchingSkipRangesIn: anObject
+		do: [ :value | result addLast: value ].
+	^ result
+]
+
+{ #category : 'parsing' }
+PPParser >> matchingSkipRangesIn: anObject do: aBlock [
+	"Search anObject repeatedly for the matches of the receiver. Skip over matches. Evaluate aBlock with the range of each match (index of first character to: index of last character)."
+	
+	self token
+		matchesSkipIn: anObject
+		do: [ :token | aBlock value: (token start to: token stop) ]
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> max: anInteger [
+	"Answer a new parser that parses the receiver at most anInteger times."
+	
+	^ self star setMax: anInteger
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> max: anInteger greedy: aParser [
+	"Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
+	
+	^ (self starGreedy: aParser) setMax: anInteger
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> max: anInteger lazy: aParser [
+	"Answer a new parser that parses the receiver at most anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed."
+	
+	^ (self starLazy: aParser) setMax: anInteger
+]
+
+{ #category : 'operators' }
+PPParser >> 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
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> min: anInteger [
+	"Answer a new parser that parses the receiver at least anInteger times."
+	
+	^ self star setMin: anInteger
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> min: anInteger greedy: aParser [
+	"Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
+	
+	^ (self starGreedy: aParser) setMin: anInteger
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> min: anInteger lazy: aParser [
+	"Answer a new parser that parses the receiver at least anInteger times until it reaches aParser. This is a lazy non-blind implementation. aParser is not consumed."
+	
+	^ (self starLazy: aParser) setMin: anInteger
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> min: aMinInteger max: aMaxInteger [
+	"Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times."
+	
+	^ self star setMin: aMinInteger; setMax: aMaxInteger
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> min: aMinInteger max: aMaxInteger greedy: aParser [
+	"Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
+	
+	^ (self starGreedy: aParser) setMin: aMinInteger; setMax: aMaxInteger
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> min: aMinInteger max: aMaxInteger lazy: aParser [
+	"Answer a new parser that parses the receiver at least aMinInteger and at most aMaxInteger times until it reaches aParser. This is a greedy non-blind implementation. aParser is not consumed."
+	
+	^ (self starLazy: aParser) setMin: aMinInteger; setMax: aMaxInteger
+]
+
+{ #category : 'accessing' }
+PPParser >> name [
+	"Answer the production name of the receiver."
+	
+	^ self propertyAt: #name ifAbsent: [ nil ]
+]
+
+{ #category : 'accessing' }
+PPParser >> name: aString [
+	self propertyAt: #name put: aString
+]
+
+{ #category : 'operators' }
+PPParser >> negate [
+	"Answer a new parser consumes any input token but the receiver."
+	
+	^ self not , #any asParser ==> #second
+]
+
+{ #category : 'operators' }
+PPParser >> nonMemoized [
+	^ self
+]
+
+{ #category : 'operators' }
+PPParser >> not [
+	"Answer a new parser (logical not-predicate) that succeeds whenever the receiver fails, but never consumes input."
+
+	^ PPNotParser on: self
+]
+
+{ #category : 'operators' }
+PPParser >> optional [
+	"Answer a new parser that parses the receiver, if possible."
+
+	^ PPOptionalParser on: self
+]
+
+{ #category : 'parsing' }
+PPParser >> parse: anObject [
+	"Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
+
+	^ self parse: anObject withContext: PPContext new
+]
+
+{ #category : 'parsing' }
+PPParser >> 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
+]
+
+{ #category : 'context' }
+PPParser >> parse: anObject withContext: aPPContext [
+	"Parse anObject with the receiving parser and answer the parse-result or an instance of PPFailure."
+
+	aPPContext stream: anObject asPetitStream.
+	^ self parseWithContext: aPPContext.
+
+]
+
+{ #category : 'parsing' }
+PPParser >> parseOn: aPPContext [
+	"Parse aStream with the receiving parser and answer the parse-result or an instance of PPFailure. Override this method in subclasses to specify custom parse behavior. Do not call this method from outside, instead use #parse:."
+	
+	self subclassResponsibility
+]
+
+{ #category : 'context' }
+PPParser >> parseWithContext: context [
+	| result |
+	context initializeFor: self.
+	result := self parseOn: context.
+	
+	"Return the furthest failure, it gives better results than the last failure"
+	(result isPetitFailure and: [ context furthestFailure notNil]) 
+		ifTrue: [ ^ context furthestFailure ].
+	^ result
+	
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> plus [
+	"Answer a new parser that parses the receiver one or more times."
+
+	^ self star setMin: 1
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> plusGreedy: aParser [
+	"Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed."
+	
+	^ (self starGreedy: aParser) setMin: 1
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> plusLazy: aParser [
+	"Answer a new parser that parses the receiver one or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed."
+	
+	^ (self starLazy: aParser) setMin: 1
+]
+
+{ #category : 'copying' }
+PPParser >> postCopy [
+	super postCopy.
+	properties := properties copy
+]
+
+{ #category : 'printing' }
+PPParser >> printNameOn: aStream [
+	self name isNil
+		ifTrue: [ aStream print: self hash ]
+		ifFalse: [ aStream nextPutAll: self name ]
+]
+
+{ #category : 'printing' }
+PPParser >> printOn: aStream [
+	super printOn: aStream.
+	aStream nextPut: $(.
+	self printNameOn: aStream.
+	aStream nextPut: $)
+]
+
+{ #category : 'accessing-properties' }
+PPParser >> properties [
+	^ properties
+]
+
+{ #category : 'accessing-properties' }
+PPParser >> propertyAt: aKey [
+	"Answer the property value associated with aKey."
+	
+	^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]
+]
+
+{ #category : 'accessing-properties' }
+PPParser >> 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 ]
+]
+
+{ #category : 'accessing-properties' }
+PPParser >> 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 ]
+]
+
+{ #category : 'accessing-properties' }
+PPParser >> 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
+]
+
+{ #category : 'accessing-properties' }
+PPParser >> 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' ]
+]
+
+{ #category : 'accessing-properties' }
+PPParser >> 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
+]
+
+{ #category : 'operators-convenience' }
+PPParser >> 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 ]
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> star [
+	"Answer a new parser that parses the receiver zero or more times. This is a greedy and blind implementation that tries to consume as much input as possible and it does not consider what comes afterwards."
+
+	^ PPPossessiveRepeatingParser on: self
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> starGreedy: aParser [
+	"Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a greedy non-blind implementation of the star operator. aParser is not consumed."
+	
+	^ PPGreedyRepeatingParser on: self limit: aParser
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> starLazy: aParser [
+	"Answer a new parser that parses the receiver zero or more times until it reaches aParser. This is a lazy non-blind implementation of the star operator. aParser is not consumed."
+	
+	^ PPLazyRepeatingParser on: self limit: aParser
+]
+
+{ #category : 'operators-repeating' }
+PPParser >> times: anInteger [
+	"Answer a new parser that parses the receiver exactly anInteger times."
+	
+	^ self min: anInteger max: anInteger
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> token [
+	"Answer a new parser that transforms the input to a token."
+	
+	^ PPTokenParser on: self
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> token: aTokenClass [
+	"Answer a new parser that transforms the input to a token of class aTokenClass."
+	
+	^ self token tokenClass: aTokenClass
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> trim [
+	"Answer a new parser that consumes spaces before and after the receiving parser."
+	
+	^ self trimSpaces
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> trim: aParser [
+	"Answer a new parser that consumes and ignores aParser repeatedly before and after the receiving parser."
+	
+	^ PPTrimmingParser on: self trimmer: aParser
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> trimBlanks [
+	"Answer a new parser that consumes blanks before and after the receiving parser."
+	
+	^ self trim: #blank asParser
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> trimLeft [
+	"Answer a new parser that consumes spaces before the receiving parser."
+	
+	^ self trimSpacesLeft
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> trimRight [
+	"Answer a new parser that consumes spaces after the receiving parser."
+	
+	^ self trimSpacesRight
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> trimRight: trimmer [
+	"Answer a new parser that consumes spaces after the receiving parser."
+	
+	^ (self, trimmer star) ==> #first
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> trimSpaces [
+	"Answer a new parser that consumes spaces before and after the receiving parser."
+	
+	^ self trim: #space asParser
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> trimSpacesLeft [
+	"Answer a new parser that consumes spaces before the receiving parser."
+	
+	^ (#space asParser star, self) ==> #second
+]
+
+{ #category : 'operators-mapping' }
+PPParser >> trimSpacesRight [
+	"Answer a new parser that consumes spaces after the receiving parser."
+	
+	^ (self, #space asParser star) ==> #first
+]
+
+{ #category : 'operators-convenience' }
+PPParser >> withoutSeparators [
+	"Filters out the separators from a parse result produced by one of the productions #delimitedBy: or #separatedBy:."
+	
+	^ self ==> [ :items |
+		| result |
+		result := Array new: items size + 1 // 2.
+		1 to: result size do: [ :index | result at: index put: (items at: 2 * index - 1) ].
+		result ]
+]
+
+{ #category : 'operators' }
+PPParser >> wrapped [
+	"Answer a new parser that is simply wrapped."
+	
+	^ PPDelegateParser on: self
+]
+
+{ #category : 'operators' }
+PPParser >> | 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
+]
diff --git a/software/PetitParser/PPPluggableParser.class.st b/software/PetitParser/PPPluggableParser.class.st
new file mode 100644
index 0000000..ac05545
--- /dev/null
+++ b/software/PetitParser/PPPluggableParser.class.st
@@ -0,0 +1,43 @@
+"
+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.
+
+
+"
+Class {
+	#name : 'PPPluggableParser',
+	#superclass : 'PPParser',
+	#instVars : [
+		'block'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'instance creation' }
+PPPluggableParser class >> on: aBlock [
+	^ self new initializeOn: aBlock
+]
+
+{ #category : 'accessing' }
+PPPluggableParser >> block [
+	"Answer the pluggable block."
+
+	^ block
+]
+
+{ #category : 'initialization' }
+PPPluggableParser >> initializeOn: aBlock [
+	block := aBlock
+]
+
+{ #category : 'parsing' }
+PPPluggableParser >> parseOn: aPPContext [
+	| memento result |
+	memento := aPPContext remember.
+	result := block value: aPPContext.
+	result isPetitFailure
+		ifTrue: [ aPPContext restore: memento ].
+	^ result
+]
diff --git a/software/PetitParser/PPPossessiveRepeatingParser.class.st b/software/PetitParser/PPPossessiveRepeatingParser.class.st
new file mode 100644
index 0000000..2f71a19
--- /dev/null
+++ b/software/PetitParser/PPPossessiveRepeatingParser.class.st
@@ -0,0 +1,25 @@
+"
+The default repeating parser with standard PEG semantics (i.e. possessive, blind, eager).
+"
+Class {
+	#name : 'PPPossessiveRepeatingParser',
+	#superclass : 'PPRepeatingParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'parsing' }
+PPPossessiveRepeatingParser >> parseOn: aPPContext [
+	| memento element elements |
+	memento := aPPContext remember.
+	elements := OrderedCollection new.
+	[ elements size < min ] whileTrue: [
+		(element := parser parseOn: aPPContext) isPetitFailure ifTrue: [
+			aPPContext restore: memento.
+			^ element ].
+		elements addLast: element ].
+	[ elements size < max ] whileTrue: [
+	 	(element := parser parseOn: aPPContext) isPetitFailure
+			ifTrue: [ ^ elements asArray ].
+		elements addLast: element ].
+	^ elements asArray
+]
diff --git a/software/PetitParser/PPPredicateObjectParser.class.st b/software/PetitParser/PPPredicateObjectParser.class.st
new file mode 100644
index 0000000..7fcbdbf
--- /dev/null
+++ b/software/PetitParser/PPPredicateObjectParser.class.st
@@ -0,0 +1,238 @@
+"
+A parser that accepts if a given predicate on one element of the input sequence holds.
+"
+Class {
+	#name : 'PPPredicateObjectParser',
+	#superclass : 'PPPredicateParser',
+	#classInstVars : [
+		'cache'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'factory-objects' }
+PPPredicateObjectParser class >> any [
+	^self
+		cacheAt: #'any'
+		ifAbsentPut: [ self
+			on: [ :each | true ] message: 'input expected'
+			negated: [ :each | false ] message: 'no input expected' ]
+]
+
+{ #category : 'factory-objects' }
+PPPredicateObjectParser class >> anyExceptAnyOf: aCollection [
+	^ self
+		on: [ :each | (aCollection includes: each) not ] message: 'any except ' , aCollection printString , ' expected'
+		negated: [ :each | aCollection includes: each ] message: aCollection printString ,  ' not expected'
+]
+
+{ #category : 'factory-objects' }
+PPPredicateObjectParser class >> anyOf: aCollection [
+	^ self
+		on: [ :each | aCollection includes: each ] message: 'any of ' , aCollection printString , ' expected'
+		negated: [ :each | (aCollection includes: each) not ] message: 'none of ' , aCollection printString ,  'expected'
+]
+
+{ #category : 'factory-objects' }
+PPPredicateObjectParser class >> 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'
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> blank [
+	^self
+		cacheAt: #'blank'
+		ifAbsentPut: [ self
+			chars: (String with: Character space with: Character tab) message: 'blank expected' ]
+]
+
+{ #category : 'cache' }
+PPPredicateObjectParser class >> cacheAt: aSymbol ifAbsentPut: aBlock [
+
+	cache ifNil: [ cache := Dictionary new ].
+	^(cache
+		at: aSymbol
+		ifAbsentPut: aBlock) copy
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> char: aCharacter [
+	^ self expect: aCharacter message: (String with: $" with: aCharacter with: $") , ' expected'
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> char: aCharacter message: aString [
+	^ self expect: aCharacter message: aString
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> chars: aCollection message: aString [
+	^ self on: (PPCharSetPredicate on: [ :char | aCollection includes: char ]) message: aString
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> cr [
+	^self
+		cacheAt: #'cr'
+		ifAbsentPut: [ self char: (Character codePoint: 13) message: 'carriage return expected' ]
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> digit [
+	^self
+		cacheAt: #'digit'
+		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isDigit ]) message: 'digit expected' ]
+]
+
+{ #category : 'factory-objects' }
+PPPredicateObjectParser class >> endOfLine [
+	
+	^ PPEndOfLineParser new.
+]
+
+{ #category : 'factory-objects' }
+PPPredicateObjectParser class >> eof [
+	
+	^ PPEndOfFileParser new
+]
+
+{ #category : 'factory-objects' }
+PPPredicateObjectParser class >> expect: anObject [
+	^ self expect: anObject message: anObject printString , ' expected'
+]
+
+{ #category : 'factory-objects' }
+PPPredicateObjectParser class >> expect: anObject message: aString [
+	^ self 
+		on: [ :each | each = anObject ] message: aString
+		negated: [ :each | each ~= anObject ] message: 'no ' , aString
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> hex [
+	^self
+		cacheAt: #'hex'
+		ifAbsentPut: [ 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' ]
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> letter [
+	^self
+		cacheAt: #'letter'
+		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isLetter ]) message: 'letter expected' ]
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> lf [
+	^self
+		cacheAt: #'lf'
+		ifAbsentPut: [ self char: (Character codePoint: 10) ]
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> lowercase [
+	^self
+		cacheAt: #'lowercase'
+		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isLowercase ]) message: 'lowercase letter expected' ]
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> newline [
+	^self
+		cacheAt: #'newline'
+		ifAbsentPut: [ self chars: (String with: (Character codePoint: 13) with: (Character codePoint: 10)) message: 'newline expected' ]
+]
+
+{ #category : 'instance creation' }
+PPPredicateObjectParser class >> on: aBlock message: aString [
+	^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString
+]
+
+{ #category : 'instance creation' }
+PPPredicateObjectParser class >> on: aBlock message: aString negated: aNegatedBlock message: aNegatedString [
+	^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> punctuation [
+	^self
+		cacheAt: #'punctuation'
+		ifAbsentPut: [ self chars: '.,"''?!;:#$%&()*+-/<>=@[]\^_{}|~' message: 'punctuation expected' ]
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> space [
+	^self
+		cacheAt: #'space'
+		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isSeparator ]) message: 'separator expected' ]
+]
+
+{ #category : 'factory-objects' }
+PPPredicateObjectParser class >> startOfLine [
+	
+	^ PPStartOfLineParser new.
+]
+
+{ #category : 'factory-objects' }
+PPPredicateObjectParser class >> startOfLogicalLine [
+	
+	^ PPStartOfLogicalLineParser new.
+]
+
+{ #category : 'factory-objects' }
+PPPredicateObjectParser class >> startOfWord [
+	
+	^ PPStartOfWordParser new.
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> tab [
+	^self
+		cacheAt: #'tab'
+		ifAbsentPut: [ self char: Character tab message: 'tab expected' ]
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> uppercase [
+	^self
+		cacheAt: #'uppercase'
+		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isUppercase ]) message: 'uppercase letter expected' ]
+]
+
+{ #category : 'factory-chars' }
+PPPredicateObjectParser class >> word [
+	^self
+		cacheAt: #'word'
+		ifAbsentPut: [ self on: (PPCharSetPredicate on: [ :char | char isAlphaNumeric ]) message: 'letter or digit expected' ]
+]
+
+{ #category : 'initialization' }
+PPPredicateObjectParser >> initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString [
+	predicate := aBlock.
+	predicateMessage := aString.
+	negated := aNegatedBlock.
+	negatedMessage := aNegatedString
+]
+
+{ #category : 'operators' }
+PPPredicateObjectParser >> negate [
+	"Answer a parser that is the negation of the receiving predicate parser."
+	
+	^ self class 
+		on: negated message: negatedMessage 
+		negated: predicate message: predicateMessage
+]
+
+{ #category : 'parsing' }
+PPPredicateObjectParser >> parseOn: aPPContext [
+	^ (aPPContext atEnd not and: [ predicate value: aPPContext uncheckedPeek ])
+		ifFalse: [ PPFailure message: predicateMessage context: aPPContext ]
+		ifTrue: [ aPPContext next ]
+]
diff --git a/software/PetitParser/PPPredicateParser.class.st b/software/PetitParser/PPPredicateParser.class.st
new file mode 100644
index 0000000..02f2002
--- /dev/null
+++ b/software/PetitParser/PPPredicateParser.class.st
@@ -0,0 +1,40 @@
+"
+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.
+"
+Class {
+	#name : 'PPPredicateParser',
+	#superclass : 'PPParser',
+	#instVars : [
+		'predicate',
+		'predicateMessage',
+		'negated',
+		'negatedMessage'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'accessing' }
+PPPredicateParser >> block [
+	"Answer the predicate block of the receiver."
+	
+	^ predicate
+]
+
+{ #category : 'accessing' }
+PPPredicateParser >> message [
+	"Answer the failure message."
+	
+	^ predicateMessage
+]
+
+{ #category : 'printing' }
+PPPredicateParser >> printNameOn: aStream [
+	super printNameOn: aStream.
+	aStream nextPutAll: ', '; print: predicateMessage
+]
diff --git a/software/PetitParser/PPPredicateSequenceParser.class.st b/software/PetitParser/PPPredicateSequenceParser.class.st
new file mode 100644
index 0000000..a6ce6b7
--- /dev/null
+++ b/software/PetitParser/PPPredicateSequenceParser.class.st
@@ -0,0 +1,62 @@
+"
+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.
+
+"
+Class {
+	#name : 'PPPredicateSequenceParser',
+	#superclass : 'PPPredicateParser',
+	#instVars : [
+		'size'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'instance creation' }
+PPPredicateSequenceParser class >> on: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger [ 
+	^ self new initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger
+]
+
+{ #category : 'instance creation' }
+PPPredicateSequenceParser class >> on: aBlock message: aString size: anInteger [
+	^ self on: aBlock message: aString negated: [ :each | (aBlock value: each) not ] message: 'no ' , aString size: anInteger 
+]
+
+{ #category : 'initialization' }
+PPPredicateSequenceParser >> initializeOn: aBlock message: aString negated: aNegatedBlock message: aNegatedString size: anInteger [
+	predicate := aBlock.
+	predicateMessage := aString.
+	negated := aNegatedBlock.
+	negatedMessage := aNegatedString.
+	size := anInteger 
+]
+
+{ #category : 'operators' }
+PPPredicateSequenceParser >> 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
+]
+
+{ #category : 'parsing' }
+PPPredicateSequenceParser >> parseOn: aPPContext [
+	| memento result |
+	memento := aPPContext remember.
+	result := aPPContext stream next: size.
+	(result size = size and: [ predicate value: result ])
+		ifTrue: [ ^ result ].
+	aPPContext restore: memento.
+	^ PPFailure message: predicateMessage context: aPPContext
+]
+
+{ #category : 'accessing' }
+PPPredicateSequenceParser >> size [
+	"Answer the sequence size of the receiver."
+
+	^ size
+]
diff --git a/software/PetitParser/PPRepeatingParser.class.st b/software/PetitParser/PPRepeatingParser.class.st
new file mode 100644
index 0000000..86059c1
--- /dev/null
+++ b/software/PetitParser/PPRepeatingParser.class.st
@@ -0,0 +1,53 @@
+"
+An abstract parser that repeatedly parses between 'min' and 'max' instances of its delegate. The default configuration parses an infinite number of elements, as 'min' is set to 0 and 'max' to infinity (SmallInteger maxVal).
+
+Instance Variables:
+	min	<Integer>	The minimum number of repetitions.
+	max	<Integer>	The maximum number of repetitions.
+"
+Class {
+	#name : 'PPRepeatingParser',
+	#superclass : 'PPDelegateParser',
+	#instVars : [
+		'min',
+		'max'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'initialization' }
+PPRepeatingParser >> initialize [
+	super initialize.
+	self setMin: 0; setMax: SmallInteger maxVal
+]
+
+{ #category : 'accessing' }
+PPRepeatingParser >> max [
+	"Answer the maximum number of repetitions."
+
+	^ max
+]
+
+{ #category : 'accessing' }
+PPRepeatingParser >> min [
+	"Answer the minimum number of repetitions."
+	
+	^ min
+]
+
+{ #category : 'printing' }
+PPRepeatingParser >> printOn: aStream [
+	super printOn: aStream.
+	aStream nextPutAll: ' ['; print: min; nextPutAll: ', '; nextPutAll: (max = SmallInteger maxVal
+		ifTrue: [ '*' ] ifFalse: [ max printString ]); nextPut: $]
+]
+
+{ #category : 'initialization' }
+PPRepeatingParser >> setMax: anInteger [
+	max := anInteger
+]
+
+{ #category : 'initialization' }
+PPRepeatingParser >> setMin: anInteger [
+	min := anInteger
+]
diff --git a/software/PetitParser/PPSequenceParser.class.st b/software/PetitParser/PPSequenceParser.class.st
new file mode 100644
index 0000000..f1fd74b
--- /dev/null
+++ b/software/PetitParser/PPSequenceParser.class.st
@@ -0,0 +1,40 @@
+"
+A parser that parses a sequence of parsers.
+"
+Class {
+	#name : 'PPSequenceParser',
+	#superclass : 'PPListParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'operators' }
+PPSequenceParser >> , aRule [
+	^ self copyWith: aRule
+]
+
+{ #category : 'parsing' }
+PPSequenceParser >> parseOn: aPPContext [
+	"This is optimized code that avoids unnecessary block activations, do not change."
+	
+	| memento elements element |
+	memento := aPPContext remember.
+	elements := Array new: parsers size.
+	1 to: parsers size do: [ :index |
+		element := (parsers at: index) 
+			parseOn: aPPContext.
+		element isPetitFailure ifTrue: [
+			aPPContext restore: memento.
+			^ element ].
+		elements at: index put: element ].
+	^ elements
+]
+
+{ #category : 'operators-mapping' }
+PPSequenceParser >> 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 ] ]
+]
diff --git a/software/PetitParser/PPStartOfLineParser.class.st b/software/PetitParser/PPStartOfLineParser.class.st
new file mode 100644
index 0000000..bbdf0be
--- /dev/null
+++ b/software/PetitParser/PPStartOfLineParser.class.st
@@ -0,0 +1,17 @@
+"
+A PPStartOfLineParser is that does not fail, if the stream position is at the beginning of a line. It does not consume anything.
+
+"
+Class {
+	#name : 'PPStartOfLineParser',
+	#superclass : 'PPParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'parsing' }
+PPStartOfLineParser >> parseOn: aPPContext [
+	(aPPContext isStartOfLine) ifTrue: [ 
+		^ #startOfLine
+	].
+	^ PPFailure message: 'Start of line expected' context: aPPContext at: aPPContext position
+]
diff --git a/software/PetitParser/PPStartOfLogicalLineParser.class.st b/software/PetitParser/PPStartOfLogicalLineParser.class.st
new file mode 100644
index 0000000..4f8917b
--- /dev/null
+++ b/software/PetitParser/PPStartOfLogicalLineParser.class.st
@@ -0,0 +1,34 @@
+"
+A PPStartOfLogicalLineParser is that does not fail, if the stream position is at the first non-blank character of a line. It does not consume anything.
+
+"
+Class {
+	#name : 'PPStartOfLogicalLineParser',
+	#superclass : 'PPParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'testing' }
+PPStartOfLogicalLineParser >> isBlank: character [
+	^ (character == Character space or: [character == Character tab])
+
+]
+
+{ #category : 'parsing' }
+PPStartOfLogicalLineParser >> parseOn: aPPContext [
+	aPPContext peek isAlphaNumeric ifFalse: [ 
+		^ PPFailure message: 'Start of logical line expected' context: aPPContext 
+	].
+
+	aPPContext isStartOfLine ifTrue: [ ^ #startOfLogicalLine ].
+	
+	
+	[ aPPContext position ~= 0 ] whileTrue: [  
+		aPPContext back.
+		(self isBlank: aPPContext peek) ifFalse: [ 
+			^ PPFailure message: 'Start of logical line expected' context: aPPContext
+		].
+		aPPContext isStartOfLine ifTrue: [ ^ #startOfLogicalLine ].
+	]
+
+]
diff --git a/software/PetitParser/PPStartOfWordParser.class.st b/software/PetitParser/PPStartOfWordParser.class.st
new file mode 100644
index 0000000..ff14a2e
--- /dev/null
+++ b/software/PetitParser/PPStartOfWordParser.class.st
@@ -0,0 +1,44 @@
+"
+A PPStartOfWordParser is that matches a word boundary.
+
+I return success if no word character preceeds my position and if word chracter succeeds my position.
+
+Word characters are any alphanumeric characters.
+"
+Class {
+	#name : 'PPStartOfWordParser',
+	#superclass : 'PPParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'testing' }
+PPStartOfWordParser >> acceptsEpsilon [
+	^ false
+]
+
+{ #category : 'parsing' }
+PPStartOfWordParser >> parseOn: aPPContext [
+	aPPContext atEnd ifTrue: [  
+		^ PPFailure message: 'Start of word expected' context: aPPContext at: aPPContext position 
+	].
+
+	(aPPContext position == 0) ifTrue: [ 
+		(aPPContext peek isAlphaNumeric) ifTrue: [ 
+			^ #startOfWord
+		] ifFalse: [ 
+			^ PPFailure message: 'Start of word expected' context: aPPContext at: aPPContext position 
+	 	]
+	].
+
+	aPPContext back.
+	aPPContext peek isAlphaNumeric ifTrue: [
+		^ PPFailure message: 'Start of word expected' context: aPPContext at: aPPContext position 
+	].
+	aPPContext next.
+	
+	^ aPPContext peek isAlphaNumeric ifTrue: [ #startOfWord ] ifFalse: [ 
+		PPFailure message: 'Start of word expected' context: aPPContext at: aPPContext position 
+	]
+	
+
+]
diff --git a/software/PetitParser/PPStream.class.st b/software/PetitParser/PPStream.class.st
new file mode 100644
index 0000000..df264eb
--- /dev/null
+++ b/software/PetitParser/PPStream.class.st
@@ -0,0 +1,162 @@
+"
+A positional stream implementation used for parsing. It overrides some methods for optimization reasons.
+"
+Class {
+	#name : 'PPStream',
+	#superclass : 'ReadStream',
+	#instVars : [
+		'newlines'
+	],
+	#category : 'PetitParser-Core'
+}
+
+{ #category : 'converting' }
+PPStream >> asPetitStream [
+	^ self
+]
+
+{ #category : 'accessing' }
+PPStream >> collection [
+	"Answer the underlying collection."
+	
+	^ collection
+]
+
+{ #category : 'positioning' }
+PPStream >> column [
+	^ self column: position.
+]
+
+{ #category : 'positioning' }
+PPStream >> column: pos [
+	| nl |
+	(pos = -1) ifTrue: [  ^ 0 ].
+	(pos > readLimit) ifTrue: [ ^ self error: 'Out of limit' ].
+	
+	nl := self newlines.
+	1 to: nl size do: [ :index | 
+		((nl at: index) > pos) ifTrue: [ ^ pos - (nl at: (index - 1)) + 1 ]
+	].
+"	nl keysAndValuesDo: [ :index :value |
+		(value > pos) ifTrue: [ ^ pos - (nl at: (index - 1)) + 1]
+	].	
+"
+	^ pos - (nl at: (nl size )) + 1
+]
+
+{ #category : 'positioning' }
+PPStream >> fillNewlines [
+	| tmp line |
+	newlines := OrderedCollection new.	
+	
+	tmp := position.
+	line := 0.
+	
+	(0 to: readLimit) do: [:index |
+		position := index.
+		self isStartOfLine ifTrue: [ newlines add: position ]
+	].
+	position := tmp.
+	newlines := newlines asArray.
+	^ newlines
+]
+
+{ #category : 'queries' }
+PPStream >> insideCRLF [
+	(position < 1) ifTrue: [ ^ false ].
+	
+	^ (self peek = (Character codePoint: 10)) and: [ self peekBack = (Character codePoint: 13) ]
+]
+
+{ #category : 'queries' }
+PPStream >> isEndOfLine [
+	self atEnd ifTrue: [ ^ true ].
+	self insideCRLF ifTrue: [ ^ false ].
+	^ (self peek = (Character codePoint: 13) or: [ self peek = (Character codePoint: 10)]).
+]
+
+{ #category : 'queries' }
+PPStream >> isStartOfLine [
+	(position = 0) ifTrue: [ ^ true ].
+
+	self insideCRLF ifTrue: [ ^ false ].
+	
+	^ (self peekBack = (Character codePoint: 13)) or: [ self peekBack = (Character codePoint: 10)].
+]
+
+{ #category : 'positioning' }
+PPStream >> line [
+	^ self line: position
+]
+
+{ #category : 'positioning' }
+PPStream >> line: pos [
+	| nl |
+	(pos = -1) ifTrue: [  ^ 0 ].
+	(pos > readLimit) ifTrue: [ ^ self error: 'Out of limit' ].
+	
+	nl := self newlines.
+	nl keysAndValuesDo: [ :index :value |
+		(value > pos) ifTrue: [ ^ (index - 1)]
+	].	
+
+	^ nl size
+]
+
+{ #category : 'positioning' }
+PPStream >> newlines [
+	^ newlines ifNil: [ 
+		newlines := self fillNewlines.
+	]
+]
+
+{ #category : 'accessing' }
+PPStream >> 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
+]
+
+{ #category : 'accessing' }
+PPStream >> peek [
+	"An improved version of peek, that is slightly faster than the built in version."
+
+	^ self atEnd ifFalse: [ collection at: position + 1 ]
+]
+
+{ #category : 'accessing' }
+PPStream >> 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
+]
+
+{ #category : 'printing' }
+PPStream >> printOn: aStream [
+	collection isString
+		ifFalse: [ ^ super printOn: aStream ].
+	aStream
+		nextPutAll: (collection copyFrom: 1 to: position);
+		nextPutAll: '·';
+		nextPutAll: (collection copyFrom: position + 1 to: readLimit)
+]
+
+{ #category : 'accessing' }
+PPStream >> size [
+	"
+		The same implementation as a ReadStream. Implemented here for compatibility with Smalltalk/X
+		that has different implementation in a ReadStream
+	"
+	^readLimit
+]
+
+{ #category : 'accessing' }
+PPStream >> 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
+]
diff --git a/software/PetitParser/PPToken.class.st b/software/PetitParser/PPToken.class.st
new file mode 100644
index 0000000..821dde0
--- /dev/null
+++ b/software/PetitParser/PPToken.class.st
@@ -0,0 +1,162 @@
+"
+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.
+"
+Class {
+	#name : 'PPToken',
+	#superclass : 'Object',
+	#instVars : [
+		'collection',
+		'start',
+		'stop',
+		'value'
+	],
+	#classVars : [
+		'NewLineParser'
+	],
+	#category : 'PetitParser-Core'
+}
+
+{ #category : 'initialization' }
+PPToken class >> initialize [
+	"Platform independent newline sequence. LF: Unix, CR+LF: Windows, and CR: Apple."
+	| cr lf |
+	cr := Character codePoint: 13.
+	lf := Character codePoint: 10.
+	NewLineParser := lf asParser / (cr asParser , lf asParser optional)
+]
+
+{ #category : 'instance creation' }
+PPToken class >> new [
+	self error: 'Token can only be created using a dedicated constructor.'
+]
+
+{ #category : 'instance creation' }
+PPToken class >> on: aSequenceableCollection [
+	^ self on: aSequenceableCollection start: 1 stop: aSequenceableCollection size value: nil
+]
+
+{ #category : 'instance creation' }
+PPToken class >> on: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject [
+	^ self basicNew 
+		initializeOn: aSequenceableCollection
+		start: aStartInteger stop: aStopInteger
+		value: anObject
+]
+
+{ #category : 'comparing' }
+PPToken >> = anObject [
+	^ self class = anObject class and: [ self inputValue = anObject inputValue ]
+]
+
+{ #category : 'accessing' }
+PPToken >> collection [
+	"Answer the underlying collection of this token."
+
+	^ collection
+]
+
+{ #category : 'querying' }
+PPToken >> column [
+	"Answer the column number of this token in the underlying collection."
+	
+	| position |
+	position := 0.
+	(NewLineParser , [ :stream |
+		start <= stream position
+			ifTrue: [ ^ start - position ].
+		position := stream position ] asParser
+		/ #any asParser) star
+			parse: collection.
+	 ^ start - position
+]
+
+{ #category : 'copying' }
+PPToken >> copyFrom: aStartInteger to: aStopInteger [
+	^ self class on: collection start: start + aStartInteger - 1 stop: stop + aStopInteger - 3 value: value
+]
+
+{ #category : 'comparing' }
+PPToken >> hash [
+	^ self inputValue hash
+]
+
+{ #category : 'initialization' }
+PPToken >> initializeOn: aSequenceableCollection start: aStartInteger stop: aStopInteger value: anObject [
+	collection := aSequenceableCollection.
+	start := aStartInteger.
+	stop := aStopInteger.
+	value := anObject
+]
+
+{ #category : 'accessing-values' }
+PPToken >> inputValue [
+	"Answer the consumed input of this token."
+
+	^ collection copyFrom: start to: stop
+]
+
+{ #category : 'testing' }
+PPToken >> isPetitToken [
+	^ true
+]
+
+{ #category : 'querying' }
+PPToken >> line [
+	"Answer the line number of this token in the underlying collection."
+	
+	| line |
+	line := 1.
+	(NewLineParser , [ :stream |
+		start <= stream position
+			ifTrue: [ ^ line ].
+		line := line + 1 ] asParser
+		/ #any asParser) star
+			parse: collection.
+	^ line
+]
+
+{ #category : 'accessing-values' }
+PPToken >> parsedValue [
+	"Answer the parsed value of this token."
+
+	^ value
+]
+
+{ #category : 'printing' }
+PPToken >> printOn: aStream [
+	super printOn: aStream.
+	aStream nextPut: $[; print: self start; nextPut: $,; print: self stop; nextPut: $].
+	aStream nextPut: $(; print: self inputValue; nextPut: $)
+]
+
+{ #category : 'accessing' }
+PPToken >> size [
+	"Answer the size of this token in the underlying collection."
+
+	^ stop - start + 1
+]
+
+{ #category : 'accessing' }
+PPToken >> start [
+	"Answer the start position of this token in the underlying collection."
+
+	^ start
+]
+
+{ #category : 'accessing' }
+PPToken >> stop [
+	"Answer the stop position of this token in the underlying collection."
+	
+	^ stop
+]
+
+{ #category : 'accessing-values' }
+PPToken >> value [
+	self notify: 'Token>>#value is no longer supported. Instead use Token>>#inputValue'.
+	^ self inputValue
+]
diff --git a/software/PetitParser/PPTokenParser.class.st b/software/PetitParser/PPTokenParser.class.st
new file mode 100644
index 0000000..2d663b2
--- /dev/null
+++ b/software/PetitParser/PPTokenParser.class.st
@@ -0,0 +1,40 @@
+"
+A parser that answers a token with the value of my delegate parses.
+
+Instance Variables:
+	tokenClass	<PPToken class>	The token sub-class to be used.
+"
+Class {
+	#name : 'PPTokenParser',
+	#superclass : 'PPFlattenParser',
+	#instVars : [
+		'tokenClass'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'private' }
+PPTokenParser >> defaultTokenClass [
+	^ PPToken
+]
+
+{ #category : 'initialization' }
+PPTokenParser >> initialize [
+	tokenClass := self defaultTokenClass
+	
+]
+
+{ #category : 'private' }
+PPTokenParser >> on: aCollection start: aStartInteger stop: aStopInteger value: anObject [
+	^ self tokenClass on: aCollection start: aStartInteger stop: aStopInteger value: anObject
+]
+
+{ #category : 'accessing' }
+PPTokenParser >> tokenClass [
+	^ tokenClass
+]
+
+{ #category : 'accessing' }
+PPTokenParser >> tokenClass: aTokenClass [
+	tokenClass := aTokenClass
+]
diff --git a/software/PetitParser/PPTrimmingParser.class.st b/software/PetitParser/PPTrimmingParser.class.st
new file mode 100644
index 0000000..18eaf9e
--- /dev/null
+++ b/software/PetitParser/PPTrimmingParser.class.st
@@ -0,0 +1,24 @@
+"
+A parser that silently consumes spaces before and after the delegate parser.
+"
+Class {
+	#name : 'PPTrimmingParser',
+	#superclass : 'PPDelegateParser',
+	#instVars : [
+		'trimmer'
+	],
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'instance creation' }
+PPTrimmingParser class >> on: aParser trimmer: aTrimParser [
+	^ self new
+		setParser: aParser;
+		setTrimmer: aTrimParser;
+		yourself
+]
+
+{ #category : 'initialization' }
+PPTrimmingParser >> setTrimmer: aParser [
+	trimmer := aParser
+]
diff --git a/software/PetitParser/PPUnresolvedParser.class.st b/software/PetitParser/PPUnresolvedParser.class.st
new file mode 100644
index 0000000..1af3c52
--- /dev/null
+++ b/software/PetitParser/PPUnresolvedParser.class.st
@@ -0,0 +1,18 @@
+"
+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.
+"
+Class {
+	#name : 'PPUnresolvedParser',
+	#superclass : 'PPParser',
+	#category : 'PetitParser-Tools'
+}
+
+{ #category : 'testing' }
+PPUnresolvedParser >> isUnresolved [
+	^ true
+]
+
+{ #category : 'parsing' }
+PPUnresolvedParser >> parseOn: aStream [
+	self error: self printString , ' need to be resolved before execution.'
+]
diff --git a/software/PetitParser/PPWrappingParser.class.st b/software/PetitParser/PPWrappingParser.class.st
new file mode 100644
index 0000000..089db70
--- /dev/null
+++ b/software/PetitParser/PPWrappingParser.class.st
@@ -0,0 +1,13 @@
+"
+A parser that performs an action block upon activation with the stream and a continuation block.
+"
+Class {
+	#name : 'PPWrappingParser',
+	#superclass : 'PPActionParser',
+	#category : 'PetitParser-Parsers'
+}
+
+{ #category : 'parsing' }
+PPWrappingParser >> parseOn: aPPContext [
+	^ block value: aPPContext value: [ parser parseOn: aPPContext ]
+]
diff --git a/software/PetitParser/PositionableStream.extension.st b/software/PetitParser/PositionableStream.extension.st
new file mode 100644
index 0000000..fdbc982
--- /dev/null
+++ b/software/PetitParser/PositionableStream.extension.st
@@ -0,0 +1,28 @@
+Extension { #name : 'PositionableStream' }
+
+{ #category : '*petitparser-core-converting' }
+PositionableStream >> 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."
+
+"
+	Disabled until we agree on some way how to optimize this
+
+	^ (collection isNil or: [ position isNil or: [ readLimit isNil ] ])
+		ifFalse: [ PPStream on: collection from: ( position + 1 ) to: readLimit ]
+      ifTrue: [ super asPetitStream ]
+"
+	^ super asPetitStream
+]
+
+{ #category : '*petitparser-core' }
+PositionableStream >> peekTwice [
+	"Answer what would be returned if the message next were sent to the 
+	receiver. If the receiver is at the end, answer nil."
+
+	| array |
+	self atEnd 
+		ifTrue: [^Array with: nil with: nil].
+	array := Array with: (self next) with: (self peek).
+	position := position - 1.
+	^array
+]
diff --git a/software/PetitParser/SequenceableCollection.extension.st b/software/PetitParser/SequenceableCollection.extension.st
new file mode 100644
index 0000000..cb57b96
--- /dev/null
+++ b/software/PetitParser/SequenceableCollection.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'SequenceableCollection' }
+
+{ #category : '*petitparser-core-converting' }
+SequenceableCollection >> asPetitStream [
+	^ PPStream on: self
+]
diff --git a/software/PetitParser/Stream.extension.st b/software/PetitParser/Stream.extension.st
new file mode 100644
index 0000000..b3ebc5b
--- /dev/null
+++ b/software/PetitParser/Stream.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'Stream' }
+
+{ #category : '*petitparser-core-converting' }
+Stream >> asPetitStream [
+	^ self contents asPetitStream
+]
diff --git a/software/PetitParser/String.extension.st b/software/PetitParser/String.extension.st
new file mode 100644
index 0000000..b75a8e0
--- /dev/null
+++ b/software/PetitParser/String.extension.st
@@ -0,0 +1,8 @@
+Extension { #name : 'String' }
+
+{ #category : '*petitparser-core-converting' }
+String >> asParser [
+	"Answer a parser that accepts the receiving string."
+
+	^ PPLiteralSequenceParser on: self
+]
diff --git a/software/PetitParser/Symbol.extension.st b/software/PetitParser/Symbol.extension.st
new file mode 100644
index 0000000..b0706c2
--- /dev/null
+++ b/software/PetitParser/Symbol.extension.st
@@ -0,0 +1,8 @@
+Extension { #name : 'Symbol' }
+
+{ #category : '*petitparser-core-converting' }
+Symbol >> asParser [
+	"Answer a predicate parser named after the receiving symbol. Possible symbols are the method selectors on the class-side of PPPredicateObjectParser."
+
+	^ PPPredicateObjectParser perform: self
+]
diff --git a/software/PetitParser/Text.extension.st b/software/PetitParser/Text.extension.st
new file mode 100644
index 0000000..b55da34
--- /dev/null
+++ b/software/PetitParser/Text.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'Text' }
+
+{ #category : '*petitparser-core-converting' }
+Text >> asPetitStream [
+	^ string asPetitStream
+]
diff --git a/software/PetitParser/UndefinedObject.extension.st b/software/PetitParser/UndefinedObject.extension.st
new file mode 100644
index 0000000..4693bca
--- /dev/null
+++ b/software/PetitParser/UndefinedObject.extension.st
@@ -0,0 +1,8 @@
+Extension { #name : 'UndefinedObject' }
+
+{ #category : '*petitparser-converting' }
+UndefinedObject >> asParser [
+	"Answer a parser that succeeds and does not consume anything."
+	
+	^ PPEpsilonParser new
+]
diff --git a/software/PetitParser/package.st b/software/PetitParser/package.st
new file mode 100644
index 0000000..72d7a2a
--- /dev/null
+++ b/software/PetitParser/package.st
@@ -0,0 +1 @@
+Package { #name : 'PetitParser' }
diff --git a/software/PetitTests/PPAbstractParserTest.class.st b/software/PetitTests/PPAbstractParserTest.class.st
new file mode 100644
index 0000000..ad92f5c
--- /dev/null
+++ b/software/PetitTests/PPAbstractParserTest.class.st
@@ -0,0 +1,102 @@
+Class {
+	#name : 'PPAbstractParserTest',
+	#superclass : 'TestCase',
+	#category : 'PetitTests-Core'
+}
+
+{ #category : 'testing' }
+PPAbstractParserTest class >> isAbstract [
+	^ self name = #PPAbstractParserTest
+]
+
+{ #category : 'accessing' }
+PPAbstractParserTest class >> packageNamesUnderTest [
+	^ #('PetitParser' 'PetitTests')
+]
+
+{ #category : 'utilities' }
+PPAbstractParserTest >> assert: aParser fail: aCollection [
+	^ self assert: aParser fail: aCollection end: 0
+]
+
+{ #category : 'utilities' }
+PPAbstractParserTest >> assert: aParser fail: aCollection end: anInteger [
+	| stream result context |
+	self 
+		assert: aParser isPetitParser
+		description: 'Parser invalid'.
+	stream := aCollection asPetitStream.
+	context := self context.
+	
+	
+	result := aParser parse: stream withContext: context.
+	self 
+		assert: result isPetitFailure
+		description: 'Parser did not fail'.
+	self
+		assert: context position = anInteger
+		description: 'Parser failed at wrong position'.
+	^ result
+]
+
+{ #category : 'utilities' }
+PPAbstractParserTest >> assert: string1 includesSubstring: string2 [
+	"Support portability by using ANSI search method"
+
+	self assert: (string1 notEmpty and: [string2 notEmpty and: [0 < (string1 indexOfSubCollection: string2 startingAt: 1)]])
+]
+
+{ #category : 'utilities' }
+PPAbstractParserTest >> assert: aParser parse: aCollection [
+	^ self assert: aParser parse: aCollection to: nil end: aCollection size 
+]
+
+{ #category : 'utilities' }
+PPAbstractParserTest >> assert: aParser parse: aCollection end: anInteger [
+	^ self assert: aParser parse: aCollection to: nil end: anInteger
+]
+
+{ #category : 'utilities' }
+PPAbstractParserTest >> assert: aParser parse: aCollection to: anObject [
+	^ self assert: aParser parse: aCollection to: anObject end: aCollection size 
+]
+
+{ #category : 'utilities' }
+PPAbstractParserTest >> assert: aParser parse: aCollection to: aTargetObject end: anInteger [
+	| stream result context |
+
+	self assert: aParser isPetitParser description: 'Parser invalid'.
+	stream := aCollection asPetitStream.
+	context := self context.
+	
+	result := aParser parse: stream withContext: context.
+	aTargetObject isNil
+		ifTrue: [ self deny: result isPetitFailure ]
+		ifFalse: [ self assert: result equals: aTargetObject ].
+	self assert: context position = anInteger description: 'Parser accepted at wrong position'.
+	^ result
+]
+
+{ #category : 'utilities' }
+PPAbstractParserTest >> assert: aParser parse: aCollection toToken: aStartInteger stop: aStopInteger [
+	^ self assert: aParser parse: aCollection toToken: aStartInteger stop: aStopInteger end: aCollection size
+]
+
+{ #category : 'utilities' }
+PPAbstractParserTest >> assert: aParser parse: aParserObject toToken: aStartInteger stop: aStopInteger end: anEndInteger [
+	| token |
+	token := self
+		assert: aParser
+		parse: aParserObject
+		to: nil
+		end: anEndInteger.
+	self assert: (token isKindOf: PPToken).
+	self assert: token start equals: aStartInteger.
+	self assert: token stop equals: aStopInteger.
+	^ token
+]
+
+{ #category : 'context' }
+PPAbstractParserTest >> context [
+	^ PPContext new
+]
diff --git a/software/PetitTests/PPArithmeticParser.class.st b/software/PetitTests/PPArithmeticParser.class.st
new file mode 100644
index 0000000..393f798
--- /dev/null
+++ b/software/PetitTests/PPArithmeticParser.class.st
@@ -0,0 +1,65 @@
+Class {
+	#name : 'PPArithmeticParser',
+	#superclass : 'PPCompositeParser',
+	#instVars : [
+		'terms',
+		'addition',
+		'factors',
+		'multiplication',
+		'power',
+		'primary',
+		'parentheses',
+		'number'
+	],
+	#category : 'PetitTests-Examples'
+}
+
+{ #category : 'grammar' }
+PPArithmeticParser >> addition [
+	^ (factors separatedBy: ($+ asParser / $- asParser) trim) 
+		foldLeft: [ :a :op :b | a perform: op asSymbol with: b ]
+]
+
+{ #category : 'grammar' }
+PPArithmeticParser >> factors [
+	^ multiplication / power
+]
+
+{ #category : 'grammar' }
+PPArithmeticParser >> multiplication [
+	^ (power separatedBy: ($* asParser / $/ asParser) trim)
+		foldLeft: [ :a :op :b | a perform: op asSymbol with: b ]
+]
+
+{ #category : 'grammar' }
+PPArithmeticParser >> number [
+	^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten trim 
+		==> [ :value | value asNumber ]
+]
+
+{ #category : 'grammar' }
+PPArithmeticParser >> parentheses [
+	^ $( asParser trim , terms , $) asParser trim
+		==> [ :nodes | nodes at: 2 ]
+]
+
+{ #category : 'grammar' }
+PPArithmeticParser >> power [
+	^ (primary separatedBy: $^ asParser trim)
+		foldRight: [ :a :op :b | a raisedTo: b ]
+]
+
+{ #category : 'grammar' }
+PPArithmeticParser >> primary [
+	^ number / parentheses
+]
+
+{ #category : 'accessing' }
+PPArithmeticParser >> start [
+	^ terms end
+]
+
+{ #category : 'grammar' }
+PPArithmeticParser >> terms [
+	^ addition / factors
+]
diff --git a/software/PetitTests/PPArithmeticParserTest.class.st b/software/PetitTests/PPArithmeticParserTest.class.st
new file mode 100644
index 0000000..c1b9426
--- /dev/null
+++ b/software/PetitTests/PPArithmeticParserTest.class.st
@@ -0,0 +1,124 @@
+Class {
+	#name : 'PPArithmeticParserTest',
+	#superclass : 'PPCompositeParserTest',
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'accessing' }
+PPArithmeticParserTest >> parserClass [
+	^ PPArithmeticParser
+]
+
+{ #category : 'testing-operations' }
+PPArithmeticParserTest >> 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
+]
+
+{ #category : 'testing-operations' }
+PPArithmeticParserTest >> 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
+]
+
+{ #category : 'testing-expression' }
+PPArithmeticParserTest >> 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
+]
+
+{ #category : 'testing-operations' }
+PPArithmeticParserTest >> testDiv [
+	self assert: '12 / 3' is: 4.
+	self assert: '-16 / -4' is: 4
+]
+
+{ #category : 'testing-operations' }
+PPArithmeticParserTest >> 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
+	
+]
+
+{ #category : 'testing-operations' }
+PPArithmeticParserTest >> testMul [
+	self assert: '2 * 3' is: 6.
+	self assert: '2 * -4' is: -8
+]
+
+{ #category : 'testing-operations' }
+PPArithmeticParserTest >> 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
+]
+
+{ #category : 'testing' }
+PPArithmeticParserTest >> 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
+]
+
+{ #category : 'testing-operations' }
+PPArithmeticParserTest >> testPow [
+	self assert: '2 ^ 3' is: 8.
+	self assert: '-2 ^ 3' is: -8.
+	self assert: '-2 ^ -3' is: -0.125
+]
+
+{ #category : 'testing-operations' }
+PPArithmeticParserTest >> 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
+]
+
+{ #category : 'testing-expression' }
+PPArithmeticParserTest >> 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
+]
+
+{ #category : 'testing-operations' }
+PPArithmeticParserTest >> 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
+]
+
+{ #category : 'testing-operations' }
+PPArithmeticParserTest >> 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
+]
diff --git a/software/PetitTests/PPComposedTest.class.st b/software/PetitTests/PPComposedTest.class.st
new file mode 100644
index 0000000..4a6ccf7
--- /dev/null
+++ b/software/PetitTests/PPComposedTest.class.st
@@ -0,0 +1,410 @@
+Class {
+	#name : 'PPComposedTest',
+	#superclass : 'PPAbstractParserTest',
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'accessing' }
+PPComposedTest >> comment [
+	^ ($" asParser , $" asParser negate star , $" asParser) flatten
+]
+
+{ #category : 'accessing' }
+PPComposedTest >> identifier [
+	^ (#letter asParser , #word asParser star) flatten
+]
+
+{ #category : 'accessing' }
+PPComposedTest >> number [
+	^ ($- asParser optional , #digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten
+]
+
+{ #category : 'testing-examples' }
+PPComposedTest >> 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"'
+]
+
+{ #category : 'testing' }
+PPComposedTest >> 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'
+]
+
+{ #category : 'testing' }
+PPComposedTest >> 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' context: stream 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'
+]
+
+{ #category : 'testing-examples' }
+PPComposedTest >> 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'
+]
+
+{ #category : 'testing' }
+PPComposedTest >> testIfThenElse [
+	"S ::= if C then S else S | if C then S | X"
+
+	| start if then else cond expr parser |
+	start := PPDelegateParser new.
+	if := 'if' asParser token trim.
+	then := 'then' asParser token trim.
+	else := 'else' asParser token trim.
+	cond := 'C' asParser token trim.
+	expr := 'X' asParser token trim.
+	start setParser: (if , cond , then , start , else , start) / (if , cond , then , start) / expr.
+	parser := start end.
+	self assert: parser parse: 'X'.
+	self assert: parser parse: 'if C then X'.
+	self assert: parser parse: 'if C then X else X'.
+	self assert: parser parse: 'if C then if C then X'.
+	self assert: parser parse: 'if C then if C then X else if C then X'.
+	self assert: parser parse: 'if C then if C then X else X else if C then X'.
+	self assert: parser parse: 'if C then if C then X else X else if C then X else X'.
+	self assert: parser fail: 'if C'.
+	self assert: parser fail: 'if C else X'.
+	self assert: parser fail: 'if C then if C'
+]
+
+{ #category : 'testing' }
+PPComposedTest >> testLeftRecursion [
+	"S ::= S 'x' S / '1'"
+	
+	| parser |
+	parser := PPDelegateParser new.
+	parser setParser: ((parser , $x asParser , parser) / $1 asParser) memoized flatten.
+
+	self assert: parser parse: '1' to: '1'.
+	self assert: parser parse: '1x1' to: '1x1'.
+	self assert: parser parse: '1x1x1' to: '1x1x1'.
+	self assert: parser parse: '1x1x1x1' to: '1x1x1x1'.
+	self assert: parser parse: '1x1x1x1x1' to: '1x1x1x1x1'.
+	self assert: parser parse: '1x1x1x1x1x1' to: '1x1x1x1x1x1'
+]
+
+{ #category : 'testing' }
+PPComposedTest >> testListOfIntegers [
+	"S ::= S , number | number"
+	
+	| number list parser |
+	number := #digit asParser plus flatten trim
+		==> [ :node | node asInteger ].
+	list := (number separatedBy: $, asParser token trim)
+		==> [ :node | node select: [ :each | each isKindOf: Integer ] ].
+	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'
+]
+
+{ #category : 'testing' }
+PPComposedTest >> testNestedComments [
+	"C ::= B I* E"
+	"I ::= !E (C | T)"
+	"B ::= /*"
+	"E ::= */"
+	"T ::= ."
+	
+	| begin end any inside parser |
+	begin := '/*' asParser.
+	end := '*/' asParser.
+	any := #any asParser.
+	
+	parser := PPDelegateParser new.
+	inside := end not , (parser / any).
+	parser setParser: begin , inside star , end.
+	
+	self assert: parser parse: '/*ab*/cd' end: 6.
+	self assert: parser parse: '/*a/*b*/c*/'.
+	self assert: parser fail: '/*a/*b*/c'
+]
+
+{ #category : 'testing-examples' }
+PPComposedTest >> 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'
+]
+
+{ #category : 'testing' }
+PPComposedTest >> testPalindrome [
+	"S0 ::= a S1 a | b S1 b | ...
+	 S1 ::= S0 | epsilon"
+	
+	| s0 s1 parser |
+	s0 := PPDelegateParser new.
+	s1 := PPDelegateParser new.
+	s0 setParser: ($a asParser , s1 , $a asParser)
+		/ ($b asParser , s1 , $b asParser)
+		/ ($c asParser , s1 , $c asParser).	
+	s1 setParser: s0 / nil asParser.
+	parser := s0 flatten end.
+
+	self assert: parser parse: 'aa' to: 'aa'.
+	self assert: parser parse: 'bb' to: 'bb'.
+	self assert: parser parse: 'cc' to: 'cc'.
+	
+	self assert: parser parse: 'abba' to: 'abba'.
+	self assert: parser parse: 'baab' to: 'baab'.
+
+	self assert: parser parse: 'abccba' to: 'abccba'.
+	self assert: parser parse: 'abaaba' to: 'abaaba'.
+	self assert: parser parse: 'cbaabc' to: 'cbaabc'.
+
+	self assert: parser fail: 'a'.
+	self assert: parser fail: 'ab'.
+	self assert: parser fail: 'aab'.
+	self assert: parser fail: 'abccbb'
+]
+
+{ #category : 'testing' }
+PPComposedTest >> testParseAaaBbb [
+	"S0 ::= a S1 b
+	 S1 ::= S0 | epsilon"
+	
+	| s0 s1 parser |
+	s0 := PPDelegateParser new.
+	s1 := PPDelegateParser new.
+	s0 setParser: $a asParser , s1 , $b asParser.
+	s1 setParser: s0 / nil asParser.
+	parser := s0 flatten.
+
+	self assert: parser parse: 'ab' to: 'ab'.
+	self assert: parser parse: 'aabb' to: 'aabb'.
+	self assert: parser parse: 'aaabbb' to: 'aaabbb'.
+	self assert: parser parse: 'aaaabbbb' to: 'aaaabbbb'.
+
+	self assert: parser parse: 'abb' to: 'ab' end: 2.
+	self assert: parser parse: 'aabbb' to: 'aabb' end: 4.
+	self assert: parser parse: 'aaabbbb' to: 'aaabbb' end: 6.
+	self assert: parser parse: 'aaaabbbbb' to: 'aaaabbbb' end: 8.
+
+	self assert: parser fail: 'a'.
+	self assert: parser fail: 'b'.
+	self assert: parser fail: 'aab'.
+	self assert: parser fail: 'aaabb'
+]
+
+{ #category : 'testing' }
+PPComposedTest >> testParseAaaaaa [
+	"S ::= a a S | epsilon"
+	
+	| s0 s1 parser |
+	s0 := PPDelegateParser new.
+	s1 := $a asParser , $a asParser , s0.
+	s0 setParser: s1 / nil asParser.
+	parser := s0 flatten.
+
+	self assert: parser parse: '' to: ''.
+	self assert: parser parse: 'aa' to: 'aa'.
+	self assert: parser parse: 'aaaa' to: 'aaaa'.
+	self assert: parser parse: 'aaaaaa' to: 'aaaaaa'.
+
+	self assert: parser parse: 'a' to: '' end: 0.
+	self assert: parser parse: 'aaa' to: 'aa' end: 2.
+	self assert: parser parse: 'aaaaa' to: 'aaaa' end: 4.
+	self assert: parser parse: 'aaaaaaa' to: 'aaaaaa' end: 6
+]
+
+{ #category : 'testing' }
+PPComposedTest >> 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'
+]
+
+{ #category : 'testing' }
+PPComposedTest >> 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'
+]
+
+{ #category : 'testing' }
+PPComposedTest >> testParseAnBnCn [
+	"PEGs for a non context- free language: 
+		
+		a^n , b^n , c^n
+		
+	S <- &P1 P2 
+	P1 <- AB 'c' 
+	AB <- 'a' AB 'b' / epsilon
+	P2 <- 'a'* BC end
+	BC <- 'b' BC 'c' / epsilon"
+	
+	| s p1 ab p2 bc |
+	s := PPDelegateParser new.
+	p1 := PPDelegateParser new.
+	ab := PPDelegateParser new.
+	p2 := PPDelegateParser new.
+	bc := PPDelegateParser new.
+	
+	s setParser: (p1 and , p2 end) flatten.
+	p1 setParser: ab , $c asParser.
+	ab setParser: ($a asParser , ab , $b asParser) optional.
+	p2 setParser: $a asParser star , bc.
+	bc setParser: ($b asParser , bc , $c asParser) optional.
+	
+	self assert: s parse: 'abc' to: 'abc'.
+	self assert: s parse: 'aabbcc' to: 'aabbcc'.
+	self assert: s parse: 'aaabbbccc' to: 'aaabbbccc'.
+
+	self assert: s fail: 'bc'.
+	self assert: s fail: 'ac'.
+	self assert: s fail: 'ab'.
+	self assert: s fail: 'abbcc'.
+	self assert: s fail: 'aabcc'.
+	self assert: s fail: 'aabbc'
+]
+
+{ #category : 'testing-examples' }
+PPComposedTest >> testReturn [
+	| number spaces return |
+	number := #digit asParser plus flatten.
+	spaces := #space asParser star.
+	return := (spaces , $^ asParser token , spaces , number)
+		==> [ :nodes | Array with: #return with: (nodes at: 4) ].
+
+	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: '^'
+]
diff --git a/software/PetitTests/PPCompositeParserTest.class.st b/software/PetitTests/PPCompositeParserTest.class.st
new file mode 100644
index 0000000..b559ec8
--- /dev/null
+++ b/software/PetitTests/PPCompositeParserTest.class.st
@@ -0,0 +1,130 @@
+Class {
+	#name : 'PPCompositeParserTest',
+	#superclass : 'PPAbstractParserTest',
+	#instVars : [
+		'parser',
+		'result',
+		'debugResult'
+	],
+	#category : 'PetitTests-Core'
+}
+
+{ #category : 'testing' }
+PPCompositeParserTest class >> isAbstract [
+	^ self name = #PPCompositeParserTest
+]
+
+{ #category : 'accessing' }
+PPCompositeParserTest class >> resources [
+	^ Array with: PPParserResource
+]
+
+{ #category : 'utilities' }
+PPCompositeParserTest >> assert: aCollection is: anObject [
+	self parse: aCollection.
+	self
+		assert: result = anObject
+		description: 'Got: ' , result printString , '; Expected: ' , anObject printString
+		resumable: true
+]
+
+{ #category : 'parsing' }
+PPCompositeParserTest >> debug: aString [ 
+	^ self debug: aString rule: #start
+]
+
+{ #category : 'parsing' }
+PPCompositeParserTest >> debug: aString rule: aSymbol [
+	| production context |
+	production := self parserInstanceFor: aSymbol.
+	context := self context.
+	
+	debugResult := production end enableDebug parse: aString withContext: context.
+	result := debugResult children first result.
+	
+	self
+		deny: result isPetitFailure
+		description: 'Unable to parse ' , aString printString.	
+	
+	^ debugResult
+]
+
+{ #category : 'parsing' }
+PPCompositeParserTest >> fail: aString rule: aSymbol [ 
+	| production context |
+	production := self parserInstanceFor: aSymbol.
+	context := self context.
+	
+	result := production end parse: aString withContext: context.
+	
+	self
+		assert: result isPetitFailure
+		description: 'Able to parse ' , aString printString.
+	^ result
+]
+
+{ #category : 'parsing' }
+PPCompositeParserTest >> parse: aString [ 
+	^ self parse: aString rule: #start
+]
+
+{ #category : 'parsing' }
+PPCompositeParserTest >> parse: aString rule: aSymbol [
+	| production context |
+	production := self parserInstanceFor: aSymbol.
+	context := self context.
+	
+	result := production end parse: aString withContext: context.
+	self
+		deny: result isPetitFailure
+		description: 'Unable to parse ' , aString printString.
+	^ result
+]
+
+{ #category : 'parsing' }
+PPCompositeParserTest >> parse: aString rule: aSymbol to: expectedResult end: end [
+	| production context |
+	production := self parserInstanceFor: aSymbol.
+	context := self context.
+	
+	result := production parse: aString withContext: context.
+	self
+		deny: result isPetitFailure
+		description: 'Unable to parse ' , aString printString.
+	
+	self assert: expectedResult = result.
+	self assert: context position = end.
+	^ result
+]
+
+{ #category : 'accessing' }
+PPCompositeParserTest >> parserClass [
+	self subclassResponsibility
+]
+
+{ #category : 'accessing' }
+PPCompositeParserTest >> parserInstance [
+	^ PPParserResource current parserAt: self parserClass
+]
+
+{ #category : 'accessing' }
+PPCompositeParserTest >> parserInstanceFor: aSymbol [
+	^ aSymbol = #start
+		ifTrue: [ self parserInstance ]
+		ifFalse: [
+			self parserInstance
+				productionAt: aSymbol 
+				ifAbsent: [ self error: 'Production ' , self parserClass name , '>>' , aSymbol printString , ' not found.' ] ]
+]
+
+{ #category : 'running' }
+PPCompositeParserTest >> setUp [
+	super setUp.
+	parser := self parserInstance
+]
+
+{ #category : 'running' }
+PPCompositeParserTest >> tearDown [
+	super tearDown.
+	parser := result := nil
+]
diff --git a/software/PetitTests/PPConditionalParserTest.class.st b/software/PetitTests/PPConditionalParserTest.class.st
new file mode 100644
index 0000000..49f44c4
--- /dev/null
+++ b/software/PetitTests/PPConditionalParserTest.class.st
@@ -0,0 +1,52 @@
+Class {
+	#name : 'PPConditionalParserTest',
+	#superclass : 'PPAbstractParserTest',
+	#instVars : [
+		'context'
+	],
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'as yet unclassified' }
+PPConditionalParserTest >> context [
+	^ context
+]
+
+{ #category : 'as yet unclassified' }
+PPConditionalParserTest >> setUp [
+	super setUp.
+	context := PPContext new
+]
+
+{ #category : 'as yet unclassified' }
+PPConditionalParserTest >> testConditionCtxAccess [
+	| parser |
+
+	parser := ('a' asParser if: [ :ctx | (ctx propertyAt: #foo) = #bar ]).
+	
+	context propertyAt: #foo put: #bar.
+	self assert: parser parse: 'a' .
+
+
+	context propertyAt: #foo put: #zorg.
+	self assert: parser fail: 'a' .
+
+]
+
+{ #category : 'as yet unclassified' }
+PPConditionalParserTest >> testConditionFalse [
+	| parser |
+	parser := ('a' asParser if: [ :ctx | false ]).
+	
+	self assert: parser fail: 'a'.
+	self assert: parser fail: 'b'.
+]
+
+{ #category : 'as yet unclassified' }
+PPConditionalParserTest >> testConditionTrue [
+	| parser |
+	parser := ('a' asParser if: [ :ctx | true ]).
+	
+	self assert: parser parse: 'a'.
+	self assert: parser fail: 'b'.
+]
diff --git a/software/PetitTests/PPConditionalParserTests.class.st b/software/PetitTests/PPConditionalParserTests.class.st
new file mode 100644
index 0000000..59540f3
--- /dev/null
+++ b/software/PetitTests/PPConditionalParserTests.class.st
@@ -0,0 +1,52 @@
+Class {
+	#name : 'PPConditionalParserTests',
+	#superclass : 'PPAbstractParserTest',
+	#instVars : [
+		'context'
+	],
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'as yet unclassified' }
+PPConditionalParserTests >> context [
+	^ context
+]
+
+{ #category : 'as yet unclassified' }
+PPConditionalParserTests >> setUp [
+	super setUp.
+	context := PPContext new
+]
+
+{ #category : 'as yet unclassified' }
+PPConditionalParserTests >> testConditionCtxAccess [
+	| parser |
+
+	parser := ('a' asParser if: [ :ctx | (ctx propertyAt: #foo) = #bar ]).
+	
+	context propertyAt: #foo put: #bar.
+	self assert: parser parse: 'a' .
+
+
+	context propertyAt: #foo put: #zorg.
+	self assert: parser fail: 'a' .
+
+]
+
+{ #category : 'as yet unclassified' }
+PPConditionalParserTests >> testConditionFalse [
+	| parser |
+	parser := ('a' asParser if: [ :ctx | false ]).
+	
+	self assert: parser fail: 'a'.
+	self assert: parser fail: 'b'.
+]
+
+{ #category : 'as yet unclassified' }
+PPConditionalParserTests >> testConditionTrue [
+	| parser |
+	parser := ('a' asParser if: [ :ctx | true ]).
+	
+	self assert: parser parse: 'a'.
+	self assert: parser fail: 'b'.
+]
diff --git a/software/PetitTests/PPContextMementoTest.class.st b/software/PetitTests/PPContextMementoTest.class.st
new file mode 100644
index 0000000..2603aa8
--- /dev/null
+++ b/software/PetitTests/PPContextMementoTest.class.st
@@ -0,0 +1,123 @@
+Class {
+	#name : 'PPContextMementoTest',
+	#superclass : 'TestCase',
+	#instVars : [
+		'memento'
+	],
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'accessing' }
+PPContextMementoTest >> memento [
+	^ PPContextMemento new
+]
+
+{ #category : 'running' }
+PPContextMementoTest >> setUp [
+	super setUp.
+	memento := self memento.
+]
+
+{ #category : 'tests' }
+PPContextMementoTest >> testEquality [
+	| m1 m2  |
+	m1 := self memento.
+	m2 := self memento.
+	
+	self assert: m1 = m2.
+	
+	m1 propertyAt: #foo put: #bar.
+	self assert: (m1 = m2) not.
+	
+	m2 propertyAt: #foo put: #bar.
+	self assert: m1 = m2.
+
+]
+
+{ #category : 'tests' }
+PPContextMementoTest >> testEquality2 [
+	| m1 m2  |
+	m1 := self memento.
+	m2 := self memento.
+	
+	self assert: m1 = m2.
+	
+	m1 propertyAt: #foo put: #bar.
+	self assert: (m1 = m2) not.
+	
+	m2 propertyAt: #bar put: #foo.
+	self assert: (m1 = m2) not.
+
+]
+
+{ #category : 'tests' }
+PPContextMementoTest >> testGetProperty [
+	
+	| c retval retval2 |
+	c := OrderedCollection new.
+	
+	memento propertyAt: #foo put: c.
+	
+	retval := memento propertyAt: #foo.
+	self assert: retval size = c size.
+	self assert: (retval == c) not.
+	self assert: retval = c.
+	
+	c add: #element.
+	self assert: (retval = c) not.
+
+	retval2 := memento propertyAt: #foo.
+	self assert: (retval = retval2).
+	self assert: (retval == retval2) not.
+	
+	retval add: #element.
+	self assert: (retval = retval2) not.
+
+]
+
+{ #category : 'tests' }
+PPContextMementoTest >> testKeysAndValuesDo [
+	|   |
+	memento keysAndValuesDo: [ :key :value |
+		self signalFailure: 'Should not be called'
+	].
+]
+
+{ #category : 'tests' }
+PPContextMementoTest >> testKeysAndValuesDo2 [
+	| c1 c2   |
+	c1 := OrderedCollection new.
+	c2 := OrderedCollection new.
+
+	memento propertyAt: #foo put: c1.
+	memento propertyAt: #bar put: c2.
+
+	memento keysAndValuesDo: [ :key :value |
+		self assert: (value == c1) not.
+		self assert: (value == c2) not.
+	].
+]
+
+{ #category : 'tests' }
+PPContextMementoTest >> testPutProperty [
+	| c retval  |
+	c := OrderedCollection new.
+	self assert: (memento hasProperty: #foo) not.
+	self assert: (memento hasProperty: #bar) not.	
+	
+	self should: [ memento propertyAt: #foo ] raise: Error.
+	self assert: (memento propertyAt: #foo ifAbsent: [ c ]) == c.
+	
+	retval := memento propertyAt: #foo ifAbsentPut: [ c ].
+	self assert: retval size = c size.	
+	self assert: (retval == c) not.
+	self assert: retval = c.
+	self assert: (memento hasProperty: #foo).
+	
+	retval := memento propertyAt: #bar put: c.
+	self assert: retval size = c size.	
+	self assert: (retval == c) not.
+	self assert: retval = c.
+	self assert: (memento hasProperty: #foo).	
+
+]
diff --git a/software/PetitTests/PPContextTest.class.st b/software/PetitTests/PPContextTest.class.st
new file mode 100644
index 0000000..4c1db80
--- /dev/null
+++ b/software/PetitTests/PPContextTest.class.st
@@ -0,0 +1,205 @@
+Class {
+	#name : 'PPContextTest',
+	#superclass : 'TestCase',
+	#instVars : [
+		'context'
+	],
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'as yet unclassified' }
+PPContextTest >> context [
+	^ PPContext new
+]
+
+{ #category : 'as yet unclassified' }
+PPContextTest >> setUp [
+	super setUp.
+	context := self context.
+]
+
+{ #category : 'tests' }
+PPContextTest >> testFurthestFailure [
+	| f1 f2 |
+	
+	f1 := PPFailure message: #foo context: context at: 1.
+	self assert: context furthestFailure = f1.	
+	f2 := PPFailure message: #foo context: context at: 1.
+	self assert: context furthestFailure = f1.	
+	f2 := PPFailure message: #foo context: context at: 3.
+	self assert: context furthestFailure = f2.
+]
+
+{ #category : 'tests' }
+PPContextTest >> testMemoization [
+	| stream memento memento2 collection |
+	stream := 'abc' asPetitStream.
+	context := context stream: stream.
+	collection := OrderedCollection new.
+
+	context propertyAt: #foo put: collection.
+	
+	memento := context remember.
+	
+	self assert: memento isNil not.
+	
+	context next.
+	collection add: #element.
+	self assert: (context propertyAt: #foo) size = 1. 	
+
+	memento2 := context remember.
+
+	context restore: memento.
+	self assert: (context propertyAt: #foo) size = 0. 
+	self assert: context position = 0.
+	
+	context restore: memento2.
+	self assert: (context propertyAt: #foo) size = 1. 
+	self assert: context position = 1.
+
+]
+
+{ #category : 'tests' }
+PPContextTest >> testMemoization2 [
+	| stream memento |
+	stream := 'abc' asPetitStream.
+	context := context stream: stream.
+	
+	memento := context remember.
+	
+	context next.
+	self assert: context position = 1.
+	
+	context restore: memento.
+	self assert: context position = 0.
+
+]
+
+{ #category : 'tests' }
+PPContextTest >> testMemoization3 [
+	| stream memento memento2 collection |
+	stream := 'abc' asPetitStream.
+	context := context stream: stream.
+	collection := OrderedCollection new.
+
+	memento := context remember.
+	context propertyAt: #foo put: collection.
+	memento2 := context remember.
+	
+	context restore: memento.
+	self assert: (context hasProperty: #foo) not.
+	
+	context restore: memento2.
+	self assert: (context hasProperty: #foo).
+]
+
+{ #category : 'tests' }
+PPContextTest >> testPutGlobals [
+	self assert: (context hasGlobal: #foo) not.
+	self assert: (context hasGlobal: #bar) not.	
+	
+	self should: [ context globalAt: #foo ] raise: Error.
+	self assert: (context globalAt: #foo ifAbsent: [ #bar ]) = #bar.
+	
+	self assert: (context globalAt: #foo ifAbsentPut: [ #bar ]) = #bar.	
+	self assert: (context hasGlobal: #foo).
+	self assert: (context hasGlobal: #bar) not.	
+	self assert: (context globalAt: #foo) = #bar.
+	
+	self assert: (context globalAt: #foo ifAbsentPut: [ #zorg ]) = #bar.	
+	self assert: (context hasGlobal: #foo).
+	self assert: (context hasGlobal: #bar) not.	
+	self assert: (context globalAt: #foo) = #bar.
+	
+	self assert: (context globalAt: #foo put: #zorg) = #zorg.	
+	self assert: (context hasGlobal: #foo).
+	self assert: (context hasGlobal: #bar) not.	
+	self assert: (context globalAt: #foo) = #zorg.
+	
+	self should: [ context globalAt: #bar ] raise: Error.
+	self assert: (context globalAt: #bar put: #foo) = #foo.
+	self assert: (context globalAt: #foo) = #zorg.
+	self assert: (context globalAt: #bar) = #foo.
+
+
+]
+
+{ #category : 'tests' }
+PPContextTest >> testPutProperties [
+	self assert: (context hasProperty: #foo) not.
+	self assert: (context hasProperty: #bar) not.	
+	
+	self should: [ context propertyAt: #foo ] raise: Error.
+	self assert: (context propertyAt: #foo ifAbsent: [ #bar ]) = #bar.
+	
+	self assert: (context propertyAt: #foo ifAbsentPut: [ #bar ]) = #bar.	
+	self assert: (context hasProperty: #foo).
+	self assert: (context hasProperty: #bar) not.	
+	self assert: (context propertyAt: #foo) = #bar.
+	
+	self assert: (context propertyAt: #foo ifAbsentPut: [ #zorg ]) = #bar.	
+	self assert: (context hasProperty: #foo).
+	self assert: (context hasProperty: #bar) not.	
+	self assert: (context propertyAt: #foo) = #bar.
+	
+	self assert: (context propertyAt: #foo put: #zorg) = #zorg.	
+	self assert: (context hasProperty: #foo).
+	self assert: (context hasProperty: #bar) not.	
+	self assert: (context propertyAt: #foo) = #zorg.
+	
+	self should: [ context propertyAt: #bar ] raise: Error.
+	self assert: (context propertyAt: #bar put: #foo) = #foo.
+	self assert: (context propertyAt: #foo) = #zorg.
+	self assert: (context propertyAt: #bar) = #foo.
+
+
+]
+
+{ #category : 'tests' }
+PPContextTest >> testRemoveGlobals [
+	context globalAt: #foo put: #zorg.
+	context globalAt: #bar put: #qwark.	
+
+	self assert: (context removeGlobal: #foo) = #zorg.
+	self assert: (context removeGlobal: #bar) = #qwark.
+	
+	self should: [context removeGlobal: #foo] raise: Error.
+	self assert: (context removeGlobal: #bar ifAbsent: [ #foobar ]) = #foobar.
+
+]
+
+{ #category : 'tests' }
+PPContextTest >> testRemoveProperties [
+	context propertyAt: #foo put: #zorg.
+	context propertyAt: #bar put: #qwark.	
+
+	self assert: (context removeProperty: #foo) = #zorg.
+	self assert: (context removeProperty: #bar) = #qwark.
+	
+	self should: [context removeProperty: #foo] raise: Error.
+	self assert: (context removeProperty: #bar ifAbsent: [ #foobar ]) = #foobar.
+
+]
+
+{ #category : 'tests' }
+PPContextTest >> testStreamProtocol [
+	context stream: 'hi there' asPetitStream.
+	
+	self assert: context position = 0.
+	self assert: context peek = $h.
+	self assert: context uncheckedPeek = $h.
+
+	self assert: context next = $h.
+	self assert: context peek = $i.
+	self assert: context uncheckedPeek = $i.
+	self assert: context position = 1.
+	
+	context skip: 2.
+	self assert: context position = 3.
+	self assert: context peek = $t.
+	self assert: context atEnd not.
+	
+	self assert: (context next: 5) = 'there'.
+	self assert: context position = 8.
+	self assert: context atEnd.
+]
diff --git a/software/PetitTests/PPExpressionParserTest.class.st b/software/PetitTests/PPExpressionParserTest.class.st
new file mode 100644
index 0000000..b2c4936
--- /dev/null
+++ b/software/PetitTests/PPExpressionParserTest.class.st
@@ -0,0 +1,66 @@
+Class {
+	#name : 'PPExpressionParserTest',
+	#superclass : 'PPArithmeticParserTest',
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'testing' }
+PPExpressionParserTest class >> shouldInheritSelectors [
+	^ true
+]
+
+{ #category : 'accessing' }
+PPExpressionParserTest >> parserInstance [
+	| expression parens number |
+	expression := PPExpressionParser new.
+	parens := $( asParser trim , expression , $) asParser trim
+		==> [ :value | value second ].
+	number := (#digit asParser plus , ($. asParser , #digit asParser plus) optional) flatten trim
+		==> [ :value | value asNumber ].
+	expression term: parens / number.
+	expression
+		group: [ :g |
+			g prefix: $- asParser trim do: [ :op :a | a negated ] ];
+		group: [ :g |
+			g postfix: '++' asParser trim do: [ :a :op | a + 1 ].
+			g postfix: '--' asParser trim do: [ :a :op | a - 1 ] ];
+		group: [ :g |
+			g right: $^ asParser trim do: [ :a :op :b | a raisedTo: b ] ];
+		group: [ :g |
+			g left: $* asParser trim do: [ :a :op :b | a * b ].
+			g left: $/ asParser trim do: [ :a :op :b | a / b ] ];
+		group: [ :g |
+			g left: $+ asParser trim do: [ :a :op :b | a + b ].
+			g left: $- asParser trim do: [ :a :op :b | a - b ] ].
+	^ expression end
+]
+
+{ #category : 'testing' }
+PPExpressionParserTest >> 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
+]
+
+{ #category : 'testing' }
+PPExpressionParserTest >> 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.
+]
+
+{ #category : 'testing' }
+PPExpressionParserTest >> testPrefixNegate [
+	self assert: '1' is: 1.
+	self assert: '-1' is: -1.
+	self assert: '--1' is: 1.
+	self assert: '---1' is: -1
+]
diff --git a/software/PetitTests/PPExtensionTest.class.st b/software/PetitTests/PPExtensionTest.class.st
new file mode 100644
index 0000000..baceea0
--- /dev/null
+++ b/software/PetitTests/PPExtensionTest.class.st
@@ -0,0 +1,121 @@
+Class {
+	#name : 'PPExtensionTest',
+	#superclass : 'PPAbstractParserTest',
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'testing-parser' }
+PPExtensionTest >> testCharacter [
+	| parser |
+	parser := $a asParser.
+	self assert: parser parse: 'a' to: $a.
+	self assert: parser fail: 'b'
+]
+
+{ #category : 'testing-parser' }
+PPExtensionTest >> testChoice [
+	| parser |
+	parser := #(1 2) asChoiceParser.
+	self assert: parser parse: #(1) to: 1.
+	self assert: parser parse: #(2) to: 2.
+	self assert: parser parse: #(1 2) to: 1 end: 1.
+	self assert: parser parse: #(2 1) to: 2 end: 1.
+	self assert: parser fail: #().
+	self assert: parser fail: #(3)
+]
+
+{ #category : 'testing-parser' }
+PPExtensionTest >> 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' context: stream ] asParser.
+	self assert: parser fail: ''.
+	self assert: parser fail: 's'.
+	self assert: parser fail: 'as'
+	
+]
+
+{ #category : 'testing-parser' }
+PPExtensionTest >> testEpsilon [
+	| parser |
+	parser := nil asParser.
+	self assert: parser asParser equals: parser
+]
+
+{ #category : 'testing-parser' }
+PPExtensionTest >> testParser [
+	| parser |
+	parser := $a asParser.
+	self assert: parser asParser equals: parser
+]
+
+{ #category : 'testing-parser' }
+PPExtensionTest >> testRange [
+	| parser |
+	parser := ($a to: $c) asParser.
+	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'
+]
+
+{ #category : 'testing-parser' }
+PPExtensionTest >> testSequence [
+	| parser |
+	parser := #(1 2) asSequenceParser.
+	self assert: parser parse: #(1 2) to: #(1 2).
+	self assert: parser parse: #(1 2 3) to: #(1 2) end: 2.
+	self assert: parser fail: #().
+	self assert: parser fail: #(1).
+	self assert: parser fail: #(1 1).
+	self assert: parser fail: #(1 1 2)
+]
+
+{ #category : 'testing-stream' }
+PPExtensionTest >> testStream [
+	| dot stream |
+	dot := (Character codePoint: 183) asString.
+	stream := 'abc' readStream asPetitStream.
+	self assert: stream class equals: PPStream.
+	self assert: stream printString equals: dot , 'abc'.
+	self assert: stream peek equals: $a.
+	self assert: stream uncheckedPeek equals: $a.
+	self assert: stream next equals: $a.
+	self assert: stream printString equals: 'a' , dot , 'bc'.
+	self assert: stream asPetitStream equals: stream
+]
+
+{ #category : 'testing-parser' }
+PPExtensionTest >> 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'
+]
+
+{ #category : 'testing-parser' }
+PPExtensionTest >> testSymbol [
+	| parser |
+	parser := #any asParser.
+	self assert: parser parse: 'a'.
+	self assert: parser fail: ''
+]
+
+{ #category : 'testing-stream' }
+PPExtensionTest >> testText [
+	| stream |
+	stream := 'abc' asText asPetitStream.
+	self assert: stream class equals: PPStream
+]
diff --git a/software/PetitTests/PPLambdaParser.class.st b/software/PetitTests/PPLambdaParser.class.st
new file mode 100644
index 0000000..42d8943
--- /dev/null
+++ b/software/PetitTests/PPLambdaParser.class.st
@@ -0,0 +1,68 @@
+Class {
+	#name : 'PPLambdaParser',
+	#superclass : 'PPCompositeParser',
+	#instVars : [
+		'expression',
+		'abstraction',
+		'application',
+		'variable'
+	],
+	#category : 'PetitTests-Examples'
+}
+
+{ #category : 'curch-booleans' }
+PPLambdaParser class >> and [
+	^ self parse: '\p.\q.((p q) p)'
+]
+
+{ #category : 'curch-booleans' }
+PPLambdaParser class >> false [
+	^ self parse: '\x.\y.y'
+]
+
+{ #category : 'curch-booleans' }
+PPLambdaParser class >> ifthenelse [
+	^ self parse: '\p.p'
+]
+
+{ #category : 'curch-booleans' }
+PPLambdaParser class >> not [
+	^ self parse: '\p.\a.\b.((p b) a)'
+]
+
+{ #category : 'curch-booleans' }
+PPLambdaParser class >> or [
+	^ self parse: '\p.\q.((p p) q)'
+]
+
+{ #category : 'curch-booleans' }
+PPLambdaParser class >> true [
+	^ self parse: '\x.\y.x'
+]
+
+{ #category : 'productions' }
+PPLambdaParser >> abstraction [
+	^ $\ asParser trim , variable , $. asParser trim , expression 
+		==> [ :node | Array with: (node at: 2) with: (node at: 4) ]
+]
+
+{ #category : 'productions' }
+PPLambdaParser >> application [
+	^ $( asParser trim , expression , expression , $) asParser trim 
+			==> [ :node | Array with: (node at: 2) with: (node at: 3) ]
+]
+
+{ #category : 'productions' }
+PPLambdaParser >> expression [
+	^ variable / abstraction / application
+]
+
+{ #category : 'accessing' }
+PPLambdaParser >> start [
+	^ expression end
+]
+
+{ #category : 'productions' }
+PPLambdaParser >> variable [
+	^ (#letter asParser , #word asParser star) flatten trim
+]
diff --git a/software/PetitTests/PPLambdaParserTest.class.st b/software/PetitTests/PPLambdaParserTest.class.st
new file mode 100644
index 0000000..5c231af
--- /dev/null
+++ b/software/PetitTests/PPLambdaParserTest.class.st
@@ -0,0 +1,73 @@
+Class {
+	#name : 'PPLambdaParserTest',
+	#superclass : 'PPCompositeParserTest',
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'accessing' }
+PPLambdaParserTest >> parserClass [
+	^ PPLambdaParser
+]
+
+{ #category : 'testing' }
+PPLambdaParserTest >> testAbstraction [
+	self assert: '\x.y' is: #('x' 'y').
+	self assert: '\x.\y.z' is: #('x' ('y' 'z'))
+]
+
+{ #category : 'testing-curch' }
+PPLambdaParserTest >> testAnd [
+	self assert: self parserClass and equals: #('p' #('q' #(#('p' 'q') 'p')))
+]
+
+{ #category : 'testing' }
+PPLambdaParserTest >> 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'))
+]
+
+{ #category : 'testing-curch' }
+PPLambdaParserTest >> testFalse [
+	self assert: self parserClass false equals: #('x' #('y' 'y'))
+]
+
+{ #category : 'testing-curch' }
+PPLambdaParserTest >> testIfThenElse [
+	self assert: self parserClass ifthenelse equals: #('p' 'p')
+]
+
+{ #category : 'testing-curch' }
+PPLambdaParserTest >> testNot [
+	self assert: self parserClass not equals: #('p' #('a' #('b' #(#('p' 'b') 'a'))))
+]
+
+{ #category : 'testing-curch' }
+PPLambdaParserTest >> testOr [
+	self assert: self parserClass or equals: #('p' #('q' #(#('p' 'p') 'q')))
+]
+
+{ #category : 'testing-utilities' }
+PPLambdaParserTest >> 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
+]
+
+{ #category : 'testing-curch' }
+PPLambdaParserTest >> testTrue [
+	self assert: self parserClass true equals: #('x' #('y' 'x'))
+]
+
+{ #category : 'testing' }
+PPLambdaParserTest >> testVariable [
+	self assert: 'x' is: 'x'.
+	self assert: 'xy' is: 'xy'.
+	self assert: 'x12' is: 'x12'
+]
diff --git a/software/PetitTests/PPMappingTest.class.st b/software/PetitTests/PPMappingTest.class.st
new file mode 100644
index 0000000..8709015
--- /dev/null
+++ b/software/PetitTests/PPMappingTest.class.st
@@ -0,0 +1,83 @@
+Class {
+	#name : 'PPMappingTest',
+	#superclass : 'PPAbstractParserTest',
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'as yet unclassified' }
+PPMappingTest >> 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)
+
+]
+
+{ #category : 'as yet unclassified' }
+PPMappingTest >> 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)
+
+]
+
+{ #category : 'as yet unclassified' }
+PPMappingTest >> 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))))
+]
+
+{ #category : 'as yet unclassified' }
+PPMappingTest >> 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))
+]
+
+{ #category : 'as yet unclassified' }
+PPMappingTest >> testMap1 [
+	| parser |
+	parser := #any asParser 
+		map: [ :a | Array with: a ].
+
+	self assert: parser parse: #(a) to: #(a)
+]
+
+{ #category : 'as yet unclassified' }
+PPMappingTest >> testMap2 [
+	| parser |
+	parser := (#any asParser , #any asParser) 
+		map: [ :a :b | Array with: b with: a ].
+
+	self assert: parser parse: #(a b) to: #(b a)
+]
+
+{ #category : 'as yet unclassified' }
+PPMappingTest >> 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)
+
+]
diff --git a/software/PetitTests/PPObjectTest.class.st b/software/PetitTests/PPObjectTest.class.st
new file mode 100644
index 0000000..e64c38f
--- /dev/null
+++ b/software/PetitTests/PPObjectTest.class.st
@@ -0,0 +1,74 @@
+Class {
+	#name : 'PPObjectTest',
+	#superclass : 'PPAbstractParserTest',
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'parsers' }
+PPObjectTest >> integer [
+	^ PPPredicateObjectParser
+		on: [ :each | each isKindOf: Integer ]
+		message: 'integer expected'
+]
+
+{ #category : 'parsers' }
+PPObjectTest >> string [
+	^ PPPredicateObjectParser
+		on: [ :each | each isKindOf: String ]
+		message: 'string expected'
+]
+
+{ #category : 'testing-operators' }
+PPObjectTest >> testChoice [
+	| parser |
+	parser := self integer / self string.
+	self assert: parser parse: #(123) to: 123.
+	self assert: parser parse: #('abc') to: 'abc'
+]
+
+{ #category : 'testing-fancy' }
+PPObjectTest >> 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' context: stream ] ]).
+	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
+	
+]
+
+{ #category : 'testing' }
+PPObjectTest >> testInteger [
+	self assert: self integer parse: #(123) to: 123.
+	self assert: self integer fail: #('abc')
+]
+
+{ #category : 'testing-operators' }
+PPObjectTest >> 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)
+	
+]
+
+{ #category : 'testing' }
+PPObjectTest >> testString [
+	self assert: self string parse: #('abc') to: 'abc'.
+	self assert: self string fail: #(123)
+]
diff --git a/software/PetitTests/PPParserResource.class.st b/software/PetitTests/PPParserResource.class.st
new file mode 100644
index 0000000..f0a6064
--- /dev/null
+++ b/software/PetitTests/PPParserResource.class.st
@@ -0,0 +1,21 @@
+Class {
+	#name : 'PPParserResource',
+	#superclass : 'TestResource',
+	#instVars : [
+		'parsers'
+	],
+	#category : 'PetitTests-Core'
+}
+
+{ #category : 'accessing' }
+PPParserResource >> parserAt: aParserClass [
+	"Answer a cached instance of aParserClass."
+	
+	^ parsers at: aParserClass name ifAbsentPut: [ aParserClass new ]
+]
+
+{ #category : 'running' }
+PPParserResource >> setUp [
+	super setUp.
+	parsers := Dictionary new
+]
diff --git a/software/PetitTests/PPParserTest.class.st b/software/PetitTests/PPParserTest.class.st
new file mode 100644
index 0000000..9a86973
--- /dev/null
+++ b/software/PetitTests/PPParserTest.class.st
@@ -0,0 +1,1600 @@
+Class {
+	#name : 'PPParserTest',
+	#superclass : 'PPAbstractParserTest',
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'testing-mapping' }
+PPParserTest >> testAction [
+	| block parser |
+	block := [ :char | char asUppercase ].
+	parser := #any asParser ==> block.
+	self assert: parser block equals: block.
+	self assert: parser parse: 'a' to: $A.
+	self assert: parser parse: 'b' to: $B
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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 equals: parser
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> testAnswer [
+	| parser |
+	parser := $a asParser answer: $b.
+	
+	self assert: parser parse: 'a' to: $b.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> 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 equals: 1.
+	self assert: p3 children size equals: 2
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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'
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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'
+]
+
+{ #category : 'testing' }
+PPParserTest >> testDelimitedByWithoutSeparators [
+	| parser |
+	parser := ($a asParser delimitedBy: $b asParser)
+		withoutSeparators.
+	
+	self assert: parser parse: 'a' to: #($a).
+	self assert: parser parse: 'aba' to: #($a $a).
+	self assert: parser parse: 'ababa' to: #($a $a $a).
+
+	self assert: parser parse: 'ab' to: #($a).
+	self assert: parser parse: 'abab' to: #($a $a).
+	self assert: parser parse: 'ababab' to: #($a $a $a).
+	
+	self assert: parser parse: 'ac' to: #($a) end: 1.
+	self assert: parser parse: 'abc' to: #($a) end: 2.
+	self assert: parser parse: 'abac' to: #($a $a) end: 3.
+	self assert: parser parse: 'ababc' to: #($a $a) end: 4.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'.
+	self assert: parser fail: 'c'
+]
+
+{ #category : 'testing' }
+PPParserTest >> testEndOfInput [
+	| parser |
+	parser := PPEndOfInputParser on: $a asParser.
+	self assert: parser end equals: parser.
+	self assert: parser parse: 'a' to: $a.
+	self assert: parser fail: ''.
+	self assert: parser fail: 'aa'
+]
+
+{ #category : 'testing' }
+PPParserTest >> testEndOfInputAfterMatch [
+	| parser |
+	parser := 'stuff' asParser end.
+	self assert: parser parse: 'stuff' to: 'stuff'.
+	self assert: parser fail: 'stufff'.
+	self assert: parser fail: 'fluff'
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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
+]
+
+{ #category : 'testing' }
+PPParserTest >> testFailing [
+	| parser result |
+	parser := PPFailingParser message: 'Plonk'.
+	self assert: parser message equals: 'Plonk'.
+	self assert: parser fail: ''.
+	self assert: parser fail: 'a'.
+	self assert: parser fail: 'aa'.
+	result := parser parse: 'a'.
+	self assert: result message equals: 'Plonk'.
+	self assert: result printString equals: 'Plonk at 0'
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testFailure [
+	| failure |
+	failure := PPFailure message: 'Error' context: PPContext new at: 3.
+	self assert: failure message equals: 'Error'.
+	self assert: failure position equals: 3.
+	self assert: failure isPetitFailure.
+	self deny: 4 isPetitFailure.
+	self deny: 'foo' isPetitFailure
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> 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'
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> 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)
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> 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)
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> 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))))
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> 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))
+]
+
+{ #category : 'testing-properties' }
+PPParserTest >> testHasProperty [
+	| parser |
+	parser := PPParser new.
+	self deny: (parser hasProperty: #foo).
+	parser propertyAt: #foo put: 123.
+	self assert: (parser hasProperty: #foo)
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> 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 equals: 1.
+	self assert: p2 children size equals: 2.
+	self assert: p3 children size equals: 3
+]
+
+{ #category : 'testing' }
+PPParserTest >> testLiteralObject [
+	| parser |
+	parser := PPLiteralObjectParser on: $a message: 'letter "a" expected'.
+	self assert: parser literal equals: $a.
+	self assert: parser message equals: 'letter "a" expected'.
+	self assert: parser parse: 'a' to: $a.
+	self assert: parser fail: 'b'
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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'
+	
+]
+
+{ #category : 'testing' }
+PPParserTest >> testLiteralSequence [
+	| parser |
+	parser := PPLiteralSequenceParser on: 'abc' message: 'sequence "abc" expected'.
+	self assert: parser size equals: 3.
+	self assert: parser literal equals: 'abc'.
+	self assert: parser message equals: 'sequence "abc" expected'.
+	self assert: parser parse: 'abc' to: 'abc'.
+	self assert: parser fail: 'ab'.
+	self assert: parser fail: 'abd'
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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'
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> testMap1 [
+	| parser |
+	parser := #any asParser 
+		map: [ :a | Array with: a ].
+
+	self assert: parser parse: #(a) to: #(a)
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> testMap2 [
+	| parser |
+	parser := (#any asParser , #any asParser) 
+		map: [ :a :b | Array with: b with: a ].
+
+	self assert: parser parse: #(a b) to: #(b a)
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> 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)
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> testMapFail1 [
+	self
+		should: [ #any asParser map: [  ] ]
+		raise: Error.
+	self
+		should: [ #any asParser map: [ :a :b | ] ]
+		raise: Error
+
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> testMapFail2 [
+	self
+		should: [ (#any asParser , #any asParser) map: [ :a | ] ]
+		raise: Error.
+	self
+		should: [ (#any asParser , #any asParser) map: [ :a :b :c | ] ]
+		raise: Error
+
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> 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)
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testMatchesIn [
+	| parser result |
+	parser := $a asParser.
+	result := parser matchesIn: 'abba'.
+	self assert: result size equals: 2.
+	self assert: result first equals: $a.
+	self assert: result last equals: $a.
+	result := parser matchesIn: 'baaah'.
+	self assert: result size equals: 3.
+	self assert: result first equals: $a.
+	self assert: result last equals: $a
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> 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 equals: #(0 1 2 3)
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testMatchesInOverlapping [
+	"Matches that overlap should be properly reported."
+
+	| parser result |
+	parser := #digit asParser , #digit asParser.
+	result := parser matchesIn: 'a123b'.
+	self assert: result size equals: 2.
+	self assert: result first equals: #($1 $2).
+	self assert: result last equals: #($2 $3)
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testMatchesSkipIn [
+	| parser result |
+	parser := $a asParser.
+	result := parser matchesSkipIn: 'abba'.
+	self assert: result size equals: 2.
+	self assert: result first equals: $a.
+	self assert: result last equals: $a.
+	result := parser matchesSkipIn: 'baaah'.
+	self assert: result size equals: 3.
+	self assert: result first equals: $a.
+	self assert: result last equals: $a
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testMatchesSkipInOverlapping [
+	"Matches that overlap should be properly reported."
+
+	| parser result |
+	parser := #digit asParser , #digit asParser.
+	result := parser matchesSkipIn: 'a123b'.
+	self assert: result size equals: 1.
+	self assert: result first equals: #($1 $2)
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testMatchingRangesIn [
+	| input parser result |
+	input := 'a12b3'.
+	parser := #digit asParser plus.
+	result := parser matchingRangesIn: input.
+	result := result collect: [ :each | input copyFrom: each first to: each last ].
+	self assert: result size equals: 3.
+	self assert: result first equals: '12'.
+	self assert: result second equals: '2'.
+	self assert: result last equals: '3'
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testMatchingSkipRangesIn [
+	| input parser result |
+	input := 'a12b3'.
+	parser := #digit asParser plus.
+	result := parser matchingSkipRangesIn: input.
+	result := result collect: [ :each | input copyFrom: each first to: each last ].
+	self assert: result size equals: 2.
+	self assert: result first equals: '12'.
+	self assert: result last equals: '3'
+]
+
+{ #category : 'testing' }
+PPParserTest >> testMax [
+	| parser printString suffix |
+	parser := $a asParser max: 2.
+	self assert: parser min equals: 0.
+	self assert: parser max equals: 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.
+	printString := parser printString.
+	suffix := printString copyFrom: printString size - 5 to: printString size.
+	self assert: suffix = '[0, 2]'
+
+]
+
+{ #category : 'testing' }
+PPParserTest >> testMaxGreedy [
+	| parser |
+	parser := #word asParser max: 2 greedy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abc'.
+	
+	self assert: parser parse: '1' to: #() end: 0.
+	self assert: parser parse: 'a1' to: #($a) end: 1.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc1'.
+	
+	self assert: parser parse: '12' to: #($1) end: 1.
+	self assert: parser parse: 'a12' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab12' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc12'.
+	
+	self assert: parser parse: '123' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a123' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab123' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc123'
+]
+
+{ #category : 'testing' }
+PPParserTest >> testMaxLazy [
+	| parser |
+	parser := #word asParser max: 2 lazy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abc'.
+	
+	self assert: parser parse: '1' to: #() end: 0.
+	self assert: parser parse: 'a1' to: #($a) end: 1.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc1'.
+	
+	self assert: parser parse: '12' to: #() end: 0.
+	self assert: parser parse: 'a12' to: #($a) end: 1.
+	self assert: parser parse: 'ab12' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc12'.
+	
+	self assert: parser parse: '123' to: #() end: 0.
+	self assert: parser parse: 'a123' to: #($a) end: 1.
+	self assert: parser parse: 'ab123' to: #($a $b) end: 2.
+	self assert: parser fail: 'abc123'
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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 equals: 1.
+	count := 0.
+	self assert: twice parse: 'a' to: #($a $a).
+	self assert: count equals: 1.
+	self assert: parser memoized equals: parser
+]
+
+{ #category : 'testing' }
+PPParserTest >> testMin [
+	| parser printString suffix |
+	parser := $a asParser min: 2.
+	self assert: parser min equals: 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).
+	printString := parser printString.
+	suffix := printString copyFrom: printString size - 5 to: printString size.
+	self assert: suffix = '[2, *]'
+
+]
+
+{ #category : 'testing' }
+PPParserTest >> testMinGreedy [
+	| parser |
+	parser := #word asParser min: 2 greedy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abcde'.
+	
+	self assert: parser fail: '1'.
+	self assert: parser fail: 'a1'.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
+	self assert: parser parse: 'abcde1' to: #($a $b $c $d $e) end: 5.
+	
+	self assert: parser fail: '12'.
+	self assert: parser parse: 'a12' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab12' to: #($a $b $1) end: 3.
+	self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4.
+	self assert: parser parse: 'abcd12' to: #($a $b $c $d $1) end: 5.
+	self assert: parser parse: 'abcde12' to: #($a $b $c $d $e $1) end: 6.
+	
+	self assert: parser parse: '123' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a123' to: #($a $1 $2) end: 3.
+	self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4.
+	self assert: parser parse: 'abc123' to: #($a $b $c $1 $2) end: 5.
+	self assert: parser parse: 'abcd123' to: #($a $b $c $d $1 $2) end: 6.
+	self assert: parser parse: 'abcde123' to: #($a $b $c $d $e $1 $2) end: 7.
+	
+	self assert: parser parse: '1234' to: #($1 $2 $3) end: 3.
+	self assert: parser parse: 'a1234' to: #($a $1 $2 $3) end: 4.
+	self assert: parser parse: 'ab1234' to: #($a $b $1 $2 $3) end: 5.
+	self assert: parser parse: 'abc1234' to: #($a $b $c $1 $2 $3) end: 6.
+	self assert: parser parse: 'abcd1234' to: #($a $b $c $d $1 $2 $3) end: 7.
+	self assert: parser parse: 'abcde1234' to: #($a $b $c $d $e $1 $2 $3) end: 8
+]
+
+{ #category : 'testing' }
+PPParserTest >> testMinLazy [
+	| parser |
+	parser := #word asParser min: 2 lazy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abcde'.
+	
+	self assert: parser fail: '1'.
+	self assert: parser fail: 'a1'.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
+	self assert: parser parse: 'abcde1' to: #($a $b $c $d $e) end: 5.
+	
+	self assert: parser fail: '12'.
+	self assert: parser parse: 'a12' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab12' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc12' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd12' to: #($a $b $c $d) end: 4.
+	self assert: parser parse: 'abcde12' to: #($a $b $c $d $e) end: 5.
+	
+	self assert: parser parse: '123' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a123' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab123' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc123' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd123' to: #($a $b $c $d) end: 4.
+	self assert: parser parse: 'abcde123' to: #($a $b $c $d $e) end: 5.
+	
+	self assert: parser parse: '1234' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a1234' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab1234' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1234' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1234' to: #($a $b $c $d) end: 4.
+	self assert: parser parse: 'abcde1234' to: #($a $b $c $d $e) end: 5
+]
+
+{ #category : 'testing' }
+PPParserTest >> testMinMax [
+	| parser printString suffix |
+	parser := $a asParser min: 2 max: 4.
+	self assert: parser min equals: 2.
+	self assert: parser max equals: 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.
+	printString := parser printString.
+	suffix := printString copyFrom: printString size - 5 to: printString size.
+	self assert: suffix = '[2, 4]'
+]
+
+{ #category : 'testing' }
+PPParserTest >> testMinMaxGreedy [
+	| parser |
+	parser := #word asParser min: 2 max: 4 greedy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abcde'.
+	
+	self assert: parser fail: '1'.
+	self assert: parser fail: 'a1'.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde1'.
+	
+	self assert: parser fail: '12'.
+	self assert: parser parse: 'a12' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab12' to: #($a $b $1) end: 3.
+	self assert: parser parse: 'abc12' to: #($a $b $c $1) end: 4.
+	self assert: parser parse: 'abcd12' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde12'.
+	
+	self assert: parser parse: '123' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a123' to: #($a $1 $2) end: 3.
+	self assert: parser parse: 'ab123' to: #($a $b $1 $2) end: 4.
+	self assert: parser parse: 'abc123' to: #($a $b $c $1) end: 4.
+	self assert: parser parse: 'abcd123' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde123'.
+	
+	self assert: parser parse: '1234' to: #($1 $2 $3) end: 3.
+	self assert: parser parse: 'a1234' to: #($a $1 $2 $3) end: 4.
+	self assert: parser parse: 'ab1234' to: #($a $b $1 $2) end: 4.
+	self assert: parser parse: 'abc1234' to: #($a $b $c $1) end: 4.
+	self assert: parser parse: 'abcd1234' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde1234'
+]
+
+{ #category : 'testing' }
+PPParserTest >> testMinMaxLazy [
+	| parser |
+	parser := #word asParser min: 2 max: 4 lazy: #digit asParser.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'abcde'.
+	
+	self assert: parser fail: '1'.
+	self assert: parser fail: 'a1'.
+	self assert: parser parse: 'ab1' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde1'.
+	
+	self assert: parser fail: '12'.
+	self assert: parser parse: 'a12' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab12' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc12' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd12' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde12'.
+	
+	self assert: parser parse: '123' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a123' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab123' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc123' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd123' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde123'.
+	
+	self assert: parser parse: '1234' to: #($1 $2) end: 2.
+	self assert: parser parse: 'a1234' to: #($a $1) end: 2.
+	self assert: parser parse: 'ab1234' to: #($a $b) end: 2.
+	self assert: parser parse: 'abc1234' to: #($a $b $c) end: 3.
+	self assert: parser parse: 'abcd1234' to: #($a $b $c $d) end: 4.
+	self assert: parser fail: 'abcde1234'
+]
+
+{ #category : 'testing-accessing' }
+PPParserTest >> testNamed [
+	| parser |
+	parser := PPSequenceParser new.
+	self assert: parser name isNil.
+	parser := PPChoiceParser named: 'choice'.
+	self assert: parser name equals: 'choice'.
+	parser := $* asParser name: 'star'.
+	self assert: parser name equals: 'star'
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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'
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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'
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testParse [
+	| parser result |
+	parser := $a asParser.
+	self assert: (parser parse: 'a') equals: $a.
+	self assert: (result := parser parse: 'b') isPetitFailure.
+	self assert: result message includesSubstring: $a printString.
+	self assert: result message includesSubstring: 'expected'.
+	self assert: result position equals: 0.
+	self assert: (parser parse: 'a' readStream) equals: $a.
+	self assert: (result := parser parse: 'b' readStream) isPetitFailure.
+	self assert: result message includesSubstring: $a printString.
+	self assert: result message includesSubstring: 'expected'.
+	self assert: result position equals: 0
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testParseOnError0 [
+	| parser result seen |
+	parser := $a asParser.
+	result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
+	self assert: result equals: $a.
+	result := parser parse: 'b' onError: [ seen := true ].
+	self assert: result.
+	self assert: seen
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testParseOnError1 [
+	| parser result seen |
+	parser := $a asParser.
+	result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
+	self assert: result equals: $a.
+	result := parser
+		parse: 'b'
+		onError: [ :failure | 
+			self assert: failure position equals: 0.
+			self assert: failure message includesSubstring: $a printString.
+			self assert: failure message includesSubstring: 'expected'.
+			seen := true ].
+	self assert: result.
+	self assert: seen
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testParseOnError2 [
+	| parser result seen |
+	parser := $a asParser.
+	result := parser parse: 'a' onError: [ self signalFailure: 'Not supposed to report an error' ].
+	self assert: result equals: $a.
+	result := parser
+		parse: 'b'
+		onError: [ :msg :pos | 
+			self assert: msg includesSubstring: $a printString.
+			self assert: msg includesSubstring: 'expected'.
+			self assert: pos equals: 0.
+			seen := true ].
+	self assert: result.
+	self assert: seen
+]
+
+{ #category : 'testing-utilities' }
+PPParserTest >> testParser [
+	| parser |
+	parser := PPParser new.
+	
+	self assert: parser isPetitParser.
+
+	self deny: 4 isPetitParser.
+	self deny: 'foo' isPetitParser
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> 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
+]
+
+{ #category : 'testing' }
+PPParserTest >> testPluggable [
+	| block parser |
+	block := [ :stream | stream position ].
+	parser := block asParser.
+	self assert: parser block equals: block
+]
+
+{ #category : 'testing' }
+PPParserTest >> testPlus [
+	| parser |
+	parser := $a asParser plus.
+	self assert: parser min equals: 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'
+]
+
+{ #category : 'testing' }
+PPParserTest >> testPlusGreedy [
+	| limit parser |
+	limit := #digit asParser.
+	parser := #word asParser plusGreedy: limit.
+	self assert: parser min equals: 1.
+	self assert: parser max > parser min.
+	self assert: parser limit equals: limit.
+	self assert: parser children size equals: 2.
+	self assert: parser children last equals: limit.
+	self assert: parser fail: ''.
+	self assert: parser fail: '1'.
+	self assert: parser fail: 'a'.
+	self assert: parser fail: 'ab'.
+	self
+		assert: parser
+		parse: 'a1'
+		to: #($a)
+		end: 1.
+	self
+		assert: parser
+		parse: 'ab1'
+		to: #($a $b)
+		end: 2.
+	self
+		assert: parser
+		parse: 'abc1'
+		to: #($a $b $c)
+		end: 3.
+	self
+		assert: parser
+		parse: 'a12'
+		to: #($a $1)
+		end: 2.
+	self
+		assert: parser
+		parse: 'ab12'
+		to: #($a $b $1)
+		end: 3.
+	self
+		assert: parser
+		parse: 'abc12'
+		to: #($a $b $c $1)
+		end: 4.
+	self
+		assert: parser
+		parse: 'a123'
+		to: #($a $1 $2)
+		end: 3.
+	self
+		assert: parser
+		parse: 'ab123'
+		to: #($a $b $1 $2)
+		end: 4.
+	self
+		assert: parser
+		parse: 'abc123'
+		to: #($a $b $c $1 $2)
+		end: 5
+]
+
+{ #category : 'testing' }
+PPParserTest >> testPlusLazy [
+	| limit parser |
+	limit := #digit asParser.
+	parser := #word asParser plusLazy: limit.
+	self assert: parser min equals: 1.
+	self assert: parser max > parser min.
+	self assert: parser limit equals: limit.
+	self assert: parser children size equals: 2.
+	self assert: parser children last equals: limit.
+	self assert: parser fail: ''.
+	self assert: parser fail: '1'.
+	self assert: parser fail: 'a'.
+	self assert: parser fail: 'ab'.
+	self
+		assert: parser
+		parse: 'a1'
+		to: #($a)
+		end: 1.
+	self
+		assert: parser
+		parse: 'ab1'
+		to: #($a $b)
+		end: 2.
+	self
+		assert: parser
+		parse: 'abc1'
+		to: #($a $b $c)
+		end: 3.
+	self
+		assert: parser
+		parse: 'a12'
+		to: #($a)
+		end: 1.
+	self
+		assert: parser
+		parse: 'ab12'
+		to: #($a $b)
+		end: 2.
+	self
+		assert: parser
+		parse: 'abc12'
+		to: #($a $b $c)
+		end: 3.
+	self
+		assert: parser
+		parse: 'a123'
+		to: #($a)
+		end: 1.
+	self
+		assert: parser
+		parse: 'ab123'
+		to: #($a $b)
+		end: 2.
+	self
+		assert: parser
+		parse: 'abc123'
+		to: #($a $b $c)
+		end: 3
+]
+
+{ #category : 'testing-properties' }
+PPParserTest >> 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)
+]
+
+{ #category : 'testing-accessing' }
+PPParserTest >> 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 printString.
+	
+	parser := PPFailingParser message: 'error'.
+	self assert: parser printString includesSubstring: 'error'.
+	
+	parser := PPPredicateObjectParser on: [ :c | true ] message: 'error'.
+	self assert: parser printString includesSubstring: 'error'
+]
+
+{ #category : 'testing-properties' }
+PPParserTest >> testPropertyAt [
+	| parser |
+	parser := PPParser new.
+	self should: [ parser propertyAt: #foo ] raise: Error.
+	parser propertyAt: #foo put: true.
+	self assert: (parser propertyAt: #foo)
+]
+
+{ #category : 'testing-properties' }
+PPParserTest >> testPropertyAtIfAbsent [
+	| parser |
+	parser := PPParser new.
+	self assert: (parser propertyAt: #foo ifAbsent: [ true ]).
+	parser propertyAt: #foo put: true.
+	self assert: (parser propertyAt: #foo ifAbsent: [ false ])
+]
+
+{ #category : 'testing-properties' }
+PPParserTest >> testPropertyAtIfAbsentPut [
+	| parser |
+	parser := PPParser new.
+	self assert: (parser propertyAt: #foo ifAbsentPut: [ true ]).
+	self assert: (parser propertyAt: #foo ifAbsentPut: [ false ])
+]
+
+{ #category : 'testing-properties' }
+PPParserTest >> testRemoveProperty [
+	| parser |
+	parser := PPParser new.
+	self should: [ parser removeProperty: #foo ] raise: Error.
+	parser propertyAt: #foo put: true.
+	self assert: (parser removeProperty: #foo)
+]
+
+{ #category : 'testing-properties' }
+PPParserTest >> testRemovePropertyIfAbsent [
+	| parser |
+	parser := PPParser new.
+	self assert: (parser removeProperty: #foo ifAbsent: [ true ]).
+	parser propertyAt: #foo put: true.
+	self assert: (parser removeProperty: #foo ifAbsent: [ false ])
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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'
+]
+
+{ #category : 'testing' }
+PPParserTest >> testSeparatedByWithoutSeparators [
+	| parser |
+	parser := ($a asParser separatedBy: $b asParser)
+		withoutSeparators.
+	
+	self assert: parser parse: 'a' to: #($a).
+	self assert: parser parse: 'aba' to: #($a $a).
+	self assert: parser parse: 'ababa' to: #($a $a $a).
+	
+	self assert: parser parse: 'ab' to: #($a) end: 1.
+	self assert: parser parse: 'abab' to: #($a $a) end: 3.
+	self assert: parser parse: 'ac' to: #($a) end: 1.
+	self assert: parser parse: 'abac' to: #($a $a) end: 3.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'c'
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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'
+]
+
+{ #category : 'testing-fixtures' }
+PPParserTest >> 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'
+]
+
+{ #category : 'testing-fixtures' }
+PPParserTest >> 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
+]
+
+{ #category : 'testing-fixtures' }
+PPParserTest >> 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'
+]
+
+{ #category : 'testing' }
+PPParserTest >> testStar [
+	| parser |
+	parser := $a asParser star.
+	self assert: parser min equals: 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
+]
+
+{ #category : 'testing' }
+PPParserTest >> testStarGreedy [
+	| limit parser |
+	limit := #digit asParser.
+	parser := #word asParser starGreedy: limit.
+	self assert: parser min equals: 0.
+	self assert: parser max > parser min.
+	self assert: parser limit equals: limit.
+	self assert: parser children size equals: 2.
+	self assert: parser children last equals: limit.
+	self assert: parser fail: ''.
+	self assert: parser fail: 'a'.
+	self assert: parser fail: 'ab'.
+	self
+		assert: parser
+		parse: '1'
+		to: #()
+		end: 0.
+	self
+		assert: parser
+		parse: 'a1'
+		to: #($a)
+		end: 1.
+	self
+		assert: parser
+		parse: 'ab1'
+		to: #($a $b)
+		end: 2.
+	self
+		assert: parser
+		parse: 'abc1'
+		to: #($a $b $c)
+		end: 3.
+	self
+		assert: parser
+		parse: '12'
+		to: #($1)
+		end: 1.
+	self
+		assert: parser
+		parse: 'a12'
+		to: #($a $1)
+		end: 2.
+	self
+		assert: parser
+		parse: 'ab12'
+		to: #($a $b $1)
+		end: 3.
+	self
+		assert: parser
+		parse: 'abc12'
+		to: #($a $b $c $1)
+		end: 4.
+	self
+		assert: parser
+		parse: '123'
+		to: #($1 $2)
+		end: 2.
+	self
+		assert: parser
+		parse: 'a123'
+		to: #($a $1 $2)
+		end: 3.
+	self
+		assert: parser
+		parse: 'ab123'
+		to: #($a $b $1 $2)
+		end: 4.
+	self
+		assert: parser
+		parse: 'abc123'
+		to: #($a $b $c $1 $2)
+		end: 5
+]
+
+{ #category : 'testing' }
+PPParserTest >> testStarLazy [
+	| limit parser |
+	limit := #digit asParser.
+	parser := #word asParser starLazy: limit.
+	self assert: parser min equals: 0.
+	self assert: parser max > parser min.
+	self assert: parser limit equals: limit.
+	self assert: parser children size equals: 2.
+	self assert: parser children last equals: limit.
+	self assert: parser fail: ''.
+	self assert: parser fail: 'a'.
+	self assert: parser fail: 'ab'.
+	self
+		assert: parser
+		parse: '1'
+		to: #()
+		end: 0.
+	self
+		assert: parser
+		parse: 'a1'
+		to: #($a)
+		end: 1.
+	self
+		assert: parser
+		parse: 'ab1'
+		to: #($a $b)
+		end: 2.
+	self
+		assert: parser
+		parse: 'abc1'
+		to: #($a $b $c)
+		end: 3.
+	self
+		assert: parser
+		parse: '12'
+		to: #()
+		end: 0.
+	self
+		assert: parser
+		parse: 'a12'
+		to: #($a)
+		end: 1.
+	self
+		assert: parser
+		parse: 'ab12'
+		to: #($a $b)
+		end: 2.
+	self
+		assert: parser
+		parse: 'abc12'
+		to: #($a $b $c)
+		end: 3.
+	self
+		assert: parser
+		parse: '123'
+		to: #()
+		end: 0.
+	self
+		assert: parser
+		parse: 'a123'
+		to: #($a)
+		end: 1.
+	self
+		assert: parser
+		parse: 'ab123'
+		to: #($a $b)
+		end: 2.
+	self
+		assert: parser
+		parse: 'abc123'
+		to: #($a $b $c)
+		end: 3
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> testToken [
+	| parser |
+	parser := $a asParser token.
+	self assert: parser tokenClass equals: 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 equals: PPToken.
+	self
+		assert: parser
+		parse: 'a'
+		toToken: 1
+		stop: 1.
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> testTrim [
+	| parser |
+	parser := $a asParser token trim.
+	
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: 'a ' toToken: 1 stop: 1.
+	self assert: parser parse: 'a	' toToken: 1 stop: 1.
+	self assert: parser parse: 'a  ' toToken: 1 stop: 1.
+	self assert: parser parse: 'a 
+	 ' toToken: 1 stop: 1.
+		
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: ' a' toToken: 2 stop: 2.
+	self assert: parser parse: '	a' toToken: 2 stop: 2.
+	self assert: parser parse: '    a' toToken: 5 stop: 5.
+	self assert: parser parse: '   
+a' toToken: 5 stop: 5.
+	
+	self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
+	self assert: parser parse: 'a	a' toToken: 1 stop: 1 end: 2.
+	self assert: parser parse: 'a  a' toToken: 1 stop: 1 end: 3.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> 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'.
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> testTrimCustom [
+	| parser |
+	parser := $a asParser token trim: $b asParser.
+	
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: 'ab' toToken: 1 stop: 1.
+	self assert: parser parse: 'abb' toToken: 1 stop: 1.
+		
+	self assert: parser parse: 'a' toToken: 1 stop: 1.
+	self assert: parser parse: 'ba' toToken: 2 stop: 2.
+	self assert: parser parse: 'bba' toToken: 3 stop: 3.
+	
+	self assert: parser parse: 'aa' toToken: 1 stop: 1 end: 1.
+	self assert: parser parse: 'ab' toToken: 1 stop: 1 end: 2.
+	self assert: parser parse: 'abba' toToken: 1 stop: 1 end: 3.
+	
+	self assert: parser fail: ''.
+	self assert: parser fail: 'b'
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> 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'
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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)
+]
+
+{ #category : 'testing-mapping' }
+PPParserTest >> 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 equals: 0.
+	self assert: result second isPetitFailure.
+	self assert: result last equals: 0
+]
+
+{ #category : 'testing' }
+PPParserTest >> 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'
+]
diff --git a/software/PetitTests/PPPredicateTest.class.st b/software/PetitTests/PPPredicateTest.class.st
new file mode 100644
index 0000000..4f0aab8
--- /dev/null
+++ b/software/PetitTests/PPPredicateTest.class.st
@@ -0,0 +1,401 @@
+Class {
+	#name : 'PPPredicateTest',
+	#superclass : 'PPAbstractParserTest',
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'utilities' }
+PPPredicateTest >> 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' ]
+]
+
+{ #category : 'private' }
+PPPredicateTest >> charactersDo: aBlock [
+	1 to: 256 do: [ :index | aBlock value: (Character codePoint: index) ]
+]
+
+{ #category : 'utilities' }
+PPPredicateTest >> parsedCharacterSet: aParser [
+	| result |
+	result := WriteStream on: String new.
+	self charactersDo: [ :char |
+		(aParser matches: (char asString))
+			ifTrue: [ result nextPut: char ] ].
+	^ result contents
+]
+
+{ #category : 'testing-objects' }
+PPPredicateTest >> 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: ''
+]
+
+{ #category : 'testing-objects' }
+PPPredicateTest >> 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: ','
+]
+
+{ #category : 'testing-objects' }
+PPPredicateTest >> 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'
+]
+
+{ #category : 'testing-objects' }
+PPPredicateTest >> 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'
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> 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)
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> 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'
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> testCr [
+	| parser |
+	parser := #cr asParser.
+	self assertCharacterSets: parser.
+	self assert: parser parse: (String with: (Character codePoint: 13)) to: (Character codePoint: 13)
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> 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'
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> testEndOfFile [
+	| parser |
+	parser := (#letter asParser / #blank asParser) star, #eof asParser.
+	
+	self assert: parser parse: 'lorem ipsum'.
+	
+	parser := #any asParser, #eof asParser, #any asParser star.
+	self assert: parser fail: 'a', Character cr asString, 'b'.
+	self assert: parser fail: Character cr asString , Character lf asString.
+	self assert: parser parse: 'a'.
+
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> testEndOfLine [
+	| cr crlf lf parser |
+	cr := Character cr asString.
+	crlf := Character cr asString , Character lf asString.
+	lf := Character lf asString.
+	parser := (#letter asParser / #blank asParser) star, #endOfLine asParser.
+	
+	self assert: parser parse: 'lorem ipsum'.
+	
+	parser := #any asParser, #endOfLine asParser, #any asParser star.
+	self assert: parser parse: 'a', cr, 'b'.
+	self assert: parser fail: crlf.
+	self assert: parser fail: 'lorem ipsum'.
+	
+	parser := #endOfLine asParser, #any asParser, #endOfLine asParser negate star, #endOfLine asParser.
+	self assert: parser parse: cr, 'lorem ipsum'.
+	self assert: parser parse: lf, 'lorem ipsum'.	
+	self assert: parser parse: crlf, 'lorem ipsum'.	
+	
+	self assert: parser parse: crlf.
+	self assert: parser parse: cr.
+	self assert: parser parse: lf.
+	
+	parser := #endOfLine asParser negate star, #endOfLine asParser, #any asParser star.
+	self assert: parser parse: crlf, 'lorem ipsum'.
+	self assert: parser parse: crlf.
+
+]
+
+{ #category : 'testing-objects' }
+PPPredicateTest >> 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: ''
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> 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'
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> 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'
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> testLf [
+	| parser |
+	parser := #lf asParser.
+	self assertCharacterSets: parser.
+	self assert: parser parse: (String with: Character lf) to: Character lf
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> 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'
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> 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: ' '
+]
+
+{ #category : 'testing' }
+PPPredicateTest >> testOnMessage [
+	| block parser |
+	block := [ :char | char = $* ].
+	parser := PPPredicateObjectParser on: block message: 'starlet'.
+	self assert: parser block equals: block.
+	self assert: parser message equals: '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'
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> 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'
+]
+
+{ #category : 'testing-sequence' }
+PPPredicateTest >> testSequenceParser [
+	| parser |
+	parser := PPPredicateSequenceParser
+		on: [ :value | value first isUppercase ]
+		message: 'uppercase 3 letter words'
+		size: 3.
+	self assert: parser size equals: 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 equals: 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'
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> 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'
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> testStartOfLine [
+	| cr crlf lf parser |
+	cr := Character cr asString.
+	crlf := Character cr asString , Character lf asString.
+	lf := Character lf asString.
+	parser := #startOfLine asParser, #any asParser star.
+	
+	self assert: parser parse: 'lorem ipsum'.
+	
+	parser := #any asParser, #startOfLine asParser, #any asParser star.
+	self assert: parser fail: 'lorem ipsum'.
+	
+	parser := #startOfLine asParser, #any asParser, #startOfLine asParser, #any asParser star.
+	self assert: parser parse: cr, 'lorem ipsum'.
+	self assert: parser parse: lf, 'lorem ipsum'.	
+	self assert: parser fail: crlf, 'lorem ipsum'.	
+	
+	self assert: parser fail: crlf.
+	self assert: parser parse: cr.
+	self assert: parser parse: lf.
+	
+	parser := #startOfLine asParser, #any asParser, #any asParser, #startOfLine asParser, #any asParser star.
+	self assert: parser parse: crlf, 'lorem ipsum'.
+	self assert: parser parse: crlf.
+
+
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> testStartOfLogicalLine [
+	| parser |
+	parser := #startOfLogicalLine asParser, #any asParser star.
+	
+	self assert: parser parse: 'lorem'.
+	self assert: parser fail: ' lorem'.
+	
+	parser := #any asParser, #startOfLogicalLine asParser, #any asParser star.
+	self assert: parser fail: 'lorem'.
+	self assert: parser fail: '        lorem'.
+	self assert: parser parse: ' lorem'.
+	self assert: parser parse: '	lorem'.
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> testStartOfWord [
+	| parser |
+	parser := #startOfWord asParser, #word asParser plus.
+	
+	self assert: parser parse: 'lorem'.
+	
+	parser := #any asParser, #startOfWord asParser, #word asParser plus.
+	self assert: parser fail: 'lorem'.
+	self assert: parser fail: '1234'.
+	
+	self assert: parser parse: ' lorem'.	
+	self assert: parser parse: ' 123'.
+	self assert: parser parse: ')lorem'.
+	self assert: parser parse: ':lorem'.
+	
+	parser := #startOfWord asParser, #any asParser optional.
+	self assert: parser fail: ''.
+	self assert: parser parse: 'a'.
+	self assert: parser fail: '.'.
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> testTab [
+	| parser |
+	parser := #tab asParser.
+	self assertCharacterSets: parser.
+	self assert: parser parse: (String with: Character tab) to: Character tab
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> 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'
+]
+
+{ #category : 'testing-chars' }
+PPPredicateTest >> 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: '-'
+]
diff --git a/software/PetitTests/PPScriptingTest.class.st b/software/PetitTests/PPScriptingTest.class.st
new file mode 100644
index 0000000..89148d9
--- /dev/null
+++ b/software/PetitTests/PPScriptingTest.class.st
@@ -0,0 +1,110 @@
+"
+These are some simple demo-scripts of parser combinators for the compiler construction course.
+http://www.iam.unibe.ch/~scg/Teaching/CC/index.html
+"
+Class {
+	#name : 'PPScriptingTest',
+	#superclass : 'PPAbstractParserTest',
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'examples' }
+PPScriptingTest >> expressionInterpreter [
+	"Same as #expressionInterpreter but with semantic actions."
+	
+	| mul prim add dec |
+	add := PPUnresolvedParser new.
+	mul := PPUnresolvedParser new.
+	prim := PPUnresolvedParser new.
+	dec := ($0 to: $9) asParser ==> [ :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
+]
+
+{ #category : 'examples' }
+PPScriptingTest >> expressionParser [
+	"Simple demo of scripting an expression parser."
+	
+	| mul prim add dec |
+	add := PPUnresolvedParser new.
+	mul := PPUnresolvedParser new.
+	prim := PPUnresolvedParser new.
+	dec := ($0 to: $9) asParser.
+	add def: (mul , $+ asParser , add)
+		/ mul.
+	mul def: (prim , $* asParser , mul)
+		/ prim.
+	prim def: ($( asParser , add , $) asParser)
+		/ dec.
+	^ add end
+]
+
+{ #category : 'examples' }
+PPScriptingTest >> 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 to: $z) asParser.
+	upper := ($A to: $Z) asParser.
+	char := lower / upper.
+	nonzero := ($1 to: $9) asParser.
+	dec := ($0 to: $9) asParser.
+	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
+
+]
+
+{ #category : 'tests' }
+PPScriptingTest >> testExpressionInterpreter [
+	self 
+		assert: self expressionInterpreter
+		parse: '2*(3+4)'
+		to: 14
+]
+
+{ #category : 'tests' }
+PPScriptingTest >> testExpressionParser [
+	self
+		assert: self expressionParser
+		parse: '2*(3+4)'
+		to: #($2 $* ($( ($3 $+ $4) $)))
+]
+
+{ #category : 'tests' }
+PPScriptingTest >> testSLassign [
+	
+	self assert: self straightLineParser
+		parse: 'abc:=1'
+		to: #(#($a #($b $c) ':=' #(#(#($1 #()) #()) #())) #())
+]
+
+{ #category : 'tests' }
+PPScriptingTest >> testSLprint [
+	self 
+		assert: self straightLineParser
+		parse: 'print(3,4)'
+		to: #(('print' $( ((($3 ()) ()) () (($, ((($4 ()) ()) ())))) $)) ())
+]
diff --git a/software/PetitTests/PPTokenTest.class.st b/software/PetitTests/PPTokenTest.class.st
new file mode 100644
index 0000000..bf93a02
--- /dev/null
+++ b/software/PetitTests/PPTokenTest.class.st
@@ -0,0 +1,128 @@
+Class {
+	#name : 'PPTokenTest',
+	#superclass : 'PPAbstractParserTest',
+	#category : 'PetitTests-Tests'
+}
+
+{ #category : 'accessing' }
+PPTokenTest >> identifier [
+	^ #word asParser plus token
+]
+
+{ #category : 'utilities' }
+PPTokenTest >> parse: aString using: aParser [
+	^ aParser parse: aString
+]
+
+{ #category : 'testing' }
+PPTokenTest >> testCollection [
+	| input result |
+	input := 'foo    '.
+	result := self parse: input using: self identifier.
+	self assert: result collection equals: input.
+	self assert: result collection == input
+]
+
+{ #category : 'testing-querying' }
+PPTokenTest >> testColumn [
+	| input parser result |
+	input := '1' , (String with: (Character codePoint: 13)) , '12' , (String with: (Character codePoint: 13) with: (Character codePoint: 10)) , '123'
+		, (String with: (Character codePoint: 10)) , '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 equals: line ]
+]
+
+{ #category : 'testing-copying' }
+PPTokenTest >> testCopyFromTo [
+	| result other |
+	result := PPToken on: 'abc'.
+	other := result copyFrom: 2 to: 2.
+	self assert: other size equals: 1.
+	self assert: other start equals: 2.
+	self assert: other stop equals: 2.
+	self assert: other collection equals: result collection
+]
+
+{ #category : 'testing-comparing' }
+PPTokenTest >> testEquality [
+	| token1 token2 |
+	token1 := self parse: 'foo' using: self identifier.
+	token2 := self parse: 'foo' using: self identifier.
+	self deny: token1 == token2.
+	self assert: token1 equals: token2.
+	self assert: token1 hash equals: token2 hash
+]
+
+{ #category : 'testing' }
+PPTokenTest >> testInitialize [
+	PPToken initialize
+]
+
+{ #category : 'testing-values' }
+PPTokenTest >> testInputValue [
+	| input result |
+	input := 'foo'.
+	result := self parse: input using: self identifier.
+	self assert: result inputValue equals: input.
+	self deny: result inputValue == input
+]
+
+{ #category : 'testing-querying' }
+PPTokenTest >> testLine [
+	| input parser result |
+	input := '1' , (String with: (Character codePoint: 13)) , '12' , (String with: (Character codePoint: 13) with: (Character codePoint: 10)) , '123'
+		, (String with: (Character codePoint: 10)) , '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 equals: line ]
+]
+
+{ #category : 'testing' }
+PPTokenTest >> testNew [
+	self should: [ PPToken new ] raise: Error.
+	
+]
+
+{ #category : 'testing-values' }
+PPTokenTest >> testParsedValue [
+	| input result |
+	input := 'foo'.
+	result := self parse: input using: self identifier.
+	self assert: result parsedValue equals: #($f $o $o)
+]
+
+{ #category : 'testing' }
+PPTokenTest >> testPrinting [
+	| result |
+	result := PPToken on: 'var'.
+	self assert: result printString includesSubstring: 'PPToken[1,3]'
+]
+
+{ #category : 'testing' }
+PPTokenTest >> testSize [
+	| result |
+	result := self parse: 'foo' using: self identifier.
+	self assert: result size equals: 3
+]
+
+{ #category : 'testing' }
+PPTokenTest >> testStart [
+	| result |
+	result := self parse: 'foo' using: self identifier.
+	self assert: result start equals: 1
+]
+
+{ #category : 'testing' }
+PPTokenTest >> testStop [
+	| result |
+	result := self parse: 'foo' using: self identifier.
+	self assert: result stop equals: 3
+]
+
+{ #category : 'testing' }
+PPTokenTest >> testValue [
+	| result |
+	result := PPToken on: 'var'.
+	self should: [ result value ] raise: Notification
+]
diff --git a/software/PetitTests/package.st b/software/PetitTests/package.st
new file mode 100644
index 0000000..51ca97d
--- /dev/null
+++ b/software/PetitTests/package.st
@@ -0,0 +1 @@
+Package { #name : 'PetitTests' }
diff --git a/software/petitcompiler/PEGFsa.class.st b/software/petitcompiler/PEGFsa.class.st
new file mode 100644
index 0000000..343af41
--- /dev/null
+++ b/software/petitcompiler/PEGFsa.class.st
@@ -0,0 +1,900 @@
+Class {
+	#name : 'PEGFsa',
+	#superclass : 'Object',
+	#instVars : [
+		'states',
+		'startState',
+		'name',
+		'distances',
+		'priorities'
+	],
+	#category : 'PetitCompiler-FSA'
+}
+
+{ #category : 'instance creation' }
+PEGFsa class >> new [
+	"return an initialized instance"
+
+	^ self basicNew initialize.
+]
+
+{ #category : 'comparing' }
+PEGFsa >> = anotherFsa [
+	"
+		Please note what the compare does. IMO nothing useful for now.
+		
+		For comparing if two FSA's are equivalent, use isIsomorphicTo:
+	"
+
+	(self == anotherFsa)  ifTrue: [ ^ true ].
+	(self class == anotherFsa class) ifFalse: [ ^ false ].
+	
+	(startState = anotherFsa startState) ifFalse: [ ^ false ].
+	(name = anotherFsa name) ifFalse: [ ^ false ].
+	
+	(states size = anotherFsa states size) ifFalse: [ ^ false ].
+	states do: [:s |
+		(anotherFsa states contains: [ :e | e = s ]) ifFalse: [ ^ false ].
+	].
+	^ true
+]
+
+{ #category : 'modifications' }
+PEGFsa >> addState: state [
+	self assert: (states includes: state) not.
+	states add: state
+]
+
+{ #category : 'modifications' }
+PEGFsa >> addTransitionFrom: fromState to: toState [ 
+	| transition |
+	self assert: (states includes: fromState).
+	self assert: (states includes: toState).
+	
+	transition := PEGFsaEpsilonTransition new 
+		destination: toState;
+		priority: 0;
+		yourself.
+		
+	fromState addTransition: transition.
+]
+
+{ #category : 'modifications' }
+PEGFsa >> addTransitionFrom: fromState to: toState on: character [
+	self addTransitionFrom: fromState to: toState on: character priority: 0
+]
+
+{ #category : 'modifications' }
+PEGFsa >> addTransitionFrom: fromState to: toState on: character priority: priority [
+	| transition |
+	transition := PEGFsaCharacterTransition new 
+		addCharacter: character;
+		destination: toState;
+		priority: priority;
+		yourself.
+		
+	fromState addTransition: transition
+]
+
+{ #category : 'modifications' }
+PEGFsa >> addTransitionFrom: fromState to: toState onCharacterSet: characterSet [
+	self addTransitionFrom: fromState to: toState onCharacterSet: characterSet priority: 0
+]
+
+{ #category : 'modifications' }
+PEGFsa >> addTransitionFrom: fromState to: toState onCharacterSet: characterSet priority: priority [
+	| transition |
+	transition := PEGFsaCharacterTransition new 
+		characterSet: characterSet;
+		destination: toState;
+		priority: priority;
+		yourself.
+
+	fromState addTransition: transition
+]
+
+{ #category : 'modifications' }
+PEGFsa >> addTransitionFrom: fromState to: toState onPredicate: block priority: priority [
+	| transition |
+	transition := PEGFsaPredicateTransition new 
+		predicate: block;
+		destination: toState;
+		priority: priority;
+		yourself.
+		
+	fromState addTransition: transition
+]
+
+{ #category : 'modifications' }
+PEGFsa >> addTransitionFrom: fromState to: toState priority: priority [
+	| transition |
+	"should not use minus priority epsilons any more"
+	self assert: (priority == 0).	
+	self assert: (states includes: fromState).
+	self assert: (states includes: toState).
+	
+	transition := PEGFsaEpsilonTransition new 
+		destination: toState;
+		priority: priority;
+		yourself.
+		
+	fromState addTransition: transition.
+]
+
+{ #category : 'modifications' }
+PEGFsa >> adopt: fsa [
+	states addAll: fsa reachableStates.
+]
+
+{ #category : 'accessing' }
+PEGFsa >> allTransitions [
+	^ self allTransitions: IdentitySet new
+]
+
+{ #category : 'accessing' }
+PEGFsa >> allTransitions: collection [
+	self states do: [ :s | collection addAll: s transitions  ].
+	^ collection
+]
+
+{ #category : 'printing' }
+PEGFsa >> asString [
+	| stream  |
+	stream := WriteStream on: ''.
+	
+	self topologicalOrder do: [ :state |
+		state printOn: stream.
+		stream nextPutAll: '> '.
+		
+		(self transitionsFor: state) do: [ :transition |
+			stream nextPut: (Character codePoint: 13).
+			stream nextPut: (Character codePoint: 9).
+			transition printOn: stream.
+		].
+		stream nextPut: (Character codePoint: 13).
+	].
+	
+"	stream nextPutAll: 'finals: '.
+	(states select: [:s | s isFinal ]) do: [:e | e printOn: stream ].
+	stream nextPut: (Character codePoint: 13).
+"
+	^ stream contents.
+]
+
+{ #category : 'analysis' }
+PEGFsa >> backTransitions [
+	|  transitionSet |
+	transitionSet := IdentitySet new.
+	self computeDistances.
+	
+	self backTransitionsFrom: startState openSet: IdentitySet new transitionSet: transitionSet.
+	^ transitionSet
+]
+
+{ #category : 'analysis' }
+PEGFsa >> backTransitionsFrom: state openSet: openSet transitionSet: transitionSet [
+	(openSet includes: state) ifTrue: [  
+		^ self
+	].
+	openSet add: state.
+	
+	state transitions do: [ :t | 
+		((openSet includes: t destination) and: [self is: state furtherThan: t destination]) ifTrue: [  
+			transitionSet add: t		
+		].
+		self backTransitionsFrom: t destination openSet: openSet copy transitionSet: transitionSet
+	]
+]
+
+{ #category : 'testing' }
+PEGFsa >> canHavePPCId [
+	^ true
+]
+
+{ #category : 'testing' }
+PEGFsa >> checkConsistency [
+	self assert: (states includes: startState).
+	
+	states do: [ :s | s transitions do: [ :t |
+		self assert: (states includes: t destination).
+	] ].
+	^ true
+]
+
+{ #category : 'testing' }
+PEGFsa >> checkFinalStatesPriorities [
+	self assert: (self finalStates allSatisfy: #hasPriority)
+]
+
+{ #category : 'testing' }
+PEGFsa >> checkSanity [
+	self checkConsistency.
+	self checkTransitionsIdentity.
+	self checkTransitionsPriority.
+	self checkFinalStatesPriorities.
+]
+
+{ #category : 'testing' }
+PEGFsa >> checkTransitionsIdentity [
+	| bag set |
+	bag := IdentityBag new.
+	set := IdentitySet new.
+	bag := self allTransitions: bag.
+	set := self allTransitions: set.	
+	
+	self assert: bag size == set size.
+]
+
+{ #category : 'testing' }
+PEGFsa >> checkTransitionsPriority [
+	self finalStates do: [ :fs |
+		fs isMultivalue ifFalse: [ 
+			fs transitions allSatisfy: [ :t | fs priority >= t priority ]
+		]
+	]
+]
+
+{ #category : 'transformations' }
+PEGFsa >> compact [
+	self error: 'deprecated?'
+]
+
+{ #category : 'analysis' }
+PEGFsa >> computeDistances [
+	| queue openSet |
+	distances := IdentityDictionary new.
+	queue := OrderedCollection with: startState.
+	openSet := IdentitySet new.
+
+	distances at: startState put: 0.
+	
+	[ queue isEmpty not ] whileTrue: [ 
+		| state |
+		state := queue removeFirst.
+		openSet add: state.
+		
+		state transitions do: [ :t |
+			(openSet includes: (t destination)) ifFalse: [ 
+				distances at: (t destination ) put: ((distances at: state) + 1).
+				queue addLast: (t destination)
+			]
+		]
+	].
+
+	^ distances
+]
+
+{ #category : 'modifications' }
+PEGFsa >> decreasePriority [
+	^ self decreasePriorityBy: 1
+]
+
+{ #category : 'modifications' }
+PEGFsa >> decreasePriorityBy: value [
+	self states select: [ :s | s hasPriority ] thenDo: [ :s |
+		s decreasePriorityBy: value.
+	].
+
+	self allTransitions do: [ :t |
+		t decreasePriorityBy: value
+	]
+]
+
+{ #category : 'ids' }
+PEGFsa >> defaultName [
+	^ #fsa
+]
+
+{ #category : 'modifications - determinization' }
+PEGFsa >> determinize [
+	^ PEGFsaSequenceDeterminizator new determinize: self.
+
+]
+
+{ #category : 'modifications - determinization' }
+PEGFsa >> determinize: joinDictionary [
+	self error: 'deprecated'.
+	
+	self removeEpsilons.
+	self removeUnreachableStates.
+	self removeLowPriorityTransitions.
+	self mergeTransitions.
+	
+	
+	states := self topologicalOrder asOrderedCollection.
+	
+	states do: [ :state |
+		state determinize: joinDictionary.
+	].
+	
+	states	 := startState reachableStates.
+
+	self removeUnreachableStates.
+	self removeLowPriorityTransitions.
+	self mergeTransitions.
+	
+
+]
+
+{ #category : 'modifications - determinization' }
+PEGFsa >> determinizeChoice [
+	^ PEGFsaChoiceDeterminizator new determinize: self.
+
+]
+
+{ #category : 'modifications - determinization' }
+PEGFsa >> determinizeStandard [
+	^ PEGFsaDeterminizator new determinize: self.
+
+]
+
+{ #category : 'analysis' }
+PEGFsa >> epsilonDestinationsFrom: state [
+	| openSet |
+	openSet := IdentitySet new.
+	self epsilonDestinationsFrom: state openSet: openSet.
+	^ openSet
+]
+
+{ #category : 'analysis' }
+PEGFsa >> epsilonDestinationsFrom: state openSet: openSet [
+	(openSet includes: state) ifTrue: [ 
+		^ self 
+	].
+
+	openSet add: state.
+	
+	((self transitionsFor: state) select: [ :t | t isEpsilon ]) do: [ :t |
+		self epsilonDestinationsFrom: t destination openSet: openSet
+	]
+	
+]
+
+{ #category : 'modifications' }
+PEGFsa >> finalState: state [
+	self assert: state isFinal not.
+	state final: true.
+	state priority: 0.
+]
+
+{ #category : 'analysis' }
+PEGFsa >> finalStates [
+	^ self states select: [ :s | s isFinal ]
+]
+
+{ #category : 'modifications' }
+PEGFsa >> fixFinalStatePriorities [
+	self finalStates do: [ :s |
+		s hasPriority ifFalse: [ s priority: 0 ]
+	]
+]
+
+{ #category : '*PetitCompiler-GUI' }
+PEGFsa >> gtGraphViewIn: composite [
+	<gtInspectorPresentationOrder: 0>
+	composite roassal2
+		title: 'Graph'; 
+		initializeView: [ RTMondrian new ];
+		painting: [ :view |
+			self viewGraphOn: view.	
+		].
+]
+
+{ #category : '*PetitCompiler-GUI' }
+PEGFsa >> gtStringViewIn: composite [
+	<gtInspectorPresentationOrder: 40>
+
+	composite text
+			title: 'Textual Representation';
+			display: [ :fsa | fsa asString  ]
+]
+
+{ #category : 'analysis' }
+PEGFsa >> hasDistinctRetvals [
+	| finalStates retvals |
+	finalStates := self finalStates.
+
+	(finalStates anySatisfy: [ :s | s isMultivalue  ]) ifTrue: [ ^ false ].
+	retvals := finalStates collect: [:s | s retval].
+
+		
+	(finalStates size == 1) ifTrue: [ ^ true ].
+
+
+	(retvals asSet size == 1) ifTrue: [ ^ true ].
+	"final states leads only to final states with the same retval"
+	(finalStates allSatisfy: [ :s | 
+		(self statesReachableFrom: s) allSatisfy: [ :rs | rs retval value isNil or: [ rs retval value == s retval value ] ]
+	]) ifTrue: [ ^ true ].
+	
+	^ false
+]
+
+{ #category : 'ids' }
+PEGFsa >> hasName [
+	^ name isNil not
+]
+
+{ #category : 'analysis' }
+PEGFsa >> hasNoRetvals [
+	^ self finalStates isEmpty
+
+
+]
+
+{ #category : 'comparing' }
+PEGFsa >> hash [
+	^ states hash bitXor: (startState hash bitXor: name hash)
+]
+
+{ #category : 'initialization' }
+PEGFsa >> initialize [
+	states := IdentitySet new.
+]
+
+{ #category : 'analysis' }
+PEGFsa >> is: state furtherThan: anotherState [
+
+	^ (distances at: state) >= (distances at: anotherState)
+]
+
+{ #category : 'analysis' }
+PEGFsa >> isBackTransition: t [
+	^ self backTransitions includes: t
+]
+
+{ #category : 'testing' }
+PEGFsa >> isDeterministic [
+	self reachableStates do: [ :state |
+		state transitionPairs do: [ :pair | 
+			((pair first intersection: pair second) includes: true) ifTrue: [ 					
+				^ false
+			] 
+		]
+	].
+	^ true
+]
+
+{ #category : 'comparing' }
+PEGFsa >> isIsomorphicTo: anotherFsa [
+	| topologicalOrder anotherTopologicalOrder  |
+	
+	"
+		Please not that this version of comparison is sensitive to the order
+		in which the transitions in state are ordered.
+	"
+	
+	topologicalOrder := self topologicalOrder.
+	anotherTopologicalOrder := anotherFsa topologicalOrder.
+	
+	topologicalOrder size == anotherTopologicalOrder size ifFalse: [ ^ false ].
+	
+	topologicalOrder with: anotherTopologicalOrder do: [ :s1 :s2 |
+		(s1 canBeIsomorphicTo: s2) ifFalse: [ ^ false ]
+	].
+	
+	^ true
+"	
+	transitions := topologicalOrder flatCollect: [ :s | s transitions ].
+	anotherTransitions := anotherTopologicalOrder flatCollect: [ :s | s transitions ].
+"	
+
+]
+
+{ #category : 'testing' }
+PEGFsa >> isReachableState: state [
+	^ self reachableStates includes: state
+]
+
+{ #category : 'testing' }
+PEGFsa >> isStartState: state [
+	^ startState == state
+]
+
+{ #category : 'testing' }
+PEGFsa >> isWithoutEpsilons [
+	self reachableStates do: [ :state | 
+		state transitions do: [ :t | 
+			t isEpsilon ifTrue: [ ^ false ]
+		]
+	].
+	^ true
+]
+
+{ #category : 'analysis' }
+PEGFsa >> isWithoutPriorities [
+	^ self states allSatisfy: [ :s | 
+		s hasPriority not or: [ 
+			s stateInfos allSatisfy: [ :i | i priority == 0 ]
+		] 
+	].
+]
+
+{ #category : 'transformations' }
+PEGFsa >> mergeTransitions [
+	|  |
+	self reachableStates do: [ :state |
+		state mergeTransitions.
+	]
+
+]
+
+{ #category : 'modifications' }
+PEGFsa >> minimize [
+	^ PEGFsaMinimizator new minimize: self
+]
+
+{ #category : 'accessing' }
+PEGFsa >> name [
+	^ name 
+]
+
+{ #category : 'accessing' }
+PEGFsa >> name: anObject [
+	
+	name := anObject
+]
+
+{ #category : 'analysis' }
+PEGFsa >> nonFinalStates [
+	^ self states reject: [ :s | s isFinal ]
+]
+
+{ #category : 'copying' }
+PEGFsa >> postCopy [
+	| map |
+	super postCopy.
+	
+	map := IdentityDictionary new.
+	states do: [ :s |
+		map at: s put: s copy.
+	].
+	
+	states := map values asIdentitySet.
+	startState isNil ifFalse: [ 
+		startState := map at: startState.
+	].
+	
+	states do: [ :s |
+		s transitions do: [:t |
+			t destination: (map at: t destination)
+		]
+	]
+]
+
+{ #category : 'ids' }
+PEGFsa >> prefix [
+	^ 'scan'
+]
+
+{ #category : 'analysis' }
+PEGFsa >> reachableStates [
+	^ self statesReachableFrom: startState
+]
+
+{ #category : 'modifications - epsilons' }
+PEGFsa >> removeEpsilonTransition: transition source: state [
+	^ self removeEpsilonTransition: transition source: state openSet: IdentitySet new
+]
+
+{ #category : 'modifications - epsilons' }
+PEGFsa >> removeEpsilonTransition: transition source: source openSet: openSet [
+	| destination |
+	(openSet includes: transition) ifTrue: [ self error: 'loop in epsilons?!' ].
+	openSet add: transition.
+	
+	destination := transition destination.
+	
+	"First Remove Recursively"
+	((self transitionsFor: destination ) select: [ :t | t isEpsilon  ]) do: [ :t |
+		self removeEpsilonTransition: t source: destination openSet: openSet
+	].
+
+	self assert: transition isEpsilon.
+	self assert: transition priority = 0.
+	
+	(destination transitions) do: [ :t |
+		source addTransition: (t copy)
+	].
+
+	source mergeInfo: destination into: source.
+
+	destination isFinal ifTrue: [ 
+		source final: true.
+		source retval: destination retval.
+	].
+
+	source removeTransition: transition.
+]
+
+{ #category : 'modifications - epsilons' }
+PEGFsa >> removeEpsilons [
+	"First, remove the negative values from epsilons"
+	self removeNegativeEpsilons.
+	
+	states do: [ :state |
+		self removeEpsilonsFor: state
+	]
+]
+
+{ #category : 'modifications - epsilons' }
+PEGFsa >> removeEpsilonsFor: state [
+	(self transitionsFor: state) copy do: [ :t |
+		(t isEpsilon and: [ t destination isStub not ]) ifTrue: [ 
+			self removeEpsilonTransition: t source: state
+		]
+	]
+]
+
+{ #category : 'modifications' }
+PEGFsa >> removeFinals [
+	self finalStates do: [ :s |
+		s final: false
+	]
+]
+
+{ #category : 'transformations' }
+PEGFsa >> removeLowPriorityTransitions [
+	states do: [ :state |
+		self removeLowPriorityTransitionsFor: state
+	]
+]
+
+{ #category : 'transformations' }
+PEGFsa >> removeLowPriorityTransitionsFor: state [
+	| transitions |
+	state hasPriority ifFalse: [ ^ self ].
+	state isFinal ifFalse: [ ^ self ].
+	"TODO JK: I can probably cut some transitions from multivalu as well"
+	state isMultivalue ifTrue: [ ^ self ].
+
+	transitions := state transitions copy.
+	transitions do: [ :t |
+		(t priority < state priority) ifTrue: [ 
+			state removeTransition: t
+		]
+	]
+]
+
+{ #category : 'modifications - epsilons' }
+PEGFsa >> removeNegativeEpsilonTransition: transition source: state [
+	^ self removeNegativeEpsilonTransition: transition source: state openSet: IdentitySet new
+]
+
+{ #category : 'modifications - epsilons' }
+PEGFsa >> removeNegativeEpsilonTransition: transition source: source openSet: openSet [
+	| destination |
+	(openSet includes: transition) ifTrue: [ self error: 'loop in epsilons?!' ].
+	openSet add: transition.
+	
+	destination := transition destination.
+	
+	"First Remove Recursively"
+	((self transitionsFor: destination ) select: [ :t | t isEpsilon  ]) do: [ :t |
+		self removeNegativeEpsilonTransition: t source: destination openSet: openSet
+	].
+	
+	"JK: Problem alert: if two different epsilons point to the same state,
+		it will decreas the state priority two times! I don't know how to handle
+		this situation properly and I make sure during FSA generation that there
+		are no two paths to one state (except for loops).
+	"
+	(self statesReachableFrom: destination) do: [ :s |
+		s decreasePriorityBy: transition priority abs.
+		s transitions do: [ :t | t decreasePriorityBy: transition priority abs  ]
+	].
+
+	transition priority: 0.
+
+]
+
+{ #category : 'modifications - epsilons' }
+PEGFsa >> removeNegativeEpsilons [
+	"
+		This will remove only negative values from epsilons, the epsilons itself will not
+		be removed!
+	"
+	states do: [ :state |
+		self removeNegativeEpsilonsFor: state
+	]
+]
+
+{ #category : 'modifications - epsilons' }
+PEGFsa >> removeNegativeEpsilonsFor: state [
+	(self transitionsFor: state) copy do: [ :t |
+		t isEpsilon ifTrue: [ 
+			self removeNegativeEpsilonTransition: t source: state
+		]
+	]
+]
+
+{ #category : 'modifications' }
+PEGFsa >> removePriorities [
+	self states select: [ :s| s hasPriority ] thenDo: [ :s |
+		s priority: 0
+	].
+
+	self allTransitions do: [ :t |
+		t priority: 0
+	]
+]
+
+{ #category : 'modifications' }
+PEGFsa >> removeState: state [
+	self assert: (states includes: state).
+	states remove: state.
+]
+
+{ #category : 'transformations' }
+PEGFsa >> removeUnreachableStates [
+	| reachable toRemove |
+	reachable := self reachableStates.
+	toRemove := OrderedCollection new.
+
+	states do: [ :s |
+		(reachable includes: s) ifFalse: [ 
+			toRemove add: s		
+		]
+	].
+
+	toRemove do: [ :s | states remove: s ]
+]
+
+{ #category : 'modifications' }
+PEGFsa >> replace: state with: anotherState [
+	| transitions  |
+	self assert: (state isKindOf: PEGFsaState).
+	self assert: (anotherState isKindOf: PEGFsaState).
+	
+	transitions := self allTransitions.
+
+	transitions do: [ :t |
+		(t destination == state) ifTrue: [ 
+			t destination: anotherState.
+		]
+	].
+
+	state == startState ifTrue: [ startState := anotherState ].
+	states remove: state.
+	states add: anotherState.
+]
+
+{ #category : 'modifications' }
+PEGFsa >> retval: returnValue [
+	self finalStates do: [ :s |
+		self assert: s retval isNil.
+		s retval: returnValue
+	]
+]
+
+{ #category : 'accessing' }
+PEGFsa >> retvals [
+	^ (self finalStates flatCollect: [ :e | e retvals collect: #value ]) asIdentitySet
+]
+
+{ #category : 'accessing' }
+PEGFsa >> startState [
+	self assert: (states includes: startState).
+	^ startState
+]
+
+{ #category : 'modifications' }
+PEGFsa >> startState: state [
+	self assert: (states includes: state).
+	
+	startState := state
+]
+
+{ #category : 'accessing' }
+PEGFsa >> stateNamed: stateName [
+	^ states detect: [ :e | e name = stateName ]
+]
+
+{ #category : 'analysis' }
+PEGFsa >> statePairs [
+	|  pairs ordered |
+	pairs := OrderedCollection new.
+	ordered := self states asOrderedCollection.
+	1 to: (ordered size - 1) do: [ :index1 |
+		(index1 + 1) to: ordered size do: [ :index2 |
+			pairs add: (PEGFsaPair with: (ordered at: index1) with: (ordered at: index2))
+ 		]
+	].
+
+	self assert: (pairs allSatisfy: [ :e | e class == PEGFsaPair ]).
+	^ pairs
+]
+
+{ #category : 'accessing' }
+PEGFsa >> states [
+	^ states
+]
+
+{ #category : 'accessing' }
+PEGFsa >> states: whatever [
+	states := whatever
+]
+
+{ #category : 'analysis' }
+PEGFsa >> statesReachableFrom: state [
+	| openSet |
+	self assert: state isNil not.
+	
+	openSet := IdentitySet new.
+	self statesReachableFrom: state openSet: openSet.
+	^ openSet
+]
+
+{ #category : 'analysis' }
+PEGFsa >> statesReachableFrom: state openSet: openSet [
+	(openSet contains: [:e | e == state]) ifTrue: [ 
+		^ self 
+	].
+
+	openSet add: state.
+	
+	(self transitionsFor: state) do: [ :t |
+		self statesReachableFrom: t destination openSet: openSet
+	]
+	
+
+]
+
+{ #category : 'ids' }
+PEGFsa >> suffix [
+	^ nil
+]
+
+{ #category : 'analysis' }
+PEGFsa >> topologicalOrder [
+	| collection |
+	collection := OrderedCollection new.
+	
+	self statesReachableFrom: startState openSet: collection.
+	^ collection
+]
+
+{ #category : 'accessing' }
+PEGFsa >> transitionFrom: from to: to [
+	^ from transitions detect: [ :t | t destination = to ]
+]
+
+{ #category : 'accessing' }
+PEGFsa >> transitionsFor: state [
+	self assert: (states includes: state).
+	^ state transitions
+]
+
+{ #category : '*PetitCompiler-GUI' }
+PEGFsa >> viewGraphOn: b [
+	b shape circle size: 50.
+	b shape color: Color gray muchLighter muchLighter.
+	b shape withText: #gtName.
+	b nodes: (self nonFinalStates).
+
+	b shape circle size: 50.
+	b shape color: Color gray muchLighter.
+	b shape withText: #gtName.
+	b nodes: (self finalStates).
+
+	b shape arrowedLine.
+	b edges 
+		connectToAll: [ :state | 
+			state transitions 	select: [:t | (self isBackTransition:t)  not] 
+									thenCollect: #destination ]
+		labelled: [ :t | (self transitionFrom: t key to: t value) gtName  ].		
+
+	b shape arrowedLine.
+	b shape color: Color red.
+	b edges 
+		connectToAll: [ :state | 
+			state transitions 	select: [:t | (self isBackTransition: t) ] 
+								thenCollect: #destination ]
+		labelled: [ :t | (self transitionFrom: t key to: t value) gtName  ].
+
+
+	b layout horizontalTree  .
+	b layout layout horizontalGap: 30.
+
+	^ b
+]
diff --git a/software/petitcompiler/PEGFsa.extension.st b/software/petitcompiler/PEGFsa.extension.st
new file mode 100644
index 0000000..56a93b2
--- /dev/null
+++ b/software/petitcompiler/PEGFsa.extension.st
@@ -0,0 +1,55 @@
+Extension { #name : 'PEGFsa' }
+
+{ #category : '*PetitCompiler-GUI' }
+PEGFsa >> gtGraphViewIn: composite [
+	<gtInspectorPresentationOrder: 0>
+	composite roassal2
+		title: 'Graph'; 
+		initializeView: [ RTMondrian new ];
+		painting: [ :view |
+			self viewGraphOn: view.	
+		].
+]
+
+{ #category : '*PetitCompiler-GUI' }
+PEGFsa >> gtStringViewIn: composite [
+	<gtInspectorPresentationOrder: 40>
+
+	composite text
+			title: 'Textual Representation';
+			display: [ :fsa | fsa asString  ]
+]
+
+{ #category : '*PetitCompiler-GUI' }
+PEGFsa >> viewGraphOn: b [
+	b shape circle size: 50.
+	b shape color: Color gray muchLighter muchLighter.
+	b shape withText: #gtName.
+	b nodes: (self nonFinalStates).
+
+	b shape circle size: 50.
+	b shape color: Color gray muchLighter.
+	b shape withText: #gtName.
+	b nodes: (self finalStates).
+
+	b shape arrowedLine.
+	b edges 
+		connectToAll: [ :state | 
+			state transitions 	select: [:t | (self isBackTransition:t)  not] 
+									thenCollect: #destination ]
+		labelled: [ :t | (self transitionFrom: t key to: t value) gtName  ].		
+
+	b shape arrowedLine.
+	b shape color: Color red.
+	b edges 
+		connectToAll: [ :state | 
+			state transitions 	select: [:t | (self isBackTransition: t) ] 
+								thenCollect: #destination ]
+		labelled: [ :t | (self transitionFrom: t key to: t value) gtName  ].
+
+
+	b layout horizontalTree  .
+	b layout layout horizontalGap: 30.
+
+	^ b
+]
diff --git a/software/petitcompiler/PEGFsaAbstractDeterminizator.class.st b/software/petitcompiler/PEGFsaAbstractDeterminizator.class.st
new file mode 100644
index 0000000..778ca4c
--- /dev/null
+++ b/software/petitcompiler/PEGFsaAbstractDeterminizator.class.st
@@ -0,0 +1,165 @@
+Class {
+	#name : 'PEGFsaAbstractDeterminizator',
+	#superclass : 'Object',
+	#instVars : [
+		'fsa',
+		'joinDictionary'
+	],
+	#category : 'PetitCompiler-FSA'
+}
+
+{ #category : 'as yet unclassified' }
+PEGFsaAbstractDeterminizator class >> new [
+	^ self basicNew initialize
+]
+
+{ #category : 'determinization' }
+PEGFsaAbstractDeterminizator >> determinize [
+	| states |
+"	fsa checkSanity."
+	fsa removeEpsilons.
+	fsa removeUnreachableStates.
+	fsa mergeTransitions.
+	
+	states := fsa topologicalOrder asOrderedCollection.
+	states do: [ :state |
+		self determinizeState: state
+	].
+
+	fsa states:	fsa startState reachableStates.
+	
+	fsa removeUnreachableStates.
+	fsa mergeTransitions.
+]
+
+{ #category : 'determinization' }
+PEGFsaAbstractDeterminizator >> determinize: anFsa [
+	fsa := anFsa.
+	joinDictionary := Dictionary new.
+	
+	self determinize.
+	^ fsa
+]
+
+{ #category : 'determinization' }
+PEGFsaAbstractDeterminizator >> determinizeOverlap: t1 second: t2 state: state [
+	|  t1Prime t2Prime tIntersection |
+	self assert: (state transitions includes: t1).
+	self assert: (state transitions includes: t2).
+	
+	tIntersection := self joinTransition: t1 with: t2.
+
+	t1Prime := PEGFsaCharacterTransition new
+					destination: t1 destination;
+					characterSet: (t1 complement: t2);
+					yourself.
+	t2Prime := PEGFsaCharacterTransition new
+					destination: t2 destination;
+					characterSet: (t2 complement: t1);
+					yourself.					
+									
+								
+	state removeTransition: t1.
+	state removeTransition: t2.
+	
+	tIntersection isEmpty ifFalse: [ state addTransition: tIntersection  ].
+	t1Prime isEmpty ifFalse: [ state addTransition: t1Prime ].
+	t2Prime isEmpty ifFalse: [ state addTransition: t2Prime ].
+]
+
+{ #category : 'determinization' }
+PEGFsaAbstractDeterminizator >> determinizeState: state [
+	| pairs |
+
+	pairs := state transitionPairs asOrderedCollection.
+
+	[pairs isEmpty] whileFalse: [ 
+		| pair |
+		
+		(joinDictionary size > 100) ifTrue: [ self error: 'Oh man, this is really big FSA. Are you sure you want to continue?' ].
+		
+		pair := pairs removeFirst.
+		self assert:((pair first destination = pair second destination) not 
+					or: [pair first isPredicateTransition not 
+					or: [pair second isPredicateTransition not ] ]).
+				
+		self assert: (pair contains: #isEpsilon) not.		
+				
+		(pair first overlapsWith: pair second) ifTrue: [ 
+			self determinizeOverlap: pair first second: pair second state: state.
+			"recompute pairs after the determinization"
+			pairs := state transitionPairs asOrderedCollection.
+		]
+	].
+]
+
+{ #category : 'initialization' }
+PEGFsaAbstractDeterminizator >> initialize [
+	super initialize.
+	joinDictionary := Dictionary new
+]
+
+{ #category : 'accessing - keys' }
+PEGFsaAbstractDeterminizator >> joinKey: key with: anotherKey [
+	^ Set new
+		addAll: key;
+		addAll: anotherKey;
+		yourself.
+
+]
+
+{ #category : 'joining' }
+PEGFsaAbstractDeterminizator >> joinName: state with: anotherState into: newState [
+	newState name: state name asString, '_', anotherState name asString.
+
+]
+
+{ #category : 'joining' }
+PEGFsaAbstractDeterminizator >> joinState: state with: anotherState [
+	| key newState |
+	key := self keyFor: state and: anotherState.
+	(joinDictionary includesKey: key) ifTrue: [ ^ joinDictionary at: key ].
+	
+	newState := PEGFsaState new.
+	joinDictionary at: key put: newState.
+
+	self joinRetval: state with: anotherState into: newState.
+	self joinInfo: state with: anotherState into: newState.
+	self joinName: state with: anotherState into: newState.
+	self joinTransitions: state with: anotherState into: newState.	
+
+	self determinizeState: newState.
+	
+	self assert: ((joinDictionary at: key) == newState).
+	^ newState
+]
+
+{ #category : 'joining' }
+PEGFsaAbstractDeterminizator >> joinTransition: t1 with: t2 [
+	| newDestination newTransition |
+	self assert: t1 isCharacterTransition.
+	self assert: t2 isCharacterTransition.
+	
+	newDestination := self joinState: t1 destination with: t2 destination.
+	
+	newTransition := PEGFsaCharacterTransition new.
+	newTransition destination: newDestination.
+	newTransition characterSet: (t1 intersection: t2).
+	newTransition priority: (t1 priority max: t2 priority).
+	
+	^ newTransition 
+]
+
+{ #category : 'accessing - keys' }
+PEGFsaAbstractDeterminizator >> keyFor: state [
+	^ joinDictionary keyAtIdentityValue: state ifAbsent: [ Set with: state ]
+]
+
+{ #category : 'accessing - keys' }
+PEGFsaAbstractDeterminizator >> keyFor: state and: anotherState [
+	| key anotherKey |
+	key := self keyFor: state.
+	anotherKey := self keyFor: anotherState.
+	
+	^ self joinKey: key with: anotherKey
+]
diff --git a/software/petitcompiler/PEGFsaChoiceDeterminizator.class.st b/software/petitcompiler/PEGFsaChoiceDeterminizator.class.st
new file mode 100644
index 0000000..69e1013
--- /dev/null
+++ b/software/petitcompiler/PEGFsaChoiceDeterminizator.class.st
@@ -0,0 +1,76 @@
+Class {
+	#name : 'PEGFsaChoiceDeterminizator',
+	#superclass : 'PEGFsaAbstractDeterminizator',
+	#category : 'PetitCompiler-FSA'
+}
+
+{ #category : 'determinization' }
+PEGFsaChoiceDeterminizator >> determinize [
+	super determinize.
+
+	fsa removeLowPriorityTransitions.
+	fsa removeUnreachableStates.
+	fsa removePriorities.
+]
+
+{ #category : 'joining' }
+PEGFsaChoiceDeterminizator >> joinInfo: info with: anotherInfo into: newInfo [
+	"Merging into the failure"
+	(info isFsaFailure and: [anotherInfo isFsaFailure not]) ifTrue: [  
+		newInfo final: anotherInfo isFinal.
+		newInfo priority: anotherInfo priority.
+		newInfo failure: false.
+		^ self
+	].
+	
+	(anotherInfo isFsaFailure and: [info isFsaFailure not]) ifTrue: [  
+		newInfo final: info isFinal.
+		newInfo priority: (anotherInfo priority max: info priority).
+		newInfo failure: false.
+		^ self
+	].
+	
+	(info hasEqualPriorityTo: anotherInfo) ifTrue: [ 
+		newInfo final: (info isFinal or: [ anotherInfo isFinal ]).
+		newInfo failure: (info isFsaFailure or: [anotherInfo isFailure]).
+		newInfo priority: info priority.	
+		^ self
+	].
+	
+	(info hasHigherPriorityThan: anotherInfo) ifTrue: [ 
+ 		newInfo priority: info priority.	
+		newInfo failure: info isFsaFailure.
+		newInfo final: info isFinal.
+		^ self
+	].
+
+	newInfo priority: anotherInfo priority.
+	newInfo failure: anotherInfo isFsaFailure.
+	newInfo final: anotherInfo isFinal.
+
+]
+
+{ #category : 'joining' }
+PEGFsaChoiceDeterminizator >> joinRetval: state with: anotherState into: newState [
+	"Different retvals cannot merge their info"
+	self assert: (state hasDifferentRetvalThan: anotherState) not. 
+	self assert: state retval == anotherState retval.
+]
+
+{ #category : 'joining' }
+PEGFsaChoiceDeterminizator >> joinState: state with: anotherState [
+	self assert: state isMultivalue not.
+	self assert: anotherState isMultivalue not.
+
+	^ super joinState: state with: anotherState
+]
+
+{ #category : 'joining' }
+PEGFsaChoiceDeterminizator >> joinTransitions: state with: anotherState into: newState [
+	self assert: newState isMultivalue not.
+	
+	newState transitions addAll: (state transitions collect: #copy).
+	newState transitions addAll: (anotherState transitions collect: #copy).
+	newState mergeTransitions.
+
+]
diff --git a/software/petitcompiler/PEGFsaDeterminizator.class.st b/software/petitcompiler/PEGFsaDeterminizator.class.st
new file mode 100644
index 0000000..ff8f78d
--- /dev/null
+++ b/software/petitcompiler/PEGFsaDeterminizator.class.st
@@ -0,0 +1,58 @@
+Class {
+	#name : 'PEGFsaDeterminizator',
+	#superclass : 'PEGFsaAbstractDeterminizator',
+	#category : 'PetitCompiler-FSA'
+}
+
+{ #category : 'checking' }
+PEGFsaDeterminizator >> checkPriorities [
+	self assert: ((fsa states select: [ :s | s hasPriority  ]) allSatisfy: [ :s | s priority == 0 ]).
+	self assert: (fsa allTransitions allSatisfy: [ :s | s priority == 0 ]).
+]
+
+{ #category : 'determinization' }
+PEGFsaDeterminizator >> determinize [
+	self checkPriorities.
+	super determinize.	
+]
+
+{ #category : 'joining' }
+PEGFsaDeterminizator >> joinInfo: info with: anotherInfo into: newInfo [
+	"nothing to do"
+]
+
+{ #category : 'joining' }
+PEGFsaDeterminizator >> joinRetval: state with: anotherState into: newState [
+	"Different retvals cannot merge their info"
+
+	state retvalsAndInfosDo: [:retval :info |
+		retval isNil ifFalse: [ 
+			newState addInfo: info for: retval.
+		]
+	].
+
+	anotherState retvalsAndInfosDo: [:retval :info |
+		retval isNil ifFalse: [ 
+			self assert: (newState retvals includes: retval) not.
+			newState addInfo: info for: retval.
+		]
+	].
+
+
+]
+
+{ #category : 'joining' }
+PEGFsaDeterminizator >> joinState: state with: anotherState [
+	self assert: state hasZeroPriorityOnly.
+	self assert: anotherState hasZeroPriorityOnly.
+	
+	^ super joinState: state with: anotherState
+]
+
+{ #category : 'joining' }
+PEGFsaDeterminizator >> joinTransitions: state with: anotherState into: newState [
+	newState transitions addAll: (state transitions collect: #copy).
+	newState transitions addAll: (anotherState transitions collect: #copy).
+	^ self
+
+]
diff --git a/software/petitcompiler/PEGFsaFailure.class.st b/software/petitcompiler/PEGFsaFailure.class.st
new file mode 100644
index 0000000..cff041b
--- /dev/null
+++ b/software/petitcompiler/PEGFsaFailure.class.st
@@ -0,0 +1,59 @@
+Class {
+	#name : 'PEGFsaFailure',
+	#superclass : 'Object',
+	#instVars : [
+		'retval'
+	],
+	#classInstVars : [
+		'Instance'
+	],
+	#category : 'PetitCompiler-FSA'
+}
+
+{ #category : 'as yet unclassified' }
+PEGFsaFailure class >> on: retval [
+	^ (self new)
+		retval: retval;
+		yourself
+]
+
+{ #category : 'comparing' }
+PEGFsaFailure >> = anotherFailure [
+	(self == anotherFailure) ifTrue: [ ^ true ].
+	self class == anotherFailure class ifFalse: [ ^ false ].
+	
+	^ (self retval == anotherFailure retval)
+]
+
+{ #category : 'comparing' }
+PEGFsaFailure >> hash [
+	^ self retval hash
+]
+
+{ #category : 'testing' }
+PEGFsaFailure >> isFsaFailure [
+	^ true
+]
+
+{ #category : 'printing' }
+PEGFsaFailure >> printOn: aStream [
+	super printOn: aStream.
+	aStream nextPut: $(.
+	retval printOn: aStream.
+	aStream nextPut: $).
+]
+
+{ #category : 'accessing' }
+PEGFsaFailure >> retval [
+	^ retval
+]
+
+{ #category : 'accessing' }
+PEGFsaFailure >> retval: anObject [
+	retval := anObject
+]
+
+{ #category : 'accessing' }
+PEGFsaFailure >> value [
+	^ retval
+]
diff --git a/software/petitcompiler/PPActionParser.extension.st b/software/petitcompiler/PPActionParser.extension.st
new file mode 100644
index 0000000..19a6cfd
--- /dev/null
+++ b/software/petitcompiler/PPActionParser.extension.st
@@ -0,0 +1,12 @@
+Extension { #name : 'PPActionParser' }
+
+{ #category : '*petitcompiler' }
+PPActionParser >> asCompilerNode [
+	^ PPCActionNode new
+		name: self name;
+		block: block;
+		child: parser;
+		properties: properties;
+		parser: self;
+		yourself
+]
diff --git a/software/petitcompiler/PPAndParser.extension.st b/software/petitcompiler/PPAndParser.extension.st
new file mode 100644
index 0000000..000150e
--- /dev/null
+++ b/software/petitcompiler/PPAndParser.extension.st
@@ -0,0 +1,9 @@
+Extension { #name : 'PPAndParser' }
+
+{ #category : '*petitcompiler' }
+PPAndParser >> asCompilerNode [
+	^ PPCAndNode new
+		name: self name;
+		child: parser;
+		yourself
+]
diff --git a/software/petitcompiler/PPCASTUtilities.class.st b/software/petitcompiler/PPCASTUtilities.class.st
new file mode 100644
index 0000000..19cf8ff
--- /dev/null
+++ b/software/petitcompiler/PPCASTUtilities.class.st
@@ -0,0 +1,196 @@
+Class {
+	#name : 'PPCASTUtilities',
+	#superclass : 'Object',
+	#category : 'PetitCompiler-Support'
+}
+
+{ #category : 'variables' }
+PPCASTUtilities >> allClassVariableNames: aClass [
+	| variables cls |
+	variables := Set new.
+	cls := aClass.
+	
+	[ cls notNil ] whileTrue:[ 
+		variables addAll: (cls isMeta ifFalse: [ cls classVariables ] ifTrue: [ #() ]).
+		cls := cls superclass.
+	].
+
+	^ variables
+]
+
+{ #category : 'variables' }
+PPCASTUtilities >> allInstanceVariableNames: aClass [
+	| variables cls |
+	variables := Set new.
+	cls := aClass.
+	
+	[ cls notNil ] whileTrue:[ 
+"		cls instanceVariables notNil ifTrue:[
+"			variables addAll: cls instanceVariables.
+"		]. "
+		cls := cls superclass.
+	].
+
+	^ variables
+]
+
+{ #category : 'checks' }
+PPCASTUtilities >> checkNodeIsFunctional: anRBNode inClass: aClass options: aPPCCompilationOptions [
+	"Check whether the given node is purely functional or not. 
+	 If no, raise an erorr. If not, this method is noop.
+
+	 A block is purely functional if and only if:
+	   (i) it does not refer to any instance or class variable or non-local variable
+	  (ii) all self-sends within the block are to 'purely-functional' methods
+		   (transitively)
+	 (iii) contains no super-sends.
+	"
+	self checkNodeVariables: anRBNode inClass: aClass.
+	
+	self withAllSuperNodesOf: anRBNode do: [ :node | 
+		PPCCompilationError new signal: 'code not functional:  contains a super-send. See https://bitbucket.org/janvrany/stx-goodies-petitparser/wiki/Limitations'.
+		^ self
+	].
+
+	self withAllMessageNodesOf: anRBNode sentToSelfDo:[:node |
+		| method |
+		
+		method := aClass lookupSelector: node selector.
+		method isNil ifTrue:[
+			PPCCompilationError new signal: 'code not functional:  contains self-send to non-existent method. See https://bitbucket.org/janvrany/stx-goodies-petitparser/wiki/Limitations'.  
+			^ self
+		].
+		aPPCCompilationOptions allowProperties ifTrue:[
+		"Accessing properties are explicitly allowed"
+			(self propertiesSelectors includes: node selector) ifTrue:[
+				method methodClass == PPParser ifTrue:[
+					^self.
+				].
+				(method methodClass inheritsFrom: PPParser) ifTrue:[
+						PPCCompilationWarning new signal: 'Class ', method methodClass name, ' overrides PPParser>>', node selector storeString.
+					^self.
+				].
+			].
+		].
+		(anRBNode isMethod and: [ anRBNode selector = node selector ]) ifFalse: [
+			self checkNodeIsFunctional: method parseTree inClass: aClass options: aPPCCompilationOptions.
+		] "ifTrue: [ 'method is calling itself ... recursion is happening' ] "
+	].      
+
+
+	"Created: / 27-07-2015 / 12:15:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 08-09-2015 / 02:48:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'checks' }
+PPCASTUtilities >> checkNodeVariables: anRBNode inClass: aClass [
+	" does node refer to any instance or class variable or non-local variable ?"
+	| allDefinedVarNames allInstVarNames allClassVarNames |
+
+	allDefinedVarNames := anRBNode allDefinedVariables.
+	allDefinedVarNames add: 'thisContext'.
+	allInstVarNames := self allInstanceVariableNames: aClass.
+	allClassVarNames := self allClassVariableNames: aClass.
+
+	self withAllVariableNodesOf: anRBNode  do: [ :node | 
+		(allDefinedVarNames includes: node name) ifFalse:[ 
+			(allInstVarNames includes: node name) ifTrue:[
+				PPCCompilationError new signal: 'code not functional: refers to an instance variable named `',node name,'`. See https://bitbucket.org/janvrany/stx-goodies-petitparser/wiki/Limitations'.
+				^ self.
+			].
+			(allClassVarNames includes: node name) ifTrue:[
+				PPCCompilationError new signal: 'code not functional:  refers to a class variable named `',node name,'`. See https://bitbucket.org/janvrany/stx-goodies-petitparser/wiki/Limitations'.
+				^ self.
+			].
+			(Smalltalk includesKey: node name asSymbol) ifFalse:[ 
+				PPCCompilationError new signal: 'code not functional:  refers to an unknown variable named `',node name,'`. See https://bitbucket.org/janvrany/stx-goodies-petitparser/wiki/Limitations'.
+				^ self.                    
+			].
+		]
+	].
+]
+
+{ #category : 'accessing' }
+PPCASTUtilities >> propertiesSelectors [
+	 ^ #(
+				hasProperty:
+				propertyAt:
+				propertyAt:ifAbsent:
+				propertyAt:ifAbsentPut:
+				propertyAt:put:
+				removeProperty:
+				removeProperty:ifAbsent:		
+			)
+]
+
+{ #category : 'enumerating' }
+PPCASTUtilities >> withAllMessageNodesOf: anRBProgramNode do: aBlock [
+	"Enumerate all chilren of `anRBProgramNode` (including itself)
+	 and evaluate `aBlock` for each message node."
+
+	self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isMessage ] do: aBlock.
+
+	"Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified (comment): / 27-07-2015 / 11:26:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'enumerating' }
+PPCASTUtilities >> withAllMessageNodesOf: anRBProgramNode sentToSelfDo: aBlock [
+	"Enumerate all chilren of `anRBProgramNode` (including itself)
+	 and evaluate `aBlock` for each message node which sends a message
+	 to self (i.e., for self-sends)."
+
+	self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isMessage and:[node receiver isSelf ] ] do: aBlock.
+
+	"Created: / 27-07-2015 / 14:41:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'enumerating' }
+PPCASTUtilities >> withAllNodesOf: node suchThat: predicate do: action [
+	"Enumerate all chilren of `node` (including itself)
+	 and evaluate `aBlock` for each node for which `predicate` returns true."
+
+	(predicate value: node) ifTrue:[ 
+		action value: node.
+	].
+	node children do:[:each | 
+		self withAllNodesOf: each suchThat: predicate do: action
+	].
+
+	"Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified (comment): / 27-07-2015 / 11:26:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'enumerating' }
+PPCASTUtilities >> withAllSelfNodesOf: anRBProgramNode do: aBlock [
+	"Enumerate all chilren of `anRBProgramNode` (including itself)
+	 and evaluate `aBlock` for each `self` node."
+
+	self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isSelf ] do: aBlock.
+
+	"Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified (comment): / 27-07-2015 / 11:26:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'enumerating' }
+PPCASTUtilities >> withAllSuperNodesOf: anRBProgramNode do: aBlock [
+	"Enumerate all chilren of `anRBProgramNode` (including itself)
+	 and evaluate `aBlock` for each `super` node."
+
+	self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isSuper ] do: aBlock.
+
+	"Created: / 27-07-2015 / 14:42:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'enumerating' }
+PPCASTUtilities >> withAllVariableNodesOf: anRBProgramNode do: aBlock [
+	"Enumerate all chilren of `anRBProgramNode` (including itself)
+	 and evaluate `aBlock` for each variable node.
+	 This is a replacement for Smalltalk/X's RBProgramNode>>variableNodesDo:
+	 which is not present in Pharo"
+
+	self withAllNodesOf: anRBProgramNode suchThat: [ :node | node isVariable and:[node isSelf not and:[node isSuper not]]] do: aBlock.
+
+	"Created: / 18-06-2015 / 22:02:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified (comment): / 27-07-2015 / 11:27:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
diff --git a/software/petitcompiler/PPCCheckingVisitor.class.st b/software/petitcompiler/PPCCheckingVisitor.class.st
new file mode 100644
index 0000000..c39482b
--- /dev/null
+++ b/software/petitcompiler/PPCCheckingVisitor.class.st
@@ -0,0 +1,22 @@
+Class {
+	#name : 'PPCCheckingVisitor',
+	#superclass : 'PPCPassVisitor',
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'hooks' }
+PPCCheckingVisitor >> beforeAccept: node [
+	| message |
+
+	message := node check.
+	message notNil ifTrue:[ 
+		((message beginsWith: 'WARNING')) ifTrue: [ 
+			context options debug ifTrue: [ Transcript cr; show: message. ].
+		] ifFalse: [ 
+			self error: message 
+		].       
+	].
+	^ node
+
+	"Created: / 07-09-2015 / 13:05:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
diff --git a/software/petitcompiler/PPCChoiceOptimizationVisitor.class.st b/software/petitcompiler/PPCChoiceOptimizationVisitor.class.st
new file mode 100644
index 0000000..550c2a1
--- /dev/null
+++ b/software/petitcompiler/PPCChoiceOptimizationVisitor.class.st
@@ -0,0 +1,34 @@
+Class {
+	#name : 'PPCChoiceOptimizationVisitor',
+	#superclass : 'PPCRewritingVisitor',
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'visiting' }
+PPCChoiceOptimizationVisitor >> rejectDuplicateChildren: node [
+	| seen newChildren |
+	seen := IdentitySet new.
+	newChildren := OrderedCollection new.
+	node children do: [ :child | 
+		(seen includes: child) ifFalse: [  
+			newChildren add: child
+		].
+		seen add: child
+	].
+	^ newChildren
+
+]
+
+{ #category : 'visiting' }
+PPCChoiceOptimizationVisitor >> visitChoiceNode: node [
+	self visitChildren: node.
+
+	"Remove the identical children"
+	node children: 	(self rejectDuplicateChildren: node).
+	
+	(node children size = 1) ifTrue: [ 
+		^ node firstChild
+	].
+
+	^ node
+]
diff --git a/software/petitcompiler/PPCClass.class.st b/software/petitcompiler/PPCClass.class.st
new file mode 100644
index 0000000..6496519
--- /dev/null
+++ b/software/petitcompiler/PPCClass.class.st
@@ -0,0 +1,393 @@
+"
+I am a basic structure represing a class being compiled.
+
+The CodeGen (or more of them) can operate on me, adding methods.
+
+I keep track of methods, ids, and inlined methods as well as the return variables for code gen.
+
+In the end ClassBuilder can create a Smalltalk class from my data.
+"
+Class {
+	#name : 'PPCClass',
+	#superclass : 'Object',
+	#instVars : [
+		'methodDictionary',
+		'currentMethod',
+		'constants',
+		'idGen',
+		'methodStack',
+		'returnVariable',
+		'properties'
+	],
+	#category : 'PetitCompiler-Compiler-Codegen'
+}
+
+{ #category : 'instance creation' }
+PPCClass class >> new [
+	"return an initialized instance"
+
+	^ self basicNew initialize.
+]
+
+{ #category : 'constants' }
+PPCClass >> addConstant: value as: name [    
+	(constants includesKey: name) ifTrue:[ 
+		(constants at: name) ~= value ifTrue:[ 
+			self error:'Duplicate constant!'.
+		].
+		^ self.
+	].
+	constants at: name put: value
+
+	"Modified: / 29-05-2015 / 07:22:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'variables' }
+PPCClass >> allocateReturnVariable [    
+	^ self allocateReturnVariableNamed: 'retval'
+
+	"Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 15-06-2015 / 17:52:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'variables' }
+PPCClass >> allocateReturnVariableNamed: name [
+	"Allocate (or return previously allocated one) temporary variable used for
+	 storing a parser's return value (the parsed object)"                 
+	^ currentMethod allocateReturnVariableNamed: name
+
+	"Created: / 15-06-2015 / 18:04:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'variables' }
+PPCClass >> allocateTemporaryVariableNamed: preferredName [ 
+	"Allocate a new variable with (preferably) given name.
+	 Returns a real variable name that should be used."
+	
+	^ self currentNonInlineMethod allocateTemporaryVariableNamed: preferredName
+
+	"Created: / 23-04-2015 / 17:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'ids' }
+PPCClass >> asClassName: string [
+	"e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432"
+	
+	| toUse |
+
+	toUse := string asString select: [:char | char isAlphaNumeric or: [ char = $_ ] ].
+	(toUse isEmpty or: [ toUse first isLetter not ])
+		ifTrue: [ toUse := 'v', toUse ].
+
+	toUse first isLowercase ifTrue: [
+		toUse := toUse copy.
+		toUse at: 1 put: toUse first asUppercase		
+	].
+	^ toUse asSymbol
+
+	"Modified: / 10-05-2015 / 07:29:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'ids' }
+PPCClass >> asSelector: string [
+	"e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432"
+	
+	| toUse |
+
+	toUse := string select: [:char | char isAlphaNumeric or: [ char = $_ ] ].
+	(toUse isEmpty or: [ toUse first isLetter not ])
+		ifTrue: [ toUse := 'v', toUse ].
+	toUse first isUppercase ifFalse:[
+		toUse := toUse copy.
+		toUse at: 1 put: toUse first asLowercase
+	].
+	^toUse
+
+	"Modified: / 10-05-2015 / 07:29:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'method cache' }
+PPCClass >> cachedMethod: id [
+	^ methodDictionary at: id ifAbsent: [ nil ]
+]
+
+{ #category : 'method cache' }
+PPCClass >> cachedMethod: id ifPresent: aBlock [
+	^ methodDictionary at: id ifPresent: aBlock
+]
+
+{ #category : 'accessing' }
+PPCClass >> classVariables [
+	^ constants keys asArray
+]
+
+{ #category : 'accessing' }
+PPCClass >> constants [
+	^ constants
+]
+
+{ #category : 'accessing' }
+PPCClass >> currentMethod [
+	^ currentMethod 
+]
+
+{ #category : 'accessing' }
+PPCClass >> currentNonInlineMethod [
+	^ methodStack 
+		detect:[:m | m isInline not ] 
+		ifNone:[ self error: 'No non-inlined method']
+
+	"Created: / 23-04-2015 / 17:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'accessing' }
+PPCClass >> currentReturnVariable [
+	^ currentMethod returnVariable 
+]
+
+{ #category : 'accessing-properties' }
+PPCClass >> hasProperty: aKey [
+	"Test if the property aKey is present."
+	
+	^ properties notNil and: [ properties includesKey: aKey ]
+]
+
+{ #category : 'ids' }
+PPCClass >> idFor: anObject [
+	^ idGen idFor: anObject
+]
+
+{ #category : 'ids' }
+PPCClass >> idFor: anObject defaultName: defaultName [
+	^ idGen idFor: anObject defaultName: defaultName
+]
+
+{ #category : 'accessing' }
+PPCClass >> idGen [
+	^ idGen
+]
+
+{ #category : 'accessing' }
+PPCClass >> idGen: anObject [
+	idGen := anObject
+]
+
+{ #category : 'accessing' }
+PPCClass >> ids [
+	^ idGen ids
+]
+
+{ #category : 'initialization' }
+PPCClass >> initialize [
+	super initialize.
+
+	methodStack := Stack new.
+	methodDictionary := IdentityDictionary new.
+	constants := Dictionary new.
+	idGen := PPCIdGenerator new.
+]
+
+{ #category : 'accessing' }
+PPCClass >> instanceAndClassVariables [
+	| collection |
+	collection := OrderedCollection new.
+	collection addAll: self instanceVariables.
+	collection addAll: self classVariables.
+	^ collection
+]
+
+{ #category : 'accessing' }
+PPCClass >> instanceVariables [
+	^ #()
+]
+
+{ #category : 'accessing' }
+PPCClass >> methodDictionary [
+	^ methodDictionary
+]
+
+{ #category : 'accessing' }
+PPCClass >> name [
+	^ self asClassName: (self propertyAt: #name)
+]
+
+{ #category : 'accessing' }
+PPCClass >> name: value [
+	^ self propertyAt: #name put: value
+]
+
+{ #category : 'ids' }
+PPCClass >> numberIdFor: object [
+	^ idGen numericIdFor: object
+]
+
+{ #category : 'support' }
+PPCClass >> parsedValueOf: aBlock to: aString [
+	| tmpVarirable method |
+
+	self assert:aBlock isBlock.
+	self assert:aString isNil not.
+	
+	tmpVarirable := returnVariable.
+	returnVariable := aString.
+	method := [
+		aBlock value
+	] ensure:[ returnVariable := tmpVarirable ].
+
+	self assert: (method isMethod).	
+	^ method
+]
+
+{ #category : 'support' }
+PPCClass >> pop [
+	| retval |
+	retval := methodStack pop.
+	currentMethod := methodStack isEmpty 
+		ifTrue: [ nil ]
+		ifFalse: [ methodStack top ].
+	^ retval
+
+	"Modified: / 21-11-2014 / 12:27:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'accessing-properties' }
+PPCClass >> properties [
+	^ properties
+]
+
+{ #category : 'accessing-properties' }
+PPCClass >> properties: aDictionary [
+	properties := aDictionary 
+]
+
+{ #category : 'accessing-properties' }
+PPCClass >> propertyAt: aKey [ 
+	^ self propertyAt: aKey  ifAbsent: [ nil ]
+]
+
+{ #category : 'accessing-properties' }
+PPCClass >> 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 ]
+]
+
+{ #category : 'accessing-properties' }
+PPCClass >> 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 ]
+]
+
+{ #category : 'accessing-properties' }
+PPCClass >> 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
+]
+
+{ #category : 'support' }
+PPCClass >> push [
+	methodStack push: currentMethod.
+	(methodStack size > 500 )ifTrue: [ self error: 'unless it is very complex grammar, there is an error somewhere' ]
+
+	"Modified: / 21-11-2014 / 12:27:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'support' }
+PPCClass >> returnVariable [
+	self error: 'Should never be called and accessed outside this class'.
+	^ returnVariable 
+]
+
+{ #category : 'accessing' }
+PPCClass >> rootMethod [
+	^ self propertyAt: #rootMethod ifAbsent: nil
+
+]
+
+{ #category : 'accessing' }
+PPCClass >> rootMethod: value [
+	^ self propertyAt: #rootMethod put: value
+
+]
+
+{ #category : 'accessing' }
+PPCClass >> selectors [
+	^ methodDictionary keys
+]
+
+{ #category : 'support' }
+PPCClass >> startInline [
+	| indentationLevel |
+	indentationLevel := currentMethod indentationLevel.
+	
+	currentMethod := PPCInlinedMethod new.
+	currentMethod returnVariable: returnVariable.
+	currentMethod indentationLevel: indentationLevel.
+	self push.
+
+	"Modified: / 01-06-2015 / 21:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'support' }
+PPCClass >> startInline: id [
+	| indentationLevel |
+	(methodDictionary includesKey: id) ifTrue: [ self error: 'OOOUPS!' ].
+	indentationLevel := currentMethod indentationLevel.
+	
+	currentMethod := PPCInlinedMethod new.
+	currentMethod id: id.   
+	currentMethod returnVariable: returnVariable.
+	currentMethod indentationLevel: indentationLevel.
+	self push.
+
+	"Modified: / 01-06-2015 / 21:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'support' }
+PPCClass >> startMethod: id category: category [
+	(methodDictionary includesKey: id) ifTrue: [ self error: 'OOOUPS!' ].
+
+	currentMethod := PPCMethod new.
+	currentMethod id: id.
+	currentMethod category: category.
+	
+	self push.      
+	self store: currentMethod as: id.
+
+	"Modified: / 01-06-2015 / 21:19:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'support' }
+PPCClass >> stopInline [
+	^ self pop.
+
+	"Modified: / 01-06-2015 / 21:37:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'support' }
+PPCClass >> stopMethod [
+   self store: currentMethod as: currentMethod methodName.
+	^ self pop.
+
+]
+
+{ #category : 'method cache' }
+PPCClass >> store: method as: id [
+	self assert: (method isKindOf: PPCMethod).
+	methodDictionary at: id put: method.
+]
+
+{ #category : 'accessing' }
+PPCClass >> superclass [
+	^ self propertyAt: #superclass
+]
+
+{ #category : 'accessing' }
+PPCClass >> superclass: value [
+	^ self propertyAt: #superclass put: value
+]
diff --git a/software/petitcompiler/PPCCodeBlock.class.st b/software/petitcompiler/PPCCodeBlock.class.st
new file mode 100644
index 0000000..4594681
--- /dev/null
+++ b/software/petitcompiler/PPCCodeBlock.class.st
@@ -0,0 +1,231 @@
+Class {
+	#name : 'PPCCodeBlock',
+	#superclass : 'Object',
+	#instVars : [
+		'buffer',
+		'indentation',
+		'temporaries'
+	],
+	#category : 'PetitCompiler-Compiler-Codegen'
+}
+
+{ #category : 'instance creation' }
+PPCCodeBlock class >> new [
+	"return an initialized instance"
+
+	^ self basicNew initialize.
+]
+
+{ #category : 'adding' }
+PPCCodeBlock >> add: string [
+	self nl.
+	self codeIndent.
+	self addOnLine: string.
+
+	"Modified: / 01-06-2015 / 22:58:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'adding' }
+PPCCodeBlock >> addOnLine: string [
+	buffer nextPutAll: string.
+]
+
+{ #category : 'code generation - variables' }
+PPCCodeBlock >> allocateTemporaryVariableNamed:preferredName [ 
+	"Allocate a new variable with (preferably) given name.
+	 Returns a real variable name that should be used."
+	
+	(temporaries includes:preferredName) ifFalse:[
+		temporaries add:preferredName.
+		^ preferredName
+	] ifTrue:[
+		| name |
+
+		name := preferredName , '_' , (temporaries size + 1) printString.
+		temporaries add:name.
+		^ name
+	].
+
+	"Created: / 23-04-2015 / 17:37:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 01-06-2015 / 21:03:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation' }
+PPCCodeBlock >> code: aStringOrBlockOrRBParseNode [
+	self codeNl.
+	self codeOnLine: aStringOrBlockOrRBParseNode
+	
+	"Created: / 01-06-2015 / 21:07:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 03-06-2015 / 05:52:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation' }
+PPCCodeBlock >> codeIndent [
+	self codeIndent:indentation
+
+	"Created: / 01-06-2015 / 22:58:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation' }
+PPCCodeBlock >> codeIndent: level [
+	((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ 
+		level * 4 timesRepeat: [ buffer nextPut: Character space  ].
+	] ifFalse:[ 
+		level timesRepeat: [ buffer nextPut: Character tab  ].
+	].
+
+	"Created: / 01-06-2015 / 22:58:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation' }
+PPCCodeBlock >> codeNl [
+	self add: ''.
+]
+
+{ #category : 'printing and storing' }
+PPCCodeBlock >> codeOn: aStream [
+	"Dumps generated code on given stream"
+
+	temporaries notEmpty ifTrue:[
+		((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ 
+			indentation * 4 timesRepeat: [ aStream nextPut: Character space  ].
+		] ifFalse:[ 
+			indentation timesRepeat: [ aStream nextPut: Character tab  ].
+		].
+		aStream nextPut: $|.
+		temporaries do:[:e | aStream space; nextPutAll: e  ].
+		aStream space.
+		aStream nextPut: $|. 
+		self nl.
+		"In Smalltalk/X, there should be a blank line after temporaries"
+		((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[ 
+			self nl.
+		].
+	].
+	aStream nextPutAll: buffer contents
+
+	"Created: / 01-06-2015 / 21:26:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation' }
+PPCCodeBlock >> codeOnLine: aStringOrBlockOrRBParseNode [
+	aStringOrBlockOrRBParseNode isString ifTrue:[ 
+		self emitCodeAsString: aStringOrBlockOrRBParseNode
+	] ifFalse:[
+		(aStringOrBlockOrRBParseNode isKindOf: RBProgramNode) ifTrue:[ 
+			self emitCodeAsRBNode: aStringOrBlockOrRBParseNode.
+		] ifFalse:[  
+			self emitCodeAsBlock: aStringOrBlockOrRBParseNode
+		].
+	].
+]
+
+{ #category : 'indentation' }
+PPCCodeBlock >> dedent [
+	indentation := indentation - 1
+]
+
+{ #category : 'private' }
+PPCCodeBlock >> emitCodeAsBlock: aBlock [
+	aBlock value
+
+]
+
+{ #category : 'private' }
+PPCCodeBlock >> emitCodeAsRBNode: anRBNode [
+	anRBNode isSequence ifTrue:[
+		anRBNode temporaries do:[:e |  
+			(temporaries includes: e name) ifFalse:[ 
+				temporaries add: e name
+			].
+		].
+		anRBNode statements do:[:e|
+			self 	add: (self formatRBNode: e); 
+					addOnLine: '.'.
+		].
+	] ifFalse:[  
+		buffer nextPutAll: anRBNode formattedCode.  
+	].
+
+
+
+]
+
+{ #category : 'private' }
+PPCCodeBlock >> emitCodeAsString: aString [
+	self addOnLine: aString
+
+]
+
+{ #category : 'private' }
+PPCCodeBlock >> formatRBNode: anRBNode [
+	| formatter |
+	formatter := anRBNode formatterClass new.
+	formatter indent: indentation.
+	^ formatter format: anRBNode 
+]
+
+{ #category : 'indentation' }
+PPCCodeBlock >> indent [ 
+	indentation := indentation + 1
+]
+
+{ #category : 'indentation' }
+PPCCodeBlock >> indentationLevel [
+	^ indentation
+]
+
+{ #category : 'indentation' }
+PPCCodeBlock >> indentationLevel: value [
+	indentation := value
+]
+
+{ #category : 'initialization' }
+PPCCodeBlock >> initialize [
+	"Invoked when a new instance is created."
+
+	buffer := String new writeStream.
+	indentation := 1.
+	temporaries := OrderedCollection new.
+
+	"Modified: / 01-06-2015 / 20:57:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified (comment): / 18-06-2015 / 06:04:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'indent-dedent' }
+PPCCodeBlock >> nl [
+	^ buffer nextPut: Character cr
+]
+
+{ #category : 'printing and storing' }
+PPCCodeBlock >> sourceOn:aStream [ 
+	"Dumps generated code on given stream"
+	
+	temporaries notEmpty ifTrue:[
+		((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
+			indentation * 4 timesRepeat:[
+				aStream nextPut:Character space
+			].
+		] ifFalse:[
+			indentation timesRepeat:[
+				aStream nextPut:Character tab
+			].
+		].
+		aStream nextPut:$|.
+		temporaries do:[:e | 
+			aStream
+				space;
+				nextPutAll:e
+		].
+		aStream space.
+		aStream nextPut:$|.
+		self nl.
+		 "In Smalltalk/X, there should be a blank line after temporaries"
+		((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifTrue:[
+			self nl.
+		].
+	].
+	aStream nextPutAll:buffer contents
+
+	"Created: / 01-06-2015 / 21:26:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
diff --git a/software/petitcompiler/PPCCodeGen.class.st b/software/petitcompiler/PPCCodeGen.class.st
new file mode 100644
index 0000000..44115bd
--- /dev/null
+++ b/software/petitcompiler/PPCCodeGen.class.st
@@ -0,0 +1,575 @@
+Class {
+	#name : 'PPCCodeGen',
+	#superclass : 'Object',
+	#instVars : [
+		'clazz',
+		'options',
+		'memoizationStrategy'
+	],
+	#category : 'PetitCompiler-Compiler-Codegen'
+}
+
+{ #category : 'instance creation' }
+PPCCodeGen class >> new [
+	"return an initialized instance"
+
+	^ self on: PPCCompilationOptions new
+
+	"Modified: / 07-09-2015 / 10:22:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'instance creation' }
+PPCCodeGen class >> on: aPPCArguments [
+	"return an initialized instance"
+
+	^ self basicNew
+		initialize;
+		options: aPPCArguments
+]
+
+{ #category : 'code primitives' }
+PPCCodeGen >> add: string [
+	self error: 'deprecated?'.
+	clazz currentMethod add: string.
+]
+
+{ #category : 'code primitives' }
+PPCCodeGen >> addConstant: value as: name [    
+	clazz addConstant: value as: name
+
+]
+
+{ #category : 'code primitives' }
+PPCCodeGen >> addOnLine: string [
+	self error: 'deprecated'.
+	clazz currentMethod addOnLine: string.
+]
+
+{ #category : 'code primitives' }
+PPCCodeGen >> addVariable: name [
+	^ clazz currentNonInlineMethod addVariable: name
+
+	"Modified: / 23-04-2015 / 17:34:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'variables' }
+PPCCodeGen >> allocateReturnVariable [    
+	^ clazz allocateReturnVariableNamed: '__retval'
+
+	"Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 15-06-2015 / 17:52:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'variables' }
+PPCCodeGen >> allocateReturnVariableNamed: name [
+	^ clazz allocateReturnVariableNamed: name
+]
+
+{ #category : 'variables' }
+PPCCodeGen >> allocateTemporaryVariableNamed: preferredName [ 
+	"Allocate a new variable with (preferably) given name.
+	 Returns a real variable name that should be used."
+	
+	^ clazz allocateTemporaryVariableNamed: preferredName
+
+	"Created: / 23-04-2015 / 17:33:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'caching' }
+PPCCodeGen >> cacheMethod: method as: id [
+	^ clazz store: method as: id
+]
+
+{ #category : 'caching' }
+PPCCodeGen >> cachedMethod: id [
+	^ clazz cachedMethod: id
+]
+
+{ #category : 'caching' }
+PPCCodeGen >> cachedMethod: id ifPresent: aBlock [
+	^ clazz cachedMethod: id ifPresent: aBlock
+]
+
+{ #category : 'code primitives' }
+PPCCodeGen >> call: anotherMethod [
+	self error: 'deprecated?'.
+	clazz currentMethod add: anotherMethod call.
+]
+
+{ #category : 'code primitives' }
+PPCCodeGen >> callOnLine: anotherMethod [
+	self error: 'deprecated?'.
+	clazz currentMethod addOnLine: anotherMethod call.
+]
+
+{ #category : 'accessing' }
+PPCCodeGen >> clazz [
+	^ clazz
+]
+
+{ #category : 'accessing' }
+PPCCodeGen >> clazz: aPPCClass [
+	clazz := aPPCClass
+]
+
+{ #category : 'code' }
+PPCCodeGen >> code: aStringOrBlockOrRBParseNode [
+	clazz currentMethod code: aStringOrBlockOrRBParseNode
+
+	"Created: / 01-06-2015 / 23:49:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code' }
+PPCCodeGen >> codeAssert: aCode [
+	self code: 'self assert: (', aCode, ').'.
+]
+
+{ #category : 'code assignment' }
+PPCCodeGen >> codeAssign: stringOrBlock to: variable [
+	self assert: variable isNil not.
+	
+	stringOrBlock isString ifTrue: [ 
+		^ self codeAssignString: stringOrBlock to: variable
+	].
+
+	(stringOrBlock isKindOf: BlockClosure) ifTrue: [ 
+		^ self codeAssignParsedValueOf: stringOrBlock  to: variable
+	].
+
+	self error: 'unknown argument'.
+]
+
+{ #category : 'code assignment' }
+PPCCodeGen >> codeAssignParsedValueOf:aBlock to: variable [ 
+	|   method |
+	method := clazz parsedValueOf: aBlock to: variable.
+		
+	method isInline ifTrue:[
+		self codeCallOnLine:method
+	] ifFalse:[
+		self codeAssignString: (method call) to: variable.
+	]
+
+	"Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code assignment' }
+PPCCodeGen >> codeAssignString: string to: variable [
+	self assert: variable isNil not.
+	
+	"TODO JK: Hack alert, whatever is magic constant!"
+	(variable == #whatever) ifFalse: [ 
+		"Do not assign, if somebody does not care!"
+		self code: variable ,' := ', string.
+	]
+]
+
+{ #category : 'code' }
+PPCCodeGen >> codeBlock: contents [
+	clazz currentMethod codeBlock: contents
+
+	"Created: / 01-06-2015 / 22:35:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code' }
+PPCCodeGen >> codeCall: aMethod [
+	self assert: (aMethod isKindOf: PPCMethod).
+	self code: aMethod call.
+]
+
+{ #category : 'code' }
+PPCCodeGen >> codeCallOnLine: aMethod [
+	self assert: (aMethod isKindOf: PPCMethod).
+	self codeOnLine: aMethod call.
+]
+
+{ #category : 'code error handling' }
+PPCCodeGen >> codeClearError [
+	self code: 'error := false.'.
+
+]
+
+{ #category : 'code debugging' }
+PPCCodeGen >> codeComment: string [
+	self code: '"', (string copyReplaceAll: '"' with: '""'), '"'.
+]
+
+{ #category : 'code' }
+PPCCodeGen >> codeDot [
+	self codeOnLine: '.'.
+
+	"Created: / 16-06-2015 / 06:09:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code error handling' }
+PPCCodeGen >> codeError [
+	self code: 'self parseError: ''message notspecified''.'.
+
+]
+
+{ #category : 'code error handling' }
+PPCCodeGen >> codeError: errorMessage [
+	| escaped |
+	escaped := (errorMessage copyReplaceAll: '''' with: '''''').
+	self code: 'self parseError: ''', escaped, '''.'
+
+]
+
+{ #category : 'code error handling' }
+PPCCodeGen >> codeError: errorMessage at: position [
+	| escaped |
+	escaped := (errorMessage copyReplaceAll: '''' with: '''''').
+	self code: 'self parseError: ''', escaped, ''' at: ', position asString, '.'
+
+]
+
+{ #category : 'code assignment' }
+PPCCodeGen >> codeEvaluate: stringOrBlock [
+	^ self codeEvaluateAndAssign: stringOrBlock to: #whatever
+]
+
+{ #category : 'code assignment' }
+PPCCodeGen >> codeEvaluate: selector argument: argument on: variable [
+	self assert: variable isNil not.
+	
+	"TODO JK: Hack alert, whatever is magic constant!"
+	(variable == #whatever) ifFalse: [ 
+		"Do not assign, if somebody does not care!"
+		self code: variable, ' ', selector,' ', argument.
+ 	] ifTrue: [ 
+		"In case argument has a side effect"
+ 		self code: argument	
+	]
+]
+
+{ #category : 'code assignment' }
+PPCCodeGen >> codeEvaluateAndAssign: stringOrBlock to: variable [
+	"Contrary to codeAssign:to: I always put code onto the stream"
+	stringOrBlock isString ifTrue: [ 
+		self codeEvaluateAndAssignString: stringOrBlock to: variable
+	] ifFalse: [ 
+		self assert: (stringOrBlock isKindOf: BlockClosure).
+		self codeEvaluateAndAssignParsedValueOf: stringOrBlock  to: variable 
+	]
+]
+
+{ #category : 'code assignment' }
+PPCCodeGen >> codeEvaluateAndAssignParsedValueOf: aBlock to: variable [
+	| method |
+	method := clazz parsedValueOf: aBlock to: variable	.
+
+
+	method isInline ifFalse: [ 
+		self codeEvaluateAndAssignString: method call to: variable.
+	] ifTrue: [ 
+		"if inlined, the variable is already filled in, just call it"
+		self code: method call
+	]
+
+]
+
+{ #category : 'code assignment' }
+PPCCodeGen >> codeEvaluateAndAssignString: string to: variable [
+	"Contrary to codeAssign:to: I always put code onto the stream"
+	self assert: string isString.
+	self assert: variable isNil not.
+	
+	"TODO JK: Hack alert, whatever is magic constant!"
+	(variable == #whatever) ifFalse: [ 
+		self codeAssignString: string to: variable
+	] ifTrue: [ 
+		"In case code has a side effect"
+		self code: string.	
+	]
+]
+
+{ #category : 'code debugging' }
+PPCCodeGen >> codeHalt [
+	self code: 'self halt. '
+
+]
+
+{ #category : 'code debugging' }
+PPCCodeGen >> codeHaltIfShiftPressed [
+	options debug ifTrue: [
+		((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifFalse:[  
+			self code: 'self haltIf:[Sensor shiftPressed].'
+		]
+	]
+
+	"Modified: / 10-05-2015 / 07:39:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code structures' }
+PPCCodeGen >> codeIf: condition then: then [ 
+	self codeIf: condition then: then else: nil
+
+	"Created: / 16-06-2015 / 06:07:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code structures' }
+PPCCodeGen >> codeIf: condition then: then else: else [
+	self 
+		code: '(';
+		codeOnLine: condition;
+		codeOnLine: ')'.
+	then notNil ifTrue:[ 
+		self 
+			codeOnLine:' ifTrue: ';
+			codeBlock: then.
+	].
+	else notNil ifTrue:[ 
+		self
+			codeOnLine:' ifFalse: ';
+			codeBlock: else.
+	].
+	self codeDot.
+
+	"Created: / 01-06-2015 / 22:43:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 16-06-2015 / 06:09:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code error handling' }
+PPCCodeGen >> codeIfErrorThen: then [
+	^ self codeIf: 'error' then: then else: nil
+
+	"Created: / 16-06-2015 / 06:06:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code error handling' }
+PPCCodeGen >> codeIfErrorThen: then else: else [
+	^ self codeIf: 'error' then: then else: else
+
+	"Created: / 16-06-2015 / 06:05:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code indentation' }
+PPCCodeGen >> codeIndentPop [
+	self code: 'context indentStack pop'; codeDot
+]
+
+{ #category : 'code' }
+PPCCodeGen >> codeNil [
+	self codeOnLine: 'nil'.
+
+]
+
+{ #category : 'code' }
+PPCCodeGen >> codeNl [
+	self code: ''.
+]
+
+{ #category : 'code' }
+PPCCodeGen >> codeOnLine:aStringOrBlockOrRBParseNode [
+	clazz currentMethod codeOnLine: aStringOrBlockOrRBParseNode
+
+	"Created: / 01-06-2015 / 23:49:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code debugging' }
+PPCCodeGen >> codeProfileStart [
+	self code: 'context methodInvoked: #', clazz currentMethod methodName, '.'
+
+	"Created: / 01-06-2015 / 21:17:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code debugging' }
+PPCCodeGen >> codeProfileStop [
+	self code: 'context methodFinished: #', clazz currentMethod methodName, '.'
+
+	"Created: / 01-06-2015 / 21:19:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code' }
+PPCCodeGen >> codeReturn [
+   clazz currentMethod isInline ifTrue: [
+				"If inlined, the return variable already holds the value"
+		] ifFalse: [
+				options profile ifTrue:[ 
+						self codeProfileStop.
+				]. 
+				self code: '^ ', clazz currentMethod returnVariable  
+		].
+
+				"Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+				"Modified: / 01-06-2015 / 21:49:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code' }
+PPCCodeGen >> codeReturn: code [
+	" - returns whatever is in code OR
+	  - assigns whatever is in code into the returnVariable"
+	clazz currentMethod isInline ifTrue:[
+		self codeEvaluateAndAssign: code to: clazz currentMethod returnVariable. 
+	] ifFalse: [ 
+		options profile ifTrue:[ 
+			self codeProfileStop.
+		].   
+		self code: '^ '.
+		self codeOnLine: code            
+	]
+
+	"Created: / 23-04-2015 / 18:01:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 01-06-2015 / 21:48:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code' }
+PPCCodeGen >> codeReturnParsedValueOf: aBlock [ 
+	|   method |
+
+	method := clazz parsedValueOf: aBlock to: clazz currentReturnVariable.
+
+	method isInline ifTrue:[
+		self codeCallOnLine: method.
+		self codeReturn: clazz currentReturnVariable.
+	] ifFalse:[
+		self codeReturn: method call.
+		
+	]
+
+	"Created: / 23-04-2015 / 18:21:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code debugging' }
+PPCCodeGen >> codeTranscriptShow: text [
+	(options debug) ifTrue: [ 
+		self code: 'Transcript show: ', text storeString, '; cr.'.
+	]
+]
+
+{ #category : 'accessing' }
+PPCCodeGen >> currentMethod [
+	^ clazz currentMethod 
+]
+
+{ #category : 'variables' }
+PPCCodeGen >> currentReturnVariable [
+	^ clazz currentReturnVariable 
+]
+
+{ #category : 'accessing - options' }
+PPCCodeGen >> debug [
+	^ options debug
+]
+
+{ #category : 'code primitives' }
+PPCCodeGen >> dedent [
+	clazz currentMethod dedent
+]
+
+{ #category : 'gt' }
+PPCCodeGen >> gtCurrentMethod: composite [
+	<gtInspectorPresentationOrder: 40>
+	
+	composite text
+		title: 'Current Method';
+		display: [ :codeGen | codeGen clazz currentMethod source ]
+	
+]
+
+{ #category : 'ids' }
+PPCCodeGen >> idFor: anObject [
+	^ clazz idFor: anObject
+]
+
+{ #category : 'ids' }
+PPCCodeGen >> idFor: anObject defaultName: defaultName [
+	^ clazz idFor: anObject defaultName: defaultName
+]
+
+{ #category : 'accessing' }
+PPCCodeGen >> idGen [
+	^ clazz idGen
+]
+
+{ #category : 'accessing' }
+PPCCodeGen >> idGen: idGenerator [
+	^ clazz idGen: idGenerator
+]
+
+{ #category : 'accessing' }
+PPCCodeGen >> ids [
+	^ clazz idGen ids
+]
+
+{ #category : 'code primitives' }
+PPCCodeGen >> indent [
+	clazz currentMethod indent
+]
+
+{ #category : 'initialization' }
+PPCCodeGen >> initialize [
+	super initialize.
+
+	clazz := PPCClass new.
+]
+
+{ #category : 'memoization' }
+PPCCodeGen >> memoizationStrategy [
+	memoizationStrategy isNil ifTrue: [ 
+		memoizationStrategy := (options memoizationStrategy asClass new)
+			codeGen: self;
+			yourself
+	].
+
+	^ memoizationStrategy 
+]
+
+{ #category : 'accessing' }
+PPCCodeGen >> methodCategory [
+	^ 'generated'
+]
+
+{ #category : 'ids' }
+PPCCodeGen >> numberIdFor: object [
+	^ clazz numberIdFor: object
+]
+
+{ #category : 'accessing' }
+PPCCodeGen >> options: args [
+	options := args
+]
+
+{ #category : 'code debugging' }
+PPCCodeGen >> profileTokenRead: tokenName [
+	options profile ifTrue: [ 
+		self code: 'context tokenRead: ', tokenName storeString, '.'
+	]
+]
+
+{ #category : 'support' }
+PPCCodeGen >> startInline [
+	^ clazz startInline
+
+	"Modified: / 01-06-2015 / 21:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'support' }
+PPCCodeGen >> startInline: id [
+	^ clazz startInline: id
+
+	"Modified: / 01-06-2015 / 21:48:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'support' }
+PPCCodeGen >> startMethod: id [
+	clazz startMethod: id category: self methodCategory.
+	
+	options profile ifTrue:[ 
+		self codeProfileStart.
+	].
+]
+
+{ #category : 'support' }
+PPCCodeGen >> stopInline [
+	^ clazz stopInline
+
+	"Modified: / 01-06-2015 / 21:37:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'support' }
+PPCCodeGen >> stopMethod [
+   ^ clazz stopInline 
+
+		"Modified: / 01-06-2015 / 21:38:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
diff --git a/software/petitcompiler/PPCContext.class.st b/software/petitcompiler/PPCContext.class.st
new file mode 100644
index 0000000..9c74945
--- /dev/null
+++ b/software/petitcompiler/PPCContext.class.st
@@ -0,0 +1,428 @@
+Class {
+	#name : 'PPCContext',
+	#superclass : 'PPStream',
+	#instVars : [
+		'root',
+		'properties',
+		'globals',
+		'furthestFailure',
+		'compiledParser',
+		'ws',
+		'waterPosition',
+		'columns'
+	],
+	#category : 'PetitCompiler-Context'
+}
+
+{ #category : 'as yet unclassified' }
+PPCContext class >> new [
+	^ self basicNew initialize
+]
+
+{ #category : 'as yet unclassified' }
+PPCContext class >> on: aPPParser stream: aStream [
+	^ self basicNew 
+		initialize;
+		root: aPPParser;
+		stream: aStream asPetitStream;
+		yourself
+]
+
+{ #category : 'converting' }
+PPCContext >> asCompiledParserContext [
+	^ self
+]
+
+{ #category : 'whitespace' }
+PPCContext >> atWs [
+	^ position == ws
+]
+
+{ #category : 'indentation' }
+PPCContext >> column [
+	^ self columns at: (position + 1)
+]
+
+{ #category : 'indentation' }
+PPCContext >> columns [
+	| column tmpPosition |
+	
+	columns isNil ifTrue: [ 
+		tmpPosition := position.
+		columns := Array new: readLimit + 1.
+		column := 1.
+	
+		0 to: readLimit do: [ :index |
+			position := index.
+			self isStartOfLine ifTrue: [ column := 1 ].
+			columns at: (index + 1) put: column.
+			column := column + 1.
+		].
+	
+		position := tmpPosition.
+	].
+	^ columns
+]
+
+{ #category : 'initialization' }
+PPCContext >> compiledParser [
+	^ compiledParser
+]
+
+{ #category : 'initialization' }
+PPCContext >> compiledParser: anObject [
+	compiledParser := anObject
+]
+
+{ #category : 'failures' }
+PPCContext >> furthestFailure [
+	^ furthestFailure 
+]
+
+{ #category : 'accessing-globals' }
+PPCContext >> globalAt: aKey [
+	"Answer the global property value associated with aKey."
+	
+	^ self globalAt: aKey ifAbsent: [ self error: 'Property not found' ]
+]
+
+{ #category : 'accessing-globals' }
+PPCContext >> globalAt: aKey ifAbsent: aBlock [
+	"Answer the global property value associated with aKey or, if aKey isn't found, answer the result of evaluating aBlock."
+	
+	^ globals isNil
+		ifTrue: [ aBlock value ]
+		ifFalse: [ globals at: aKey ifAbsent: aBlock ]
+]
+
+{ #category : 'accessing-globals' }
+PPCContext >> globalAt: aKey ifAbsentPut: aBlock [
+	"Answer the global property associated with aKey or, if aKey isn't found store the result of evaluating aBlock as new value."
+	
+	^ self globalAt: aKey ifAbsent: [ self globalAt: aKey put: aBlock value ]
+]
+
+{ #category : 'accessing-globals' }
+PPCContext >> globalAt: aKey put: anObject [
+	"Set the global 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."
+
+	^ (globals ifNil: [ globals := Dictionary new: 1 ])
+		at: aKey put: anObject
+]
+
+{ #category : 'whitespace' }
+PPCContext >> goUpTo: char [
+	[ position < readLimit ] whileTrue: [ 
+		(collection at: position + 1) == char ifTrue: [ position := position + 1. ^ char ] .
+		position := position + 1.
+	]
+	
+]
+
+{ #category : 'gt' }
+PPCContext >> gtIndentStack: composite [
+	<gtInspectorPresentationOrder: 40>
+	
+	composite list
+		title: 'Indent Stack';
+		display: [ :context | context indentStack contents ]
+]
+
+{ #category : 'gt' }
+PPCContext >> gtProperties: composite [
+	<gtInspectorPresentationOrder: 40>
+	
+	composite table
+		title: 'Properties';
+		column: 'Key' evaluated: [ :each | each key printString ];
+		column: 'Value' evaluated: [ :each | each value printString ];
+		display: [ :node | (node properties ifNil: [ Dictionary new ]) associations ]
+]
+
+{ #category : 'accessing-globals' }
+PPCContext >> hasGlobal: aKey [
+	"Test if the global property aKey is present."
+	
+	^ globals notNil and: [ globals includesKey: aKey ]
+]
+
+{ #category : 'accessing-properties' }
+PPCContext >> hasProperties [
+	^ properties isNil not and: [ properties isEmpty not ]
+]
+
+{ #category : 'accessing-properties' }
+PPCContext >> hasProperty: aKey [
+	"Test if the property aKey is present."
+	
+	^ properties notNil and: [ properties includesKey: aKey ]
+]
+
+{ #category : 'ruby' }
+PPCContext >> heredocId [
+	^ self globalAt: #heredocId ifAbsent: nil
+]
+
+{ #category : 'ruby' }
+PPCContext >> heredocId: value [
+	self globalAt: #heredocId put: value
+]
+
+{ #category : 'memoization' }
+PPCContext >> identifier [
+	^ collection
+]
+
+{ #category : 'indentation' }
+PPCContext >> indentStack [
+	^ self propertyAt: #indentStack ifAbsentPut: [ IndentStack new ]
+]
+
+{ #category : 'initialization' }
+PPCContext >> initialize [
+	super initialize.	
+	rc := 0.
+	"Note a failure at -1"
+	furthestFailure  := PPFailure new position: -1; yourself.
+]
+
+{ #category : 'initialization' }
+PPCContext >> initializeFor: parser [
+	rc := 0.
+	root := parser.
+]
+
+{ #category : 'accessing-globals' }
+PPCContext >> invoke: parser [
+	^ parser parseOn: self
+]
+
+{ #category : 'profiling' }
+PPCContext >> islandInvoke [
+]
+
+{ #category : 'profiling' }
+PPCContext >> islandMemoHit [
+]
+
+{ #category : 'profiling' }
+PPCContext >> islandMemoized [
+]
+
+{ #category : 'memoization' }
+PPCContext >> lwRemember [
+
+	^ position
+]
+
+{ #category : 'memoization' }
+PPCContext >> lwRestore: aPPContextMemento [
+	
+	position := aPPContextMemento.
+]
+
+{ #category : 'failures' }
+PPCContext >> noteFailure: aPPFailure [
+	(aPPFailure position > furthestFailure position)
+		ifTrue: [ furthestFailure := aPPFailure ].
+]
+
+{ #category : 'accessing-globals' }
+PPCContext >> peek2 [
+	position = readLimit ifTrue: [ ^ nil ].
+	^ collection at: (position + 1)
+]
+
+{ #category : 'ruby' }
+PPCContext >> percentStringEnd [
+	^ self globalAt: #percentStringEnd ifAbsent: nil
+]
+
+{ #category : 'ruby' }
+PPCContext >> percentStringStart: value [
+	| endValue |
+	endValue := value.
+	(value == $[) ifTrue: [ endValue := $] ].
+	(value == $() ifTrue: [ endValue := $) ].
+	(value == ${) ifTrue: [ endValue := $} ].
+
+	self globalAt: #percentStringStart put: value.
+	self globalAt: #percentStringEnd put: endValue
+]
+
+{ #category : 'accessing-properties' }
+PPCContext >> properties [
+	^ properties ifNil: [ properties := Dictionary new ]
+]
+
+{ #category : 'accessing-properties' }
+PPCContext >> propertyAt: aKey [
+	"Answer the property value associated with aKey."
+	
+	^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]
+]
+
+{ #category : 'accessing-properties' }
+PPCContext >> 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 ]
+]
+
+{ #category : 'accessing-properties' }
+PPCContext >> 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 ]
+]
+
+{ #category : 'accessing-properties' }
+PPCContext >> 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
+]
+
+{ #category : 'memoization' }
+PPCContext >> remember [
+	| memento |
+	memento := PPCContextMemento new
+		position: position;
+		yourself.
+		
+	self rememberProperties: memento.
+	^ memento
+]
+
+{ #category : 'memoization' }
+PPCContext >> rememberProperties: aPPContextMemento [
+	properties ifNil: [ ^ self ].
+	
+	properties keysAndValuesDo: [ :key :value |
+		aPPContextMemento propertyAt: key put: value
+	].
+]
+
+{ #category : 'accessing-globals' }
+PPCContext >> removeGlobal: aKey [
+	"Remove the property with aKey. Answer the property or raise an error if aKey isn't found."
+	
+	^ self removeGlobal: aKey ifAbsent: [ self error: 'Property not found' ]
+]
+
+{ #category : 'accessing-globals' }
+PPCContext >> removeGlobal: aKey ifAbsent: aBlock [
+	"Remove the global property with aKey. Answer the value or, if aKey isn't found, answer the result of evaluating aBlock."
+	
+	| answer |
+	globals isNil ifTrue: [ ^ aBlock value ].
+	answer := globals removeKey: aKey ifAbsent: aBlock.
+	globals isEmpty ifTrue: [ globals := nil ].
+	^ answer
+]
+
+{ #category : 'accessing-properties' }
+PPCContext >> 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' ]
+]
+
+{ #category : 'accessing-properties' }
+PPCContext >> 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
+]
+
+{ #category : 'initialization' }
+PPCContext >> reset [
+	properties := nil.
+	globals := nil.
+	waterPosition := nil.
+	ws := nil
+]
+
+{ #category : 'memoization' }
+PPCContext >> restore: aPPContextMemento [
+"	
+	position := aPPContextMemento.
+"	
+	position := aPPContextMemento position.
+	
+	self restoreProperties: aPPContextMemento.
+			
+]
+
+{ #category : 'memoization' }
+PPCContext >> restoreProperties: aPPContextMemento [
+	properties ifNil: [ ^ self ].
+	
+	properties keysDo: [ :key |
+		(aPPContextMemento hasProperty: key)
+			ifTrue: [ properties at: key put: (aPPContextMemento propertyAt: key) ]
+			ifFalse: [ properties removeKey: key  ]. 
+	].
+
+	aPPContextMemento keysAndValuesDo: [ :key :value |
+		properties at: key put: value
+	]
+]
+
+{ #category : 'acessing' }
+PPCContext >> root [
+	^ root 
+]
+
+{ #category : 'whitespace' }
+PPCContext >> setWs [
+	^ ws := position
+]
+
+{ #category : 'acessing' }
+PPCContext >> stream [
+	^ self
+]
+
+{ #category : 'acessing' }
+PPCContext >> stream: aStream [
+	collection := aStream collection.
+	position := aStream position.
+	readLimit := collection size.
+	newlines := nil.
+	columns := nil.
+	ws := nil.
+]
+
+{ #category : 'islands' }
+PPCContext >> waterPosition [
+	"^ self globalAt:  #waterPosition ifAbsentPut: [ nil ]"
+	^ waterPosition 
+]
+
+{ #category : 'islands' }
+PPCContext >> waterPosition: value [
+"	^ self globalAt:  #waterPosition put: value"
+	waterPosition := value
+]
+
+{ #category : 'profiling' }
+PPCContext >> waterToken [
+]
+
+{ #category : 'whitespace' }
+PPCContext >> ws [
+	^ ws
+]
+
+{ #category : 'whitespace' }
+PPCContext >> ws: anInteger [
+	ws := anInteger
+]
diff --git a/software/petitcompiler/PPCContextAnalysisEnvironment.class.st b/software/petitcompiler/PPCContextAnalysisEnvironment.class.st
new file mode 100644
index 0000000..370cc34
--- /dev/null
+++ b/software/petitcompiler/PPCContextAnalysisEnvironment.class.st
@@ -0,0 +1,39 @@
+Class {
+	#name : 'PPCContextAnalysisEnvironment',
+	#superclass : 'Object',
+	#instVars : [
+		'pushSet',
+		'popSet',
+		'changeSet'
+	],
+	#category : 'PetitCompiler-Support'
+}
+
+{ #category : 'instance creation' }
+PPCContextAnalysisEnvironment class >> new [
+	^ self basicNew initialize
+]
+
+{ #category : 'as yet unclassified' }
+PPCContextAnalysisEnvironment >> changes [
+	^ changeSet 
+]
+
+{ #category : 'as yet unclassified' }
+PPCContextAnalysisEnvironment >> initialize [
+	super initialize.
+	
+	pushSet := IdentitySet new.
+	popSet  := IdentitySet new.
+	changeSet := IdentitySet new.
+]
+
+{ #category : 'as yet unclassified' }
+PPCContextAnalysisEnvironment >> pops [
+	^ popSet 
+]
+
+{ #category : 'as yet unclassified' }
+PPCContextAnalysisEnvironment >> pushes [
+	^ pushSet 
+]
diff --git a/software/petitcompiler/PPCContextMemento.class.st b/software/petitcompiler/PPCContextMemento.class.st
new file mode 100644
index 0000000..6d26118
--- /dev/null
+++ b/software/petitcompiler/PPCContextMemento.class.st
@@ -0,0 +1,115 @@
+Class {
+	#name : 'PPCContextMemento',
+	#superclass : 'Object',
+	#instVars : [
+		'position',
+		'properties'
+	],
+	#category : 'PetitCompiler-Context'
+}
+
+{ #category : 'comparing' }
+PPCContextMemento >> = anObject [
+	
+	(self == anObject) ifTrue: [ ^ true ].
+	(anObject class = PPCContextMemento) ifFalse: [ ^ false ].
+	
+	(anObject position = position) ifFalse: [ ^ false ].
+
+	(self propertiesSize = anObject propertiesSize) ifFalse: [ ^ false ].
+
+	self keysAndValuesDo: [ :key :value |
+		(anObject hasProperty: key) ifFalse: [ ^ false ].
+		((anObject propertyAt: key) = value) ifFalse: [ ^ false ]. 
+ 		].
+	
+	^ true.
+]
+
+{ #category : 'accessing - properties' }
+PPCContextMemento >> hasProperty: aKey [
+	"Test if the property aKey is present."
+	
+	^ properties notNil and: [ properties includesKey: aKey ]
+]
+
+{ #category : 'comparing' }
+PPCContextMemento >> hash [
+	^ position hash bitXor: properties hash.
+]
+
+{ #category : 'accessing - properties' }
+PPCContextMemento >> keysAndValuesDo: aBlock [
+	properties ifNil: [ ^ self ].
+	properties keysAndValuesDo: [ :key :value | aBlock value: key value: value copy ] 
+]
+
+{ #category : 'accessing' }
+PPCContextMemento >> position [
+	^ position
+]
+
+{ #category : 'accessing' }
+PPCContextMemento >> position: anInteger [
+	position := anInteger 
+]
+
+{ #category : 'accessing - properties' }
+PPCContextMemento >> propertiesSize [
+	properties ifNil: [ ^ 0 ].
+	^ properties size.
+]
+
+{ #category : 'accessing - properties' }
+PPCContextMemento >> propertyAt: aKey [
+	"Answer the property value associated with aKey."
+	
+	^ self propertyAt: aKey ifAbsent: [ self error: 'Property not found' ]
+]
+
+{ #category : 'accessing - properties' }
+PPCContextMemento >> 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 ifFalse: [ 
+		(properties includesKey: aKey) ifTrue: [ 
+			^ (properties at: aKey) copy
+		].
+	].
+	^ aBlock value
+
+	"Modified: / 15-04-2015 / 11:19:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'accessing - properties' }
+PPCContextMemento >> 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 ]
+]
+
+{ #category : 'accessing - properties' }
+PPCContextMemento >> 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 copy)
+]
+
+{ #category : 'accessing - properties' }
+PPCContextMemento >> 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' ]
+]
+
+{ #category : 'accessing - properties' }
+PPCContextMemento >> 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
+]
diff --git a/software/petitcompiler/PPCCopyVisitor.class.st b/software/petitcompiler/PPCCopyVisitor.class.st
new file mode 100644
index 0000000..eecf690
--- /dev/null
+++ b/software/petitcompiler/PPCCopyVisitor.class.st
@@ -0,0 +1,23 @@
+"
+As I go, I do the copy of all the nodes
+"
+Class {
+	#name : 'PPCCopyVisitor',
+	#superclass : 'PPCRewritingVisitor',
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'as yet unclassified' }
+PPCCopyVisitor >> cache: node value: retval [
+	self cache: node value: retval ifPresent: [ :e | self assert: e == retval ]
+]
+
+{ #category : 'as yet unclassified' }
+PPCCopyVisitor >> visitNode: node [
+	| newNode |
+	self change.
+	newNode := node copy.
+	self cache: node value: newNode.
+	
+	^ super visitNode: newNode.
+]
diff --git a/software/petitcompiler/PPCDeterministicChoiceVisitor.class.st b/software/petitcompiler/PPCDeterministicChoiceVisitor.class.st
new file mode 100644
index 0000000..b66be72
--- /dev/null
+++ b/software/petitcompiler/PPCDeterministicChoiceVisitor.class.st
@@ -0,0 +1,88 @@
+"
+I can recognize the deterministic choices, i.e. the choices, where based on the first token, one can decide if to take the choice or not.
+
+This simplifies the generated code and this migth improve performance as well (not yet implemented, as far as I know..)
+
+I need to be revisited and reimplemented...
+"
+Class {
+	#name : 'PPCDeterministicChoiceVisitor',
+	#superclass : 'PPCRewritingVisitor',
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'as yet unclassified' }
+PPCDeterministicChoiceVisitor >> isDeterministicChoice: node [
+	| predicates firstIndexes |
+	
+	predicates := self predicates: node.
+	firstIndexes := OrderedCollection new.
+	predicates do: [ :predicate | 
+		predicate classification withIndexDo: [ :bool :index | 
+			bool ifTrue: [firstIndexes add: index]
+		]
+	].
+
+	
+	^ firstIndexes size = firstIndexes asIdentitySet size
+]
+
+{ #category : 'as yet unclassified' }
+PPCDeterministicChoiceVisitor >> mergeFirstCharSets: firstSet [
+	| firstCharSetsOfFirstSet blocks mergedBlock |
+	firstCharSetsOfFirstSet := firstSet collect: [:e | e firstCharSet ].
+	blocks :=  firstCharSetsOfFirstSet collect: [ :e | e block ].
+	mergedBlock := [ :input | blocks anySatisfy: [ :block | block value: input ] ].
+
+
+	^ PPCharSetPredicate on: mergedBlock.
+]
+
+{ #category : 'as yet unclassified' }
+PPCDeterministicChoiceVisitor >> predicates: node [
+	| firstSets mergedSets |
+	
+	(node startsWithTrimmingTokens) ifTrue: [  
+		| tokensPerChild |
+		tokensPerChild := node children collect: [:child | child firstSetWithTokens "firstSet" ].
+		
+		firstSets := tokensPerChild collect: [ :childTokensOrTerminal | 
+			| firstSet |
+			firstSet := IdentitySet new.
+			childTokensOrTerminal do: [ :tokenOrTerminal | 
+				tokenOrTerminal isTokenNode ifTrue: [ 
+					firstSet addAll: tokenOrTerminal child firstSet 
+				] ifFalse: [  
+					firstSet addAll: tokenOrTerminal firstSet.
+				]
+			].
+			firstSet
+		].
+	] ifFalse: [ 
+		firstSets := node children collect: [:child | child firstSet ].
+	].
+	
+	mergedSets := firstSets collect: [ :fs | self mergeFirstCharSets: fs ].
+	node children with: mergedSets do: [ :child :merged |
+		child mergedFirstCharSet: merged
+	].
+	^ mergedSets
+]
+
+{ #category : 'as yet unclassified' }
+PPCDeterministicChoiceVisitor >> visitChoiceNode: node [
+	self visitChildren: node.
+
+	(self isDeterministicChoice: node) ifTrue: [ 
+		^ PPCDeterministicChoiceNode new
+				children: node children;
+				name: node name;
+				firstFollowCache: node firstFollowCache;
+				properties: node properties;
+				yourself.
+	].
+
+	^ super visitChoiceNode: node.
+	
+
+]
diff --git a/software/petitcompiler/PPCFSAVisitor.class.st b/software/petitcompiler/PPCFSAVisitor.class.st
new file mode 100644
index 0000000..b78d0a2
--- /dev/null
+++ b/software/petitcompiler/PPCFSAVisitor.class.st
@@ -0,0 +1,151 @@
+"
+I create following:
+ - FSAs equivalents for tokens
+ - FSAs for followSetsWithTokens
+
+"
+Class {
+	#name : 'PPCFSAVisitor',
+	#superclass : 'PPCPassVisitor',
+	#instVars : [
+		'fsaCache',
+		'idGen'
+	],
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'accessing' }
+PPCFSAVisitor >> idGen: anObject [
+	idGen := anObject
+]
+
+{ #category : 'initialization' }
+PPCFSAVisitor >> initialize [
+	super initialize.
+	
+	"for the given set of nodes, remember the unordered choice fsa
+		see `unorderedChoiceFromFollowSet:`
+	"
+	fsaCache := Dictionary new.
+]
+
+{ #category : 'as yet unclassified' }
+PPCFSAVisitor >> unorderedChoiceFromFsas: fsas [
+	| result startState |
+	result := PEGFsa new.
+	startState := PEGFsaState new.
+	
+	result addState: startState.
+	result startState: startState.
+
+	fsas do: [ :fsa | 
+		result adopt: fsa.
+		result addTransitionFrom: startState to: fsa startState.
+	].
+
+	result determinizeStandard.
+	^ result
+]
+
+{ #category : 'as yet unclassified' }
+PPCFSAVisitor >> unorderedChoiceFromSet: aSet [
+	| followFsas  |
+	
+	^ fsaCache at: aSet ifAbsentPut: [ 
+		followFsas := aSet collect: [ :followNode | 
+			followNode asFsa 
+				name: (context idGenerator  idFor: followNode);
+				retval: (context idGenerator  idFor: followNode); 
+				yourself
+		].
+		self unorderedChoiceFromFsas: followFsas.
+	]
+
+	"Modified: / 03-09-2015 / 21:28:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'as yet unclassified' }
+PPCFSAVisitor >> visitChoiceNode: node [
+	| anFsa firstSet |
+	super visitChoiceNode: node.
+
+	firstSet := node firstSetWithTokens.
+	anFsa := self unorderedChoiceFromSet: firstSet.
+	anFsa name: (context idGenerator idFor: anFsa defaultName: node defaultName prefix: 'firstOf').
+	node firstFsa: anFsa.
+
+	node children do: [ :child |
+		firstSet := child firstSetWithTokens.
+	
+		anFsa := self unorderedChoiceFromSet: firstSet.
+		anFsa name: 'firstOf_', (context idGenerator idFor: anFsa defaultName: child defaultName prefix: 'firstOf').
+
+		child firstFsa: anFsa.
+	].
+
+	^ node
+
+	"Modified: / 03-09-2015 / 21:27:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'as yet unclassified' }
+PPCFSAVisitor >> visitToken: tokenNode [
+	| anFsa |
+
+	anFsa := tokenNode asFsa determinize.
+	anFsa name: (context idGenerator idFor: tokenNode).
+	anFsa retval: (context idGenerator idFor: tokenNode).
+	
+	tokenNode fsa: anFsa.
+	^ tokenNode
+
+	"Modified: / 03-09-2015 / 21:27:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'as yet unclassified' }
+PPCFSAVisitor >> visitTokenConsumeNode: node [
+	| epsilon anFsa followSet |
+	followSet := node followSetWithTokens.
+	
+	epsilon := followSet anySatisfy: [ :e | e acceptsEpsilon ].
+	followSet := followSet reject: [ :e | e acceptsEpsilon ].
+	epsilon ifTrue: [ followSet add: PPCEndOfFileNode instance ].
+	
+	anFsa := self unorderedChoiceFromSet: followSet.
+	anFsa name: (context idGenerator idFor: anFsa defaultName: node defaultName prefix: 'nextToken').
+
+	node nextFsa: anFsa.
+
+	"Modified: / 03-09-2015 / 21:27:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'as yet unclassified' }
+PPCFSAVisitor >> visitTokenNode: node [
+	^ self visitToken: node
+]
+
+{ #category : 'as yet unclassified' }
+PPCFSAVisitor >> visitTokenizingParserNode: node [
+	"TODO JK: hack alert, change the handling of WS!"
+	self visitWhitespace: node whitespace.
+
+	self visit: node tokens.
+	self visit: node parser.
+	^ node
+
+]
+
+{ #category : 'as yet unclassified' }
+PPCFSAVisitor >> visitTrimmingTokenNode: node [
+	^ self visitToken: node
+]
+
+{ #category : 'as yet unclassified' }
+PPCFSAVisitor >> visitWhitespace: node [
+	"JK HACK: treat ws as token -> create FSA for whitespace"
+	| retval |
+	retval := self visitToken: node.
+	"we don't care about the finals of whitespace"
+	node fsa removeFinals.
+	^ retval
+]
diff --git a/software/petitcompiler/PPCIdGenerator.class.st b/software/petitcompiler/PPCIdGenerator.class.st
new file mode 100644
index 0000000..98ed57d
--- /dev/null
+++ b/software/petitcompiler/PPCIdGenerator.class.st
@@ -0,0 +1,140 @@
+Class {
+	#name : 'PPCIdGenerator',
+	#superclass : 'Object',
+	#instVars : [
+		'idCache',
+		'numericIdCache'
+	],
+	#category : 'PetitCompiler-Compiler-Codegen'
+}
+
+{ #category : 'as yet unclassified' }
+PPCIdGenerator class >> new [
+	^ self basicNew initialize
+]
+
+{ #category : 'as yet unclassified' }
+PPCIdGenerator >> asSelector: string [
+	"e.g. '234znak 43 ) 2' asLegalSelector = #v234znak432"
+	
+	| toUse |
+
+	toUse := string select: [:char | char isAlphaNumeric or: [ char = $_ ] ].
+	(toUse isEmpty or: [ toUse first isLetter not ])
+		ifTrue: [ toUse := 'v', toUse ].
+	toUse first isUppercase ifFalse:[
+		toUse := toUse copy.
+		toUse at: 1 put: toUse first asLowercase
+	].
+	^toUse
+
+	"Modified: / 10-05-2015 / 07:29:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'as yet unclassified' }
+PPCIdGenerator >> cachedSuchThat: block ifNone: noneBlock [
+	| key |
+	key := idCache keys detect: block ifNone: [ nil ].
+	key isNil ifTrue: [ ^ noneBlock value ].
+	
+	^ idCache at: key
+]
+
+{ #category : 'as yet unclassified' }
+PPCIdGenerator >> generateIdFor: object defaultName: defaultName prefix: prefix suffix: suffix [  
+	| name count |
+	object canHavePPCId ifTrue: [ 
+		name := object hasName ifTrue: [ object name ] ifFalse: [ object defaultName ].
+		name := self asSelector: name asString.
+		
+		"JK: I am not sure, if prefix and suffix should be applied to the name or not..."
+"		suffix isNil ifFalse: [ 
+			name := name, '_', suffix.		
+		].
+"	
+		prefix isNil ifFalse: [ 
+			name := prefix , '_', name.		
+		].	
+		
+		"(idCache contains: [ :e | e = name ]) ifTrue: [  self error: 'Duplicit names?' ]."
+	] ifFalse: [ 
+		name := defaultName.
+
+		prefix isNil ifFalse: [ 
+			name := prefix , '_', name.		
+		].
+
+		suffix isNil ifFalse: [ 
+			name := name, '_', suffix.		
+		].
+
+		name := self asSelector: name asString.
+		
+	].
+
+	(idCache contains: [ :e | e = name ]) ifTrue: [  
+		count := 2. 
+		
+		[	| tmpName |	
+			tmpName := (name, '_', count asString).
+			idCache contains: [:e | e = tmpName ]
+		] whileTrue: [ count := count + 1 ].
+
+		name := name, '_', count asString
+	].
+	"self haltIf: [ name = 'prim' ]."
+	^ name asSymbol
+]
+
+{ #category : 'as yet unclassified' }
+PPCIdGenerator >> idFor: object [
+	self assert: object canHavePPCId.
+	^ self idFor: object defaultName: object defaultName prefix: object prefix suffix: object suffix
+]
+
+{ #category : 'as yet unclassified' }
+PPCIdGenerator >> idFor: object defaultName: defaultName [
+	^ self idFor: object defaultName: defaultName prefix: nil suffix: nil
+]
+
+{ #category : 'as yet unclassified' }
+PPCIdGenerator >> idFor: object defaultName: defaultName prefix: prefix [
+	^ self idFor: object defaultName: defaultName prefix: prefix suffix: ''
+]
+
+{ #category : 'as yet unclassified' }
+PPCIdGenerator >> idFor: object defaultName: defaultName prefix: prefix suffix: suffix [
+	^ idCache at: object ifAbsentPut: [ 
+		self generateIdFor: object defaultName: defaultName prefix: prefix suffix: suffix
+	]
+]
+
+{ #category : 'accessing' }
+PPCIdGenerator >> ids [
+	^ idCache keys
+]
+
+{ #category : 'initialization' }
+PPCIdGenerator >> initialize [
+	super initialize.
+	idCache := IdentityDictionary new.
+	numericIdCache := IdentityDictionary new.
+]
+
+{ #category : 'accessing' }
+PPCIdGenerator >> numericIdCache [
+	^ numericIdCache
+]
+
+{ #category : 'as yet unclassified' }
+PPCIdGenerator >> numericIdFor: object [
+	self assert: object isSymbol.
+	^ numericIdCache at: object ifAbsentPut: [ 
+		numericIdCache at: object put: (numericIdCache size) + 1
+	]
+]
+
+{ #category : 'accessing' }
+PPCIdGenerator >> numericIds [
+	^ numericIdCache keys
+]
diff --git a/software/petitcompiler/PPCInlinedMethod.class.st b/software/petitcompiler/PPCInlinedMethod.class.st
new file mode 100644
index 0000000..6f6f6dc
--- /dev/null
+++ b/software/petitcompiler/PPCInlinedMethod.class.st
@@ -0,0 +1,61 @@
+Class {
+	#name : 'PPCInlinedMethod',
+	#superclass : 'PPCMethod',
+	#category : 'PetitCompiler-Compiler-Codegen'
+}
+
+{ #category : 'code generation - variables' }
+PPCInlinedMethod >> allocateReturnVariable [
+	self error: 'return variable must be assigned by the non-inlined method....'
+
+   "Created: / 23-04-2015 / 21:06:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation - variables' }
+PPCInlinedMethod >> allocateReturnVariableNamed: name [
+	self error: 'return variable must be assigned by the non-inlined method....'
+
+	"Created: / 15-06-2015 / 17:52:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation - variables' }
+PPCInlinedMethod >> allocateTemporaryVariableNamed:aString [
+	self error: 'sorry, I can''t allocate variables....'
+
+   "Created: / 23-04-2015 / 21:06:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'accessing' }
+PPCInlinedMethod >> bridge [
+	self error: 'Cannot bridge to the inlined method!'.
+	^ super bridge
+]
+
+{ #category : 'as yet unclassified' }
+PPCInlinedMethod >> call [
+	^ self source
+
+	"Modified: / 24-07-2015 / 19:45:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'as yet unclassified' }
+PPCInlinedMethod >> callOn: receiver [
+	self error: 'are you sure you want to inline code from different receiver? If so, remove me!'.
+	^ self code
+]
+
+{ #category : 'as yet unclassified' }
+PPCInlinedMethod >> isInline [
+	^ true
+]
+
+{ #category : 'as yet unclassified' }
+PPCInlinedMethod >> source [
+	^ source isString ifTrue:[ 
+		source
+	] ifFalse:[ 
+		(String streamContents:[:s | source sourceOn:s ]) trimRight
+	].
+
+	"Created: / 24-07-2015 / 19:46:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
diff --git a/software/petitcompiler/PPCInliningVisitor.class.st b/software/petitcompiler/PPCInliningVisitor.class.st
new file mode 100644
index 0000000..2dc65b9
--- /dev/null
+++ b/software/petitcompiler/PPCInliningVisitor.class.st
@@ -0,0 +1,223 @@
+"
+I mark nodes for inlining
+"
+Class {
+	#name : 'PPCInliningVisitor',
+	#superclass : 'PPCPassVisitor',
+	#instVars : [
+		'acceptedNodes'
+	],
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'hooks' }
+PPCInliningVisitor >> beforeAccept: node [
+	acceptedNodes := acceptedNodes + 1.
+	super beforeAccept: node
+]
+
+{ #category : 'testing' }
+PPCInliningVisitor >> canInline [
+	^ acceptedNodes > 1
+]
+
+{ #category : 'initialization' }
+PPCInliningVisitor >> initialize [
+	super initialize.        
+	acceptedNodes := 0
+
+	"Modified (format): / 29-08-2015 / 07:40:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> markForInline: node [
+	self canInline ifTrue: [ 
+		node markForInline.
+	].
+	^ node
+]
+
+{ #category : 'hooks' }
+PPCInliningVisitor >> openDetected: node [
+	"
+		if someone is referring to the inlined node than we have a problem with cycle.
+		Only non inlined nodes may start the cycle.
+	"
+	node unmarkForInline.
+	^ super openDetected: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitActionNode: node [
+	"Only mark unnamed sequence nodes for inlining.
+	 Named nodes should not be inlined as they should make a method.
+	 There's little point in inlining non-sequence nodes, so don't
+	 enforce inlining on those. Some (JK :-) may prefer them non-inlined
+	 (for debugging purposes)"
+
+	self flag: 'JV: how is this supposed to work? Can you turn inlinin on and off?'.
+	(node child isSequenceNode and:[node child name isNil]) 
+		ifTrue: [ node child markForInline ].
+
+	^ super visitActionNode: node.
+
+	"Created: / 13-05-2015 / 16:25:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 31-07-2015 / 08:20:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitAndNode: node [
+	^ super visitAndNode: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitAnyNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitCharSetPredicateNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitCharacterNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitColumnNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitIslandNode: node [
+	super visitIslandNode: node.
+	
+	"island node children cannot be inlined, because they are referred from a PPCBridge"
+	node children do: [ :child |
+		| forward |
+		child isMarkedForInline ifTrue: [ 
+			forward := PPCForwardNode new
+				child: child;
+				yourself.
+			node replace: child with: forward. 
+		]
+	].
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitLiteralNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitMessagePredicateNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitNilNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitNotCharSetPredicateNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitNotLiteralNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitNotMessagePredicateNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitPluggableNode: node [
+	"Sadly, on Smalltalk/X blocks cannot be inlined because
+	 the VM does not provide enough information to map
+	 it back to source code. Very bad indeed!"
+	((Smalltalk respondsTo:#isSmalltalkX) and:[ Smalltalk isSmalltalkX ]) ifFalse:[
+						self markForInline: node
+	].
+	^ super visitPluggableNode: node.
+
+	"Modified: / 23-04-2015 / 12:15:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitStarCharSetPredicateNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitStarMessagePredicateNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitTokenConsumeNode: node [
+	"super visitTokenConsumeNode: node."
+
+"	node name isNil ifTrue: [ 
+		self markForInline: node
+	]."
+	self markForInline: node.
+	
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitTokenStarCharSetPredicateNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitTokenStarMessagePredicateNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitTokenStarSeparatorNode: node [
+	^ self markForInline: node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitTokenWhitespaceNode: node [
+	super visitTokenWhitespaceNode: node.
+	self markForInline: node.
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitTokenizingParserNode: node [
+	"skip tokens"
+	"skip whitespace"
+	"self visit: node whitespace."
+
+	self visit: node parser.
+	
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCInliningVisitor >> visitUnknownNode: node [
+	super visitUnknownNode: node.
+	
+	"unknown node children cannot be inlined, because they are referred from a PPCBridge"
+	node children do: [ :child |
+		| forward |
+		child isMarkedForInline ifTrue: [ 
+			forward := PPCForwardNode new
+				child: child;
+				yourself.
+			node replace: child with: forward. 
+		]
+	].
+	^ node
+]
diff --git a/software/petitcompiler/PPCLL1ChoiceVisitor.class.st b/software/petitcompiler/PPCLL1ChoiceVisitor.class.st
new file mode 100644
index 0000000..ed7d416
--- /dev/null
+++ b/software/petitcompiler/PPCLL1ChoiceVisitor.class.st
@@ -0,0 +1,41 @@
+Class {
+	#name : 'PPCLL1ChoiceVisitor',
+	#superclass : 'PPCRewritingVisitor',
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'as yet unclassified' }
+PPCLL1ChoiceVisitor >> visitChoiceNode: node [
+	| bag |
+	super visitChoiceNode: node.
+	
+	node firstFsa hasDistinctRetvals ifFalse: [ 
+		^ node
+	].
+
+	bag := IdentityBag new.
+	node children do: [ :child |
+		bag addAll: child firstSetWithTokens.
+	].
+
+	(bag size == bag asIdentitySet size) ifFalse: [  
+		"some of the tokens are shared between choices"
+		^ node
+	].
+
+	^ PPCLL1ChoiceNode new
+		children: node children;
+		name: node name;
+		properties: node properties;
+		yourself. 
+]
+
+{ #category : 'as yet unclassified' }
+PPCLL1ChoiceVisitor >> visitTokenNode: node [
+	^ node
+]
+
+{ #category : 'as yet unclassified' }
+PPCLL1ChoiceVisitor >> visitTrimmingTokenNode: node [
+	^ node
+]
diff --git a/software/petitcompiler/PPCMergingVisitor.class.st b/software/petitcompiler/PPCMergingVisitor.class.st
new file mode 100644
index 0000000..d892900
--- /dev/null
+++ b/software/petitcompiler/PPCMergingVisitor.class.st
@@ -0,0 +1,84 @@
+"
+As I traverste the graph, I find equivalent nodes and I merge the equivalent nodes under the single one.
+
+This saves compiler time, number of instance variables needed and makes compiled class more compact.
+
+I am using `node:equals:` because of performance (I do cache allNodes) which took too much time to constantly compute...
+"
+Class {
+	#name : 'PPCMergingVisitor',
+	#superclass : 'PPCRewritingVisitor',
+	#instVars : [
+		'nodeSet',
+		'childrenCache'
+	],
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'children cache' }
+PPCMergingVisitor >> cachedChildren: node [
+	^ childrenCache at: node ifAbsentPut: [ 
+		node dfsOrder
+	]
+]
+
+{ #category : 'node comparison' }
+PPCMergingVisitor >> equivalentNode: node [
+	self halt: 'not used?'.
+	^  nodeSet detect: [ :e | self node: e equals: node ]
+]
+
+{ #category : 'node comparison' }
+PPCMergingVisitor >> equivalentNode: node ifNone: block [
+	^  nodeSet detect: [ :e | self node: e equals: node ] ifNone: block
+]
+
+{ #category : 'node comparison' }
+PPCMergingVisitor >> hasEquivalentNode: node [
+	^ nodeSet contains: [ :e | self node: e equals: node ]
+]
+
+{ #category : 'initialization' }
+PPCMergingVisitor >> initialize [
+	super initialize.
+	
+	"Though this is IdentitySet, I do assert node:equals: befoere inserting node into the set"
+	nodeSet := IdentitySet new.
+	childrenCache := IdentityDictionary new.
+]
+
+{ #category : 'node comparison' }
+PPCMergingVisitor >> node: node equals: anotherNode [
+	| children anotherChildren |
+	(node equals: anotherNode) ifFalse: [ ^ false ].
+
+	children := self cachedChildren: node.
+	anotherChildren := self cachedChildren: anotherNode.
+	
+	(children size = anotherChildren size) ifFalse: [ ^ false ].
+	
+	children with: anotherChildren do: [ :n1 :n2 | 
+		(n1 equals: n2) ifFalse: [ ^ false ] 
+	].
+	^ true
+]
+
+{ #category : 'node comparison' }
+PPCMergingVisitor >> store: node [
+	self assert: (self hasEquivalentNode: node) not.
+	nodeSet add: node
+]
+
+{ #category : 'traversing' }
+PPCMergingVisitor >> visitNode: node [
+	| equivalent |
+	"merge the conntent of the node"
+	super visitNode: node.
+
+	(equivalent := self equivalentNode: node ifNone: nil ) isNil ifFalse: [
+		self cache: node value: equivalent.
+		^ equivalent
+	].
+	self store: node.
+	^ node
+]
diff --git a/software/petitcompiler/PPCMethod.class.st b/software/petitcompiler/PPCMethod.class.st
new file mode 100644
index 0000000..3179370
--- /dev/null
+++ b/software/petitcompiler/PPCMethod.class.st
@@ -0,0 +1,280 @@
+Class {
+	#name : 'PPCMethod',
+	#superclass : 'Object',
+	#instVars : [
+		'selector',
+		'source',
+		'category',
+		'variableForReturn'
+	],
+	#category : 'PetitCompiler-Compiler-Codegen'
+}
+
+{ #category : 'as yet unclassified' }
+PPCMethod class >> new [
+	"return an initialized instance"
+
+	^ self basicNew initialize.
+]
+
+{ #category : 'as yet unclassified' }
+PPCMethod >> add: string [
+	source add: string
+
+	"Modified: / 01-06-2015 / 21:09:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'as yet unclassified' }
+PPCMethod >> addOnLine: string [
+	source addOnLine: string
+
+	"Modified: / 01-06-2015 / 21:09:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation - variables' }
+PPCMethod >> allocateReturnVariable [
+	
+		^ variableForReturn isNil ifTrue:[ 
+				variableForReturn := self allocateTemporaryVariableNamed: 'retval'  
+		] ifFalse:[ 
+				variableForReturn
+		].
+
+	"Created: / 23-04-2015 / 18:03:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation - variables' }
+PPCMethod >> allocateReturnVariableNamed: name [    
+	"Allocate temporary variable used for storing a parser's return value (the parsed object)"
+
+	variableForReturn notNil ifTrue:[ 
+		self error: 'Return variable already allocated!'.
+		^ self.
+	]. 
+	variableForReturn := self allocateTemporaryVariableNamed: name.
+	^ variableForReturn
+
+	"Created: / 15-06-2015 / 17:52:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation - variables' }
+PPCMethod >> allocateTemporaryVariableNamed:preferredName [ 
+	"Allocate a new variable with (preferably) given name.
+	 Returns a real variable name that should be used."
+
+	^ source allocateTemporaryVariableNamed: preferredName
+
+	"Created: / 23-04-2015 / 17:37:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 01-06-2015 / 21:04:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'accessing' }
+PPCMethod >> bridge [
+	^ PPCBridge on: self methodName.
+]
+
+{ #category : 'as yet unclassified' }
+PPCMethod >> call [
+	^ 'self ', self methodName, '.'.
+]
+
+{ #category : 'as yet unclassified' }
+PPCMethod >> callOn: receiver [
+	^ receiver, ' ', self methodName.
+]
+
+{ #category : 'accessing' }
+PPCMethod >> category [
+	^ category isNil 
+		ifTrue: [ category := 'generated' ]
+		ifFalse: [ category ]
+						  
+]
+
+{ #category : 'accessing' }
+PPCMethod >> category: value [
+	category := value
+]
+
+{ #category : 'accessing' }
+PPCMethod >> code [
+	^ String streamContents: [ :s |
+		s nextPutAll: self methodName; cr.
+		source codeOn: s.    
+	]
+
+	"Modified: / 01-06-2015 / 21:24:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation' }
+PPCMethod >> code: aStringOrBlockOrRBParseNode [
+	source code: aStringOrBlockOrRBParseNode.
+
+	"Created: / 01-06-2015 / 22:31:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified (format): / 01-06-2015 / 23:50:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation' }
+PPCMethod >> codeBlock: contents [
+	| outerBlock innerBlock |
+
+	outerBlock := source.
+	innerBlock := PPCCodeBlock new.
+	innerBlock indentationLevel: outerBlock indentationLevel + 1.  
+	[ 
+		outerBlock addOnLine: '['.
+		source := innerBlock.
+		self codeOnLine: contents.
+	] ensure:[
+		outerBlock 
+			codeOnLine: (String streamContents:[:s | innerBlock sourceOn:s]);
+			add: ']'.
+		source := outerBlock.
+	]
+
+	"Created: / 01-06-2015 / 22:33:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 03-06-2015 / 06:11:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation' }
+PPCMethod >> codeOnLine: aStringOrBlockOrRBParseNode [
+	source codeOnLine: aStringOrBlockOrRBParseNode.
+
+	"Created: / 01-06-2015 / 22:31:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified (format): / 01-06-2015 / 23:50:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation - indenting' }
+PPCMethod >> dedent [
+	source dedent
+
+	"Created: / 01-06-2015 / 21:32:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'accessing' }
+PPCMethod >> id: value [
+	selector := value
+]
+
+{ #category : 'code generation - indenting' }
+PPCMethod >> indent [
+	source indent
+
+	"Created: / 01-06-2015 / 21:32:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'accessing' }
+PPCMethod >> indentationLevel [
+	^ source indentationLevel
+
+	"Created: / 01-06-2015 / 21:38:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'accessing' }
+PPCMethod >> indentationLevel: anInteger [
+	source indentationLevel: anInteger
+
+	"Created: / 01-06-2015 / 21:38:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'initialization' }
+PPCMethod >> initialize [
+	source := PPCCodeBlock new.
+
+	"Modified: / 01-06-2015 / 21:33:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'testing' }
+PPCMethod >> isInline [
+	^ false
+]
+
+{ #category : 'testing' }
+PPCMethod >> isMethod [
+	^ true
+]
+
+{ #category : 'accessing' }
+PPCMethod >> methodName [
+	^ selector
+]
+
+{ #category : 'code generation - indenting' }
+PPCMethod >> nl [
+
+	source nl
+
+	"Created: / 01-06-2015 / 21:52:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'printing' }
+PPCMethod >> printOn:aStream [
+	"append a printed representation if the receiver to the argument, aStream"
+
+	super printOn:aStream.
+	aStream nextPutAll:' id: '.
+	selector printOn:aStream.
+
+	"Modified: / 23-04-2015 / 12:32:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'as yet unclassified' }
+PPCMethod >> profilingBegin [
+	self profile ifTrue: [ 
+ 																^ '  context methodInvoked: #', selector, '.'	
+	].
+	^ ''
+]
+
+{ #category : 'as yet unclassified' }
+PPCMethod >> profilingEnd [
+	self profile ifTrue: [ 
+ 																^ '  context methodFinished: #', selector, '.'	
+	].
+	^ ''
+]
+
+{ #category : 'code generation - variables' }
+PPCMethod >> returnVariable [    
+	^ variableForReturn
+
+	"Created: / 23-04-2015 / 20:50:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified (format): / 15-06-2015 / 18:12:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'code generation - variables' }
+PPCMethod >> returnVariable: aString [
+	(variableForReturn notNil and:[variableForReturn ~= aString]) ifTrue:[ 
+		 self error: 'Return variable already allocated with different name (''', variableForReturn , ''' vs ''', aString,''')'.
+	].
+	variableForReturn := aString
+
+	"Created: / 23-04-2015 / 18:23:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+	"Modified: / 15-06-2015 / 18:14:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'accessing' }
+PPCMethod >> selector [
+	^ selector
+]
+
+{ #category : 'accessing' }
+PPCMethod >> source [
+	^ source isString ifTrue:[ 
+		source
+	] ifFalse:[ 
+		String streamContents: [ :s |
+			s nextPutAll: self methodName; cr.
+			source sourceOn:s.    
+		]
+	].
+
+	"Created: / 24-07-2015 / 19:46:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'accessing' }
+PPCMethod >> source: aString [
+	source := aString
+
+	"Created: / 24-07-2015 / 19:48:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
diff --git a/software/petitcompiler/PPCNilVisitor.class.st b/software/petitcompiler/PPCNilVisitor.class.st
new file mode 100644
index 0000000..bd1f476
--- /dev/null
+++ b/software/petitcompiler/PPCNilVisitor.class.st
@@ -0,0 +1,42 @@
+"
+I do literally nothing, just visiting :)
+
+Be carefull, I do not keep the close set, only open set, so that it might take time for me to go through all the possible paths in a graph.
+"
+Class {
+	#name : 'PPCNilVisitor',
+	#superclass : 'PPCNodeVisitor',
+	#instVars : [
+		'visitCount'
+	],
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'as yet unclassified' }
+PPCNilVisitor >> afterAccept: node retval: retval [
+	"do not cache the result"
+	^ retval
+]
+
+{ #category : 'as yet unclassified' }
+PPCNilVisitor >> initialize [
+	super initialize.
+	
+	visitCount := 0.
+]
+
+{ #category : 'accessing' }
+PPCNilVisitor >> visitCount [
+	^ visitCount
+]
+
+{ #category : 'accessing' }
+PPCNilVisitor >> visitCount: anObject [
+	visitCount := anObject
+]
+
+{ #category : 'as yet unclassified' }
+PPCNilVisitor >> visitNode: node [
+	visitCount := visitCount + 1.
+	^ super visitNode: node
+]
diff --git a/software/petitcompiler/PPCNodeVisitor.class.st b/software/petitcompiler/PPCNodeVisitor.class.st
new file mode 100644
index 0000000..7b80f2a
--- /dev/null
+++ b/software/petitcompiler/PPCNodeVisitor.class.st
@@ -0,0 +1,438 @@
+"
+Default Node Visitor. I am DFS visitor, I do traverse by default all the children of a node from left to right. This is implemented in visitNode: visitChildren: methods. On the other hand, my subclasses are more than free to redesign this traversing strategy.
+
+I have some cool features as well:
+
+1) I do keep the close set. After I visit node, I cache the return value and later I can detect cached value and return it without visiting the node again.
+
+2) I do keep open set. So I can detect cycles. I do even fire a message openDetected in order to allow my children to react to this.
+
+3) I do keep forbidden set. This set say, that these nodes are not allowed to be visited. This might get sometimes handy to detect some unwanted structures
+"
+Class {
+	#name : 'PPCNodeVisitor',
+	#superclass : 'Object',
+	#instVars : [
+		'openSet',
+		'closeSet',
+		'cache',
+		'forbiddenSet'
+	],
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'instance creation' }
+PPCNodeVisitor class >> new [
+	^ self basicNew initialize
+]
+
+{ #category : 'hooks' }
+PPCNodeVisitor >> afterAccept: node retval: retval [
+	self cache: node value: retval.
+	^ retval
+]
+
+{ #category : 'hooks' }
+PPCNodeVisitor >> beforeAccept: node [
+	"nothing to do"
+	(forbiddenSet includes: node) ifTrue: [ self error: 'visiting forbidden node!' ]
+]
+
+{ #category : 'traversing - caching' }
+PPCNodeVisitor >> cache: node value: retval [
+	self cache: node value: retval ifPresent: [ :e | self error: 'already cached' ]
+]
+
+{ #category : 'traversing - caching' }
+PPCNodeVisitor >> cache: node value: retval ifPresent: block [
+	(cache includesKey: node) ifTrue: [ block value: (self cachedValue: node) ].
+	
+	cache at: node put: retval
+]
+
+{ #category : 'hooks' }
+PPCNodeVisitor >> cachedDetected: node [
+	^ self cachedValue: node
+]
+
+{ #category : 'traversing - caching' }
+PPCNodeVisitor >> cachedValue: node [
+	^ cache at: node
+]
+
+{ #category : 'traversing' }
+PPCNodeVisitor >> close: node [
+	| last |
+	self assert: (self isOpen: node) description: 'should be opened first!'.
+	openSet size > 500 ifTrue: [ self error: 'This seems to be a bit too much, isnt it?' ].
+		
+	last := openSet removeLast.
+	self assert: last == node.
+	closeSet add: node
+]
+
+{ #category : 'hooks' }
+PPCNodeVisitor >> closedDetected: node [
+	^ #closed
+]
+
+{ #category : 'accessing' }
+PPCNodeVisitor >> forbiddenSet [
+	^ forbiddenSet
+]
+
+{ #category : 'accessing' }
+PPCNodeVisitor >> forbiddenSet: anObject [
+	forbiddenSet := anObject
+]
+
+{ #category : 'initialization' }
+PPCNodeVisitor >> initialize [
+	super initialize.
+	openSet := OrderedCollection new.
+	closeSet := IdentitySet new.	
+	cache := IdentityDictionary new.
+	forbiddenSet := IdentitySet new.
+]
+
+{ #category : 'traversing - caching' }
+PPCNodeVisitor >> isCached: node [
+	^ cache includesKey: node
+]
+
+{ #category : 'traversing' }
+PPCNodeVisitor >> isClosed: child [
+	^ closeSet includes: child
+]
+
+{ #category : 'traversing' }
+PPCNodeVisitor >> isOpen: child [
+	^ openSet contains: [ :e | e == child ]
+]
+
+{ #category : 'traversing' }
+PPCNodeVisitor >> open: node [
+	self assert: (self isOpen: node) not description: 'already opened!'.
+	openSet size > 200 ifTrue: [ self error: 'This seems to be a bit too much, isnt it?' ].
+	openSet addLast: node
+]
+
+{ #category : 'hooks' }
+PPCNodeVisitor >> openDetected: node [
+	^ #open
+]
+
+{ #category : 'traversing' }
+PPCNodeVisitor >> visit: node [
+	| retval |
+	(self isOpen: node) ifTrue: [ 
+		^ self openDetected: node
+	].
+
+	(self isCached: node) ifTrue: [ 
+		^ self cachedDetected: node.
+	].
+
+	(self isClosed: node) ifTrue: [ 
+		self closedDetected: node
+	].
+
+	self open: node.
+	self beforeAccept: node.
+	retval := node accept: self.
+	retval := self afterAccept: node retval: retval.
+	self close: node.
+	
+	^ retval
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitActionNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitAlignOLNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitAndNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitAnyNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitCharSetPredicateNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitCharacterNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'traversing' }
+PPCNodeVisitor >> visitChildren: node [
+	node children do: [ :child | 
+		self visit: child
+	]
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitChoiceNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitColumnNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitDeterministicChoiceNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitEndOfFileNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitEndOfInputNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitFailingNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitForwardNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitIslandNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitLL1ChoiceNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitLiteralNode: node [
+	"default implementation"
+	^ self visitNode: node.
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitMappedActionNode: node [
+	^ self visitActionNode: node
+
+	"Created: / 02-06-2015 / 17:28:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitMessagePredicateNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitNilNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'traversing' }
+PPCNodeVisitor >> visitNode: node [
+	self visitChildren: node.
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitNonEmptyNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitNotCharSetPredicateNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitNotCharacterNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitNotLiteralNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitNotMessagePredicateNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitNotNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitOptionalNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitPluggableNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitPlusMessagePredicateNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitPlusNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitPopNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitPredicateNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitPushNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitRecognizingSequenceNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitSequenceNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitStarAnyNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitStarCharSetPredicateNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitStarMessagePredicateNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitStarNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitSymbolActionNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenActionNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenChoiceNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenConsumeNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenOLNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenPlusMessagePredicateNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenPlusNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenStarCharSetPredicateNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenStarMessagePredicateNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenStarSeparatorNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenWhitespaceNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTokenizingParserNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTrimNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTrimmingTokenCharacterNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitTrimmingTokenNode: node [
+	^ self visitNode: node
+]
+
+{ #category : 'visiting' }
+PPCNodeVisitor >> visitUnknownNode: node [
+	^ self visitNode: node
+]
diff --git a/software/petitcompiler/PPCPassVisitor.class.st b/software/petitcompiler/PPCPassVisitor.class.st
new file mode 100644
index 0000000..f32ed68
--- /dev/null
+++ b/software/petitcompiler/PPCPassVisitor.class.st
@@ -0,0 +1,78 @@
+Class {
+	#name : 'PPCPassVisitor',
+	#superclass : 'PPCNodeVisitor',
+	#instVars : [
+		'context'
+	],
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'converting' }
+PPCPassVisitor class >> asPPCPass [
+	^ self new
+
+	"Created: / 29-08-2015 / 07:12:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'converting' }
+PPCPassVisitor >> asPPCPass [
+	^ self
+
+	"Created: / 29-08-2015 / 07:13:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'accessing' }
+PPCPassVisitor >> context [
+	^ context
+]
+
+{ #category : 'accessing' }
+PPCPassVisitor >> context: aPPCCompilationContext [
+	context := aPPCCompilationContext.
+
+	"Created: / 26-08-2015 / 22:05:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'history' }
+PPCPassVisitor >> copyPassResult: result [
+	^ result transform: [ :e | e copy ]
+]
+
+{ #category : 'history' }
+PPCPassVisitor >> passName [
+	^ self class name
+]
+
+{ #category : 'history' }
+PPCPassVisitor >> rememberResult: result to: history [
+	| key value |
+	key := self passName.
+	value := self copyPassResult: result.
+	
+	history add: key -> value
+]
+
+{ #category : 'running' }
+PPCPassVisitor >> run: ir [
+	"Actually run the pass on given IR (tree of PPCNode) and return
+	 (possibly transformed or completely new) another IR."
+
+	context isNil ifTrue:[ 
+		PPCCompilationError new signal: 'oops, no context set, use #context: before running a pass!'.
+	].
+	^ self visit: ir.
+
+	"Created: / 26-08-2015 / 22:30:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'running' }
+PPCPassVisitor >> run: ir in: ctx [
+	"Actually run the pass on given IR (tree of PPCNode) in given
+	 compilation context and return (possibly transformed or completely 
+	 new) another IR."
+
+	context := ctx.
+	^ self run: ir.
+
+	"Created: / 26-08-2015 / 22:33:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
diff --git a/software/petitcompiler/PPCPrintVisitor.class.st b/software/petitcompiler/PPCPrintVisitor.class.st
new file mode 100644
index 0000000..9c2e5f6
--- /dev/null
+++ b/software/petitcompiler/PPCPrintVisitor.class.st
@@ -0,0 +1,50 @@
+"
+I do print  whatever I visit
+"
+Class {
+	#name : 'PPCPrintVisitor',
+	#superclass : 'PPCNodeVisitor',
+	#instVars : [
+		'indent'
+	],
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'printing' }
+PPCPrintVisitor >> dedent [
+	indent := indent - 1
+]
+
+{ #category : 'printing' }
+PPCPrintVisitor >> indent [
+	^ indent := indent + 1
+]
+
+{ #category : 'initialization' }
+PPCPrintVisitor >> initialize [
+	super initialize.
+	
+	indent := 0.
+]
+
+{ #category : 'printing' }
+PPCPrintVisitor >> show: string [
+	indent timesRepeat: [ 
+		Transcript show: '    '.
+	].
+
+	Transcript 
+		show: string;
+		cr.
+
+]
+
+{ #category : 'visiting' }
+PPCPrintVisitor >> visitNode: node [
+	| retval |
+	self show: node asString.
+	self indent.
+	retval := super visitNode: node.
+	self dedent.
+	^ retval
+]
diff --git a/software/petitcompiler/PPCProfilingContext.class.st b/software/petitcompiler/PPCProfilingContext.class.st
new file mode 100644
index 0000000..9cd2f0c
--- /dev/null
+++ b/software/petitcompiler/PPCProfilingContext.class.st
@@ -0,0 +1,384 @@
+Class {
+	#name : 'PPCProfilingContext',
+	#superclass : 'PPCContext',
+	#instVars : [
+		'totalSize',
+		'selectors',
+		'positions',
+		'events',
+		'colors',
+		'fPositions',
+		'fEvents',
+		'lastStreamIndex',
+		'fSelectors'
+	],
+	#category : 'PetitCompiler-Context'
+}
+
+{ #category : 'converting' }
+PPCProfilingContext >> asEventMorph [
+	^ self asEventMorph: events asIdentitySet asArray
+]
+
+{ #category : 'converting' }
+PPCProfilingContext >> asEventMorph: eventArray [
+	|   width height canvas morph |
+	
+	fPositions := OrderedCollection new.
+	fEvents := OrderedCollection new.
+	fSelectors := OrderedCollection new.
+	"for the last stream only"
+	
+	((lastStreamIndex + 1) to: events size) do: [ :index | | e |
+		e := events at: index.
+		(eventArray includes: e) ifTrue: [
+			fPositions addLast: (self positions at: index).
+			fSelectors addLast: (self selectors at: index).
+			fEvents addLast: e.
+		]
+	].
+	
+	
+	width  := self stream size + 1 min: 4096.
+	height := fPositions size min: 32768.
+	canvas := FormCanvas extent: width @ height.
+	
+	self contents keysAndValuesDo: [ :index :char |
+		char isSeparator 
+			ifFalse: [ canvas line: index @ 1 to: index @ height color: Color paleYellow lighter ] 	].
+			
+			
+	1 to: height do: [ :index |
+			canvas form 
+				colorAt: (fPositions at: index) @ index 
+				put: (self colorForEvent: (fEvents at: index)) ].
+	morph := canvas form asMorph.
+	
+	morph on: #mouseMove
+		send: #mouseDown:with:
+		to: self.
+	^ morph
+]
+
+{ #category : 'converting' }
+PPCProfilingContext >> asFrequencyTable [
+	| bag total result |
+	bag := selectors asBag.
+	result := OrderedCollection new.
+	bag isEmpty ifTrue: [ ^ result ].
+	total := 100.0 / bag size.
+	bag sortedCounts 
+		do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ].
+	^ result
+]
+
+{ #category : 'converting' }
+PPCProfilingContext >> asFrequencyTableForEvent: event [
+	| bag total result filtered |
+	
+	filtered := OrderedCollection new.
+	events with: selectors do: [ :e :selector | 
+		event == e ifTrue: [ filtered add: selector ]
+	].
+	
+	bag := filtered asBag.
+	result := OrderedCollection new.
+	bag isEmpty ifTrue: [ ^ result ].
+	total := 100.0 / bag size.
+	bag sortedCounts 
+		do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ].
+	^ result
+]
+
+{ #category : 'converting' }
+PPCProfilingContext >> asReportTable [
+	^{ 
+		#'lwBacktrack per character' -> (self lwRestoreCount / (totalSize + 1.0)).
+		#'backtrack per character' -> (self restoreCount / (totalSize + 1.0)).
+		#'total stream size' -> totalSize .
+		#'lwRemember count' -> self lwRememberCount.
+		#'lwRestore count' -> self lwRestoreCount.
+		#'remember count' -> self rememberCount.
+		#'restore count' -> self restoreCount.
+		#'token read count' -> self tokenReadCount.
+		#'islands invoked' -> (self countFor: #islandInvoke).
+		#'islands memoized' -> (self countFor: #islandMemoized).
+		#'islands memo hits' -> (self countFor: #islandMemoHit).
+	}
+]
+
+{ #category : 'converting' }
+PPCProfilingContext >> colorForEvent: event [
+	| eventSet |
+	colors isNil ifTrue: [ 
+		eventSet := events asIdentitySet asArray.
+		colors := RTMultiLinearColorForIdentity new objects: eventSet.
+	].
+	^ colors 	rtValue: event
+]
+
+{ #category : 'reporting' }
+PPCProfilingContext >> countFor: event [
+	^ (events select: [ :e | e == event ]) size
+]
+
+{ #category : 'private' }
+PPCProfilingContext >> event: value [
+	positions addLast: self position.
+	selectors addLast: self selector.
+	events addLast: value.
+]
+
+{ #category : 'accessing' }
+PPCProfilingContext >> events [
+	^ events
+]
+
+{ #category : 'gt' }
+PPCProfilingContext >> eventsIn: composite [
+	<gtInspectorPresentationOrder: 30>
+	composite morph 
+		title: 'Parsing Events';
+		display: [:result :sample :stream :parser  | 
+			| morph |
+			morph := ScrollPane new.
+			morph color: Color white.
+			morph scroller addMorph: self asEventMorph.
+			morph ]
+]
+
+{ #category : 'gt' }
+PPCProfilingContext >> gtReport: composite [
+	<gtInspectorPresentationOrder: 40>
+	composite table 
+		title: 'Report';
+		column: 'Info' evaluated: [ :each | each key printString ];
+		column: 'Value' evaluated: [ :each | each value printString ];
+		display: [:context | context asReportTable ].
+]
+
+{ #category : 'initialization' }
+PPCProfilingContext >> initialize [
+	super initialize.
+	self reset.
+]
+
+{ #category : 'reporting' }
+PPCProfilingContext >> invocationCount [
+	^  self countFor: #methodInvoked
+]
+
+{ #category : 'accessing' }
+PPCProfilingContext >> invokedMethods [
+	| methods |
+	methods := OrderedCollection new.
+	events withIndexDo: [ :event :index | 
+		(event == #methodInvoked) ifTrue: [ 
+			methods add: (selectors at: index)
+		]
+	].
+	^ methods
+]
+
+{ #category : 'gt' }
+PPCProfilingContext >> islandEventsIn: composite [
+	<gtInspectorPresentationOrder: 30>
+	composite morph 
+		title: 'Island Events';
+		display: [:result :sample :context :parser  | 
+			| morph |
+			morph := ScrollPane new.
+			morph color: Color white.
+			morph scroller addMorph: 
+				(self asEventMorph: #(#islandInvoke #islandMemoHit #islandMemoized #waterToken)).
+			morph ]
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> islandInvoke [
+ 	self event: #islandInvoke
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> islandMemoHit [
+	self event: #islandMemoHit
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> islandMemoized [
+	self event: #islandMemoized
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> lwRemember [
+	self event: #lwRemember.
+	^ super lwRemember
+]
+
+{ #category : 'reporting' }
+PPCProfilingContext >> lwRememberCount [
+	^ (events asBag select: [ :e | e == #lwRemember ]) size
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> lwRestore: whatever [
+	self event: #lwRestore.
+	^ super lwRestore: whatever.
+]
+
+{ #category : 'reporting' }
+PPCProfilingContext >> lwRestoreCount [
+	^ (events asBag select: [ :e | e == #lwRestore ]) size
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> methodFinished: selector [
+	"Nothing to do for now"
+	self event: #methodFinished.
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> methodInvoked: selector [
+	self event: #methodInvoked
+]
+
+{ #category : 'converting' }
+PPCProfilingContext >> mouseDown: anEvent with: aMorph [
+	| location event |
+	location := anEvent position.
+	(location  y < fEvents size and: [ location y > 0 ]) ifTrue: [ 
+		event := fEvents at: location y.
+		Transcript cr; show: event; show: ': '; show: (fSelectors at: location y).
+	]
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> next [
+	self event: #step.
+	^ super next
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> next: number [
+	self event: #step.
+	^ super next: number
+]
+
+{ #category : 'accessing' }
+PPCProfilingContext >> position: value [
+	self assert: value isInteger.
+	super position: value
+]
+
+{ #category : 'accessing' }
+PPCProfilingContext >> positions [
+	^ positions
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> remember [
+	self event: #remember.
+	^ super remember
+]
+
+{ #category : 'reporting' }
+PPCProfilingContext >> rememberCount [
+	^ (events asBag select: [ :e | e == #remember ]) size
+]
+
+{ #category : 'gt' }
+PPCProfilingContext >> rememberTallyIn: composite [
+	<gtInspectorPresentationOrder: 34>
+
+	composite table 
+		title: 'Remember Tally';
+		column: 'Selector/Parser' evaluated: [ :each | each first printString ];
+		column: 'Count' evaluated: [ :each | each second printString ];
+		column: 'Percentage (%)' evaluated: [ :each | each third printString ];
+		display: [ self asFrequencyTableForEvent: #remember ];
+		noSelection;
+		showOnly: 50
+]
+
+{ #category : 'initialization' }
+PPCProfilingContext >> reset [
+	super reset.
+	
+	events := OrderedCollection new.
+	positions := OrderedCollection new.
+	selectors := OrderedCollection new.
+	colors := nil.
+	totalSize := 0.
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> restore: whatever [
+	self event: #restore.
+	^ super restore: whatever
+]
+
+{ #category : 'reporting' }
+PPCProfilingContext >> restoreCount [
+	^ (events asBag select: [ :e | e == #restore ]) size
+]
+
+{ #category : 'private' }
+PPCProfilingContext >> selector [
+	self flag: 'JK: this method needs review...'.
+	^ (thisContext findContextSuchThat: [ :ctxt | (ctxt receiver isKindOf: PPParser) or: [ ctxt receiver isKindOf: PPCDistinctScanner ] ])
+		ifNil: [ nil ]
+		ifNotNil: [ :aContext |
+			((aContext receiver isKindOf: PPCompiledParser) or: [aContext receiver isKindOf: PPCDistinctScanner]) ifTrue: [ 
+				aContext selector
+			] ifFalse: [ 
+				aContext receiver
+			]
+		].	
+
+]
+
+{ #category : 'accessing' }
+PPCProfilingContext >> selectors [
+	^ selectors
+]
+
+{ #category : 'accessing' }
+PPCProfilingContext >> stream: aStream [
+	totalSize := totalSize + aStream size.
+	lastStreamIndex := events size.
+	^ super stream: aStream
+]
+
+{ #category : 'gt' }
+PPCProfilingContext >> tallyIn: composite [
+	<gtInspectorPresentationOrder: 35>
+
+	composite table 
+		title: 'Global Tally';
+		column: 'Selector/Parser' evaluated: [ :each | each first printString ];
+		column: 'Count' evaluated: [ :each | each second printString ];
+		column: 'Percentage (%)' evaluated: [ :each | each third printString ];
+		display: [ self asFrequencyTable ];
+		noSelection;
+		showOnly: 50
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> tokenRead: tokenName [
+	self event: #tokenRead
+]
+
+{ #category : 'reporting' }
+PPCProfilingContext >> tokenReadCount [
+	^ self countFor: #tokenRead
+]
+
+{ #category : 'accessing' }
+PPCProfilingContext >> totalSize [
+	^ totalSize
+]
+
+{ #category : 'events' }
+PPCProfilingContext >> waterToken [
+	self event: #waterToken
+]
diff --git a/software/petitcompiler/PPCRecognizerComponentDetector.class.st b/software/petitcompiler/PPCRecognizerComponentDetector.class.st
new file mode 100644
index 0000000..2f10917
--- /dev/null
+++ b/software/petitcompiler/PPCRecognizerComponentDetector.class.st
@@ -0,0 +1,128 @@
+"
+I do traverse the tree and locate recognizer components. I do start PPCRecognizerComponentVisitor, when a recognizer component is detected. 
+
+Recognizer component is a subgraph, that does not return a value, just returns true/false of an recognition attempt, therefore the recognizer component nodes can be further optimized.
+
+
+"
+Class {
+	#name : 'PPCRecognizerComponentDetector',
+	#superclass : 'PPCRewritingVisitor',
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'visiting' }
+PPCRecognizerComponentDetector >> visitIslandNode: node [
+	| water newWater |
+
+	water := node water.
+	newWater := self visitWithRecognizingComponentVisitor: water.
+	self cache: water value: newWater ifPresent: [ :e | self assert: e == newWater ].
+
+	^ super visitIslandNode: node
+	
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentDetector >> visitNotNode: node [
+	"We don't need result of the not,..."
+	| child newChild |
+	
+	"
+		There might be some pretty complicated logic in the not not, 
+		for example
+		
+		'foo', 'bar' ==> [ :res | res isOK ] not
+		
+		If recognizing component dos not create arrays, res will be nill
+		and thus such a parse will be invalid
+	"
+	true ifTrue: [ ^ super visitNotNode: node ].
+	
+	child := node child.
+	newChild := self visitWithRecognizingComponentVisitor: child.
+	self cache: child value: newChild.
+	
+	^ super visitNotNode: node
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentDetector >> visitTokenConsumeNode: node [
+	"Let the scanner handle this stuff"
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentDetector >> visitTokenNode: node [
+	| child newChild |
+	
+	child := node child.
+	newChild := self visitWithRecognizingComponentVisitor: child.
+	self cache: child value: newChild ifPresent: [ :e | self assert: e == newChild ].	
+
+	^ super visitTokenNode: node
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentDetector >> visitTokenWhitespaceNode: node [
+	| child newChild |
+
+	child := node child.
+	newChild := self visitWithRecognizingComponentVisitor: child.
+	self cache: child value: newChild ifPresent: [ :e | self assert: e == newChild ].
+	
+	^ super visitTokenWhitespaceNode: node
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentDetector >> visitTokenizingParserNode: node [
+	|  |
+
+	"Do not visit whitespace, it is tokenizer's job"
+"	self change.
+	newWhitespace := self visitWithRecognizingComponentVisitor: node whitespace.
+	node replace: node whitespace with: newWhitespace.
+"
+
+	"Do not visit tokens, they will be handled by the scanner:"
+	"self visit: node tokens."
+	
+	self visitChild: node parser of: node.
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentDetector >> visitTrimmingTokenNode: node [
+	| child newChild whitespace newWhitespace |
+	
+	child := node child.
+	newChild := self visitWithRecognizingComponentVisitor: child.
+	self cache: child value: newChild ifPresent: [ :e | self assert: e == newChild ].
+
+	whitespace := node whitespace.
+	newWhitespace := self visitWithRecognizingComponentVisitor: whitespace.
+	self cache: whitespace value: newWhitespace ifPresent: [ :e | self assert: e == newWhitespace ].
+
+	
+	^ super visitTrimmingTokenNode: node
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentDetector >> visitWithRecognizingComponentVisitor: node [
+	| retval forbiddenNodes copyVisitor tokenVisitor copy |
+
+	(self isCached: node) ifTrue: [ 
+		^ self cachedValue: node
+	].
+	
+	copyVisitor := PPCCopyVisitor new.
+	tokenVisitor := PPCRecognizerComponentVisitor new.
+	
+	forbiddenNodes := openSet copy.
+	copyVisitor forbiddenSet: openSet copy.
+
+	copy := copyVisitor visit: node.
+	retval := tokenVisitor visit: copy.
+	^ retval
+
+]
diff --git a/software/petitcompiler/PPCRecognizerComponentVisitor.class.st b/software/petitcompiler/PPCRecognizerComponentVisitor.class.st
new file mode 100644
index 0000000..2903eb2
--- /dev/null
+++ b/software/petitcompiler/PPCRecognizerComponentVisitor.class.st
@@ -0,0 +1,104 @@
+"
+Creates a specialized recognizer nodes, that are faster.
+
+The parsers returns objects, e.g. AST as a result.
+Recognizer returns only True/False
+
+If I could, I would be a private class of PPCRecognizerComponentDetector.
+"
+Class {
+	#name : 'PPCRecognizerComponentVisitor',
+	#superclass : 'PPCRewritingVisitor',
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'initialization' }
+PPCRecognizerComponentVisitor >> initialize [
+	super initialize.
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentVisitor >> visitActionNode: node [
+	super visitActionNode: node.
+	^ node child
+
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentVisitor >> visitPlusMessagePredicateNode: node [
+	self visitChildren: node.
+	
+	^ PPCTokenPlusMessagePredicateNode new
+		name: node name;
+		message: node message;
+		child: node child;
+		yourself
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentVisitor >> visitPlusNode: node [
+	self visitChildren: node.
+	
+	^ PPCTokenPlusNode new
+		name: node name;
+		child: node child;
+		yourself
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentVisitor >> visitSequenceNode: node [
+	| newNode |
+	newNode := PPCRecognizingSequenceNode new
+		children: node children;
+		name: node name;
+		properties: node properties;
+		yourself.
+		
+	self cache: node value: newNode.
+	
+	^ super visitSequenceNode: newNode.
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentVisitor >> visitStarCharSetPredicateNode: node [
+	self visitChildren: node.
+	
+	^ PPCTokenStarCharSetPredicateNode new
+		name: node name;
+		predicate: node predicate;
+		child: node child;
+		yourself
+
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentVisitor >> visitStarMessagePredicateNode: node [
+	self visitChildren: node.
+	
+	(node message = #isSeparator) ifTrue: [ 
+		^ PPCTokenStarSeparatorNode new
+			name: node name;
+			child: node child;
+			message: node message;
+			yourself.
+	].
+	
+	^ PPCTokenStarMessagePredicateNode new
+		name: node name;
+		message: node message;
+		child: node child;
+		yourself
+
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentVisitor >> visitSymbolActionNode: node [
+	self visitChildren: node.
+	^ node child
+]
+
+{ #category : 'visiting' }
+PPCRecognizerComponentVisitor >> visitTokenNode: node [
+	self visitChildren: node.
+	^ node child
+]
diff --git a/software/petitcompiler/PPCRewritingVisitor.class.st b/software/petitcompiler/PPCRewritingVisitor.class.st
new file mode 100644
index 0000000..81b7fe3
--- /dev/null
+++ b/software/petitcompiler/PPCRewritingVisitor.class.st
@@ -0,0 +1,50 @@
+"
+I do support graph rewriting...
+
+And I should be able to work fine with cyclic structures as well and at the same time allow for customization of the traversal strategy. 
+
+While traversing cyclic structures (where node refers to itself later) the key point is to cache the new value for the node (or at least the stub of the new value) before visiting the children of the node.
+"
+Class {
+	#name : 'PPCRewritingVisitor',
+	#superclass : 'PPCPassVisitor',
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'as yet unclassified' }
+PPCRewritingVisitor >> afterAccept: node retval: retval [
+	self cache: node value: retval ifPresent: [ :e | "I am fine with it" ].
+	^ retval
+]
+
+{ #category : 'as yet unclassified' }
+PPCRewritingVisitor >> change [
+
+]
+
+{ #category : 'as yet unclassified' }
+PPCRewritingVisitor >> openDetected: node [
+	(self isCached: node) ifTrue: [ 
+		^ self cachedValue: node
+	].
+	^ node
+]
+
+{ #category : 'as yet unclassified' }
+PPCRewritingVisitor >> visitChild: child of: node [
+	| newChild |
+"	Halt if: [ node name = 'nullToken' ]."
+	newChild := self visit: child.
+
+	(newChild == child) ifFalse: [ 
+		node replace: child with: newChild.
+	].
+
+]
+
+{ #category : 'as yet unclassified' }
+PPCRewritingVisitor >> visitChildren: node [
+	node children do: [ :child | 
+		self visitChild: child of: node
+	]
+]
diff --git a/software/petitcompiler/PPCSpecializingVisitor.class.st b/software/petitcompiler/PPCSpecializingVisitor.class.st
new file mode 100644
index 0000000..1e9145b
--- /dev/null
+++ b/software/petitcompiler/PPCSpecializingVisitor.class.st
@@ -0,0 +1,270 @@
+"
+I do specialize some nodes, so that they can emit optimized code for them.
+
+e.g. #any star can be optimized to simple jump to the end of the input.
+"
+Class {
+	#name : 'PPCSpecializingVisitor',
+	#superclass : 'PPCRewritingVisitor',
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> rejectDuplicateChildren: node [
+	| seen newChildren |
+	seen := IdentitySet new.
+	newChildren := OrderedCollection new.
+	node children do: [ :child | 
+		(seen includes: child) ifFalse: [  
+			newChildren add: child
+		].
+		seen add: child
+	].
+	^ newChildren
+
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitActionNode: node [
+	(node block isSymbol) ifTrue: [ 
+		| newNode |
+		newNode := PPCSymbolActionNode new
+			block: node block;
+			name: node name;
+			child: node child;
+			properties: node properties copy;
+			yourself.
+			
+		^ super visitActionNode: newNode
+	].
+
+	^ super visitActionNode: node
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitChoiceNode: node [
+	self visitChildren: node.
+	
+	(node children size = 1) ifTrue: [ 
+		^ node "firstChild "
+			
+	].
+
+	"Remove the identical children"
+	"node children: 	(self rejectDuplicateChildren: node)."
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitForwardNode: node [
+	node name ifNil: [ 
+		self cache: node value: node child.
+		^ self visit: node child.
+	].
+
+	node child name ifNil: [  
+		node child name: node name.
+
+		self cache: node value: node child.
+		^ self visit: node child.
+	].
+
+	(node child name = node name) ifTrue: [ 
+		self cache: node value: node child.
+		^ self visit: node child.
+	].
+
+	^ super visitForwardNode: node
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitIslandNode: node [
+	(context options useContextFreeSeas and: [ node island isContextFree ]) ifTrue: [ 
+		node parser: node parser asLightweightMemoizingSea
+	].
+
+	^ super visitIslandNode: node
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitNonEmptyNode: node [
+	self visitChildren: node.
+
+	(node child alwaysConsumes) ifTrue: [ 
+		^ node child
+	].
+
+	^ node
+	
+	"Modified: / 23-04-2015 / 12:02:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitNotNode: node [
+	self visitChildren: node.
+
+	(node child isKindOf: PPCAbstractLiteralNode) ifTrue: [  
+		^ PPCNotLiteralNode new
+			name: node name;
+			literal: node child literal;
+			yourself
+	]. 
+
+	(node child isKindOf: PPCMessagePredicateNode) ifTrue: [  
+		^ PPCNotMessagePredicateNode new
+			name: node name;
+			predicate: node child predicate;
+			message: node child message;
+			yourself
+	].
+
+	(node child isKindOf: PPCCharSetPredicateNode) ifTrue: [  
+		^ PPCNotCharSetPredicateNode new
+			name: node name;
+			predicate: node child predicate;
+			yourself
+	].
+
+	(node child isKindOf: PPCCharacterNode) ifTrue: [  
+		^ PPCNotCharacterNode new
+			name: node name;
+			character: node child character;
+			yourself
+	].
+
+	^ node
+	
+	"Modified: / 23-04-2015 / 12:02:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitPlusNode: node [
+	self visitChildren: node.
+
+	(node child isKindOf: PPCMessagePredicateNode) ifTrue: [ 
+		^ PPCPlusMessagePredicateNode new
+			name: node name;
+			child: node child;
+			message: node child message;
+			yourself
+	].
+
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitPredicateNode: node [
+	| charSet |
+	
+	(node predicate class == PPCharSetPredicate) ifTrue: [ 
+		charSet := node predicate.
+	].
+	charSet := PPCharSetPredicate on: node predicate.
+
+
+	(charSet equals: (PPCharSetPredicate on: [ :char | char isLetter])) ifTrue: [ 
+		^ PPCMessagePredicateNode new
+			name: node name;
+			message: #isLetter;
+			predicate: node predicate;
+			yourself
+	].
+
+
+	(charSet equals: (PPCharSetPredicate on: [ :char | char isDigit])) ifTrue: [ 
+		^ PPCMessagePredicateNode new
+			name: node name;
+			message: #isDigit;
+			predicate: node predicate;
+			yourself
+	].
+
+	(charSet equals: (PPCharSetPredicate on: [ :char | char isAlphaNumeric])) ifTrue: [ 
+		^ PPCMessagePredicateNode new
+			name: node name;
+			message: #isAlphaNumeric;
+			predicate: node predicate;
+			yourself
+	].
+
+	(charSet equals: (PPCharSetPredicate on: [ :char | char isSeparator])) ifTrue: [ 
+		^ PPCMessagePredicateNode new
+			name: node name;
+			message: #isSeparator;
+			predicate: node predicate;
+			yourself
+	].
+
+	(charSet equals: (PPCharSetPredicate on: [ :char | true ])) ifTrue: [ 
+		^ PPCAnyNode new
+			name: node name;
+			yourself
+	].
+
+	^ PPCCharSetPredicateNode new
+		name: node name;
+		predicate: charSet;
+		yourself.
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitStarNode: node [
+	self visitChildren: node.
+
+	(node child isKindOf: PPCMessagePredicateNode) ifTrue: [ 
+		^ PPCStarMessagePredicateNode new
+			name: node name;
+			child: node child;
+			message: node child message;
+			yourself
+	].
+
+	(node child isKindOf: PPCAnyNode) ifTrue: [ 
+		^ PPCStarAnyNode new
+			name: node name;
+			child: node child;
+			yourself
+	]. 
+
+	(node child isKindOf: PPCCharSetPredicateNode) ifTrue: [ 
+		^ PPCStarCharSetPredicateNode new
+			name: node name;
+			predicate: node child predicate;
+			child: node child;
+			yourself
+	].
+
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitTokenConsumeNode: node [
+	"Let the Scanner to handle this stuff"
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitTokenizingParserNode: node [
+	self visitChild: node parser of: node.
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCSpecializingVisitor >> visitTrimmingTokenNode: node [
+
+	self visitChildren: node.
+
+	(node child isKindOf: PPCCharacterNode) ifTrue: [ 
+		^ PPCTrimmingCharacterTokenNode new
+			child: node child;               
+			whitespace: node whitespace;
+			tokenClass: node tokenClass;
+			character: node child character;
+			name: node name;
+			yourself
+	].
+
+	^ node
+
+	"Modified: / 21-05-2015 / 14:41:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
diff --git a/software/petitcompiler/PPCTokenDetector.class.st b/software/petitcompiler/PPCTokenDetector.class.st
new file mode 100644
index 0000000..94e29ae
--- /dev/null
+++ b/software/petitcompiler/PPCTokenDetector.class.st
@@ -0,0 +1,94 @@
+"
+I can find tokens and I start PPCTokenVisitor, when I see a token.
+"
+Class {
+	#name : 'PPCTokenDetector',
+	#superclass : 'PPCRewritingVisitor',
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'as yet unclassified' }
+PPCTokenDetector >> visitActionNode: node [	
+	(node isMarkedAsTrimmingToken) ifTrue: [ 
+		| newNode child whitespace |
+		child := self visitWithTokenVisitor: node child secondChild.
+		whitespace := self visitWithTokenVisitor: node child firstChild. 
+		
+		newNode := PPCTrimmingTokenNode new
+			name: node name;
+			child: child;
+			whitespace: whitespace;
+			tokenClass: node child secondChild tokenClass;
+			properties: node properties copy;
+			yourself.
+			
+		self cache: node value: newNode.
+		^ super visitActionNode: newNode	
+	].
+
+	^ super visitActionNode: node
+
+]
+
+{ #category : 'as yet unclassified' }
+PPCTokenDetector >> visitTokenNode: node [	
+	| child newChild |
+
+	child := node child.
+	
+	newChild := self visitWithTokenVisitor: node child.
+	self cache: node child value: newChild ifPresent: [ :e | self assert: newChild == e ].
+	
+	^ super visitTokenNode: node
+]
+
+{ #category : 'as yet unclassified' }
+PPCTokenDetector >> visitTokenOLNode: node [	
+	^ self visitTokenNode: node
+]
+
+{ #category : 'as yet unclassified' }
+PPCTokenDetector >> visitTrimNode: node [
+	(node child class = PPCTokenNode) ifTrue: [  
+		| newNode |
+		newNode := PPCTrimmingTokenNode new
+			name: node name;
+			child: node child child;
+			tokenClass: node child tokenClass;
+			whitespace: node trimmer;
+			parser: node parser;
+			yourself.
+		
+		self cache: node value: newNode.
+		^ super visitTrimNode: newNode.
+	]. 
+
+	^ super visitTrimNode: node
+
+
+]
+
+{ #category : 'as yet unclassified' }
+PPCTokenDetector >> visitWithTokenVisitor: node [
+	| copy retval forbiddenNodes copyVisitor tokenVisitor |
+	
+	"Do not modify the token structure"
+	(context options specialize) ifFalse: [ 
+		^ node
+	].
+	
+	(self isCached: node) ifTrue: [ 
+		^ self cachedValue: node
+	].
+	
+	copyVisitor := PPCCopyVisitor new.
+	tokenVisitor := PPCTokenVisitor new.
+	
+	forbiddenNodes := openSet copy.
+	copyVisitor forbiddenSet: openSet copy.
+
+	copy := copyVisitor visit: node.
+	retval := tokenVisitor visit: copy.
+	^ retval
+
+]
diff --git a/software/petitcompiler/PPCTokenVisitor.class.st b/software/petitcompiler/PPCTokenVisitor.class.st
new file mode 100644
index 0000000..1576f01
--- /dev/null
+++ b/software/petitcompiler/PPCTokenVisitor.class.st
@@ -0,0 +1,66 @@
+"
+I do updates in tokens. My goal is to remove tokens inside tokens. 
+
+If I could, I would be private class of PPCTokendDetector.
+"
+Class {
+	#name : 'PPCTokenVisitor',
+	#superclass : 'PPCRewritingVisitor',
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'traversing' }
+PPCTokenVisitor >> afterAccept: node retval: retval [
+	(retval name isNil not and: [ (retval name endsWith: '_ws') ]) ifTrue: [ 
+		| newRetval |
+		newRetval := PPCTokenWhitespaceNode new
+			child: retval;
+			yourself.
+		^ super afterAccept: node retval: newRetval.
+	].
+
+	^ super afterAccept: node retval: retval
+]
+
+{ #category : 'as yet unclassified' }
+PPCTokenVisitor >> visitActionNode: node [	
+
+	(node isMarkedAsTrimmingToken) ifTrue: [ 
+		| child newChild | 
+		"trimming token in token, remove it"
+		child := node child secondChild.
+		newChild := self visit: child.
+		
+		child name isNil ifTrue: [ 
+			newChild name: node name.
+			^ newChild.
+		].
+	
+		^ PPCForwardNode new
+			child: newChild;
+			name: node name;
+			yourself
+	].
+
+	"remove the action from token, they are not allowed there"
+	super visitActionNode: node.
+	^ node child
+]
+
+{ #category : 'as yet unclassified' }
+PPCTokenVisitor >> visitTokenNode: node [
+	"token in token, remove the token"
+	| newNode |
+	
+	node child name isNil ifTrue: [ 
+		node child name: node name.
+		^ super visit: node child
+	].
+
+	newNode := PPCForwardNode new
+		child: node child;
+		name: node name;
+		yourself.	
+	
+	^ super visit: newNode
+]
diff --git a/software/petitcompiler/PPCTokenizingCodeGen.class.st b/software/petitcompiler/PPCTokenizingCodeGen.class.st
new file mode 100644
index 0000000..03c2302
--- /dev/null
+++ b/software/petitcompiler/PPCTokenizingCodeGen.class.st
@@ -0,0 +1,43 @@
+"
+I am CodeGen suited for the needs of tokenizing code generator.
+"
+Class {
+	#name : 'PPCTokenizingCodeGen',
+	#superclass : 'PPCCodeGen',
+	#category : 'PetitCompiler-Compiler-Codegen'
+}
+
+{ #category : 'code generation' }
+PPCTokenizingCodeGen >> codeScannerRememberTo: variableName [ 
+	self codeAssign: 'scanner remember' to: variableName.
+	self codeDot.
+
+]
+
+{ #category : 'code generation' }
+PPCTokenizingCodeGen >> codeScannerRestoreFrom: variableName [ 
+	self code: 'scanner restore: ', variableName.
+	self codeDot.
+					
+
+]
+
+{ #category : 'initialization' }
+PPCTokenizingCodeGen >> initialize [
+	super initialize.
+]
+
+{ #category : 'code generation' }
+PPCTokenizingCodeGen >> remember: node to: variableName [ 
+	^ self codeScannerRememberTo: variableName
+]
+
+{ #category : 'code generation' }
+PPCTokenizingCodeGen >> restore: node from: mementoName [
+	^ self codeScannerRestoreFrom: mementoName
+]
+
+{ #category : 'code generation' }
+PPCTokenizingCodeGen >> restoreSequence: node child: child from: mementoName [
+	^ self restore: node from: mementoName
+]
diff --git a/software/petitcompiler/PPCTokenizingVisitor.class.st b/software/petitcompiler/PPCTokenizingVisitor.class.st
new file mode 100644
index 0000000..d99155a
--- /dev/null
+++ b/software/petitcompiler/PPCTokenizingVisitor.class.st
@@ -0,0 +1,127 @@
+"
+I am capable of creating PPCTokenizingParserNode.
+
+This is a node that 
+- has all all the tokens collected, 
+- identifies the whitespace 
+- replaces all the token reads with token consume
+"
+Class {
+	#name : 'PPCTokenizingVisitor',
+	#superclass : 'PPCRewritingVisitor',
+	#instVars : [
+		'tokens'
+	],
+	#category : 'PetitCompiler-Visitors'
+}
+
+{ #category : 'tokens' }
+PPCTokenizingVisitor >> addToken: token [
+	(tokens contains: [:e | e = token] ) ifFalse: [ 
+		tokens addLast: token
+	]
+]
+
+{ #category : 'hooks' }
+PPCTokenizingVisitor >> afterAccept: node retval: retval [
+	| newRetval |
+	self isRoot ifTrue: [ 
+		| tokensNode whitespaceNode |
+
+		tokens do: [ :token | token unmarkForInline ].
+		whitespaceNode := tokens detect: [ :e | e isTrimmingTokenNode ] ifNone: [ nil ].
+		whitespaceNode notNil ifTrue: [ 
+				whitespaceNode := whitespaceNode whitespace copy
+					unmarkForInline;
+					name: 'consumeWhitespace';
+					yourself.
+				"whitespaceNode := PPCTokenWhitespaceNode new
+					child: whitespaceNode;
+					yourself"
+		] ifFalse: [ 
+				whitespaceNode := PPCNilNode new
+					name: 'consumeWhitespace';
+					yourself 
+		].
+		
+		tokensNode := PPCListNode new
+			children: tokens asArray;
+			name: 'nextToken';
+			yourself.
+			
+
+		 newRetval := PPCTokenizingParserNode new
+			parser: retval;
+			whitespace: whitespaceNode;
+			tokens: tokensNode;
+			name: (retval name isNil ifTrue: [ #mainParser ] ifFalse: [ retval name ]);
+			yourself 
+	] ifFalse: [ 
+		newRetval := retval
+	].
+
+	^ super afterAccept: node retval: newRetval
+	
+	"Modified: / 12-05-2015 / 01:37:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'hooks' }
+PPCTokenizingVisitor >> eofToken [
+	| ws  |
+	self error: 'deprecated?'.
+	ws := PPCStarNode new
+		child: (PPCMessagePredicateNode new
+			message: #isSeparator;
+			yourself);
+		yourself.
+	
+	^ PPCTrimmingTokenNode new
+		child: PPCEndOfFileNode new;
+		whitespace: ws;
+		tokenClass: PPToken;
+		name: 'eof';
+		yourself.
+]
+
+{ #category : 'initialization' }
+PPCTokenizingVisitor >> initialize [
+	super initialize.
+	tokens := OrderedCollection new.
+]
+
+{ #category : 'testing' }
+PPCTokenizingVisitor >> isRoot [
+	^ openSet size = 1
+]
+
+{ #category : 'visiting' }
+PPCTokenizingVisitor >> visitTokenConsumeNode: node [
+	"
+		Seems, it might happen, that if I create the consume node, 
+		I will ge to it later. This would create a token consume node for the
+		child, thus having tokenConsumNode with tokenConsumNode as a child...
+	"
+	^ node
+]
+
+{ #category : 'visiting' }
+PPCTokenizingVisitor >> visitTokenNode: node [
+	self addToken: node.
+	
+	self assert: node acceptsEpsilon not description: 'Sorry, but the epsilon tokens are not allowed'.
+	
+	^ PPCTokenConsumeNode new
+		child: node;
+		name: node name;
+		yourself.
+]
+
+{ #category : 'visiting' }
+PPCTokenizingVisitor >> visitTrimmingTokenNode: node [
+	self addToken: node.
+	
+	^ PPCTokenConsumeNode new
+		child: node;
+		name: node name;
+		yourself.
+]
diff --git a/software/petitcompiler/PPCUniversalCodeGen.class.st b/software/petitcompiler/PPCUniversalCodeGen.class.st
new file mode 100644
index 0000000..b40651b
--- /dev/null
+++ b/software/petitcompiler/PPCUniversalCodeGen.class.st
@@ -0,0 +1,97 @@
+"
+I am CodeGen suited for the needs of standard (universal) code generator.
+"
+Class {
+	#name : 'PPCUniversalCodeGen',
+	#superclass : 'PPCCodeGen',
+	#category : 'PetitCompiler-Compiler-Codegen'
+}
+
+{ #category : 'memoization' }
+PPCUniversalCodeGen >> remember: node to: variableName [ 
+	self memoizationStrategy remember: node to: variableName.
+	
+	"options analyzeContext ifFalse: [ 
+		self  codeAssign: 'context remember.'
+				to: variableName.			
+		^ self
+	].
+
+	(node changesContext) ifFalse: [ 
+		self 	codeAssign: 'context lwRemember.' 
+				to: variableName.
+	] ifTrue: [ 
+		node isIndentPush ifTrue: [ 
+			self 	codeAssign: 'context lwRemember.' 
+					to: variableName.
+		] ifFalse: [ 
+			(node isSequenceNode and: [node children allButLast noneSatisfy: [:e | e changesContext ]]) ifTrue: [ 
+				""it is only the last child that changes context...""
+				self 	codeAssign: 'context lwRemember.' 
+						to: variableName.
+			] ifFalse: [ 
+				self  codeAssign: 'context remember.'
+					to: variableName.			
+			].
+		]
+	]
+"
+]
+
+{ #category : 'memoization' }
+PPCUniversalCodeGen >> restore: node from: variableName [
+	^ self memoizationStrategy restore: node from: variableName.
+
+"	self flag: 'JK: refactor!'.
+	options analyzeContext ifFalse: [ 
+		self code: 'context restore: ', mementoName, '.'.
+		^ self
+	].
+
+	node changesContext ifFalse: [ 
+		self code: 'context lwRestore: ', mementoName, '.'.
+	] ifTrue: [ 
+		node isIndentPush ifTrue: [ 
+			self assert: node isSequenceNode not.
+			self code: 'context lwRestore: ', mementoName, '.'.
+			self code: 'context indentStack pop.'.
+		] ifFalse: [ 
+			self code: 'context restore: ', mementoName, '.'.
+		]
+	]
+"
+]
+
+{ #category : 'memoization' }
+PPCUniversalCodeGen >> restoreSequence: node child: child from: variableName [
+	self assert: node isSequenceNode.
+	self memoizationStrategy restoreSequenceNode: node child: child from: variableName
+	
+"
+	self flag: 'JK: refactor'.
+	options analyzeContext ifFalse: [ 
+		self code: 'context restore: ', mementoName, '.'.
+		^ self
+	].	
+	
+	node changesContext ifFalse: [ 
+		self restore: node from: mementoName
+	] ifTrue: [ 
+		node isIndentPush ifTrue: [ 
+			| push |
+			self code: 'context lwRestore: ', mementoName, '.'.
+			push := (node children detect: [:e | e isIndentPush]).
+			(node children indexOf: child) > (node children indexOf: push) ifTrue: [ 
+				self code: 'context indentStack pop.'.
+			]
+		] ifFalse: [ 
+			(node children allButLast noneSatisfy: [:e | e changesContext ]) ifTrue: [ 
+				""it is only the last child that changes context...""
+				self code: 'context lwRestore: ', mementoName, '.'.
+			] ifFalse: [ 
+				self restore: node from: mementoName
+			]
+		]
+	]
+"
+]
diff --git a/software/petitcompiler/PPCharSetPredicate.extension.st b/software/petitcompiler/PPCharSetPredicate.extension.st
new file mode 100644
index 0000000..6870fd9
--- /dev/null
+++ b/software/petitcompiler/PPCharSetPredicate.extension.st
@@ -0,0 +1,41 @@
+Extension { #name : 'PPCharSetPredicate' }
+
+{ #category : '*petitcompiler' }
+PPCharSetPredicate >> = anObject [
+	self == anObject ifTrue: [ ^ true ].
+	self class == anObject class ifFalse: [ ^ false ].
+	^ classification = anObject classification
+]
+
+{ #category : '*petitcompiler' }
+PPCharSetPredicate >> block [
+	^ block
+]
+
+{ #category : '*petitcompiler' }
+PPCharSetPredicate >> block: value [
+	block := value
+]
+
+{ #category : '*petitcompiler' }
+PPCharSetPredicate >> classification [
+	^ classification
+]
+
+{ #category : '*petitcompiler' }
+PPCharSetPredicate >> classification: value [
+	classification := value
+]
+
+{ #category : '*petitcompiler' }
+PPCharSetPredicate >> equals: anotherPredicate [
+	self == anotherPredicate ifTrue: [ ^ true ].
+	self class == anotherPredicate class ifFalse: [ ^ false ].
+	
+	^ classification  = anotherPredicate classification.
+]
+
+{ #category : '*petitcompiler' }
+PPCharSetPredicate >> hash [
+	^ classification hash
+]
diff --git a/software/petitcompiler/PPChoiceParser.extension.st b/software/petitcompiler/PPChoiceParser.extension.st
new file mode 100644
index 0000000..47a2373
--- /dev/null
+++ b/software/petitcompiler/PPChoiceParser.extension.st
@@ -0,0 +1,10 @@
+Extension { #name : 'PPChoiceParser' }
+
+{ #category : '*petitcompiler' }
+PPChoiceParser >> asCompilerNode [
+	^ PPCChoiceNode new
+		name: self name;
+		children: parsers;
+		parser: self;
+		yourself
+]
diff --git a/software/petitcompiler/PPCompositeParser.extension.st b/software/petitcompiler/PPCompositeParser.extension.st
new file mode 100644
index 0000000..645b355
--- /dev/null
+++ b/software/petitcompiler/PPCompositeParser.extension.st
@@ -0,0 +1,11 @@
+Extension { #name : 'PPCompositeParser' }
+
+{ #category : '*petitcompiler' }
+PPCompositeParser >> asCompilerNode [
+	^ PPCForwardNode new
+		name: (self name ifNil: [ #start ]);
+		child: parser;
+		yourself
+
+	"Modified: / 22-05-2015 / 21:54:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
diff --git a/software/petitcompiler/PPContext.extension.st b/software/petitcompiler/PPContext.extension.st
new file mode 100644
index 0000000..4f2547d
--- /dev/null
+++ b/software/petitcompiler/PPContext.extension.st
@@ -0,0 +1,94 @@
+Extension { #name : 'PPContext' }
+
+{ #category : '*petitcompiler' }
+PPContext >> asCompiledParserContext [
+	^ PPCContext new
+		stream: stream;
+		yourself
+		
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> atWs [
+	^ false
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> comment [
+	^ self globalAt: #comment ifAbsent: [ nil ].
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> comment: value [
+	^ self globalAt: #comment put: value
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> compiledParser [
+	^ self globalAt: #compiledParser
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> compiledParser: aPPParser [
+	^ self globalAt: #compiledParser put: aPPParser
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> lwRemember [
+	^ self position
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> lwRestore: position [
+	^ self position: position
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> methodFinished: whatever [
+	"nothing to do"
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> methodInvoked: whatever [
+	"nothing to do"
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> peek: anInteger [
+	^ stream peek: anInteger
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> setWs [
+	"nothing to do"
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> skipSeparators [
+	^ stream skipSeparators
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> tokenRead: whatever [
+	"nothing to do"
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> uncheckedBack [
+	^ stream uncheckedBack
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> uncheckedPosition: position [
+	^ stream uncheckedPosition: position
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> whitespace [
+	^ self globalAt: #whitespace ifAbsent: [ nil ].
+]
+
+{ #category : '*petitcompiler' }
+PPContext >> whitespace: value [
+	^ self globalAt: #whitespace put: value
+]
diff --git a/software/petitcompiler/PPDelegateParser.extension.st b/software/petitcompiler/PPDelegateParser.extension.st
new file mode 100644
index 0000000..9eea55f
--- /dev/null
+++ b/software/petitcompiler/PPDelegateParser.extension.st
@@ -0,0 +1,25 @@
+Extension { #name : 'PPDelegateParser' }
+
+{ #category : '*petitcompiler' }
+PPDelegateParser >> asCompilerNode [
+	self class == PPDelegateParser ifTrue: [ 
+		^ PPCForwardNode new
+			name: self name;
+			child: parser;
+			yourself
+	].
+	^ super asCompilerNode
+
+	"Modified: / 22-05-2015 / 21:53:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : '*petitcompiler' }
+PPDelegateParser >> firstCharSet [
+	^ parser firstCharSet 
+]
+
+{ #category : '*PetitCompiler-Analysis' }
+PPDelegateParser >> neverFails [
+	"TODO JK: I can do better here, should be implemented as the PPCNodes hierarchy"
+	^ false
+]
diff --git a/software/petitcompiler/PPEndOfFileParser.extension.st b/software/petitcompiler/PPEndOfFileParser.extension.st
new file mode 100644
index 0000000..0e04fc2
--- /dev/null
+++ b/software/petitcompiler/PPEndOfFileParser.extension.st
@@ -0,0 +1,8 @@
+Extension { #name : 'PPEndOfFileParser' }
+
+{ #category : '*petitcompiler' }
+PPEndOfFileParser >> asCompilerNode [
+	^ PPCEndOfFileNode new
+		name: self name;
+		yourself
+]
diff --git a/software/petitcompiler/PPEndOfInputParser.extension.st b/software/petitcompiler/PPEndOfInputParser.extension.st
new file mode 100644
index 0000000..c199c58
--- /dev/null
+++ b/software/petitcompiler/PPEndOfInputParser.extension.st
@@ -0,0 +1,10 @@
+Extension { #name : 'PPEndOfInputParser' }
+
+{ #category : '*petitcompiler' }
+PPEndOfInputParser >> asCompilerNode [
+	
+	^ PPCEndOfInputNode new
+		name: self name;
+		child: parser;
+		yourself	
+]
diff --git a/software/petitcompiler/PPEpsilonParser.extension.st b/software/petitcompiler/PPEpsilonParser.extension.st
new file mode 100644
index 0000000..ed3db31
--- /dev/null
+++ b/software/petitcompiler/PPEpsilonParser.extension.st
@@ -0,0 +1,8 @@
+Extension { #name : 'PPEpsilonParser' }
+
+{ #category : '*petitcompiler' }
+PPEpsilonParser >> asCompilerNode [
+	^ PPCNilNode new
+		name: self name;
+		yourself
+]
diff --git a/software/petitcompiler/PPFailingParser.extension.st b/software/petitcompiler/PPFailingParser.extension.st
new file mode 100644
index 0000000..93d0c9b
--- /dev/null
+++ b/software/petitcompiler/PPFailingParser.extension.st
@@ -0,0 +1,9 @@
+Extension { #name : 'PPFailingParser' }
+
+{ #category : '*petitcompiler' }
+PPFailingParser >> asCompilerNode [
+	^ PPCFailingNode new
+		name: self name;
+		message: self message;
+		yourself
+]
diff --git a/software/petitcompiler/PPFailure.extension.st b/software/petitcompiler/PPFailure.extension.st
new file mode 100644
index 0000000..808309a
--- /dev/null
+++ b/software/petitcompiler/PPFailure.extension.st
@@ -0,0 +1,16 @@
+Extension { #name : 'PPFailure' }
+
+{ #category : '*petitcompiler' }
+PPFailure >> context: aPPContext [
+	context := aPPContext
+]
+
+{ #category : '*petitcompiler' }
+PPFailure >> message: text [
+	message := text
+]
+
+{ #category : '*petitcompiler' }
+PPFailure >> position: anInteger [
+	position := anInteger
+]
diff --git a/software/petitcompiler/PPFlattenParser.extension.st b/software/petitcompiler/PPFlattenParser.extension.st
new file mode 100644
index 0000000..736d462
--- /dev/null
+++ b/software/petitcompiler/PPFlattenParser.extension.st
@@ -0,0 +1,15 @@
+Extension { #name : 'PPFlattenParser' }
+
+{ #category : '*petitcompiler' }
+PPFlattenParser >> changesContext [
+	^ self propertyAt: #changesContext ifAbsentPut: [ 
+		parser changesContext
+	]
+]
+
+{ #category : '*petitcompiler' }
+PPFlattenParser >> changesContextOpenSet: ctxEnv [
+	^ self propertyAt: #changesContext ifAbsentPut: [ 
+		parser changesContextOpenSet: ctxEnv
+	]
+]
diff --git a/software/petitcompiler/PPLiteralObjectParser.extension.st b/software/petitcompiler/PPLiteralObjectParser.extension.st
new file mode 100644
index 0000000..18cac4b
--- /dev/null
+++ b/software/petitcompiler/PPLiteralObjectParser.extension.st
@@ -0,0 +1,9 @@
+Extension { #name : 'PPLiteralObjectParser' }
+
+{ #category : '*petitcompiler' }
+PPLiteralObjectParser >> asCompilerNode [
+	^ PPCCharacterNode new
+		character: literal;
+		name: self name;
+		yourself
+]
diff --git a/software/petitcompiler/PPLiteralParser.extension.st b/software/petitcompiler/PPLiteralParser.extension.st
new file mode 100644
index 0000000..0201513
--- /dev/null
+++ b/software/petitcompiler/PPLiteralParser.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'PPLiteralParser' }
+
+{ #category : '*petitcompiler' }
+PPLiteralParser >> id [
+	^ literal printString
+]
diff --git a/software/petitcompiler/PPLiteralSequenceParser.extension.st b/software/petitcompiler/PPLiteralSequenceParser.extension.st
new file mode 100644
index 0000000..f3fe0fe
--- /dev/null
+++ b/software/petitcompiler/PPLiteralSequenceParser.extension.st
@@ -0,0 +1,9 @@
+Extension { #name : 'PPLiteralSequenceParser' }
+
+{ #category : '*petitcompiler' }
+PPLiteralSequenceParser >> asCompilerNode [
+	^ PPCLiteralNode new
+		literal: literal;
+		name: self name;
+		yourself
+]
diff --git a/software/petitcompiler/PPMappedActionParser.class.st b/software/petitcompiler/PPMappedActionParser.class.st
new file mode 100644
index 0000000..a8fdd86
--- /dev/null
+++ b/software/petitcompiler/PPMappedActionParser.class.st
@@ -0,0 +1,28 @@
+Class {
+	#name : 'PPMappedActionParser',
+	#superclass : 'PPActionParser',
+	#category : 'PetitCompiler-Parsers'
+}
+
+{ #category : 'converting' }
+PPMappedActionParser >> asCompilerNode [
+	^ PPCMappedActionNode new
+		name: self name;
+		block: block;
+		child: parser;
+		properties: properties;
+		parser: self;
+		yourself
+
+	"Created: / 02-06-2015 / 17:27:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : 'parsing' }
+PPMappedActionParser >> parseOn: aPPContext [
+	| element |
+	^ (element := parser parseOn: aPPContext) isPetitFailure
+			ifFalse: [ block valueWithArguments: element ]
+			ifTrue: [ element ]
+
+	"Created: / 02-06-2015 / 17:15:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
diff --git a/software/petitcompiler/PPMemoizingSea.extension.st b/software/petitcompiler/PPMemoizingSea.extension.st
new file mode 100644
index 0000000..7742f63
--- /dev/null
+++ b/software/petitcompiler/PPMemoizingSea.extension.st
@@ -0,0 +1,12 @@
+Extension { #name : 'PPMemoizingSea' }
+
+{ #category : '*petitcompiler' }
+PPMemoizingSea >> asLightweightMemoizingSea [
+	^ PPLwMemoizingSea new
+		island: island;
+		setBeforeWaterParser: defaultBeforeWaterParser;
+		setAfterWaterParser: defaultAfterWaterParser;
+		water: water;
+		properties: properties copy;
+		yourself
+]
diff --git a/software/petitcompiler/PPNonEmptyParser.extension.st b/software/petitcompiler/PPNonEmptyParser.extension.st
new file mode 100644
index 0000000..766005b
--- /dev/null
+++ b/software/petitcompiler/PPNonEmptyParser.extension.st
@@ -0,0 +1,9 @@
+Extension { #name : 'PPNonEmptyParser' }
+
+{ #category : '*petitcompiler' }
+PPNonEmptyParser >> asCompilerNode [
+	^ PPCNonEmptyNode new
+		name: self name;
+		child: parser;
+		yourself
+]
diff --git a/software/petitcompiler/PPNotParser.extension.st b/software/petitcompiler/PPNotParser.extension.st
new file mode 100644
index 0000000..9f417c7
--- /dev/null
+++ b/software/petitcompiler/PPNotParser.extension.st
@@ -0,0 +1,9 @@
+Extension { #name : 'PPNotParser' }
+
+{ #category : '*petitcompiler' }
+PPNotParser >> asCompilerNode [
+	^ PPCNotNode new 
+		child: parser;
+		name: self name;
+		yourself
+]
diff --git a/software/petitcompiler/PPOptionalParser.extension.st b/software/petitcompiler/PPOptionalParser.extension.st
new file mode 100644
index 0000000..fb5373d
--- /dev/null
+++ b/software/petitcompiler/PPOptionalParser.extension.st
@@ -0,0 +1,11 @@
+Extension { #name : 'PPOptionalParser' }
+
+{ #category : '*petitcompiler' }
+PPOptionalParser >> asCompilerNode [
+	^ PPCOptionalNode new
+		name: self name;
+		child: parser;
+		yourself
+
+"	^ super asCompilerNode "
+]
diff --git a/software/petitcompiler/PPParser.extension.st b/software/petitcompiler/PPParser.extension.st
new file mode 100644
index 0000000..89393cb
--- /dev/null
+++ b/software/petitcompiler/PPParser.extension.st
@@ -0,0 +1,195 @@
+Extension { #name : 'PPParser' }
+
+{ #category : '*petitcompiler' }
+PPParser >> allNodesDo: aBlock seen: aSet [
+	"Iterate over all the parse nodes of the receiver, do not visit and follow the ones contained in aSet."
+
+	(aSet includes: self) ifTrue: [ ^ self ].
+	aSet add: self.
+	aBlock value: self.
+	
+	self children do: [ :each | 
+		each allNodesDo: aBlock seen: aSet 
+	]
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> asCompilerNode [
+	^ PPCUnknownNode new
+		parser: self;
+		name: self name;
+		properties: self properties copy;
+		yourself
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> asCompilerTree [
+	^ self transform: [ :p | p asCompilerNode  ]
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> bridge [
+	^ self
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> changesContext [
+	"
+		by default true.
+		When overriding be carefull to give the priority to the property value
+	"
+	^ self propertyAt: #changesContext ifAbsentPut: [ 
+		true
+	]
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> changesContext: value [
+	self propertyAt: #changesContext put: value.
+	^ self
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> changesContextOpenSet: ctxEnv [
+	self changesContextSet ifTrue: [ ^ self changesContext ].
+	(ctxEnv changes includes: self) ifTrue: [ ^ self changesContext: false ].
+	ctxEnv changes add: self.
+	
+	^ self changesContext
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> changesContextSet [
+	^ self hasProperty: #changesContext
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> compile [
+	^ self compileWithOptions: PPCCompilationOptions new
+
+	"Modified: / 07-09-2015 / 10:54:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> compileTokenizing [
+	| options |
+	options := PPCCompilationOptions new
+		tokenize: true;
+		yourself.
+	^ self compileWithOptions: options
+
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> compileWithOptions: options [
+	"Compile receiver with given options. Return 
+	 an *instance* of the compiler parser which is 
+	 ready to use (repeatedly). 
+
+	 `options` may be either an instance of PPCCompilationOptions
+	 or an array specifying options like #( tokenizing: true debug: false )
+	" 
+	| compiler |
+
+	compiler := PPCCompiler new.
+	compiler options: options.
+	^compiler compile: self
+
+	"Created: / 07-09-2015 / 10:52:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> firstSetSuchThat: block into: aCollection openSet: aSet [
+	(aSet includes: self) ifTrue: [ ^ aCollection ].
+	aSet add: self.
+	
+	(block value: self) ifTrue: [aCollection add: self. ^ aCollection ].
+	self children do: [ :child | 
+		child firstSetSuchThat: block into: aCollection openSet: aSet 
+	].
+	^ aCollection
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> id [
+	self name ifNotNil: [ ^ self name ].
+	^ self hash asString
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> indentPop: value [
+	self propertyAt: #indentPop put: value.
+	^ self
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> indentPush: value [
+	self propertyAt: #indentPush put: value.
+	^ self
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> isCompiled [
+	^ false
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> isContextFree [
+	^ self propertyAt: #isContextFree ifAbsentPut: 
+		[ self allParsers allSatisfy: [ :p | p isContextFreePrim ] ].
+	
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> isContextFreePrim [
+	^ true
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> isContextSensitive [
+	^ self isContextFree not
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> isToken [
+	^ false
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> isTokenParser [
+	^ false
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> javaToken [
+	| ws |
+	ws := PPJavaWhitespaceParser new.
+	^ ((ws, ((PPTokenParser on: self) tokenClass: PPJavaToken; yourself), ws) ==> #second)
+		propertyAt: #'trimmingToken' put: true;
+		yourself
+	.
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> optimize [
+	^ self copy
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> optimized [
+	^ self copy
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> properties: whatever [
+	properties := whatever
+]
+
+{ #category : '*petitcompiler' }
+PPParser >> trimmingToken [
+	| ws |
+	ws := #space asParser star.
+	^ ((ws, (PPTokenParser on: self), ws) ==> #second)
+		propertyAt: #trimmingToken put: true;
+		yourself
+]
diff --git a/software/petitcompiler/PPPluggableParser.extension.st b/software/petitcompiler/PPPluggableParser.extension.st
new file mode 100644
index 0000000..8e7fe53
--- /dev/null
+++ b/software/petitcompiler/PPPluggableParser.extension.st
@@ -0,0 +1,15 @@
+Extension { #name : 'PPPluggableParser' }
+
+{ #category : '*petitcompiler' }
+PPPluggableParser >> asCompilerNode [
+	^ PPCPluggableNode new
+		block: block;
+		name: self name;
+		properties: properties;
+		yourself
+]
+
+{ #category : '*petitcompiler' }
+PPPluggableParser >> isContextFreePrim [
+	^ false
+]
diff --git a/software/petitcompiler/PPPossessiveRepeatingParser.extension.st b/software/petitcompiler/PPPossessiveRepeatingParser.extension.st
new file mode 100644
index 0000000..815e059
--- /dev/null
+++ b/software/petitcompiler/PPPossessiveRepeatingParser.extension.st
@@ -0,0 +1,21 @@
+Extension { #name : 'PPPossessiveRepeatingParser' }
+
+{ #category : '*petitcompiler' }
+PPPossessiveRepeatingParser >> asCompilerNode [
+	((self min = 0) and: [ self max = SmallInteger maxVal ]) ifTrue: [
+		^ PPCStarNode new
+			name: self name;
+			child: parser;
+			parser: self;
+			yourself
+	].
+
+	((self min = 1) and: [ self max = SmallInteger maxVal ]) ifTrue: [
+		^ PPCPlusNode new
+			name: self name;
+			child: parser;
+			parser: self;
+			yourself
+	].
+	^ super asCompilerNode
+]
diff --git a/software/petitcompiler/PPPredicateObjectParser.extension.st b/software/petitcompiler/PPPredicateObjectParser.extension.st
new file mode 100644
index 0000000..f7ec9d3
--- /dev/null
+++ b/software/petitcompiler/PPPredicateObjectParser.extension.st
@@ -0,0 +1,19 @@
+Extension { #name : 'PPPredicateObjectParser' }
+
+{ #category : '*petitcompiler' }
+PPPredicateObjectParser >> asCompilerNode [
+	^ PPCPredicateNode new
+		name: self name;
+		predicate: predicate;
+		yourself
+]
+
+{ #category : '*petitcompiler' }
+PPPredicateObjectParser >> firstCharSet [
+	^ predicate
+]
+
+{ #category : '*petitcompiler' }
+PPPredicateObjectParser >> firstCharSetCached [
+	^ predicate
+]
diff --git a/software/petitcompiler/PPPreviousParser.extension.st b/software/petitcompiler/PPPreviousParser.extension.st
new file mode 100644
index 0000000..906e2c2
--- /dev/null
+++ b/software/petitcompiler/PPPreviousParser.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'PPPreviousParser' }
+
+{ #category : '*petitcompiler' }
+PPPreviousParser >> changesContext [
+	^ false
+]
diff --git a/software/petitcompiler/PPProfilingContext.class.st b/software/petitcompiler/PPProfilingContext.class.st
new file mode 100644
index 0000000..b524aa4
--- /dev/null
+++ b/software/petitcompiler/PPProfilingContext.class.st
@@ -0,0 +1,285 @@
+Class {
+	#name : 'PPProfilingContext',
+	#superclass : 'PPContext',
+	#instVars : [
+		'invocations',
+		'totalSize',
+		'positions',
+		'parsers',
+		'events',
+		'fEvents',
+		'fPositions',
+		'fParsers',
+		'colors',
+		'lastStreamIndex'
+	],
+	#category : 'PetitCompiler-Context'
+}
+
+{ #category : 'converting' }
+PPProfilingContext >> asEventMorph [
+	^ self asEventMorph: events asIdentitySet asArray
+]
+
+{ #category : 'converting' }
+PPProfilingContext >> asEventMorph: eventArray [
+	|   width height canvas morph |
+	
+	fPositions := OrderedCollection new.
+	fEvents := OrderedCollection new.
+	fParsers := OrderedCollection new.
+	"for the last stream only"
+	
+	((lastStreamIndex + 1) to: events size) do: [ :index | | e |
+		e := events at: index.
+		(eventArray includes: e) ifTrue: [
+			fPositions addLast: (self positions at: index).
+			fParsers addLast: (self parsers at: index).
+			fEvents addLast: e.
+		]
+	].
+	
+	
+	width  := self stream size + 1 min: 4096.
+	height := fPositions size min: 32768.
+	canvas := FormCanvas extent: width @ height.
+	
+	self contents keysAndValuesDo: [ :index :char |
+		char isSeparator 
+			ifFalse: [ canvas line: index @ 1 to: index @ height color: Color paleYellow lighter ] 	].
+			
+			
+	1 to: height do: [ :index |
+			canvas form 
+				colorAt: (fPositions at: index) @ index 
+				put: (self colorForEvent: (fEvents at: index)) ].
+	morph := canvas form asMorph.
+	
+	morph on: #mouseMove
+		send: #mouseDown:with:
+		to: self.
+	^ morph
+]
+
+{ #category : 'converting' }
+PPProfilingContext >> asFrequencyTable [
+	| bag total result |
+	bag := parsers asBag.
+	result := OrderedCollection new.
+	bag isEmpty ifTrue: [ ^ result ].
+	total := 100.0 / bag size.
+	bag sortedCounts 
+		do: [ :each | result addLast: (Array with: each value with: each key with: total * each key) ].
+	^ result
+]
+
+{ #category : 'converting' }
+PPProfilingContext >> asReportTable [
+	^ { 
+		#'backtrack per character' -> (self restoreCount / (self totalSize + 1.0)).
+		#'total stream size' -> self streamSize.
+		#'remember count' -> self rememberCount.
+		#'restore count' -> self restoreCount.	
+	}
+]
+
+{ #category : 'converting' }
+PPProfilingContext >> colorForEvent: event [
+	| eventSet |
+	colors isNil ifTrue: [ 
+		eventSet := events asIdentitySet asArray.
+		colors := RTMultiLinearColorForIdentity new objects: eventSet.
+	].
+	^ colors 	rtValue: event
+
+"	event == #islandInvoke ifTrue: [ ^ Color purple lighter ].
+	event == #islandMemoized ifTrue: [ ^ Color red lighter ].
+	event == #islandMemoHit ifTrue: [ ^ Color green darker ].
+	event == #waterToken ifTrue: [ ^ Color blue ].
+	event == #remember ifTrue: [ ^ Color green ].
+	event == #restore ifTrue: [ ^ Color red ].
+	^ Color yellow."
+]
+
+{ #category : 'reporting' }
+PPProfilingContext >> countFor: event [
+	^ (events asBag select: [ :e | e == event ]) size
+]
+
+{ #category : 'private' }
+PPProfilingContext >> event: value [
+	positions addLast: self position.
+	parsers addLast: self parser.
+	events addLast: value.
+]
+
+{ #category : 'accessing' }
+PPProfilingContext >> events [
+	^ events
+]
+
+{ #category : 'gt' }
+PPProfilingContext >> eventsIn: composite [
+	<gtInspectorPresentationOrder: 30>
+	composite morph 
+		title: 'Parsing Events';
+		display: [:result :sample :context :parser  | 
+			| morph |
+			morph := ScrollPane new.
+			morph color: Color white.
+			morph scroller addMorph: self asEventMorph.
+			morph ]
+]
+
+{ #category : 'gt' }
+PPProfilingContext >> gtReport: composite [
+	<gtInspectorPresentationOrder: 40>
+	composite table 
+		title: 'Report';
+		column: 'Info' evaluated: [ :each | each key printString ];
+		column: 'Value' evaluated: [ :each | each value printString ];
+		display: [:context | context asReportTable ].
+]
+
+{ #category : 'initialization' }
+PPProfilingContext >> initialize [
+	super initialize.
+	
+	events := OrderedCollection new.
+	positions := OrderedCollection new.
+	parsers := OrderedCollection new.
+	colors := nil.
+	totalSize := 0.
+]
+
+{ #category : 'gt' }
+PPProfilingContext >> islandEventsIn: composite [
+	<gtInspectorPresentationOrder: 30>
+	composite morph 
+		title: 'Island Events';
+		display: [:result :sample :context :parser  | 
+			| morph |
+			morph := ScrollPane new.
+			morph color: Color white.
+			morph scroller addMorph: 
+				(self asEventMorph: #(#islandInvoke #islandMemoHit #islandMemoized #waterToken)).
+			morph ]
+]
+
+{ #category : 'events' }
+PPProfilingContext >> islandInvoke [
+	self event: #islandInvoke
+]
+
+{ #category : 'events' }
+PPProfilingContext >> islandMemoHit [
+	self event: #islandMemoHit
+]
+
+{ #category : 'events' }
+PPProfilingContext >> islandMemoized [
+	self event: #islandMemoized
+]
+
+{ #category : 'converting' }
+PPProfilingContext >> mouseDown: anEvent with: aMorph [
+	| location event |
+	location := anEvent position.
+	(location  y < fEvents size and: [ location y > 0 ]) ifTrue: [ 
+		event := fEvents at: location y.
+		Transcript cr; show: event; show: ': '; show: (fParsers at: location y).
+	]
+]
+
+{ #category : 'events' }
+PPProfilingContext >> next [
+	self event: #step.
+	^ super next
+]
+
+{ #category : 'events' }
+PPProfilingContext >> next: number [
+	self event: #step.
+	^ super next: number
+]
+
+{ #category : 'private' }
+PPProfilingContext >> parser [
+	^ (thisContext findContextSuchThat: [ :ctxt | ctxt receiver isKindOf: PPParser ])
+		ifNil: [ nil ]
+		ifNotNil: [ :aContext | aContext receiver ].
+]
+
+{ #category : 'accessing' }
+PPProfilingContext >> parsers [
+	^ parsers
+]
+
+{ #category : 'accessing' }
+PPProfilingContext >> positions [
+	^ positions
+]
+
+{ #category : 'events' }
+PPProfilingContext >> remember [
+	self event: #remember.
+	^ super remember
+]
+
+{ #category : 'reporting' }
+PPProfilingContext >> rememberCount [
+	^ (events asBag select: [ :e | e == #remember ]) size
+]
+
+{ #category : 'initialization' }
+PPProfilingContext >> reset [
+	super reset
+
+]
+
+{ #category : 'events' }
+PPProfilingContext >> restore: whatever [
+	self event: #restore.
+	^ super restore: whatever
+]
+
+{ #category : 'reporting' }
+PPProfilingContext >> restoreCount [
+	^ (events asBag select: [ :e | e == #restore ]) size
+]
+
+{ #category : 'accessing' }
+PPProfilingContext >> stream: aStream [
+	totalSize := totalSize + aStream size.
+	lastStreamIndex := events size.
+	^ super stream: aStream
+]
+
+{ #category : 'accessing' }
+PPProfilingContext >> streamSize [
+	^ stream size
+]
+
+{ #category : 'gt' }
+PPProfilingContext >> tallyIn: composite [
+	<gtInspectorPresentationOrder: 30>
+
+	composite table 
+		title: 'Tally';
+		column: 'Parser' evaluated: [ :each | each first displayName ];
+		column: 'Count' evaluated: [ :each | each second printString ];
+		column: 'Percentage (%)' evaluated: [ :each | each third printString ];
+		display: [ self asFrequencyTable ];
+		noSelection;
+		showOnly: 50
+]
+
+{ #category : 'accessing' }
+PPProfilingContext >> totalSize [
+	^ totalSize 
+]
+
+{ #category : 'events' }
+PPProfilingContext >> waterToken [
+	self event: #waterToken
+]
diff --git a/software/petitcompiler/PPSea.extension.st b/software/petitcompiler/PPSea.extension.st
new file mode 100644
index 0000000..6dddc4a
--- /dev/null
+++ b/software/petitcompiler/PPSea.extension.st
@@ -0,0 +1,18 @@
+Extension { #name : 'PPSea' }
+
+{ #category : '*petitcompiler' }
+PPSea >> asCompilerNode [
+	^ PPCSeaNode new
+		island: island;
+		water: water;
+		parser: self copy;
+		properties: properties;
+		yourself
+]
+
+{ #category : '*petitcompiler' }
+PPSea >> map: aThreeArgBlock [
+	^ aThreeArgBlock numArgs = 3
+		ifTrue: [ PPMappedActionParser on: self block: aThreeArgBlock ]
+		ifFalse: [ self error: 'three arguments expected.' ]
+]
diff --git a/software/petitcompiler/PPSequenceParser.extension.st b/software/petitcompiler/PPSequenceParser.extension.st
new file mode 100644
index 0000000..3f4f977
--- /dev/null
+++ b/software/petitcompiler/PPSequenceParser.extension.st
@@ -0,0 +1,33 @@
+Extension { #name : 'PPSequenceParser' }
+
+{ #category : '*petitcompiler' }
+PPSequenceParser >> asCompilerNode [
+	^ PPCSequenceNode new
+		children: parsers;
+		name: self name;
+		properties: properties;
+		yourself
+]
+
+{ #category : '*petitcompiler' }
+PPSequenceParser >> firstSetSuchThat: block into: aCollection openSet: aSet [
+	(aSet includes: self) ifTrue: [ ^ aCollection ].
+	aSet add: self.
+	
+	(block value: self) ifTrue: [ aCollection add: self. ^ aCollection ].
+	
+	self children do: [ :child | 
+		child firstSetSuchThat: block into: aCollection openSet: aSet.
+		child acceptsEpsilon ifFalse: [ ^ aCollection ]
+	].
+	^ aCollection
+]
+
+{ #category : '*petitcompiler' }
+PPSequenceParser >> map: aBlock [
+		^ aBlock numArgs = self children size
+				ifTrue: [ PPMappedActionParser on: self block: aBlock ]
+				ifFalse: [ self error: aBlock numArgs asString , ' arguments expected.' ]
+
+	"Modified: / 02-06-2015 / 17:16:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+]
diff --git a/software/petitcompiler/PPStartOfLineParser.extension.st b/software/petitcompiler/PPStartOfLineParser.extension.st
new file mode 100644
index 0000000..a1d0b67
--- /dev/null
+++ b/software/petitcompiler/PPStartOfLineParser.extension.st
@@ -0,0 +1,12 @@
+Extension { #name : 'PPStartOfLineParser' }
+
+{ #category : '*petitcompiler' }
+PPStartOfLineParser >> changesContext [
+	^ false
+]
+
+{ #category : '*petitcompiler' }
+PPStartOfLineParser >> firstCharSet [
+	"anything..."
+	^ PPCharSetPredicate on: [:e | true ] 
+]
diff --git a/software/petitcompiler/PPStream.extension.st b/software/petitcompiler/PPStream.extension.st
new file mode 100644
index 0000000..a8b6fa4
--- /dev/null
+++ b/software/petitcompiler/PPStream.extension.st
@@ -0,0 +1,8 @@
+Extension { #name : 'PPStream' }
+
+{ #category : '*petitcompiler' }
+PPStream >> peek: anInteger [
+	| endPosition |
+	endPosition := position + anInteger  min:  readLimit.
+	^ collection copyFrom: position+1 to: endPosition.
+]
diff --git a/software/petitcompiler/PPToken.extension.st b/software/petitcompiler/PPToken.extension.st
new file mode 100644
index 0000000..668b160
--- /dev/null
+++ b/software/petitcompiler/PPToken.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'PPToken' }
+
+{ #category : '*petitcompiler' }
+PPToken >> isToken [
+	^ true
+]
diff --git a/software/petitcompiler/PPTokenParser.extension.st b/software/petitcompiler/PPTokenParser.extension.st
new file mode 100644
index 0000000..539008e
--- /dev/null
+++ b/software/petitcompiler/PPTokenParser.extension.st
@@ -0,0 +1,35 @@
+Extension { #name : 'PPTokenParser' }
+
+{ #category : '*petitcompiler' }
+PPTokenParser >> asCompilerNode [
+	^ PPCTokenNode new
+		name: self name;
+		tokenClass: self tokenClass;
+		child: parser;
+		yourself
+]
+
+{ #category : '*petitcompiler' }
+PPTokenParser >> displayName [
+	^ 'TOKEN[', parser displayName, ']'
+]
+
+{ #category : '*petitcompiler' }
+PPTokenParser >> isFirstSetTerminal [
+	^ false
+]
+
+{ #category : '*petitcompiler' }
+PPTokenParser >> isTokenParser [
+	^ true
+]
+
+{ #category : '*petitcompiler' }
+PPTokenParser >> parser [
+	^ parser
+]
+
+{ #category : '*petitcompiler' }
+PPTokenParser >> whitespace [
+	^ self class whitespace 
+]
diff --git a/software/petitcompiler/PPTrimmingParser.extension.st b/software/petitcompiler/PPTrimmingParser.extension.st
new file mode 100644
index 0000000..db19ab2
--- /dev/null
+++ b/software/petitcompiler/PPTrimmingParser.extension.st
@@ -0,0 +1,31 @@
+Extension { #name : 'PPTrimmingParser' }
+
+{ #category : '*petitcompiler' }
+PPTrimmingParser >> asCompilerNode [
+	^ PPCTrimNode new
+		child: parser;
+		"
+			JK HACK ALERT, because trimmer is not included in children, it will never be asked
+			to be translated into the PPCNode when building compiler tree. We have to do it on 
+			our own :(
+		"
+		trimmer: trimmer star asCompilerTree;
+		name: self name;
+		parser: self;
+		yourself
+]
+
+{ #category : '*petitcompiler' }
+PPTrimmingParser >> parseOn: aPPContext [
+	| memento element |
+	memento := aPPContext remember.
+	[ (trimmer parseOn: aPPContext) isPetitFailure ]
+		whileFalse.
+	element := parser parseOn: aPPContext.
+	element isPetitFailure ifTrue: [
+		aPPContext restore: memento.
+		^ element ].
+	[ (trimmer parseOn: aPPContext) isPetitFailure ]
+		whileFalse.
+	^ element
+]
diff --git a/software/petitcompiler/PPWrappingParser.extension.st b/software/petitcompiler/PPWrappingParser.extension.st
new file mode 100644
index 0000000..4f3abad
--- /dev/null
+++ b/software/petitcompiler/PPWrappingParser.extension.st
@@ -0,0 +1,16 @@
+Extension { #name : 'PPWrappingParser' }
+
+{ #category : '*petitcompiler' }
+PPWrappingParser >> asCompilerNode [
+	^ PPCUnknownNode new
+		parser: self;
+		name: self name;
+		contextFree: false;
+		changesContext: (self propertyAt: #changesContext ifAbsent: true);
+		yourself
+]
+
+{ #category : '*petitcompiler' }
+PPWrappingParser >> isContextFreePrim [
+	^ false
+]
diff --git a/software/petitcompiler/package.st b/software/petitcompiler/package.st
new file mode 100644
index 0000000..9e3bf80
--- /dev/null
+++ b/software/petitcompiler/package.st
@@ -0,0 +1 @@
+Package { #name : 'petitcompiler' }
diff --git a/software/petitislands/FirstFollowNextTests.class.st b/software/petitislands/FirstFollowNextTests.class.st
new file mode 100644
index 0000000..15b7a54
--- /dev/null
+++ b/software/petitislands/FirstFollowNextTests.class.st
@@ -0,0 +1,1289 @@
+Class {
+	#name : 'FirstFollowNextTests',
+	#superclass : 'TestCase',
+	#category : 'PetitIslands-Tests'
+}
+
+{ #category : 'support' }
+FirstFollowNextTests >> assert: set allMatches: string [
+	self assert: (set allSatisfy: [:e | e end matches: string])
+]
+
+{ #category : 'support' }
+FirstFollowNextTests >> assert: set allSatisfy: aBlock [
+	self assert: (set allSatisfy: aBlock)
+]
+
+{ #category : 'support' }
+FirstFollowNextTests >> assert: set anyMatches: string [
+	self assert: (set anySatisfy: [:e | e end matches: string])
+]
+
+{ #category : 'support' }
+FirstFollowNextTests >> assert: set anySatisfy: aBlock [
+	self assert: (set anySatisfy: aBlock)
+
+]
+
+{ #category : 'support' }
+FirstFollowNextTests >> assert: set noneMatches: string [
+	self assert: (set noneSatisfy: [:e | e end matches: string])
+]
+
+{ #category : 'support' }
+FirstFollowNextTests >> assert: set noneSatisfy: aBlock [
+	self assert: (set noneSatisfy: aBlock)	
+]
+
+{ #category : 'support' }
+FirstFollowNextTests >> assert: set size: anInteger [
+	self assert: (set size = anInteger )
+]
+
+{ #category : 'support' }
+FirstFollowNextTests >> first: aParser [ 
+	^ aParser firstSet
+]
+
+{ #category : 'support' }
+FirstFollowNextTests >> first: aParser terminalPredicate: predicate [
+	^ aParser firstSetPredicate: predicate
+]
+
+{ #category : 'support' }
+FirstFollowNextTests >> follow: aParser in: rootParser [
+	^ rootParser followSets at: aParser
+	
+]
+
+{ #category : 'support' }
+FirstFollowNextTests >> identifier [
+	^ ((#letter asParser / $# asParser), (#letter asParser / #digit asParser) star) flatten 
+]
+
+{ #category : 'support' }
+FirstFollowNextTests >> next: aParser in: rootParser [
+	^ rootParser nextSets at: aParser
+	
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirst1 [
+	| p first |
+	p := nil asParser / 'a' asParser.
+	
+	self assert: (self first: p) anyMatches: ''.
+	self assert: (self first: p) anyMatches: 'a'.
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirst2 [
+	| p first |
+	p := 'a' asParser optional, 'b' asParser.
+	
+	self assert: (self first: p) anyMatches: 'a'.
+	self assert: (self first: p) anyMatches: 'b'.
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirst3 [
+	| p first |
+	p := ('a' asParser optional, 'b' asParser asParser optional), 'c' asParser.
+	
+	self assert: (self first: p) anyMatches: 'a'.
+	self assert: (self first: p) anyMatches: 'b'.
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirst4 [
+	| p first |
+	p := ('a' asParser plus) optional, 'b' asParser.
+	
+	self assert: (self first: p) anyMatches: 'a'.
+	self assert: (self first: p) anyMatches: 'b'.
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstChoice1 [
+	| p first |
+	p := nil asParser / '' asParser.
+	
+	self assert: (self first: p) anySatisfy: [:e | e matches: ''].
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstChoice2 [
+	| p first |
+	p := 'a' asParser / nil asParser.
+	
+	first := (self first: p).
+	
+	self assert: first anySatisfy: [:e | e matches: 'a'].
+	self assert: first anySatisfy: [:e | e matches: ''].
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstChoice3 [
+	| p first |
+	p := 'a' asParser / nil asParser / 'b' asParser.
+	
+	first := (self first: p).
+	
+	self assert: first anySatisfy: [:e | e matches: 'a'].
+	self assert: first anySatisfy: [:e | e matches: 'b'].
+	self assert: first anySatisfy: [:e | e matches: ''].
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstComplex1 [
+	| p first root |
+
+	p := 'a' asParser / nil asParser.
+	root := p, 'c' asParser.
+	
+	first := (self first: root).
+	
+	self assert: first size: 2.
+	self assert: first anySatisfy: [:e | e matches: 'a'].
+	self assert: first anySatisfy: [:e | e matches: 'c'].
+	self assert: first noneSatisfy: [:e | e matches: ''].
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstComplex2 [
+	| p first root |
+
+	p := 'a' asParser / nil asParser / 'b' asParser.
+	root := p, 'c' asParser.
+	
+	first := (self first: root).
+	
+	self assert: first size: 3.
+	self assert: first anySatisfy: [:e | e matches: 'a'].
+	self assert: first anySatisfy: [:e | e matches: 'b'].
+	self assert: first anySatisfy: [:e | e matches: 'c'].
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstComplex3 [
+	| p first root |
+
+	p := 'a' asParser / nil asParser / 'b' asParser.
+	root := p, 'c' asParser not.
+	
+	first := (self first: root).
+	
+	self assert: first anySatisfy: [:e | e matches: 'a'].
+	self assert: first anySatisfy: [:e | e matches: 'b'].
+	self assert: first anySatisfy: [:e | e matches: ''].
+	self assert: first noneSatisfy: [:e | e end matches: 'c'].
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstComplex4 [
+	| p first root |
+
+	p := 'a' asParser / nil asParser / 'b' asParser.
+	root := (p, 'c' asParser not) wrapped.
+	
+	first := (self first: root).
+	
+	self assert: first anySatisfy: [:e | e matches: 'a'].
+	self assert: first anySatisfy: [:e | e matches: 'b'].
+	self assert: first anySatisfy: [:e | e matches: ''].
+	self assert: first noneSatisfy: [:e | e end matches: 'c'].
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstNegate1 [
+	| p first |
+	p := 'a' asParser negate, 'b' asParser.
+	
+	self assert: (p parse: 'bb') isPetitFailure not.
+	self assert: (p parse: 'cb') isPetitFailure not.
+	
+	self assert: (self first: p) noneSatisfy: [:each | each matches: 'a' ].
+	self assert: (self first: p) anySatisfy:  [:each | each matches: 'b' ].
+	self assert: (self first: p) anySatisfy: [:each | each matches: 'c' ].
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstNot [
+	| p |
+	p := 'a' asParser not, 'b' asParser.
+	
+	self assert: (p parse: 'b') isPetitFailure not.
+	
+	self assert: (self first: p) size: 1.
+	self assert: (self first: p) noneSatisfy: [:each | each matches: 'a' ].
+	self assert: (self first: p) anySatisfy:  [:each | each matches: 'b' ].
+	self assert: (self first: p) anySatisfy: [:each | each matches: 'c' ].
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstOptional [
+	| p first result |
+	p := 'a' asParser optional.
+	
+	result := (self first: p).
+	
+	self assert: result anySatisfy: [:e | e matches: '' ].
+	self assert: result anySatisfy: [:e | e matches: 'a'].
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstRepeat1 [
+	| p first |
+	p := ('a' asParser / nil asParser) plus.
+	
+	first := self first: p.
+
+	self assert: first anyMatches: 'a'.
+	self assert: first anyMatches: ''.	
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstRepeat2 [
+	| p first |
+	p := 'a' asParser star, 'b' asParser.
+	
+	first := self first: p.
+
+	self assert: first anyMatches: 'a'.
+	self assert: first anyMatches: 'b'.
+	self assert: first noneMatches: ''	
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstRepeat3 [
+	| p first |
+	p := 'a' asParser negate, 'a' asParser.
+	
+	first := self first: p.
+
+	self assert: first noneMatches: 'a'.
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstRepeat4 [
+	| p first |
+	p := 'a' asParser negate star, 'b' asParser.
+	
+	first := self first: p.
+
+	self assert: first size: 2.
+	self assert: first noneMatches: 'a'.
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstSequence1 [
+	| p first |
+	p := 'a' asParser, 'b' asParser .
+	
+	first := self first: p.
+	self assert: first size: 1.
+	self assert: first allMatches: 'a'.
+	self assert: first noneMatches: 'b'.	
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstSequence2 [
+	| p first |
+	p := nil asParser, 'a' asParser, 'b' asParser .
+	
+	first := self first: p.
+	self assert: first size: 1.
+	self assert: first allMatches: 'a'.
+	self assert: first noneMatches: 'b'.	
+	self assert: first noneMatches: ''.		
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstSequence3 [
+	| p first |
+	p := nil asParser, nil asParser.
+	
+	self assert: (self first: p) anySatisfy: [:e | e end matches: ''].
+
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstSequence4 [
+	| p first |
+	p := ((nil asParser / 'a' asParser) plus), 'b' asParser.
+	
+	first := self first: p.
+	self assert: first anyMatches: 'b'.
+	self assert: first anyMatches: 'a'.
+	self assert: first noneMatches: ''.
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstSequence5 [
+	| p first |
+	p := ((nil asParser / 'a' asParser) star), 'b' asParser.
+	
+	first := self first: p.
+	self assert: first anyMatches: 'b'.
+	self assert: first anyMatches: 'a'.
+	self assert: first noneMatches: ''.
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstTerminal2 [
+	| p |
+	p := 'a' asParser not.
+	
+	self assert: (self first: p) noneMatches: 'a'.
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstTerminal3 [
+	| p |
+	p := 'a' asParser and.
+	
+	self assert: (self first: p) anyMatches: 'a'
+]
+
+{ #category : 'test first' }
+FirstFollowNextTests >> testFirstTerminal4 [
+	| p |
+	p := nil asParser.
+	
+	self assert: (self first: p) anySatisfy: [:e | e end matches: ''].
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowNot1 [
+	| p followSet terminal |
+
+	terminal := 'a' asParser.
+	p := terminal, 'b' asParser not.
+	followSet := self follow: terminal in: p.
+	
+	self assert: followSet anySatisfy: [:e | e matches: 'c' ].
+	self assert: followSet anySatisfy: [:e | (e matches: 'b') not ].
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet1 [
+	| result p root followSet |
+
+
+	p := 'a' asParser.
+	root := (p star, 'b' asParser).
+	
+	followSet := self follow: p in: root.
+	
+	self assert: followSet anySatisfy: [:e | e literal = 'a'].
+	self assert: followSet anySatisfy: [:e | e literal = 'b'].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet10 [
+	|  island1 followSet p root island2 block |
+
+	island1 := ('class' asParser, self identifier) sea.
+	island2 := ('extends' asParser, self identifier) sea.
+	block := '{}' asParser sea.	
+
+	root := (island1, island2 optional, block) star.
+	
+	followSet := self follow: block in: root.
+
+	self assert: followSet anySatisfy: [:e | e end matches: 'class'].
+	self assert: followSet anySatisfy: [:e | e end matches: ''].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet11 [
+	|  island1 followSet p root island2 block |
+
+	island1 := ('class' asParser, self identifier) sea.
+	island2 := ('extends' asParser, self identifier) sea.
+	block := '{}' asParser sea.	
+
+	root := (island1, island2 optional, block) plus.
+	
+	followSet := self follow: block in: root.
+
+	self assert: followSet anySatisfy: [:e | e end matches: 'class'].
+	self assert: followSet anySatisfy: [:e | e end matches: ''].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet12 [
+	| parser followSet |
+	
+	
+
+	parser := 'a' asParser.
+	followSet := self follow: parser in: parser.
+
+	self assert: followSet anySatisfy: [:e | e end matches: '' ].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet13 [
+	| parser followSet a b c |
+	
+	a := 'a' asParser.
+	b := 'b' asParser optional.
+	c := 'c' asParser.
+	
+	
+	parser := a, b, c.
+	followSet := self follow: c in: parser.
+	self assert: followSet anySatisfy: [:e | e end matches: '' ].
+	
+	followSet := self follow: b in: parser.
+	self assert: followSet anySatisfy: [:e | e end matches: 'c' ].
+
+	followSet := self follow: a in: parser.
+	self assert: followSet anySatisfy: [:e | e end matches: 'b' ].
+	self assert: followSet anySatisfy: [:e | e end matches: 'c' ].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet14 [
+	| parser followSet a b c |
+	
+	a := 'a' asParser.
+	b := 'b' asParser optional.
+	c := 'c' asParser.
+	
+	
+	parser := a plus, b, c.
+
+	followSet := self follow: a in: parser.
+	self assert: followSet anySatisfy: [:e | e end matches: 'a' ].	
+	self assert: followSet anySatisfy: [:e | e end matches: 'b' ].
+	self assert: followSet anySatisfy: [:e | e end matches: 'c' ].
+	self assert: followSet noneSatisfy: [:e | e end matches: '' ].
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet2 [
+	| result p follow root followSets followSet |
+
+	p := 'a' asParser.
+	follow := 'b' asParser, 'c' asParser.
+	
+	root := (p, follow).
+
+	followSet := self follow: p in: root.
+
+	self assert: followSet size: 1.
+	self assert: followSet anySatisfy: [:e | e  end matches: 'b'].
+	self assert: followSet noneSatisfy: [:e | e matches: 'c'].	
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet3 [
+	| result p follow root followSets followSet |
+
+	p := 'a' asParser.
+	follow := ('b' asParser, 'c' asParser) / ('d' asParser).
+	
+	
+	root := (p, follow).
+
+	followSet := self follow: p in: root.
+
+	self assert: followSet anySatisfy: [:e | e end matches: 'b' ].
+	self assert: followSet anySatisfy: [:e | e end matches: 'd' ].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet4 [
+	| result p follow root followSets followSet |
+
+	p := 'a' asParser.
+	follow := ('b' asParser, 'c' asParser).
+	
+	
+	root := (p star, follow).
+
+	followSet := self follow: p in: root.
+
+	self assert: followSet anySatisfy: [:e | e end matches: 'b' ].
+	self assert: followSet anySatisfy: [:e | e end matches: 'a' ].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet5 [
+	| result p root followSets followSet follow1 follow2 |
+
+	p := 'a' asParser.
+	follow1 := ('b' asParser, 'c' asParser) / nil asParser.
+	follow2 := 'd' asParser.
+	
+	
+	root := (p, follow1, follow2).
+
+	followSet := self follow: p in: root.
+
+	self assert: followSet anySatisfy: [:e | e end matches: 'b' ].
+	self assert: followSet anySatisfy: [:e | e end matches: 'd' ].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet6 [
+	| result p root followSets followSet follow follow1 follow2 |
+
+	p := 'a' asParser.
+	follow1 := ('b' asParser, 'c' asParser) / nil asParser.
+	follow2 := 'd' asParser.
+	
+	follow := (follow1, follow2).
+	
+	root  := (p, follow).
+
+	followSet := self follow: p in: root.
+
+	self assert: followSet anySatisfy: [:e | e end matches: 'b' ].
+	self assert: followSet anySatisfy: [:e | e end matches: 'd' ].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet7 [
+	| result p root followSets followSet r1 r2 follow1 follow2 |
+
+	p := 'a' asParser.
+	follow1 := ('b' asParser, 'c' asParser) / nil asParser.
+	follow2 := 'd' asParser / nil asParser .
+	
+	r1 := (p, follow1).
+	r2 := (r1, follow2).
+	
+	root  := r2.
+
+	followSet := self follow: p in: root.
+
+	self assert: followSet anySatisfy: [:e | e end matches: 'b' ].
+	self assert: followSet anySatisfy: [:e | e end matches: 'd' ].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet8 [
+	| result p root followSets followSet follow |
+
+	p := 'a' asParser.
+	follow := PPEndOfFileParser new.
+	
+	root := p, follow.
+
+	followSet := self follow: p in: root.
+
+	self assert: followSet anySatisfy: [:e | e end matches: ''].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSet9 [
+	|  island1 followSet p root island2 block |
+
+	island1 := ('class' asParser, self identifier) sea.
+	island2 := (':' asParser, self identifier) sea.
+	block := '{' asParser, '}' asParser sea.	
+
+	root := (island1, island2 optional, block) sea.
+	
+	followSet := self follow: island1 in: root.
+
+	self assert: followSet anySatisfy: [:e | e end matches: '{'].
+	self assert: followSet anySatisfy: [:e | e end matches: ':'].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSetChoice1 [
+	| result p root followSets followSet follow |
+
+	p := 'a' asParser.
+	follow := 'b' asParser / 'c' asParser .
+	
+	root := p, follow.
+
+	followSet := self follow: p in: root.
+	
+	self assert: followSet anySatisfy: [:e | (e parse: 'b') isPetitFailure not].
+	self assert: followSet anySatisfy: [:e | (e parse: 'c') isPetitFailure not].
+	self assert: followSet noneSatisfy: [:e | (e parse: 'a') isPetitFailure not].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSetChoice2 [
+	| result p root followSet follow b c |
+
+	follow := 'a' asParser / 'd' asParser.
+	b := 'b' asParser.
+	c := 'c' asParser.
+	p := b / c.
+	
+	root := p, follow.
+
+	followSet := self follow: p in: root.
+
+	self assert: followSet anySatisfy: [:e | (e parse: 'a') isPetitFailure not].
+	self assert: followSet anySatisfy: [:e | (e parse: 'd') isPetitFailure not].
+
+	followSet := self follow: p in: root.
+	
+	self assert: followSet anySatisfy: [:e | (e parse: 'a') isPetitFailure not].
+	self assert: followSet noneSatisfy: [:e | (e parse: 'c') isPetitFailure not].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSetOptional1 [
+	| result p root followSets followSet follow follow1 follow2 |
+
+	p := 'a' asParser.
+	follow1 := 'b' asParser optional.
+	follow2 := 'c' asParser.
+	
+	root := p, follow1, follow2.
+
+	followSet := self follow: p in: root.
+
+	self assert: followSet anySatisfy: [:e | e end matches: 'b'].
+	self assert: followSet anySatisfy: [:e | e end matches: 'c'].
+	self assert: followSet noneSatisfy: [:e | e end matches: ''].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSetRepeat1 [
+	| p followSet terminal |
+
+	terminal := 'a' asParser.
+	p := terminal plus.
+	
+	followSet := self follow: terminal in: p.
+	self assert: followSet anySatisfy: [:e | e end matches: 'a' ].
+	self assert: followSet anySatisfy: [:e | e end matches: '' ].
+
+	followSet := self follow: p in: p.
+	self assert: followSet anySatisfy: [:e | e end matches: '' ].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSetStar1 [
+	| a b p followSet |
+
+	a := 'a' asParser star.
+	b := 'b' asParser.
+	p := a, b.
+	followSet := self follow: a in: p.
+	
+	self assert: followSet size: 1.
+	self assert: followSet anySatisfy: [:e | e end matches: 'b'].
+	self assert: followSet noneSatisfy: [:e | e end matches: ''].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSetStar3 [
+	| a b p followSet n |
+
+	a := 'a' asParser star.
+	p := a.
+	followSet := self follow: a in: p.
+	
+	self assert: followSet noneSatisfy: [:e | e end matches: 'a'].
+	self assert: followSet anySatisfy: [:e | e end matches: ''].
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSetStar4 [
+	| a b p followSet |
+
+	a := 'a' asParser.
+	b := 'b' asParser.
+	p := a star, b.
+	followSet := self follow: a in: p.
+	
+	self assert: followSet size: 2.
+	self assert: followSet anySatisfy: [:e | e end matches: 'a'].
+	self assert: followSet anySatisfy: [:e | e end matches: 'b'].
+	self assert: followSet noneSatisfy: [:e | e end matches: ''].
+
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSetStar5 [
+	| a b p followSet n |
+
+	a := 'a' asParser.
+	b := 'b' asParser.
+	n := nil asParser.
+	p := a star, (b / n).
+	followSet := self follow: a in: p.
+	
+
+	self assert: followSet anySatisfy: [:e | e end matches: 'a'].
+	self assert: followSet anySatisfy: [:e | e end matches: 'b'].
+	self assert: followSet anySatisfy: [:e | e end matches: ''].
+]
+
+{ #category : 'test follow' }
+FirstFollowNextTests >> testFollowSetStar6 [
+	| a b p followSet n |
+
+	a := 'a' asParser.
+	p := a star.
+	followSet := self follow: a in: p.
+	
+
+	self assert: followSet anySatisfy: [:e | e end matches: 'a'].
+	self assert: followSet anySatisfy: [:e | e end matches: ''].
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable01 [
+	self assert:	'a' asParser acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable02 [
+	self assert:	'a' asParser wrapped acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable03 [
+	self assert:	nil asParser acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable04 [
+	self assert:	nil asParser wrapped acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable05 [
+	self assert:	 'a' asParser not acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable06 [
+	self assert:	 'a' asParser and acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable07 [
+	self assert:	 'a' asParser wrapped not acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable08 [
+	self assert:	 'a' asParser wrapped and acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable09 [
+	self assert:	 'a' asParser optional acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable10 [
+	self assert:	 'a' asParser wrapped optional acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable11 [
+	self assert:	 'a' asParser wrapped not optional acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullable12 [
+	self assert:	 'a' asParser optional wrapped acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableChoice1 [
+	| a b c p |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	c := 'c' asParser.
+	
+	p := a / b / c.
+	
+	self assert: p acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableChoice2 [
+	| a b c p |
+	a := 'a' asParser.
+	b := 'b' asParser optional.
+	c := 'c' asParser.
+	
+	p := a / b / c.
+	
+	self assert: p acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableChoice3 [
+	| a b c p |
+	a := 'a' asParser optional.
+	b := 'b' asParser optional.
+	c := 'c' asParser optional.
+	
+	p := a / b / c.
+	
+	self assert: p acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableChoice4 [
+	| a b c p |
+	a := 'a' asParser optional wrapped.
+	b := 'b' asParser optional wrapped.
+	c := 'c' asParser optional wrapped.
+	
+	p := a / b / c.
+	
+	self assert: p acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableCycle1 [
+	| a p |
+	a := 'a' asParser.
+	p := PPDelegateParser new.
+	
+	p setParser: a / p.
+	self assert: p acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableCycle2 [
+	| a p e |
+	a := 'a' asParser.
+	e := nil asParser.
+	p := PPDelegateParser new.
+	
+	p setParser: (a, p) / e.
+	
+	self assert: p acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableCycle3 [
+	| a p e |
+	a := 'a' asParser.
+	e := nil asParser.
+	p := PPDelegateParser new.
+	
+	p setParser: (a, p), e.
+	
+	self assert: p acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableEOF [
+	| a |
+	a := #eof asParser.
+	self assert: a acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableSeq1 [
+	| a b c p |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	c := 'c' asParser.
+	
+	p := a, b, c.
+	
+	self assert: p acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableSeq2 [
+	| a b c p |
+	a := 'a' asParser.
+	b := 'b' asParser optional.
+	c := 'c' asParser.
+	
+	p := a, b, c.
+	
+	self assert: p acceptsEpsilon not.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableSeq3 [
+	| a b c p |
+	a := 'a' asParser optional.
+	b := 'b' asParser optional.
+	c := 'c' asParser optional.
+	
+	p := a, b, c.
+	
+	self assert: p acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableSeq4 [
+	| a b c p |
+	a := 'a' asParser optional wrapped.
+	b := 'b' asParser optional wrapped.
+	c := 'c' asParser wrapped optional.
+	
+	p := a, b, c.
+	
+	self assert: p acceptsEpsilon.
+]
+
+{ #category : 'test isNullable' }
+FirstFollowNextTests >> testIsNullableStartOfLine [
+	| a |
+	a := #startOfLine asParser.
+	self assert: a acceptsEpsilon not.
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNext1 [
+	| p nextSet |
+	p := 'a' asParser.
+	
+	nextSet := (self next: p in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: ''].
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNext2 [
+	| p nextSet a b |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	
+	p := a, b.
+	
+	nextSet := (self next: a in: p).
+	self assert: nextSet size: 1.
+	self assert: nextSet anySatisfy: [:e | e end matches: 'b'].
+	
+	nextSet := (self next: b in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: ''].
+	
+	nextSet := (self next: p in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: ''].
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNext3 [
+	| p nextSet a b |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	
+	p := a / b.
+	
+	nextSet := (self next: a in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: ''].
+	
+	nextSet := (self next: b in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: ''].
+	
+	nextSet := (self next: p in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: ''].
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNext4 [
+	| p nextSet a b n |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	n := nil asParser.
+	
+	p := a, n, b.
+	
+	nextSet := (self next: a in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: 'b'].
+	
+	nextSet := (self next: n in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: 'b'].
+	
+	nextSet := (self next: b in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: ''].
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNext5 [
+	| p nextSet a b n a1 a2 |
+	a1 := 'a1' asParser wrapped.
+	a2 := 'a2' asParser wrapped.
+	a := (a1 asParser, a2 asParser) wrapped.
+	b := 'b' asParser.
+	n := 'n' asParser optional.
+	
+	p := a, n, b.
+	
+	nextSet := (self next: a1 in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: 'a2'].
+
+	nextSet := (self next: a2 in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: 'b'].
+	self assert: nextSet anySatisfy: [:e | e end matches: 'nb'].
+
+
+
+	nextSet := (self next: a in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: 'b'].
+	self assert: nextSet anySatisfy: [:e | e end matches: 'nb'].
+	
+	nextSet := (self next: n in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: 'b'].
+	
+	nextSet := (self next: b in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: ''].
+	self assert: nextSet noneSatisfy: [:e | e end matches: 'b'].	
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNext6 [
+	| p nextSet a b n a1 a2 |
+	a1 := 'a1' asParser wrapped.
+	a2 := 'a2' asParser wrapped / nil asParser.
+	a := (a1 asParser, a2 asParser) wrapped.
+	b := 'b' asParser.
+	n := 'nil' asParser optional.
+	
+	p := a, n, b.
+	
+	nextSet := (self next: a1 in: p).
+	self assert: nextSet anySatisfy: [:e | e matches: 'a2'].
+	self assert: nextSet anySatisfy: [:e | e matches: 'nilb'].
+	self assert: nextSet anySatisfy: [:e | e matches: 'b'].
+
+	nextSet := (self next: a2 in: p).
+	self assert: nextSet anySatisfy: [:e | e matches: 'nilb'].
+	self assert: nextSet anySatisfy: [:e | e matches: 'b'].
+
+
+	nextSet := (self next: a in: p).
+	self assert: nextSet anySatisfy: [:e | e matches: 'nilb'].
+	self assert: nextSet anySatisfy: [:e | e matches: 'b'].
+	
+	nextSet := (self next: n in: p).
+	self assert: nextSet anySatisfy: [:e | e matches: 'b'].
+	
+	nextSet := (self next: b in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: ''].
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNext7 [
+	| p nextSet a b n  c |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	c := 'c' asParser.
+	n := nil asParser.
+	
+	p := a, b, a, n, c.
+	
+	nextSet := (self next: a in: p).
+
+	self assert: nextSet anySatisfy: [:e | e matches: 'bac'].
+	self assert: nextSet anySatisfy: [:e | e matches: 'c'].
+
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNext8 [
+	| p nextSet a b n  c |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	c := 'c' asParser.
+	n := nil asParser.
+	
+	p := a, n, a, b, c.
+	
+	nextSet := (self next: a in: p).
+	self assert: nextSet anySatisfy: [:e | e matches: 'abc'].
+	self assert: nextSet anySatisfy: [:e | e matches: 'bc'].
+
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNextDelegate1 [
+
+	| a nextSet b c p |
+	a := 'a' asParser optional wrapped.
+	b := 'b' asParser optional wrapped.
+	c := 'c' asParser optional wrapped.
+	p := a, b, c.
+
+	nextSet := (self next: a in: p).
+	self assert: nextSet anySatisfy: [:e | e end matches: 'b'].
+	self assert: nextSet anySatisfy: [:e | e end matches: 'c'].
+
+
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNextRepeat1 [
+	| p nextSet a b n  c |
+	a := 'a' asParser star.
+	
+	nextSet := (self next: a in: a).
+	self assert: nextSet size: 1.
+	self assert: nextSet anySatisfy: [:e | e end matches: '']
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNextRepeat2 [
+	| p nextSet a b astar |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	astar := a star.
+	
+	p := astar, b.
+	
+	nextSet := (self next: astar in: p).
+
+	self assert: nextSet size: 1.
+	self assert: nextSet anySatisfy: [:e | e end matches: 'b'].
+
+
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNextRepeat3 [
+	| p nextSet a b astar |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	
+	p := a star, b.
+	
+	nextSet := (self next: a in: p).
+
+	self assert: nextSet size: 2.
+	self assert: nextSet anySatisfy: [:e | e end matches: 'b'].
+	self assert: nextSet anySatisfy: [:e | e end matches: 'a'].
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNextRepeat4 [
+	| a nextSet b p root |
+	a := 'a' asParser.
+	b := 'b' asParser optional.
+	
+	p := a, b.
+	root := p plus.
+	
+	nextSet := (self next: a in: root).
+	self assert: nextSet size = 3.
+	self assert: nextSet anySatisfy: [ :e | e matches: 'a'].
+	self assert: nextSet anySatisfy: [ :e | e matches: 'ab'].
+	self assert: nextSet anySatisfy: [ :e | e acceptsEpsilon ].
+
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNextSequence [
+	| a p nextSet b c |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	c := 'c' asParser.
+	
+	p := a, b, c.
+	
+	nextSet := (self next: a in: p).
+	self assert: nextSet noneSatisfy: [:e | e matches: 'b' ].
+	self assert: nextSet noneSatisfy: [:e | e matches: 'c' ].
+	self assert: nextSet anySatisfy: [:e | e matches: 'bc' ].
+
+
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNextSequence2 [
+	| a p nextSet b c |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	c := 'c' asParser.
+	
+	p := (a, b) wrapped, c.
+	
+	nextSet := (self next: a in: p).
+	self assert: nextSet anySatisfy: [:e | e matches: 'b' ].
+	self assert: nextSet noneSatisfy: [:e | e matches: 'c' ].
+	self assert: nextSet anySatisfy: [:e | e matches: 'bc' ].
+
+
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNextSequence3 [
+	| a p nextSet b c |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	c := 'c' asParser.
+	
+	p := (a, b sea) wrapped, c.
+	
+	nextSet := (self next: a in: p).
+	self assert: nextSet size = 2.
+	
+	self assert: nextSet anySatisfy: [:e | e matches: 'b' ].
+	self assert: nextSet anySatisfy: [:e | e matches: 'c' ].
+
+
+]
+
+{ #category : 'test next' }
+FirstFollowNextTests >> testNextSequence4 [
+	| a p nextSet b c d |
+	a := 'a' asParser.
+	b := 'b' asParser.
+	c := 'c' asParser.
+	d := 'd' asParser.
+	
+	p := (a, b sea, c sea) wrapped, d.
+	
+	nextSet := (self next: a in: p).
+	self assert: nextSet size = 2.
+	
+	self assert: nextSet anySatisfy: [:e | e matches: 'bc' ].
+	self assert: nextSet anySatisfy: [:e | e matches: 'd' ].
+
+
+]
diff --git a/software/petitislands/PPAlignOLParser.extension.st b/software/petitislands/PPAlignOLParser.extension.st
new file mode 100644
index 0000000..29ee60c
--- /dev/null
+++ b/software/petitislands/PPAlignOLParser.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'PPAlignOLParser' }
+
+{ #category : '*petitislands' }
+PPAlignOLParser >> isIslandBorder [
+	^ false
+]
diff --git a/software/petitislands/PPChoiceParser.extension.st b/software/petitislands/PPChoiceParser.extension.st
new file mode 100644
index 0000000..34e5d19
--- /dev/null
+++ b/software/petitislands/PPChoiceParser.extension.st
@@ -0,0 +1,13 @@
+Extension { #name : 'PPChoiceParser' }
+
+{ #category : '*petitislands' }
+PPChoiceParser >> acceptsEpsilonOpenSet: set [
+	set add: self.
+	^ self children anySatisfy: [:e | e acceptsEpsilonOpenSet: set ].
+]
+
+{ #category : '*petitislands' }
+PPChoiceParser >> isIslandBorderOpenSet: set [
+	set add: self.
+	^ self children allSatisfy: [:e | e isIslandBorderOpenSet: set ].
+]
diff --git a/software/petitislands/PPColumnParser.extension.st b/software/petitislands/PPColumnParser.extension.st
new file mode 100644
index 0000000..d262447
--- /dev/null
+++ b/software/petitislands/PPColumnParser.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'PPColumnParser' }
+
+{ #category : '*petitislands' }
+PPColumnParser >> isIslandBorder [
+	^ false
+]
diff --git a/software/petitislands/PPContext.extension.st b/software/petitislands/PPContext.extension.st
new file mode 100644
index 0000000..76024b2
--- /dev/null
+++ b/software/petitislands/PPContext.extension.st
@@ -0,0 +1,31 @@
+Extension { #name : 'PPContext' }
+
+{ #category : '*petitislands' }
+PPContext >> islandInvoke [
+	"profiling message, nothing to do here, see PPProfilingContext for more details"
+]
+
+{ #category : '*petitislands' }
+PPContext >> islandMemoHit [
+	"profiling message, nothing to do here, see PPProfilingContext for more details"
+]
+
+{ #category : '*petitislands' }
+PPContext >> islandMemoized [
+	"profiling message, nothing to do here, see PPProfilingContext for more details"
+]
+
+{ #category : '*petitislands' }
+PPContext >> waterPosition [
+	^ self globalAt:  #waterPosition ifAbsentPut: nil
+]
+
+{ #category : '*petitislands' }
+PPContext >> waterPosition: position [
+	^ self globalAt:  #waterPosition put: position
+]
+
+{ #category : '*petitislands' }
+PPContext >> waterToken [
+	"profiling message, nothing to do here, see PPProfilingContext for more details"
+]
diff --git a/software/petitislands/PPDelegateParser.extension.st b/software/petitislands/PPDelegateParser.extension.st
new file mode 100644
index 0000000..1fd7a2f
--- /dev/null
+++ b/software/petitislands/PPDelegateParser.extension.st
@@ -0,0 +1,29 @@
+Extension { #name : 'PPDelegateParser' }
+
+{ #category : '*petitislands' }
+PPDelegateParser >> acceptsEpsilon [
+	^ parser acceptsEpsilonOpenSet: (IdentitySet with: self).
+]
+
+{ #category : '*petitislands' }
+PPDelegateParser >> acceptsEpsilonOpenSet: set [
+	(set includes: parser) ifFalse: [ 
+		set add: parser.
+		^ parser acceptsEpsilonOpenSet: set 
+	].
+	^ false
+]
+
+{ #category : '*petitislands' }
+PPDelegateParser >> isIslandBorder [
+	^ parser isIslandBorderOpenSet: (IdentitySet with: self).
+]
+
+{ #category : '*petitislands' }
+PPDelegateParser >> isIslandBorderOpenSet: set [
+	(set includes: parser) ifFalse: [ 
+		set add: parser.
+		^ parser isIslandBorderOpenSet: set 
+	].
+	^ false
+]
diff --git a/software/petitislands/PPEndOfFileParser.extension.st b/software/petitislands/PPEndOfFileParser.extension.st
new file mode 100644
index 0000000..279bded
--- /dev/null
+++ b/software/petitislands/PPEndOfFileParser.extension.st
@@ -0,0 +1,11 @@
+Extension { #name : 'PPEndOfFileParser' }
+
+{ #category : '*petitislands' }
+PPEndOfFileParser >> acceptsEpsilon [
+	^ false
+]
+
+{ #category : '*petitislands' }
+PPEndOfFileParser >> isIslandBorder [
+	^ true
+]
diff --git a/software/petitislands/PPEndOfLineParser.extension.st b/software/petitislands/PPEndOfLineParser.extension.st
new file mode 100644
index 0000000..828b539
--- /dev/null
+++ b/software/petitislands/PPEndOfLineParser.extension.st
@@ -0,0 +1,11 @@
+Extension { #name : 'PPEndOfLineParser' }
+
+{ #category : '*petitislands' }
+PPEndOfLineParser >> acceptsEpsilon [
+	^ false
+]
+
+{ #category : '*petitislands' }
+PPEndOfLineParser >> isIslandBorder [
+	^ true
+]
diff --git a/software/petitislands/PPEpsilonParser.extension.st b/software/petitislands/PPEpsilonParser.extension.st
new file mode 100644
index 0000000..61a84bc
--- /dev/null
+++ b/software/petitislands/PPEpsilonParser.extension.st
@@ -0,0 +1,16 @@
+Extension { #name : 'PPEpsilonParser' }
+
+{ #category : '*petitislands' }
+PPEpsilonParser >> acceptsEpsilon [
+	^ true
+]
+
+{ #category : '*petitislands' }
+PPEpsilonParser >> isIslandBorder [
+	^ false
+]
+
+{ #category : '*petitislands' }
+PPEpsilonParser >> nonEmpty [
+	^ PPFailingParser message: 'epsilon is always empty'
+]
diff --git a/software/petitislands/PPFailingParser.extension.st b/software/petitislands/PPFailingParser.extension.st
new file mode 100644
index 0000000..cc4c3aa
--- /dev/null
+++ b/software/petitislands/PPFailingParser.extension.st
@@ -0,0 +1,11 @@
+Extension { #name : 'PPFailingParser' }
+
+{ #category : '*petitislands' }
+PPFailingParser >> acceptsEpsilon [
+	^ false
+]
+
+{ #category : '*petitislands' }
+PPFailingParser >> isIslandBorder [
+	^ false
+]
diff --git a/software/petitislands/PPJavaSeaGrammar.class.st b/software/petitislands/PPJavaSeaGrammar.class.st
new file mode 100644
index 0000000..75cdc33
--- /dev/null
+++ b/software/petitislands/PPJavaSeaGrammar.class.st
@@ -0,0 +1,262 @@
+"
+A JavaParser is a island parser, that can extract method names from a java file.
+
+Instance Variables
+	arguments:		<Object>
+	block:		<Object>
+	classBody:		<Object>
+	classDef:		<Object>
+	classId:		<Object>
+	javaClass:		<Object>
+	javaClassIsland:		<Object>
+	methodBody:		<Object>
+	methodDef:		<Object>
+	methodModifiers:		<Object>
+	methodName:		<Object>
+	modifiers:		<Object>
+	semicolon:		<Object>
+	throws:		<Object>
+	type:		<Object>
+
+arguments
+	- xxxxx
+
+block
+	- xxxxx
+
+classBody
+	- xxxxx
+
+classDef
+	- xxxxx
+
+classId
+	- xxxxx
+
+javaClass
+	- xxxxx
+
+javaClassIsland
+	- xxxxx
+
+methodBody
+	- xxxxx
+
+methodDef
+	- xxxxx
+
+methodModifiers
+	- xxxxx
+
+methodName
+	- xxxxx
+
+modifiers
+	- xxxxx
+
+semicolon
+	- xxxxx
+
+throws
+	- xxxxx
+
+type
+	- xxxxx
+
+"
+Class {
+	#name : 'PPJavaSeaGrammar',
+	#superclass : 'PPCompositeParser',
+	#instVars : [
+		'javaClass',
+		'classDef',
+		'classBody',
+		'methodDef',
+		'arguments',
+		'methodBody',
+		'methodName',
+		'block',
+		'modifiers',
+		'classId',
+		'type',
+		'javaClassSea',
+		'methodModifiers',
+		'semicolon',
+		'comment',
+		'singleLineComment',
+		'string',
+		'water',
+		'letters',
+		'spaces',
+		'javaClassInClassBody',
+		'methodDefInClassBody'
+	],
+	#category : 'PetitIslands-Examples'
+}
+
+{ #category : 'method' }
+PPJavaSeaGrammar >> arguments [
+	^ $( asParser, nil asParser sea,  $) asParser trim
+]
+
+{ #category : 'class' }
+PPJavaSeaGrammar >> block [
+	^ (${ asParser,
+		((block sea: water) plus / nil asParser sea: water),
+	$} asParser) ==> [:tokens | nil ]
+		
+]
+
+{ #category : 'class' }
+PPJavaSeaGrammar >> classBody [
+	 ^ 
+	(${ asParser,
+		(
+		(
+			((methodDefInClassBody / javaClassInClassBody) sea: water) ==> #second
+		) plus /
+		((nil asParser sea: water) ==> [ :tokens | OrderedCollection new ])
+		),
+	$} asParser) 
+	
+	map: [:_open :_content :_close | _content ]
+]
+
+{ #category : 'class' }
+PPJavaSeaGrammar >> classDef [
+	^ (modifiers trim, 'class' asParser, classId trim)
+]
+
+{ #category : 'class' }
+PPJavaSeaGrammar >> classId [
+	^ (#uppercase asParser, (#letter asParser / #digit asParser / $_ asParser) star) flatten 
+]
+
+{ #category : 'support' }
+PPJavaSeaGrammar >> collectMethodNames: javaClassResult [
+	| name methods |
+	self halt: 'deprecated'.
+	name := javaClassResult first.
+	methods := javaClassResult second.
+	
+	^ methods collect: [ :m | Array with: name with: methods first with: methods second ]
+]
+
+{ #category : 'comments and strings' }
+PPJavaSeaGrammar >> comment [
+	| end |
+	end := '*/' asParser.
+	^ ('/*' asParser, (end negate star), end)
+]
+
+{ #category : 'class' }
+PPJavaSeaGrammar >> javaClass [
+	^ classDef, ((classBody sea:water) ==> #second)
+]
+
+{ #category : 'class' }
+PPJavaSeaGrammar >> javaClassInClassBody [
+	^ javaClass
+]
+
+{ #category : 'class' }
+PPJavaSeaGrammar >> javaClassSea [
+	^ (javaClass sea: water) ==> #second
+]
+
+{ #category : 'method' }
+PPJavaSeaGrammar >> letters [
+	^ (#letter asParser plus)
+]
+
+{ #category : 'method' }
+PPJavaSeaGrammar >> methodBody [ 
+	^ semicolon / block
+]
+
+{ #category : 'method' }
+PPJavaSeaGrammar >> methodDef [
+	^ methodModifiers, 
+		((type sea: water), ((methodName, arguments) sea:water)) wrapped, 
+		methodBody
+]
+
+{ #category : 'method' }
+PPJavaSeaGrammar >> methodDefInClassBody [
+	^ methodDef
+]
+
+{ #category : 'class' }
+PPJavaSeaGrammar >> methodModifiers [
+	^( ('public' asParser / 'private' asParser / 'protected' asParser) optional, 
+	  'static' asParser trim optional, 
+	  'final' asParser trim optional,
+	  'abstract' asParser trim optional,
+	  'synchronized' asParser trim optional,	
+	  'native' asParser trim optional) ==> [ :tokens | nil ]
+]
+
+{ #category : 'method' }
+PPJavaSeaGrammar >> methodName [
+	^ ((#letter asParser / $_ asParser), (#letter asParser / #digit asParser / $_ asParser) star) flatten trimBlanks
+]
+
+{ #category : 'class' }
+PPJavaSeaGrammar >> modifiers [
+	^ ('public' asParser / 'private' asParser) optional, 'final' asParser trim optional, 'abstract' asParser trim optional
+]
+
+{ #category : 'method' }
+PPJavaSeaGrammar >> semicolon [
+	^ ';' asParser
+]
+
+{ #category : 'comments and strings' }
+PPJavaSeaGrammar >> singleLineComment [
+	| end |
+	end := #newline asParser.
+	^ ('//' asParser, (end negate star), end)
+]
+
+{ #category : 'method' }
+PPJavaSeaGrammar >> spaces [
+	^ #space asParser plus
+]
+
+{ #category : 'accessing' }
+PPJavaSeaGrammar >> start [
+	^ javaClassSea
+]
+
+{ #category : 'comments and strings' }
+PPJavaSeaGrammar >> string [
+	| end |
+	end := $" asParser.
+	^ ($" asParser, (#any asParser starLazy: end), end)
+		name: 'stringSeq';
+		yourself.
+]
+
+{ #category : 'method' }
+PPJavaSeaGrammar >> throws [
+	self halt: 'deprecated'.
+	^ 'throws' asParser trim, type trim, ($, asParser, type trim) star
+]
+
+{ #category : 'method' }
+PPJavaSeaGrammar >> type [
+	^ (#letter asParser, (#letter asParser / #digit asParser / $_ asParser) star) flatten 
+]
+
+{ #category : 'method' }
+PPJavaSeaGrammar >> water [
+	"
+		This will allow to skip over
+			- Strings, 
+			- Comments 
+			- and blocks 
+		when parsing water. This way, comments and strings cannot confuse the result.
+	"
+
+	^ comment / string / singleLineComment / block / letters / spaces / #any asParser
+]
diff --git a/software/petitislands/PPJavaSeaParser.class.st b/software/petitislands/PPJavaSeaParser.class.st
new file mode 100644
index 0000000..1bad91a
--- /dev/null
+++ b/software/petitislands/PPJavaSeaParser.class.st
@@ -0,0 +1,28 @@
+Class {
+	#name : 'PPJavaSeaParser',
+	#superclass : 'PPJavaSeaGrammar',
+	#category : 'PetitIslands-Examples'
+}
+
+{ #category : 'as yet unclassified' }
+PPJavaSeaParser >> javaClass [
+	^ super javaClass
+	
+	map: [:_def :_body |
+		PJTypeDeclarationNode new
+			modifiers: _def first;
+			simpleName: _def third;
+			methodDeclarations: _body
+			yourself
+	]
+]
+
+{ #category : 'as yet unclassified' }
+PPJavaSeaParser >> methodDef [
+	^ super methodDef ==> [:tokens | 
+		PJMethodDeclarationNode new
+			returnType: tokens second first second;
+			simpleName: tokens second second second first;
+			yourself
+	]
+]
diff --git a/software/petitislands/PPJavaSeaParserTest.class.st b/software/petitislands/PPJavaSeaParserTest.class.st
new file mode 100644
index 0000000..f0b1d7e
--- /dev/null
+++ b/software/petitislands/PPJavaSeaParserTest.class.st
@@ -0,0 +1,743 @@
+Class {
+	#name : 'PPJavaSeaParserTest',
+	#superclass : 'PPCompositeParserTest',
+	#category : 'PetitIslands-Examples'
+}
+
+{ #category : 'as yet unclassified' }
+PPJavaSeaParserTest class >> classJavaLangClass [
+	^ self new classJavaLangClass
+]
+
+{ #category : 'as yet unclassified' }
+PPJavaSeaParserTest class >> classJavaLangObject [
+	^ self new classJavaLangObject
+]
+
+{ #category : 'src' }
+PPJavaSeaParserTest >> file1 [
+ ^
+'package org.test;
+
+import java.util.*;
+
+public class Foo 
+{
+	// I am only empty class
+}'
+]
+
+{ #category : 'src' }
+PPJavaSeaParserTest >> file2 [
+ ^
+'
+public class Foo
+{
+	public void methodA() {}
+	
+	public Bar methodB(Some argument, and another) {}
+}'
+]
+
+{ #category : 'src' }
+PPJavaSeaParserTest >> file3 [
+ ^
+'package org.test;
+
+import java.util.*;
+
+public class Foo<Bar> extends Zorg
+{
+	// some comment
+	
+	public void methodA() {
+		System.out.println();
+	}
+	
+	private InnerClass  {}
+	
+	/**
+	 *
+	 */
+	public Bar methodB(Some argument, and another)
+	{
+		return new Bar();
+	}
+}'
+]
+
+{ #category : 'src' }
+PPJavaSeaParserTest >> file4 [
+ ^
+'package java.lang;
+
+import java.lang.reflect.Array;
+/**
+ * Instances of the class {@code Class} represent classes and
+ * interfaces in a running Java application. 
+ * <p> The following example uses a {@code Class} object to print the
+ * class name of an object:
+ *
+ * <p> <blockquote><pre>
+ *     void printClassName(Object obj) {
+ *         System.out.println("The class of " + obj +
+ *                            " is " + obj.getClass().getName());
+ *     }
+ * </pre></blockquote>
+ *
+ * <p> It is also possible to get the {@code Class} object for a named
+ * type (or for void) using a class literal
+ * (JLS Section <A HREF="http://java.sun.com/docs/books/jls/second_edition/html/expressions.doc.html#251530">15.8.2</A>).
+ * For example:
+ *
+ * <p> <blockquote>
+ *     {@code System.out.println("The name of class Foo is: "+Foo.class.getName());}
+ * </blockquote>
+ *
+ * @param <T> the type of the class modeled by this {@code Class}
+ * object.  For example, the type of {@code String.class} is {@code
+ * Class<String>}.  Use {@code Class<?>} if the class being modeled is
+ * unknown.
+ *
+ * @author  unascribed
+ * @see     java.lang.ClassLoader#defineClass(byte[], int, int)
+ * @since   JDK1.0
+ */
+public final
+    class Class<T> implements java.io.Serializable,
+                              java.lang.reflect.GenericDeclaration,
+                              java.lang.reflect.Type,
+                              java.lang.reflect.AnnotatedElement {
+    private static final int ANNOTATION= 0x00002000;
+    private static final int ENUM      = 0x00004000;
+    private static final int SYNTHETIC = 0x00001000;
+
+    private static native void registerNatives();
+    static {
+        registerNatives();
+    }
+
+    /*
+     * Constructor. Only the Java Virtual Machine creates Class
+     * objects.
+     */
+    private Class() {}
+
+
+    /**
+     * Converts the object to a string. The string representation is the
+     * string "class" or "interface", followed by a space, and then by the
+     * fully qualified name of the class in the format returned by
+     * {@code getName}.  If this {@code Class} object represents a
+     * primitive type, this method returns the name of the primitive type.  If
+     * this {@code Class} object represents void this method returns
+     * "void".
+     *
+     * @return a string representation of this class object.
+     */
+    public String toString() {
+        return (isInterface() ? "interface " : (isPrimitive() ? "" : "class "))
+            + getName();
+    }
+}'
+]
+
+{ #category : 'src' }
+PPJavaSeaParserTest >> file5 [
+ ^
+'package java.lang;
+
+import java.lang.reflect.Array;
+
+/**
+ * This is a class that has a comment!
+ * public class Bar { public void bar() { } }  }
+ *
+ * @author  unascribed
+ * @since   JDK1.0
+ */
+public final class Foo implements java.io.Serializable {
+    /*
+     * Constructor. Only the Java Virtual Machine creates Class
+     * objects.
+     */
+    private Foo() {}
+
+
+    /**
+     * Converts the object to a string. The string representation is the
+     * string "class" or "interface", followed by a space, and then by the
+     * fully qualified name of the class in the format returned by
+     * {@code getName}.  If this {@code Class} object represents a
+     * primitive type, this method returns the name of the primitive type.  If
+     * this {@code Class} object represents void this method returns
+     * "void".
+     *
+     * @return a string representation of this class object.
+     */
+    public String toString() {
+        return (isInterface() ? "interface " : (isPrimitive() ? "" : "class "))
+            + getName();
+    }
+}'
+]
+
+{ #category : 'src' }
+PPJavaSeaParserTest >> file7 [
+ ^
+'
+
+package java.lang;
+
+import sun.reflect.annotation.*;
+
+/**
+ * @author  unascribed
+ * @see     java.lang.ClassLoader#defineClass(byte[], int, int)
+ * @since   JDK1.0
+ */
+public final
+    class Class<T> implements java.io.Serializable,
+                              java.lang.reflect.GenericDeclaration,
+                              java.lang.reflect.Type,
+                              java.lang.reflect.AnnotatedElement {
+    
+    private static native void registerNatives();
+    
+	 static {
+        registerNatives();
+    }
+
+    /*
+     * Constructor. Only the Java Virtual Machine creates Class
+     * objects.
+     */
+    private Class() { }
+
+
+    public String toString() {
+        return (isInterface() ? "interface " : (isPrimitive() ? "" : "class "))
+            + getName();
+    }
+
+
+    
+
+    AnnotationType getAnnotationType() {
+        return annotationType;
+    }
+}'
+]
+
+{ #category : 'accessing' }
+PPJavaSeaParserTest >> parserClass [
+	^ PPJavaSeaParser
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> test1 [
+	self parse: self file1.
+	self assert: result simpleName = 'Foo'.
+	self assert: result methodDeclarations size = 0.
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> test2 [
+	self parse: self file2.
+
+	self assert: result simpleName = 'Foo'.
+	self assert: result methodDeclarations size = 2.
+	
+	self assert: result methodDeclarations first simpleName = 'methodA'.
+	self assert: result methodDeclarations second simpleName = 'methodB'.	
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> test3 [
+	self parse: self file3.
+
+	self assert: result simpleName = 'Foo'.
+	self assert: result methodDeclarations size = 2.
+	
+	self assert: result methodDeclarations first simpleName = 'methodA'.
+	self assert: result methodDeclarations second simpleName = 'methodB'.	
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> test4 [
+	self parse: self file4.
+
+	self assert: result simpleName = 'Class'.
+	self assert: result methodDeclarations size = 2.
+	
+	self assert: (result methodDeclarations anySatisfy: [ :e | e simpleName = 'registerNatives' ]).
+	self assert: (result methodDeclarations anySatisfy: [ :e | e simpleName = 'toString' ]).
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> test5 [
+	self parse: self file5.
+
+	self assert: result simpleName = 'Foo'.
+	self assert: result methodDeclarations size = 1.
+	
+	"self assert: result second first = 'Foo'."
+	self assert: result methodDeclarations first simpleName = 'toString'.	
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> test7 [
+	self parse: self file7.
+
+	self assert: result simpleName = 'Class'.
+	self assert: result methodDeclarations size = 3.
+	
+	self assert: (result methodDeclarations anySatisfy: [ :e | e simpleName = 'toString' ]).
+	self assert: (result methodDeclarations anySatisfy: [ :e | e simpleName = 'getAnnotationType' ]).
+	self assert: (result methodDeclarations anySatisfy: [ :e | e simpleName = 'registerNatives' ]).
+
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> testBlock [
+	self parse: '{}' rule: #block.
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> testBlock2 [
+	self parse: '{ }' rule: #block.
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> testBlock3 [
+	self parse: '{ {}  }' rule: #block.
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> testClass1 [
+	self parse: 'private final class Foo 
+		{
+			// I am only empty class
+		}'
+	rule: #javaClass.
+
+	self assert: result simpleName = 'Foo'.
+	self assert: result methodDeclarations size = 0.
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> testClass2 [
+	self parse: 'public class Foo<Bar> extends Zorg implements Qwark, Bark
+		{
+			// I am only empty class
+		}' 
+	rule: #javaClass.
+
+	self assert: result simpleName = 'Foo'.
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> testClass3 [
+	self parse: 'private class Bar<T> extends Zorg implements Qwark, Bark
+		{
+			public static void methodA() { /* is empty */ }
+		}' 
+	rule: #javaClass.
+
+	self assert: result simpleName = 'Bar'.
+	self assert: result methodDeclarations first simpleName = 'methodA'.
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody1 [
+	self parse: '{
+		// some comment
+		public void methodA() 
+		{ 
+		}
+	}' 
+	rule: #classBody.
+
+	self assert: result first returnType = 'void'.	
+	self assert: result first simpleName = 'methodA'.
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody10 [
+	self parse: '{
+    private static final int SKIP_BUFFER_SIZE = 2048;
+   	 public int read(byte b[]) throws IOException {
+		return read(b, 0, b.length);
+    }
+}' 
+	rule: #classBody.
+	
+	self assert: result isPetitFailure not.
+	self assert: result size = 1.
+	self assert: result first simpleName = 'read'.
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody11 [
+	self parse: '{
+    void foo() { {}}
+    void bar() { }
+}' 
+	rule: #classBody.
+	
+	self assert: result isPetitFailure not.
+	self assert: result size = 2.
+	self assert: result first simpleName = 'foo'.
+	self assert: result second simpleName  = 'bar'.	
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody12 [
+	self parse: '{
+    public boolean addAll(int index, Collection<? extends E> c) {
+    }	
+   
+	 public Iterator<E> iterator() {
+        return listIterator();
+    }	 
+}' 
+	rule: #classBody.
+	
+	self assert: result isPetitFailure not.
+	self assert: result first simpleName = 'addAll'.
+	self assert: result second simpleName = 'iterator'.
+
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody13 [
+	self parse: '{
+			class A { 
+        		void bar() {}
+			}
+			
+			void baz() {}
+		}' 
+	rule: #classBody.
+	
+	self assert: result isPetitFailure not.
+	self assert: result first simpleName = 'A'.
+	self assert: result first methodDeclarations first simpleName = 'bar'.
+	self assert: result second simpleName = 'baz'.
+
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody2 [
+	self parse: '{
+		// some comment
+		public void methodA() { 
+		}
+	
+		private Another methodB( )
+		{
+			return new Another();
+		}
+	}' 
+	rule: #classBody.
+	
+	self assert: result first simpleName = 'methodA'.
+	self assert: result second simpleName = 'methodB'.	
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody3 [
+	self parse: '{
+		// some comment
+	
+		public void methodA() {
+			System.out.println();
+		}
+	
+		/**
+		 *
+		 */
+		public Bar methodB(Some argument, and another)
+		{
+			return new Bar();
+		}
+	}' 
+	rule: #classBody.
+	
+	self assert: result first simpleName = 'methodA'.
+	self assert: result second simpleName = 'methodB'.	
+	self assert: result second returnType = 'Bar'.
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody4 [
+	self parse: '{
+		public void methodA() {
+			System.out.println();
+		}
+		private InnerClass { }
+	
+		public Bar methodB(Some argument, and another)
+		{
+			return new Bar();
+		}
+	}' 
+	rule: #classBody.
+	
+	self assert: result first simpleName = 'methodA'.
+	self assert: result second simpleName = 'methodB'.	
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody5 [
+	self parse: '{
+	// I am only empty class
+}' 
+	rule: #classBody.
+	
+	self assert: result size = 0.
+
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody6 [
+	self parse: '{
+		static { int i; }
+}' 
+	rule: #classBody.
+	
+	
+	self assert: result size = 0.
+
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody7 [
+	self parse: '{
+		static { int i; }
+		
+		public String[] getStrings() {  }
+}' 
+	rule: #classBody.
+	
+	
+	self assert: result size = 1.
+	self assert: result first simpleName = 'getStrings'.
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody8 [
+	self parse: '{
+		private static final int ANNOTATION= 0x00002000;
+		static { int i; }
+		
+		public String[] getStrings() {  }
+}' 
+	rule: #classBody.
+	
+	
+	self assert: result size = 1.
+	self assert: result first simpleName = 'getStrings'.
+
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassBody9 [
+	self parse: '{
+	 private static final int ANNOTATION= 0x00002000;
+   
+    private static native void registerNatives();
+    static {
+        registerNatives();
+    }
+
+    public String toString() {
+        return (isInterface() ? "interface " : (isPrimitive() ? "" : "class "))
+            + getName();
+    }
+}' 
+	rule: #classBody.
+	
+	"debugResult inspect."
+	self assert: result isPetitFailure not.
+	self assert: result first simpleName = 'registerNatives'.
+	self assert: result second simpleName = 'toString'.
+
+]
+
+{ #category : 'tests - class' }
+PPJavaSeaParserTest >> testClassDef1 [
+	self parse: 'public class Foo' rule: #classDef
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> testComment [
+	| input  |
+	input := '/* hello there */'.
+	self parse: input rule: #comment
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> testComment2 [
+	| input  |
+	input := '/**
+     * <p> If the {@code name} is "{@code <init>};"or "{@code <clinit>}" a
+     * @since JDK1.1
+     */'.
+
+	self parse: input rule: #comment
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod1 [
+	self parse: 'void foo() { }' rule: #methodDef.
+	
+	self assert: result simpleName = 'foo'.
+	self assert: result returnType = 'void'.
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod10 [
+	self parse: 'public void foo () { 
+	}' rule: #methodDef.
+
+	self assert: result simpleName = 'foo'.
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod11 [
+	self parse: 'public void foo_bar () { 
+	}' rule: #methodDef.
+
+	self assert: result simpleName = 'foo_bar'.
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod12 [
+	self parse: 'public void _bar () { 
+	}' rule: #methodDef.
+
+	self assert: result simpleName = '_bar'.
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod2 [
+	self parse: 'Foo m() { /** method body */ }' rule: #methodDef.
+	
+	self assert: result simpleName = 'm'.
+	self assert: result returnType = 'Foo'.
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod3 [
+	self parse: 'Bar methodB(Some argument, and another)
+		{
+			return new Bar();
+		}'
+	rule: #methodDef.
+	
+	self assert: result simpleName = 'methodB'.
+	self assert: result returnType = 'Bar'.
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod4 [
+	self parse: 'void finalize() throws Throwable { }'
+	rule: #methodDef.
+	
+	self assert: result simpleName = 'finalize'.
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod5 [
+	self parse: 'public void methodA() 
+		{ 
+		}' 
+	rule: #methodDef.
+	
+	self assert: result simpleName = 'methodA'.
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod6 [
+	self fail: 'private InnerClass {  }
+	
+	   public void methodA() 
+		{ 
+		}' 
+	rule: #methodDef.
+	
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod7 [
+	self parse: 'public int read(byte b) throws IOException {
+		return b;
+    }' 
+	rule: #methodDef.
+	
+	self assert: result isPetitFailure not.
+	self assert: result simpleName = 'read'.
+	self assert: result returnType = 'int'.	
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod8 [
+	"type is missing"
+	self fail: 'private Class() {}' rule: #methodDef.
+]
+
+{ #category : 'tests - method' }
+PPJavaSeaParserTest >> testMethod9 [
+	self parse: 'public void foo() { if (true) {} return false;}' rule: #methodDef.
+
+	self assert: result simpleName = 'foo'.
+]
+
+{ #category : 'tests - nested class' }
+PPJavaSeaParserTest >> testNestedClass1 [
+	self parse: 'private final class Foo 
+		{
+			public void foo() {  }
+			
+			class Bar { 
+				public void bar() { }
+			}
+		}'
+	rule: #javaClass.
+
+	self assert: result simpleName = 'Foo'.
+	self assert: result methodDeclarations size = 2.
+	self assert: result methodDeclarations first simpleName = 'foo'.
+	self assert: result methodDeclarations second simpleName = 'Bar'.
+	self assert: result methodDeclarations second methodDeclarations first simpleName = 'bar'.
+]
+
+{ #category : 'tests - nested class' }
+PPJavaSeaParserTest >> testNestedClass2 [
+	self parse: 'class Foo 
+		{
+			private class Entry {
+        		private void bar() {
+       		}
+			}
+			
+			public void baz() {  }
+		}'
+	rule: #javaClass.
+
+	self assert: result simpleName = 'Foo'.
+	self assert: result methodDeclarations size = 2.
+
+	self assert: result methodDeclarations first simpleName = 'Entry'.
+	self assert: result methodDeclarations first methodDeclarations first simpleName = 'bar'.
+	self assert: result methodDeclarations second simpleName = 'baz'.
+]
+
+{ #category : 'tests' }
+PPJavaSeaParserTest >> testSingleLineComment [
+	| input  |
+	input := '// hello there
+'.
+	self parse: input rule: #singleLineComment.
+]
diff --git a/software/petitislands/PPListParser.extension.st b/software/petitislands/PPListParser.extension.st
new file mode 100644
index 0000000..f4727af
--- /dev/null
+++ b/software/petitislands/PPListParser.extension.st
@@ -0,0 +1,11 @@
+Extension { #name : 'PPListParser' }
+
+{ #category : '*petitislands' }
+PPListParser >> acceptsEpsilon [
+	^ self acceptsEpsilonOpenSet: IdentitySet new.
+]
+
+{ #category : '*petitislands' }
+PPListParser >> isIslandBorder [
+	^ self isIslandBorderOpenSet: IdentitySet new
+]
diff --git a/software/petitislands/PPLiteralParser.extension.st b/software/petitislands/PPLiteralParser.extension.st
new file mode 100644
index 0000000..a35d207
--- /dev/null
+++ b/software/petitislands/PPLiteralParser.extension.st
@@ -0,0 +1,11 @@
+Extension { #name : 'PPLiteralParser' }
+
+{ #category : '*petitislands' }
+PPLiteralParser >> acceptsEpsilon [
+	^ false
+]
+
+{ #category : '*petitislands' }
+PPLiteralParser >> isIslandBorder [
+	^ true
+]
diff --git a/software/petitislands/PPMemoizingSea.class.st b/software/petitislands/PPMemoizingSea.class.st
new file mode 100644
index 0000000..291d749
--- /dev/null
+++ b/software/petitislands/PPMemoizingSea.class.st
@@ -0,0 +1,94 @@
+"
+A PPMemoizingIsland is memoized version of PPIsland. Use this one, unless you don't mind really bad performance. If the memoized version is not working flawlessly, its a bug!
+
+Please see help of the PPIsland for how to use...
+
+Instance Variables
+	memoizationDictionaries:		<Object>
+	rootParser:		<Object>
+
+memoizationDictionaries
+	- memoization cache
+
+rootParser
+	- used for memoizing, once the root changes, flushes the caches
+
+"
+Class {
+	#name : 'PPMemoizingSea',
+	#superclass : 'PPSea',
+	#instVars : [
+		'dictionary'
+	],
+	#category : 'PetitIslands-Parsers'
+}
+
+{ #category : 'as yet unclassified' }
+PPMemoizingSea class >> initialize [ 
+	super initialize 
+
+]
+
+{ #category : 'memoization' }
+PPMemoizingSea >> memoizeResult: result onContext: aPPContext memento: ctxMemento [
+	| memento |
+	memento := PPMemento new.
+	memento contextMemento: aPPContext remember.
+	memento result: result.
+	
+	dictionary at: ctxMemento put: memento.
+	
+"	memoizedPositions at: (ctxMemento position + 1) put: true."
+]
+
+{ #category : 'converting' }
+PPMemoizingSea >> memoized [
+	"We have our own implementation of memoization"
+	^ self
+]
+
+{ #category : 'memoization' }
+PPMemoizingSea >> memoizedResult: aPPContext [
+"	(memoizedPositions at: aPPContext position + 1) isNil ifTrue: [ ^ nil ]."
+	^ dictionary at: (aPPContext remember) ifAbsent: nil .
+	
+]
+
+{ #category : 'converting' }
+PPMemoizingSea >> nonMemoized [ 
+	^ PPSea new
+		island: island;
+		yourself
+]
+
+{ #category : 'parsing' }
+PPMemoizingSea >> parseOn: aPPContext [ 
+	|  memoizedResult retval memento |
+	self check: aPPContext.
+	
+	memoizedResult := self memoizedResult: aPPContext.
+	memoizedResult ifNotNil: [ 
+		aPPContext islandMemoHit.
+		aPPContext restore: memoizedResult contextMemento.
+		^ memoizedResult result 
+	].
+	memento := aPPContext remember.
+	
+	retval := super parseOn: aPPContext.
+
+	(aPPContext waterPosition == aPPContext position) ifFalse: [ 
+		aPPContext islandMemoized.
+		self memoizeResult: retval onContext: aPPContext memento: memento.
+	].
+
+	^ retval.
+
+
+]
+
+{ #category : 'initialization' }
+PPMemoizingSea >> reset: aPPContext [
+	super reset: aPPContext.
+	dictionary := Dictionary new.
+	"memoizedPositions := Array new: aPPContext size + 1."
+]
diff --git a/software/petitislands/PPMemoizingSeaTest.class.st b/software/petitislands/PPMemoizingSeaTest.class.st
new file mode 100644
index 0000000..c70880c
--- /dev/null
+++ b/software/petitislands/PPMemoizingSeaTest.class.st
@@ -0,0 +1,29 @@
+Class {
+	#name : 'PPMemoizingSeaTest',
+	#superclass : 'PPSeaTest',
+	#category : 'PetitIslands-Tests'
+}
+
+{ #category : 'as yet unclassified' }
+PPMemoizingSeaTest class >> shouldInheritSelectors [ 
+	^ true.
+]
+
+{ #category : 'as yet unclassified' }
+PPMemoizingSeaTest >> seaClass [
+	^ PPMemoizingSea 
+]
+
+{ #category : 'testing' }
+PPMemoizingSeaTest >> testMemo [
+	| parser  result1 result2 input |
+	
+	parser := self sea: ('class' asParser, self identifier, 'endclass' asParser).
+	input := 'class Foo endclass' asPetitStream.
+	
+	context := PPContext new.
+	
+	result1 :=  parser parse: input withContext: context.
+	result2 := parser parse: input withContext: context.
+	self assert: (result1 == result2 ).
+]
diff --git a/software/petitislands/PPNonEmptyParser.class.st b/software/petitislands/PPNonEmptyParser.class.st
new file mode 100644
index 0000000..f1a4060
--- /dev/null
+++ b/software/petitislands/PPNonEmptyParser.class.st
@@ -0,0 +1,37 @@
+"
+I return failure, if the delegate parser did not consumed any input.
+"
+Class {
+	#name : 'PPNonEmptyParser',
+	#superclass : 'PPDelegateParser',
+	#category : 'PetitIslands-Parsers'
+}
+
+{ #category : '*petitislands' }
+PPNonEmptyParser >> acceptsEpsilon [
+	^ false
+]
+
+{ #category : 'analysis' }
+PPNonEmptyParser >> isNullable [
+	^ false
+]
+
+{ #category : 'parsing' }
+PPNonEmptyParser >> nonEmpty [
+	^ self
+]
+
+{ #category : 'parsing' }
+PPNonEmptyParser >> parseOn: aPPContext [
+	| memento result |
+	memento := aPPContext remember.
+	result := parser parseOn: aPPContext.
+	
+
+	((memento position == aPPContext position) and: [ result isPetitFailure not ]) ifTrue: [ 
+		aPPContext restore: memento.
+		^ PPFailure message: 'Epsilon parse not allowed' context: aPPContext
+	].
+	^ result
+]
diff --git a/software/petitislands/PPNonEmptyParser.extension.st b/software/petitislands/PPNonEmptyParser.extension.st
new file mode 100644
index 0000000..4911eca
--- /dev/null
+++ b/software/petitislands/PPNonEmptyParser.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'PPNonEmptyParser' }
+
+{ #category : '*petitislands' }
+PPNonEmptyParser >> acceptsEpsilon [
+	^ false
+]
diff --git a/software/petitislands/PPOffsideOLParser.extension.st b/software/petitislands/PPOffsideOLParser.extension.st
new file mode 100644
index 0000000..dbd80b7
--- /dev/null
+++ b/software/petitislands/PPOffsideOLParser.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'PPOffsideOLParser' }
+
+{ #category : '*petitislands' }
+PPOffsideOLParser >> isIslandBorder [
+	^ false
+]
diff --git a/software/petitislands/PPOnsideOLParser.extension.st b/software/petitislands/PPOnsideOLParser.extension.st
new file mode 100644
index 0000000..8079750
--- /dev/null
+++ b/software/petitislands/PPOnsideOLParser.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'PPOnsideOLParser' }
+
+{ #category : '*petitislands' }
+PPOnsideOLParser >> isIslandBorder [
+	^ false
+]
diff --git a/software/petitislands/PPOptionalParser.extension.st b/software/petitislands/PPOptionalParser.extension.st
new file mode 100644
index 0000000..3a4681e
--- /dev/null
+++ b/software/petitislands/PPOptionalParser.extension.st
@@ -0,0 +1,21 @@
+Extension { #name : 'PPOptionalParser' }
+
+{ #category : '*petitislands' }
+PPOptionalParser >> acceptsEpsilon [
+	^ true
+]
+
+{ #category : '*petitislands' }
+PPOptionalParser >> acceptsEpsilonOpenSet: set [
+	^ true
+]
+
+{ #category : '*petitislands' }
+PPOptionalParser >> isIslandBorder [
+	^ false
+]
+
+{ #category : '*petitislands' }
+PPOptionalParser >> isIslandBorderOpenSet: set [
+	^ false
+]
diff --git a/software/petitislands/PPParser.extension.st b/software/petitislands/PPParser.extension.st
new file mode 100644
index 0000000..2a584c8
--- /dev/null
+++ b/software/petitislands/PPParser.extension.st
@@ -0,0 +1,130 @@
+Extension { #name : 'PPParser' }
+
+{ #category : '*petitislands' }
+PPParser >> acceptsEpsilon [
+	"
+		return true, if parser can accepts epsilon without a failure.
+		
+		Use #neverFails if parser never fail, no matter what is the input.
+		The #isNullable semantics is a mystery for me. I think it is something 
+		like acceptsEpsilon and is used for first/set computation.
+	"
+	^ self subclassResponsibility
+]
+
+{ #category : '*petitislands' }
+PPParser >> acceptsEpsilonOpenSet: set [
+	"private helper for acceptsEmpsilon that makes sure to avoid cycles (using open set)"
+	self children isEmpty ifTrue: [ ^ self acceptsEpsilon ].
+	
+	self shouldBeImplemented .
+]
+
+{ #category : '*petitislands' }
+PPParser >> isIslandBorder [
+	^ self subclassResponsibility
+]
+
+{ #category : '*petitislands' }
+PPParser >> isIslandBorderOpenSet: set [
+	"private helper for acceptsEmpsilon that makes sure to avoid cycles (using open set)"
+	self children isEmpty ifTrue: [ ^ self isIslandBorder ].
+	
+	self shouldBeImplemented .
+]
+
+{ #category : '*petitislands' }
+PPParser >> isWater [
+	^ false
+]
+
+{ #category : '*petitislands' }
+PPParser >> island [
+	self halt: 'deprecated'.
+	^ self sea
+]
+
+{ #category : '*petitislands' }
+PPParser >> island: water [
+	self halt: 'deprecated'.
+	^ self sea: water
+]
+
+{ #category : '*petitislands' }
+PPParser >> next: context [
+	^ PPChoiceParser withAll: (self nextSet: context)
+]
+
+{ #category : '*petitislands' }
+PPParser >> nextSet: aPPContext [
+	^ aPPContext root nextSets at: self.
+]
+
+{ #category : '*petitislands' }
+PPParser >> nextSets [
+	| nextSets |
+	
+	nextSets := IdentityDictionary new.
+	self allParsersDo: [ :each | nextSets at: each put: IdentitySet new ].
+	
+	(nextSets at: self) add: PPSentinel instance.
+	
+	[ 	| changed |
+		changed := false.
+	
+		nextSets keysAndValuesDo: [:parser :next |
+			changed := (parser 
+				nextSets: nextSets
+				into: next) or: [ changed ].
+		].
+		changed ] whileTrue.
+	
+	^ nextSets
+]
+
+{ #category : '*petitislands' }
+PPParser >> nextSets: aNextDictionary into: aSet [
+	"return true/false, if something has changed or not...."
+	| childSet change tally |
+	
+	change := false.
+
+	self children do: [:each | 
+		childSet := aNextDictionary at: each.
+		tally := childSet size.
+		childSet addAll: aSet.
+		change := change or: [ tally ~= childSet size ].
+	].
+
+	^ change
+	
+]
+
+{ #category : '*petitislands' }
+PPParser >> nonEmpty [
+	^ PPNonEmptyParser on: self
+]
+
+{ #category : '*petitislands' }
+PPParser >> previous [
+	^ PPPreviousParser on: self
+]
+
+{ #category : '*petitislands' }
+PPParser >> sea [
+	| island |
+	island := PPSea new
+		island: self;
+		yourself.
+		
+	^ island memoized
+
+]
+
+{ #category : '*petitislands' }
+PPParser >> sea: water [
+	^ self sea
+		water: water;
+		yourself
+
+]
diff --git a/software/petitislands/PPPluggableParser.extension.st b/software/petitislands/PPPluggableParser.extension.st
new file mode 100644
index 0000000..7e5abb9
--- /dev/null
+++ b/software/petitislands/PPPluggableParser.extension.st
@@ -0,0 +1,16 @@
+Extension { #name : 'PPPluggableParser' }
+
+{ #category : '*petitislands' }
+PPPluggableParser >> acceptsEpsilon [
+	^ true
+]
+
+{ #category : '*petitislands' }
+PPPluggableParser >> acceptsEpsilonOpenSet: set [
+	^ true
+]
+
+{ #category : '*petitislands' }
+PPPluggableParser >> isIslandBorder [
+	^ false
+]
diff --git a/software/petitislands/PPPopParser.extension.st b/software/petitislands/PPPopParser.extension.st
new file mode 100644
index 0000000..5e21776
--- /dev/null
+++ b/software/petitislands/PPPopParser.extension.st
@@ -0,0 +1,11 @@
+Extension { #name : 'PPPopParser' }
+
+{ #category : '*petitislands' }
+PPPopParser >> acceptsEpsilon [
+	^ true
+]
+
+{ #category : '*petitislands' }
+PPPopParser >> isIslandBorder [
+	^ false
+]
diff --git a/software/petitislands/PPPredicateParser.extension.st b/software/petitislands/PPPredicateParser.extension.st
new file mode 100644
index 0000000..67c6117
--- /dev/null
+++ b/software/petitislands/PPPredicateParser.extension.st
@@ -0,0 +1,11 @@
+Extension { #name : 'PPPredicateParser' }
+
+{ #category : '*petitislands' }
+PPPredicateParser >> acceptsEpsilon [
+	^ false
+]
+
+{ #category : '*petitislands' }
+PPPredicateParser >> isIslandBorder [
+	^ true
+]
diff --git a/software/petitislands/PPPreviousParser.class.st b/software/petitislands/PPPreviousParser.class.st
new file mode 100644
index 0000000..8823dc9
--- /dev/null
+++ b/software/petitislands/PPPreviousParser.class.st
@@ -0,0 +1,19 @@
+Class {
+	#name : 'PPPreviousParser',
+	#superclass : 'PPDelegateParser',
+	#category : 'PetitIslands-Extras'
+}
+
+{ #category : 'parsing' }
+PPPreviousParser >> parseOn: aPPContext [
+	| result position |
+	(aPPContext position > 0) ifTrue: [  
+		position := aPPContext position.
+		aPPContext back.
+		result := parser parseOn: aPPContext.
+		aPPContext position: position.
+		^ result
+	].
+	^ PPFailure message: 'At the beginning of a stream' at: 0
+	
+]
diff --git a/software/petitislands/PPRepeatingParser.extension.st b/software/petitislands/PPRepeatingParser.extension.st
new file mode 100644
index 0000000..f5f6fb9
--- /dev/null
+++ b/software/petitislands/PPRepeatingParser.extension.st
@@ -0,0 +1,28 @@
+Extension { #name : 'PPRepeatingParser' }
+
+{ #category : '*petitislands' }
+PPRepeatingParser >> acceptsEpsilon [
+	^ min == 0
+]
+
+{ #category : '*petitislands' }
+PPRepeatingParser >> isIslandBorder [
+	^ min > 0
+]
+
+{ #category : '*petitislands' }
+PPRepeatingParser >> isIslandBorderOpenSet: set [
+	^ min > 0
+]
+
+{ #category : '*petitislands' }
+PPRepeatingParser >> nextSets: aNextDictionary into: aSet [
+	| tally childSet change |
+
+	change := super nextSets: aNextDictionary  into: aSet.
+
+	childSet := aNextDictionary at: parser.
+	tally := aSet size.
+	childSet add: parser.
+	^ change or: [ tally ~= aSet size ].
+]
diff --git a/software/petitislands/PPRobustXmlFeedParser.class.st b/software/petitislands/PPRobustXmlFeedParser.class.st
new file mode 100644
index 0000000..27bcefb
--- /dev/null
+++ b/software/petitislands/PPRobustXmlFeedParser.class.st
@@ -0,0 +1,14 @@
+"
+A RobustXmlFeedParser is XmlFeedParser, that can handle error within an xml Item element. This is thanks to the fact, that elements in item are defined as islands (see rule itemContent).
+
+"
+Class {
+	#name : 'PPRobustXmlFeedParser',
+	#superclass : 'PPXmlFeedParser',
+	#category : 'PetitIslands-Examples'
+}
+
+{ #category : 'as yet unclassified' }
+PPRobustXmlFeedParser >> itemContent [
+	^ ((simpleElement sea ==> #second) star) ==> self elementsToDictionaryBlock
+]
diff --git a/software/petitislands/PPRobustXmlFeedParserTest.class.st b/software/petitislands/PPRobustXmlFeedParserTest.class.st
new file mode 100644
index 0000000..4883ddd
--- /dev/null
+++ b/software/petitislands/PPRobustXmlFeedParserTest.class.st
@@ -0,0 +1,59 @@
+Class {
+	#name : 'PPRobustXmlFeedParserTest',
+	#superclass : 'PPCompositeParserTest',
+	#category : 'PetitIslands-Examples'
+}
+
+{ #category : 'as yet unclassified' }
+PPRobustXmlFeedParserTest >> feed03 [
+^'
+<shoplist>
+<name>ABC Shop</name>
+<address>Here and there 123, 123 45 Somewhere</address>
+<item>
+  <name>socks</name>
+  <price>123</price>
+  <availability>1</availability>
+</item>
+
+
+<item>
+  <name> shoes </name>
+  <price>2345</price>
+  <!-- this one is malformed -->
+  <availability>1 </
+</item>
+
+<item>
+  <name> shoes </name>
+  <price>3456</price>
+  <availability>0</availability>
+</item>
+
+
+</shoplist>
+'
+]
+
+{ #category : 'as yet unclassified' }
+PPRobustXmlFeedParserTest >> parserClass [
+	^ PPRobustXmlFeedParser 
+]
+
+{ #category : 'as yet unclassified' }
+PPRobustXmlFeedParserTest >> testXmlFeed03 [
+	self parse: self feed03.
+	
+	self assert: result size = 3.
+	self assert: (result first at:#name) = 'socks'.
+	self assert: (result first at:#price) = '123'.
+	self assert: (result first at:#availability) = '1'.
+
+	self assert: (result second at:#name) = 'shoes'.
+	self assert: (result second at:#price) = '2345'.
+	
+	self assert: (result third at:#name) = 'shoes'.
+	self assert: (result third at:#price) = '3456'.
+	self assert: (result third at:#availability) = '0'.
+
+]
diff --git a/software/petitislands/PPRubySeaGrammar.class.st b/software/petitislands/PPRubySeaGrammar.class.st
new file mode 100644
index 0000000..0595a31
--- /dev/null
+++ b/software/petitislands/PPRubySeaGrammar.class.st
@@ -0,0 +1,352 @@
+"
+I can recognize basic structure block in ruby code (almost precisely).
+
+I use indentation to determine the scope of the block. I use island to skip the rest.
+
+The following structures are recognized:
+- modules
+- classes
+- methods
+"
+Class {
+	#name : 'PPRubySeaGrammar',
+	#superclass : 'PPCompositeParser',
+	#instVars : [
+		'primary',
+		'kClassIS',
+		'cpath',
+		'superclass',
+		'identifier',
+		'kSelf',
+		'word',
+		'fname',
+		'classDef',
+		'methodDef',
+		'primaryElement',
+		'water',
+		'operator',
+		'program',
+		'kDefIS',
+		'defEndIS',
+		'kModuleIS',
+		'moduleDef',
+		'eigenDef',
+		'body',
+		'kEndIS',
+		'kEnd',
+		'comment',
+		'string',
+		'aligns',
+		'nl',
+		'setIl',
+		'onside',
+		'restoreIl',
+		'sol',
+		'eol',
+		'eof',
+		'onsideLine'
+	],
+	#category : 'PetitIslands-Examples'
+}
+
+{ #category : 'indentation' }
+PPRubySeaGrammar >> aligns [
+	^ [:context |
+		(context column == (context indentStack topIfEmpty: -1)) ifTrue: [ 
+			#aligns
+		] ifFalse: [
+			PPFailure message: 'no alignment' at: context position
+		]
+	] asParser
+		"JK: this is a hack, it improves the speed of compiled parser"
+		propertyAt: #changesContext put: false;
+		yourself
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> body [
+	^	((((primaryElement) sea: water) ==> #second) plus) 
+			==> [ :args | args select: [ :e | e isEmpty not ]]
+	/
+		((nil asParser sea: water) ==> [ :args | #() ])
+]
+
+{ #category : 'grammar - class' }
+PPRubySeaGrammar >> classDef [
+	"Indentation Sensitive Class Definition"
+	^ kClassIS, 
+		cpath trim, 
+		superclass optional, 
+		body, 
+		kEndIS
+	
+	
+	map: [ :cl :cp :sup :content :end | 
+		| retval |
+		retval := OrderedCollection new.
+		content do: [ :m |
+			retval addAll: (m collect: [:e | '::', cp, e ]).
+		].
+		retval.
+	]
+]
+
+{ #category : 'whitespaces' }
+PPRubySeaGrammar >> comment [
+	^ $# asParser trimBlanks, (nl negate star), nl
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> cpath [
+	^ ('::' asParser optional , identifier, (('::' asParser , identifier) star)) flatten
+]
+
+{ #category : 'grammar - method' }
+PPRubySeaGrammar >> defEndIS [
+	"End of Indentation Sensitive Feature"
+	^ kEnd optional, restoreIl
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> eigenDef [
+	^ kClassIS , '<<' asParser trim , (identifier / kSelf) , 
+		body, 
+		kEndIS 
+	
+	map: [ :class :tmp :ref :content :end |
+		| retval |
+		retval := OrderedCollection new.
+		content do: [ :m |
+			retval addAll: (m collect: [:e | '.', ref, e ]).
+		].
+		retval.		
+	]
+
+]
+
+{ #category : 'whitespaces' }
+PPRubySeaGrammar >> eof [
+	^ #eof asParser
+]
+
+{ #category : 'whitespaces' }
+PPRubySeaGrammar >> eol [
+	^ nl / eof
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> fname [
+	^ (operator / 
+		'..' asParser / '|' asParser / 'ˆ' asParser / '&' asParser 
+		/ '<=>' asParser / '==' asParser / 
+		'===' asParser / '=~' asParser / '>'asParser / '>='asParser / '<' asParser / 
+		'<=' asParser / '+' asParser / '-' asParser / 
+		'*' asParser / '/' asParser /	'%' asParser / '**' asParser / '<<' asParser / 
+		'>>' asParser / '~' asParser / '+@' asParser / 
+		'-@' asParser / '[]' asParser / '[]=' asParser)
+
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> identifier [
+	^ (#letter asParser / $_ asParser, word star) flatten
+]
+
+{ #category : 'keywords' }
+PPRubySeaGrammar >> kClassIS [
+	^ (($. asParser / word) previous not, setIl, 'class' asParser , ($. asParser / word) not) ==> #third
+]
+
+{ #category : 'keywords' }
+PPRubySeaGrammar >> kDefIS [
+	^ (word previous not, setIl, 'def' asParser , word not) ==> #third
+]
+
+{ #category : 'keywords' }
+PPRubySeaGrammar >> kEnd [
+	^ (word previous not, 'end' asParser , word not) ==> #second
+]
+
+{ #category : 'keywords' }
+PPRubySeaGrammar >> kEndIS [
+	"End of Indentation Sensitive Feature"
+	^ aligns, kEnd, restoreIl
+]
+
+{ #category : 'keywords' }
+PPRubySeaGrammar >> kModuleIS [
+	^ (word previous not, setIl, 'module' asParser , word not) trim ==> #third
+]
+
+{ #category : 'keywords' }
+PPRubySeaGrammar >> kSelf [
+	^ (($. asParser / word) previous not, 'self' asParser , ($. asParser / word) not) trim ==> #second
+]
+
+{ #category : 'whitespaces' }
+PPRubySeaGrammar >> line [
+	^ (sol, nl negate star, eol) nonEmpty
+]
+
+{ #category : 'grammar - method' }
+PPRubySeaGrammar >> methodDef [
+	^ kDefIS, 
+		('self.' asParser / (identifier, $. asParser)) flatten trim optional ,
+		fname trim, 
+		primary,
+	  	defEndIS 
+	
+	map: [ :def :static :name :content :end |
+		| mName retval |
+		mName := static isNil 	ifTrue: [ '.', name ]
+										ifFalse: [ '.', static, name ].
+
+		retval := OrderedCollection new.
+		content do: [ :e | retval addAll: (e collect: [ :e2 | mName, e2 ]) ].
+		retval add: mName.
+		retval										
+	]
+
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> moduleDef [
+	"Indentation Sensitive Class Definition"
+	^ kModuleIS, 
+		cpath trim, 
+		body, 
+		kEndIS
+	
+	
+	map: [ :module :cp :prim :end | 
+		| retval |
+		retval := OrderedCollection new.
+		prim do: [ :m |
+			retval addAll: (m collect: [:e | '::', cp, e ]).
+		].
+		retval.
+	]
+]
+
+{ #category : 'whitespaces' }
+PPRubySeaGrammar >> nl [
+	^ #newline asParser
+]
+
+{ #category : 'indentation' }
+PPRubySeaGrammar >> onside [
+	^ [:context |
+		(context column >= (context indentStack topIfEmpty: -1)) ifTrue: [ 
+			#onside
+		] ifFalse: [
+			PPFailure message: 'offside position, not onside :(' at: context position
+		]
+	] asParser
+		"JK: this is a hack, it improves the speed of compiled parser"
+		propertyAt: #changesContext put: false;
+		yourself
+]
+
+{ #category : 'whitespaces' }
+PPRubySeaGrammar >> onsideLine [
+	^ onside, #letter asParser, nl asParser negate star, eol
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> operator [
+	^ (identifier , ($? asParser / $! asParser / $= asParser) optional) flatten
+
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> primary [
+	^	((((primaryElement) sea: water) ==> #second) plus) 
+			==> [ :args | args select: [ :e | e isEmpty not ]]
+	/
+		((nil asParser sea: water) ==> [ :args | #() ])
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> primaryElement [
+	^ onside, 
+		(classDef /
+		moduleDef /
+		eigenDef /
+		methodDef)
+	==> #second
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> program [
+	^ primary ==> [ :res | 
+		res flatten 
+	]
+]
+
+{ #category : 'indentation' }
+PPRubySeaGrammar >> restoreIl [
+	^ [ :context | context indentStack pop ] asParser
+		"JK: this is a hack, it improves the speed of compiled parser"
+		propertyAt: #indentPop put: true;
+		yourself
+]
+
+{ #category : 'indentation' }
+PPRubySeaGrammar >> setIl [
+	^ [:context |
+		| level |
+		level := context column.
+		context indentStack push: level.
+	] asParser
+		"JK: this is a hack, it improves the speed of compiled parser"
+		propertyAt: #indentPush put: true;
+		yourself
+]
+
+{ #category : 'whitespaces' }
+PPRubySeaGrammar >> sol [
+	^ #startOfLine asParser
+]
+
+{ #category : 'accessing' }
+PPRubySeaGrammar >> start [
+	^ program
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> string [
+	| doubleQuotes singleQuotes slash doubleString singleString regexp |
+	doubleQuotes := $" asParser.
+	singleQuotes := $' asParser.
+	slash := $/ asParser.
+	
+	doubleString := (doubleQuotes , 
+		(($\ asParser , doubleQuotes) / #any asParser starLazy: doubleQuotes) , 
+		doubleQuotes) flatten.
+		
+	singleString := (singleQuotes , 
+		(($\ asParser , singleQuotes) / #any asParser starLazy: singleQuotes) , 
+		singleQuotes) flatten.
+		
+	regexp := (slash ,
+	  (('\\' asParser) / ($\ asParser , slash) / #any asParser starLazy: slash) ,
+	  slash) flatten.
+		
+	^ (doubleString / singleString / regexp) ==> [ :nodes | #() ]
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> superclass [
+	^ (($< asParser trim , cpath) ==> #second)
+
+]
+
+{ #category : 'whitespaces' }
+PPRubySeaGrammar >> water [
+	^ (#space asParser plus) /  onsideLine  / comment "/ string / line" /  identifier / #any asParser
+]
+
+{ #category : 'grammar' }
+PPRubySeaGrammar >> word [
+	^ #word asParser / $_ asParser
+]
diff --git a/software/petitislands/PPRubySeaGrammarTest.class.st b/software/petitislands/PPRubySeaGrammarTest.class.st
new file mode 100644
index 0000000..e562f18
--- /dev/null
+++ b/software/petitislands/PPRubySeaGrammarTest.class.st
@@ -0,0 +1,372 @@
+Class {
+	#name : 'PPRubySeaGrammarTest',
+	#superclass : 'PPCompositeParserTest',
+	#category : 'PetitIslands-Examples'
+}
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> parserClass [
+	^ PPRubySeaGrammar
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testClass [
+	self parse: 
+'class Foo 
+end' rule: #classDef.
+	
+	self assert: result size = 0.
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testClass2 [
+	self parse: '
+	class Foo 
+		def bar
+		end
+	end'.
+	self assert: result size = 1.
+	self assert: result first = '::Foo.bar'.
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testClass3 [
+	self parse: '
+	class Foo 
+		def bar
+		end
+		
+		def baz
+		end
+	end'.
+	self assert: result size = 2.
+	self assert: result first = '::Foo.bar'.
+	self assert: result second = '::Foo.baz'.	
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testClass4 [
+	self parse: '
+	class Foo 
+		def bar
+		end
+		
+		some mess
+		
+		def baz
+		end
+	end'.
+	self assert: result size = 2.
+	self assert: result first = '::Foo.bar'.
+	self assert: result second = '::Foo.baz'.	
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testClass5 [
+	self parse: '
+	class Foo 
+		def bar()
+			new("with a very
+				/* and comment */ cool string over multiple lines")
+		end
+		
+		def baz
+			yet "another" string
+		end
+		
+		def bag
+		end
+	end'.
+	self assert: result size = 3.
+	self assert: result first = '::Foo.bar'.
+	self assert: result second = '::Foo.baz'.	
+	self assert: result third = '::Foo.bag'
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testClass6 [
+	"
+	The known case when the Island Indent Parser fails
+	"
+"
+	self parse: '
+module Plugins
+	class Foo 
+		class Bar < Barr; end
+		def baz()
+			if something
+				return true if whatever
+			end
+		end
+	end
+end'.
+	self assert: result size = 1.
+	self assert: result first = '::Plugins::Foo.baz'.
+"
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testDanglingEnd1 [
+	self parse: '
+	class Foo 
+		def bar
+		end
+		
+		a if b
+		
+		def baz
+		end
+	end'.
+
+	self assert: result size = 2.
+	self assert: result first = '::Foo.bar'.
+	self assert: result second = '::Foo.baz'.
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testDanglingEnd2 [
+	self parse: '
+	class Foo 
+		def bar
+		end
+		
+		if a then  b else c end
+		
+		def self.baz
+		end
+	end'.
+
+	self assert: result size = 2.
+	self assert: result first = '::Foo.bar'.
+	self assert: result second = '::Foo.self.baz'.
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testEigenClass1 [
+	self parse: '
+	class Foo 
+		def bar()
+		end
+		
+		class << self
+			def baz
+				yet "another" string
+			end
+		
+			def bag
+			end
+		end
+	end'.
+	self assert: result size = 3.
+	self assert: result first = '::Foo.bar'.
+	self assert: result second = '::Foo.self.baz'.	
+	self assert: result third = '::Foo.self.bag'
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testMethod1 [
+	self parse: 'def bar end' 
+	rule: #methodDef.
+
+	self assert: result size = 1.
+	self assert: result first = '.bar'.
+
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testMethod2 [
+	self parse: 'def self.bar 
+		1+1
+	end' rule: #methodDef.
+
+	self assert: result size = 1.
+	self assert: result first = '.self.bar'.
+
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testMethod3 [
+	self parse: 'def suspend_record
+    					UserHistory.for(a).order(''id DESC'').first
+  					 end' rule: #methodDef.
+
+	self assert: result size = 1.
+	self assert: result first = '.suspend_record'.
+
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testMethod4 [
+	self parse: 'def bar 
+end' rule: #methodDef.
+	
+	self assert: result size = 1.
+	self assert: result first = '.bar'.
+
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testMethod5 [
+	self parse: 'def bar=(val)
+end' rule: #methodDef.
+	
+	self assert: result size = 1.
+	self assert: result first = '.bar='.
+
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testMethod6 [
+	self parse: 'def self.bar end' rule: #methodDef.
+	
+	self assert: result size = 1.
+	self assert: result first = '.self.bar'.
+
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testMethod7 [
+	self parse: 'def self.[] end' rule: #methodDef.
+	
+	self assert: result size = 1.
+	self assert: result first = '.self.[]'.
+
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testMethodWithMethod1 [
+	self parse: 'def bar
+		def baz
+		end
+end' rule: #methodDef.
+	
+	self assert: result size = 2.
+	self assert: result first = '.bar.baz'.
+	self assert: result second = '.bar'.
+
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testModule [
+	self parse: '
+	module Foo 
+		def bar
+		end
+	end'.
+	self assert: result size = 1.
+	self assert: result first = '::Foo.bar'.
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testNestedClass1 [
+	self parse: '
+	class Foo 
+		def bar
+		end
+		
+		class Baz
+			def bazz
+			end
+		end
+		
+		def bazz
+		end
+		
+	end'.
+	self assert: result size = 3.
+	self assert: result first = '::Foo.bar'.
+	self assert: result second = '::Foo::Baz.bazz'.
+	self assert: result third = '::Foo.bazz'.	
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testOnsideLine [
+	self parse: 'aaa' rule: #onsideLine.
+	self fail: '  aaa' rule: #onsideLine.
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testProgram [
+	self parse: 'class Foo end'.
+	self assert: result size = 0.
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testProgram2 [
+	self parse: '
+	class Foo 
+		def bar
+		end
+		
+		def self.baz
+		end
+	end'.
+	self assert: result size = 2.
+	self assert: result first = '::Foo.bar'.
+	self assert: result second = '::Foo.self.baz'.	
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testProgram3 [
+	self parse: '
+	class Foo 
+		title = 123
+		if () end
+	
+		def bar
+		end
+	end'.
+	self assert: result size = 1.
+	self assert: result first = '::Foo.bar'.
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testProgram4 [
+	self parse: '
+	require_dependency ''post_creator''	
+	
+	class Foo 
+		title = 123
+		if () end
+	
+		def bar
+		end
+	end'.
+	self assert: result size = 1.
+	self assert: result first = '::Foo.bar'.
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testProgram5 [
+	self parse: '
+	class Foo 
+		def bar
+		end
+	end
+	
+	def baz
+	end
+	'.
+
+	self assert: result first = '::Foo.bar'.
+	self assert: result second = '.baz'.
+]
+
+{ #category : 'as yet unclassified' }
+PPRubySeaGrammarTest >> testProgram6 [
+	self parse: '
+class Bar
+   def foo	
+    [case duration
+      when a
+        created_at
+      when b
+        previous_visit_at
+      else
+        duration.minutes.ago
+      end, user_stat.new_since].max
+   end
+end'.
+	self assert: result first = '::Bar.foo'.
+
+]
diff --git a/software/petitislands/PPSea.class.st b/software/petitislands/PPSea.class.st
new file mode 100644
index 0000000..8af2db6
--- /dev/null
+++ b/software/petitislands/PPSea.class.st
@@ -0,0 +1,405 @@
+"
+A PPIsland allows for imprecise parsing. One can create it on a parser p by calling: 'p island' E.g.:
+
+p := x, a island, y              accepts following inputs:
+x.....a.....b 
+xab
+
+yet fails on:
+x....a....c
+xb
+xac
+x..b....a....b
+
+The input represented by dots is called water and water can appear before and after the island. Use it, if you don't want to define all the grammar rules and you want to skip something.
+
+I am still an experiment, but if you know how to improve me, please contact Jan Kurs at: kurs@iam.unibe.ch
+
+Instance Variables
+	afterWaterParser:		<Object>
+	awp:		<Object>
+	beforeWaterParser:		<Object>
+	bwp:		<Object>
+	context:		<Object>
+	island:		<Object>
+
+afterWaterParser
+	- xxxxx
+
+awp
+	- xxxxx
+
+beforeWaterParser
+	- xxxxx
+
+bwp
+	- xxxxx
+
+context
+	- xxxxx
+
+island
+	- xxxxx
+
+"
+Class {
+	#name : 'PPSea',
+	#superclass : 'PPParser',
+	#instVars : [
+		'island',
+		'afterWaterParser',
+		'beforeWaterParser',
+		'water',
+		'defaultBeforeWaterParser',
+		'defaultAfterWaterParser',
+		'contextIdentifier'
+	],
+	#category : 'PetitIslands-Parsers'
+}
+
+{ #category : 'queries' }
+PPSea >> acceptsEpsilon [
+	^ island acceptsEpsilon
+]
+
+{ #category : 'queries' }
+PPSea >> acceptsEpsilonOpenSet: set [
+	^ island acceptsEpsilonOpenSet: set
+]
+
+{ #category : 'parsing' }
+PPSea >> afterWaterParser: aPPContext [
+	self check: aPPContext.
+
+	afterWaterParser ifNil: [
+		afterWaterParser := self createAfterWaterParser: aPPContext.
+	].
+	^ afterWaterParser
+
+]
+
+{ #category : 'parsing' }
+PPSea >> beforeWaterParser: aPPContext [
+	self check: aPPContext.
+
+	beforeWaterParser ifNil: [
+		beforeWaterParser := self createBeforeWaterParser: aPPContext.
+	].
+	^ beforeWaterParser
+
+]
+
+{ #category : 'parsing' }
+PPSea >> check: aPPContext [
+	(contextIdentifier == aPPContext identifier) ifFalse: [ self reset: aPPContext ].
+]
+
+{ #category : 'accessing' }
+PPSea >> children [
+	self flag: 'HACK ???'.
+	(beforeWaterParser isNotNil and: [afterWaterParser isNotNil]) ifTrue: [ 
+		^ Array with: beforeWaterParser with: island with: afterWaterParser
+	].
+ 	^ Array with: water with: island with: water
+
+]
+
+{ #category : 'parsing' }
+PPSea >> createAfterWaterParser: aPPContext [
+	^ self createAfterWaterParserFromNextSet: (self nextSet: aPPContext).
+]
+
+{ #category : 'parsing' }
+PPSea >> createAfterWaterParserFromNextSet: nextSet [
+	| set p |
+	set := nextSet copy.
+	set := self filterOutNextSet: set.
+
+	(set anySatisfy: [ :e | e acceptsEpsilon  ]) ifTrue: [ 
+		set := set collect: [ :e | e acceptsEpsilon ifTrue: [ e nonEmpty ] ifFalse: [ e ]].
+		set add: PPEndOfFileParser new.
+	].
+	
+	set := set reject: [ :e | e class = PPFailingParser ].
+		
+	p := (PPChoiceParser withAll: set) and.
+	^ PPWater on: p waterToken: water
+]
+
+{ #category : 'parsing' }
+PPSea >> createBeforeWaterParser: aPPContext [
+	^ self createBeforeWaterParserFromNextSet: (self nextSet: aPPContext).
+	
+]
+
+{ #category : 'parsing' }
+PPSea >> createBeforeWaterParserFromNextSet: nextSet [
+	| set p |
+	set := nextSet copy.
+	set := self filterOutNextSet: nextSet.
+
+	set add: island.
+
+	(set anySatisfy: [ :e | e acceptsEpsilon  ]) ifTrue: [ 
+		set := set collect: [ :e | e acceptsEpsilon ifTrue: [ e nonEmpty ] ifFalse: [ e ]].
+		set add: PPEndOfFileParser new.
+	].
+	
+	set := set reject: [ :e | e class = PPFailingParser ].
+	
+	p := (PPChoiceParser withAll: set) and.
+	^ PPWater on: p waterToken: water.
+]
+
+{ #category : 'analysis' }
+PPSea >> createWaterForRoot: root [
+	| nextSet |
+	"
+		Be careful, why you call this method.
+		I guess this is usefull when only debugging island gramamrs
+	"
+	nextSet := root nextSets at: self.
+	defaultBeforeWaterParser := beforeWaterParser := self createBeforeWaterParserFromNextSet: nextSet.
+	defaultAfterWaterParser := afterWaterParser := self createAfterWaterParserFromNextSet: nextSet.
+	
+
+]
+
+{ #category : 'parsing' }
+PPSea >> exampleOn: aStream [
+	aStream nextPutAll: '~~~~ '.
+	island exampleOn: aStream .
+	aStream nextPutAll:  ' ~~~~'.
+]
+
+{ #category : 'analysis' }
+PPSea >> filterOutNextSet: nextSet [
+	| newNextSet |
+	newNextSet := nextSet.
+	"This should remove the most patological cases of exponential complexity of islands"
+	"TODO JK: this is an adhoc approach that needs better solution"
+	newNextSet := newNextSet collect: [ :e | 
+		((e isKindOf: PPSea) 
+			and: [e island == island ]) 
+				ifTrue: [ island ] 
+				ifFalse: [ e ]].
+
+	newNextSet := newNextSet collect: [ :e | 
+		((e isKindOf: PPActionParser) 
+			and: [ (e block == #second) 
+			and: [ (e child isKindOf: PPSea)  
+			and: [ e child island == island ]]]) 
+				ifTrue: [ island ] 
+				ifFalse: [ e ]].
+
+	newNextSet := newNextSet collect: [ :e | 
+		((e isKindOf: PPDelegateParser) 
+			and: [ (e child isKindOf: PPActionParser) 
+			and: [ (e child block == #second) 
+			and: [ (e child child isKindOf: PPSea)  
+			and: [ e child child island == island ]]]])
+				ifTrue: [ island ] 
+				ifFalse: [ e ]].
+
+	^ newNextSet
+]
+
+{ #category : 'analysis' }
+PPSea >> followSet: aPPContext [
+
+	^ aPPContext root followSets at: self.	
+]
+
+{ #category : 'accessing' }
+PPSea >> initialize [ 
+	super initialize.
+	water := #any asParser name: 'water'; yourself.
+
+]
+
+{ #category : 'queries' }
+PPSea >> isIslandBorder [
+	^ false
+]
+
+{ #category : 'queries' }
+PPSea >> isIslandBorderOpenSet: set [
+	^ false
+]
+
+{ #category : 'accessing' }
+PPSea >> island [
+
+	^ island
+]
+
+{ #category : 'accessing' }
+PPSea >> island: anObject [
+	island := anObject "memoized"
+]
+
+{ #category : 'memoization' }
+PPSea >> memoized [ 
+	^ PPMemoizingSea new
+		island: self island;
+		water: water;
+		yourself
+]
+
+{ #category : 'queries' }
+PPSea >> name [
+	^ super name ifNil: [ 
+		island name ifNil: ['unknown island'] ifNotNil: [ island name, ' island' ] ].
+]
+
+{ #category : 'analysis' }
+PPSea >> nextSet: aPPContext [
+	^ aPPContext root nextSets at: self.
+]
+
+{ #category : 'analysis' }
+PPSea >> nextSets: aNextDictionary into: aSet [
+	"return true/false, if something has changed or not...."
+	| islandSet change tally |
+	
+	change := false.
+	
+	"
+		I rewrite the super implementation in order not to avoid updates in the
+		before/after water (that would be unfortunate...)
+	"
+	islandSet := aNextDictionary at: island.
+	tally := islandSet size.
+	islandSet addAll: aSet.
+	change := tally ~= islandSet size.
+
+	^ change
+	
+]
+
+{ #category : 'parsing' }
+PPSea >> parseAfterWater: aPPContext [
+	^ (self afterWaterParser: aPPContext) parseOn: aPPContext .
+]
+
+{ #category : 'parsing' }
+PPSea >> parseBeforeWater: aPPContext [
+	^ (self beforeWaterParser: aPPContext) parseOn: aPPContext.
+]
+
+{ #category : 'parsing' }
+PPSea >> parseIslandOn: aPPContext [ 
+	| tmp result |
+	tmp := aPPContext waterPosition.
+	aPPContext waterPosition: aPPContext position.
+	result := island parseOn: aPPContext.
+	aPPContext waterPosition: tmp.
+
+	^ result
+
+]
+
+{ #category : 'parsing' }
+PPSea >> parseIslandOn_old: aPPContext [ 
+	|  result |
+	"Do not allow empty parses, when searching for the island..."
+	(aPPContext waterPosition == aPPContext position) ifTrue:[
+		result := island "nonEmpty" parseOn: aPPContext.
+	"But allow when boundary found"
+	] ifFalse: [
+		| tmp |
+		"
+			Oh, the thing is, if island starts with island parser B, 
+			which is nested in another parser A, where B is bounded
+			by something else than A. Then the B is not allowed to 
+			skip over the boundary of A, but B has different boundary!
+			
+			Thus I disallow before water of any island parser that starts island
+			by setting the water position!
+		"
+		tmp := aPPContext waterPosition.
+		aPPContext waterPosition: aPPContext position.
+		result := island parseOn: aPPContext.
+		aPPContext waterPosition: tmp.
+	].
+
+	^ result
+
+]
+
+{ #category : 'parsing' }
+PPSea >> parseOn: aPPContext [ 
+	|  bwr awr result retval memento |
+	
+	aPPContext islandInvoke.
+	
+	memento := aPPContext remember.
+	bwr := self parseBeforeWater: aPPContext.
+	bwr isPetitFailure ifTrue: 
+	[
+		retval := PPFailure message: 'Could not find neither the island nor the next' context: aPPContext.
+		aPPContext restore: memento.
+		^ retval.
+	].
+
+	result := self parseIslandOn: aPPContext.
+
+	result isPetitFailure ifTrue: [ 
+		retval := PPFailure message: 'Island not found  between ', memento position asString, ' and ', aPPContext position asString context: aPPContext.
+		aPPContext restore: memento.
+		^ retval
+	].
+
+	awr := self parseAfterWater: aPPContext.	
+	awr isPetitFailure ifTrue: 
+	[
+		retval := PPFailure message: 'Could not find the next' context: aPPContext.
+		aPPContext restore: memento.
+		^ retval.
+	].
+
+	retval := OrderedCollection with: bwr with: result with: awr.
+	^ retval
+
+
+
+]
+
+{ #category : 'accessing' }
+PPSea >> replace: parser with: anotherParser [ 
+	super replace: parser with: anotherParser.
+	
+	(beforeWaterParser == parser) ifTrue: [ beforeWaterParser := anotherParser ].
+	(afterWaterParser == parser) ifTrue: [ afterWaterParser := anotherParser ].
+	(defaultBeforeWaterParser == parser) ifTrue: [ defaultBeforeWaterParser := anotherParser ].
+	(defaultAfterWaterParser == parser) ifTrue: [ defaultAfterWaterParser := anotherParser ].
+	(water == parser) ifTrue: [ water := anotherParser ].
+	(island == parser) ifTrue: [ island := anotherParser ].
+]
+
+{ #category : 'memoization' }
+PPSea >> reset: aPPContext [
+	contextIdentifier := aPPContext identifier.
+	beforeWaterParser := defaultBeforeWaterParser.
+	afterWaterParser := defaultAfterWaterParser.
+]
+
+{ #category : 'accessing - private' }
+PPSea >> setAfterWaterParser: parser [
+	defaultAfterWaterParser := parser
+]
+
+{ #category : 'accessing - private' }
+PPSea >> setBeforeWaterParser: parser [
+	defaultBeforeWaterParser  := parser
+]
+
+{ #category : 'accessing' }
+PPSea >> water [
+	^ water
+]
+
+{ #category : 'accessing' }
+PPSea >> water: aPPParser [
+	water := aPPParser
+]
diff --git a/software/petitislands/PPSeaTest.class.st b/software/petitislands/PPSeaTest.class.st
new file mode 100644
index 0000000..73af263
--- /dev/null
+++ b/software/petitislands/PPSeaTest.class.st
@@ -0,0 +1,1106 @@
+Class {
+	#name : 'PPSeaTest',
+	#superclass : 'PPAbstractParserTest',
+	#instVars : [
+		'result',
+		'context'
+	],
+	#category : 'PetitIslands-Tests'
+}
+
+{ #category : 'indentation' }
+PPSeaTest >> align [
+	| aligns |
+	
+	aligns := self aligns.
+	
+	^ (aligns not, #space asParser) star, aligns
+]
+
+{ #category : 'indentation' }
+PPSeaTest >> aligns [
+	^ [ :ctx | 
+		ctx indentStack isEmpty ifFalse: [ 
+			ctx indentStack top parseOn: ctx ] 
+		ifTrue: [ PPFailure message: 'stack is empty' context: ctx ]
+	] asParser
+]
+
+{ #category : 'parsing' }
+PPSeaTest >> assert: parser parse: input [
+	result := super assert: parser parse: input
+]
+
+{ #category : 'indentation' }
+PPSeaTest >> blank [
+	^ #blank asParser
+]
+
+{ #category : 'accessing' }
+PPSeaTest >> context [
+	context ifNil: [ ^ super context ].
+	^ context
+]
+
+{ #category : 'parse support' }
+PPSeaTest >> identifier [ 
+ 	^ ((#letter asParser / $# asParser), (#letter asParser / #digit asParser) star) flatten 
+]
+
+{ #category : 'tests - water objects' }
+PPSeaTest >> multilineCommentParser [
+	^ '/*' asParser, (#any asParser starLazy: '*/' asParser), '*/' asParser.
+]
+
+{ #category : 'parse support' }
+PPSeaTest >> nestedBlock [
+	| blockIsland block nilIsland |
+	blockIsland := self seaInstance.
+	nilIsland := self nilIsland.
+	
+	block := PPDelegateParser new.
+	block setParser: (${ asParser,  (blockIsland plus / nilIsland), $} asParser).
+	block name: 'block'.
+	
+	blockIsland island: block.
+	blockIsland name: 'block island'.
+	^ block
+]
+
+{ #category : 'parse support' }
+PPSeaTest >> nilIsland [
+	|  nilIsland |
+	nilIsland := self seaInstance.
+	
+	nilIsland island: nil asParser.
+	nilIsland name: 'nil island'.
+	
+	^ nilIsland
+]
+
+{ #category : 'indentation' }
+PPSeaTest >> restoreIl [
+	^ [ :ctx | ctx indentStack pop ] asParser
+]
+
+{ #category : 'parse support' }
+PPSeaTest >> sea: parser [
+	^ self seaInstance island: parser.
+]
+
+{ #category : 'parse support' }
+PPSeaTest >> sea: parser water: water [
+	^ self seaInstance 
+		island: parser;
+		water: water;
+		yourself
+	
+]
+
+{ #category : 'parse support' }
+PPSeaTest >> seaClass [ 
+	^ PPSea  
+]
+
+{ #category : 'parse support' }
+PPSeaTest >> seaInstance [
+	^ self seaClass new 
+]
+
+{ #category : 'indentation' }
+PPSeaTest >> setIl [
+	^ [ :ctx | 
+		| level comp p blank |
+		level := ctx column.
+		blank := self blank.
+	
+		comp := PPCompareParser 
+						on: [ :_ctx | _ctx column = level  ] 
+						message: 'expected level: ', level asString.
+		p := comp.
+	
+		ctx indentStack push: p.
+	] asParser
+]
+
+{ #category : 'running' }
+PPSeaTest >> setUp [
+	super setUp.
+	context := nil
+]
+
+{ #category : 'tests - water objects' }
+PPSeaTest >> singleCommentParser [
+	| nl |
+	nl := #newline asParser.
+	^ '//' asParser, (#any asParser starLazy: nl), nl.
+]
+
+{ #category : 'tests - indentation' }
+PPSeaTest >> testAlign [
+	|  align p setIl restoreIl blank |
+	
+	setIl := #setIl asParser.
+	restoreIl := #restoreIl asParser.
+	align := #align asParser.
+	blank := #blank asParser.
+	
+	p := blank, setIl, 'a' asParser, align, 'b' asParser, restoreIl.
+	
+	self assert: p  parse: ' a     
+ b'.
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testBlock [
+	| block  |
+
+	block := self nestedBlock.
+	
+	self assert: block parse: '{}'.
+	self assert: result size = 3.
+	self assert: result first = ${.
+	self assert: result third = $}.
+	
+	self assert: block parse: '{ }'.
+	self assert: result size = 3.
+	self assert: result first = ${.
+	self assert: result third = $}.	
+		
+	self assert: block parse: '{ { } }'.
+	self assert: result size = 3.
+	self assert: result first = ${.
+	self assert: result third = $}.	
+		
+		
+	self assert: block parse: '{ { {{} } } }'.
+	self assert: result isCollection.
+	self assert: result  size = 3.
+	self assert: result  first = ${.
+	self assert: result  second first second first = ${.
+	self assert: result  second first second second first second first = ${.
+	self assert: result  second first second second first second third = $}.
+	self assert: result  second first second third = $}.	
+	self assert: result  third = $}.
+	
+	
+	self assert: block parse: '{ { 
+		{{} } 
+	} }'.
+	self assert: result isCollection.
+	self assert: result  size = 3.
+	self assert: result  first = ${.
+	self assert: result  second first second first = ${.
+	self assert: result  second first second second first second first = ${.
+	self assert: result  second first second second first second third = $}.
+	self assert: result  second first second third = $}.	
+	self assert: result  third = $}.				
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testBoundary [
+	|  p end body start |
+	
+	"use non-trivial end-of-class a complex end"
+	end := 'end' asParser trimBlanks, 'of' asParser trimBlanks, 'class' asParser trimBlanks ==> [:args | #eoc].
+	body := self nilIsland.
+	start := 'class' asParser trim, self identifier.
+	p := start, body, end.
+	
+	self assert: p parse: 'class Foo end of class'.
+	self assert: result size = 4.
+	self assert: result second = 'Foo'.
+	self assert: result third first = ''.
+	self assert: result third last = ''.
+	
+	self assert: p parse: 'class Foo .... end of class'.
+	self assert: result size = 4.
+	self assert: result second = 'Foo'.
+	self assert: result third first = ' ....'.
+	self assert: result third last = ''.
+	
+	self assert: p parse: 'class Foo .... end ... end of class'.
+	self assert: result size = 4.
+	self assert: result second = 'Foo'.
+	
+	self assert: p parse: 'class Foo .... end of ... end of class'.
+	self assert: result size = 4.
+	self assert: result second = 'Foo'.
+	self assert: result third first = ' .... end of ...'.
+	self assert: result third last = ''.
+
+
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testBoundary2 [
+	
+	|   epilog  id p |
+	"use optional boundary"
+	epilog := 'end' asParser optional.
+	id := self identifier.
+	p := ((self sea: id), epilog) plus.
+
+	self assert: p parse: '...foo..end...bar...end'.	
+	
+	self assert: result first first first = '...'.
+	self assert: result first first second = 'foo'.
+	self assert: result first first third = '..'.
+	
+	self assert: result first second = 'end'.
+
+	self assert: result second first first = '...'.
+	self assert: result second first second = 'bar'.
+	self assert: result second first third = '...'.
+	self assert: result second second = 'end'.
+]
+
+{ #category : 'tests - complex' }
+PPSeaTest >> testClass [
+	| text   file class |
+	text := '
+// some comment
+namespace cde {
+
+public class Foo 
+endclass
+
+public class 123 // invalid class
+public struct {}
+
+class bar endclass
+class Zorg endclass
+}	
+	'.
+	
+	class := ('public' asParser trim optional, 'class' asParser trim, self identifier,  'endclass' asParser trim) 
+		==> [:t | t third] .
+	file := ((self sea: class) ==> [:t | t second ]) plus.	
+	
+	result := file parse: text.
+	self assert: result size = 3.
+	self assert: result first = 'Foo'.
+	self assert: result second = 'bar'.
+	self assert: result third = 'Zorg'.
+
+]
+
+{ #category : 'tests - complex' }
+PPSeaTest >> testFile [
+	| text using imports class file |
+	text := '
+	
+using a.b.c;
+using c.d.e;
+// some comment
+namespace cde {
+
+public class Foo 
+endclass
+
+public class 123 // invalid class
+public struct {}
+
+class bar endclass
+}	
+	'.
+	
+	using := 'using' asParser trim, (self identifier, ('.' asParser, self identifier) star) flatten ==> [:t | t second].
+	
+	imports := (self sea: using) star.
+	
+	class := ('public' asParser trim optional, 'class' asParser trim, self identifier,  'endclass' asParser trim) 
+		==> [:t | t third] .
+	file := imports, ((self sea: class) ==> [:t | t second ]) plus.	
+	
+	result := file parse: text.
+	
+	self assert: result isPetitFailure not.
+
+]
+
+{ #category : 'tests - complex' }
+PPSeaTest >> testFile2 [
+	| text using imports class file |
+	text := '
+	
+using a.b.c;
+using c.d.e;
+// some comment
+namespace cde {
+
+class Foo 
+endclass
+
+public class 123 // invalid class
+public struct {}
+
+class bar endclass
+}	
+	'.
+	
+	using := 'using' asParser trim, (self identifier, ('.' asParser, self identifier) star) flatten ==> [:t | t second].
+	
+	imports := (self sea: using) star.
+	
+	class := ('public' asParser trim optional, 'class' asParser trim, self identifier,  'endclass' asParser trim) 
+		==> [:t | t third] .
+	file := imports, ((self sea: class) ==> [:t | t second ]) plus.	
+	
+	result := file parse: text.
+	
+	self assert: result isPetitFailure not.
+
+]
+
+{ #category : 'tests - complex' }
+PPSeaTest >> testImports [
+	| text using imports   |
+	text := '
+
+/** whatever */	
+using a.b.c;
+// another comment
+using c.d.e;
+// some comment
+namespace cde {
+}	
+	'.
+	
+	using := 'using' asParser trim, (self identifier, ('.' asParser, self identifier) star) flatten ==> [:t | t second].
+	imports := ((self sea: using) ==> [:t | t second ]) star.
+	
+	result := imports parse: text.
+	
+	self assert: result size = 2.
+	self assert: result first = 'a.b.c'.
+	self assert: result second = 'c.d.e'.
+
+]
+
+{ #category : 'tests - indentation' }
+PPSeaTest >> testIndentation [
+	|  aligns push island p |
+	
+	aligns := #aligns asParser.
+	push := (nil asParser ==> [ :e | 'a' asParser]) push.
+	
+	island := push, aligns.	
+		
+	self assert: island parse: 'a'.
+	self assert: island fail: '.a'.
+	
+	p := self sea: island.
+	self assert: p  parse: 'a'.
+	self assert: p  parse: '..a'.
+]
+
+{ #category : 'tests - indentation' }
+PPSeaTest >> testIndentation2 [
+	|  aligns push  p |
+	
+	aligns := #aligns asParser.
+	push := (nil asParser ==> [ :e | 'a' asParser]) push.
+	
+	p := push, (self sea: aligns) plus.
+	self assert: p  parse: 'a'.
+	self assert: p  parse: '..a'.
+	self assert: p  parse: '..a.aa'.	
+	self assert: p  parse: '..a..a...a'.
+	
+	self assert: result second size = 3.
+]
+
+{ #category : 'tests - indentation' }
+PPSeaTest >> testIndentation3 [
+	|  aligns push pop  p |
+	
+	aligns := #aligns asParser.
+	push := (nil asParser ==> [ :e | 'a' asParser]) push.
+	pop := #pop asParser.
+	
+	p := push, (self sea: aligns) plus, pop.
+	
+	self assert: p  parse: 'a'.
+	self assert: p  parse: '..a'.
+	self assert: p  parse: '..a.aa'.	
+	self assert: p  parse: '..a..a...a'.
+]
+
+{ #category : 'tests - indentation' }
+PPSeaTest >> testIndentationBlock [
+	|  begin content end block setIl restoreIl     |
+	
+	setIl:= #setIl asParser.
+	restoreIl := #restoreIl asParser.
+	
+	begin := setIl, 'begin' asParser ==> [:e | #begin ].
+	content := 'foo' asParser.
+	end := 'end' asParser, restoreIl ==> [:e | #end ].
+	block := PPDelegateParser new.
+	
+	block setParser: 	begin trimLeft,
+								(self sea: (block / content) trimOnside)  star,
+							end trimAlign.
+			
+	self assert: block parse: '
+		begin
+			foo
+			bar
+			foo
+		end'.
+
+	self assert: result size = 3.
+	self assert: result second size = 2.
+	self assert: result second first second = 'foo'.
+	
+	self assert: block parse: '
+		begin
+			foo
+			foo
+		end'.
+
+	self assert: result size = 3.
+	self assert: result second size = 2.
+	self assert: result second first second = 'foo'.
+	self assert: result second second second = 'foo'.
+]
+
+{ #category : 'tests - indentation' }
+PPSeaTest >> testIndentationBlock2 [
+	|  begin content end block setIl restoreIl     |
+	
+	setIl:= #setIl asParser.
+	restoreIl := #restoreIl asParser.
+		
+	begin := setIl, 'begin' asParser ==> [:e | #begin ].
+	content := 'foo' asParser plus.
+	end := 'end' asParser, restoreIl ==> [:e | #end ].
+	block := PPDelegateParser new.
+	
+	block setParser: 	begin trimLeft,
+								(self sea: (block / content) trimOnside)  star,
+							end trimAlign.
+			
+	self assert: block parse: '
+		begin
+			foo
+			bar
+			begin
+				bar
+				foo
+				foo
+				baz
+			end
+			bar
+			foo
+		end'.
+
+	self assert: result size = 3.
+	self assert: result second size = 3.
+	self assert: result second second second second size = 2.
+]
+
+{ #category : 'tests - indentation' }
+PPSeaTest >> testIndentationBlock3 [
+	|  begin content end block setIl restoreIl     |
+	
+	setIl:= #setIl asParser.
+	restoreIl := #restoreIl asParser.
+	
+	begin := setIl, 'begin' asParser ==> [:e | #begin ].
+	content := 'foo' asParser plus.
+	end := 'end' asParser, restoreIl ==> [:e | #end ].
+	block := PPDelegateParser new.
+	
+	block setParser: 	begin trimLeft,
+								(self sea: ((block / content) trimOnside)) star,
+							end trimAlign.
+			
+	self assert: block parse: '
+		begin
+			foo
+			begin
+				bar
+				foo
+			end
+			begin
+				bar
+			bar
+			foo
+		end'.
+
+	self assert: result size = 3.
+	self assert: result second size = 3.
+]
+
+{ #category : 'tests - indentation' }
+PPSeaTest >> testIndentationBlock4 [
+	|  begin content end block setIl restoreIl     |
+	
+	setIl:= #setIl asParser.
+	restoreIl := #restoreIl asParser.
+	
+	begin := setIl, 'begin' asParser ==> [:e | #begin ].
+	content := 'foo' asParser plus.
+	end := 'end' asParser, restoreIl ==> [:e | #end ].
+	block := PPDelegateParser new.
+	
+	block setParser: 	begin trimLeft,
+								(self sea: (block / content) trimOnside) star,
+							end trimAlign.
+			
+	self assert: (block sea ==> #second) star parse: '
+		begin
+			foo
+			bar
+			foo
+		end
+		
+		begin
+			bar
+		
+		begin
+			foo
+			bar
+		end'.
+
+	self assert: result size = 2.
+	self assert: result first second size = 2.
+	self assert: result second second size = 1.	
+]
+
+{ #category : 'tests - indentation' }
+PPSeaTest >> testIndentationCompare [
+	|  aligns p setIl restoreIl |
+	
+	aligns := self aligns.
+	setIl := self setIl.
+	restoreIl := self restoreIl.
+	
+	p := (setIl, aligns, restoreIl, (aligns not)).
+	
+	self assert: p  parse: ''.
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandAfterIslandPlus [
+	
+	| island2 islandParser2 island1 islandParser1 parser |
+	island1 := 'aa' asParser, 'bb' asParser.
+	islandParser1 := self seaInstance.
+	islandParser1 island: island1.
+	
+	island2 := 'cc' asParser.
+	islandParser2 := self seaInstance.
+	islandParser2 island: island2.
+	
+	parser := (islandParser1, islandParser2) plus.
+	 
+	result := islandParser1 parse: '__ aabb __ cc __'.
+	self assert: result isPetitFailure not.
+
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandAfterIslandPlus2 [
+	
+	| island2 islandParser2 island1 islandParser1 parser |
+	
+	island1 := 'aa' asParser, 'bb' asParser.
+	islandParser1 := self seaInstance.
+	islandParser1 island: island1.
+	
+	island2 := 'cc' asParser.
+	islandParser2 := self seaInstance.
+	islandParser2 sea: island2.
+	
+	parser := (islandParser1, islandParser2) plus.
+	 
+	result := islandParser1 parse: '__ aaxx __ cc __'.
+	self assert: result isPetitFailure.
+
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandDetection [
+	| island parser |
+	island := 'class' asParser, self identifier trim, 'endclass' asParser.
+	parser := self sea: island.
+	
+	self assert: parser parse: 'class Foo endclass'.
+	self assert: result size = 3.
+	self assert: result second second = 'Foo'.
+
+	self assert: parser parse: '/*comment*/ class Foo endclass'.
+	self assert: result size = 3.
+	self assert: result second second = 'Foo'.
+
+	self assert: parser parse: '/*comment class Bar */ class Foo endclass'.
+	self assert: result size = 3.
+	self assert: result second second = 'Foo'.
+
+	self assert: parser parse: '/*comment class Bar */ class Foo endclass //something more'.
+	self assert: result size = 3.
+	self assert: result second second = 'Foo'.
+
+	self assert: parser parse: '/*comment class Bar endclass */ class Foo endclass //something more'.
+	self assert: result size = 3.
+	self assert: result second second = 'Bar'.
+
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandPlus [
+	
+	| island  parser |
+	island := self sea: 'X' asParser.
+	parser := island plus.
+	
+	self assert: parser parse: '....X....'.
+	self assert: result size = 1.
+	self assert: result first first = '....'.
+	self assert: result first third = '....'.
+
+	self assert: parser parse: '...X...X...XX'.
+	self assert: result size = 4.
+
+	self assert: result second first = ''.
+	self assert: result second third = '...'.
+	self assert: result third first = ''.
+	self assert: result third third = ''.
+	self assert: result fourth first = ''.
+	self assert: result fourth third = ''.
+
+	self assert: parser fail: '.....'.
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandPlus2 [
+	
+	| island  parser |
+	island := self sea: ('class' asParser, self identifier trim).
+	parser := island plus.
+	
+	self assert: parser parse: '....class Foo....'.
+	self assert: result size = 1.
+	self assert: result first second second = 'Foo'.
+
+
+	self assert: parser parse: '....class . class Foo....'.
+	self assert: result size = 1.
+	self assert: result first second second = 'Foo'.
+
+	self assert: parser parse: '....class . class Foo class Bar....'.
+	self assert: result size = 2.
+	self assert: result first second second = 'Foo'.
+	self assert: result second second second = 'Bar'.
+
+
+
+	self assert: parser fail: '.....'.
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandSequence [
+	
+	|  parser   a b c |
+	"Island sequence will never cross the boundery of 'c'"
+	a := 'a' asParser.
+	b := 'b' asParser.
+	c := 'c' asParser.
+	
+	parser := ((self sea: a), (self sea: b)) wrapped, c.
+	
+	self assert: parser parse: '..a...b...c'.
+	self assert: parser fail: '..a..c...b..c'.
+	self assert: parser fail: '..c..a.....b..c'.
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandSequence2 [
+	| p a b |
+	
+	a := self sea: ('a' asParser plus).
+	a name: 'a island'.
+	
+	b := self sea: 'b' asParser.
+	b name: 'b island'.
+	
+	p := a optional, (b / self nilIsland).
+	self assert: p  parse: 'a'.
+	self assert: result size = 2.
+	self assert: result first notNil.
+	self assert: result second size = 3.
+	self assert: result second second = nil.
+	
+	self assert: p parse: '..ab'.
+	
+	self assert: result isPetitFailure not.
+	self assert: result size = 2.
+	self assert: result first notNil.
+	self assert: result second size = 3.
+	self assert: result second second = 'b'.
+	
+	self assert: p parse: 'a..b'.
+	
+	self assert: result isPetitFailure not.
+	self assert: result size = 2.
+	self assert: result first notNil.
+	self assert: result second size = 3.
+	self assert: result second second = 'b'.
+	
+	self assert: p parse: 'ab...'.
+	
+	self assert: result isPetitFailure not.
+	self assert: result size = 2.
+	self assert: result first notNil.
+	self assert: result second size = 3.
+	self assert: result second second = 'b'.
+	
+	self assert: p parse: '...a...b...'.
+	
+	self assert: result isPetitFailure not.
+	self assert: result size = 2.
+	self assert: result first notNil.
+	self assert: result second size = 3.
+	self assert: result second second = 'b'.
+	
+	self assert: p parse: '...a...b...'.
+	
+	self assert: result isPetitFailure not.
+	self assert: result size = 2.
+	self assert: result first notNil.
+	self assert: result second size = 3.
+	self assert: result second second = 'b'.
+	
+	self assert: p end parse: '...b...'.
+	
+	self assert: result isPetitFailure not.
+	self assert: result size = 2.
+	self assert: result first isNil.
+	self assert: result second size = 3.
+	self assert: result second second = 'b'.
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandSequence3 [
+	
+	| parser   body class extends |
+	class := self sea: 'class' asParser trim, self identifier trim.	
+	extends := self sea: 'extends' asParser trim, self identifier trim.
+	body := self sea: self nestedBlock.
+
+	parser := (class, extends optional, body) plus.
+	self assert: parser parse: '
+	/* lorem ipsum */ 
+	class Foo { whatever } 
+	
+	// something more 
+	class Bar extends Zorg { blah blah bla } 
+	// this is the end'.
+	
+	self assert: result isPetitFailure not.
+	self assert: result size = 2. 
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandSequence4 [
+	
+	|  parser  a b c  eps |
+	"Island sequence will never cross the boundery of 'c'"
+	a := 'a' asParser.
+	b := 'b' asParser.
+	c := 'c' asParser.
+	eps := nil asParser.
+	
+	parser := (self sea: a), b optional, (self sea: eps), c.
+	
+	self assert: parser parse: '..a...b...c'.
+	"This fails, but it should not. Right now, the problem is, that eps island 
+		does not allow for epsilon parse, if the current position is the water
+		position. Yet, in this case, it should allow for.
+		
+		You should find a better way, how to prefer non-epsilon parses than using
+		nonEpsilon (used right now)
+	"
+	self assert: parser parse: 'ac'.
+	self assert: parser parse: '..a...c'.
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandStar [
+	|  p  |
+	
+	
+	p := (self sea: 'a' asParser) star, 'b' asParser. 
+	self assert: p parse: 'b'.
+	self assert: result size = 2.
+	self assert: result first size = 0.
+	
+	self assert: p parse: 'ab'.
+	self assert: result size = 2.
+	self assert: result first size = 1.
+	
+	self assert: p parse: 'aab'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+	
+	self assert: p parse: '...aab'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+	
+	self assert: p parse: '...aa...b'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+	
+	self assert: p parse: '...a...a...b'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+
+	self assert: p parse: '...a...a...aa...b'.
+	self assert: result size = 2.
+	self assert: result first size = 4.
+	
+	"Thats the question, if I want this:"
+	self assert: p fail: '...b'.
+
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandStar2 [
+	|  p  |
+	
+	
+	p := (self sea: 'a' asParser) star, 'b' asParser optional. 
+	self assert: p parse: 'aa'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+	
+	self assert: p parse: '....aa'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+	
+	self assert: p parse: '...a...a...'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+	
+	self assert: p parse: '...a...a...b'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+	self assert: result second = 'b'.
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testIslandStar3 [
+	|  p  |
+	
+	
+	p := (self sea: 'a' asParser) star, (self sea: nil asParser). 
+	
+	self assert: p parse: '....'.
+	self assert: result size = 2.
+	self assert: result first size = 0.
+	
+	self assert: p parse: 'aa'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+	
+	self assert: p parse: '....aa'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+	
+	self assert: p parse: '...a...a...'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+	
+	self assert: p parse: '...a...a...b'.
+	self assert: result size = 2.
+	self assert: result first size = 2.
+	self assert: result second second = nil.
+]
+
+{ #category : 'tests - water objects' }
+PPSeaTest >> testMultilineComment [
+	|  parser |
+	parser := self multilineCommentParser.
+	
+	self assert: parser parse: '/* hello there */'.
+	self assert: parser parse: '/* class Bar endclass */'.
+
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testNestedIsland [
+	
+	|  nestedIsland before after topIsland |
+	nestedIsland := self sea: 'X' asParser.
+	
+	before := 'before' asParser.
+	after := 'after' asParser.
+	topIsland := self sea: (before, nestedIsland, after).
+	
+	self assert: nestedIsland parse: 'before...X...ater'.
+	self assert: topIsland parse: 'beforeXafter'.
+	
+	self assert: topIsland parse: '....before..X..after....'.
+	self assert: result size = 3.
+	self assert: result second size = 3.
+	self assert: result second second size = 3.
+	self assert: result second second second = 'X'.
+	
+	self assert: topIsland parse: '....X....before...X....after'.
+	self assert: topIsland parse: '....before.......after....before..X...after'.
+
+	self assert: topIsland fail: '....before.......after...'.	
+	self assert: topIsland fail: '....before.......after...X'.	
+	self assert: topIsland fail: '....before.......after...X...after'.		
+
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testNestedIsland2 [
+	
+	|  nestedIsland before after topIsland |
+	nestedIsland := self sea: 'after' asParser.
+	
+	before := 'before' asParser.
+	after := 'after' asParser.
+	topIsland := self sea: (before, nestedIsland, after).
+	
+	self assert: nestedIsland parse: '..after..'.
+	self assert: topIsland parse: 'before..after..after'.
+	self assert: topIsland parse: '....before...after....after...'.
+	self assert: topIsland fail: '....before...after...'.
+	
+	topIsland := self sea: (before, (nestedIsland / (nil asParser sea)), after).
+	self assert: topIsland parse: '....before...after....after...'.
+	self assert: topIsland parse: '..before...after..'.
+
+
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testNilIsland [
+	
+	| nilIsland  p |
+
+	nilIsland := self nilIsland.
+	
+
+	p := ${ asParser, nilIsland, $} asParser.
+
+	self assert: p parse: '{}'.
+	
+	self assert: result isCollection.
+	self assert: result size = 3.
+	self assert: result first = ${.
+	self assert: result third = $}.	
+	
+
+	self assert: p parse: '{ }'.
+	self assert: result isCollection.
+	self assert: result size = 3.
+	self assert: result first = ${.
+	self assert: result third = $}.
+	
+
+	self assert: p parse: '{ ... }'.
+	self assert: result isCollection.
+	self assert: result size = 3.
+	self assert: result first = ${.
+	self assert: result third = $}.
+]
+
+{ #category : 'tests - nonempty' }
+PPSeaTest >> testNonEmptyParser [
+	| p |
+	p := 'a' asParser optional nonEmpty.
+	
+	self assert: p parse: 'a'.
+	self assert: p fail: ''.
+]
+
+{ #category : 'tests - nonempty' }
+PPSeaTest >> testNonEmptyParser2 [
+	| p |
+	context := PPContext new.
+	
+	context propertyAt: #foo put: #baz.
+	p := [ :ctx | ctx propertyAt: #foo put: #bar ] asParser nonEmpty.
+	
+	result := p parse: '' withContext: context.
+	self assert: (context propertyAt: #foo) = #baz. 
+	self assert: result isPetitFailure.
+]
+
+{ #category : 'testing' }
+PPSeaTest >> testOptionalIsland [
+	
+	| island parser   |
+	
+	island := self sea: ('a' asParser / 'b' asParser optional).
+	parser := island, 'c' asParser.
+	
+	self assert: parser parse: '....a....b...c'.
+	self assert: result first second = 'a'.
+	self assert: result second = 'c'.
+	
+	self assert: parser parse: '....d....b...c'.
+	self assert: result first second = 'b'.
+	self assert: result second = 'c'.
+	
+	self assert: parser parse: '....d....d...c'.
+	self assert: result first second = nil.
+	self assert: result second = 'c'.
+
+	self assert: parser parse: '...c'.
+]
+
+{ #category : 'tests - water objects' }
+PPSeaTest >> testWaterObjects [
+	| parser |
+	parser := (self sea: ('class' asParser, self identifier trim, 'endclass' asParser ==> #second)) star.
+
+	self assert: parser parse: ' /* hello there */ class Foo endclass'.
+	self assert: result size = 1.
+	self assert: result first second = 'Foo'.
+	
+	self assert: parser parse: ' /* class Bar endclass */ class Foo endclass'.
+	self assert: result size = 2.
+	self assert: result first second = 'Bar'.
+	self assert: result second second = 'Foo'.
+	
+	parser := (self sea: ('class' asParser, self identifier trim, 'endclass' asParser ==> #second) water: self multilineCommentParser / #any asParser) star.
+
+	self assert: parser parse: ' /* class Bar endclass */ class Foo endclass'.
+	self assert: result size = 1.
+	self assert: result first second = 'Foo'.
+]
+
+{ #category : 'tests - water objects' }
+PPSeaTest >> testWaterObjects2 [
+	| parser source |
+	context := PPContext new.
+
+	parser := (self sea: ('class' asParser, self identifier trim, 'endclass' asParser ==> #second)
+						 water: self multilineCommentParser / self singleCommentParser / #any asParser) 				star.
+	
+	source := ' /* class Bar endclass */ 
+	class Foo 
+	endclass
+	/* 
+	   class Borg
+	   endclass
+	*/
+	// class Qwark endclass 
+	class Zorg 
+	endclass
+	'.
+	
+	self assert: parser parse: source.
+	self assert: result size = 2.
+	self assert: result first second = 'Foo'.	
+	self assert: result second second = 'Zorg'.	
+
+]
diff --git a/software/petitislands/PPSequenceParser.extension.st b/software/petitislands/PPSequenceParser.extension.st
new file mode 100644
index 0000000..7832deb
--- /dev/null
+++ b/software/petitislands/PPSequenceParser.extension.st
@@ -0,0 +1,51 @@
+Extension { #name : 'PPSequenceParser' }
+
+{ #category : '*petitislands' }
+PPSequenceParser >> acceptsEpsilonOpenSet: set [
+	set add: self.
+	^ self children allSatisfy: [:e | e acceptsEpsilonOpenSet: set ]
+]
+
+{ #category : '*petitislands' }
+PPSequenceParser >> isIslandBorderOpenSet: set [
+	set add: self.
+	^ self children anySatisfy: [:e | e isIslandBorderOpenSet: set ]
+]
+
+{ #category : '*petitislands' }
+PPSequenceParser >> nextSets: aNextDictionary into: aSet [
+	| change tally tmp childSet |
+	
+	change := false.
+
+	self children keysAndValuesDo: [ :index :child |
+		childSet := (aNextDictionary at: child). 
+		tally :=  childSet size.
+
+		index = parsers size ifTrue: [ 
+			childSet addAll: aSet.
+		] ifFalse: [  
+			tmp := self subsequenceFrom: index + 1 to: parsers size.
+			childSet add: tmp.
+			tmp isIslandBorder ifFalse: [ 
+				childSet addAll: aSet.
+			]
+		].
+		change := change or: [ (aNextDictionary at: child) size ~= tally ]
+ 	].
+
+	^ change
+]
+
+{ #category : '*petitislands' }
+PPSequenceParser >> subsequenceFrom: from to: to [
+	| interval dict |
+	
+	interval := from to: to.
+	dict := self propertyAt: #subsequenceCache ifAbsentPut: [ Dictionary new ].
+	^ dict at: interval ifAbsentPut: [
+		(from = to) 
+			ifTrue: [ parsers at: from ] 
+			ifFalse: [ self class withAll: (parsers copyFrom: from to: to) ]
+	].
+]
diff --git a/software/petitislands/PPStartOfLineParser.extension.st b/software/petitislands/PPStartOfLineParser.extension.st
new file mode 100644
index 0000000..25b583f
--- /dev/null
+++ b/software/petitislands/PPStartOfLineParser.extension.st
@@ -0,0 +1,11 @@
+Extension { #name : 'PPStartOfLineParser' }
+
+{ #category : '*petitislands' }
+PPStartOfLineParser >> acceptsEpsilon [
+	^ false
+]
+
+{ #category : '*petitislands' }
+PPStartOfLineParser >> isIslandBorder [
+	^ true
+]
diff --git a/software/petitislands/PPStartOfWordParser.extension.st b/software/petitislands/PPStartOfWordParser.extension.st
new file mode 100644
index 0000000..1f7bee7
--- /dev/null
+++ b/software/petitislands/PPStartOfWordParser.extension.st
@@ -0,0 +1,6 @@
+Extension { #name : 'PPStartOfWordParser' }
+
+{ #category : '*petitislands' }
+PPStartOfWordParser >> isIslandBorder [
+	^ true
+]
diff --git a/software/petitislands/PPWater.class.st b/software/petitislands/PPWater.class.st
new file mode 100644
index 0000000..56c58d9
--- /dev/null
+++ b/software/petitislands/PPWater.class.st
@@ -0,0 +1,85 @@
+Class {
+	#name : 'PPWater',
+	#superclass : 'PPDelegateParser',
+	#instVars : [
+		'waterToken'
+	],
+	#category : 'PetitIslands-Parsers'
+}
+
+{ #category : 'as yet unclassified' }
+PPWater class >> on: parser [
+	^ self on: parser waterToken: #any asParser
+]
+
+{ #category : 'as yet unclassified' }
+PPWater class >> on: parser waterToken: waterToken [
+	^ (super on: parser)
+		waterToken: waterToken;
+		yourself
+]
+
+{ #category : 'as yet unclassified' }
+PPWater >> children [
+	^ Array with: waterToken with: parser
+]
+
+{ #category : 'as yet unclassified' }
+PPWater >> initialize [
+	super initialize.
+	waterToken := nil asParser.
+
+]
+
+{ #category : 'testing' }
+PPWater >> isWater [
+	^ true
+]
+
+{ #category : 'as yet unclassified' }
+PPWater >> nextSets: aNextSetDictionary into: aSet [
+	self assert: aSet isEmpty.
+	^ false
+]
+
+{ #category : 'as yet unclassified' }
+PPWater >> parseOn: aPPContext [
+	| waterPosition result position |
+	
+	position := aPPContext position.
+	(aPPContext waterPosition == aPPContext position) ifFalse: [ 
+		waterPosition := aPPContext waterPosition.
+		aPPContext waterPosition: aPPContext position.
+
+		result := parser parseOn: aPPContext.
+		[result isPetitFailure] whileTrue: [
+			aPPContext atEnd ifTrue: [ 
+				aPPContext waterPosition: waterPosition.
+				^ PPFailure message: 'anchor did not found' at: aPPContext position ].
+			aPPContext waterToken.
+			waterToken parseOn: aPPContext.
+			aPPContext waterPosition: aPPContext position.
+			result := parser parseOn: aPPContext.
+		].
+		
+		aPPContext waterPosition: waterPosition.
+	].
+	
+	^ aPPContext stream collection copyFrom: position + 1 to: aPPContext position
+]
+
+{ #category : 'as yet unclassified' }
+PPWater >> replace: child with: anotherChild [
+	child == waterToken  ifTrue: [ 
+		waterToken := anotherChild
+	].
+
+	child == parser ifTrue: [ 
+		parser := anotherChild
+	]
+]
+
+{ #category : 'as yet unclassified' }
+PPWater >> waterToken: aPPParser [
+	^ waterToken := aPPParser
+]
diff --git a/software/petitislands/PPXmlFeedParser.class.st b/software/petitislands/PPXmlFeedParser.class.st
new file mode 100644
index 0000000..8d1379c
--- /dev/null
+++ b/software/petitislands/PPXmlFeedParser.class.st
@@ -0,0 +1,151 @@
+"
+A XmlFeedParser is Parser of a fake shop feed. Shop feed is a XML file with information about shop products. Shop feed can be malformed (for any reason) the parser will recover from malformed item (see rule shoplistContent) and will continue on the next valid item.
+
+Instance Variables
+	closeItem:		<Object>
+	closeName:		<Object>
+	closeShoplist:		<Object>
+	item:		<Object>
+	itemContent:		<Object>
+	name:		<Object>
+	nameContent:		<Object>
+	openItem:		<Object>
+	openName:		<Object>
+	openShoplist:		<Object>
+	shoplist:		<Object>
+	shoplistContent:		<Object>
+	simpleElement:		<Object>
+	stringValue:		<Object>
+
+closeItem
+	- xxxxx
+
+closeName
+	- xxxxx
+
+closeShoplist
+	- xxxxx
+
+item
+	- xxxxx
+
+itemContent
+	- xxxxx
+
+name
+	- xxxxx
+
+nameContent
+	- xxxxx
+
+openItem
+	- xxxxx
+
+openName
+	- xxxxx
+
+openShoplist
+	- xxxxx
+
+shoplist
+	- xxxxx
+
+shoplistContent
+	- xxxxx
+
+simpleElement
+	- xxxxx
+
+stringValue
+	- xxxxx
+
+"
+Class {
+	#name : 'PPXmlFeedParser',
+	#superclass : 'PPCompositeParser',
+	#instVars : [
+		'item',
+		'openItem',
+		'itemContent',
+		'closeItem',
+		'openShoplist',
+		'shoplistContent',
+		'closeShoplist',
+		'shoplist',
+		'simpleElement',
+		'stringValue'
+	],
+	#category : 'PetitIslands-Examples'
+}
+
+{ #category : 'tags' }
+PPXmlFeedParser >> closeItem [
+	^ '</' asParser, 'item' asParser trim, '>' asParser
+]
+
+{ #category : 'tags' }
+PPXmlFeedParser >> closeShoplist [
+	^ '</' asParser, 'shoplist' asParser trim, '>' asParser
+]
+
+{ #category : 'xmlSupport' }
+PPXmlFeedParser >> elementsToDictionaryBlock [
+ 	^ [ :elements | | d | 
+		d := Dictionary new.
+		elements do: [ :e | d at: e first asSymbol put: e second ].
+		d
+	]
+]
+
+{ #category : 'grammar' }
+PPXmlFeedParser >> item [
+	^ (openItem, itemContent trim, closeItem) trim ==> #second
+]
+
+{ #category : 'grammar' }
+PPXmlFeedParser >> itemContent [
+	^ (simpleElement trim star) ==> self elementsToDictionaryBlock
+]
+
+{ #category : 'tags' }
+PPXmlFeedParser >> openItem [
+	^ '<' asParser, 'item' asParser trim, '>' asParser
+]
+
+{ #category : 'tags' }
+PPXmlFeedParser >> openShoplist [
+	^ '<' asParser, 'shoplist' asParser trim, '>' asParser
+]
+
+{ #category : 'grammar' }
+PPXmlFeedParser >> shoplist [
+	^ (openShoplist, shoplistContent, closeShoplist) trim ==> #second
+]
+
+{ #category : 'grammar' }
+PPXmlFeedParser >> shoplistContent [
+	^ (item sea ==> #second) star
+]
+
+{ #category : 'xmlSupport' }
+PPXmlFeedParser >> simpleElement [
+	^ (
+		(('<' asParser, stringValue trim, '>' asParser) ==> #second),
+		stringValue,
+		(('</' asParser, stringValue trim, '>' asParser) ==> #second)
+	) ==> [ :elements |
+		(elements first = elements third) 
+		ifTrue: [ Array with: elements first with: elements second ]
+		ifFalse: [ PPFailure message: 'malformed element' ]
+ 	]
+]
+
+{ #category : 'grammar' }
+PPXmlFeedParser >> start [
+	^ shoplist
+]
+
+{ #category : 'grammar' }
+PPXmlFeedParser >> stringValue [
+	^ (#letter asParser / #digit asParser) star flatten trim
+]
diff --git a/software/petitislands/PPXmlFeedParserTest.class.st b/software/petitislands/PPXmlFeedParserTest.class.st
new file mode 100644
index 0000000..05012e1
--- /dev/null
+++ b/software/petitislands/PPXmlFeedParserTest.class.st
@@ -0,0 +1,246 @@
+Class {
+	#name : 'PPXmlFeedParserTest',
+	#superclass : 'PPCompositeParserTest',
+	#category : 'PetitIslands-Examples'
+}
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> feed01 [
+^'
+<shoplist>
+<name>ABC Shop</name>
+<address>Here and there 123, 123 45 Somewhere</address>
+<item>
+  <name>socks</name>
+  <price>123</price>
+  <availability>1</availability>
+</item>
+</shoplist>
+'
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> feed02 [
+^'
+<shoplist>
+<name>ABC Shop</name>
+<address>Here and there 123, 123 45 Somewhere</address>
+<item>
+  <name>socks</name>
+  <price>123</price>
+  <availability>1</availability>
+</item>
+
+
+<item>
+  <name> shoes </name>
+  <price>2345</price>
+  <availability>1</availability>
+</item>
+
+</shoplist>
+'
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> feed03 [
+^'
+<shoplist>
+<name>ABC Shop</name>
+<address>Here and there 123, 123 45 Somewhere</address>
+<item>
+  <name>socks</name>
+  <price>123</price>
+  <availability>1</availability>
+</item>
+
+
+<item>
+  <name> shoes </name>
+  <price>2345</price>
+  <!-- this one is malformed -->
+  <availability>1 </
+</item>
+
+<item>
+  <name> shoes </name>
+  <price>3456</price>
+  <availability>0</availability>
+</item>
+
+
+</shoplist>
+'
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> parse: aString rule: aSymbol to: anObject [
+	| production |
+	production := self parserInstanceFor: aSymbol.
+	result := production end parse: aString.
+	self
+		deny: result isPetitFailure
+		description: 'Unable to parse ' , aString printString.
+	self assert: result = anObject.
+	
+	^ result
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> parserClass [
+	^ PPXmlFeedParser
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testItem01 [
+	self parse: '
+	<item>
+		<name>abc</name>
+	</item>
+	' rule: #item.
+	
+	self assert: (result at: #name) = 'abc'.
+	
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testItem02 [
+	self parse: '
+	<item>
+		<name>abc</name>
+		<price>123</price>
+	</item>
+	' rule: #item.
+	
+	self assert: (result at: #name) = 'abc'.
+	self assert: (result at: #price) = '123'.
+	
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testItem03 [
+	self parse: '
+	<item>
+		<price>123</price>
+		<name>abc</name>
+	</item>
+	' rule: #item.
+	
+	self assert: (result at: #name) = 'abc'.
+	self assert: (result at: #price) = '123'.
+	
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testShoplist [
+	self testShoplist01.
+	self testShoplist02.
+	self testShoplist03.
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testShoplist01 [
+	self parse: '
+<shoplist>
+	<item>
+		<name>abc</name>
+	</item>
+</shoplist>
+	' rule: #shoplist.
+	
+	self assert: result size = 1.
+	
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testShoplist02 [
+	self parse: '
+<shoplist>
+	<name>xyz</name>
+	<item>
+		<name>abc</name>
+		<price>123</price>
+	</item>
+</shoplist>
+	' rule: #shoplist.
+	
+	self assert: result size = 1.
+	
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testShoplist03 [
+	self parse: '
+<shoplist>
+	<name>xyz</name>
+	<item>
+		<name>abc</name>
+		<price>123</price>
+	</item>
+	<item>
+		<name>cde</name>
+		<price>345</price>
+	</item>
+</shoplist>
+	' rule: #shoplist.
+	
+	self assert: result size = 2.
+	
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testSimpleElement [
+	self parse: '<a>b</a>' rule: #simpleElement to: #('a' 'b').	
+	self parse: '<abc> def </ abc>' rule: #simpleElement to: #('abc' 'def').	
+		
+	self fail: '<a>b</b>' rule: #simpleElement.
+	
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testStringValue [
+	self parse: 'abc' rule: #stringValue to: 'abc'.	
+	self parse: ' def ' rule: #stringValue to: 'def'.
+	
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testXmlFeed01 [
+	self parse: self feed01.
+	
+	self assert: result size = 1.
+	self assert: (result first at:#name) = 'socks'.
+	self assert: (result first at:#price) = '123'.
+	self assert: (result first at:#availability) = '1'.
+	
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testXmlFeed02 [
+	self parse: self feed02.
+	
+	self assert: result size = 2.
+	self assert: (result first at:#name) = 'socks'.
+	self assert: (result first at:#price) = '123'.
+	self assert: (result first at:#availability) = '1'.
+
+	self assert: (result second at:#name) = 'shoes'.
+	self assert: (result second at:#price) = '2345'.
+	self assert: (result second at:#availability) = '1'.
+	
+]
+
+{ #category : 'as yet unclassified' }
+PPXmlFeedParserTest >> testXmlFeed03 [
+	self parse: self feed03.
+	
+	self assert: result size = 2.
+	self assert: (result first at:#name) = 'socks'.
+	self assert: (result first at:#price) = '123'.
+	self assert: (result first at:#availability) = '1'.
+
+	self assert: (result second at:#name) = 'shoes'.
+	self assert: (result second at:#price) = '3456'.
+	self assert: (result second at:#availability) = '0'.
+	
+]
diff --git a/software/petitislands/package.st b/software/petitislands/package.st
new file mode 100644
index 0000000..19911f4
--- /dev/null
+++ b/software/petitislands/package.st
@@ -0,0 +1 @@
+Package { #name : 'petitislands' }