islands/PPMemoizingIsland.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Wed, 08 Oct 2014 21:56:20 +0100
changeset 388 74c9c229033b
parent 387 e2b2ccaa4de6
child 420 b2f2f15cef26
permissions -rw-r--r--
Workaround to fix PPComposedTest>>testLeftRecursion - make PPStream>>size returning size of the input. For whatever reason, in Smalltalk/X ReadStream>>size returns size remaning data, not the size of a whole stream. This is a bug and should be fixed in Smalltalk/X libbasic. Meanwhile, override PPStream>>size to return proper value. In Pharo, the method is not needed as the inherited method is exactly the same.

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

PPIsland subclass:#PPMemoizingIsland
	instanceVariableNames:'rootParser memoizationDictionaries'
	classVariableNames:''
	poolDictionaries:''
	category:'PetitIslands-Parsers'
!

PPMemoizingIsland comment:'A PPMemoizingIsland is memoized version of PPIsland. Use this one, unless you don''t mind really bad performance. If the memoized version is not working flawlessly, its a bug!!

Please see help of the PPIsland for how to use...

Instance Variables
	memoizationDictionaries:		<Object>
	rootParser:		<Object>

memoizationDictionaries
	- memoization cache

rootParser
	- used for memoizing, once the root changes, flushes the caches
'
!

!PPMemoizingIsland class methodsFor:'as yet unclassified'!

initialize 
	super initialize 
! !

!PPMemoizingIsland methodsFor:'accessing'!

island: anObject

	island ifNil: [
		super island: anObject.
	] ifNotNil: [
		self error: 'JK: I do not want to do this' .
	] 
! !

!PPMemoizingIsland methodsFor:'initialization'!

initialize 
	super initialize.

	memoizationDictionaries := IdentityDictionary new.
! !

!PPMemoizingIsland methodsFor:'memoization'!

memoizationDictionaryForContext: aPPContext
	^ memoizationDictionaries at: aPPContext ifAbsentPut: [IdentityDictionary new].
!

memoizeResult: result onContext: aPPContext position: pos
	| memento |
	
	memento := PPMemento new.
	memento contextMemento: aPPContext remember.
	memento result: result.
	
	(self memoizationDictionaryForContext: aPPContext) at: pos put: memento.
!

memoizedResult: aPPContext
	^ (self memoizationDictionaryForContext: aPPContext) at: (aPPContext position) ifAbsent: [ nil ].
	
! !

!PPMemoizingIsland methodsFor:'parsing'!

memoized
	"We have our own implementation of memoization"
	^ self
!

nonMemoized 
	^ PPIsland new
		island: self island;
		yourself
!

parseOn: aPPContext 
	|  memoizedResult parsingPosition retval |
	memoizedResult := self memoizedResult: aPPContext.
	memoizedResult ifNotNil: [ 
		aPPContext restore: memoizedResult contextMemento.
		^ memoizedResult result 
	].
	parsingPosition := aPPContext position.
	
	retval := super parseOn: aPPContext.

	(aPPContext waterPosition == aPPContext position) ifFalse: [ 
		self memoizeResult: retval onContext: aPPContext position: parsingPosition.
	].

	^ retval.

! !


PPMemoizingIsland initialize!