1.
The Cpsfree
module computes a map associating each lambda with the set
of free variables used in the body of this lambda.
let doubleton x y = VarSet.add x (VarSet.singleton y)
m1
and m2
are
disjoint.
let merge_map m1 m2 = VarMap.fold (fun key value map →
assert( ¬( VarMap.mem key map));
VarMap.add key value map) m1 m2
expression t
returns a pair:t
Lambda
to the free variables in the lambda.
The expression is traverse using a depth-first traversal (that enter into
Lambda
s), and the set and the map are built bottom-up.
In the case of a recursive or mutually recursive values (lambdas,
injections, tuples), the recursive bindings are considered to
be free in the value (and especially in the lambda).
let rec expression t = match Expression.get t with
∣ Let_prim(x,Value(Lambda(_,_,vl,bodylambda)),body) →
let (set,map) = (expression bodylambda) in
(∗ Remove arguments from the free variables of bodylambda
. ∗)
let set = List.fold_left (fun set v → VarSet.remove v set) set vl in
Log.Free_variables.debug "Free variables for %s: [%a] \n"
(Var.Var.to_string x)
(Make_printer.list ~sep:", " (Make_printer.from_string Var.Var.to_string))
(VarSet.elements set);
(∗ x
is still considered free in bodylambda
: it is removed from
set
, but after being added to map
. ∗)
let map = VarMap.add x set map in
let (set_body, map_body) = expression body in
let set = VarSet.remove x (VarSet.union set set_body) in
let map = merge_map map_body map in
(set,map)
∣ Let_prim(x,p,body) →
let set_prim = prim p in
let (set_body, map_body) = expression body in
let set = VarSet.remove x (VarSet.union set_prim set_body) in
let map = map_body in
(set,map)
∣ Let_cont(_,x,t,body) →
let (set_t, map_t) = expression t in
let (set_body, map_body) = expression body in
let set = (VarSet.union set_body (VarSet.remove x set_t)) in
let map = merge_map map_body map_t in
(set,map)
∣ Apply_cont(_,x) → VarSet.singleton (var x), VarMap.empty
∣ Case(o,_,default) →
let set = VarSet.singleton (var o) in
set, VarMap.empty
∣ Apply(_,f,_,xl) →
let set = List.fold_left
(fun set x → VarSet.add (var x) set) VarSet.empty xl in
VarSet.add (var f) set, VarMap.empty
Lambda
case is already handled above).
and prim = function
∣ Integer_binary_operation(_, a,b)
∣ Integer_binary_predicate(_, a,b) → doubleton (var a) (var b)
∣ Projection(_,x) → VarSet.singleton (var x)
∣ Value v → value v
and value = function
∣ Constant(_) ∣ External(_) → VarSet.empty
∣ Tuple(l) → (List.fold_left
(fun set occ → VarSet.add (var occ) set)
VarSet.empty l )
∣ Lambda(_,_,vl,bodylambda) → assert false (∗ This case is already handled. ∗)
∣ Injection(_,_,x) → VarSet.singleton (var x)