(* -*- caml -*- *) class virtual food (energy : int) = object(o) val mutable valid = true val mutable energy = energy method virtual is_innumerable : bool method eaten = if not valid then failwith "bad food" ; if not o#is_innumerable then valid <- false ; energy end class virtual ['a, 'b] animal energy (when_slaughtered : int -> 'a) (check_food : 'b -> unit) = object (* constraint 'a = #food *) val mutable valid = true val mutable energy = energy method energy = energy method eat food = if not valid then failwith "bad animal" ; check_food food ; energy <- energy + food#eaten method slaughter = if not valid then failwith "bad animal" ; valid <- false ; when_slaughtered energy end class virtual vegetable energy = object inherit food energy method is_innumerable = true end class virtual meat energy = object inherit food energy method is_innumerable = false end class carrot energy = object inherit vegetable energy method foo_carrot = () end class grass energy = object inherit vegetable energy method foo_grass = () end class beef energy = object inherit meat energy method foo_beef = () end class dead_rabbit energy = object inherit meat energy method foo_dead_rabbit = () end class dead_human energy = object inherit meat energy method foo_dead_human = () end let drop _ = () class cow energy = object inherit [beef, grass ] animal energy (new beef) drop method foo_cow = () end class rabbit energy = object inherit [dead_rabbit, carrot] animal energy (new dead_rabbit) drop method foo_rabbit = () end class human energy = object inherit [dead_human, food] animal energy (new dead_human) drop method foo_human = () end 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 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 :> food) ; a_human#eat (carrot :> food) ; a_human#eat (carrot :> food) ; a_human#eat (a_dead_rabbit :> food) ; a_human#eat (another_human#slaughter :> food) ; if a_human#energy <> 1785 then failwith "failed" ; (* should fail, but doesn't :-( *) a_human#eat (grass :> food) ; (* human do not eat grass *) (* 7 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 *) *) let should_fail = [ (fun () -> a_human#eat (a_beef :> 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"