Initial data commit

Task/Polymorphic-copy/00-META.yaml

@@ -0,0 +1,3 @@
+---
+from: http://rosettacode.org/wiki/Polymorphic_copy
+note: Object oriented

Task/Polymorphic-copy/00-TASK.txt

@@ -0,0 +1,16 @@
+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:
+<syntaxhighlight lang="c">int x;
+int y = x;</syntaxhighlight>
+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/ALGOL-68/polymorphic-copy.alg

@@ -0,0 +1,51 @@
+BEGIN
+    # Algol 68 doesn't have classes and inheritence as such, however structures #
+    # can contain procedures and different instances of a structure can have    #
+    # different versons of the procedure                                        #
+    # this allows us to simulate inheritence by creating structure instances    #
+    # with different procedures                                                 #
+
+    # the following declares a type (MODE) HORSE with two constructors, one for #
+    # a standard horse and one for a zebra (the "derived class").               #
+    # The standard horse has its print procedure set to thw print horse         #
+    # procedure (the "base class" method). zebras get the print zebra procedure #
+    # (the "derived class" method). A convenience operator (PRINT) is defined   #
+    # to simplify calling the horse/zebra print method of its horse parameter   #
+    # = this PRINT operator is independent of which actual print method the     #
+    # horse has - it just saved typeing "( print OF h )( h )" everywhere we     #
+    # need to call the print method (euivalent to h.print(h) in e.g. C, Java,   #
+    # etc.)                                                                     #
+
+    # "class" #
+    MODE HORSE = STRUCT( STRING name, PROC(HORSE)VOID print );
+    # constructors #
+    PROC new horse   = ( STRING name )HORSE: ( name, print horse );
+    PROC new zebra   = ( STRING name )HORSE: ( name, print zebra );
+    # print methods: one for a standard horse and one for a zebra #
+    PROC print horse = ( HORSE  h    )VOID: print( ( "horse: ", name OF h ) );
+    PROC print zebra = ( HORSE  h    )VOID: print( ( "zebra: ", name OF h ) );
+    # print operator #
+    OP   PRINT       = ( HORSE  h    )VOID: ( print OF h )( h );
+
+    # declare and construct some horses and zebras #
+    HORSE h1 := new horse( "silver blaze" );
+    HORSE z1 := new zebra( "stripy" );
+    HORSE z2 := new zebra( "second zebra" );
+
+    # show their values #
+    PRINT h1; print( ( newline ) );
+    PRINT z1; print( ( newline ) );
+    PRINT z2; print( ( newline ) );
+    print( ( "----", newline ) );
+
+    # change the second zebra to be a copy of the first zebra #
+    z2 := z1;
+    PRINT z1; print( ( newline ) );
+    PRINT z2; print( ( newline ) );
+    print( ( "----", newline ) );
+
+    # change the name of the first zebra leaving z2 unchanged #
+    name OF z1 := "ed";
+    PRINT z1; print( ( newline ) );
+    PRINT z2; print( ( newline ) )
+END

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

@@ -0,0 +1,53 @@
+with Ada.Text_IO;  use Ada.Text_IO;
+
+procedure Test_Polymorphic_Copy is
+   package Base is
+      type T is tagged null record;
+      type T_ptr is access all T'Class;
+      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;
+
+      -- The function knows nothing about S and creates a copy on the heap
+   function Clone (X : T'Class) return T_ptr is
+   begin
+      return new T'Class(X);
+   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;
+   Object_3 : T_ptr := Clone(T);
+   Object_4 : T_ptr := Clone(S);
+begin
+   Copier (Object_1);
+   Copier (Object_2);
+   Put_Line ("Cloned " & Object_3.all.Name);
+   Put_Line ("Cloned " & Object_4.all.Name);
+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.basic

@@ -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-sharp/polymorphic-copy-1.cs

@@ -0,0 +1,39 @@
+using System;
+
+class T
+{
+    public virtual string Name()
+    {
+        return "T";
+    }
+
+    public virtual T Clone()
+    {
+        return new T();
+    }
+}
+
+class S : T
+{
+    public override string Name()
+    {
+        return "S";
+    }
+
+    public override T Clone()
+    {
+        return new S();
+    }
+}
+
+class Program
+{
+    static void Main()
+    {
+        T original = new S();
+        T clone = original.Clone();
+
+        Console.WriteLine(original.Name());
+        Console.WriteLine(clone.Name());
+    }
+}

Task/Polymorphic-copy/C-sharp/polymorphic-copy-2.cs

@@ -0,0 +1,2 @@
+S
+S

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: " ~ str.idup;
+    }
+
+    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');
+
+    orig.writeln;
+    copy.writeln; // Should have 'X' at the beginning.
+}

Task/Polymorphic-copy/Delphi/polymorphic-copy-1.delphi

@@ -0,0 +1,33 @@
+program PolymorphicCopy;
+
+type
+  T = class
+    function Name:String; virtual;
+    function Clone:T; virtual;
+  end;
+
+  S = class(T)
+    function Name:String; override;
+    function Clone:T; override;
+  end;
+
+function T.Name :String; begin Exit('T')     end;
+function T.Clone:T;      begin Exit(T.Create)end;
+
+function S.Name :String; begin Exit('S')     end;
+function S.Clone:T;      begin Exit(S.Create)end;
+
+procedure Main;
+var
+  Original, Clone :T;
+begin
+  Original := S.Create;
+  Clone    := Original.Clone;
+
+  WriteLn(Original.Name);
+  WriteLn(Clone.Name);
+end;
+
+begin
+  Main;
+end.

Task/Polymorphic-copy/Delphi/polymorphic-copy-2.delphi

@@ -0,0 +1,2 @@
+S
+S

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/EchoLisp/polymorphic-copy.l

@@ -0,0 +1,24 @@
+(lib 'types)
+(lib 'struct)
+
+(struct T (integer:x)) ;; super class
+(struct S T (integer:y)) ;; sub class
+(struct K (T:box)) ;; container class, box must be of type T, or derived
+
+(define k-source (K (S 33 42)))
+(define k-copy (copy k-source))
+
+k-source
+    → #<K> (#<S> (33 42)) ;; new container, with a S in box
+k-copy
+    → #<K> (#<S> (33 42)) ;; copied S type
+
+(set-S-y! (K-box k-source) 666) ;; modify k-source.box.y
+
+k-source
+    → #<K> (#<S> (33 666)) ;; modified
+k-copy
+    → #<K> (#<S> (33 42))  ;; unmodified
+
+(K "string-inside") ;; trying to put a string in the container box
+😡 error: T : type-check failure : string-inside → 'K:box'

Task/Polymorphic-copy/Elena/polymorphic-copy.elena

@@ -0,0 +1,24 @@
+import extensions;
+
+class T
+{
+    Name = "T";
+
+    T clone() = new T();
+}
+
+class S : T
+{
+    Name = "S";
+
+    T clone() = new S();
+}
+
+public program()
+{
+    T original := new S();
+    T clone := original.clone();
+
+    console.printLine(original.Name);
+    console.printLine(clone.Name)
+}

Task/Polymorphic-copy/F-Sharp/polymorphic-copy.fs

@@ -0,0 +1,14 @@
+type T() =
+  // expose protected MemberwiseClone method (and downcast the result)
+  member x.Clone() = x.MemberwiseClone() :?> T
+  // virtual method Print with default implementation
+  abstract Print : unit -> unit
+  default x.Print() = printfn "I'm a T!"
+
+type S() =
+  inherit T()
+  override x.Print() = printfn "I'm an S!"
+
+let s = new S()
+let s2 = s.Clone()  // the static type of s2 is T, but it "points" to an S
+s2.Print() // prints "I'm an S!"

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-1.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/Forth/polymorphic-copy-2.fth

@@ -0,0 +1,25 @@
+include FMS-SI.f
+
+:class T
+ ivar container  \ can contain an object of any type
+ :m put ( obj -- ) container ! ;m
+ :m init: self self put ;m \ initially container holds self
+ :m print ." class is T" ;m
+ :m print-container container @ print ;m
+;class
+
+:class S <super T    \ subclass S from T
+ :m print ." class is S" ;m \ override T's print method
+;class
+
+: ecopy {: obj1 -- obj2 :} \ make an exact copy of obj
+  obj1 dup >class dfa @
+  obj1 heap: dup >r swap move r> ;
+
+T obj-t  \ instantiate a T object
+obj-t print-container \ class is T
+
+S obj-s  \ instantiate an S object
+obj-s ecopy obj-t put  \ make an exact copy of S object and store in T object
+
+obj-t print-container \ class is S

Task/Polymorphic-copy/Fortran/polymorphic-copy.f

@@ -0,0 +1,66 @@
+!-----------------------------------------------------------------------
+!Module polymorphic_copy_example_module
+!-----------------------------------------------------------------------
+module polymorphic_copy_example_module
+   implicit none
+   private ! all by default
+   public :: T,S
+
+   type, abstract :: T
+   contains
+      procedure (T_procedure1), deferred, pass :: identify
+      procedure (T_procedure2), deferred, pass :: duplicate
+   end type T
+
+
+   abstract interface
+      subroutine T_procedure1(this)
+         import  :: T
+         class(T), intent(inout) :: this
+      end subroutine T_procedure1
+      function T_procedure2(this) result(Tobj)
+         import  :: T
+         class(T), intent(inout) :: this
+         class(T), allocatable :: Tobj
+      end function T_procedure2
+   end interface
+
+   type, extends(T) :: S
+   contains
+      procedure, pass :: identify
+      procedure, pass :: duplicate
+   end type S
+
+ contains
+
+   subroutine  identify(this)
+      implicit none
+      class(S), intent(inout) :: this
+      write(*,*) "S"
+   end subroutine identify
+
+   function duplicate(this) result(obj)
+      class(S), intent(inout) :: this
+      class(T), allocatable :: obj
+      allocate(obj, source = S())
+   end function duplicate
+
+end module polymorphic_copy_example_module
+
+!-----------------------------------------------------------------------
+!Main program test
+!-----------------------------------------------------------------------
+program    test
+   use polymorphic_copy_example_module
+   implicit none
+
+   class(T), allocatable :: Sobj
+   class(T), allocatable :: Sclone
+
+   allocate(Sobj, source = S())
+   allocate(Sclone, source = Sobj % duplicate())
+
+   call Sobj % identify()
+   call Sclone % identify()
+
+end program test

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/Groovy/polymorphic-copy-1.groovy

@@ -0,0 +1,14 @@
+class T implements Cloneable {
+    String property
+    String name() { 'T' }
+    T copy() {
+        try { super.clone() }
+        catch(CloneNotSupportedException e) { null }
+    }
+    @Override
+    boolean equals(that) { this.name() == that?.name() && this.property == that?.property }
+}
+
+class S extends T {
+    @Override String name() { 'S' }
+}

Task/Polymorphic-copy/Groovy/polymorphic-copy-2.groovy

@@ -0,0 +1,14 @@
+T obj1 = new T(property: 'whatever')
+S obj2 = new S(property: 'meh')
+
+def objA = obj1.copy()
+def objB = obj2.copy()
+
+assert objA.class == T
+assert objA == obj1 && ! objA.is(obj1) // same values, not same instance
+
+assert objB.class == S
+assert objB == obj2 && ! objB.is(obj2) // same values, not same instance
+
+println "objA:: name: ${objA.name()}, property: ${objA.property}"
+println "objB:: name: ${objB.name()}, property: ${objB.property}"

Task/Polymorphic-copy/Icon/polymorphic-copy.icon

@@ -0,0 +1,36 @@
+class T()
+    method a(); write("This is T's a"); end
+end
+
+class S: T()
+    method a(); write("This is S's a"); end
+end
+
+procedure main()
+    write("S:",deepcopy(S()).a())
+end
+
+procedure deepcopy(A, cache)  #: return a deepcopy of A
+    local k
+
+    /cache := table()        # used to handle multireferenced objects
+    if \cache[A] then return cache[A]
+
+    case type(A) of {
+        "table"|"list": {
+            cache[A] := copy(A)
+            every cache[A][k := key(A)] := deepcopy(A[k], cache)
+            }
+        "set": {
+            cache[A] := set()
+            every insert(cache[A], deepcopy(!A, cache))
+            }
+        default: {           # records and objects (encoded as records)
+            cache[A] := copy(A)
+            if match("record ",image(A)) then {
+                every cache[A][k := key(A)] := deepcopy(A[k], cache)
+                }
+            }
+        }
+    return .cache[A]
+end

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/Julia/polymorphic-copy.julia

@@ -0,0 +1,38 @@
+abstract type Jewel end
+
+mutable struct RoseQuartz <: Jewel
+    carats::Float64
+    quality::String
+end
+
+mutable struct Sapphire <: Jewel
+    color::String
+    carats::Float64
+    quality::String
+end
+
+color(j::RoseQuartz) = "rosepink"
+color(j::Jewel) = "Use the loupe."
+color(j::Sapphire) = j.color
+
+function testtypecopy()
+    a = Sapphire("blue", 5.0, "good")
+    b = RoseQuartz(3.5, "excellent")
+
+    j::Jewel = deepcopy(b)
+
+    println("a is a Jewel? ", a isa Jewel)
+    println("b is a Jewel? ", a isa Jewel)
+    println("j is a Jewel? ", a isa Jewel)
+    println("a is a Sapphire? ", a isa Sapphire)
+    println("a is a RoseQuartz? ", a isa RoseQuartz)
+    println("b is a Sapphire? ", b isa Sapphire)
+    println("b is a RoseQuartz? ", b isa RoseQuartz)
+    println("j is a Sapphire? ", j isa Sapphire)
+    println("j is a RoseQuartz? ", j isa RoseQuartz)
+
+    println("The color of j is ", color(j), ".")
+    println("j is the same as b? ", j == b)
+end
+
+testtypecopy()

Task/Polymorphic-copy/Kotlin/polymorphic-copy.kotlin

@@ -0,0 +1,21 @@
+// version 1.1.2
+
+open class Animal(val name: String, var age: Int) {
+    open fun copy() = Animal(name, age)
+
+    override fun toString() = "Name: $name, Age: $age"
+}
+
+class Dog(name: String, age: Int, val breed: String) : Animal(name, age) {
+    override fun copy() = Dog(name, age, breed)
+
+    override fun toString() = super.toString() + ", Breed: $breed"
+}
+
+fun main(args: Array<String>) {
+    val a: Animal = Dog("Rover", 3, "Terrier")
+    val b: Animal = a.copy()  // calls Dog.copy() because runtime type of 'a' is Dog
+    println("Dog 'a' = $a")   // implicitly calls Dog.toString()
+    println("Dog 'b' = $b")   // ditto
+    println("Dog 'a' is ${if (a === b) "" else "not"} the same object as Dog 'b'")
+}

Task/Polymorphic-copy/Lua/polymorphic-copy.lua

@@ -0,0 +1,16 @@
+T = { name=function(s) return "T" end, tostring=function(s) return "I am a "..s:name() end }
+
+function clone(s) local t={} for k,v in pairs(s) do t[k]=v end return t end
+S1 = clone(T)  S1.name=function(s) return "S1" end
+
+function merge(s,t) for k,v in pairs(t) do s[k]=v end return s end
+S2 = merge(clone(T), {name=function(s) return "S2" end})
+
+function prototype(base,mixin) return merge(merge(clone(base),mixin),{prototype=base}) end
+S3 = prototype(T, {name=function(s) return "S3" end})
+
+print("T :  "..T:tostring())
+print("S1:  " ..S1:tostring())
+print("S2:  " ..S2:tostring())
+print("S3:  " ..S3:tostring())
+print("S3's parent:  "..S3.prototype:tostring())

Task/Polymorphic-copy/MiniScript/polymorphic-copy.mini

@@ -0,0 +1,22 @@
+T = {}
+T.foo = function()
+    return "This is an instance of T"
+end function
+
+S = new T
+S.foo = function()
+    return "This is an S for sure"
+end function
+
+instance = new S
+print "instance.foo: " + instance.foo
+
+copy = {}
+copy = copy + instance  // copies all elements
+print "copy.foo: " + copy.foo
+
+// And to prove this is a copy, and not a reference:
+instance.bar = 1
+copy.bar = 2
+print "instance.bar: " + instance.bar
+print "copy.bar: " + copy.bar

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/Nim/polymorphic-copy.nim

@@ -0,0 +1,37 @@
+type
+  T = ref object of RootObj
+    myValue: string
+  S1 = ref object of T
+  S2 = ref object of T
+
+method speak(x: T) {.base.} = echo "T Hello ", x.myValue
+method speak(x: S1) = echo "S1 Meow ", x.myValue
+method speak(x: S2) = echo "S2 Woof ", x.myValue
+
+echo "creating initial objects of types S1, S2, and T."
+var a = S1(myValue: "Green")
+a.speak
+var b = S2(myValue: "Blue")
+b.speak
+var u = T(myValue: "Blue")
+u.speak
+
+echo "Making copy of a as u; colors and types should match."
+u.deepCopy(a)
+u.speak
+a.speak
+
+echo "Assigning new color to u; A's color should be unchanged."
+u.myValue = "Orange"
+u.speak
+a.speak
+
+echo "Assigning u to reference same object as b; colors and types should match."
+u = b
+u.speak
+b.speak
+
+echo "Assigning new color to u. Since u,b reference the same object, b's color changes as well."
+u.myValue = "Yellow"
+u.speak
+b.speak

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,38 @@
+@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()
+{
+    @autoreleasepool {
+
+        T *original = [[S alloc] init];
+        T *another = [original copy];
+        [another identify]; // logs "I am an S"
+
+    }
+    return 0;
+}

Task/Polymorphic-copy/OoRexx/polymorphic-copy.rexx

@@ -0,0 +1,12 @@
+s = .s~new
+s2 = s~copy   -- makes a copy of the first
+if s == s2 then say "copy didn't work!"
+if s2~name == "S" then say "polymorphic copy worked"
+
+::class t
+::method name
+  return "T"
+
+::class s subclass t
+::method name
+  return "S"

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

@@ -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/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/Phix/polymorphic-copy-1.phix

@@ -0,0 +1,28 @@
+(phixonline)-->
+ <span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
+ <span style="color: #008080;">enum</span> <span style="color: #000000;">NAME</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">METHOD</span>
+
+ <span style="color: #008080;">procedure</span> <span style="color: #000000;">me_t</span><span style="color: #0000FF;">()</span>
+     <span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"I is a T\n"</span><span style="color: #0000FF;">)</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
+
+ <span style="color: #008080;">procedure</span> <span style="color: #000000;">me_s</span><span style="color: #0000FF;">()</span>
+     <span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"I is an S\n"</span><span style="color: #0000FF;">)</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
+
+ <span style="color: #008080;">type</span> <span style="color: #000000;">T</span><span style="color: #0000FF;">(</span><span style="color: #004080;">object</span> <span style="color: #000000;">o</span><span style="color: #0000FF;">)</span>
+     <span style="color: #000080;font-style:italic;">-- as o[METHOD] can be overidden, don't verify it (as in test for me_t)!</span>
+     <span style="color: #008080;">return</span> <span style="color: #004080;">sequence</span><span style="color: #0000FF;">(</span><span style="color: #000000;">o</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">and</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">o</span><span style="color: #0000FF;">)=</span><span style="color: #000000;">2</span> <span style="color: #008080;">and</span> <span style="color: #004080;">string</span><span style="color: #0000FF;">(</span><span style="color: #000000;">o</span><span style="color: #0000FF;">[</span><span style="color: #000000;">NAME</span><span style="color: #0000FF;">])</span> <span style="color: #008080;">and</span> <span style="color: #004080;">integer</span><span style="color: #0000FF;">(</span><span style="color: #000000;">o</span><span style="color: #0000FF;">[</span><span style="color: #000000;">METHOD</span><span style="color: #0000FF;">])</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">type</span>
+
+ <span style="color: #008080;">type</span> <span style="color: #000000;">S</span><span style="color: #0000FF;">(</span><span style="color: #000000;">T</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">METHOD</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">me_s</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">type</span>
+
+ <span style="color: #000000;">S</span> <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"S"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">me_s</span><span style="color: #0000FF;">}</span>
+ <span style="color: #000000;">T</span> <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"T"</span><span style="color: #0000FF;">,</span><span style="color: #000000;">me_t</span><span style="color: #0000FF;">}</span>
+
+ <span style="color: #7060A8;">call_proc</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">METHOD</span><span style="color: #0000FF;">],{})</span>
+ <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">s</span>
+ <span style="color: #7060A8;">call_proc</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">[</span><span style="color: #000000;">METHOD</span><span style="color: #0000FF;">],{})</span>
+<!--

Task/Polymorphic-copy/Phix/polymorphic-copy-2.phix

@@ -0,0 +1,29 @@
+-->
+ <span style="color: #008080;">without</span> <span style="color: #008080;">js</span> <span style="color: #000080;font-style:italic;">-- (no class under p2js, and certainly not the low-level stuff)</span>
+ <span style="color: #008080;">include</span> <span style="color: #000000;">builtins</span><span style="color: #0000FF;">/</span><span style="color: #000000;">structs</span><span style="color: #0000FF;">.</span><span style="color: #000000;">e</span>
+
+ <span style="color: #008080;">function</span> <span style="color: #000000;">deep_copy_class</span><span style="color: #0000FF;">(</span><span style="color: #008080;">class</span> <span style="color: #000000;">c</span><span style="color: #0000FF;">)</span>
+     <span style="color: #004080;">string</span> <span style="color: #000000;">name</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">get_struct_name</span><span style="color: #0000FF;">(</span><span style="color: #000000;">c</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">class</span> <span style="color: #000000;">res</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">new</span><span style="color: #0000FF;">(</span><span style="color: #000000;">name</span><span style="color: #0000FF;">)</span>
+     <span style="color: #004080;">sequence</span> <span style="color: #000000;">fields</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">get_struct_fields</span><span style="color: #0000FF;">(</span><span style="color: #000000;">c</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">fields</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
+         <span style="color: #004080;">string</span> <span style="color: #000000;">field</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">fields</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]</span>
+         <span style="color: #000000;">store_field</span><span style="color: #0000FF;">(</span><span style="color: #000000;">res</span><span style="color: #0000FF;">,</span><span style="color: #000000;">field</span><span style="color: #0000FF;">,</span><span style="color: #000000;">fetch_field</span><span style="color: #0000FF;">(</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">field</span><span style="color: #0000FF;">,</span><span style="color: #000000;">name</span><span style="color: #0000FF;">),</span><span style="color: #000000;">name</span><span style="color: #0000FF;">)</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
+     <span style="color: #008080;">return</span> <span style="color: #000000;">res</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
+
+ <span style="color: #008080;">class</span> <span style="color: #000000;">T</span>
+     <span style="color: #008080;">private</span> <span style="color: #004080;">atom</span> <span style="color: #000000;">x</span>
+     <span style="color: #008080;">public</span> <span style="color: #004080;">atom</span> <span style="color: #000000;">y</span>
+     <span style="color: #008080;">procedure</span> <span style="color: #000000;">show</span><span style="color: #0000FF;">()</span>
+         <span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"This is T%d/%d\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">x</span><span style="color: #0000FF;">,</span><span style="color: #000000;">y</span><span style="color: #0000FF;">})</span>
+     <span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
+ <span style="color: #008080;">end</span> <span style="color: #008080;">class</span>
+
+ <span style="color: #000000;">T</span> <span style="color: #000000;">t</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">new</span><span style="color: #0000FF;">({</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">}),</span>
+   <span style="color: #000000;">s</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">deep_copy_class</span><span style="color: #0000FF;">(</span><span style="color: #000000;">t</span><span style="color: #0000FF;">)</span>
+ <span style="color: #000000;">s</span><span style="color: #0000FF;">.</span><span style="color: #000000;">y</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">3</span>
+ <span style="color: #000000;">t</span><span style="color: #0000FF;">.</span><span style="color: #000000;">show</span><span style="color: #0000FF;">()</span>
+ <span style="color: #000000;">s</span><span style="color: #0000FF;">.</span><span style="color: #000000;">show</span><span style="color: #0000FF;">()</span>
+<!--

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/REXX/polymorphic-copy.rexx

@@ -0,0 +1,7 @@
+/*REXX program to  copy  (polymorphically)  one variable's value into another variable. */
+b= 'old value.'
+a= 123.45
+b= a                                             /*copy a variable's value into another.*/
+if a==b  then say "copy did work."
+         else say "copy didn't work."            /*didn't work, maybe ran out of storage*/
+                                                 /*stick a fork in it,  we're all done. */

Task/Polymorphic-copy/Racket/polymorphic-copy-1.rkt

@@ -0,0 +1,18 @@
+#lang racket/base
+
+(define (copy-prefab-struct str)
+  (apply make-prefab-struct (vector->list (struct->vector str))))
+
+(struct point (x y) #:prefab)
+(struct point/color point (color) #:prefab)
+
+
+(let* ([original (point 0 0)]
+       [copied (copy-prefab-struct original)])
+  (displayln copied)
+  (displayln (eq? original copied)))
+
+(let* ([original (point/color 0 0 'black)]
+       [copied (copy-prefab-struct original)])
+  (displayln copied)
+  (displayln (eq? original copied)))

Task/Polymorphic-copy/Racket/polymorphic-copy-2.rkt

@@ -0,0 +1,19 @@
+#lang racket/base
+
+(define (copy-struct str)
+  (define-values (str-struct-info _) (struct-info str))
+  (define str-maker (struct-type-make-constructor str-struct-info))
+  (apply str-maker (cdr (vector->list (struct->vector str)))))
+
+(struct point (x y) #:transparent)
+(struct point/color point (color) #:transparent)
+
+(let* ([original (point 0 0)]
+       [copied (copy-struct original)])
+  (displayln copied)
+  (displayln (eq? original copied)))
+
+(let* ([original (point/color 0 0 'black)]
+       [copied (copy-struct original)])
+  (displayln copied)
+  (displayln (eq? original copied)))

Task/Polymorphic-copy/Racket/polymorphic-copy-3.rkt

@@ -0,0 +1,16 @@
+;#lang racket
+
+(define point%
+  (class object%
+    (super-new)
+    (init-field x y)
+    (define/public (clone) (new this% [x x] [y y]))
+    (define/public (to-list) (list this% x y))))
+
+(define point/color%
+  (class point%
+    (super-new)
+    (inherit-field x y)
+    (init-field color)
+    (define/override (clone) (new this% [x x] [y y] [color color]))
+    (define/override (to-list) (list this% x y color))))

Task/Polymorphic-copy/Raku/polymorphic-copy.raku

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

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/Scala/polymorphic-copy.scala

@@ -0,0 +1,21 @@
+object PolymorphicCopy {
+
+  def main(args: Array[String]) {
+    val a: Animal = Dog("Rover", 3, "Terrier")
+    val b: Animal = a.copy() // calls Dog.copy() because runtime type of 'a' is Dog
+    println(s"Dog 'a' = $a") // implicitly calls Dog.toString()
+    println(s"Dog 'b' = $b") // ditto
+    println(s"Dog 'a' is ${if (a == b) "" else "not"} the same object as Dog 'b'")
+  }
+
+  case class Animal(name: String, age: Int) {
+
+    override def toString = s"Name: $name, Age: $age"
+  }
+
+  case class Dog(override val name: String, override val age: Int, breed: String) extends Animal(name, age) {
+
+    override def toString = super.toString() + s", Breed: $breed"
+  }
+
+}

Task/Polymorphic-copy/Sidef/polymorphic-copy.sidef

@@ -0,0 +1,22 @@
+class T(value) {
+    method display {
+        say value;
+    }
+}
+
+class S(value) < T {
+    method display {
+        say value;
+    }
+}
+
+var obj1 = T("T");
+var obj2 = S("S");
+var obj3 = obj2.dclone;         # make a deep clone of obj2
+
+obj1.value = "foo";             # change the value of obj1
+obj2.value = "bar";             # change the value of obj2
+
+obj1.display;                   # prints "foo"
+obj2.display;                   # prints "bar"
+obj3.display;                   # 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/Swift/polymorphic-copy.swift

@@ -0,0 +1,24 @@
+class T {
+  required init() { } // constructor used in polymorphic initialization must be "required"
+  func identify() {
+    println("I am a genuine T")
+  }
+  func copy() -> T {
+    let newObj : T = self.dynamicType() // call an appropriate constructor here
+    // then copy data into newObj as appropriate here
+    // make sure to use "self.dynamicType(...)" and
+    // not "T(...)" to make it polymorphic
+    return newObj
+  }
+}
+
+class S : T {
+  override func identify()  {
+    println("I am an S")
+  }
+}
+
+let original : T = S()
+let another : T = original.copy()
+println(original === another) // prints "false" (i.e. they are different objects)
+another.identify() // prints "I am an S"

Task/Polymorphic-copy/TXR/polymorphic-copy.txr

@@ -0,0 +1,25 @@
+(defstruct base ()
+  (:method identify (self) (put-line "base")))
+
+(defstruct derived (base)
+  (:method identify (self) (put-line "derived")))
+
+(defstruct poly ()
+  obj
+
+  (:method deep-copy (self)
+    (let ((c (copy self))) ;; make copy of s
+      (upd c.obj copy)     ;; copy self's obj
+      c)))                 ;; return c
+
+;; Test
+
+(let* ((b (new base))
+       (d (new derived))
+       (p (new poly obj d)))
+  b.(identify) ;; prints base
+  d.(identify) ;; prints derived
+
+  (let ((c p.(deep-copy)))
+    p.obj.(identify) ;; prints derived
+    (prinl (eq p.obj c.obj)))) ;; prints nil: c.obj is not a ref to p.obj

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

Task/Polymorphic-copy/Wren/polymorphic-copy.wren

@@ -0,0 +1,33 @@
+class Animal {
+    construct new(name, age) {
+        _name = name
+        _age = age
+    }
+
+    name { _name }
+    age  { _age }
+
+    copy() { Animal.new(name, age) }
+
+    toString { "Name: %(_name), Age: %(_age)" }
+}
+
+class Dog is Animal {
+    construct new(name, age, breed) {
+        super(name, age) // call Animal's constructor
+        _breed = breed
+    }
+
+    // name and age properties will be inherited from Animal
+    breed { _breed }
+
+    copy() { Dog.new(name, age, breed) } // overrides Animal's copy() method
+
+    toString { super.toString + ", Breed: %(_breed)" } // overrides Animal's toString method
+}
+
+var a = Dog.new("Rover", 3, "Terrier") // a's type is Dog
+var b = a.copy() // a's copy() method is called and so b's type is Dog
+System.print("Dog 'a' -> %(a)") // implicitly calls a's toString method
+System.print("Dog 'b' -> %(b)") // ditto
+System.print("Dog 'a' is %((Object.same(a, b)) ? "" : "not") the same object as Dog 'b'")