-
Notifications
You must be signed in to change notification settings - Fork 125
/
flat_RecordGeneration.ml
86 lines (69 loc) · 2.52 KB
/
flat_RecordGeneration.ml
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
(*
Copyright © 2011 MLstate
This file is part of OPA.
OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.
OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(* CF mli *)
(* depends *)
module List = Base.List
(* refactoring in progress *)
(* alias *)
module ServerLib = Flat_Common.ServerLib
(* shorthands *)
module Q = QmlAst
(* -- *)
type label = Flat_Common.label
let cmp (f1, _) (f2, _) = String.compare f1 f2
let may_be_simple ~info label value =
let vtable = Ocaml.make_repr (Flat_Shared.vtable [ label ]) in
let info =
match info with
| Some info -> Ocaml.make_repr (Ocaml.Cons.some info)
| None -> Ocaml.make_repr Ocaml.Cons.none
in
let value = Ocaml.make_repr value in
let anarray = Ocaml.AnArray [ vtable ; info ; value ] in
Ocaml.Cons.app ServerLib.may_be_simple anarray
let static_init ~is_lazy ~info fields =
match fields with
(*
The function ServerLib.unsafe_init_static cannot be called with 0 or 1 argument,
This would corrupt the sharing.
*)
| [] ->
ServerLib.empty
| [ label, value ] ->
may_be_simple ~info:None label value
(* *)
| _ ->
let fields = List.stable_sort cmp fields in
let fields = List.uniq ~cmp fields in
let fields, values = List.split fields in
let vtable = Ocaml.make_repr (Flat_Shared.vtable fields) in
let info =
match info with
| Some info -> Ocaml.make_repr (Ocaml.Cons.some info)
| None -> Ocaml.make_repr Ocaml.Cons.none
in
let values =
if is_lazy
then
List.map (fun value -> Ocaml.make_repr (Ocaml.Lazy value)) values
else
List.map Ocaml.make_repr values
in
let anarray = Ocaml.AnArray ( vtable :: info :: values ) in
Ocaml.Cons.app ServerLib.unsafe_init_static anarray
let extend record fields =
let fields = List.stable_sort cmp fields in
let fields = List.uniq ~cmp fields in
let extend = List.map (fun (f, e) -> Ocaml.Cons.tuple [ Flat_Shared.field f ; e ]) fields in
Ocaml.Cons.app3 ServerLib.extend_with_array record (Ocaml.AnArray extend)