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
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* 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 Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
type shape =
| Function
| Lazy
| Class
| Module of shape array
| Value of Obj.t
let rec init_mod_field modu i loc shape =
let init =
match shape with
| Function ->
let rec fn (x : 'a) =
let fn' : 'a -> 'b = Obj.obj (Obj.field modu i) in
if fn == fn' then
raise (Undefined_recursive_module loc)
else
fn' x in
Obj.repr fn
| Lazy ->
let rec l =
lazy (
let l' = Obj.obj (Obj.field modu i) in
if l == l' then
raise (Undefined_recursive_module loc)
else
Lazy.force l') in
Obj.repr l
| Class ->
Obj.repr (CamlinternalOO.dummy_class loc)
| Module comps ->
Obj.repr (init_mod_block loc comps)
| Value v -> v
in
Obj.set_field modu i init
and init_mod_block loc comps =
let length = Array.length comps in
let modu = Obj.new_block 0 length in
for i = 0 to length - 1 do
init_mod_field modu i loc comps.(i)
done;
modu
let init_mod loc shape =
match shape with
| Module comps ->
Obj.repr (init_mod_block loc comps)
| _ -> failwith "CamlinternalMod.init_mod: not a module"
let rec update_mod_field modu i shape n =
match shape with
| Function | Lazy ->
Obj.set_field modu i n
| Value _ ->
() (* the value is already there *)
| Class ->
assert (Obj.tag n = 0 && Obj.size n = 3);
let cl = Obj.field modu i in
for j = 0 to 2 do
Obj.set_field cl j (Obj.field n j)
done
| Module comps ->
update_mod_block comps (Obj.field modu i) n
and update_mod_block comps o n =
assert (Obj.tag n = 0 && Obj.size n >= Array.length comps);
for i = 0 to Array.length comps - 1 do
update_mod_field o i comps.(i) (Obj.field n i)
done
let update_mod shape o n =
match shape with
| Module comps ->
update_mod_block comps o n
| _ -> failwith "CamlinternalMod.update_mod: not a module"
|
