Nicer API

Author: Leonidas-from-XIV

src/loader/cmi.ml

@@ -757,11 +757,7 @@ let read_value_description ({ident_env ; warnings_tag} as env) parent id vd =
         External primitives
     | _ -> assert false
   in
-  let zero_alloc = Doc_attr.known_attribute vd in
-  let ext_attr = match zero_alloc with
-    | Some za -> [za]
-    | None -> []
-  in
+  let ext_attr = Doc_attr.attrs_of_value_description vd in
   Value { Value.id; source_loc; doc; type_; value; ext_attr }
 
 #if defined OXCAML

src/loader/cmti.ml

@@ -233,11 +233,7 @@ let read_value_description env parent vd =
     | [] -> Value.Abstract
     | primitives -> External primitives
   in
-  let zero_alloc = Doc_attr.known_attribute vd.val_val in
-  let ext_attr = match zero_alloc with
-    | Some za -> [za]
-    | None -> []
-  in
+  let ext_attr = Doc_attr.attrs_of_value_description vd.val_val in
   Value { Value.id; source_loc; doc; type_; value; ext_attr }
 
 let read_type_parameter (ctyp, var_and_injectivity)  =

src/loader/doc_attr.ml

@@ -74,7 +74,7 @@ let attribute_unpack = function
   | { Location.txt = name; loc }, attr_payload -> (name, attr_payload, loc)
 #endif
 
-let known_attribute (vd : Types.value_description) =
+let attrs_of_value_description (vd : Types.value_description) =
   let zero_alloc = match vd.val_zero_alloc |> Zero_alloc.get with
     | Default_zero_alloc -> None
     | Ignore_assert_all -> None
@@ -84,8 +84,8 @@ let known_attribute (vd : Types.value_description) =
         Some ( Lang.Value.Zero_alloc.{ opt; strict; arity; custom_error_msg })
   in
   match zero_alloc with
-  | Some za -> Some (Lang.Value.Zero_alloc za)
-  | None -> None
+  | Some za -> [Lang.Value.Zero_alloc za]
+  | None -> []
 
 type payload = string * Location.t
 

src/loader/doc_attr.mli

@@ -93,4 +93,4 @@ type parsed_attribute =
   ]
 
 val parse_attribute : Parsetree.attribute -> parsed_attribute option
-val known_attribute : Types.value_description -> Lang.Value.attr option
+val attrs_of_value_description : Types.value_description -> Lang.Value.attr list