diff options
Diffstat (limited to 'kernel/csymtable.ml')
| -rw-r--r-- | kernel/csymtable.ml | 19 |
1 files changed, 14 insertions, 5 deletions
diff --git a/kernel/csymtable.ml b/kernel/csymtable.ml index 6c9e73b50d..978c2c9f57 100644 --- a/kernel/csymtable.ml +++ b/kernel/csymtable.ml @@ -135,12 +135,12 @@ let rec slot_for_getglobal env kn = match cb.const_body_code with | None -> set_global (val_of_constant kn) | Some code -> - match Cemitcodes.force code with - | BCdefined(code,pl,fv) -> + match Cemitcodes.force code with + | BCdefined(code,pl,fv) -> let v = eval_to_patch env (code,pl,fv) in set_global v - | BCalias kn' -> slot_for_getglobal env kn' - | BCconstant -> set_global (val_of_constant kn) + | BCalias kn' -> slot_for_getglobal env kn' + | BCconstant -> set_global (val_of_constant kn) in (*Pp.msgnl(str"value stored at: "++int pos);*) rk := Some (CEphemeron.create pos); @@ -184,7 +184,16 @@ and eval_to_patch env (buff,pl,fv) = | Reloc_proj_name p -> slot_for_proj_name p in let tc = patch buff pl slots in - let vm_env = Array.map (slot_for_fv env) fv in + let vm_env = + (* Beware, this may look like a call to [Array.map], but it's not. + Calling [Array.map f] when the first argument returned by [f] + is a float would lead to [vm_env] being an unboxed Double_array + (Tag_val = Double_array_tag) whereas eval_tcode expects a + regular array (Tag_val = 0). + See test-suite/primitive/float/coq_env_double_array.v + for an actual instance. *) + let a = Array.make (Array.length fv) crazy_val in + Array.iteri (fun i v -> a.(i) <- slot_for_fv env v) fv; a in eval_tcode tc (get_atom_rel ()) (vm_global global_data.glob_val) vm_env and val_of_constr env c = |