Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
POTTIER Francois
alphaLib
Commits
bf691e70
Commit
bf691e70
authored
Feb 20, 2017
by
POTTIER Francois
Browse files
Renaming of the three modes.
parent
e600b6d0
Changes
1
Hide whitespace changes
Inline
Side-by-side
src/Unbound.ml
View file @
bf691e70
type
'
env
mode
=
|
OutsideRec
(* updating [current] and visiting [outer] subterms *)
|
ExtendAndVisit
(* updating [current] and visiting [outer] subterms *)
(* we are outside [rec] and outside [repeated] *)
|
InsideRecDiscovery
(* updating [current] and doing nothing else; embedded subterms not visited *)
|
ExtendNoVisit
(* updating [current] and doing nothing else; embedded subterms not visited *)
(* we are under [rec] in the discovery phase *)
|
InsideRec
Visit
(* [current] not updated; [inner] is [current]; embedded subterms visited *)
|
LookupAnd
Visit
(* [current] not updated; [inner] is [current]; embedded subterms visited *)
(* we are either under [rec] in the visit phase, or under [repeated] *)
type
'
env
penv
=
{
current
:
'
env
ref
;
(* threaded left to right *)
current
:
'
env
ref
;
(* threaded left to right
; do NOT use a mutable field!
*)
outer
:
'
env
;
(* sent down only *)
mode
:
'
env
mode
;
}
...
...
@@ -49,7 +49,7 @@ class virtual ['self] libmap = object (self : 'self)
(
'
env
penv
->
'
p1
->
'
p2
)
->
'
env
->
'
p1
abstraction
->
'
p2
abstraction
=
fun
visit_p
env
p1
->
let
penv
=
{
current
=
ref
env
;
outer
=
env
;
mode
=
OutsideRec
}
in
let
penv
=
{
current
=
ref
env
;
outer
=
env
;
mode
=
ExtendAndVisit
}
in
visit_p
penv
p1
method
private
visit_outer
:
'
env
'
t1
'
t2
.
...
...
@@ -57,10 +57,10 @@ class virtual ['self] libmap = object (self : 'self)
'
env
penv
->
'
t1
outer
->
'
t2
outer
=
fun
visit_t
penv
t1
->
match
penv
.
mode
with
|
OutsideRec
|
InsideRec
Visit
->
|
ExtendAndVisit
|
LookupAnd
Visit
->
visit_t
penv
.
outer
t1
|
InsideRecDiscovery
->
|
ExtendNoVisit
->
(* An [outer] subterm is NOT visited in discovery mode. *)
Obj
.
magic
()
...
...
@@ -69,14 +69,14 @@ class virtual ['self] libmap = object (self : 'self)
'
env
penv
->
'
bn1
binder
->
'
bn2
binder
=
fun
_
penv
x1
->
match
penv
.
mode
with
|
OutsideRec
|
InsideRecDiscovery
->
|
ExtendAndVisit
|
ExtendNoVisit
->
let
current
=
penv
.
current
in
let
env
=
!
current
in
let
x2
,
env
=
self
#
extend
x1
env
in
current
:=
env
;
x2
|
InsideRec
Visit
->
|
LookupAnd
Visit
->
(* The environment should not be extended when in visit mode.
It has been extended already during the discovery phase. *)
self
#
lookup
x1
!
(
penv
.
current
)
...
...
@@ -87,15 +87,15 @@ class virtual ['self] libmap = object (self : 'self)
'
env
penv
->
(
'
p1
,
'
q1
)
rebind
->
(
'
p2
,
'
q2
)
rebind
=
fun
visit_p
visit_q
penv
(
p1
,
q1
)
->
match
penv
.
mode
with
|
OutsideRec
->
|
ExtendAndVisit
->
let
p2
=
visit_p
penv
p1
in
(* Copy [current] into [outer]. This changes the meaning of [outer]
in the right-hand side of [rebind]. *)
let
penv
=
{
penv
with
outer
=
!
(
penv
.
current
)
}
in
let
q2
=
visit_q
penv
q1
in
p2
,
q2
|
InsideRecDiscovery
|
InsideRec
Visit
->
|
ExtendNoVisit
|
LookupAnd
Visit
->
(* [rebind] forbidden under [rec] and [repeated] *)
assert
false
...
...
@@ -116,11 +116,11 @@ class virtual ['self] libmap = object (self : 'self)
'
env
penv
->
'
t1
inner
->
'
t2
inner
=
fun
visit_t
penv
t1
->
match
penv
.
mode
with
|
InsideRecDiscovery
->
|
ExtendNoVisit
->
(* An [inner] subterm is NOT visited in discovery mode. *)
Obj
.
magic
()
|
OutsideRec
|
InsideRec
Visit
->
|
ExtendAndVisit
|
LookupAnd
Visit
->
visit_t
!
(
penv
.
current
)
t1
method
private
visit_recursive
:
'
env
'
p1
'
p2
.
...
...
@@ -128,16 +128,16 @@ class virtual ['self] libmap = object (self : 'self)
'
env
penv
->
'
p1
recursive
->
'
p2
recursive
=
fun
visit_p
penv
p1
->
match
penv
.
mode
with
|
OutsideRec
->
|
ExtendAndVisit
->
(* Discovery phase. Result is discarded (fortunately, since we have used
[magic] to produce it, and it is entirely meaningless). *)
let
penv
=
{
penv
with
mode
=
InsideRecDiscovery
}
in
let
penv
=
{
penv
with
mode
=
ExtendNoVisit
}
in
let
_
=
visit_p
penv
p1
in
(* [!current] becomes [inner] *)
let
penv
=
{
penv
with
mode
=
InsideRec
Visit
}
in
let
penv
=
{
penv
with
mode
=
LookupAnd
Visit
}
in
visit_p
penv
p1
|
InsideRecDiscovery
|
InsideRec
Visit
->
|
ExtendNoVisit
|
LookupAnd
Visit
->
(* [rec] forbidden under [rec] or [repeated] *)
assert
false
...
...
@@ -145,7 +145,7 @@ class virtual ['self] libmap = object (self : 'self)
(
'
env
penv
->
'
p1
->
'
p2
)
->
'
env
penv
->
'
p1
repeated
->
'
p2
repeated
=
fun
visit_p
penv
p1
->
let
penv
=
{
penv
with
mode
=
InsideRec
Visit
}
in
let
penv
=
{
penv
with
mode
=
LookupAnd
Visit
}
in
visit_p
penv
p1
end
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment