#QUALITY by stefan
authorStefan Vogel <sv@exept.de>
Wed, 27 Jul 2016 17:15:55 +0200
changeset 4006 1bd5da475215
parent 4005 688fdfafab0d
child 4007 da947b2313c9
#QUALITY by stefan class: Future added: #displayOn: #displayString #value comment/format in: #examples changed:14 methods support for inspecting
Future.st
--- a/Future.st	Wed Jul 27 15:00:38 2016 +0200
+++ b/Future.st	Wed Jul 27 17:15:55 2016 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  This is a Manchester Goodie protected by copyright.
  These conditions are imposed on the whole Goodie, and on any significant
@@ -85,7 +87,7 @@
                                                                     [exBegin]
     | fac |
 
-    fac := [5000 factorial] futureValue.
+    fac := [50000 factorial] futureValue.
     Transcript showCR: 'evaluating factorial...'.
     Dialog information:'You can do something useful now...'.
     Transcript showCR: fac
@@ -100,10 +102,10 @@
                                                                     [exBegin]
     | fac1 fac2 |
 
-    fac1 := [Transcript showCR: 'Starting fac1.. '. 1000 factorial] futureValue.
-    fac2 := [Transcript showCR: 'Starting fac2.. '. 2000 factorial] futureValue.
-    fac2 isString.
-    fac1 isString.
+    fac1 := [Transcript showCR: 'Starting fac1.. '. 9000 factorial. Transcript showCR: 'Finished fac1'] futureValue.
+    fac2 := [Transcript showCR: 'Starting fac2.. '. 5000 factorial. Transcript showCR: 'Finished fac2'] futureValue.
+    fac2 value.
+    fac1 value.
     Transcript showCR: 'both completed.'.
                                                                     [exEnd]
 
@@ -174,7 +176,9 @@
      of the block has terminated are suspended until it has terminated."
 
     semaphore := Semaphore new name:'Future'.
-    [result := aBlock ensure:[semaphore signal]] fork
+    [
+        [result := aBlock value] ensure:[semaphore signal. semaphore := nil.]
+    ] fork
 
     "Modified (format): / 04-10-2011 / 14:54:11 / cg"
 !
@@ -186,9 +190,9 @@
 
     semaphore := Semaphore new name:'Future'.
     [
-        result := [
-            aBlock value:aValue
-        ] ensure:[semaphore signal]
+        [
+            result := aBlock value:aValue
+        ] ensure:[semaphore signal. semaphore := nil.]
     ] fork
 
     "Modified (format): / 04-10-2011 / 14:54:18 / cg"
@@ -201,9 +205,9 @@
 
     semaphore := Semaphore new name:'Future'.
     [
-        result := [
-            aBlock value:value1 value:value2
-        ] ensure:[semaphore signal]
+        [
+            result := aBlock value:value1 value:value2
+        ] ensure:[semaphore signal. semaphore := nil.]
     ] fork
 
     "Modified (format): / 04-10-2011 / 14:54:28 / cg"
@@ -216,9 +220,9 @@
 
     semaphore := Semaphore new name:'Future'.
     [
-        result := [
-            aBlock value:value1 value:value2 value:value3
-        ] ensure:[semaphore signal]
+        [
+            result := aBlock value:value1 value:value2 value:value3
+        ] ensure:[semaphore signal. semaphore := nil.]
     ] fork
 
     "Modified (format): / 04-10-2011 / 14:54:45 / cg"
@@ -231,9 +235,9 @@
 
     semaphore := Semaphore new name:'Future'.
     [
-        result := [
-            aBlock valueWithArguments:anArray
-        ] ensure:[semaphore signal]
+        [
+            result := aBlock valueWithArguments:anArray
+        ] ensure:[semaphore signal. semaphore := nil.]
     ] fork
 
     "Modified (format): / 04-10-2011 / 14:55:09 / cg"
@@ -246,7 +250,7 @@
 
     semaphore := Semaphore new name:'Future'.
     [
-        result := aBlock ensure:[semaphore signal]
+        [result := aBlock value] ensure:[semaphore signal. semaphore := nil.]
     ] forkAt:prio
 
     "Created: / 04-10-2011 / 14:53:21 / cg"
@@ -259,9 +263,9 @@
 
     semaphore := Semaphore new name:'Future'.
     [
-        result := [
-            aBlock value:aValue
-        ] ensure:[semaphore signal]
+        [
+            result := aBlock value:aValue
+        ] ensure:[semaphore signal. semaphore := nil.]
     ] forkAt:prio
 
     "Created: / 04-10-2011 / 14:53:35 / cg"
@@ -274,9 +278,9 @@
 
     semaphore := Semaphore new name:'Future'.
     [
-        result := [
-            aBlock value:value1 value:value2
-        ] ensure:[semaphore signal]
+        [
+            result := aBlock value:value1 value:value2
+        ] ensure:[semaphore signal. semaphore := nil.]
     ] forkAt:prio
 
     "Created: / 04-10-2011 / 14:54:03 / cg"
@@ -289,9 +293,9 @@
 
     semaphore := Semaphore new name:'Future'.
     [
-        result := [
-            aBlock value:value1 value:value2 value:value3
-        ] ensure:[semaphore signal]
+        [
+            result := aBlock value:value1 value:value2 value:value3
+        ] ensure:[semaphore signal. semaphore := nil.]
     ] forkAt:prio
 
     "Created: / 04-10-2011 / 14:54:51 / cg"
@@ -304,32 +308,54 @@
 
     semaphore := Semaphore new name:'Future'.
     [
-        result := [
-            aBlock valueWithArguments:anArray
-        ] ensure:[semaphore signal]
+        [
+            result := aBlock valueWithArguments:anArray
+        ] ensure:[semaphore signal. semaphore := nil.]
     ] forkAt:prio
 
     "Created: / 04-10-2011 / 14:55:14 / cg"
 ! !
 
+!Future 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:' (Future evaluated)'.
+        ^ self.
+    ].    
+    aGCOrStream nextPutAll:'Future (unevaluated)'
+!
+
+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
+! !
+
 !Future methodsFor:'synchronising'!
 
 doesNotUnderstand:aMessage
     "Any message to a Future will end up here."
 
-    result isNil ifTrue:[
+    semaphore notNil ifTrue:[
         IsDebuggingQuery query ifTrue:[
-            (#(instVarAt: isKindOf:) includes:aMessage selector) ifTrue:[
-                "enable debugging / inspecting"
-                ^ (Object compiledMethodAt:aMessage selector)
-                    valueWithReceiver:self
-                    arguments:aMessage arguments
-                    selector:aMessage selector
-             ].
-        ] ifFalse:[
-            semaphore waitUncounted. "Wait for evaluation to complete"
-                                     "(if not already completed)"
+            "enable debugging / inspecting"
+            ^ aMessage sendTo:self usingClass:Object.
         ].
+        self value.
     ].
     ^ aMessage sendTo:result
 
@@ -337,7 +363,10 @@
 !
 
 value
-    result isNil ifTrue:[
+    |sema|
+
+    sema := semaphore.
+    sema notNil ifTrue:[
         semaphore waitUncounted. "Wait for evaluation to complete"
                                  "(if not already completed)"
     ].
@@ -349,13 +378,13 @@
 !Future methodsFor:'testing'!
 
 hasValue
-    ^ result notNil or:[semaphore wouldBlock not]
+    ^ semaphore isNil or:[semaphore wouldBlock not].
 
     "Modified: / 04-10-2011 / 17:29:36 / cg"
 !
 
 isLazyValue
-    ^ result isNil and:[semaphore isNil or:[semaphore wouldBlock]]
+    ^ semaphore notNil and:[semaphore wouldBlock]
 ! !
 
 !Future class methodsFor:'documentation'!