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