Commit 0bc058cd authored by POTTIER Francois's avatar POTTIER Francois

Implement [BindingFormsUnbound.iter].

parent 8e2a8471
......@@ -60,6 +60,7 @@ class virtual ['self] iter = object (_ : 'self)
= fun _ _ -> assert false
inherit [_] BindingFormsAbs.iter
inherit [_] BindingFormsUnbound.iter
end
......
......@@ -267,3 +267,82 @@ class virtual ['self] map = object (self : 'self)
p2, t2
end
(* -------------------------------------------------------------------------- *)
(* [iter] *)
(* This is like [map], only simpler. The [lookup] method is not required, as
it would have result type [unit]. (And, presumably, would perform no side
effect.) We simply remove it. The [extend] method returns an environment
only. The implementation of [visit_outer] does not require an unsafe cast. *)
class virtual ['self] iter = object (self : 'self)
method private virtual extend: 'bn -> 'env -> 'env
method private visit_abstraction: 'env 'p .
('env penv -> 'p -> unit) ->
'env -> 'p abstraction -> unit
= fun visit_p env p ->
visit_p (abstraction env) p
method private visit_binder:
_ ->
'env penv -> 'bn binder -> unit
= fun _ penv x ->
let env = !(penv.current) in
match penv.at_binder with
| Extend ->
let env = self#extend x env in
penv.current := env
| Lookup ->
()
method private visit_inner: 'env 't .
('env -> 't -> unit) ->
'env penv -> 't inner -> unit
= fun visit_t penv t ->
self#visit_rebind (self#visit_outer visit_t) penv t
method private visit_outer: 'env 't .
('env -> 't -> unit) ->
'env penv -> 't outer -> unit
= fun visit_t penv t ->
match penv.at_outer with
| Visit ->
visit_t penv.outer t
| DoNotVisit ->
()
method private visit_rebind: 'env 'p .
('env penv -> 'p -> unit) ->
'env penv -> 'p rebind -> unit
= fun visit_p penv p ->
visit_p (rebind penv) p
method private visit_recursive: 'env 'p .
('env penv -> 'p -> unit) ->
'env penv -> 'p recursive -> unit
= fun visit_p penv p ->
check_recursive_permitted penv;
let _ = visit_p { penv with at_outer = DoNotVisit } p in
visit_p { penv with at_binder = Lookup } p
method private visit_repeat: 'env 'p .
('env penv -> 'p -> unit) ->
'env penv -> 'p repeat -> unit
= fun visit_p penv p ->
let penv = { penv with at_binder = Lookup } in
visit_p penv p
method private visit_bind: 'env 'p 't .
('env penv -> 'p -> unit) ->
('env -> 't -> unit) ->
'env -> ('p, 't) bind -> unit
= fun visit_p visit_t env (p, t) ->
let penv = abstraction env in
visit_p penv p;
self#visit_inner visit_t penv t
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