Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Open sidebar
POTTIER Francois
visitors
Commits
b9695df1
Commit
b9695df1
authored
Mar 09, 2017
by
POTTIER Francois
Browse files
Cleanup of [generator].
parent
9e95809a
Changes
2
Hide whitespace changes
Inline
Sidebyside
Showing
2 changed files
with
211 additions
and
71 deletions
+211
71
test/generator.ml
test/generator.ml
+210
71
test/misc.mllib
test/misc.mllib
+1
0
No files found.
test/generator.ml
View file @
b9695df1
type
'
a
delay
=
'
a
(* To play with this code in an OCaml toplevel, launch [ocaml] and type this:
#use "topfind";;
#require "visitors.ppx";;
#require "visitors.runtime";;
*)
(*  *)
(* Suppose we have an arbitrary data structure that contains elements
of type ['a]. Here, it is a binary tree, but it could be anything: *)
type
'
a
sometree
=

Leaf

Node
of
'
a
sometree
*
'
a
*
'
a
sometree
(* We would like to enumerate the elements of this data structure.
More precisely, we would like to construct an iterator, that is,
an an ondemand producer of elements. Here is a simple definition
of a stateful iterator: *)
type
'
a
iterator
=
unit
>
'
a
option
(* The question is, can we construct an iterator for the type ['a sometree],
based on an automaticallygenerated visitor, so that the construction is
entirely independent of the type ['a sometree]? *)
type
'
a
delaytree
=

DTNothing

DTElement
of
'
a

DTConcat
of
'
a
delaytree
*
'
a
delaytree

DTDelay
of
(
unit
>
'
a
delaytree
)
(*  *)
(* https://github.com/ocaml/ocaml/pull/1002 *)
(* For starters, let us first define cascades, which are a more pleasant kind
of iterators. A cascade is a persistent (stateless) iterator. It can be
thought of as a delayed list, that is, a list whose elements are computed
only on demand. *)
(* Cascades could (should) be part of a separate library. There is in fact a
proposal to add them to OCaml's standard library: see the discussion at
https://github.com/ocaml/ocaml/pull/1002 *)
type
'
a
cascade
=
unit
>
'
a
head
...
...
@@ 15,92 +43,180 @@ and 'a head =

Nil

Cons
of
'
a
*
'
a
cascade
(* A delayed computation is represented as a function of type [unit > _].
Thus, no memoization takes place. It is easy to implement a function
[memo: 'a cascade > 'a cascade] that turns a nonmemoizing cascade into
a memoizing one, so memoization can be requested a posteriori, if
desired. *)
(* The empty cascade. *)
let
nil
:
'
a
cascade
=
fun
()
>
Nil
let
force
thunk
=
thunk
()
(* Forcing a cascade reveals its head. *)
let
head
(
xs
:
'
a
cascade
)
:
'
a
=
match
force
xs
with

Nil
>
invalid_arg
"head"

Cons
(
x
,
_
)
>
x
let
force
xs
=
xs
()
let
tail
(
xs
:
'
a
cascade
)
:
'
a
cascade
=
match
force
xs
with

Nil
>
invalid_arg
"tail"

Cons
(
_
,
xs
)
>
xs
(* A cascade can be easily converted to a stateful iterator. *)
type
'
a
iterator
=
unit
>
'
a
option
let
cascade2iterator
(
xs
:
'
a
cascade
)
:
'
a
iterator
=
let
cascade_to_iterator
(
xs
:
'
a
cascade
)
:
'
a
iterator
=
let
s
=
ref
xs
in
fun
()
>
match
force
!
s
with

Nil
>
s
:=
nil
;
(* avoid repeating this work, next time *)
(* Writing [nil] into [s] may seem superfluous, but is in fact
necessary to guarantee that the computation that just led to
a [Nil] outcome is not repeated in the future. *)
s
:=
nil
;
None

Cons
(
x
,
xs
)
>
s
:=
xs
;
Some
x
let
rec
delaytree2cascade
(
dt
:
'
a
delaytree
)
(
k
:
'
a
cascade
)
:
'
a
cascade
=
fun
()
>
delaytree2head
dt
k
and
delaytree2head
(
dt
:
'
a
delaytree
)
(
k
:
'
a
cascade
)
:
'
a
head
=
(* Because cascades are close cousins of lists, they are easy to work with.
Constructing a cascade for a treelike data structure is straightforward,
whereas directly constructing a stateful iterator would be more involved. *)
(*  *)
(* Now, can we use some kind of visitor to turn a tree of type ['a sometree]
into a cascade of type ['a cascade]? *)
(* At first sight, this does not seem very easy, for two reasons: 1 a visitor
usually traverses a tree in an eager manner, whereas we need the traversal
to make progress only as cascade elements are demanded; and 2 a visitor
performs a bottomup computation, without a lefttoright bias (assuming
mutable state is not used), whereas a cascade enumerates elements in a
lefttoright manner. (Or in a righttoleft manner. As will be apparent
below, both directions are possible.) *)
(* The trick is to use another intermediate step. Instead of turning a tree
directly into a cascade, we first transform it into a generic treelike
structure: a *delayed tree*. Problem 1 is solved because, by introducing
delays into the new tree, we allow its construction to be carried out on
demand. Problem 2 is solved because this treetotree transformation can be
carried out in a purely bottomup manner by a [reduce] visitor. Then,
finally, it is straightforward to transform a delayed tree into a
cascade. *)
(*  *)
(* A delayed tree contains ordinary nodes of arity 0, 1, and 2. Furthermore,
it contains [DTDelay] nodes, of arity 1, whose child is delayed, that is,
computed only on demand. *)
type
'
a
delayed_tree
=

DTZero

DTOne
of
'
a

DTTwo
of
'
a
delayed_tree
*
'
a
delayed_tree

DTDelay
of
(
unit
>
'
a
delayed_tree
)
(* A delayed tree is converted to a cascade as follows. We may choose, at this
point, between lefttoright and righttoleft traversals. As usual, when
building a cascade, one must take a continuation [k] as an argument, so as
to avoid naive and costly cascade concatenation operations. *)
let
rec
delayed_tree_to_cascade
(
dt
:
'
a
delayed_tree
)
(
k
:
'
a
cascade
)
:
'
a
cascade
=
fun
()
>
delayed_tree_to_head
dt
k
and
delayed_tree_to_head
(
dt
:
'
a
delayed_tree
)
(
k
:
'
a
cascade
)
:
'
a
head
=
match
dt
with

DT
Nothing
>

DT
Zero
>
force
k

DT
Element
x
>

DT
One
x
>
Cons
(
x
,
k
)

DT
Concat
(
dt1
,
dt2
)
>
delaytree
2
head
dt1
(
delaytree
2
cascade
dt2
k
)

DT
Two
(
dt1
,
dt2
)
>
delay
ed_
tree
_to_
head
dt1
(
delay
ed_
tree
_to_
cascade
dt2
k
)

DTDelay
dt
>
delaytree
2
head
(
force
dt
)
k
delay
ed_
tree
_to_
head
(
force
dt
)
k
let
delaytree
2
cascade
dt
=
delaytree
2
cascade
dt
nil
let
delay
ed_
tree
_to_
cascade
(
dt
:
'
a
delayed_tree
)
:
'
a
cascade
=
delay
ed_
tree
_to_
cascade
dt
nil
let
yield
_env
x
=
DTElement
x
let
delayed_tree_to_iterator
(
dt
:
'
a
delayed_tree
)
:
'
a
iterator
=
cascade_to_iterator
(
delayed_tree_to_cascade
dt
)
(*  *)
class
[
'
self
]
delaytree_monoid
=
object
(
_
:
'
self
)
(* We now set up four constructor functions and constructor methods, which
construct delayed trees, and which we will use in a [reduce] visitor. *)
method
private
zero
=
DTNothing
(* The type ['a delay] is a synonym for ['a]. It is used as a decoration, in a
type definition, to indicate that a call to the method [visit_delay] is
desired. *)
method
private
plus
s1
s2
=
type
'
a
delay
=
'
a
class
[
'
self
]
delayed_tree_monoid
=
object
(
_
:
'
self
)
(* Delayed trees form a monoid, in the sense that we concatenate them using
[DTTwo], and the neutral element is [DTZero]. We package these two data
constructors in the methods [zero] and [plus], which are automatically
called in an automaticallygenerated [reduce] visitor. *)
method
zero
=
DTZero
method
plus
s1
s2
=
match
s1
,
s2
with

DT
Nothing
,
s

s
,
DT
Nothing
>
(*
An
opti
onal optimization
. *)

DT
Zero
,
s

s
,
DT
Zero
>
(*
This
opti
mization is not mandatory. It helps allocate fewer nodes
. *)
s

_
,
_
>
DTConcat
(
s1
,
s2
)
DTTwo
(
s1
,
s2
)
(* The visitor method [visit_delay] delays the visit of a subtree by
constructing and returning a [DTDelay] node, which carries a delayed
recursive call to a visitor. *)
method
visit_delay
:
'
env
'
a
.
(
'
env
>
'
a
>
'
b
delaytree
)
>
'
env
>
'
a
delay
>
'
b
delaytree
(
'
env
>
'
a
>
'
b
delay
ed_
tree
)
>
'
env
>
'
a
delay
>
'
b
delay
ed_
tree
=
fun
visit_'a
env
x
>
DTDelay
(
fun
()
>
visit_'a
env
x
)
end
type
'
a
kctree
=

Leaf

Node
of
'
a
kctree
*
'
a
*
'
a
kctree
(* The visitor function [yield] will be invoked at elements of type ['a].
It constructs a oneelement delayed tree. *)
let
yield
_env
x
=
DTOne
x
(*  *)
type
'
a
t
=
'
a
kctree
=
(* It is now time to generate a [reduce] visitor for the type ['a sometree].
This is the only part of the code which is specific of [sometree].
Everything else is generic. *)
(* We must insert [delay]s into the structure of the type ['a sometree] so as
to indicate where [visit_delay] should be called and (therefore) where
[DTDelay] nodes should be allocated. To do this, we write a copy of the
definition of the type ['a sometree], with extra delays in it. The new type
is actually considered equal to ['a sometree] by OCaml. Its role is purely
to carry a [@@deriving visitors] annotation. *)
(* In the data constructor [Node], the lefthand [delay] is in fact
superfluous. With or without it, our iterators will eagerly descend along
the leftmost branch of a tree, anyway. *)
type
'
a
mytree
=
'
a
sometree
=

Leaf

Node
of
'
a
u
*
'
a
*
'
a
u

Node
of
'
a
mytree
delay
*
'
a
*
'
a
mytree
delay
and
'
a
mytree_delay
=
'
a
mytree
delay
[
@@
deriving
visitors
{
variety
=
"reduce"
;
polymorphic
=
true
;
concrete
=
true
;
ancestors
=
[
"delayed_tree_monoid"
]
}]
and
'
a
u
=
'
a
t
delay
[
@@
deriving
visitors
{
variety
=
"reduce"
;
ancestors
=
[
"delaytree_monoid"
];
polymorphic
=
true
;
concrete
=
true
}]
(*  *)
(* For demonstration purposes, let us make our visitor verbose. *)
class
[
'
self
]
verbose_reduce
=
object
(
_
:
'
self
)
inherit
[
_
]
reduce
as
super
...
...
@@ 112,25 +228,48 @@ class ['self] verbose_reduce = object (_ : 'self)
super
#
visit_Node
visit_'a
env
t1
x
t2
end
let
t2delaytree
(
t
:
'
a
kctree
)
=
new
verbose_reduce
#
visit_u
yield
()
t
let
t2cascade
t
=
delaytree2cascade
(
t2delaytree
t
)
(* In production, one should remove [verbose_reduce] and use [reduce]
instead. *)
let
t2iterator
(
t
:
'
a
kctree
)
:
'
a
iterator
=
cascade2iterator
(
t2cascade
t
)
let
sometree_to_delayed_tree
(
t
:
'
a
sometree
)
=
new
verbose_reduce
#
visit_mytree_delay
yield
()
t
(* We use [visit_mytree_delay], even though [visit_mytree] would work
just as well, so as to ensure that we get a delayed tree whose root
is a [DTDelay] node. *)
let
t
=
Node
(
Node
(
Leaf
,
1
,
Leaf
)
,
2
,
Node
(
Leaf
,
3
,
Leaf
))
(* Problem solved! *)
let
i
=
t2iterator
t
let
sometree_to_iterator
(
t
:
'
a
sometree
)
:
'
a
iterator
=
delayed_tree_to_iterator
(
sometree_to_delayed_tree
t
)
let
_
=
i
(
)
(*  *
)
let
u
=
Node
(
Node
(
Leaf
,
false
,
Leaf
)
,
true
,
Node
(
Leaf
,
false
,
Leaf
))
(* Demo. *)
let
j
=
t2iterator
u
let
t
:
int
sometree
=
Node
(
Node
(
Leaf
,
1
,
Leaf
)
,
2
,
Node
(
Leaf
,
3
,
Leaf
))
let
_
=
j
()
let
i
:
int
iterator
=
sometree_to_iterator
t
(* Transcript of an OCaml toplevel session:
# i();;
Visiting a node.
Visiting a node.
Visiting a leaf.
 : int option = Some 1
# i();;
Visiting a leaf.
 : int option = Some 2
# i();;
Visiting a node.
Visiting a leaf.
 : int option = Some 3
# i();;
Visiting a leaf.
 : int option = None
# i();;
 : int option = None
*)
test/misc.mllib
View file @
b9695df1
dictionary
fold
generator
mapReduce
map_from_fold
monopoly
...
...
Write
Preview
Markdown
is supported
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