diff options
| -rw-r--r-- | asmcomp/closure.ml | 40 |
1 files changed, 33 insertions, 7 deletions
diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml index e12fa3bbc..e76907ba3 100644 --- a/asmcomp/closure.ml +++ b/asmcomp/closure.ml @@ -530,6 +530,13 @@ let approx_ulam = function Uconst c -> Value_const c | _ -> Value_unknown +let find_action idxs acts tag = + let res = ref None in + for i = 0 to Array.length idxs - 1 do + if idxs.(i) = tag then res := Some acts.(i) + done; + !res + let rec substitute fpc sb ulam = match ulam with Uvar v -> @@ -574,13 +581,32 @@ let rec substitute fpc sb ulam = simplif_prim fpc p (sargs, List.map approx_ulam sargs) dbg in res | Uswitch(arg, sw) -> - Uswitch(substitute fpc sb arg, - { sw with - us_actions_consts = - Array.map (substitute fpc sb) sw.us_actions_consts; - us_actions_blocks = - Array.map (substitute fpc sb) sw.us_actions_blocks; - }) + let sarg = substitute fpc sb arg in + let action = + (* Unfortunately, we cannot easily deal with the + case of a constructed block (makeblock) bound to a local + identifier. This would require to keep track of + local let bindings (at least their approximations) + in this substitute function. + *) + match sarg with + | Uconst (Uconst_ref (_, Uconst_block (tag, _))) -> + find_action sw.us_index_blocks sw.us_actions_blocks tag + | Uconst (Uconst_ptr tag) -> + find_action sw.us_index_consts sw.us_actions_consts tag + | _ -> None + in + begin match action with + | Some u -> substitute fpc sb u + | None -> + Uswitch(sarg, + { sw with + us_actions_consts = + Array.map (substitute fpc sb) sw.us_actions_consts; + us_actions_blocks = + Array.map (substitute fpc sb) sw.us_actions_blocks; + }) + end | Ustringswitch(arg,sw,d) -> Ustringswitch (substitute fpc sb arg, |