1(**************************************************************************)
2(*                                                                        *)
3(*                                 OCaml                                  *)
4(*                                                                        *)
5(*                       Pierre Chambart, OCamlPro                        *)
6(*           Mark Shinwell and Leo White, Jane Street Europe              *)
7(*                                                                        *)
8(*   Copyright 2013--2016 OCamlPro SAS                                    *)
9(*   Copyright 2014--2016 Jane Street Group LLC                           *)
10(*                                                                        *)
11(*   All rights reserved.  This file is distributed under the terms of    *)
12(*   the GNU Lesser General Public License version 2.1, with the          *)
13(*   special exception on linking described in the file LICENSE.          *)
14(*                                                                        *)
15(**************************************************************************)
16
17[@@@ocaml.warning "+a-4-9-30-40-41-42"]
18
19(** Freshening of various identifiers. *)
20
21(** A table used for freshening variables and static exception identifiers. *)
22type t
23type subst = t
24
25(** The freshening that does nothing.  This is the unique inactive
26    freshening. *)
27val empty : t
28
29(** Activate the freshening.  Without activation, operations to request
30    freshenings have no effect (cf. the documentation below for
31    [add_variable]).  As such, the inactive renaming is unique. *)
32val activate : t -> t
33
34(** Given the inactive freshening, return the same; otherwise, return an
35    empty active freshening. *)
36val empty_preserving_activation_state : t -> t
37
38(** [add_variable t var]
39    If [t] is active:
40      It returns a fresh variable [new_var] and adds [var] -> [new_var]
41      to the freshening.
42      If a renaming [other_var] -> [var] or [symbol] -> [var] was already
43      present in [t], it will also add [other_var] -> [new_var] and
44      [symbol] -> [new_var].
45    If [t] is inactive, this is the identity.
46*)
47val add_variable : t -> Variable.t -> Variable.t * t
48
49(** Like [add_variable], but for multiple variables, each freshened
50    separately. *)
51val add_variables'
52   : t
53  -> Variable.t list
54  -> Variable.t list * t
55
56(** Like [add_variables'], but passes through the second component of the
57    input list unchanged. *)
58val add_variables
59   : t
60  -> (Variable.t * 'a) list
61  -> (Variable.t * 'a) list * t
62
63(** Like [add_variable], but for mutable variables. *)
64val add_mutable_variable : t -> Mutable_variable.t -> Mutable_variable.t * t
65
66(** As for [add_variable], but for static exception identifiers. *)
67val add_static_exception : t -> Static_exception.t -> Static_exception.t * t
68
69(** [apply_variable t var] applies the freshening [t] to [var].
70    If no renaming is specified in [t] for [var] it is returned unchanged. *)
71val apply_variable : t -> Variable.t -> Variable.t
72
73(** As for [apply_variable], but for mutable variables. *)
74val apply_mutable_variable : t -> Mutable_variable.t -> Mutable_variable.t
75
76(** As for [apply_variable], but for static exception identifiers. *)
77val apply_static_exception : t -> Static_exception.t -> Static_exception.t
78
79(** Replace recursive accesses to the closures in the set through
80    [Symbol] by the corresponding [Var]. This is used to recover
81    the recursive call when importing code from another compilation unit.
82
83    If the renaming is inactive, this is the identity.
84*)
85val rewrite_recursive_calls_with_symbols
86   : t
87  -> Flambda.function_declarations
88  -> make_closure_symbol:(Closure_id.t -> Symbol.t)
89  -> Flambda.function_declarations
90
91(* CR-soon mshinwell for mshinwell: maybe inaccurate module name, it freshens
92   closure IDs as well.  Check use points though *)
93module Project_var : sig
94  (** A table used for freshening of identifiers in [Project_closure] and
95      [Move_within_set_of_closures] ("ids of closures"); and [Project_var]
96      ("bound vars of closures") expressions.
97
98      This information is propagated bottom up and populated when inlining a
99      function containing a closure declaration.
100
101      For instance,
102        [let f x =
103           let g y = ... x ... in
104           ... g.x ...           (Project_var x)
105           ... g 1 ...           (Apply (Project_closure g ...))
106           ]
107
108      If f is inlined, g is renamed. The approximation of g will carry this
109      table such that later the access to the field x of g and selection of
110      g in the closure can be substituted.
111   *)
112  type t
113
114  (* The freshening that does nothing. *)
115  val empty : t
116
117  (** Composition of two freshenings. *)
118  val compose : earlier:t -> later:t -> t
119
120  (** Freshen a closure ID based on the given renaming.  The same ID is
121      returned if the renaming does not affect it.
122      If dealing with approximations, you probably want to use
123      [Simple_value_approx.freshen_and_check_closure_id] instead of this
124      function.
125  *)
126  val apply_closure_id : t -> Closure_id.t -> Closure_id.t
127
128  (** Like [apply_closure_id], but for variables within closures. *)
129  val apply_var_within_closure
130     : t
131    -> Var_within_closure.t
132    -> Var_within_closure.t
133
134  val print : Format.formatter -> t -> unit
135end
136
137(* CR-soon mshinwell for mshinwell: add comment *)
138val apply_function_decls_and_free_vars
139   : t
140  -> (Flambda.specialised_to * 'a) Variable.Map.t
141  -> Flambda.function_declarations
142  -> only_freshen_parameters:bool
143  -> (Flambda.specialised_to * 'a) Variable.Map.t
144    * Flambda.function_declarations
145    * t
146    * Project_var.t
147
148val does_not_freshen : t -> Variable.t list -> bool
149
150val print : Format.formatter -> t -> unit
151
152(** N.B. This does not freshen the domain of the supplied map, only the
153    range. *)
154(* CR-someday mshinwell: consider fixing that *)
155val freshen_projection_relation
156   : Flambda.specialised_to Variable.Map.t
157  -> freshening:t
158  -> closure_freshening:Project_var.t
159  -> Flambda.specialised_to Variable.Map.t
160
161val freshen_projection_relation'
162   : (Flambda.specialised_to * 'a) Variable.Map.t
163  -> freshening:t
164  -> closure_freshening:Project_var.t
165  -> (Flambda.specialised_to * 'a) Variable.Map.t
166