Commit a1185be3 authored by POTTIER Francois's avatar POTTIER Francois

Removed the [env] parameter of [InsideRecVisit].

parent 63ecb7a2
type 'env mode = type 'env mode =
| OutsideRec | OutsideRec (* updating [current] and visiting [outer] subterms *)
| InsideRecDiscovery (* updating [current] and doing nothing else; embedded subterms not visited *) | InsideRecDiscovery (* updating [current] and doing nothing else; embedded subterms not visited *)
| InsideRecVisit of 'env (* [inner] component now known; embedded subterms visited *) | InsideRecVisit (* [current] not updated; [inner] is [current]; embedded subterms visited *)
| Repeated | Repeated
type 'env penv = { type 'env penv = {
...@@ -29,10 +29,8 @@ type ('p, 't) bind = ...@@ -29,10 +29,8 @@ type ('p, 't) bind =
(('p, 't outer) rebind) abstraction (* = 'p * 't *) (('p, 't outer) rebind) abstraction (* = 'p * 't *)
(* [Abstraction] allowed only in an expression *) (* [Abstraction] allowed only in an expression *)
(* [Rebind], [Rec] forbidden under [Rec] *) (* [Rebind], [Rec] forbidden under [Rec] and [Repeated] *)
(* [Outer], [Binder] allowed both outside and inside [Rec] *) (* [Outer], [Inner], [Binder], [Repeated] allowed everywhere *)
(* [Inner] allowed only under [Rec]. *)
(* [Repeated] allowed everywhere *)
type 't inner = type 't inner =
't 't
...@@ -58,7 +56,7 @@ class virtual ['self] libmap = object (self : 'self) ...@@ -58,7 +56,7 @@ class virtual ['self] libmap = object (self : 'self)
= fun visit_t penv t1 -> = fun visit_t penv t1 ->
match penv.mode with match penv.mode with
| OutsideRec | OutsideRec
| InsideRecVisit _ | InsideRecVisit
| Repeated -> | Repeated ->
visit_t penv.outer t1 visit_t penv.outer t1
| InsideRecDiscovery -> | InsideRecDiscovery ->
...@@ -77,15 +75,11 @@ class virtual ['self] libmap = object (self : 'self) ...@@ -77,15 +75,11 @@ class virtual ['self] libmap = object (self : 'self)
let x2, env = self#extend x1 env in let x2, env = self#extend x1 env in
current := env; current := env;
x2 x2
| Repeated -> | Repeated
let current = penv.current in | InsideRecVisit ->
let env = !current in
self#lookup x1 env
| InsideRecVisit env ->
assert (env == !(penv.current)); (* TEMPORARY if always true, then we do not need to carry [env] *)
(* The environment should not be extended when in visit mode. (* The environment should not be extended when in visit mode.
It has been extended already during the discovery phase. *) It has been extended already during the discovery phase. *)
self#lookup env x1 self#lookup x1 !(penv.current)
method private visit_rebind: 'env 'p1 'p2 'q1 'q2 . method private visit_rebind: 'env 'p1 'p2 'q1 'q2 .
('env penv -> 'p1 -> 'p2) -> ('env penv -> 'p1 -> 'p2) ->
...@@ -101,7 +95,7 @@ class virtual ['self] libmap = object (self : 'self) ...@@ -101,7 +95,7 @@ class virtual ['self] libmap = object (self : 'self)
let q2 = visit_q penv q1 in let q2 = visit_q penv q1 in
p2, q2 p2, q2
| InsideRecDiscovery | InsideRecDiscovery
| InsideRecVisit _ | InsideRecVisit
| Repeated -> | Repeated ->
(* [rebind] forbidden under [rec] and [repeated] *) (* [rebind] forbidden under [rec] and [repeated] *)
assert false assert false
...@@ -123,15 +117,11 @@ class virtual ['self] libmap = object (self : 'self) ...@@ -123,15 +117,11 @@ class virtual ['self] libmap = object (self : 'self)
'env penv -> 't1 inner -> 't2 inner 'env penv -> 't1 inner -> 't2 inner
= fun visit_t penv t1 -> = fun visit_t penv t1 ->
match penv.mode with match penv.mode with
| OutsideRec ->
(* [inner] allowed only under [rec] *)
assert false
| InsideRecDiscovery -> | InsideRecDiscovery ->
(* An [inner] subterm is NOT visited in discovery mode. *) (* An [inner] subterm is NOT visited in discovery mode. *)
Obj.magic () Obj.magic ()
| InsideRecVisit env -> | OutsideRec
assert (env == !(penv.current)); | InsideRecVisit
visit_t env t1
| Repeated -> | Repeated ->
visit_t !(penv.current) t1 visit_t !(penv.current) t1
...@@ -146,12 +136,12 @@ class virtual ['self] libmap = object (self : 'self) ...@@ -146,12 +136,12 @@ class virtual ['self] libmap = object (self : 'self)
let penv = { penv with mode = InsideRecDiscovery } in let penv = { penv with mode = InsideRecDiscovery } in
let _ = visit_p penv p1 in let _ = visit_p penv p1 in
(* [!current] becomes [inner] *) (* [!current] becomes [inner] *)
let penv = { penv with mode = InsideRecVisit !(penv.current) } in let penv = { penv with mode = InsideRecVisit } in
visit_p penv p1 visit_p penv p1
| InsideRecDiscovery | InsideRecDiscovery
| InsideRecVisit _ | InsideRecVisit
| Repeated -> | Repeated ->
(* [rec] not allowed under [rec] or [repeated] *) (* [rec] forbidden under [rec] or [repeated] *)
assert false assert false
method private visit_repeated: 'env 'p1 'p2 . method private visit_repeated: 'env 'p1 'p2 .
......
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