Commit ec4b9af6 authored by POTTIER Francois's avatar POTTIER Francois

Add the class [BindingCombinators.iter2].

parent babccd06
......@@ -214,3 +214,54 @@ class virtual ['self] iter = object (self : 'self)
self#visit_inner visit_t ctx t
end
(* -------------------------------------------------------------------------- *)
(* [iter2] *)
class virtual ['self] iter2 = object (self : 'self)
method private virtual extend: 'env -> 'bn1 -> 'bn2 -> 'env
method private visit_abstraction: 'env 'p1 'p2 .
('env context -> 'p1 -> 'p2 -> unit) ->
'env -> 'p1 abstraction -> 'p2 abstraction -> unit
= fun visit_p env p1 p2 ->
visit_p (abstraction env) p1 p2
method private visit_binder:
_ ->
'env context -> 'bn1 binder -> 'bn2 binder -> unit
= fun _ ctx x1 x2 ->
let env = !(ctx.current) in
let env = self#extend env x1 x2 in
ctx.current := env
method private visit_inner: 'env 't1 't2 .
('env -> 't1 -> 't2 -> unit) ->
'env context -> 't1 inner -> 't2 inner -> unit
= fun visit_t ctx t1 t2 ->
self#visit_rebind (self#visit_outer visit_t) ctx t1 t2
method private visit_outer: 'env 't1 't2 .
('env -> 't1 -> 't2 -> unit) ->
'env context -> 't1 outer -> 't2 outer -> unit
= fun visit_t ctx t1 t2 ->
visit_t ctx.outer t1 t2
method private visit_rebind: 'env 'p1 'p2 .
('env context -> 'p1 -> 'p2 -> unit) ->
'env context -> 'p1 rebind -> 'p2 rebind -> unit
= fun visit_p ctx p1 p2 ->
visit_p (rebind ctx) p1 p2
method private visit_bind: 'env 'p1 'p2 't1 't2 .
('env context -> 'p1 -> 'p2 -> unit) ->
('env -> 't1 -> 't2 -> unit) ->
'env -> ('p1, 't1) bind -> ('p2, 't2) bind -> unit
= fun visit_p visit_t env (p1, t1) (p2, t2) ->
let ctx = abstraction env in
visit_p ctx p1 p2;
self#visit_inner visit_t ctx t1 t2
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment