Another update from ingydotnet^djgoku

Task/Delegates/ALGOL-68/delegates.alg

@@ -0,0 +1,75 @@
+# An Algol 68 approximation of delegates                                #
+
+# The delegate mode - the delegate is a STRUCT with a single field      #
+# that is a REF PROC STRING. If this is NIL, it doesn't implement       #
+# thing                                                                 #
+MODE DELEGATE  = STRUCT( REF PROC STRING thing );
+
+
+# A delegator mode that will invoke the delegate's thing method         #
+# - if there is a delegate and the delegate has a thing method          #
+MODE DELEGATOR = STRUCT( REF DELEGATE delegate
+                       , PROC( REF DELEGATE )STRING thing
+                       );
+
+# constructs a new DELEGATE with the specified PROC as its thing        #
+# Algol 68 HEAP is like "new" in e.g. Java, but it can't take           #
+# parameters, so this PROC does the equivalent                          #
+PROC new delegate = ( REF PROC STRING thing )REF DELEGATE:
+    BEGIN
+        REF DELEGATE result = HEAP DELEGATE;
+        thing OF result := thing;
+
+        result
+    END # new delegate #
+;
+
+# constructs a new DELEGATOR with the specified DELEGATE                #
+PROC new delegator = ( REF DELEGATE delegate )REF DELEGATOR:
+    HEAP DELEGATOR := ( delegate
+                      , # anonymous PROC to invoke the delegate's thing #
+                        ( REF DELEGATE delegate )STRING:
+                            IF delegate IS REF DELEGATE(NIL)
+                            THEN
+                                # we have no delegate #
+                                "default implementation"
+
+                            ELIF thing OF delegate IS REF PROC STRING(NIL)
+                            THEN
+                                # the delegate doesn't have an implementation #
+                                "default implementation"
+
+                            ELSE
+                                # the delegate can thing #
+                                thing OF delegate
+
+                            FI
+                      )
+;
+
+
+# invokes the delegate's thing via the delagator                        #
+# Because the PROCs of a STRUCT don't have an equivalent of e.g. Java's #
+# "this", we have to explicitly pass the delegate as a parameter        #
+PROC invoke thing = ( REF DELEGATOR delegator )STRING:
+    # the following is Algol 68 for what would be written in Java as    #
+    #                           "delegator.thing( delegator.delegate )" #
+    ( thing OF delegator )( delegate OF delegator )
+;
+
+main:
+(
+
+    print( ( "No delegate           : "
+           , invoke thing( new delegator( NIL ) )
+           , newline
+           , "Delegate with no thing: "
+           , invoke thing( new delegator( new delegate( NIL ) ) )
+           , newline
+           , "Delegate with a thing : "
+           , invoke thing( new delegator( new delegate( HEAP PROC STRING := STRING: ( "delegate implementation" ) ) ) )
+           , newline
+           )
+         )
+
+)

Task/Delegates/Forth/delegates.fth

@@ -0,0 +1,67 @@
+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
+
+delegate slave
+
+:class delegator
+  ivar del  \ object container
+  :m !: ( n -- ) del ! ;m
+  :m init: 0 del ! ;m
+  :m default ." default implementation" ;m
+  :m operation
+     del @ 0= if self default exit then
+     del @ [has-meth] thing
+     if del @ thing
+     else self default
+     then ;m
+;class
+
+delegator master
+
+\ First, without a delegate
+master operation \ => default implementation
+
+\ then with a delegate that does not implement "thing"
+object o
+o master !:
+master operation \ => default implementation
+
+\ and last with a delegate that implements "thing"
+slave master !:
+master operation \ => delegate implementation

Task/Delegates/Mathematica/delegates.math

@@ -0,0 +1,6 @@
+delegator[del_]@operate :=
+  If[StringQ[del@operate], del@operate, "default implementation"];
+del1 = Null;
+del2@banana = "phone";
+del3@operate = "delegate implementation";
+Print[delegator[#]@operate] & /@ {del1, del2, del3};