--- a/LazyValue.st Tue Jun 28 07:00:12 2016 +0200
+++ b/LazyValue.st Thu Jun 30 07:04:26 2016 +0200
@@ -9,12 +9,13 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-
"{ Package: 'stx:libbasic2' }"
+"{ NameSpace: Smalltalk }"
+
ProtoObject subclass:#LazyValue
- instanceVariableNames:'result block'
- classVariableNames:'AccessLock'
+ instanceVariableNames:'result block lock'
+ classVariableNames:''
poolDictionaries:''
category:'Kernel-Processes'
!
@@ -395,12 +396,6 @@
"
! !
-!LazyValue class methodsFor:'initialization'!
-
-initialize
- AccessLock := RecursionLock forMutualExclusion
-! !
-
!LazyValue class methodsFor:'instance creation'!
block:aBlock
@@ -420,13 +415,13 @@
_evaluate_
block notNil ifTrue:[
- AccessLock critical:[
- |b|
+ lock wait. "ensure that block is only executed once"
+ block notNil ifTrue:[
+ result := block value.
+ block := nil.
- (b := block) notNil ifTrue:[
- block := nil.
- result := b value.
- ].
+ lock signalForAll.
+ lock := nil.
].
].
^ result
@@ -434,43 +429,59 @@
!LazyValue methodsFor:'printing'!
-displayString
+displayOn:aGCOrStream
+
+ "/ what a kludge - Dolphin and Squeak mean: printOn: a stream;
+ "/ ST/X (and some old ST80's) mean: draw-yourself on a GC.
+ (aGCOrStream isStream) ifFalse:[
+ ^ self _evaluate_ displayOn:aGCOrStream
+ ].
+
block isNil ifTrue:[
- ^ 'LazyValue (unevaluated)'
- ].
- ^ 'LazyValue (evaluated)'
+ result displayOn:aGCOrStream.
+ aGCOrStream nextPutAll:' (lazyValue evaluated)'.
+ ^ self.
+ ].
+ aGCOrStream nextPutAll:'LazyValue (unevaluated)'
!
-printOn:aStream
- aStream nextPutAll:'(lazy)'
+displayString
+ |s|
+
+ "/ attention: TextStream is not present in ultra-mini standalone apps
+ s := TextStream isNil
+ ifTrue:['' writeStream]
+ ifFalse:[TextStream on:(String new:32)].
+ self displayOn:s.
+ ^ s contents
! !
!LazyValue methodsFor:'private access'!
block:aBlock
block := aBlock.
+ lock := Semaphore forMutualExclusion.
! !
!LazyValue methodsFor:'queries'!
class
^ self _evaluate_ class
+! !
+
+!LazyValue methodsFor:'testing'!
+
+isBehavior
+ ^ self _evaluate_ isBehavior
!
isLazyValue
^ block notNil
! !
-!LazyValue methodsFor:'testing'!
-
-isBehavior
- ^ self _evaluate_ isBehavior
-! !
-
!LazyValue class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic2/LazyValue.st,v 1.5 2005-01-26 13:54:57 stefan Exp $'
+ ^ '$Header$'
! !
-LazyValue initialize!