10 REM DELEGATION CODE AND EXAMPLE . ATARI BASIC 2020 A. KRESS [email protected]
14 REM
15 GOTO 100:REM MAINLOOP
16 REM
20 REM DELEGATOR OBJECT
21 REM
30 IF DELEGATE THEN GOSUB DELEGATE:GOTO 56
35 REM
50 REM DELEGATOR HAS TO DO THE JOB
55 PRINT "DEFAULT IMPLEMENTATION - DONE BY DELEGATOR"
56 RETURN
60 REM CALL DELEGATE
65 GOSUB DELEGATOR
66 RETURN
79 REM
80 REM DELEGATE OBJECT
81 REM
90 PRINT "DELEGATE IMPLEMENTATION - DONE BY DELEGATE"
91 RETURN
99 REM
100 REM MAINLOOP - DELEGATION EXAMPLE
101 REM
110 DELEGATE=0:REM NO DELEGATE
120 GOSUB 20:REM INIT DELEGATOR
130 DELEGATE=80:REM DELEGATE IS
140 GOSUB 20:REM INIT DELEGATOR


#include <stdio.h>
#include <stdlib.h>
#include <string.h>

typedef const char * (*Responder)( int p1);

typedef struct sDelegate {
    Responder operation;
} *Delegate;

/* Delegate class constructor */
Delegate NewDelegate( Responder rspndr )
{
    Delegate dl = malloc(sizeof(struct sDelegate));
    dl->operation = rspndr;
    return dl;
}

/* Thing method of Delegate */
const char *DelegateThing(Delegate dl, int p1)
{
    return  (dl->operation)? (*dl->operation)(p1) : NULL;
}

/** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
typedef struct sDelegator {
    int     param;
    char    *phrase;
    Delegate delegate;
} *Delegator;

const char * defaultResponse( int p1)
{
    return "default implementation";
}

static struct sDelegate defaultDel = { &defaultResponse };

/* Delegator class constructor */
Delegator NewDelegator( int p, char *phrase)
{
    Delegator d  = malloc(sizeof(struct sDelegator));
    d->param = p;
    d->phrase = phrase;
    d->delegate = &defaultDel;	/* default delegate */
    return d;
}

/* Operation method of Delegator */
const char *Delegator_Operation( Delegator theDelegator, int p1, Delegate delroy)
{
    const char *rtn;
    if (delroy) {
        rtn = DelegateThing(delroy, p1);
        if (!rtn) {			/* delegate didn't handle 'thing' */
            rtn = DelegateThing(theDelegator->delegate, p1);
        }
    }
    else 		/* no delegate */
        rtn = DelegateThing(theDelegator->delegate, p1);

    printf("%s\n", theDelegator->phrase );
    return rtn;
}

/** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
const char *thing1( int p1)
{
    printf("We're in thing1 with value %d\n" , p1);
    return "delegate implementation";
}

int main()
{
    Delegate del1 = NewDelegate(&thing1);
    Delegate del2 = NewDelegate(NULL);
    Delegator theDelegator = NewDelegator( 14, "A stellar vista, Baby.");

    printf("Delegator returns %s\n\n",
            Delegator_Operation( theDelegator, 3, NULL));
    printf("Delegator returns %s\n\n",
            Delegator_Operation( theDelegator, 3, del1));
    printf("Delegator returns %s\n\n",
            Delegator_Operation( theDelegator, 3, del2));
    return 0;
}


using System;

interface IOperable
{
    string Operate();
}

class Inoperable
{
}

class Operable : IOperable
{
    public string Operate()
    {
        return "Delegate implementation.";
    }
}

class Delegator : IOperable
{
    object Delegate;

    public string Operate()
    {
        var operable = Delegate as IOperable;
        return operable != null ? operable.Operate() : "Default implementation.";
    }

    static void Main()
    {
        var delegator = new Delegator();
        foreach (var @delegate in new object[] { null, new Inoperable(), new Operable() })
        {
            delegator.Delegate = @delegate;
            Console.WriteLine(delegator.Operate());
        }
    }
}


#include <tr1/memory>
#include <string>
#include <iostream>
#include <tr1/functional>

using namespace std;
using namespace std::tr1;
using std::tr1::function;

// interface for all delegates
class IDelegate
{
public:
    virtual ~IDelegate() {}
};

//interface for delegates supporting thing
class IThing
{
public:
    virtual ~IThing() {}
    virtual std::string Thing() = 0;
};

// Does not handle Thing
class DelegateA : virtual public IDelegate
{
};

// Handles Thing
class DelegateB : public IThing, public IDelegate
{
    std::string Thing()
    {
        return "delegate implementation";
    }
};

class Delegator
{
public:
    std::string Operation()
    {
        if(Delegate) //have delegate
           if (IThing * pThing = dynamic_cast<IThing*>(Delegate.get()))
            //delegate provides IThing interface
            return pThing->Thing();

        return "default implementation";
    }

    shared_ptr<IDelegate> Delegate;
};

int main()
{
    shared_ptr<DelegateA> delegateA(new DelegateA());
    shared_ptr<DelegateB> delegateB(new DelegateB());
    Delegator delegator;

    // No delegate
    std::cout << delegator.Operation() << std::endl;

    // Delegate doesn't handle "Thing"
    delegator.Delegate = delegateA;
    std::cout << delegator.Operation() << std::endl;

    // Delegate handles "Thing"
    delegator.Delegate = delegateB;
    std::cout << delegator.Operation() << std::endl;

/*
Prints:

  default implementation
  default implementation
  delegate implementation
 */
}


BEGIN # find repunits (all digits are 1 ) such that R(n-1) is divisible by n and n is not prime #
      # R(n) is the nth repunit, so has n 1s                                                    #
    PR precision 8000 PR             # set precision of LONG LONG INT, enough for up to R(8000) #
    PR read "primes.incl.a68" PR                                      # include prime utilities #
    []BOOL prime = PRIMESIEVE 8000;
    LONG LONG INT repunit := 111 111;   # n must be odd as all repunits are odd, the lowest odd #
    INT           r count := 0;          # non-prime is 9, so we start with repunit set to R(6) #
    FOR n FROM 9 BY 2 WHILE r count < 15 DO
        repunit *:= 100 +:= 11;                                       # gets R(n-1) from R(n-3) #
        IF NOT prime[ n ] THEN
            IF repunit MOD n = 0 THEN
                # found non-prime n which divides R(n-1) #
                print( ( " ", whole( n, 0 ) ) );
                r count +:= 1
            FI
        FI
    OD
END


deceptive?: function [n][
    and? -> not? prime? n
         -> zero? (to :integer repeat "1" n-1) % n
]

cnt: 0
i: 3

while [cnt < 10][
    if deceptive? i [
        print i
        cnt: cnt + 1
    ]
    i: i + 2
]


(defprotocol Thing
  (thing [_]))

(defprotocol Operation
  (operation [_]))

(defrecord Delegator [delegate]
  Operation
  (operation [_] (try (thing delegate) (catch IllegalArgumentException e "default implementation"))))

(defrecord Delegate []
  Thing
  (thing [_] "delegate implementation"))


class Delegator
  operation: ->
    if @delegate and typeof (@delegate.thing) is "function"
      return @delegate.thing()
    "default implementation"

class Delegate
  thing: ->
    "Delegate Implementation"

testDelegator = ->
  # Delegator with no delegate.
  a = new Delegator()
  console.log a.operation()

  # Delegator with delegate not implementing "thing"
  a.delegate = "A delegate may be any object"
  console.log a.operation()

  # Delegator with delegate that does implement "thing"
  a.delegate = new Delegate()
  console.log a.operation()

testDelegator()


(defgeneric thing (object)
  (:documentation "Thing the object."))

(defmethod thing (object)
  "default implementation")

(defclass delegator ()
  ((delegate
    :initarg :delegate
    :reader delegator-delegate)))

(defmethod thing ((delegator delegator))
  "If delegator has a delegate, invoke thing on the delegate,
otherwise return \"no delegate\"."
  (if (slot-boundp delegator 'delegate)
    (thing (delegator-delegate delegator))
    "no delegate"))

(defclass delegate () ())

(defmethod thing ((delegate delegate))
  "delegate implementation")

(let ((d1 (make-instance 'delegator))
      (d2 (make-instance 'delegator :delegate nil))
      (d3 (make-instance 'delegator :delegate (make-instance 'delegate))))
  (assert (string= "no delegate" (thing d1)))
  (assert (string= "default implementation" (thing d2)))
  (assert (string= "delegate implementation" (thing d3))))


#include <gmpxx.h>

#include <iomanip>
#include <iostream>

bool is_prime(int n) {
    if (n < 2)
        return false;
    if (n % 2 == 0)
        return n == 2;
    if (n % 3 == 0)
        return n == 3;
    for (int p = 5; p * p <= n; p += 4) {
        if (n % p == 0)
            return false;
        p += 2;
        if (n % p == 0)
            return false;
    }
    return true;
}

int main() {
    std::cout << "First 100 deceptive numbers:\n";
    mpz_class repunit = 11;
    for (int n = 3, count = 0; count != 100; n += 2) {
        if (n % 3 != 0 && n % 5 != 0 && !is_prime(n) &&
            mpz_divisible_ui_p(repunit.get_mpz_t(), n))
            std::cout << std::setw(6) << n << (++count % 10 == 0 ? '\n' : ' ');
        repunit *= 100;
        repunit += 11;
    }
}


// Deceptive numbers. Nigel Galloway: February 13th., 2022
Seq.unfold(fun n->Some(n|>Seq.filter(isPrime>>not)|>Seq.filter(fun n->(10I**(n-1)-1I)%(bigint n)=0I),n|>Seq.map((+)30)))(seq{1;7;11;13;17;19;23;29})|>Seq.concat|>Seq.skip 1
|>Seq.chunkBySize 10|>Seq.take 7|>Seq.iter(fun n->n|>Array.iter(printf "%7d "); printfn "")


class Delegator {
    string delegate() hasDelegate;

    string operation() {
        if (hasDelegate is null)
            return "Default implementation";
        return hasDelegate();
    }

    typeof(this) setDg(string delegate() dg) {
        hasDelegate = dg;
        return this;
    }
}

void main() {
    import std.stdio;
    auto dr = new Delegator;
    string delegate() thing = () => "Delegate implementation";

    writeln(dr.operation());
    writeln(dr.operation());
    writeln(dr.setDg(thing).operation());
}


class Delegator {
  var delegate;

  String operation() {
    if (delegate == null)
      return "default implementation";
    else
      return delegate.thing();
  }
}

class Delegate {
  String thing() => "delegate implementation";
}

main() {
  // Without a delegate:
  Delegator a = new Delegator();
  Expect.equals("default implementation",a.operation());

  // any object doesn't work unless we can check for existing methods
  // a.delegate=new Object();
  // Expect.equals("default implementation",a.operation());

  // With a delegate:
  Delegate d = new Delegate();
  a.delegate = d;
  Expect.equals("delegate implementation",a.operation());
}


unit Printer;

interface

type
  // the "delegate"
  TRealPrinter = class
  public
    procedure Print;
  end;

  // the "delegator"
  TPrinter = class
  private
    FPrinter: TRealPrinter;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Print;
  end;

implementation

{ TRealPrinter }

procedure TRealPrinter.Print;
begin
   Writeln('Something...');
end;

{ TPrinter }

constructor TPrinter.Create;
begin
  inherited Create;
  FPrinter:= TRealPrinter.Create;
end;

destructor TPrinter.Destroy;
begin
  FPrinter.Free;
  inherited;
end;

procedure TPrinter.Print;
begin
  FPrinter.Print;
end;

end.


USING: io kernel lists lists.lazy math math.functions
math.primes prettyprint ;

: repunit ( m -- n ) 10^ 1 - 9 / ;

: composite ( -- list ) 4 lfrom [ prime? not ] lfilter ;

: deceptive ( -- list )
    composite [ [ 1 - repunit ] keep divisor? ] lfilter ;

10 deceptive ltake [ pprint bl ] leach nl


Func Rep(n)=Sigma<m=0,n-1>[10^m].;
c:=0;
n:=3;
while c<10 do
    n:=n+1;
    if Isprime(n)>1 and Divides(n,Rep(n-1)) then !!n; c:+; fi
od;


package main

import (
    "fmt"
    "math/big"
    "rcu"
)

func main() {
    count := 0
    limit := 25
    n := int64(17)
    repunit := big.NewInt(1111111111111111)
    t := new(big.Int)
    zero := new(big.Int)
    eleven := big.NewInt(11)
    hundred := big.NewInt(100)
    var deceptive []int64
    for count < limit {
        if !rcu.IsPrime(int(n)) && n%3 != 0 && n%5 != 0 {
            bn := big.NewInt(n)
            if t.Rem(repunit, bn).Cmp(zero) == 0 {
                deceptive = append(deceptive, n)
                count++
            }
        }
        n += 2
        repunit.Mul(repunit, hundred)
        repunit.Add(repunit, eleven)
    }
    fmt.Println("The first", limit, "deceptive numbers are:")
    fmt.Println(deceptive)
}


using Primes

function deceptives(numwanted)
    n, r, ret = 2, big"1", Int[]
    while length(ret) < numwanted
        !isprime(n) && r % n == 0 && push!(ret, n)
        n += 1
        r = 10r + 1
    end
    return ret
end

@time println(deceptives(30))


def makeDelegator {
    /** construct without an explicit delegate */
    to run() {
        return makeDelegator(null)
    }

    /** construct with a delegate */
    to run(delegateO) { # suffix because "delegate" is a reserved keyword
        def delegator {
            to operation() {
                return if (delegateO.__respondsTo("thing", 0)) {
                           delegateO.thing()
                       } else {
                           "default implementation"
                       }
            }
        }
        return delegator
    }
}

? def delegator := makeDelegator()
> delegator.operation()
# value: "default implementation"

? def delegator := makeDelegator(def doesNotImplement {})
> delegator.operation()
# value: "default implementation"

? def delegator := makeDelegator(def doesImplement {
>     to thing() { return "delegate implementation" }
> })
> delegator.operation()
# value: "default implementation"


import extensions;
import system'routines;

interface IOperable
{
    abstract operate() {}
}

class Operable : IOperable
{
    constructor() {}

    operate()
        = "delegate implementation";
}

class Delegator
{
    object theDelegate;

    set Delegate(object)
    {
        theDelegate := object
    }

    internal operate(operable)
        = "default implementation";

    internal operate(IOperable operable)
        = operable.operate();

    operate()
        <= operate(theDelegate);
}

public program()
{
    var delegator := new Delegator();

    new object[]{nil, new Object(), new Operable()}.forEach:(o)
    {
       delegator.Delegate := o;

       console.printLine(delegator.operate())
    }
}


type Delegator() =
  let defaultOperation() = "default implementation"
  let mutable del = null

  // write-only property "Delegate"
  member x.Delegate with set(d:obj) = del <- d

  member x.operation() =
    if del = null then
      defaultOperation()
    else
      match del.GetType().GetMethod("thing", [||]) with
      | null -> defaultOperation()
      | thing -> thing.Invoke(del, [||]) :?> string

type Delegate() =
  member x.thing() = "delegate implementation"

let d = new Delegator()
assert (d.operation() = "default implementation")

d.Delegate <- "A delegate may be any object"
assert (d.operation() = "default implementation")

d.Delegate <- new Delegate()
assert (d.operation() = "delegate implementation")


ClearAll[DeceptiveNumberQ]
DeceptiveNumberQ[n_Integer] := If[! PrimeQ[n], PowerMod[10, n - 1, 9 n] == 1]
c = 0;
out = Reap[Do[
     If[DeceptiveNumberQ[i],
      Sow[i];
      c++;
      If[c >= 1000, Break[]]
      ]
     ,
     {i, 2, \[Infinity]}
     ]][[2, 1]];
Print["The first 100:"]
Multicolumn[Take[out, 100], Appearance -> "Horizontal"]
Print["The 1000th is: ", out[[1000]]]


program DeceptiveNumbers;
{$IfDef FPC} {$Optimization ON,ALL} {$ENDIF}
{$IfDef Windows} {$APPTYPE CONSOLE} {$ENDIF}
uses
  sysutils;
const
  LIMIT = 100000;//1E6 at home takes over (5 min) now 1m10s
  RepInitLen = 13; //Uint64 19 decimal digits -> max 6 digits divisor
  DecimalDigits = 10*1000*1000*1000*1000;//1E13
  RepLimit = (DecimalDigits-1)DIV 9;//RepInitLen '1'

type
  tmyUint64 = array[0..Limit DIV RepInitLen+1] of Uint64;
var
  {$Align 32}
  K: tmyUint64;
  {$Align 32}
  MaxKIdx : Int32;

procedure OutK(const K:tmyUint64);
var
  i : Uint32;
begin
  For i := MaxKidx downto 0 do
  begin
    write(k[i]:13);
  end;
  writeln;
end;

function isPrime(n: UInt64):boolean;
var
 p: Uint64;
begin
  if n in [2,3,5,7,11,13,17,19,23,29] then
    EXIT(true);

  if Not ODD(n) OR ( n MOD 3 = 0) then
    EXIT(false);
  p := 5;
  repeat
    if (n mod p=0)or(n mod(p+2)=0) then
      EXIT(false);
    p +=6;
  until p*p>n;
  Exit(true);
end;

procedure ExtendRep(var K:tmyUint64;n:NativeUint);
var
  q : Uint64;
  i : Int32;
begin
  n -= MaxKidx*RepInitLen;
  i := MaxKidx;
  while RepInitLen<=n do
  begin
    K[i] := RepLimit;
    inc(i);
    dec(n,RepInitLen);
  end;
  if n = 0 then
    Exit;
  MaxKidx := i;
  q := 1;
  while n<RepInitLen do
  begin
    q *= 10;
    inc(n);
  end;
  K[i] := RepLimit DIV q;
end;

function GetModK(const K:tmyUint64;n:Uint64):NativeUint;
var
  r,q : Uint64;
  i : Uint32;
Begin
  r := 0;
  For i := MaxKidx downto 0 do
  begin
    q := K[i]+r*DecimalDigits;
    r := q MOD n;
  end;
  Exit(r)
end;

const
  NextNotMulOF35 : array[0..7] of byte = (6,4,2,4,2,4,6,2);
var
  i,cnt,idx35 : UInt64;
BEGIN
  fillchar(K,SizeOF(K),#0);
  MaxKIdx:= 0;
  cnt := 0;
  i := 1;
  idx35 := 0;
  repeat
    inc(i,NextNotMulOF35[idx35]);
    IF i > LIMIT then
      BREAK;
    idx35 := (idx35+1) AND 7;
    if isprime(i) then
      continue;
    ExtendRep(k,i-1);
    IF GetModK(K,i)=0 then
    Begin
      inc(cnt);
      write(i:6,',');
      if cnt Mod 10 = 0 then
        writeln;
    end;
  until false;
 {$IfDef Windows}
 readln;
 {$ENDIF}
END.


include FMS-SI.f

: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


package main
import "fmt"

type Delegator struct {
    delegate interface{} // the delegate may be any type
}

// interface that represents anything that supports thing()
type Thingable interface {
    thing() string
}

func (self Delegator) operation() string {
    if v, ok := self.delegate.(Thingable); ok {
        return v.thing()
    }
    return "default implementation"
}

type Delegate int // any dummy type

func (Delegate) thing() string {
    return "delegate implementation"
}

func main() {
    // Without a delegate:
    a := Delegator{}
    fmt.Println(a.operation()) // prints "default implementation"

    // With a delegate that does not implement "thing"
    a.delegate = "A delegate may be any object"
    fmt.Println(a.operation()) // prints "default implementation"

    // With a delegate:
    var d Delegate
    a.delegate = d
    fmt.Println(a.operation()) // prints "delegate implementation"
}


Delegator := Object clone do(
    delegate ::= nil
    operation := method(
        if((delegate != nil) and (delegate hasSlot("thing")),
            delegate thing,
            "default implementation"
        )
    )
)

Delegate := Object clone do(
    thing := method("delegate implementation")
)

a := clone Delegator
a operation println

a setDelegate("A delegate may be any object")
a operation println

a setDelegate(Delegate clone)
a operation println


use strict;
use warnings;
use Math::AnyNum qw(imod is_prime);

my($x,@D) = 2;
while ($x++) {
    push @D, $x if 1 == $x%2 and !is_prime $x and 0 == imod(1x($x-1),$x);
    last if 25 == @D
}
print "@D\n";


with javascript_semantics
constant limit = 70
atom t0 = time()
include mpfr.e
mpz repunit = mpz_init(0)
integer n = 1, count = 0
printf(1,"The first %d deceptive numbers are:\n",limit)
while count<limit do
    -- No repunit is ever divisible by 2 or 5 since it ends in 1.
    -- If n is 3*k, sum(digits(repunit))=3*k-1, not divisible by 3.
    -- Hence only check odd and hop any multiples of 3 or 5.
    n += 2
    mpz_mul_si(repunit,repunit,100)
    mpz_add_si(repunit,repunit,11)
    if gcd(n,3*5)=1
    and not is_prime(n)
    and mpz_divisible_ui_p(repunit,n) then
        count += 1
        printf(1," %7d%n",{n,remainder(count,10)=0})
    end if
end while
printf(1,"%s\n",elapsed(time()-t0))


fcn funnel(dxs, rule){
   x:=0.0; rxs:=L();
   foreach dx in (dxs){
      rxs.append(x + dx);
      x = rule(x,dx);
   }
   rxs
}

fcn mean(xs){ xs.sum(0.0)/xs.len() }

fcn stddev(xs){
   m:=mean(xs);
   (xs.reduce('wrap(sum,x){ sum + (x-m)*(x-m) },0.0)/xs.len()).sqrt();
}

fcn experiment(label,dxs,dys,rule){
   rxs:=funnel(dxs,rule); rys:=funnel(dys,rule);
   label.println();
   "Mean x, y    : %7.4f, %7.4f".fmt(mean(rxs),  mean(rys))  .println();
   "Std dev x, y : %7.4f, %7.4f".fmt(stddev(rxs),stddev(rys)).println();
   println();
}


coclass 'delegator'
  operation=:3 :'thing__delegate ::thing y'
  thing=: 'default implementation'"_
  setDelegate=:3 :'delegate=:y'  NB. result is the reference to our new delegate
  delegate=:<'delegator'

coclass 'delegatee1'

coclass 'delegatee2'
  thing=: 'delegate implementation'"_

NB. set context in case this script was used interactively, instead of being loaded
cocurrent 'base'


interface Thingable {
    String thing();
}

class Delegator {
    public Thingable delegate;

    public String operation() {
        if (delegate == null)
            return "default implementation";
        else
            return delegate.thing();
    }
}

class Delegate implements Thingable {
    public String thing() {
        return "delegate implementation";
    }
}

// Example usage
// Memory management ignored for simplification
public class DelegateExample {
    public static void main(String[] args) {
        // Without a delegate:
        Delegator a = new Delegator();
        assert a.operation().equals("default implementation");

        // With a delegate:
        Delegate d = new Delegate();
        a.delegate = d;
        assert a.operation().equals("delegate implementation");

        // Same as the above, but with an anonymous class:
        a.delegate = new Thingable() {
                public String thing() {
                    return "anonymous delegate implementation";
                }
            };
        assert a.operation().equals("anonymous delegate implementation");
    }
}


function Delegator() {
  this.delegate = null ;
  this.operation = function(){
    if(this.delegate && typeof(this.delegate.thing) == 'function')
      return this.delegate.thing() ;
    return 'default implementation' ;
  }
}

function Delegate() {
  this.thing = function(){
    return 'Delegate Implementation' ;
  }
}

function testDelegator(){
  var a = new Delegator() ;
  document.write(a.operation() + "\n") ;

  a.delegate = 'A delegate may be any object' ;
  document.write(a.operation() + "\n") ;

  a.delegate = new Delegate() ;
  document.write(a.operation() + "\n") ;
}


// [dependencies]
// primal = "0.3"
// rug = "1.15.0"

fn main() {
    println!("First 100 deceptive numbers:");
    use rug::Integer;
    let mut repunit = Integer::from(11);
    let mut n: u32 = 3;
    let mut count = 0;
    while count != 100 {
        if n % 3 != 0 && n % 5 != 0 && !primal::is_prime(n as u64) && repunit.is_divisible_u(n) {
            print!("{:6}", n);
            count += 1;
            if count % 10 == 0 {
                println!();
            } else {
                print!(" ");
            }
        }
        n += 2;
        repunit *= 100;
        repunit += 11;
    }
}


say 100.by {|n|
    n.is_composite && (divmod(powmod(10, n-1, n)-1, 9, n) == 0)
}.join(' ')


import math.big

fn is_prime(n int) bool {
    if n < 2 {
        return false
    } else if n%2 == 0 {
        return n == 2
    } else if n%3 == 0 {
        return n == 3
    } else {
        mut d := 5
        for d*d <= n {
            if n%d == 0 {
                return false
            }
            d += 2
            if n%d == 0 {
                return false
            }
            d += 4
        }
        return true
    }
}

fn main() {
    mut count := 0
    limit := 25
    mut n := i64(17)
    mut repunit := big.integer_from_i64(1111111111111111)
    mut t := big.integer_from_int(0)
    zero := big.integer_from_int(0)
    eleven := big.integer_from_int(11)
    hundred := big.integer_from_int(100)
    mut deceptive := []i64{}
    for count < limit {
        if !is_prime(int(n)) && n%3 != 0 && n%5 != 0 {
            bn := big.integer_from_i64(n)
            t = repunit % bn
            if t == zero {
                deceptive << n
                count++
            }
        }
        n += 2
        repunit = repunit * hundred
        repunit = repunit + eleven
    }
    println("The first $limit deceptive numbers are:")
    println(deceptive)
}


/* deceptive_numbers.wren */

import "./gmp" for Mpz
import "./math" for Int

var count = 0
var limit = 25
var n = 17
var repunit = Mpz.from(1111111111111111)
var deceptive = []
while (count < limit) {
    if (!Int.isPrime(n) && n % 3 != 0 && n % 5 != 0) {
        if (repunit.isDivisibleUi(n)) {
            deceptive.add(n)
            count = count + 1
        }
    }
    n = n + 2
    repunit.mul(100).add(11)
}
System.print("The first %(limit) deceptive numbers are:")
System.print(deceptive)


module Delegates

export Delegator, Delegate

struct Delegator{T}
    delegate::T
end

struct Delegate end

operation(x::Delegator) = thing(x.delegate)
thing(::Any) = "default implementation"
thing(::Delegate) = "delegate implementation"

end  # module Delegates


// version 1.1.51

interface Thingable {
    fun thing(): String?
}

class Delegate(val responds: Boolean) : Thingable {
    override fun thing() = if (responds) "delegate implementation" else null
}

class Delegator(d: Delegate) : Thingable by d {
    fun operation() = thing() ?: "default implementation"
}

fun main(args: Array<String>) {
    // delegate doesn't respond to 'thing'
    val d = Delegate(false)
    val dd = Delegator(d)
    println(dd.operation())

    // delegate responds to 'thing'
    val d2 = Delegate(true)
    val dd2 = Delegator(d2)
    println(dd2.operation())
}


Delegator ::= Object clone tap {
  self delegate := Nil.
  self clone := {
    Parents above (parent self, 'clone) call tap {
      self delegate := #'(self delegate).
    }.
  }.
  self operation := {
    localize.
    if { this delegate slot? 'thing. } then {
      this delegate thing.
    } else {
      "default implementation".
    }.
  }.
}.

Delegate ::= Object clone tap {
  self thing := "delegate implementation".
}.

;; No delegate
foo := Delegator clone.
println: foo operation. ;; "default implementation"

;; Delegate which lacks `thing`
foo delegate := Object.
println: foo operation. ;; "default implementation"

;; Delegate which implements `thing`
foo delegate := Delegate.
println: foo operation. ;; "delegate implementation"


% define a category for holding the interface
% and implementation for delegator objects

:- category(delegator).

    :- public(delegate/1).
    :- public(set_delegate/1).

    :- private(delegate_/1).
    :- dynamic(delegate_/1).

    delegate(Delegate) :-
        ::delegate_(Delegate).

    set_delegate(Delegate) :-
        ::retractall(delegate_(Delegate)),
        ::assertz(delegate_(Delegate)).

:- end_category.

% define a simpler delegator object, with a
% method, operation/1, for testing delegation

:- object(a_delegator,
    imports(delegator)).

    :- public(operation/1).

    operation(String) :-
        (   ::delegate(Delegate), Delegate::current_predicate(thing/1) ->
            % a delegate is defined that understands the method thing/1
            Delegate::thing(String)
        ;   % otherwise just use the default implementation
            String = 'default implementation'
        ).

:- end_object.

% define an interface for delegate objects

:- protocol(delegate).

    :- public(thing/1).

:- end_protocol.

% define a simple delegate

:- object(a_delegate,
    implements(delegate)).

    thing('delegate implementation').

:- end_object.

% define a simple object that doesn't implement the "delegate" interface

:- object(an_object).

:- end_object.

% test the delegation solution when this file is compiled and loaded

:- initialization((
    % without a delegate:
    a_delegator::operation(String1),
    String1 == 'default implementation',
    % with a delegate that does not implement thing/1:
    a_delegator::set_delegate(an_object),
    a_delegator::operation(String2),
    String2 == 'default implementation',
    % with a delegate that implements thing/1:
    a_delegator::set_delegate(a_delegate),
    a_delegator::operation(String3),
    String3 == 'delegate implementation'
)).


local function Delegator()
  return {
    operation = function(self)
      if (type(self.delegate)=="table") and (type(self.delegate.thing)=="function") then
        return self.delegate:thing()
      else
        return "default implementation"
      end
    end
  }
end

local function Delegate()
  return {
    thing = function(self)
      return "delegate implementation"
    end
  }
end

local function NonDelegate(which)
  if (which == 1) then return true -- boolean
  elseif (which == 2) then return 12345 -- number
  elseif (which == 3) then return "Hello" -- string
  elseif (which == 4) then return function() end -- function
  elseif (which == 5) then return { nothing = function() end } -- table (without "thing")
  elseif (which == 6) then return coroutine.create(function() end) -- thread
  elseif (which == 7) then return io.open("delegates.lua","r") -- userdata (if exists, or nil)
  end
end

-- WITH NO (NIL) DELEGATE
local d = Delegator()
assert(d:operation() == "default implementation")

-- WITH A NON-DELEGATE
for i = 1, 7 do
  d.delegate = NonDelegate(i)
  assert(d:operation() == "default implementation")
end

-- WITH A PROPER DELEGATE
d.delegate = Delegate()
assert(d:operation() == "delegate implementation")

print("pass")


Module Checkit {
	\\ there are some kinds of objects in M2000, one of them is the Group, the user object
	\\ the delegate is a pointer to group
	\\ 1. We pass parameters to function operations$(), $ means that this function return string value
	\\ 2. We see how this can be done with pointers to group
	global doc$  \\ first define a global (for this module) to log output
	document doc$="Output:"+{
	}
	class Delegator {
	private:
		group delegate
		group null
	public:
		function operation$ {
			if not .delegate is .null then
				try ok {
					ret$="Delegate implementation:"+.delegate=>operation$(![])
					\\ [] is the stack of values (leave empty stack), ! used to place this to callee stack
				}
				if not ok or error then ret$="No implementation"
			else
				ret$= "Default implementation"
			end if
			\\ a global  variable and all group members except arrays use <= not =. Simple = used for declaring local variables
			doc$<=ret$+{
			}
			=ret$
		}
	class:
		Module Delegator {
				class none {}
				.null->none()
				If match("G") then .delegate->(group) else .delegate<=.null
		}
	}

	Class Thing {
		function operation$(a,b) {
			=str$(a*b)
		}
	}
	Module CallbyReference (&z as group) {
		Print Z.operation$(5,30)
	}
	Module CallbyValue (z as group) {
		Print Z.operation$(2,30)
	}
	Module CallbyReference2 (&z as pointer) {
		Print Z=>operation$(5,30)
	}
	Module CallbyValue2 (z as pointer) {
		Print Z=>operation$(2,30)
	}
	\\ Normal Group  ' no logging to doc$
	N=Thing()
	Print N.operation$(10,20)
	CallbyReference &N
	CallbyValue N
	N1->N    ' N1 is a pointer to a named group
	Print N1=>operation$(10,20)
	CallbyReference2 &N1
	CallbyValue2 N1
	N1->(N)  ' N1 now is a pointer to a float group (a copy of N)
 	Print N1=>operation$(10,20)
	CallbyReference2 &N1
	CallbyValue2 N1
	\\ using named groups (A is a group, erased when this module exit)
	A=Delegator()
	B=Delegator(Thing())
	Print A.operation$(10,20)
	Print B.operation$(10,20)
	A=B
	CallbyReference &A
	CallbyValue A
	\\ M2000 has two kinds of pointers to groups
	\\ one is a pointer to a no named group (a float group)
	\\ a float group leave until no pointer refer to it
	\\ using pointers to groups (A1 is a pointer to Group)
	A1->Delegator()
	B1->Delegator(Thing())
	Print A1=>operation$(10,20)
	Print B1=>operation$(10,20)
	A1=B1
	CallbyReference2 &A1
	CallbyValue2 A1
	\\ Second type is a pointer to a named group
	\\ the pointer hold a weak reference to named group
	\\ so a returned pointer of thid kind can be invalid if actual reference not exist
	A=Delegator() ' copy a float group to A
	A1->A
	B1->B
	Print A1=>operation$(10,20)
	Print B1=>operation$(10,20)
	A1=B1
	CallbyReference2 &A1
	CallbyValue2 A1
	Group Something {
	}
	B=Delegator(Something)
	Print B.operation$(10,20)
	CallbyReference &B
	CallbyValue B
	Report Doc$
	Clipboard Doc$
}
Checkit


delegator[del_]@operate :=
  If[StringQ[[email protected]], [email protected], "default implementation"];
del1 = Null;
[email protected] = "phone";
[email protected] = "delegate implementation";
Print[delegator[#]@operate] & /@ {del1, del2, del3};


{
	type Delegator

	F init(d:Delegator) d.delegate = null

	F default_impl(d:Delegator) 'default implementation'

	F operation(d:Delegator) default_impl(d)

	F operation(d:Delegator) {
		guard defined thing
		guard thing is Fun
		try {
			d.delegate.thing()
		}
		catch(e:ImplNotFound) {
			# Might be unrelated exception, so check and optionally rethrow
			e.callable !== thing throws e
			default_impl(d)
		}
	}

	F operation(d:Delegator) {
		guard d.delegate is Null
		default_impl(d)
	}

	a = Delegator()
	echo(a.operation())

	# There is no method thing(s:Str)
	a.delegate = "abc"
	echo(a.operation())

	# ... now there is method thing(s:Str)
	F thing(s:Str) 'delegate implementation'
	echo(a.operation())

}


####################################################################################################
# Base delegate.

type Delegate = ref object of RootObj
  nil

method thing(d: Delegate): string {.base.} =
  ## Default implementation of "thing".
  ## Using a method rather than a proc allows dynamic dispatch.
  "default implementation"

####################################################################################################
# Delegator.

type Delegator = object
  delegate: Delegate

proc initDelegator(d: Delegate = nil): Delegator =
  ## Create a delegator with given delegate or nil.
  if d.isNil:
    Delegator(delegate: Delegate())     # Will use a default delegate instance.
  else:
    Delegator(delegate: d)              # Use the provided delegate instance.

proc operation(d: Delegator): string =
  ## Calls the delegate.
  d.delegate.thing()

####################################################################################################
# Usage.

let d = initDelegator()
echo "Without any delegate: ", d.operation()

type Delegate1 = ref object of Delegate

let d1 = initDelegator(Delegate1())
echo "With a delegate which desn’t provide the “thing” method: ", d1.operation()

type Delegate2 = ref object of Delegate

method thing(d: Delegate2): string =
  "delegate implementation"

let d2 = initDelegator(Delegate2())
echo "With a delegate which provided the “thing” method: ", d2.operation()


interface Thingable {
  method : virtual : public : Thing() ~ String;
}

class Delegator {
  @delegate : Thingable;

  New() {
  }

  method : public : SetDelegate(delegate : Thingable) ~ Nil {
    @delegate := delegate;
  }

  method : public : Operation() ~ String {
    if(@delegate = Nil) {
      return "default implementation";
    }
    else {
      return @delegate->Thing();
    };
  }
}

class Delegate implements Thingable {
  New() {
  }

  method : public : Thing() ~ String {
    return "delegate implementation";
  }
}

class Example {
  function : Main(args : String[]) ~ Nil {
    # Without a delegate:
    a := Delegator->New();
    Runtime->Assert(a->Operation()->Equals("default implementation"));

    # With a delegate:
    d := Delegate->New();
    a->SetDelegate(d);
    Runtime->Assert(a->Operation()->Equals("delegate implementation"));

    # Same as the above, but with an anonymous class:
    a->SetDelegate(Base->New() implements Thingable {
      method : public : Thing() ~ String {
        return "anonymous delegate implementation";
      }
    });

    Runtime->Assert(a->Operation()->Equals("anonymous delegate implementation"));
  }
}


#import <Foundation/Foundation.h>

@interface Delegator : NSObject {

    id delegate;
}

- (id)delegate;
- (void)setDelegate:(id)obj;
- (NSString *)operation;

@end

@implementation Delegator

- (id)delegate {

    return delegate;
}

- (void)setDelegate:(id)obj {

    delegate = obj; // Weak reference
}

- (NSString *)operation {

    if ([delegate respondsToSelector:@selector(thing)])
        return [delegate thing];

    return @"default implementation";
}

@end

// Any object may implement these
@interface NSObject (DelegatorDelegating)

- (NSString *)thing;

@end

@interface Delegate : NSObject

// Don't need to declare -thing because any NSObject has this method

@end

@implementation Delegate

- (NSString *)thing {

    return @"delegate implementation";
}

@end

// Example usage
// Memory management ignored for simplification
int main() {

    // Without a delegate:
    Delegator *a = [[Delegator alloc] init];
    NSLog(@"%d\n", [[a operation] isEqualToString:@"default implementation"]);

    // With a delegate that does not implement thing:
    [a setDelegate:@"A delegate may be any object"];
    NSLog(@"%d\n", [[a operation] isEqualToString:@"delegate implementation"]);

    // With a delegate that implements "thing":
    Delegate *d = [[Delegate alloc] init];
    [a setDelegate:d];
    NSLog(@"%d\n", [[a operation] isEqualToString:@"delegate implementation"]);

    return 0;
}


Object Class new: Delegate1

Object Class new: Delegate2
Delegate2 method: thing  "Delegate implementation" println ;

Object Class new: Delegator(delegate)
Delegator method: initialize  := delegate ;

Delegator method: operation
   @delegate respondTo(#thing) ifTrue: [ @delegate thing return ]
   "Default implementation" println ;


delegator = .delegator~new   -- no delegate
say delegator~operation
-- an invalid delegate type
delegator~delegate = "Some string"
say delegator~operation
-- a good delegate
delegator~delegate = .thing~new
say delegator~operation
-- a directory object with a thing entry defined
d = .directory~new
d~thing = "delegate implementation"
delegator~delegate = d
say delegator~operation

-- a class we can use as a delegate
::class thing
::method thing
  return "delegate implementation"

::class delegator
::method init
  expose delegate
  use strict arg delegate = .nil

::attribute delegate

::method operation
  expose delegate
  if delegate == .nil then return "default implementation"

  -- Note:  We could use delegate~hasMethod("THING") to check
  -- for a THING method, but this will fail of the object relies
  -- on an UNKNOWN method to handle the method.  By trapping
  -- NOMETHOD conditions, we can allow those calls to go
  -- through
  signal on nomethod
  return delegate~thing

nomethod:
  return "default implementation"


class DelegateA 'not implmenting thing()
'==============
'
string message

end class

class DelegateB 'implementing thing()
'==============
'
string message

method thing() as string
return message
end method
'
end class

Class Delegator
'==============
'
has DelegateA dgA
has DelegateB dgB
'
method operation() as DelegateB
dgB.message="Delegate Implementation"
return @dgB
end method

method thing() as string
return "not using Delegate"
end method
'
end class

'====
'TEST
'====

Delegator dgr
let dg=dgr.operation
print dgr.thing 'result "not using Delegate"
print dg.thing  'result "Delegate Implementation"


declare
  class Delegator from BaseObject
     attr
	delegate:unit

     meth set(DG)
	{Object.is DG} = true %% assert: DG must be an object
	delegate := DG
     end

     meth operation($)
	if @delegate == unit then
	   {self default($)}
	else
	   try
	      {@delegate thing($)}
	   catch error(object(lookup ...) ...) then
	      %% the delegate did not understand the message
	      {self default($)}
	   end
	end
     end

     meth default($)
	"default implementation"
     end
  end

  class Delegate from BaseObject
     meth thing($)
	"delegate Implementation"
     end
  end

  A = {New Delegator noop}
in
  {System.showInfo {A operation($)}}

  {A set({New BaseObject noop})}
  {System.showInfo {A operation($)}}

  {A set({New Delegate noop})}
  {System.showInfo {A operation($)}}


use strict;

package Delegator;
sub new {
   bless {}
}
sub operation {
   my ($self) = @_;
   if (defined $self->{delegate} && $self->{delegate}->can('thing')) {
      $self->{delegate}->thing;
   } else {
      'default implementation';
   }
}
1;

package Delegate;
sub new {
   bless {};
}
sub thing {
   'delegate implementation'
}
1;

package main;
# No delegate
my $a = Delegator->new;
$a->operation eq 'default implementation' or die;

# With a delegate that does not implement "thing"
$a->{delegate} = 'A delegate may be any object';
$a->operation eq 'default implementation' or die;

# With delegate that implements "thing"
$a->{delegate} = Delegate->new;
$a->operation eq 'delegate implementation' or die;


enum OTHER, OPERATION

function operation(object o)
    integer rid = o[OPERATION]
    if rid!=NULL then
        return call_func(rid,{})
    end if
    return "no implementation"
end function

function xthing()
    return "default implementation"
end function

function newX()
    return {1,routine_id("xthing"),2}
end function

function newY()
    object res = newX()
    res[OTHER] = "something else"
    -- remove delegate:
    res[OPERATION] = NULL
    return res
end function

function zthing()
    return "delegate implementation"
end function

function newZ()
    object res = newX()
    -- replace delegate:
    res[OPERATION] = routine_id("zthing")
    return res
end function

object x = newX(),
       y = newY(),
       z = newZ()

?operation(x)
?operation(y)
?operation(z)


class Delegator {
  function __construct() {
    $this->delegate = NULL ;
  }
  function operation() {
    if(method_exists($this->delegate, "thing"))
      return $this->delegate->thing() ;
    return 'default implementation' ;
  }
}

class Delegate {
  function thing() {
    return 'Delegate Implementation' ;
  }
}

$a = new Delegator() ;
print "{$a->operation()}\n" ;

$a->delegate = 'A delegate may be any object' ;
print "{$a->operation()}\n" ;

$a->delegate = new Delegate() ;
print "{$a->operation()}\n" ;


(class +Delegator)
# delegate

(dm operation> ()
   (if (: delegate)
      (thing> @)
      "default implementation" ) )

(class +Delegate)
# thing

(dm T (Msg)
   (=: thing Msg) )

(dm thing> ()
   (: thing) )

(let A (new '(+Delegator))
   # Without a delegate
   (println (operation> A))

   # With delegate that does not implement 'thing>'
   (put A 'delegate (new '(+Delegate)))
   (println (operation> A))

   # With delegate that implements 'thing>'
   (put A 'delegate (new '(+Delegate) "delegate implementation"))
   (println (operation> A)) )


uses objectclass;
define :class Delegator;
    slot delegate = false;
enddefine;

define :class Delegate;
enddefine;

define :method thing(x : Delegate);
   'delegate implementation'
enddefine;

define :method operation(x : Delegator);
if delegate(x) and fail_safe(delegate(x), thing) then
   ;;; Return value is on the stack
else
   'default implementation'
endif;
enddefine;

;;; Default, without a delegate
lvars a = newDelegator();
operation(a) =>

;;; a delegating to itself (works because Delegator does not
;;; implement thing)
a -> delegate(a);
operation(a) =>

;;; delegating to a freshly created Delegate
newDelegate() -> delegate(a);
operation(a) =>


class Delegator:
   def __init__(self):
      self.delegate = None
   def operation(self):
       if hasattr(self.delegate, 'thing') and callable(self.delegate.thing):
          return self.delegate.thing()
       return 'default implementation'

class Delegate:
   def thing(self):
      return 'delegate implementation'

if __name__ == '__main__':

   # No delegate
   a = Delegator()
   assert a.operation() == 'default implementation'

   # With a delegate that does not implement "thing"
   a.delegate = 'A delegate may be any object'
   assert a.operation() == 'default implementation'

   # With delegate that implements "thing"
   a.delegate = Delegate()
   assert a.operation() == 'delegate implementation'


#lang racket
;; Delegates. Tim Brown 2014-10-16

(define delegator%
  (class object%
    (init-field [delegate #f])
    (define/public (operation)
      (cond [(and (object? delegate) (object-method-arity-includes? delegate 'thing 0))
             (send delegate thing)]
            [else "default implementation"]))
    (super-new)))

(define non-thinging-delegate% (class object% (super-new)))

(define thinging-delegate%
  (class object%
    (define/public (thing) "delegate implementation")
    (super-new)))

(module+ test
  (require tests/eli-tester)
  (define delegator-1 (new delegator%))
  (define delegator-2 (new delegator%))
  (define non-thinging-delegate (new non-thinging-delegate%))
  (define thinging-delegate     (new thinging-delegate%))

  (test
   (send delegator-1 operation) => "default implementation"
   (send delegator-2 operation) => "default implementation"
   (set-field! delegate delegator-1 non-thinging-delegate) => (void)
   (set-field! delegate delegator-2 thinging-delegate)     => (void)
   (send delegator-1 operation) => "default implementation"
   (send delegator-2 operation) => "delegate implementation"
   (send (new delegator% [delegate thinging-delegate]) operation) => "delegate implementation"))


class Non-Delegate  { }

class Delegate {
	method thing {
		return "delegate implementation"
	}
}

class Delegator {
	has $.delegate is rw;

	method operation {
		$.delegate.^can( 'thing' ) ?? $.delegate.thing
		!! "default implementation"
	}
}

my Delegator $d .= new;

say "empty: "~$d.operation;

$d.delegate = Non-Delegate.new;

say "Non-Delegate: "~$d.operation;

$d.delegate = Delegate.new;

say "Delegate: "~$d.operation;


class Delegator
   attr_accessor :delegate
   def operation
      if @delegate.respond_to?(:thing)
         @delegate.thing
      else
         'default implementation'
      end
   end
end

class Delegate
   def thing
      'delegate implementation'
   end
end

if __FILE__ == $PROGRAM_NAME

   # No delegate
   a = Delegator.new
   puts a.operation # prints "default implementation"

   # With a delegate that does not implement "thing"
   a.delegate = 'A delegate may be any object'
   puts a.operation # prints "default implementation"

   # With delegate that implements "thing"
   a.delegate = Delegate.new
   puts a.operation # prints "delegate implementation"
end


trait Thingable {
    fn thing(&self) -> &str;
}

struct Delegator<T>(Option<T>);

struct Delegate {}

impl Thingable for Delegate {
    fn thing(&self) -> &'static str {
        "Delegate implementation"
    }
}

impl<T: Thingable> Thingable for Delegator<T> {
    fn thing(&self) -> &str {
        self.0.as_ref().map(|d| d.thing()).unwrap_or("Default implmementation")
    }
}

fn main() {
    let d: Delegator<Delegate> = Delegator(None);
    println!("{}", d.thing());

    let d: Delegator<Delegate> = Delegator(Some(Delegate {}));
    println!("{}", d.thing());
}


trait Thingable {
  def thing: String
}

class Delegator {
  var delegate: Thingable = _

  def operation: String = if (delegate == null) "default implementation"
  else delegate.thing
}

class Delegate extends Thingable {
  override def thing = "delegate implementation"
}

// Example usage
// Memory management ignored for simplification
object DelegateExample extends App {

  val a = new Delegator
  assert(a.operation == "default implementation")
  // With a delegate:
  val d = new Delegate
  a.delegate = d
  assert(a.operation == "delegate implementation")
  // Same as the above, but with an anonymous class:
  a.delegate = new Thingable() {
    override def thing = "anonymous delegate implementation"
  }
  assert(a.operation == "anonymous delegate implementation")

}


class NonDelegate { }

class Delegate {
    method thing {
        return "delegate implementation"
    }
}

class Delegator (delegate = null) {
    method operation {

        if (delegate.respond_to(:thing)) {
            return delegate.thing
        }

        return "default implementation"
    }
}

var d = Delegator()
say "empty: #{d.operation}"
d.delegate = NonDelegate()
say "NonDelegate: #{d.operation}"
d.delegate = Delegate()
say "Delegate: #{d.operation}"


Object
 subclass:#Thingy
 instanceVariableNames:''

thing
    ^ 'thingy implementation'


import Foundation

protocol Thingable { // prior to Swift 1.2, needs to be declared @objc
  func thing() -> String
}

class Delegator {
  weak var delegate: AnyObject?
  func operation() -> String {
    if let f = self.delegate?.thing {
      return f()
    } else {
      return "default implementation"
    }
  }
}

class Delegate {
  dynamic func thing() -> String { return "delegate implementation" }
}

// Without a delegate:
let a = Delegator()
println(a.operation())    // prints "default implementation"

// With a delegate that does not implement thing:
a.delegate = "A delegate may be any object"
println(a.operation())    // prints "default implementation"

// With a delegate that implements "thing":
let d = Delegate()
a.delegate = d
println(a.operation())    // prints "delegate implementation"


package require TclOO

oo::class create Delegate {
    method thing {} {
        return "delegate impl."
    }
    export thing
}

oo::class create Delegator {
    variable delegate
    constructor args {
        my delegate {*}$args
    }

    method delegate args {
        if {[llength $args] == 0} {
            if {[info exists delegate]} {
                return $delegate
            }
        } elseif {[llength $args] == 1} {
            set delegate [lindex $args 0]
        } else {
            return -code error "wrong # args: should be \"[self] delegate ?target?\""
        }
    }

    method operation {} {
        try {
            set result [$delegate thing]
        } on error e {
            set result "default implementation"
        }
        return $result
    }
}

# to instantiate a named object, use: class create objname; objname aMethod
# to have the class name the object:  set obj [class new]; $obj aMethod

Delegator create a
set b [Delegator new "not a delegate object"]
set c [Delegator new [Delegate new]]

assert {[a operation] eq "default implementation"}   ;# a "named" object, hence "a ..."
assert {[$b operation] eq "default implementation"}  ;# an "anonymous" object, hence "$b ..."
assert {[$c operation] ne "default implementation"}

# now, set a delegate for object a
a delegate [$c delegate]
assert {[a operation] ne "default implementation"}

puts "all assertions passed"


a = new()
a.f = method(){
        .x.print()
}

c = new()
c.g = method(){
        (.x + 1).print()
}

# array of delegates
b = new()
b.delegate = new()
b.delegate[0] = a
b.delegate[1] = c
b.x = 3
b.f()
b.g()

# single delegate
d = new()
d.delegate = a
d.x = 7
d.f()


class Thingable {
    thing { }
}

// Delegate that doesn't implement Thingable
class Delegate {
    construct new() { }
}

// Delegate that implements Thingable
class Delegate2 is Thingable {
    construct new() { }

    thing { "delegate implementation" }
}

class Delegator {
    construct new() {
        _delegate = null
    }

    delegate     { _delegate }
    delegate=(d) { _delegate = d }

    operation {
        if (!_delegate || !(_delegate is Thingable)) return "default implementation"
        return _delegate.thing
    }
}

// without a delegate
var d = Delegator.new()
System.print(d.operation)

// with a delegate that doesn't implement Thingable
d.delegate = Delegate.new()
System.print(d.operation)

// with a delegate that does implement Thingable
d.delegate = Delegate2.new()
System.print(d.operation)


class Thingable{ var thing; }

class Delegator{
   var delegate;
   fcn operation{
      if (delegate) delegate.thing;
      else "default implementation"
   }
}

class Delegate(Thingable){ thing = "delegate implementation" }


 # assume max int <= ABS - max negative int #
 INT max bounded = ( LENG max int * max int > long max int | ENTIER sqrt(max int) | max int );

 MODE RANGE = STRUCT(INT lwb, upb);
 MODE BOUNDED = STRUCT(INT value, RANGE range);
 FORMAT bounded repr = $g"["g(-0)":"g(-0)"]"$;

 # Define some useful operators for looping over ranges #
 OP LWB = (RANGE range)INT: lwb OF range,
    UPB = (RANGE range)INT: upb OF range,
    LWB = (BOUNDED bounded)INT: lwb OF range OF bounded,
    UPB = (BOUNDED bounded)INT: upb OF range OF bounded;

 PROC raise exception = ([]STRING args)VOID: (
   put(stand error, ("exception: ",args, newline));
   stop
 );

 PROC raise not implemented error := ([]STRING args)VOID: raise exception(args);
 PROC raise bounds error := ([]STRING args)VOID: raise exception(args);

 PRIO MIN=9, MAX=9;
 OP MIN = ([]INT list)INT: (
   INT out:= list[LWB list];
   FOR index FROM LWB list+1 TO UPB list DO IF list[index]<out THEN out :=list[index] FI OD;
   out
 );
 OP MAX = ([]INT list)INT: (
   INT out:= list[LWB list];
   FOR index FROM LWB list+1 TO UPB list DO IF list[index]>out THEN out :=list[index] FI OD;
   out
 );

 PRIO ASSERTIN = 6;
 OP ASSERTIN = (INT result, []RANGE range)BOUNDED: (
     BOUNDED out = (result, (MAX lwb OF range, MIN upb OF range));
     IF value OF out < lwb OF range OF out THEN
       raise bounds error(("out of bounds", whole(result, int width)," < [",whole(MAX lwb OF range, int width),":]"))
     ELIF value OF out > upb OF range OF out THEN
       raise bounds error(("out of bounds", whole(result, int width)," > [:",whole(MIN upb OF range, int width),"]"))
     FI;
     out
   ),
   ASSERTIN = (LONG INT result, []RANGE range)BOUNDED: (
     STRUCT (LONG INT value, RANGE range) out = (result, (MAX lwb OF range, MIN upb OF range));
     IF value OF out < lwb OF range OF out THEN
       raise bounds error(("out of bounds", whole(result, long int width)," < [",whole(MAX lwb OF range, int width),":]"))
     ELIF value OF out > upb OF range OF out THEN
       raise bounds error(("out of bounds", whole(result, long int width)," > [:",whole(MIN upb OF range, int width),"]"))
     FI;
     (SHORTEN value OF out, range OF out)
   ),
   ASSERTIN = (INT result, []BOUNDED bounds)BOUNDED: result ASSERTIN range OF bounds,
   ASSERTIN = (LONG INT result, []BOUNDED bounds)BOUNDED: result ASSERTIN range OF bounds;

 INT half max int = max int OVER 2;
 INT sqrt max int = ENTIER sqrt (max int);

 OP + = (BOUNDED a, b)BOUNDED:
          IF ABS value OF a < half max int AND ABS value OF b < half max int THEN
            value OF a + value OF b ASSERTIN []BOUNDED(a,b)
          ELSE
            LENG value OF a + value OF b ASSERTIN []BOUNDED(a,b)
          FI,
    - = (BOUNDED a, b)BOUNDED: value OF a + -value OF b ASSERTIN []BOUNDED(a,b),
    * = (BOUNDED a, b)BOUNDED:
          IF ABS value OF a < sqrt max int AND ABS value OF b < sqrt max int THEN
            value OF a * value OF b ASSERTIN []BOUNDED(a,b)
          ELSE
            LENG value OF a * value OF b ASSERTIN []BOUNDED(a,b)
          FI,
    /  = (BOUNDED a, b)REAL: value OF a / value OF b,
    %  = (BOUNDED a, b)BOUNDED: value OF a % value OF b ASSERTIN []BOUNDED(a,b),
    %* = (BOUNDED a, b)BOUNDED: value OF a %* value OF b ASSERTIN []BOUNDED(a,b),
    ** = (BOUNDED a, INT exponent)BOUNDED: value OF a ** exponent ASSERTIN []BOUNDED(a);

 OP OVER = (INT value, RANGE range)BOUNDED:
   IF ABS lwb OF range > max bounded THEN
     raise bounds error(("out of bounds, ABS", whole(lwb OF range, int width)," > [:",whole(max bounded, int width),"]"));
     SKIP
   ELIF ABS upb OF range > max bounded THEN
     raise bounds error(("out of bounds, ABS", whole(upb OF range, int width)," > [:",whole(max bounded, int width),"]"));
     SKIP
   ELSE
     value ASSERTIN []RANGE(range)
   FI;

 OP INTINIT = (BOUNDED range)REAL: value OF range;

 OP <  = (BOUNDED a, b)BOOL: value OF a < value OF b,
    >  = (BOUNDED a, b)BOOL: value OF a > value OF b,
    <= = (BOUNDED a, b)BOOL: NOT ( value OF a > value OF b ),
    >= = (BOUNDED a, b)BOOL: NOT ( value OF a < value OF b ),
    =  = (BOUNDED a, b)BOOL: value OF a = value OF b,
    /= = (BOUNDED a, b)BOOL: NOT (a = b);

 # Monadic operators #
 OP - = (BOUNDED range)BOUNDED: -value OF range ASSERTIN []BOUNDED(range),
    ABS = (BOUNDED range)BOUNDED: ABS value OF range ASSERTIN []BOUNDED(range);

 COMMENT Operators for extended characters set, and increment/decrement:
 OP +:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a + b ),
    +=: = (BOUNDED a, REF BOUNDED b)REF BOUNDED: ( b := a + b ),
    -:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a - b ),
    *:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a * b ),
    %:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a % b ),
    %*:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a %* b );

 # OP aliases for extended character sets (eg: Unicode, APL, ALCOR and GOST 10859) #
 OP ×  = (BOUNDED a, b)BOUNDED: a * b,
    ÷  = (BOUNDED a, b)INT: a OVER b,
    ÷× = (BOUNDED a, b)BOUNDED: a MOD b,
    ÷* = (BOUNDED a, b)BOUNDED: a MOD b,
    %× = (BOUNDED a, b)BOUNDED: a MOD b,
    ≤  = (BOUNDED a, b)BOUNDED: a <= b,
    ≥  = (BOUNDED a, b)BOUNDED: a >= b,
    ≠  = (BOUNDED a, b)BOOL: a /= b,
    ↑  = (BOUNDED range, INT exponent)BOUNDED: value OF range ** exponent,

    ÷×:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a MOD b ),
    %×:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a MOD b ),
    ÷*:= = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a := a MOD b );

 # BOLD aliases for CPU that only support uppercase for 6-bit bytes  - wrist watches #
 OP OVER = (BOUNDED a, b)INT: a % b,
    MOD = (BOUNDED a, b)BOUNDED: a %*b,
    LT = (BOUNDED a, b)BOOL: a <  b,
    GT = (BOUNDED a, b)BOOL: a >  b,
    LE = (BOUNDED a, b)BOOL: a <= b,
    GE = (BOUNDED a, b)BOOL: a >= b,
    EQ = (BOUNDED a, b)BOOL: a =  b,
    NE = (BOUNDED a, b)BOOL: a /= b,
    UP = (BOUNDED range, INT exponent)BOUNDED: range**exponent;

 # the required standard assignment operators #
 OP PLUSAB  = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a +:= b ), # PLUS #
    PLUSTO  = (BOUNDED a, REF BOUNDED b)REF BOUNDED: ( a +=: b ), # PRUS #
    MINUSAB = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a *:= b ),
    DIVAB   = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a /:= b ),
    OVERAB  = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a %:= b ),
    MODAB   = (REF BOUNDED a, BOUNDED b)REF BOUNDED: ( a %*:= b );

END COMMENT
Test:
 RANGE range = RANGE(0, 10000);

 # override the default exception #
 raise bounds error := ([]STRING args)VOID: (
     putf(stand error, ($g$, args, $"- exiting to except bounds error"l$));
     except bounds error
   );

 BOUNDED a, b := 0 OVER range;
 FOR step FROM 4 BY 4 TO UPB range DO # something for pythagoras #
   b := b + step OVER range;
   a := ENTIER sqrt( 1.5 + 2 * value OF b ) OVER range OF b;
   printf(($"Sum of "$, bounded repr, a * a, b * b,
           $" is "$,    bounded repr, a * a + b * b, $l$))
 OD;
 except bounds error:
   SKIP


(*

Here is the type:

*)

typedef rosetta_code_primitive_type =
  [i : int | 1 <= i; i <= 10] int i

(*

You do not have to insert bounds checking, and the compiler inserts no
bounds checking. You simply *cannot* assign an out-of-range value.

(Proviso: unless you do some serious cheating.)

*)

implement
main0 (argc, argv) =
  let
    var n : rosetta_code_primitive_type
  in
    n := 1;
    n := 10;
    n := 11
  end

(*

An attempt to compile this program *will fail* when it typechecks ‘n := 11’:

$ patscc primitive_type-postiats.dats
/path/to/primitive_type-postiats.dats: 282(line=21, offs=3) -- 373(line=27, offs=6): error(3): unsolved constraint: C3NSTRprop(C3TKmain(); S2Eapp(S2Ecst(<=); S2EVar(0->S2Eintinf(11)), S2Eintinf(10)))
/path/to/primitive_type-postiats.dats: 282(line=21, offs=3) -- 373(line=27, offs=6): error(3): unsolved constraint for lvar preservation
typechecking has failed: there are some unsolved constraints: please inspect the above reported error message(s) for information.
exit(ATS): uncaught exception: _2tmp_2ATS_2dPostiats_2src_2pats_error_2esats__FatalErrorExn(1025)

*)


using System;
using System.Globalization;

struct LimitedInt : IComparable, IComparable<LimitedInt>, IConvertible, IEquatable<LimitedInt>, IFormattable
{
    const int MIN_VALUE = 1;
    const int MAX_VALUE = 10;

    public static readonly LimitedInt MinValue = new LimitedInt(MIN_VALUE);
    public static readonly LimitedInt MaxValue = new LimitedInt(MAX_VALUE);

    static bool IsValidValue(int value) => value >= MIN_VALUE && value <= MAX_VALUE;

    readonly int _value;
    public int Value => this._value == 0 ? MIN_VALUE : this._value; // Treat the default, 0, as being the minimum value.

    public LimitedInt(int value)
    {
        if (!IsValidValue(value))
            throw new ArgumentOutOfRangeException(nameof(value), value, $"Value must be between {MIN_VALUE} and {MAX_VALUE}.");
        this._value = value;
    }

    #region IComparable
    public int CompareTo(object obj)
    {
        if (obj is LimitedInt l) return this.Value.CompareTo(l);
        throw new ArgumentException("Object must be of type " + nameof(LimitedInt), nameof(obj));
    }
    #endregion

    #region IComparable<LimitedInt>
    public int CompareTo(LimitedInt other) => this.Value.CompareTo(other.Value);
    #endregion

    #region IConvertible
    public TypeCode GetTypeCode() => this.Value.GetTypeCode();
    bool IConvertible.ToBoolean(IFormatProvider provider) => ((IConvertible)this.Value).ToBoolean(provider);
    byte IConvertible.ToByte(IFormatProvider provider) => ((IConvertible)this.Value).ToByte(provider);
    char IConvertible.ToChar(IFormatProvider provider) => ((IConvertible)this.Value).ToChar(provider);
    DateTime IConvertible.ToDateTime(IFormatProvider provider) => ((IConvertible)this.Value).ToDateTime(provider);
    decimal IConvertible.ToDecimal(IFormatProvider provider) => ((IConvertible)this.Value).ToDecimal(provider);
    double IConvertible.ToDouble(IFormatProvider provider) => ((IConvertible)this.Value).ToDouble(provider);
    short IConvertible.ToInt16(IFormatProvider provider) => ((IConvertible)this.Value).ToInt16(provider);
    int IConvertible.ToInt32(IFormatProvider provider) => ((IConvertible)this.Value).ToInt32(provider);
    long IConvertible.ToInt64(IFormatProvider provider) => ((IConvertible)this.Value).ToInt64(provider);
    sbyte IConvertible.ToSByte(IFormatProvider provider) => ((IConvertible)this.Value).ToSByte(provider);
    float IConvertible.ToSingle(IFormatProvider provider) => ((IConvertible)this.Value).ToSingle(provider);
    string IConvertible.ToString(IFormatProvider provider) => this.Value.ToString(provider);
    object IConvertible.ToType(Type conversionType, IFormatProvider provider) => ((IConvertible)this.Value).ToType(conversionType, provider);
    ushort IConvertible.ToUInt16(IFormatProvider provider) => ((IConvertible)this.Value).ToUInt16(provider);
    uint IConvertible.ToUInt32(IFormatProvider provider) => ((IConvertible)this.Value).ToUInt32(provider);
    ulong IConvertible.ToUInt64(IFormatProvider provider) => ((IConvertible)this.Value).ToUInt64(provider);
    #endregion

    #region IEquatable<LimitedInt>
    public bool Equals(LimitedInt other) => this == other;
    #endregion

    #region IFormattable
    public string ToString(string format, IFormatProvider formatProvider) => this.Value.ToString(format, formatProvider);
    #endregion

    #region operators
    public static bool operator ==(LimitedInt left, LimitedInt right) => left.Value == right.Value;
    public static bool operator !=(LimitedInt left, LimitedInt right) => left.Value != right.Value;
    public static bool operator <(LimitedInt left, LimitedInt right) => left.Value < right.Value;
    public static bool operator >(LimitedInt left, LimitedInt right) => left.Value > right.Value;
    public static bool operator <=(LimitedInt left, LimitedInt right) => left.Value <= right.Value;
    public static bool operator >=(LimitedInt left, LimitedInt right) => left.Value >= right.Value;

    public static LimitedInt operator ++(LimitedInt left) => (LimitedInt)(left.Value + 1);
    public static LimitedInt operator --(LimitedInt left) => (LimitedInt)(left.Value - 1);

    public static LimitedInt operator +(LimitedInt left, LimitedInt right) => (LimitedInt)(left.Value + right.Value);
    public static LimitedInt operator -(LimitedInt left, LimitedInt right) => (LimitedInt)(left.Value - right.Value);
    public static LimitedInt operator *(LimitedInt left, LimitedInt right) => (LimitedInt)(left.Value * right.Value);
    public static LimitedInt operator /(LimitedInt left, LimitedInt right) => (LimitedInt)(left.Value / right.Value);
    public static LimitedInt operator %(LimitedInt left, LimitedInt right) => (LimitedInt)(left.Value % right.Value);

    public static LimitedInt operator &(LimitedInt left, LimitedInt right) => (LimitedInt)(left.Value & right.Value);
    public static LimitedInt operator |(LimitedInt left, LimitedInt right) => (LimitedInt)(left.Value | right.Value);
    public static LimitedInt operator ^(LimitedInt left, LimitedInt right) => (LimitedInt)(left.Value ^ right.Value);
    public static LimitedInt operator ~(LimitedInt left) => (LimitedInt)~left.Value;

    public static LimitedInt operator >>(LimitedInt left, int right) => (LimitedInt)(left.Value >> right);
    public static LimitedInt operator <<(LimitedInt left, int right) => (LimitedInt)(left.Value << right);

    public static implicit operator int(LimitedInt value) => value.Value;
    public static explicit operator LimitedInt(int value)
    {
        if (!IsValidValue(value)) throw new OverflowException();
        return new LimitedInt(value);
    }
    #endregion

    public bool TryFormat(Span<char> destination, out int charsWritten, ReadOnlySpan<char> format = default, IFormatProvider provider = null)
        => this.Value.TryFormat(destination, out charsWritten, format, provider);

    public override int GetHashCode() => this.Value.GetHashCode();
    public override bool Equals(object obj) => obj is LimitedInt l && this.Equals(l);
    public override string ToString() => this.Value.ToString();

    #region static methods
    public static bool TryParse(ReadOnlySpan<char> s, out int result) => int.TryParse(s, out result);
    public static bool TryParse(ReadOnlySpan<char> s, NumberStyles style, IFormatProvider provider, out int result) => int.TryParse(s, style, provider, out result);
    public static int Parse(string s, IFormatProvider provider) => int.Parse(s, provider);
    public static int Parse(string s, NumberStyles style, IFormatProvider provider) => int.Parse(s, style, provider);
    public static bool TryParse(string s, NumberStyles style, IFormatProvider provider, ref int result) => int.TryParse(s, style, provider, out result);
    public static int Parse(string s) => int.Parse(s);
    public static int Parse(string s, NumberStyles style) => int.Parse(s, style);
    public static int Parse(ReadOnlySpan<char> s, NumberStyles style = NumberStyles.Integer, IFormatProvider provider = null) => int.Parse(s, style, provider);
    public static bool TryParse(string s, ref int result) => int.TryParse(s, out result);
    #endregion
}


#include <stdexcept>

class tiny_int
{
public:
  tiny_int(int i):
    value(i)
  {
    if (value < 1)
      throw std::out_of_range("tiny_int: value smaller than 1");
    if (value > 10)
      throw std::out_of_range("tiny_int: value larger than 10");
  }
  operator int() const
  {
    return value;
  }
  tiny_int& operator+=(int i)
  {
    // by assigning to *this instead of directly modifying value, the
    // constructor is called and thus the check is enforced
    *this = value + i;
    return *this;
  }
  tiny_int& operator-=(int i)
  {
    *this = value - i;
    return *this;
  }
  tiny_int& operator*=(int i)
  {
    *this = value * i;
    return *this;
  }
  tiny_int& operator/=(int i)
  {
    *this = value / i;
    return *this;
  }
  tiny_int& operator<<=(int i)
  {
    *this = value << i;
    return *this;
  }
  tiny_int& operator>>=(int i)
  {
    *this = value >> i;
    return *this;
  }
  tiny_int& operator&=(int i)
  {
    *this = value & i;
    return *this;
  }
  tiny_int& operator|=(int i)
  {
    *this = value | i;
    return *this;
  }
private:
  unsigned char value; // we don't need more space
};


(defn tinyint [^long value]
  (if (<= 1 value 10)
    (proxy [Number] []
      (doubleValue [] value)
      (longValue [] value))
    (throw (ArithmeticException. "integer overflow"))))


(deftype one-to-ten ()
  '(integer 1 10))


import std.exception, std.string, std.traits;

/++
A bounded integral type template.
Template params:
- min: the minimal value
- max: the maximal value
- I: the type used to store the value internally
+/
struct BoundedInt(alias min, alias max, I = int)
{
    // Static checks
    static assert(isIntegral!(typeof(min)));
    static assert(isIntegral!(typeof(max)));
    static assert(isIntegral!I);
    static assert(min < max);
    static assert(cast(I) max == max, "Type " ~ I.stringof
        ~ " cannot hold values up to " ~ max.stringof);

    /// The actual value stored in this struct
    private I _value;

    /// Getter for the internal value
    @property I internalValue()
    {
        return _value;
    }

    /// 'alias this' to make this struct look like a built-in integer
    alias internalValue this;

    /// Constructor
    this(T)(T value)
    {
        opAssign(value);
    }

    /// Assignment operator
    void opAssign(T)(T value)
        if (isIntegral!T)
    {
        _value = checked(value);
    }

    /// Unary operators
    auto opUnary(string op)() const
    {
        return checked(mixin(op ~ "_value"));
    }

    /// Binary operators
    auto opBinary(string op, T)(T other) const
    {
        return checked(mixin("_value" ~ op ~ "other"));
    }

    /// ditto
    auto opBinaryRight(string op, T)(T other) const
        if (isIntegral!T)
    {
        return checked(mixin("_value" ~ op ~ "other"));
    }

    // Bounds enforcement
    private I checked(T)(T value) const
    {
        enforce(value >= min && value <= max,
            format("Value %s is out of bounds (%s to %s).", value, min, max));
        return cast(I) value;
    }
}

unittest
{
    alias MyInt = BoundedInt!(1, 10);
    // alias BoundInt!(1, 10) MyInt; // D < 2.061

    MyInt i = 4;
    MyInt j = i + i;
    assert(j / 2 == 4);
    assert(2 + j == 10);
    assert(i < 5);
    assert(j > i);
}


type TinyInt(Integer value) {
    throw @Overflow(value) when value is <1 or >10
} with Lookup, Show

func TinyInt as Integer => this.value

func TinyInt + (other) => TinyInt(this.value + other as Integer)

func TinyInt * (other) => TinyInt(this.value * other as Integer)

func TinyInt - (other) => TinyInt(this.value - other as Integer)

func TinyInt / (other) => TinyInt(this.value / other as Integer)


def MyNumber := 1..10

for i :MyNumber in [0, 5, 10, 15, 20, 25] {
    println(i)
}


(require 'types)
(require 'math)

;; type defined by a predicate
(define (one-ten? x) (in-interval? x 1 10))
(type One-ten [Integer & one-ten?])

;; OR by an enumeration
(type One-ten [ 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 ])

;; EXPLICIT type checking
;; type-of? returns a Boolean

(type-of? 5 One-ten) → #t
(type-of? 'Albert One-ten) → #f

;; type-check raises an error
(type-check 6 One-ten)  → #t
(type-check 88 One-ten)
⛔ error: One-ten : type-check failure : 88 → 'one-ten?'

;; IMPLICIT type checking
;; declare a function signature
(define (f10 x y) (+ x y))
(signature f10 One-ten -> One-ten -> Integer)

(f10 6 7) → 13
(f10 42 666)
❗ error: One-ten : type-check failure : 42 → 'f10:x'


import extensions;

sealed struct TinyInt : BaseNumber
{
    int value;

    int cast() = value;

    constructor(int n)
    {
        if (n <= 1 || n >= 10)
        {
            InvalidArgumentException.raise()
        };

        value := n
    }

    cast t(string s)
    {
        value := s.toInt();

        if (value <= 1 || value >= 10)
        {
            InvalidArgumentException.raise()
        }
    }

    TinyInt add(TinyInt t)
        = value + (cast int(t));

    TinyInt subtract(TinyInt t)
        = value - (cast int(t));

    TinyInt multiply(TinyInt t)
        = value * (cast int(t));

    TinyInt divide(TinyInt t)
        = value / (cast int(t));

    bool equal(TinyInt t)
       = value == (cast int(t));

    bool less(TinyInt t)
       = value == (cast int(t));
}

public program()
{
    TinyInt i := 4t;
    TinyInt j := i + i;

    try
    {
      i + j
    }
    catch(InvalidArgumentException e)
    {
        console.printLine("A value is out of range")
    }
}


type My_Type(integer i)
    return i >= 1 and i <= 10
end type


PREDICATE: my-int < integer [ 0 > ] [ 11 < ] bi and ;


DECIMAL
: CLIP  ( n lo hi -- n') ROT MIN MAX ;
: BETWEEN  ( n lo hi -- flag) 1+ WITHIN ;

\ programmer chooses CLIPPED or SAFE integer assignment
: CLIP! ( n addr -- ) SWAP 1 10 CLIP SWAP  ! ;
: SAFE!   ( n addr -- )
          OVER 1 10 BETWEEN 0= ABORT" out of range!"
          ! ;


module Bounded
  implicit none

  type BoundedInteger
     integer, private :: v         ! we cannot allow direct access to this, or we
     integer, private :: from, to  !   can't check the bounds!
     logical, private :: critical
  end type BoundedInteger

  interface assignment(=)
     module procedure bounded_assign_bb, bounded_assign_bi !, &
                    ! bounded_assign_ib
  end interface

  interface operator(+)
     module procedure bounded_add_bbb !, bounded_add_bbi, &
                    ! bounded_add_bib, bounded_add_ibb,   &
                    ! bounded_add_iib, bounded_add_ibi,   &
                    ! bounded_add_bii
  end interface

  private :: bounded_assign_bb, bounded_assign_bi, &
             bounded_add_bbb

contains

  subroutine set_bound(bi, lower, upper, critical, value)
    type(BoundedInteger), intent(out) :: bi
    integer, intent(in) :: lower, upper
    integer, intent(in), optional :: value
    logical, intent(in), optional :: critical

    bi%from = min(lower, upper)
    bi%to = max(lower, upper)
    if ( present(critical) ) then
       bi%critical = critical
    else
       bi%critical = .false.
    end if
    if ( present(value) ) then
       bi = value
    end if
  end subroutine set_bound

  subroutine bounded_assign_bb(a, b)
    type(BoundedInteger), intent(out) :: a
    type(BoundedInteger), intent(in)  :: b

    call bounded_assign_bi(a, b%v)

  end subroutine bounded_assign_bb

  subroutine bounded_assign_bi(a, b)
    type(BoundedInteger), intent(out) :: a
    integer,              intent(in)  :: b

    if ( (a%from <= b) .and. (a%to >= b) ) then
       a%v = b
    else
       write(0,*) "BoundedInteger: out of bound assignment"
       if ( a%critical ) then
          stop
       else
          if ( b < a%from ) then
             a%v = a%from
          else
             a%v = a%to
          end if
          write(0,"(A,' (',I0, ')')") "BoundedInteger: set to nearest bound", a%v
       end if
    end if
  end subroutine bounded_assign_bi

  function bounded_add_bbb(a, b) result(c)
    type(BoundedInteger) :: c
    type(BoundedInteger), intent(in) :: a, b

    integer :: t

    c%from = max(a%from, b%from)
    c%to   = min(a%to,   b%to)
    t = a%v + b%v
    if ( c%from <= t .and. c%to >= t ) then
       c%v = t
    else
       write(0,*) "BoundedInteger: out of bound sum"
       if ( a%critical .or. b%critical ) then
          stop
       else
          if ( t < c%from ) then
             c%v = c%from
          else
             c%v = c%to
          end if
          write(0,"(A,' (',I0,')')") "BoundedInteger: set to nearest bound", c%v
       end if
    end if
  end function bounded_add_bbb

end module Bounded


type
	range = 1..10;
var
	n: range;
begin
	n := 10;
	{$rangeChecks on}
	n := n + 10; // will yield a run-time error
end;


' FB 1.05.0 Win64

Type MyInteger
  Private:
    Dim i_ As Integer
  Public:
    Declare Constructor(i_ As Integer)
    Declare Property I() As Integer
    Declare Operator Cast() As Integer
    Declare Operator Cast() As String
End Type

Constructor MyInteger(i_ As Integer)
  If i_ < 1 Then
    i_ = 1
  ElseIf i_ > 10 Then
    i_ = 10
  End If
  This.i_ = i_
End Constructor

Property MyInteger.I() As Integer
  Return i_
End Property

Operator MyInteger.Cast() As Integer
  Return i_
End Operator

Operator MyInteger.Cast() As String
  Return Str(i_)
End Operator

Dim i As MyInteger = 11 ' implicit constructor call;  i_ automatically limited to 10
Dim j As MyInteger = 3  ' implicit constructor call;  no adjustment needed
Dim k As Integer = 4
Print "i = "; i; "   j = " ; j; "   k = "; k; "   j + 6 ="; j.I + 6; "   j + k ="; j + k
Print
Print "Press any key to quit"
Sleep


LDA $00  ;read the byte at memory address $00
STA $20  ;store it at memory address $20


oneToTen[x] := isInteger[x] AND x >= 1 AND x <= 10

var y is oneToTen = 1

while (true)
{
   println[y]
   y = y + 1
}


package main

import "fmt"

type TinyInt int

func NewTinyInt(i int) TinyInt {
    if i < 1 {
        i = 1
    } else if i > 10 {
        i = 10
    }
    return TinyInt(i)
}

func (t1 TinyInt) Add(t2 TinyInt) TinyInt {
    return NewTinyInt(int(t1) + int(t2))
}

func (t1 TinyInt) Sub(t2 TinyInt) TinyInt {
    return NewTinyInt(int(t1) - int(t2))
}

func (t1 TinyInt) Mul(t2 TinyInt) TinyInt {
    return NewTinyInt(int(t1) * int(t2))
}

func (t1 TinyInt) Div(t2 TinyInt) TinyInt {
    return NewTinyInt(int(t1) / int(t2))
}

func (t1 TinyInt) Rem(t2 TinyInt) TinyInt {
    return NewTinyInt(int(t1) % int(t2))
}

func (t TinyInt) Inc() TinyInt {
    return t.Add(TinyInt(1))
}

func (t TinyInt) Dec() TinyInt {
    return t.Sub(TinyInt(1))
}

func main() {
    t1 := NewTinyInt(6)
    t2 := NewTinyInt(3)
    fmt.Println("t1      =", t1)
    fmt.Println("t2      =", t2)
    fmt.Println("t1 + t2 =", t1.Add(t2))
    fmt.Println("t1 - t2 =", t1.Sub(t2))
    fmt.Println("t1 * t2 =", t1.Mul(t2))
    fmt.Println("t1 / t2 =", t1.Div(t2))
    fmt.Println("t1 % t2 =", t1.Rem(t2))
    fmt.Println("t1 + 1  =", t1.Inc())
    fmt.Println("t1 - 1  =", t1.Dec())
}


list L1, L2;

# Lists are heterogeneous:
l_append(L1, 3);
l_append(L1, "deep");

# and may contain self references.
# A self references in the last position:
l_link(L1, -1, L1);

# List may also contain mutual references.
# Create a new list in the last position:
l_n_list(L1, -1);
# Add a reference to the top level list to the nested list:
l_link(l_q_list(L1, -1), -1, L1);

# There are no limitations to the deep copy method:
l_copy(L2, L1);

# Modify the string in the original list,
# via the self reference in the 3rd position
l_r_text(l_q_list(L1, 2), 1, "copy");

# Show the string in the two lists:
o_text(l_query(L2, 1));
o_text(l_query(L1, 1));
o_byte('\n');

# And again, via the included self references:
o_text(l_query(l_query(L2, 2), 1));
o_text(l_query(l_query(L1, 2), 1));
o_byte('\n');


x: #[
    name: "John"
    surname: "Doe"
    age: 34
    hobbies: [
        "Cycling",
        "History",
        "Programming",
        "Languages",
        "Psychology",
        "Buddhism"
    ]
    sayHello: function [][
        print "Hello there!"
    ]
]

print ["Name of first person:" x\name]

y: new x
y\name: "Jane"

print ["Name of first person:" x\name]
print ["Name of second person:" y\name]


DeepCopy(Array, Objs=0)
{
    If !Objs
        Objs := Object()
    Obj := Array.Clone() ; produces a shallow copy in that any sub-objects are not cloned
    Objs[&Array] := Obj ; Save this new array - & returns the address of Array in memory
    For Key, Val in Obj
        If (IsObject(Val)) ; If it is a subarray
            Obj[Key] := Objs[&Val] ; If we already know of a reference to this array
            ? Objs[&Val] ; Then point it to the new array (to prevent infinite recursion on self-references
            : DeepCopy(Val,Objs) ; Otherwise, clone this sub-array
    Return Obj
}


BEGIN {
    for (elem in original)
        copied[elem] = original[elem]
}


{-# OPTIONS -fglasgow-exts #-}

data Check a b = Check { unCheck :: b } deriving (Eq, Ord)

class Checked a b where
  check :: b -> Check a b

lift  f x = f (unCheck x)
liftc f x = check $ f (unCheck x)

lift2  f x y = f (unCheck x) (unCheck y)
lift2c f x y = check $ f (unCheck x) (unCheck y)
lift2p f x y = (check u, check v) where (u,v) = f (unCheck x) (unCheck y)

instance Show b => Show (Check a b) where
  show (Check x)        = show x
  showsPrec p (Check x) = showsPrec p x

instance (Enum b, Checked a b) => Enum (Check a b) where
  succ = liftc succ
  pred = liftc pred
  toEnum   = check . toEnum
  fromEnum = lift fromEnum

instance (Num b, Checked a b) => Num (Check a b) where
  (+) = lift2c (+)
  (-) = lift2c (-)
  (*) = lift2c (*)
 negate = liftc negate
  abs    = liftc abs
   signum = liftc signum
  fromInteger = check . fromInteger

instance (Real b, Checked a b) => Real (Check a b) where
  toRational = lift toRational

instance (Integral b, Checked a b) => Integral (Check a b) where
  quot = lift2c quot
  rem  = lift2c rem
  div  = lift2c div
  mod  = lift2c mod
  quotRem = lift2p quotRem
  divMod  = lift2p divMod
  toInteger = lift toInteger


#include<stdio.h>

typedef struct{
	int a;
}layer1;

typedef struct{
	layer1 l1;
	float b,c;
}layer2;

typedef struct{
	layer2 l2;
	layer1 l1;
	int d,e;
}layer3;

void showCake(layer3 cake){
	printf("\ncake.d = %d",cake.d);
	printf("\ncake.e = %d",cake.e);
	printf("\ncake.l1.a = %d",cake.l1.a);
	printf("\ncake.l2.b = %f",cake.l2.b);
	printf("\ncake.l2.l1.a = %d",cake.l2.l1.a);
}

int main()
{
	layer3 cake1,cake2;

	cake1.d = 1;
	cake1.e = 2;
	cake1.l1.a = 3;
	cake1.l2.b = 4;
	cake1.l2.l1.a = 5;

	printf("Cake 1 is : ");
	showCake(cake1);

	cake2 = cake1;

	cake2.l2.b += cake2.l2.l1.a;

	printf("\nCake 2 is : ");
	showCake(cake2);

	return 0;
}


using System;

namespace prog
{
	class MainClass
	{
		class MyClass : ICloneable
		{
			public MyClass() { f = new int[3]{2,3,5}; c = '1'; }

			public object Clone()
			{
				MyClass cpy = (MyClass) this.MemberwiseClone();
				cpy.f = (int[]) this.f.Clone();
				return cpy;
			}

			public char c;
			public int[] f;
		}

		public static void Main( string[] args )
		{
			MyClass c1 = new MyClass();
			MyClass c2 = (MyClass) c1.Clone();
		}
	}
}


NB. z locale by default on path.
type_z_=: 3!:0
nameClass_z_=: 4!:0
signalError_z_=: 13!:8

NB. create a restricted object from an appropriate integer
create_restrict_ =: monad define
 'Domain error: expected integer' assert 1 4 e.~ type y  NB. or Boolean
 'Domain error: not on [1,10]' assert (0 [email protected]:e. [: , (0&<*.<&11)) y
 value=: y
)

add_restrict_=: monad define
 if. 0 = nameClass<'value__y' do.
  (value + value__y) conew 0{::coname''
 else.
  'value unavailable'signalError 21
 end.
)


class BoundedIntOutOfBoundsException extends Exception
{
  public BoundedIntOutOfBoundsException(int v, int l, int u) {
    super("value " + v + " is out of bounds [" + l + "," + u + "]");
  }
}

class BoundedInt {
  private int value;
  private int lower;
  private int upper;

  public BoundedInt(int l, int u) {
    lower = Math.min(l, u);
    upper = Math.max(l, u);
  }

  private boolean checkBounds(int v) {
    return (v >= this.lower) && (v <= this.upper);
  }

  public void assign(BoundedInt i) throws BoundedIntOutOfBoundsException {{
    assign(i.value()); //could still throw Exception if the other BoundedInt has different bounds
  }

  public void assign(int v) throws BoundedIntOutOfBoundsException {
    if ( checkBounds(v) ) {
      this.value = v;
    } else {
      throw new BoundedIntOutOfBoundsException(v, this.lower, this.upper);
    }
  }

  public int add(BoundedInt i) throws BoundedIntOutOfBoundsException {
    return add(i.value());
  }

  public int add(int i) throws BoundedIntOutOfBoundsException {
    if ( checkBounds(this.value + i) ) {
      this.value += i;
    }  else {
      throw new BoundedIntOutOfBoundsException(this.value + i, this.lower, this.upper);
    }
    return this.value;
  }

  public int value() {
    return this.value;
  }
}

public class Bounded {
  public static void main(String[] args) throws BoundedIntOutOfBoundsException {
    BoundedInt a = new BoundedInt(1, 10);
    BoundedInt b = new BoundedInt(1, 10);

    a.assign(6);
    try {
      b.assign(12);
    } catch (Exception e) {
      System.out.println(e.getMessage());
    }
    b.assign(9);
    try {
      a.add(b.value());
    } catch (Exception e) {
      System.out.println(e.getMessage());
    }
  }
}


#include <array>
#include <iostream>
#include <list>
#include <map>
#include <vector>

int main()
{
    // make a nested structure to copy - a map of arrays containing vectors of strings
    auto myNumbers = std::vector<std::string>{"one", "two", "three", "four"};
    auto myColors = std::vector<std::string>{"red", "green", "blue"};
    auto myArray = std::array<std::vector<std::string>, 2>{myNumbers, myColors};
    auto myMap = std::map<int, decltype(myArray)> {{3, myArray}, {7, myArray}};

    // make a deep copy of the map
    auto mapCopy = myMap;

    // modify the copy
    mapCopy[3][0][1] = "2";
    mapCopy[7][1][2] = "purple";

    std::cout << "the original values:\n";
    std::cout << myMap[3][0][1] << "\n";
    std::cout << myMap[7][1][2] << "\n\n";

    std::cout << "the modified copy:\n";
    std::cout << mapCopy[3][0][1] << "\n";
    std::cout << mapCopy[7][1][2] << "\n";
}


$ clisp -q
[1]> (setf *print-circle* t)
T
[2]> (let ((a (cons 1 nil))) (setf (cdr a) a)) ;; create circular list
#1=(1 . #1#)
[3]> (read-from-string "#1=(1 . #1#)") ;; read it from a string
#1=(1 . #1#) ;; a similar circular list is returned


function Num(n){
    n = Math.floor(n);
    if(isNaN(n))
        throw new TypeError("Not a Number");
    if(n < 1 || n > 10)
        throw new TypeError("Out of range");
    this._value = n;
}
Num.prototype.valueOf = function() { return this._value; }
Num.prototype.toString = function () { return this._value.toString();}

var w = new Num(3), x = new Num(4);

WScript.Echo(w + x); //7
WScript.Echo(x - w); //1
WScript.Echo(w * x); //12
WScript.Echo(w / x); //0.75
WScript.Echo(w < x); //true
WScript.Echo(x < w); //false

var y = new Num(0); //TypeError
var z = new Num(11); //TypeError


def typeof:
  if type == "object" and has("type") then .type else type end;


local :(copy-action) {}

(copy-action)!list obj cache:
	local :new []
	set-to cache obj new
	for i range 0 -- len obj:
		push-to new (deepcopy) @obj! i cache
	return new

(copy-action)!dict obj cache:
	local :new {}
	set-to cache obj new
	for key in keys obj:
		set-to new (deepcopy) @key cache (deepcopy) @obj! @key cache
	return new

labda obj cache:
	set-to cache @obj dup copy @obj
set-default (copy-action)

(deepcopy) obj cache:
	if has cache obj:
		return @cache! @obj
	(copy-action)! type @obj @obj cache

deepcopy obj:
	(deepcopy) obj {}

#example usage:
#a reasonably complicated object:
set :A { :foo [ "bar" ] [] [ & 1 2 & 3 4 ] }
set :B deepcopy A

!. A
!. B

push-to get-from B :foo "HODOR"

!. A
!. B

#it works with cycles:
set :C push-through dup []
set :D deepcopy C

!. C
!. D

push-to C 7

!. C
!. D


program DeepCopyApp;

{$APPTYPE CONSOLE}

uses
  System.TypInfo;

type
  TTypeA = record
    value1: integer;
    value2: char;
    value3: string[10];
    value4: Boolean;
    function DeepCopy: TTypeA;
  end;

{ TTypeA }

function TTypeA.DeepCopy: TTypeA;
begin
  CopyRecord(@result, @self, TypeInfo(TTypeA));
end;

var
  a, b: TTypeA;

begin
  a.value1 := 10;
  a.value2 := 'A';
  a.value3 := 'OK';
  a.value4 := True;

  b := a.DeepCopy;
  a.value1 := 20;
  a.value2 := 'B';
  a.value3 := 'NOK';
  a.value4 := False;

  Writeln('Value of "a":');
  Writeln(a.value1);
  Writeln(a.value2);
  Writeln(a.value3);
  Writeln(a.value4);

  Writeln(#10'Value of "b":');
  Writeln(b.value1);
  Writeln(b.value2);
  Writeln(b.value3);
  Writeln(b.value4);
  readln;
end.


def deSubgraphKit := <elib:serial.deSubgraphKit>
def deepcopy(x) {
  return deSubgraphKit.recognize(x, deSubgraphKit.makeBuilder())
}


struct LittleInt <: Integer
    val::Int8
    function LittleInt(n::Real)
        1 ≤ n ≤ 10 || throw(ArgumentError("LittleInt number must be in [1, 10]"))
        return new(Int8(n))
    end
end
Base.show(io::IO, x::LittleInt) = print(io, x.val)
Base.convert(::Type{T}, x::LittleInt) where T<:Number = convert(T, x.val)
Base.promote_rule(::Type{LittleInt}, ::Type{T}) where T<:Number = T

for op in (:+, :*, :÷, :-, :&, :|, :$, :<, :>, :(==))
    @eval (Base.$op)(a::LittleInt, b::LittleInt) = LittleInt(($op)(a.val, b.val))
end

# Test
a = LittleInt(3)
b = LittleInt(4.0)
@show a b
@show a + b
@show b - a
@show a * LittleInt(2)
@show b ÷ LittleInt(2)
@show a * b


// version 1.1

class TinyInt(i: Int) {
    private val value = makeTiny(i)

    operator fun plus (other: TinyInt): TinyInt = TinyInt(this.value + other.value)
    operator fun minus(other: TinyInt): TinyInt = TinyInt(this.value - other.value)
    operator fun times(other: TinyInt): TinyInt = TinyInt(this.value * other.value)
    operator fun div  (other: TinyInt): TinyInt = TinyInt(this.value / other.value)
    operator fun rem  (other: TinyInt): TinyInt = TinyInt(this.value % other.value)

    operator fun inc()  = TinyInt(this.value + 1)
    operator fun dec()  = TinyInt(this.value - 1)

    private fun makeTiny(i: Int): Int =
        when {
            i < 1  -> 1
            i > 10 -> 10
            else   -> i
        }

    override fun toString(): String = value.toString()
}

fun main(args: Array<String>) {
    var t1 = TinyInt(6)
    var t2 = TinyInt(3)
    println("t1      = $t1")
    println("t2      = $t2")
    println("t1 + t2 = ${t1 + t2}")
    println("t1 - t2 = ${t1 - t2}")
    println("t1 * t2 = ${t1 * t2}")
    println("t1 / t2 = ${t1 / t2}")
    println("t1 % t2 = ${t1 % t2}")
    println("t1 + 1  = ${++t1}")
    println("t2 - 1  = ${--t2}")
}


1> A = <<"abcdefghijklmnopqrstuvwxyz">>.
<<"abcdefghijklmnopqrstuvwxyz">>
2> B = <<A/binary, A/binary, A/binary, A/binary>>.
<<"abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz">>
3> <<_:10/binary, C:80/binary, _/binary>> = B.
<<"abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz">>
4> C.
<<"klmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijkl">>
5> byte_size(C).
80
6> binary:referenced_byte_size(C).
104
7> C2 = binary:copy(C).
<<"klmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijkl">>
8> C2 == C.
true
9> binary:referenced_byte_size(C2).
80


USING: accessors arrays io kernel named-tuples prettyprint
sequences sequences.deep ;

! Define a simple class
TUPLE: foo bar baz ;

! Allow instances of foo to be modified like an array
INSTANCE: foo named-tuple

! Create a foo object composed of mutable objects
V{ 1 2 3 } V{ 4 5 6 } [ clone ] [email protected] foo boa

! create a copy of the reference to the object
dup

! create a deep copy from this copy
>array [ clone ] deep-map T{ foo } like

! print them both
"Before modification:" print [ [ . ] [email protected] ] 2keep nl

! modify the deep copy
[ -1 suffix! ] change-bar

! print them both again
"After modification:" print [ . ] [email protected]


Type DeepCopy
    value1 As Integer
    value2 As String * 1
    value3 As String
    value4 As Boolean
    value5 As Double
End Type
Dim As DeepCopy a, b

a.value1 = 10
a.value2 = "A"
a.value3 = "OK"
a.value4 = True
a.value5 = 1.985766472453666

b = a
a.value1 = 20
a.value2 = "B"
a.value3 = "NOK"
a.value4 = False
a.value5 = 3.148556644245367

Print !"Valor de \"a\":"
Print a.value1
Print a.value2
Print a.value3
Print a.value4
Print a.value5

Print !"\nValor \"b\":"
With b
    Print .value1
    Print .value2
    Print .value3
    Print .value4
    Print .value5
End With
Sleep


package main

import "fmt"

// a complex data structure
type cds struct {
    i int            // no special handling needed for deep copy
    s string         // no special handling
    b []byte         // copied easily with append function
    m map[int]bool   // deep copy requires looping
}

// a method
func (c cds) deepcopy() *cds {
    // copy what you can in one line
    r := &cds{c.i, c.s, append([]byte{}, c.b...), make(map[int]bool)}
    // populate map with a loop
    for k, v := range c.m {
        r.m[k] = v
    }
    return r
}

// demo
func main() {
    // create and populate a structure
    c1 := &cds{1, "one", []byte("unit"), map[int]bool{1: true}}
    fmt.Println(c1)      // show it
    c2 := c1.deepcopy()  // copy it
    fmt.Println(c2)      // show copy
    c1.i = 0             // change original
    c1.s = "nil"
    copy(c1.b, "zero")
    c1.m[1] = false
    fmt.Println(c1)      // show changes
    fmt.Println(c2)      // show copy unaffected
}


define dint => type {
   data private value

   public oncreate(value::integer) => {
	fail_if(#value < 1,#value+' less than 1 ')
	fail_if(#value > 10,#value+' greater than 10')
	.value = #value
   }

   public +(rhs::integer) => dint(.value + #rhs)
   public -(rhs::integer) => dint(.value - #rhs)
   public *(rhs::integer) => dint(.value * #rhs)
   public /(rhs::integer) => dint(.value / #rhs)
   public %(rhs::integer) => dint(.value % #rhs)

   public asstring() => string(.value)

}

dint(1) // 1
dint(10) // 10

dint(0) // Error: 0 less than 1
dint(2) - 5 // Error: -3 less than 1

dint(11) // Error: 11 greater than 10
dint(10) + 1 // Error: 11 greater than 10
dint(10) * 2 // Error: 20 greater than 10


BI = { -- Bounded Integer
  new = function(self, v) return setmetatable({v = self:_limit(v)}, BI_mt) end,
  _limit = function(self,v) return math.max(1, math.min(math.floor(v), 10)) end,
}
BI_mt = {
  __index = BI,
  __call = function(self,v) return self:new(v) end,
  __unm = function(self) return BI(-self.v) end,
  __add = function(self,other) return BI(self.v+other.v) end,
  __sub = function(self,other) return BI(self.v-other.v) end,
  __mul = function(self,other) return BI(self.v*other.v) end,
  __div = function(self,other) return BI(self.v/other.v) end,
  __mod = function(self,other) return BI(self.v%other.v) end,
  __pow = function(self,other) return BI(self.v^other.v) end,
  __eq = function(self,other) return self.v==other.v end,
  __lt = function(self,other) return self.v<other.v end,
  __le = function(self,other) return self.v<=other.v end,
  __tostring = function(self) return tostring(self.v) end
}
setmetatable(BI, BI_mt)


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


   a=:b=: 2 2 2 2 2  NB. two copies of the same array
   b=: 3 (2)} b  NB. modify one of the arrays
   b
2 2 3 2 2
   a
2 2 2 2 2