DelayedValue.st
changeset 5035 d7ebd3f79b75
child 5036 470d8976544f
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/DelayedValue.st	Tue Jun 25 10:32:00 2019 +0200
@@ -0,0 +1,235 @@
+"
+ COPYRIGHT (c) 2019 by eXept Software AG
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic2' }"
+
+"{ NameSpace: Smalltalk }"
+
+ProtoObject subclass:#DelayedValue
+	instanceVariableNames:'result semaphore'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Kernel-Processes'
+!
+
+!DelayedValue class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2019 by eXept Software AG
+              All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+    I am similar to a Future, in that I represent an execution in progress, 
+    whose value will be required some time in the future.
+    In contrast to a future, which itself spawns a thread to perform the computation,
+    my value comes from an external source (typically, an event or incoming message from an
+    interprocess communication channel)
+    I will delay any messages sent to me, until the execution has completed (i.e. the value was provided).
+    This is useful to return values from external sources (print jobs, compile jobs etc.),
+    which can be done in the background and the user can do something else
+    in the meantime. 
+    If the computation is finished before the user needs its value, he is not forced to wait.
+    If the computation is unfinished, he has to wait for the remaining time only.
+
+    [author:]
+        cg
+
+    [see also:]
+        Block Lazy LazyValue Future
+"
+!
+
+examples
+"
+  Waits for someon else to provide a value after some time-consuming computation
+  (could be a remote process, sending me an event):
+                                                                    [exBegin]
+    | delayedValue |
+
+    delayedValue := DelayedValue new.
+    [
+        Transcript showCR: 'evaluating factorial...'.
+        Delay waitForSeconds:2.
+        delayedValue value:(100 factorial).
+        Transcript showCR: 'done...'.
+    ] fork.    
+    Transcript showCR:'The value is: %1' with:delayedValue
+                                                                    [exEnd]
+"
+! !
+
+!DelayedValue class methodsFor:'instance creation'!
+
+new
+    "return an initialized instance"
+
+    ^ self basicNew initialize.
+! !
+
+!DelayedValue methodsFor:'initialization'!
+
+initialize
+    "Invoked when a new instance is created."
+
+    semaphore := Semaphore new.
+
+    "Modified: / 25-06-2019 / 10:28:50 / Claus Gittinger"
+! !
+
+!DelayedValue methodsFor:'printing'!
+
+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 value displayOn:aGCOrStream
+    ].
+
+    semaphore isNil ifTrue:[
+        result displayOn:aGCOrStream.
+        aGCOrStream nextPutAll:' ('; nextPutAll:self class name; nextPutAll:' (evaluated)'.
+        ^ self.
+    ].    
+    aGCOrStream nextPutAll:self class name; nextPutAll:' (unevaluated)'
+
+    "Modified (format): / 25-06-2019 / 09:09:58 / Claus Gittinger"
+!
+
+displayString
+    "defined here, because I inherit from nobody"
+    
+    ^ (Object compiledMethodAt:#displayString)
+        valueWithReceiver:self
+        arguments:nil
+        selector:#displayString
+
+    "Modified: / 25-06-2019 / 09:46:22 / Claus Gittinger"
+! !
+
+!DelayedValue methodsFor:'providing value'!
+
+errorValueAlreadyProvided
+    self error:'value can only be provided once'
+
+    "Created: / 25-06-2019 / 10:30:25 / Claus Gittinger"
+!
+
+value:anyObject
+    "value is now provided.
+     If anyone is waiting on me, signal the semaphore"
+
+    |sema|
+    
+    (sema := semaphore) notNil ifTrue:[
+        result := anyObject.
+        semaphore := nil.
+        sema signal.
+    ] ifFalse:[
+        self errorValueAlreadyProvided
+    ].
+
+    "Created: / 25-06-2019 / 10:22:10 / Claus Gittinger"
+! !
+
+!DelayedValue methodsFor:'synchronising'!
+
+doesNotUnderstand:aMessage
+    "Any message to a Future will end up here."
+
+    |sema|
+    
+    (sema := semaphore) notNil ifTrue:[
+        Processor activeProcess isDebuggerProcess ifTrue:[
+            "enable debugging / inspecting"
+            ^ aMessage sendTo:self usingClass:Object.
+        ].
+        sema waitUncounted. "Wait for evaluation to complete"
+                            "(if not already completed)"
+    ].
+    ^ aMessage sendTo:result
+
+    "Modified: / 04-10-2011 / 17:37:18 / cg"
+    "Modified: / 01-02-2018 / 10:17:48 / stefan"
+    "Modified: / 25-06-2019 / 07:52:42 / Claus Gittinger"
+!
+
+perform:aSelector withArguments:argArray
+    "send the message aSelector with all args taken from argArray
+     to the receiver."
+
+    |sema|
+
+    (sema := semaphore) notNil ifTrue:[
+        Processor activeProcess isDebuggerProcess ifTrue:[
+            "enable debugging / inspecting"
+            ^ super perform:aSelector withArguments:argArray.
+        ].
+        sema waitUncounted.
+    ].
+    ^ result perform:aSelector withArguments:argArray.
+
+    "Modified (format): / 01-02-2018 / 10:17:44 / stefan"
+    "Modified: / 25-06-2019 / 07:53:01 / Claus Gittinger"
+!
+
+value
+    "retrieve the value, possibly waiting for the result to arrive"
+    
+    |sema|
+
+    (sema := semaphore) notNil ifTrue:[
+        sema waitUncounted. "Wait for evaluation to complete"
+                            "(if not already completed)"
+    ].
+    ^ result
+
+    "Created: / 04-10-2011 / 17:36:06 / cg"
+    "Modified (comment): / 25-06-2019 / 07:53:28 / Claus Gittinger"
+! !
+
+!DelayedValue methodsFor:'testing'!
+
+hasValue
+    "true if I have already a value 
+     (i.e. would not block when sending me a message)"
+     
+    ^ semaphore isNil or:[semaphore wouldBlock not].
+
+    "Modified: / 04-10-2011 / 17:29:36 / cg"
+    "Modified (comment): / 25-06-2019 / 10:23:54 / Claus Gittinger"
+!
+
+isLazyValue
+    "true if I have no value yet 
+     (i.e. would block when sending me a message)"
+
+    ^ semaphore notNil and:[semaphore wouldBlock]
+
+    "Modified (comment): / 25-06-2019 / 10:23:48 / Claus Gittinger"
+! !
+
+!DelayedValue class methodsFor:'documentation'!
+
+version_CVS
+    ^ '$Header$'
+! !
+