Commit 30af628a by POTTIER Francois

New auxiliary function [bulk].

parent 2bca65a2
......@@ -907,10 +907,7 @@ let rec visit_type (env_in_scope : bool) (ty : core_type) : expression =
let ascend = new ascend_tuple this subjects rs ss in
plambdas
(alias this (ptuples (transpose arity (pvarss xss))))
(bind rs ss
(visit_types tys subjects)
(ascend#ascend)
)
(bulk rs ss tys subjects ascend)
(* If [env_in_scope] does not have the desired value, wrap a recursive call
within an application or abstraction. At most one recursive call takes
......@@ -951,6 +948,22 @@ and visit_types tys (ess : expressions list) : expressions =
(* -------------------------------------------------------------------------- *)
(* The expression [bulk rs ss tys subjects ascend] represents the bulk of a
visitor method or visitor function. It performs the recursive calls, binds
their results to [rs] and/or [ss], then runs the ascending code. *)
and bulk
(rs : variables) (ss : variables)
(tys : core_types)
(subjects : expressions list)
(ascend : < ascend: expression; .. >)
=
bind rs ss
(visit_types tys subjects)
(ascend#ascend)
(* -------------------------------------------------------------------------- *)
(* [constructor_declaration] turns a constructor declaration (as found in a
declaration of a sum type) into a case, that is, a branch in the case
analysis construct that forms the body of the visitor method for this sum
......@@ -1049,10 +1062,7 @@ let constructor_declaration decl (cd : constructor_declaration) : case =
(quantify alphas (ty_arrows
(map visitor_param_type alphas)
(visitor_fun_type (transmit (decl_type decl) tys) (decl_type decl))))
(bind rs ss
(visit_types tys subjects)
(ascend#ascend)
)
(bulk rs ss tys subjects ascend)
)
(* -------------------------------------------------------------------------- *)
......@@ -1096,11 +1106,7 @@ let visit_decl (decl : type_declaration) : expression =
(hd xs) subjects rs ss
builder decl (tycon_ascending_method decl) tys
in
lambdas xs (
bind rs ss
(visit_types tys subjects)
(ascend#ascend)
)
lambdas xs (bulk rs ss tys subjects ascend)
(* A sum type. *)
| Ptype_variant (cds : constructor_declaration list), _ ->
......
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