Moving Beyond Types (2017)(hypothesis.works)

    let create_frog () = object
      method color = "black"
      method size = 10
      method speed = 5
      method direction = 3.14
      method swim = print_endline "Frog swimming"
    end

    let allow_frog_to_walk frog = object
      method walk = print_endline "Frog walking"
      method super = frog
    end

    let allow_frog_to_jump frog = object
      method jump = print_endline "Frog jumping"
      method super = frog
    end

    let make_frog_toxic frog = object
      method intoxicate animal = print_endline ("Intoxicate" ^ animal)
      method super = frog
    end

    let frog = create_frog ()
    let frog = allow_frog_to_walk frog
    let frog = allow_frog_to_jump frog
    let frog = make_frog_toxic frog

    type walker = WalkFn of (animal -> unit)
    and  jumper = JumpFn of (animal -> unit)
    and  swimmer = SwimFn of (animal -> unit)
    and  intoxicator = ToxicFn of (animal -> animal -> unit)
    and  animal = Animal of animal_data
    and  animal_data = {
      name: string;
      color: string;
      mutable walk: walker option;
      mutable jump: jumper option;
      mutable swim: swimmer option;
      mutable intoxicate: intoxicator option
    }

    let can_walk = function
      | Animal { walk = Some _ } -> true
      | _ -> false

    let walk animal =
      match animal with
      | Animal { walk = Some (WalkFn walk_fn) } -> walk_fn animal
      | _ -> invalid_arg "this animal can't walk"

    let default_walker = function
      | Animal { name; color } -> Printf.printf "the %s %s walks\n" color name

    let allow_to_walk (Animal data) =
      data.walk <- Some (WalkFn default_walker)

    (* --- more of the same for the other actions --- *)
    let can_jump = function
      | Animal { jump = Some _ } -> true
      | _ -> false

    let jump animal =
      match animal with
      | Animal { jump = Some (JumpFn jump_fn) } -> jump_fn animal
      | _ -> invalid_arg "this animal can't jump"

    let default_jumper = function
      | Animal { name; color } -> Printf.printf "the %s %s jumps\n" color name

    let allow_to_jump (Animal data) =
      data.jump <- Some (JumpFn default_jumper)

    let can_swim = function
      | Animal { swim = Some _ } -> true
      | _ -> false

    let swim animal =
      match animal with
      | Animal { swim = Some (SwimFn swim_fn) } -> swim_fn animal
      | _ -> invalid_arg "this animal can't swim"

    let default_swimmer = function
      | Animal { name; color } -> Printf.printf "the %s %s swims\n" color name

    let allow_to_swim (Animal data) =
      data.swim <- Some (SwimFn default_swimmer)

    let can_intoxicate = function
      | Animal { intoxicate = Some _ } -> true
      | _ -> false

    let intoxicate animal victim =
      match animal with
      | Animal { intoxicate = Some (ToxicFn toxic_fn) } -> toxic_fn animal victim   
      | _ -> invalid_arg "this animal can't intoxicate"
  
    let default_intoxicator animal victim =
      match animal, victim with
      | Animal attacker, Animal victim ->
          Printf.printf "the %s %s poisons the %s %s\n"
            attacker.color attacker.name victim.color victim.name
  
    let allow_to_intoxicate (Animal data) =
      data.intoxicate <- Some (ToxicFn default_intoxicator)
    (* --- end of actions --- *)

    let create_frog () =
      Animal {
        name = "frog";
        color = "black";
        walk = None;
        jump = None;
        swim = None;
        intoxicate = None
      }

    let create_cow () =
      Animal {
        name = "cow";
        color = "green";
        walk = None;
        jump = None;
        swim = None;
        intoxicate = None
      }

    let story () =
      let frog = create_frog () in
      Printf.printf "newborn frog, can it walk? %s\n"
        (if can_walk frog then "yes" else "no");
      allow_to_walk frog;
      Printf.printf "and now, can it walk? %s\n"
        (if can_walk frog then "yes" else "no");
      walk frog;
      allow_to_swim frog;
      swim frog;
      allow_to_jump frog;
      jump frog;
      allow_to_intoxicate frog;
      intoxicate frog (create_cow ());
      Printf.printf "the end\n"

    (* now run all this *)
    let _ = story ()

    $ ocaml frog_story.ml 
    newborn frog, can it walk? no
    and now, can it walk? yes
    the black frog walks
    the black frog swims
    the black frog jumps
    the black frog poisons the green cow
    the end

   let frob something = something#run ...