15
15
16
16
(* Translation from typed abstract syntax to lambda terms,
17
17
for the module language *)
18
-
18
+ #if BS_ONLY then
19
+ module Translobj = struct
20
+ let oo_wrap _env _b f a = f a
21
+ let reset_labels () : unit = ()
22
+ let transl_store_label_init _ _ _ _ : int * _ = assert false
23
+ let transl_label_init _ : _ * 'a = assert false
24
+ end
25
+ #end
19
26
open Misc
20
27
open Asttypes
21
28
open Longident
@@ -25,7 +32,7 @@ open Typedtree
25
32
open Lambda
26
33
open Translobj
27
34
open Translcore
28
- open Translclass
35
+
29
36
30
37
type error =
31
38
Circular_dependency of Ident .t
@@ -364,15 +371,15 @@ let rec bound_value_identifiers = function
364
371
365
372
366
373
(* Code to translate class entries in a structure *)
367
-
374
+ #if undefined BS_ONLY then
368
375
let transl_class_bindings cl_list =
369
376
let ids = List. map (fun (ci , _ ) -> ci.ci_id_class) cl_list in
370
377
(ids,
371
378
List. map
372
379
(fun ({ci_id_class =id ; ci_expr =cl ; ci_virt =vf } , meths ) ->
373
- (id, transl_class ids id meths cl vf))
380
+ (id, Translclass. transl_class ids id meths cl vf))
374
381
cl_list)
375
-
382
+ #end
376
383
(* Compile one or more functors, merging curried functors to produce
377
384
multi-argument functors. Any [@inline] attribute on a functor that is
378
385
merged must be consistent with any other [@inline] attribute(s) on the
@@ -632,13 +639,17 @@ and transl_structure loc fields cc rootpath final_env = function
632
639
body
633
640
in
634
641
lam, size
642
+ #if undefined BS_ONLY then
635
643
| Tstr_class cl_list ->
636
644
let (ids, class_bindings) = transl_class_bindings cl_list in
637
645
let body, size =
638
646
transl_structure loc (List. rev_append ids fields)
639
647
cc rootpath final_env rem
640
648
in
641
649
Lletrec (class_bindings, body), size
650
+ #else
651
+ | Tstr_class _ -> assert false
652
+ #end
642
653
| Tstr_include incl ->
643
654
let ids = bound_value_identifiers incl.incl_type in
644
655
let modl = incl.incl_mod in
@@ -972,14 +983,17 @@ let transl_store_structure glob map prims str =
972
983
bindings
973
984
(Lsequence (store_idents Location. none ids,
974
985
transl_store rootpath (add_idents true ids subst) rem))
986
+ #if BS_ONLY then
987
+ | Tstr_class _ -> assert false
988
+ #else
975
989
| Tstr_class cl_list ->
976
990
let (ids, class_bindings) = transl_class_bindings cl_list in
977
991
let lam =
978
992
Lletrec (class_bindings, store_idents Location. none ids)
979
993
in
980
994
Lsequence (subst_lambda subst lam,
981
995
transl_store rootpath (add_idents false ids subst) rem)
982
-
996
+ #end
983
997
| Tstr_include {
984
998
incl_loc= loc;
985
999
incl_mod= {
@@ -1235,12 +1249,16 @@ let transl_toplevel_item item =
1235
1249
(fun id modl _loc -> transl_module Tcoerce_none (Some (Pident id)) modl)
1236
1250
bindings
1237
1251
(make_sequence toploop_setvalue_id idents)
1252
+ #if BS_ONLY then
1253
+ | Tstr_class _ -> assert false
1254
+ #else
1238
1255
| Tstr_class cl_list ->
1239
1256
(* we need to use unique names for the classes because there might
1240
1257
be a value named identically *)
1241
1258
let (ids, class_bindings) = transl_class_bindings cl_list in
1242
1259
List. iter set_toplevel_unique_name ids;
1243
1260
Lletrec (class_bindings, make_sequence toploop_setvalue_id ids)
1261
+ #end
1244
1262
| Tstr_include incl ->
1245
1263
let ids = bound_value_identifiers incl.incl_type in
1246
1264
let modl = incl.incl_mod in
0 commit comments