diff --git a/src/Visitors.ml b/src/Visitors.ml index caf8b51d8d009cb60e5533420441681c2a3ac66d..4d0b42704dd92be8f937fc06f69ca37523e03fe4 100644 --- a/src/Visitors.ml +++ b/src/Visitors.ml @@ -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. *)