tasks a-s

Task/Polymorphic-copy/0DESCRIPTION

@@ -0,0 +1,8 @@
+An object is [[polymorphism|polymorphic]] when its specific type may vary. The types a specific value may take, is called ''class''.
+
+It is trivial to copy an object if its type is known:
+<lang c>int x;
+int y = x;</lang>
+Here x is not polymorphic, so y is declared of same type (''int'') as x. But if the specific type of x were unknown, then y could not be declared of any specific type.
+
+The task: let a polymorphic object contain an instance of some specific type S derived from a type T. The type T is known. The type S is possibly unknown until [[run time]]. The objective is to create an exact copy of such polymorphic object (not to create a [[reference]], nor a pointer to). Let further the type T have a method overridden by S. This method is to be called on the copy to demonstrate that the specific type of the copy is indeed S.

Task/Polymorphic-copy/1META.yaml

@@ -0,0 +1,2 @@
+---
+note: Object oriented

Task/Polymorphic-copy/Ada/polymorphic-copy.ada

@@ -0,0 +1,42 @@
+with Ada.Text_IO;  use Ada.Text_IO;
+
+procedure Test_Polymorphic_Copy is
+   package Base is
+      type T is tagged null record;
+      function Name (X : T) return String;
+   end Base;
+   use Base;
+
+   package body Base is
+      function Name (X : T) return String is
+      begin
+         return "T";
+      end Name;
+   end Base;
+
+      -- The procedure knows nothing about S
+   procedure Copier (X : T'Class) is
+      Duplicate : T'Class := X;  -- A copy of X
+   begin
+      Put_Line ("Copied " & Duplicate.Name); -- Check the copy
+   end Copier;
+
+   package Derived is
+      type S is new T with null record;
+      overriding function Name (X : S) return String;
+   end Derived;
+   use Derived;
+
+   package body Derived is
+      function Name (X : S) return String is
+      begin
+         return "S";
+      end Name;
+   end Derived;
+
+   Object_1 : T;
+   Object_2 : S;
+begin
+   Copier (Object_1);
+   Copier (Object_2);
+end Test_Polymorphic_Copy;

Task/Polymorphic-copy/Aikido/polymorphic-copy.aikido

@@ -0,0 +1,23 @@
+class T {
+    public function print {
+        println ("class T")
+    }
+}
+
+class S extends T {
+    public function print {
+        println ("class S")
+    }
+}
+
+var t = new T()
+var s = new S()
+println ("before copy")
+t.print()
+s.print()
+
+var tcopy = clone (t, false)
+var scopy = clone (s, false)
+println ("after copy")
+tcopy.print()
+scopy.print()

Task/Polymorphic-copy/BBC-BASIC/polymorphic-copy.bbc

@@ -0,0 +1,28 @@
+      INSTALL @lib$ + "CLASSLIB"
+
+      REM Create parent class T:
+      DIM classT{array#(0), setval, retval}
+      DEF classT.setval (n%,v) classT.array#(n%) = v : ENDPROC
+      DEF classT.retval (n%) = classT.array#(n%)
+      PROC_class(classT{})
+
+      REM Create class S derived from T, known only at run-time:
+      RunTimeSize% = RND(100)
+      DIM classS{array#(RunTimeSize%)}
+      PROC_inherit(classS{}, classT{})
+      DEF classS.retval (n%) = classS.array#(n%) ^ 2 : REM Overridden method
+      PROC_class(classS{})
+
+      REM Create an instance of class S:
+      PROC_new(myobject{}, classS{})
+
+      REM Now make a copy of the instance:
+      DIM mycopy{} = myobject{}
+      mycopy{} = myobject{}
+      PROC_discard(myobject{})
+
+      REM Test the copy (should print 123^2):
+      PROC(mycopy.setval)(RunTimeSize%, 123)
+      result% = FN(mycopy.retval)(RunTimeSize%)
+      PRINT result%
+      END

Task/Polymorphic-copy/C++/polymorphic-copy.cpp

@@ -0,0 +1,50 @@
+#include <iostream>
+
+class T
+{
+public:
+  virtual void identify() { std::cout << "I am a genuine T" << std::endl; }
+  virtual T* clone() { return new T(*this); }
+  virtual ~T() {}
+};
+
+class S: public T
+{
+public:
+  virtual void identify() { std::cout << "I am an S" << std::endl; }
+  virtual S* clone() { return new S(*this); }
+};
+
+class X // the class of the object which contains a T or S
+{
+public:
+  // by getting the object through a pointer to T, X cannot know if it's an S or a T
+  X(T* t): member(t) {}
+
+  // copy constructor
+  X(X const& other): member(other.member->clone()) {}
+
+  // copy assignment operator
+  X& operator=(X const& other)
+  {
+    T* new_member = other.member->clone();
+    delete member;
+    member = new_member;
+  }
+
+  // destructor
+  ~X() { delete member; }
+
+  // check what sort of object it contains
+  void identify_member() { member->identify(); }
+
+private:
+  T* member;
+};
+
+int main()
+{
+  X original(new S);      // construct an X and give it an S,
+  X copy = original;      // copy it,
+  copy.identify_member(); // and check what type of member it contains
+}

Task/Polymorphic-copy/C/polymorphic-copy.c

@@ -0,0 +1,202 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+typedef struct object *BaseObj;
+typedef struct sclass *Class;
+typedef void (*CloneFctn)(BaseObj s, BaseObj clo);
+typedef const char * (*SpeakFctn)(BaseObj s);
+typedef void (*DestroyFctn)(BaseObj s);
+
+typedef struct sclass {
+    size_t csize;		/* size of the class instance */
+    const char  *cname;		/* name of the class */
+    Class  parent;		/* parent class */
+
+    CloneFctn clone;		/* clone function */
+    SpeakFctn speak;		/* speak function */
+    DestroyFctn del;		/* delete the object */
+} sClass;
+
+typedef struct object {
+    Class class;
+} SObject;
+
+static
+BaseObj obj_copy( BaseObj s, Class c )
+{
+    BaseObj clo;
+    if (c->parent)
+        clo = obj_copy( s, c->parent);
+    else
+        clo = malloc( s->class->csize );
+
+    if (clo)
+        c->clone( s, clo );
+    return clo;
+}
+
+static
+void obj_del( BaseObj s, Class c )
+{
+    if (c->del)
+        c->del(s);
+    if (c->parent)
+        obj_del( s, c->parent);
+    else
+        free(s);
+}
+
+BaseObj ObjClone( BaseObj s )
+{ return obj_copy( s, s->class ); }
+
+const char * ObjSpeak( BaseObj s )
+{
+    return s->class->speak(s);
+}
+
+void ObjDestroy( BaseObj s )
+{ if (s) obj_del( s, s->class ); }
+
+/* * * * * * */
+static
+void baseClone( BaseObj s, BaseObj clone)
+{
+    clone->class = s->class;
+}
+
+static
+const char *baseSpeak(BaseObj s)
+{
+    return "Hello, I'm base object";
+}
+
+sClass boc = { sizeof(SObject), "BaseObj", NULL,
+    &baseClone, &baseSpeak, NULL };
+Class BaseObjClass = &boc;
+
+/* * * * * * */
+/* Dog - a derived class */
+
+typedef struct sDogPart {
+    double weight;
+    char color[32];
+    char name[24];
+} DogPart;
+
+typedef struct sDog *Dog;
+
+struct sDog {
+    Class   class;		// parent structure
+    DogPart dog;
+};
+
+static
+void dogClone( BaseObj s, BaseObj c)
+{
+    Dog src = (Dog)s;
+    Dog clone = (Dog)c;
+    clone->dog = src->dog;	/* no pointers so strncpys not needed */
+}
+
+static
+const char *dogSpeak( BaseObj s)
+{
+    Dog d = (Dog)s;
+    static char  response[90];
+    sprintf(response, "woof! woof! My name is %s. I'm a %s %s",
+            d->dog.name, d->dog.color, d->class->cname);
+    return response;
+}
+
+
+sClass dogc = { sizeof(struct sDog), "Dog", &boc,
+    &dogClone, &dogSpeak, NULL };
+Class DogClass = &dogc;
+
+BaseObj NewDog( const char *name, const char *color, double weight )
+{
+    Dog dog = malloc(DogClass->csize);
+    if (dog) {
+        DogPart *dogp = &dog->dog;
+        dog->class = DogClass;
+        dogp->weight = weight;
+        strncpy(dogp->name, name, 23);
+        strncpy(dogp->color, color, 31);
+    }
+    return (BaseObj)dog;
+}
+
+/* * * * * * * * * */
+/* Ferret - a derived class */
+
+typedef struct sFerretPart {
+    char color[32];
+    char name[24];
+    int  age;
+} FerretPart;
+
+typedef struct sFerret *Ferret;
+
+struct sFerret {
+    Class   class;		// parent structure
+    FerretPart ferret;
+};
+
+static
+void ferretClone( BaseObj s, BaseObj c)
+{
+    Ferret src = (Ferret)s;
+    Ferret clone = (Ferret)c;
+    clone->ferret = src->ferret;  /* no pointers so strncpys not needed */
+}
+
+static
+const char *ferretSpeak(BaseObj s)
+{
+    Ferret f = (Ferret)s;
+    static char  response[90];
+    sprintf(response, "My name is %s. I'm a %d mo. old %s wiley %s",
+            f->ferret.name, f->ferret.age, f->ferret.color,
+            f->class->cname);
+    return response;
+}
+
+sClass ferretc = { sizeof(struct sFerret), "Ferret", &boc,
+    &ferretClone, &ferretSpeak, NULL };
+Class FerretClass = &ferretc;
+
+BaseObj NewFerret( const char *name, const char *color, int age )
+{
+    Ferret ferret = malloc(FerretClass->csize);
+    if (ferret) {
+        FerretPart *ferretp = &(ferret->ferret);
+        ferret->class = FerretClass;
+        strncpy(ferretp->name, name, 23);
+        strncpy(ferretp->color, color, 31);
+        ferretp->age = age;
+    }
+    return (BaseObj)ferret;
+}
+
+/* * Now you really understand why Bjarne created C++ * */
+
+int main()
+{
+    BaseObj  o1;
+    BaseObj  kara = NewFerret( "Kara", "grey", 15 );
+    BaseObj  bruce = NewDog("Bruce", "yellow", 85.0 );
+    printf("Ok created things\n");
+
+    o1 = ObjClone(kara );
+    printf("Karol says %s\n", ObjSpeak(o1));
+    printf("Kara says %s\n", ObjSpeak(kara));
+    ObjDestroy(o1);
+
+    o1 = ObjClone(bruce );
+    strncpy(((Dog)o1)->dog.name, "Donald", 23);
+    printf("Don says %s\n", ObjSpeak(o1));
+    printf("Bruce says %s\n", ObjSpeak(bruce));
+    ObjDestroy(o1);
+    return 0;
+}

Task/Polymorphic-copy/Common-Lisp/polymorphic-copy-1.lisp

@@ -0,0 +1,12 @@
+(defstruct super foo)
+
+(defstruct (sub (:include super)) bar)
+
+(defgeneric frob (thing))
+
+(defmethod frob ((super super))
+  (format t "~&Super has foo = ~w." (super-foo super)))
+
+(defmethod frob ((sub sub))
+  (format t "~&Sub has foo = ~w, bar = ~w."
+          (sub-foo sub) (sub-bar sub)))

Task/Polymorphic-copy/Common-Lisp/polymorphic-copy-2.lisp

@@ -0,0 +1,5 @@
+(defmethod frob ((sequence sequence))
+  (format t "~&sequence has ~w elements" (length sequence)))
+
+(defmethod frob ((string string))
+  (format t "~&the string has ~w elements" (length string)))

Task/Polymorphic-copy/D/polymorphic-copy-1.d

@@ -0,0 +1,19 @@
+class T {
+    override string toString() { return "I'm the instance of T"; }
+    T duplicate() { return new T; }
+}
+
+class S : T {
+    override string toString() { return "I'm the instance of S"; }
+
+    override T duplicate() { return new S; }
+}
+
+void main () {
+    import std.stdio;
+    T orig = new S;
+    T copy = orig.duplicate();
+
+    writeln(orig);
+    writeln(copy);
+}

Task/Polymorphic-copy/D/polymorphic-copy-2.d

@@ -0,0 +1,46 @@
+class T {
+    this(T t = null) {} // Constructor that will be used for copying.
+
+    override string toString() { return "I'm the instance of T"; }
+
+    T duplicate() { return new T(this); }
+
+    bool custom(char c) { return false; }
+}
+
+class S : T {
+    char[] str;
+
+    this(S s = null) {
+        super(s);
+        if (s is null)
+            str = ['1', '2', '3']; // All newly created will get that.
+        else
+            str = s.str.dup; // Do the deep-copy.
+    }
+
+    override string toString() {
+        return "I'm the instance of S p: " ~ cast(string)str;
+    }
+
+    override T duplicate() { return new S(this); }
+
+    // Additional procedure, just to test deep-copy.
+    override bool custom(char c) {
+        if (str !is null)
+            str[0] = c;
+        return str is null;
+    }
+}
+
+void main () {
+    import std.stdio;
+    T orig = new S;
+    orig.custom('X');
+
+    T copy = orig.duplicate();
+    orig.custom('Y');
+
+    writeln(orig);
+    writeln(copy); // Should have 'X' at the beginning.
+}

Task/Polymorphic-copy/E/polymorphic-copy-1.e

@@ -0,0 +1,5 @@
+def deSubgraphKit := <elib:serial.deSubgraphKit>
+
+def copy(object) {
+    return deSubgraphKit.recognize(object, deSubgraphKit.makeBuilder())
+}

Task/Polymorphic-copy/E/polymorphic-copy-2.e

@@ -0,0 +1,12 @@
+? def a := [1].diverge()
+# value: [1].diverge()
+
+? def b := copy(a)
+# value: [1].diverge()
+
+? b.push(2)
+? a
+# value: [1].diverge()
+
+? b
+# value: [1, 2].diverge()

Task/Polymorphic-copy/Factor/polymorphic-copy.factor

@@ -0,0 +1,8 @@
+USING: classes kernel prettyprint serialize ;
+TUPLE: A ;
+TUPLE: C < A ;
+: serial-clone ( obj -- obj' ) object>bytes bytes>object ;
+
+C new
+[ clone ]
+[ serial-clone ] bi [ class . ] bi@

Task/Polymorphic-copy/Forth/polymorphic-copy.fth

@@ -0,0 +1,36 @@
+include lib/memcell.4th
+include 4pp/lib/foos.4pp
+                                       ( a1 -- a2)
+:token fork dup allocated dup (~~alloc) swap >r swap over r> smove ;
+                                       \ allocate an empty object
+:: T()                                 \ super class T
+   class
+     method: print                     \ print message
+     method: clone                     \ clone yourself
+   end-class {
+                                       \ implementing methods
+     :method { ." class T" cr } ; defines print
+     fork defines clone                ( -- addr)
+   }
+;
+
+:: S()                                 \ class S
+   extends T()                         \ derived from T
+   end-extends {                       \ print message
+     :method { ." class S" cr } ; defines print
+   }                                   \ clone yourself
+;
+
+new T() t                              \ create a new object t
+new S() s                              \ create a new object s
+
+." before copy" cr
+t => print                             \ use "print" methods
+s => print
+
+t => clone to tcopy                    \ cloning t, spawning tcopy
+s => clone to scopy                    \ cloning s, spawning scopy
+
+." after copy" cr
+tcopy => print                         \ use "print" methods
+scopy => print

Task/Polymorphic-copy/Go/polymorphic-copy.go

@@ -0,0 +1,84 @@
+package main
+
+import (
+    "fmt"
+    "reflect"
+)
+
+// interface types provide polymorphism, but not inheritance.
+type i interface {
+    identify() string
+}
+
+// "base" type
+type t float64
+
+// "derived" type.  in Go terminology, it is simply a struct with an
+// anonymous field.  fields and methods of anonymous fields however,
+// can be accessed without additional qualification and so are
+// "inherited" in a sense.
+type s struct {
+    t
+    kōan string
+}
+
+// another type with an "embedded" t field.  (t is the *type*, this field
+// has no *name*.)
+type r struct {
+    t
+    ch chan int
+}
+
+// a method on t.  this method makes t satisfy interface i.
+// since a t is embedded in types s and r, they automatically "inherit"
+// the method.
+func (x t) identify() string {
+    return "I'm a t!"
+}
+
+// the same method on s.  although s already satisfied i, calls to identify
+// will now find this method rather than the one defined on t.  in a sense
+// it "overrides" the method of the "base class."
+func (x s) identify() string {
+    return "I'm an s!"
+}
+
+func main() {
+    // three variables with different types, initialized from literals.
+    var t1 t = 5
+    var s1 s = s{6, "one"}
+    var r1 r = r{t: 7}
+
+    // variables declared with the same type.  initial value is nil.
+    var i1, i2, i3 i
+    fmt.Println("Initial (zero) values of interface variables:")
+    fmt.Println("i1:", i1)
+    fmt.Println("i2:", i2)
+    fmt.Println("i3:", i3)
+
+    // in the terminology of the Go language reference, i1, i2, and i3
+    // still have static type i, but now have different dynamic types.
+    i1, i2, i3 = t1, s1, r1
+    fmt.Println("\nPolymorphic:")
+    fmt.Println("i1:", i1, "/", i1.identify(), "/", reflect.TypeOf(i1))
+    fmt.Println("i2:", i2, "/", i2.identify(), "/", reflect.TypeOf(i2))
+    fmt.Println("i3:", i3, "/", i3.identify(), "/", reflect.TypeOf(i3))
+
+    // copy: declare and assign in one step using "short declaration."
+    i1c, i2c, i3c := i1, i2, i3
+
+    // modify first set of polymorphic variables.
+    i1, i2, i3 = s{3, "dog"}, r{t: 1}, t(2)
+
+    // demonstrate that copies are distinct from first set
+    // and that types are preserved.
+    fmt.Println("\nFirst set now modified:")
+    fmt.Println("i1:", i1, "/", i1.identify(), "/", reflect.TypeOf(i1))
+    fmt.Println("i2:", i2, "/", i2.identify(), "/", reflect.TypeOf(i2))
+    fmt.Println("i3:", i3, "/", i3.identify(), "/", reflect.TypeOf(i3))
+
+    fmt.Println("\nCopies made before modifications:")
+    fmt.Println("i1c:", i1c, "/", i1c.identify(), "/", reflect.TypeOf(i1c))
+    fmt.Println("i2c:", i2c, "/", i2c.identify(), "/", reflect.TypeOf(i2c))
+    fmt.Println("i3c:", i3c, "/", i3c.identify(), "/", reflect.TypeOf(i3c))
+}

Task/Polymorphic-copy/Java/polymorphic-copy.java

@@ -0,0 +1,24 @@
+class T implements Cloneable {
+    public String name() { return "T"; }
+    public T copy() {
+        try {
+            return (T)super.clone();
+        } catch (CloneNotSupportedException e) {
+            return null;
+        }
+    }
+}
+
+class S extends T {
+    public String name() { return "S"; }
+}
+
+public class PolymorphicCopy {
+    public static T copier(T x) { return x.copy(); }
+    public static void main(String[] args) {
+        T obj1 = new T();
+        S obj2 = new S();
+        System.out.println(copier(obj1).name()); // prints "T"
+        System.out.println(copier(obj2).name()); // prints "S"
+    }
+}

Task/Polymorphic-copy/JavaScript/polymorphic-copy.js

@@ -0,0 +1,9 @@
+function clone(obj){
+    if (obj == null || typeof(obj) != 'object')
+        return obj;
+
+    var temp = {};
+    for (var key in obj)
+        temp[key] = clone(obj[key]);
+    return temp;
+}

Task/Polymorphic-copy/NetRexx/polymorphic-copy.netrexx

@@ -0,0 +1,38 @@
+/* NetRexx */
+options replace format comments java crossref savelog symbols binary
+
+-- -----------------------------------------------------------------------------
+class RCPolymorphicCopy public
+
+method copier(x = T) public static returns T
+  return x.copy
+
+method main(args = String[]) public constant
+  obj1 = T()
+  obj2 = S()
+  System.out.println(copier(obj1).name) -- prints "T"
+  System.out.println(copier(obj2).name) -- prints "S"
+  return
+
+-- -----------------------------------------------------------------------------
+class RCPolymorphicCopy.T public implements Cloneable
+
+method name returns String
+  return T.class.getSimpleName
+
+method copy public returns T
+  dup = T
+
+  do
+    dup = T super.clone
+  catch ex = CloneNotSupportedException
+    ex.printStackTrace
+  end
+
+  return dup
+
+-- -----------------------------------------------------------------------------
+class RCPolymorphicCopy.S public extends RCPolymorphicCopy.T
+
+method name returns String
+  return S.class.getSimpleName

Task/Polymorphic-copy/OCaml/polymorphic-copy.ocaml

@@ -0,0 +1,13 @@
+let obj1 =
+  object
+    method name = "T"
+  end
+
+let obj2 =
+  object
+    method name = "S"
+  end
+
+let () =
+  print_endline (Oo.copy obj1)#name; (* prints "T" *)
+  print_endline (Oo.copy obj2)#name; (* prints "S" *)

Task/Polymorphic-copy/Objective-C/polymorphic-copy.m

@@ -0,0 +1,39 @@
+@interface T : NSObject
+{ }
+- (void)identify;
+@end
+
+@implementation T
+- (void)identify {
+    NSLog(@"I am a genuine T");
+}
+- (id)copyWithZone:(NSZone *)zone {
+    T *copy = [[[self class] allocWithZone:zone] init]; // call an appropriate constructor here
+                                                        // then copy data into it as appropriate here
+                                                        // make sure to use "[[self class] alloc..." and
+                                                        // not "[T alloc..." to make it polymorphic
+    return copy;
+}
+@end
+
+@interface S : T
+{ }
+@end
+
+@implementation S
+- (void)identify
+{
+    NSLog(@"I am an S");
+}
+@end
+
+int main()
+{
+    T *original = [[S alloc] init];
+    T *another = [original copy];
+    [another identify]; // logs "I am an S"
+
+    [another release]; // like "alloc", the object returned by "copy" is "owned" by the caller, so we are responsible for releasing it
+    [original release];
+    return 0;
+}

Task/Polymorphic-copy/OxygenBasic/polymorphic-copy.oxy

@@ -0,0 +1,37 @@
+'======
+class T
+'======
+
+float vv
+
+method constructor(float a=0) {vv=a}
+method destructor    {}
+method copy as T     {new T ob : ob<=vv : return ob}
+method mA() as float {return vv*2}
+method mB() as float {return vv*3}
+
+end class
+
+
+'======
+class S
+'======
+
+has T
+
+method mB() as float {return vv*4} 'ovveride
+
+end class
+
+'====
+'TEST
+'====
+
+new T objA(10.5)
+
+let objB = cast S objA.copy
+
+print objA.mb 'result 31.5
+print objB.mb 'result 42
+
+del objA : del objB

Task/Polymorphic-copy/Oz/polymorphic-copy.oz

@@ -0,0 +1,41 @@
+declare
+  class T from ObjectSupport.reflect
+     meth init
+        skip
+     end
+
+     meth name($)
+        'T'
+     end
+  end
+
+  class S from T
+     attr a
+     feat f
+
+     meth name($)
+        'S'
+     end
+
+     meth getA($) @a end
+     meth setA(V) a := V end
+  end
+
+  Obj = {New S init}
+  Copy = {Obj clone($)}
+in
+  %% Some assertions:
+
+  %% Copy is really an S:
+  {Copy name($)} = 'S'
+
+  %% Copy is not just a reference to the same object:
+  {System.eq Obj Copy} = false
+
+  %% Not a deep copy. Feature f has the same identity for both objects:
+  {System.eq Obj.f Copy.f} = true
+
+  %% However, both have their own distinct attributes:
+  {Obj setA(13)}
+  {Copy setA(14)}
+  {Obj getA($)} \= {Copy getA($)} = true

Task/Polymorphic-copy/PHP/polymorphic-copy.php

@@ -0,0 +1,16 @@
+<?php
+class T {
+      function name() { return "T"; }
+}
+
+class S {
+      function name() { return "S"; }
+}
+
+$obj1 = new T();
+$obj2 = new S();
+$obj3 = clone $obj1;
+$obj4 = clone $obj2;
+echo $obj3->name(), "\n"; // prints "T"
+echo $obj4->name(), "\n"; // prints "S"
+?>

Task/Polymorphic-copy/Perl-6/polymorphic-copy.pl6

@@ -0,0 +1,3 @@
+my Cool $x = 22/7 but role Fink { method brag { say "I'm a cool {self.WHAT.perl}!" }}
+my Cool $y = $x.clone;
+$y.brag;

Task/Polymorphic-copy/Perl/polymorphic-copy.pl

@@ -0,0 +1,53 @@
+package T;
+sub new {
+        my $cls = shift;
+        bless [ @_ ], $cls
+}
+
+sub set_data {
+        my $self = shift;
+        @$self = @_;
+}
+
+sub copy {
+        my $self = shift;
+        bless [ @$self ], ref $self;
+}
+
+sub manifest {
+        my $self = shift;
+        print "type T, content: @$self\n\n";
+}
+
+package S;
+our @ISA = 'T';
+# S is inheriting from T.
+# 'manifest' method is overriden, while 'new', 'copy' and
+# 'set_data' are all inherited.
+sub manifest {
+        my $self = shift;
+        print "type S, content: @$self\n\n";
+}
+
+package main;
+
+print "# creating \$t as a T\n";
+my $t = T->new('abc');
+$t->manifest;
+
+print "# creating \$s as an S\n";
+my $s = S->new('SPQR');
+$s->manifest;
+
+print "# make var \$x as a copy of \$t\n";
+my $x = $t->copy;
+$x->manifest;
+
+print "# now as a copy of \$s\n";
+$x = $s->copy;
+$x->manifest;
+
+print "# show that this copy is indeed a separate entity\n";
+$x->set_data('totally different');
+print "\$x is: ";
+$x->manifest;

Task/Polymorphic-copy/PicoLisp/polymorphic-copy-1.l

@@ -0,0 +1,10 @@
+: (setq A (new '(+Cls1 +Cls2) 'attr1 123  'attr2 "def"  'attr3 (4 2 0)  'attr4 T))
+-> $385603635
+
+: (show A)
+$385603635 (+Cls1 +Cls2)
+   attr4
+   attr3 (4 2 0)
+   attr2 "def"
+   attr1 123
+-> $385603635

Task/Polymorphic-copy/PicoLisp/polymorphic-copy-2.l

@@ -0,0 +1 @@
+(putl (setq B (new (val A))) (getl A))

Task/Polymorphic-copy/PicoLisp/polymorphic-copy-3.l

@@ -0,0 +1,7 @@
+: (show B)
+$385346595 (+Cls1 +Cls2)
+   attr1 123
+   attr2 "def"
+   attr3 (4 2 0)
+   attr4
+-> $385346595

Task/Polymorphic-copy/Python/polymorphic-copy-1.py

@@ -0,0 +1,54 @@
+import copy
+
+class T:
+   def classname(self):
+      return self.__class__.__name__
+
+   def __init__(self):
+      self.myValue = "I'm a T."
+
+   def speak(self):
+      print self.classname(), 'Hello', self.myValue
+
+   def clone(self):
+      return copy.copy(self)
+
+class S1(T):
+   def speak(self):
+      print self.classname(),"Meow", self.myValue
+
+class S2(T):
+   def speak(self):
+      print self.classname(),"Woof", self.myValue
+
+
+print "creating initial objects of types S1, S2, and T"
+a = S1()
+a.myValue = 'Green'
+a.speak()
+
+b = S2()
+b.myValue = 'Blue'
+b.speak()
+
+u = T()
+u.myValue = 'Purple'
+u.speak()
+
+print "Making copy of a as u, colors and types should match"
+u = a.clone()
+u.speak()
+a.speak()
+print "Assigning new color to u, A's color should be unchanged."
+u.myValue = "Orange"
+u.speak()
+a.speak()
+
+print "Assigning u to reference same object as b, colors and types should match"
+u = b
+u.speak()
+b.speak()
+print "Assigning new color to u. Since u,b references same object b's color changes as well"
+u.myValue = "Yellow"
+u.speak()
+b.speak()

Task/Polymorphic-copy/Python/polymorphic-copy-2.py

@@ -0,0 +1,7 @@
+import cPickle as pickle
+
+source = {'a': [1, 2.0, 3, 4+6j],
+         'b': ('string', u'Unicode string'),
+         'c': None}
+
+target = pickle.loads(pickle.dumps(source))

Task/Polymorphic-copy/Python/polymorphic-copy-3.py

@@ -0,0 +1,8 @@
+target = source.__class__()  # Create an object of the same type
+if hasattr(source, 'items') and callable(source.items):
+    for key,value in source.items:
+        target[key] = value
+elif hasattr(source, '__len__'):
+    target = source[:]
+else:  # Following is not recommended. (see below).
+    target = source

Task/Polymorphic-copy/Ruby/polymorphic-copy.rb

@@ -0,0 +1,16 @@
+class T
+  def name
+    "T"
+  end
+end
+
+class S
+  def name
+    "S"
+  end
+end
+
+obj1 = T.new
+obj2 = S.new
+puts obj1.dup.name # prints "T"
+puts obj2.dup.name # prints "S"

Task/Polymorphic-copy/Slate/polymorphic-copy.slate

@@ -0,0 +1,9 @@
+define: #T &parents: {Cloneable}.
+
+define: #S &parents: {Cloneable}.
+
+define: #obj1 -> T clone.
+define: #obj2 -> S clone.
+
+obj1 printName.
+obj2 printName.

Task/Polymorphic-copy/Tcl/polymorphic-copy-1.tcl

@@ -0,0 +1 @@
+set varCopy $varOriginal

Task/Polymorphic-copy/Tcl/polymorphic-copy-2.tcl

@@ -0,0 +1,42 @@
+oo::class create CanClone {
+    method clone {{name {}}} {
+        # Make a bare, optionally named, copy of the object
+        set new [oo::copy [self] {*}[expr {$name eq "" ? {} : [list $name]}]]
+
+        # Reproduce the basic variable state of the object
+        set newns [info object namespace $new]
+        foreach v [info object vars [self]] {
+            namespace upvar [namespace current] $v v1
+            namespace upvar $newns $v v2
+            if {[array exists v1]} {
+                array set v2 [array get v1]
+            } else {
+                set v2 $v1
+            }
+        }
+        # Other object state is possible like open file handles. Cloning that is
+        # properly left to subclasses, of course.
+
+        return $new
+    }
+}
+
+# Now a demonstration
+oo::class create Example {
+    superclass CanClone
+    variable Count Name
+    constructor {name} {set Name $name;set Count 0}
+    method step {} {incr Count;return}
+    method print {} {puts "this is $Name in [self], stepped $Count times"}
+    method rename {newName} {set Name $newName}
+}
+set obj1 [Example new "Abracadabra"]
+$obj1 step
+$obj1 step
+$obj1 print
+set obj2 [$obj1 clone]
+$obj2 step
+$obj2 print
+$obj2 rename "Hocus Pocus"
+$obj2 print
+$obj1 print