compiler/PPCChoiceNode.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Mon, 24 Nov 2014 00:09:23 +0000
changeset 421 7e08b31e0dae
parent 414 0eaf09920532
child 422 116d2b2af905
permissions -rw-r--r--
Merged JK's version from Monticello Name: PetitParser-JanKurs.260 Author: JanKurs Time: 17-11-2014, 12:09:05.490 PM UUID: 07411cef-ef69-40db-9d93-d4018a9b34ef Name: PetitTests-JanKurs.65 Author: JanKurs Time: 17-11-2014, 12:09:04.530 PM UUID: f98d613f-f4ce-4e0e-a7e9-310ee7c7e7a6 Name: PetitSmalltalk-JanKurs.78 Author: JanKurs Time: 14-11-2014, 05:05:07.765 PM UUID: 3d68330d-44d5-46c3-9705-97f627b3edbc Name: PetitCompiler-JanKurs.71 Author: JanKurs Time: 18-11-2014, 09:48:35.425 AM UUID: 06352c33-3c76-4382-8536-0cc48e225117 Name: PetitCompiler-Tests-JanKurs.21 Author: JanKurs Time: 17-11-2014, 05:51:53.134 PM UUID: 8d6c0799-14e7-4871-8d91-8b0f9886db83 Name: PetitCompiler-Benchmarks-JanKurs.2 Author: JanKurs Time: 17-11-2014, 05:51:07.887 PM UUID: d5e3a980-7871-487a-a232-e3ca93fc2483

"{ Package: 'stx:goodies/petitparser/compiler' }"

PPCListNode subclass:#PPCChoiceNode
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	category:'PetitCompiler-Nodes'
!

!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 whitespaceConsumed |

	whitespaceConsumed := false.
	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.
		whitespaceConsumed := true.
	].
	
	(1 to: children size) do: [ :idx  | |child allowGuard |
		child := children at: idx.
"		allowGuard := ((child isKindOf: PPCTrimmingTokenNode) and: [ whitespaceConsumed not ]) not.
"	
		allowGuard := whitespaceConsumed.
				
 		(allowGuard and: [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
! !