/* A simple point object */

p = let r = {x = ref 0, y = ref 0} in
        { getx = (lambda _:Unit. !r.x),
          gety = (lambda _:Unit. !r.y),
          set = (lambda xn:Nat.(lambda yn:Nat. (r.x := xn; r.y := yn))) };

p.getx unit;
p.gety unit;
p.set 1 2; 
p.getx unit;
p.gety unit;


/* Typing the behavior of points. */

Point = {getx: Unit -> Nat, gety : Unit -> Nat, set : Nat -> Nat -> Unit};

p as Point;

/* An operation on Points. */

move = (lambda p:Point. p.set(succ(p.getx unit)) (succ(p.gety unit)));

move p;
p.getx unit;
p.gety unit;

/* A generator for point objects. */

newPoint =
   lambda _:Unit. 
    let r = {x = ref 0, y = ref 0} in
        { getx = (lambda _:Unit. !r.x),
          gety = (lambda _:Unit. !r.y),
          set = (lambda xn:Nat.(lambda yn:Nat. (r.x := xn; r.y := yn))) };

p = newPoint unit;
p.getx unit;
p.gety unit;
p.set 1 2; 
p.getx unit;
p.gety unit;

move p;
p.getx unit;
p.gety unit;

/* Subtyping. */

Color = <red:Unit, green:Unit, blue:Unit>;

ColorPoint = {getx: Unit -> Nat, gety : Unit -> Nat, getc : Unit -> Color, 
              set : Nat -> Nat -> Unit};

newColorPoint =
   lambda _:Unit. 
    let r = {x = ref 0, y = ref 0, c = ref (<red=unit> as Color)} in
        { getx = (lambda _:Unit. !r.x),
          gety = (lambda _:Unit. !r.y),
          getc = (lambda _:Unit. !r.c),
          set = (lambda xn:Nat.lambda yn:Nat. (r.x := xn; r.y := yn; 
                                               r.c := (<blue=unit> as Color))) };

p = newColorPoint unit;
p as ColorPoint;
p as Point;
p.set 1 2;
move p;
p.getx unit;
p.gety unit;
p.getc unit;

/* Separating out representation. */

PointRep = {x: Ref Nat, y: Ref Nat};

pointClass =
  lambda r:PointRep.
        { getx = (lambda _:Unit. !r.x),
          gety = (lambda _:Unit. !r.y),
          set = (lambda xn:Nat.(lambda yn:Nat. (r.x := xn; r.y := yn))) };


newPoint = 
  lambda _:Unit. let r = {x = ref 0, y = ref 0} in
                     pointClass r;

p = newPoint unit;
p.getx unit;
p.gety unit;
move p;
p.getx unit;
p.gety unit;

/* Sub-classing */

ColorPointRep = {x: Ref Nat, y: Ref Nat, c: Ref Color};

colorPointClass = 
  lambda r:ColorPointRep.
      let super = pointClass r in
        { getx = super.getx,
          gety = super.gety,
          getc = (lambda _:Unit. !r.c),
          set = (lambda xn:Nat.lambda yn:Nat.(super.set xn yn; 
                                              r.c := (<blue=unit> as Color))) };

newColorPoint =
  lambda _:Unit. let r = {x = ref 0, y = ref 0, c = ref (<red=unit> as Color)} in
                   colorPointClass r;

p = newColorPoint unit;
p.getx unit;
p.gety unit;
p.getc unit;
move p;
p.getx unit;
p.gety unit;
p.getc unit;


/* Classes with 'self' */

MovablePoint = {getx: Unit -> Nat, gety : Unit -> Nat, 
                set : Nat -> Nat -> Unit, move: Unit -> Unit };

movablePointClass =
  lambda r:PointRep.
      fix 
        (lambda self : MovablePoint.
           { getx = (lambda _:Unit. !r.x),
             gety = (lambda _:Unit. !r.y),
             set = (lambda xn:Nat.(lambda yn:Nat. (r.x := xn; r.y := yn))),
             move = (lambda _:Unit. self.set(succ(self.getx unit)) 
                                            (succ(self.gety unit))) });

newMovablePoint =
  lambda _:Unit. let r = {x = ref 0, y = ref 0} in
                     movablePointClass r;


p = newMovablePoint unit;
p.getx unit;
p.gety unit;
p.move unit;
p.getx unit;
p.gety unit;


/* Sub-classing doesn't quite work as we'd like. */

ColorMovablePoint = {getx: Unit -> Nat, gety : Unit -> Nat, getc: Unit -> Color, 
                     set : Nat -> Nat -> Unit, move: Unit -> Unit };

colorMovablePointClass = 
  lambda r:ColorPointRep.
       fix
        (lambda self: ColorMovablePoint. 
           let super = movablePointClass r in
             { getx = super.getx,
               gety = super.gety,
               getc = (lambda _:Unit. !r.c),
               set = (lambda xn:Nat.lambda yn:Nat. (super.set xn yn; 
                                                    r.c := (<blue=unit> as Color))),
               move = super.move });

newColorMovablePoint =
  lambda _:Unit. let r = {x = ref 0, y = ref 0, c = ref (<red=unit> as Color)} in
                   colorMovablePointClass r;

p = newColorMovablePoint unit;
p.getx unit;
p.gety unit;
p.getc unit;
p.move unit;  /* doesn't change color */
p.getx unit;
p.gety unit;
p.getc unit;

/* Open Recursion */

movablePointClass =
  lambda r:PointRep.
        lambda self : MovablePoint.
           { getx = (lambda _:Unit. !r.x),
             gety = (lambda _:Unit. !r.y),
             set = (lambda xn:Nat.(lambda yn:Nat. (r.x := xn; r.y := yn))),
             move = (lambda _:Unit. self.set(succ(self.getx unit)) 
                                            (succ(self.gety unit))) };

newMovablePoint =
  lambda _:Unit. let r = {x = ref 0, y = ref 0} in
                     fix (movablePointClass r);


p = newMovablePoint unit;
p.getx unit;
p.gety unit;
p.move unit;  
p.getx unit;
p.gety unit;


/* Open recursion with subtyping. Still not quite right.  */

colorMovablePointClass = 
  lambda r:ColorPointRep.
      lambda self: ColorMovablePoint. 
           let super = movablePointClass r self in
             { getx = super.getx,
               gety = super.gety,
               getc = (lambda _:Unit. !r.c),
               set = (lambda xn:Nat.lambda yn:Nat. (super.set xn yn; 
                                                    r.c := (<blue=unit> as Color))),
               move = super.move };

newColorMovablePoint =
  lambda _:Unit. let r = {x = ref 0, y = ref 0, c = ref (<red=unit> as Color)} in
                   fix (colorMovablePointClass r);

/*
p = newColorMovablePoint unit;  /* doesn't terminate */
*/

/* Introducing thunks. */

movablePointClass =
  lambda r:PointRep.
      lambda self : (Unit -> MovablePoint).
          lambda _:Unit.
           { getx = (lambda _:Unit. !r.x),
             gety = (lambda _:Unit. !r.y),
             set = (lambda xn:Nat.(lambda yn:Nat. (r.x := xn; r.y := yn))),
             move = (lambda _:Unit. (self unit).set(succ((self unit).getx unit)) 
                                                   (succ((self unit).gety unit))) };

newMovablePoint =
  lambda _:Unit. let r = {x = ref 0, y = ref 0} in
                     fix (movablePointClass r) unit;

p = newMovablePoint unit;
p.getx unit;
p.gety unit;
p.move unit;  
p.getx unit;
p.gety unit;


colorMovablePointClass = 
  lambda r:ColorPointRep.
      lambda self: Unit->ColorMovablePoint. 
        lambda _:Unit.
           let super = movablePointClass r self unit in
             { getx = super.getx,
               gety = super.gety,
               getc = (lambda _:Unit. !r.c),
               set = (lambda xn:Nat.lambda yn:Nat. (super.set xn yn; 
                                                    r.c := (<blue=unit> as Color))),
               move = super.move };

newColorMovablePoint =
  lambda _:Unit. let r = {x = ref 0, y = ref 0, c = ref (<red=unit> as Color)} in
                   fix (colorMovablePointClass r) unit;

p = newColorMovablePoint unit;
p.getx unit;
p.gety unit;
p.getc unit;
p.move unit; 
p.getx unit;
p.gety unit;
p.getc unit;  /* finally get desired result! */