ocaml/stdlib/camlinternalMod.ml

61 lines
2.3 KiB
OCaml

(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2004 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License, with *)
(* the special exception on linking described in file ../LICENSE. *)
(* *)
(***********************************************************************)
(* $Id$ *)
type shape =
| Function
| Lazy
| Class
| Module of shape array
let rec init_mod loc shape =
match shape with
| Function ->
let pad1 = 1 and pad2 = 2 and pad3 = 3 and pad4 = 4
and pad5 = 5 and pad6 = 6 and pad7 = 7 and pad8 = 8 in
Obj.repr(fun _ ->
ignore pad1; ignore pad2; ignore pad3; ignore pad4;
ignore pad5; ignore pad6; ignore pad7; ignore pad8;
raise (Undefined_recursive_module loc))
| Lazy ->
Obj.repr (lazy (raise (Undefined_recursive_module loc)))
| Class ->
Obj.repr (CamlinternalOO.dummy_class loc)
| Module comps ->
Obj.repr (Array.map (init_mod loc) comps)
let overwrite o n =
assert (Obj.size o >= Obj.size n);
for i = 0 to Obj.size n - 1 do
Obj.set_field o i (Obj.field n i)
done
let rec update_mod shape o n =
match shape with
| Function ->
if Obj.tag n = Obj.closure_tag && Obj.size n <= Obj.size o
then begin overwrite o n; Obj.truncate o (Obj.size n) (* PR #4008 *) end
else overwrite o (Obj.repr (fun x -> (Obj.obj n : _ -> _) x))
| Lazy ->
assert (Obj.tag n = Obj.lazy_tag);
overwrite o n
| Class ->
assert (Obj.tag n = 0 && Obj.size n = 4);
overwrite o n
| Module comps ->
assert (Obj.tag n = 0 && Obj.size n >= Array.length comps);
for i = 0 to Array.length comps - 1 do
update_mod comps.(i) (Obj.field o i) (Obj.field n i)
done