/* Lingay classes - simple examples */


/* Class for integer store cells */

type intCell = {get: unit->int, set: int->unit} ;

val intCellClass =
   class :: intCell with
      fields i:int
      methods
         get () = ?i ,
         set j  = i:=j
      constr j:int => {i=j}
   end ;

val mkIntCell = new intCellClass ;

val X = mkIntCell 3 ; 
X.get () = 3 ;
X.set 4  = () ;
X.get () = 4 ;


/* Example showing dynamic binding */

type I = {A: int->int, B: int->int} ;

val class1 = 
   class :: I with
      fields
      methods A n = n+n ,
              B n = self.A n + 1
      constr u:unit => {}
   end ;

val X1 = new class1 () ;
X1.A 5 = 10 ;
X1.B 5 = 11 ;

val class2 =
   class :: I extending class1 with
      fields
      methods A n = (n+n)+n
      constr u:unit => {}
   end ;

val X2 = new class2 () ;
X2.B 5 = 16 ; 



/* Class for 2D points */

type intPair = {x:int, y:int} ;

type PointI = {
   getX    : unit->int, 
   setY    : int->unit, 
   reflect : unit->unit
   } ;

val Point = 
   class :: PointI with
      fields x:int, y:int
      methods 
         getX () = ?x,
         setY i  = y:=i,
         reflect() = 
            (val z = self.getX(); 
             val w = ?y;
             x:=w; self.setY z)
      constr p:intPair => {x=p.x, y=p.y}
   end ;


/* Extending points with colour */

datatype Colour :=: [| red, blue, green, yellow, grey of int |] ;

type ColouredPointI = PointI ** {changeColour: Colour->unit} ; 

val ColouredPoint =
   class :: ColouredPointI extending Point with
      fields  c:Colour
      methods 
         changeColour d = c:=d,
         reflect() = (self.changeColour red ;
                      super.reflect())
      constr p:intPair => super p +> {c = red}
   end ;


// minor bug: if type name `intPair' is unknown, get internal error
// annoying limitation in definition stops us writing x := ?y  - relax this?
// ...and error reporting is pretty confusing in cases like this!
// Revisit "overlap" in writesafety rules for x.k.write

// And write that pretty-printer SOON!


/* Translations:

// Preprocessing using top-level type environment Gamma

lo class :: t extending C with stuff end 
   ~~>
lo class :: t extending C : t with stuff end 

where t=\Gamma(C)


// The rest is purely syntactic translation.

// Types:
classimpl fields .. methods .. constr .. end  ~~>  classimpl ..,..,.. end

()  ~~>  {}             // as both expression and pattern

(..) => ..  ~~> ..=>..  // stripping brackets from patterns


lo class :: t with stuff end
   ~~>  
lo class :: t extending lo triv : lo classimpl unit,unit,unit end 
with stuff end


lo class :: pi'_m extending C:lo classimpl pi_f, pi_m, tau_k end with 
   fields pi''_f
   methods method-suite
   constr match
end
   ~~>
lo extend C with 
   fn supervar : tau_super => fn selfvar : tau_self =>
      selfvar +> <lo,pi'f,M,M'>method-suite^ ,
   fn super : (tau_k -> pi_f) => fn match^
end 

  where pi'_f = pi_f + pi''_f
        pi'_m extends pi'_m
        M = names pi_m, M' = names pi'_m
        tau_super = pi_m # pi'_f
        tau_self = pi'_m # pi'_f


<lo,pi'f,M,M'>{mdef0, ...}
   ~~>
{<lo,pi'f,M,M'>mdef0^, ...}


<standard,pi'f,M,M'> m pattern = body
   ~~>
m = fn rw : tau_rw =>
       (super = {m0 = prom (supervar.m0 rw), ...} ;
        self  = {m'0 = prom (selfvar.m'0 rw), ...} ;
        oncefn pattern => body) ,

  where tau_rw = RW_all (pi'_f)
        M = {m0, ...}, M' = {m'0, ...}

?x      ~~>  rw.x.read()
x := e  ~~>  rw.x.write(e)


<linear,pi'f,M,M'> m pat = body
   ~~>
m = fn ...


*/


/* ASIDE: use :<< for open upcasting? */