- let strs = List.map (
- fun (struct_name, sflist, cflist) ->
- let sflist = List.map (
- fun { SC.sf_name = sf_name; sf_fields = fields } ->
- if fields <> [] then (
- let fields = List.map (
- fun (name, t) ->
- match t with
- | PP.FListHeadPointer _ ->
- (* A list head turns into three fields, the pointer,
- * the offset within current struct, and the adjustment
- * (offset within destination struct).
- *)
- let t = ocaml_type_of_field_type t in
- [ <:ctyp< $lid:sf_name^"_"^name$ : $t$ >>;
- <:ctyp< $lid:sf_name^"_"^name^"_offset"$ : int >>;
- <:ctyp< $lid:sf_name^"_"^name^"_adjustment"$ : int >> ]
- | _ ->
- let t = ocaml_type_of_field_type t in
- [ <:ctyp< $lid:sf_name^"_"^name$ : $t$ >> ]
- ) fields in
- let fields = List.concat fields in
- let fields = concat_record_fields fields in
-
- <:str_item<
- type $lid:sf_name$ = { $fields$ }
- >>
- ) else
- <:str_item< type $lid:sf_name$ = unit >>
- ) sflist in
- let sflist = concat_str_items sflist in
-
- let cflist = List.map (
- fun { SC.cf_name = cf_name; cf_fields = fields } ->
- if fields <> [] then (
- let fields = List.map (
- fun (name, t) ->
- let t = ocaml_type_of_field_type t in
- <:ctyp< $lid:cf_name^"_"^name$ : $t$ >>
- ) fields in
- let fields = concat_record_fields fields in
-
- <:str_item<
- type $lid:cf_name$ = { $fields$ }
- >>
- ) else
- <:str_item< type $lid:cf_name$ = unit >>
- ) cflist in
- let cflist = concat_str_items cflist in
+ let types = List.map (
+ fun (struct_name, all_fields) ->
+ let fields = List.map (
+ fun (name, (typ, always_available)) ->
+ match typ with
+ | PP.FListHeadPointer _ ->
+ (* A list head turns into three fields, the pointer,
+ * the offset within current struct, and the adjustment
+ * (offset within destination struct).
+ *)
+ let t = ocaml_type_of_field_type (typ, always_available) in
+ [ <:ctyp< $lid:struct_name^"_"^name$ : $t$ >>;
+ <:ctyp< $lid:struct_name^"_"^name^"_offset"$ : int >>;
+ <:ctyp< $lid:struct_name^"_"^name^"_adjustment"$ : int >> ]
+ | _ ->
+ let t = ocaml_type_of_field_type (typ, always_available) in
+ [ <:ctyp< $lid:struct_name^"_"^name$ : $t$ >> ]
+ ) all_fields in
+ let fields = List.concat fields in
+ let fields = concat_record_fields fields in