September 2017 Update

Task/Delegates/Elena/delegates-1.elena

@@ -0,0 +1,54 @@
+import extensions.
+import system'routines.
+
+class IOperable
+{
+    operate
+    [
+        NotSupportedException new; raise.
+    ]
+}
+
+class Operable :: IOperable
+{
+    operate
+        = "delegate implementation".
+}
+
+class Delegator
+{
+    object theDelegate.
+
+    constructor new
+    [
+        theDelegate := nil.
+    ]
+
+    set Delegate:obj
+    [
+        if ($nil == obj)
+            [ theDelegate := $nil. ];
+            [ theDelegate := obj. ].
+    ]
+
+    operate(Object operable)
+        = "default implementation".
+
+    operate(IOperable operable)
+        = operable operate.
+
+    operate
+        <= operate(theDelegate).
+}
+
+program =
+[
+    var delegator := Delegator new.
+
+    (nil, Object new, Operable new) forEach(:o)
+    [
+       delegator Delegate := o.
+
+       console printLine(delegator operate).
+    ].
+].

Task/Delegates/Elena/delegates-2.elena

@@ -0,0 +1,53 @@
+import extensions.
+import system'routines.
+
+class Operable
+{
+    operable = $self.
+
+    operate
+        = "delegate implementation".
+}
+
+class Delegator
+{
+    object theDelegate.
+
+    constructor new
+    [
+        theDelegate := nil.
+    ]
+
+    set Delegate:obj
+    [
+        if ($nil == obj)
+            [ theDelegate := $nil. ];
+            [ theDelegate := obj. ].
+    ]
+
+    operate
+    [
+        // if the object does not support "get&operable" message - returns nil
+        var anOperable := theDelegate operable \ back:$nil.
+
+        if ($nil == anOperable)
+        [
+            ^ "default implementation".
+        ];
+        [
+            ^ anOperable operate.
+        ].
+    ]
+}
+
+program =
+[
+    var delegator := Delegator new.
+
+    (nil, Object new, Operable new) forEach(:o)
+    [
+       delegator Delegate := o.
+
+       console printLine(delegator operate).
+    ].
+].

Task/Delegates/Elena/delegates.elena

@@ -1,48 +0,0 @@
-#import system.
-#import system'routines.
-
-#class Operable
-{
-    #method cast:verb &to:target
-        = target::verb eval &delegate:$self.
-
-    #method operate
-        = "delegate implementation".
-}
-
-#class Delegator
-{
-    #field theDelegate.
-
-    #constructor new
-    [
-        theDelegate := nil.
-    ]
-
-    #method set &Delegate:obj
-    [
-        ($nil == obj)
-            ? [ theDelegate := nil. ]
-            ! [ theDelegate := obj. ].
-    ]
-
-    #method operate
-        = theDelegate cast:%eval &to:
-            {
-                delegate : o = o operate.
-
-                ! : o = "default implementation".
-            }.
-}
-
-#symbol program =
-[
-    #var delegator := Delegator new.
-
-    ($nil, Object new, Operable new) run &each: o
-    [
-       delegator set &Delegate:o.
-
-       console writeLine:(delegator operate).
-    ].
-].

Task/Delegates/Forth/delegates.fth

@@ -1,38 +1,5 @@
 include FMS-SI.f
 
--1 [if] \ add optional introspection facility to FMS
-
-: fm' ( selector-ID link -- xt | 0 ) \ find method, linked-list search
-  begin @ dup
-  while 2dup cell+ @ =
-  if [ 2 cells ] literal + nip @ exit then
-  repeat 2drop false ;
-
-: has-meth-L ( obj addr -- xt | 0 )
-  swap >class over @ + fm' ;
-
-: >xt' ( table-offset ^dispatch -- xt | 0 )
-  2dup @ > if 2drop false exit then
-  + @ ;
-
-: has-meth-D ( obj addr -- xt | 0 )
-  @ swap @ >xt' ;
-
-: (has-meth) ( obj addr sel-type -- xt | 0 )
-  seltype-L =
-  if   ( obj addr ) has-meth-L
-  else ( obj addr ) has-meth-D
-  then ;
-
-: [has-meth] ( obj "messageName" -- xt | 0 ) \ compile time only, can use ex-meth on xt to execute the method
-  ' >body dup postpone literal cell+ @ postpone literal postpone (has-meth) ; immediate
-
-: has-meth ( obj "messageName" -- xt | 0 ) \ interpret time only, can use ex-meth on xt to execute the method
-  ' >body dup cell+ @ (has-meth) ;
-[then]
-
-
-
 :class delegate
   :m thing ." delegate implementation" ;m
 ;class
@@ -46,7 +13,7 @@ delegate slave
   :m default ." default implementation" ;m
   :m operation
      del @ 0= if self default exit then
-     del @ [has-meth] thing
+     del @ has-meth thing
      if del @ thing
      else self default
      then ;m

Task/Delegates/OoRexx/delegates.rexx

@@ -0,0 +1,40 @@
+delegator = .delegator~new   -- no delegate
+say delegator~operation
+-- an invalid delegate type
+delegator~delegate = "Some string"
+say delegator~operation
+-- a good delegate
+delegator~delegate = .thing~new
+say delegator~operation
+-- a directory object with a thing entry defined
+d = .directory~new
+d~thing = "delegate implementation"
+delegator~delegate = d
+say delegator~operation
+
+-- a class we can use as a delegate
+::class thing
+::method thing
+  return "delegate implementation"
+
+::class delegator
+::method init
+  expose delegate
+  use strict arg delegate = .nil
+
+::attribute delegate
+
+::method operation
+  expose delegate
+  if delegate == .nil then return "default implementation"
+
+  -- Note:  We could use delegate~hasMethod("THING") to check
+  -- for a THING method, but this will fail of the object relies
+  -- on an UNKNOWN method to handle the method.  By trapping
+  -- NOMETHOD conditions, we can allow those calls to go
+  -- through
+  signal on nomethod
+  return delegate~thing
+
+nomethod:
+  return "default implementation"

Task/Delegates/Zkl/delegates-1.zkl

@@ -0,0 +1,11 @@
+class Thingable{ var thing; }
+
+class Delegator{
+   var delegate;
+   fcn operation{
+      if (delegate) delegate.thing;
+      else "default implementation"
+   }
+}
+
+class Delegate(Thingable){ thing = "delegate implementation" }

Task/Delegates/Zkl/delegates-2.zkl

@@ -0,0 +1,7 @@
+    // Without a delegate:
+a:= Delegator();
+a.operation().println(); //--> "default implementation"
+
+    // With a delegate:
+a.delegate = Delegate();
+a.operation().println(); //-->"delegate implementation"

Task/Delegates/Zkl/delegates-3.zkl

@@ -0,0 +1,6 @@
+class [static] Logger{ // Only one logging resource
+   var [mixin=File] dst; // File like semantics, eg Data, Pipe
+   dst = File.DevNull;
+   // initially, the logger does nothing
+   fcn log(msg){dst.writeln(vm.pasteArgs())}
+}

Task/Delegates/Zkl/delegates-4.zkl

@@ -0,0 +1,6 @@
+Logger.log("this is a test"); //-->nada
+Logger.dst=Console;
+Logger.log("this is a test 2"); //-->writes to Console
+
+class B(Logger){ log("Hello from ",self,"'s constructor"); }
+B(); //-->Hello from Class(B)'s constructor