An object is 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:

int x;
int y = x;
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.

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