Commit dce14c24 by POTTIER Francois

Split [fold] out of [ascend].

parent 68c83e98
......@@ -679,30 +679,26 @@ let ifbuild (attrs : attributes) (builder : builder) : builder =
(* -------------------------------------------------------------------------- *)
(* [ascend] builds the code that forms the ascending part of a visitor method
(associated with a data constructor or record). The ascending part of the
method is the code found after the recursive calls. The parameters of the
(* [ascend] builds the code that forms the ascending part of a visitor method,
that is, the code found after the recursive calls. The parameters of the
function [ascend] are as follows:
[decl] the type declaration under which we are working
[tys] the types of the components of the data constructor or record
[this] a variable that denotes the data structure that is visited
[subjects] the matrix of arguments to the recursive calls
[rs], [ss] vectors of variables that denote the results of the calls
[builder] code for reconstructing a data structure
[m] the name of the virtual ascending method
[fold] what to do if this is a [fold] visitor
*)
let ascend
(decl : type_declaration)
(tys : core_types)
(this : variable)
(subjects : expressions list)
(rs : variables)
(ss : variables)
(builder : builder)
(m : methode)
(fold : unit -> expression)
: expression
=
let rec ascend scheme =
match scheme with
......@@ -729,15 +725,34 @@ let ascend
returned by a [map] visitor and by a [reduce] visitor. *)
tuple [ ascend Map; ascend Reduce ]
| Fold ->
(* A [fold] visitor invokes a virtual method, named [m], passing [env]
and [rs] as arguments. *)
vhook m (env :: rs)
(ty_arrows
(ty_env :: map fold_result_type tys)
(decl_result_type decl))
fold()
in
ascend X.scheme
(* [fold decl m rs tys] builds the code that forms the ascending part of a
visitor method, when this method is associated with a data constructor or
record, and when the scheme is [fold]. The parameters of the function
[ascend] are as follows:
[decl] the type declaration under which we are working
[m] the name of the virtual ascending method
[rs] a vector of variables that denote the results of the calls
[tys] the types of the components of this data constructor or record
*)
let fold
(decl : type_declaration) (m : methode) (rs : variables) (tys : core_types)
() (* delay the side effect! *)
=
(* Invoke the virtual ascending method, with [env] and [rs] as arguments.
As a side effect, declare the existence of this method. *)
vhook m (env :: rs)
(ty_arrows
(ty_env :: map fold_result_type tys)
(decl_result_type decl)
)
(* -------------------------------------------------------------------------- *)
(* [visit_type env_in_scope ty] builds a small expression that represents the
......@@ -989,7 +1004,8 @@ let constructor_declaration decl (cd : constructor_declaration) : case =
(visitor_fun_type (transmit (decl_type decl) tys) (decl_type decl))))
(bind rs ss
(visit_types tys subjects)
(ascend decl tys this subjects rs ss builder (datacon_ascending_method cd))
(ascend this subjects rs ss builder
(fold decl (datacon_ascending_method cd) rs tys))
)
)
......@@ -1032,7 +1048,8 @@ let visit_decl (decl : type_declaration) : expression =
and ss = summaries labels in
bind rs ss
(visit_types tys subjects)
(ascend decl tys (hd xs) subjects rs ss builder (tycon_ascending_method decl))
(ascend (hd xs) subjects rs ss builder
(fold decl (tycon_ascending_method decl) rs tys))
)
(* A sum type. *)
......
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