Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 103 lines (81 sloc) 2.357 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
4 This file is part of Opa.
fccc685 Initial open-source release
MLstate authored
5
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
6 Opa is free software: you can redistribute it and/or modify it under the
fccc685 Initial open-source release
MLstate authored
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
10 Opa is distributed in the hope that it will be useful, but WITHOUT ANY
fccc685 Initial open-source release
MLstate authored
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
5bb0f1a @Aqua-Ye [cleanup] compiler: typo on Opa
Aqua-Ye authored
16 along with Opa. If not, see <http://www.gnu.org/licenses/>.
fccc685 Initial open-source release
MLstate authored
17 *)
18 (* CF mli *)
19
20 (* Annotation *)
21 type t = int
22 let next =
23 let r = ref 0 in
24 (fun () ->
25 let i = !r in
26 incr(r);
27 i)
28 let to_string x = "#" ^ string_of_int x
29 let hash = Hashtbl.hash
30 let equal : int -> int -> bool = (=)
31 let compare : int -> int -> int = compare
32 external to_int : t -> int = "%identity"
33
34 module AnnotMap = IntMap
35 module AnnotSet = IntSet
36
37 (* AST *)
38 type pos = FilePos.pos
39
40 type label = {
41 annot : t ;
42 pos : pos ;
43 }
44
45 let annot label = label.annot
46 let pos label = label.pos
47 let make_label annot pos = {
48 annot ;
49 pos ;
50 }
51
52 let next_label pos = {
53 annot = next () ;
54 pos = pos ;
55 }
56
57 let refresh label = next_label label.pos
58
59 let nolabel s = next_label (FilePos.nopos s)
60
61 module Magic =
62 struct
63
64 external label : 'a -> label = "%field0"
65
66 external imp_reset_label : Obj.t -> label -> unit = "%setfield0"
67
68 let annot ast =
69 let label = label ast in
70 label.annot
71
72 (*
73 Obj.dup reallocate a fresh block of the same size, and make a shallow copy of fields.
74 cf in ocaml/byterun/obj.c, function caml_obj_dup
75 *)
76 let new_label ast label =
77 let ast = Obj.dup (Obj.repr ast) in
78 imp_reset_label ast label;
79 Obj.obj ast
80
81 let new_annot ast t =
82 let label = label ast in
83 let label = { label with annot = t } in
84 new_label ast label
85
86 let pos ast =
87 let label = label ast in
88 label.pos
89
90 let new_pos ast pos =
91 let label = label ast in
92 let label = { label with pos = pos } in
93 new_label ast label
94
95 let merge_pos ast pos =
96 let label = label ast in
97 let pos = FilePos.merge_pos pos label.pos in
98 let label = { label with pos = pos } in
99 let ast = Obj.dup (Obj.repr ast) in
100 imp_reset_label ast label;
101 Obj.obj ast
102 end
Something went wrong with that request. Please try again.