map_from_fold.ml 1.36 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
(* Direct definitions of [map], [reduce], and [fold]. *)
class virtual ['self] reduce = object (self: 'self)
  method private visit_option: 'a .
    ('env -> 'a -> 'z) -> 'env -> 'a option -> 'z
  = fun f env ox ->
      match ox with None -> self#zero | Some x -> f env x
  method private virtual zero: 'z
end
class ['self] map = object (_ : 'self)
  method private visit_option: 'a 'b .
    ('env -> 'a -> 'b) -> 'env -> 'a option -> 'b option
  = fun f env ox ->
      match ox with None -> None | Some x -> Some (f env x)
end
class virtual ['self] fold = object (self : 'self)
  method private visit_option: 'a .
    ('env -> 'a -> 'r) -> 'env -> 'a option -> 's
  = fun f env ox ->
      match ox with
      | None   -> self#build_None env
      | Some x -> self#build_Some env (f env x)
  method private virtual build_None: 'env -> 's
  method private virtual build_Some: 'env -> 'r -> 's
end
(* A successful definition of [reduce] in terms of [fold]. *)
class virtual ['self] reduce_from_fold = object (self : 'self)
  inherit [_] fold
  method private build_None _env   = self#zero
  method private build_Some _env z = z
  method private virtual zero: 'z
end
(* An unsatisfactory definition of [map] in terms of [fold]. *)
class ['self] map_from_fold = object (_ : 'self)
  inherit [_] fold
  method private build_None _env   = None
  method private build_Some _env x = Some x
end