(* -*- caml -*- *)

class ['a] food (energy : int) = 
  object
    method eaten = energy
    method food_type : 'a option = None
  end

class ['a] meat (energy : int) =
  object
    inherit ['a] food energy as super
    val mutable eaten = false
    method eaten = 
      if eaten then failwith "bad food" ;
      eaten <- true ;
      super#eaten
  end

class any_animal (energy : int) =
  object
    val mutable energy = energy
    method energy = energy
  end

(* objects are typed only by (when_slaughtered, accepted_food) which uniquely describe the animal *)
class ['accepted_food, 'when_slaughtered] animal energy = 
  object
    inherit any_animal energy
    val mutable valid = true

    method eat (food : 'accepted_food food) =
      if not valid then failwith "bad animal" ;
      energy <- energy + food#eaten

    method slaughter =
      if not valid then failwith "bad animal" ;
      valid <- false ;
      (new meat energy :> 'when_slaughtered food)

  end


type human_food = [`Carrot | `Beef | `Dead_rabbit | `Dead_human]

class grass  = [[`Grass]]  food
class carrot = [[`Carrot]] food

class cow    = [[`Grass],   [`Beef]]        animal
class rabbit = [[`Carrot],  [`Dead_rabbit]] animal 
class human  = [human_food, [`Dead_human]]  animal


let should_work =
  let grass    = new grass 5 in
  let carrot   = new carrot 10 in

  let a_rabbit      = new rabbit 100 in
  let a_cow         = new cow 1000 in
  let a_human       = new human 300 in
  let another_human = new human 350 in

  let animals = [ "rabbit", (a_rabbit :> any_animal) ; 
		  "beef",   (a_cow    :> any_animal) ; 
		  "human",  (a_human  :> any_animal) ] in
  List.iter (fun (name, o) -> Printf.printf "%s -> %d\n" name o#energy) animals ;

  a_rabbit#eat carrot ;
  a_cow#eat grass ;

  let a_dead_rabbit = a_rabbit#slaughter in
  let a_beef = a_cow#slaughter in

  a_human#eat (a_beef :> human_food food) ;
  a_human#eat (carrot :> human_food food) ;
  a_human#eat (carrot :> human_food food) ;
  a_human#eat (a_dead_rabbit :> human_food food) ;

  a_human#eat (another_human#slaughter :> human_food food) ;

  if a_human#energy <> 1785 then failwith "failed" ;

(*
  8 should_fail's are detected at compile-time:

  (new cow 10)#slaughter#eat grass ; (* => expression has type beef, it has no method eat *)
  (new cow 10)#slaughter#slaughter ; (* => expression has type beef, it has no method slaughter *)
  carrot#eat grass ; (* => expression has type carrot, it has no method eat *)
  carrot#slaughter ; (* => expression has type carrot, it has no method slaughter *)
  a_human#eat (new cow 10) ; (* => This expression has type cow but is here used with type food *)
  (new cow 10)#eat carrot ; (* => This expression has type carrot but is here used with type grass *)
  (new cow 10)#eat (new cow 10)#slaughter ; (* => This expression has type beef but is here used with type grass *)
  a_human#eat (grass :> human_food food) ; (* => This expression cannot be coerced to type human_food food; is has type [`Grass] food *)
*)

  let should_fail = [
  (fun () -> a_human#eat (a_beef :> human_food food)) ; (* a_beef is already eaten *)
  (fun () -> a_cow#eat grass) ; (* a_cow is dead, it can't eat *)
  (fun () -> ignore a_cow#slaughter) ; (* a_cow is dead, it can't be slaughtered again *)
  ] in

  List.iter (fun f ->
    if not (try f() ; false with Failure s -> Printf.eprintf "expected error: %s\n" s ; true) then
      failwith "should fail"
  ) should_fail ;

  Printf.eprintf "all ok\n"