--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/PPCChoiceNode.st	Sun Oct 26 01:03:31 2014 +0000
@@ -0,0 +1,77 @@
+"{ Package: 'stx:goodies/petitparser/compiler' }"
+
+PPCListNode subclass:#PPCChoiceNode
+	instanceVariableNames:''
+	classVariableNames:''
+	poolDictionaries:''
+	category:'PetitCompiler-Nodes'
+!
+
+PPCChoiceNode comment:''
+!
+
+!PPCChoiceNode methodsFor:'as yet unclassified'!
+
+acceptsEpsilon
+	^ self acceptsEpsilonOpenSet: IdentitySet new.
+!
+
+acceptsEpsilonOpenSet: set
+	set add: self.
+	^ self children anySatisfy: [:e | e acceptsEpsilonOpenSet: set ].
+!
+
+compileWith: compiler effect: effect id: id
+	| firsts guard  |
+	compiler addVariable: 'element'.
+
+	firsts := (self firstSetSuchThat: [ :e | (e isKindOf: PPCTrimmingTokenNode) or: [ e isTerminal ] ]).
+	
+	compiler startMethod: id.
+	compiler addVariable: 'element'.
+
+	"If we start with trimming token, we should invoke the whitespace parser"
+	(firsts allSatisfy: [ :e | e isKindOf: PPCTrimmingTokenNode ]) ifTrue: [  
+		firsts anyOne compileWhitespace: compiler.
+	].
+	
+	(1 to: children size) do: [ :idx  | |child|
+		child := children at: idx.
+		
+		(compiler guards and: [ (guard := PPCGuard on: child) makesSense ]) ifTrue: [ 	
+			guard id: (compiler idFor: guard prefixed: #guard).
+			guard compileGuard: compiler.
+			compiler add: ' ifTrue: [ '.
+			compiler indent.
+				compiler add: 'self clearError.'.
+				compiler add: 'element := '.
+				compiler callOnLine: (child compileWith: compiler).
+				compiler add: 'error ifFalse: [ ^ element ].'.
+			compiler dedent.
+			compiler add: ' ].'.
+		] ifFalse: [
+			compiler add: 'self clearError.'.
+			compiler add: 'element := '.
+			compiler callOnLine: (child compileWith: compiler).
+			compiler add: 'error ifFalse: [ ^ element ].'.
+		]
+	].
+	compiler add: '^ self error: ''no choice suitable'''.
+ ^ compiler stopMethod.
+!
+
+prefix
+	^ #ch
+! !
+
+!PPCChoiceNode methodsFor:'optimizing'!
+
+optimize: params status: changeStatus
+	| retval |
+	retval := self.
+	retval := retval rewrite: params status: changeStatus.
+	retval := retval inline: params status: changeStatus.
+	
+	^ retval
+! !
+