Use antiquot (#10)

bn-d · May 12, 2023 · be1c628 · be1c628
1 parent 7f3891a
commit be1c628
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 20 deletions.
diff --git a/src/arg_type.ml b/src/arg_type.ml
@@ -5,19 +5,13 @@ type label_arg = Labelled | Optional of expression option
 type t = string loc * core_type * label_arg option
 
 let default_expression_of_core_type ~loc (ct : core_type) =
-  match ct.ptyp_desc with
-  | Ptyp_constr ({ txt = Lident "option"; _ }, _)
-  | Ptyp_constr ({ txt = Ldot (Lident "Option", "t"); _ }, _) ->
-      Some None
-  | Ptyp_constr ({ txt = Lident "list"; _ }, _)
-  | Ptyp_constr ({ txt = Ldot (Lident "List", "t"); _ }, _) ->
-      Some (Some [%expr []])
-  | Ptyp_constr ({ txt = Lident "array"; _ }, _)
-  | Ptyp_constr ({ txt = Ldot (Lident "Array", "t"); _ }, _) ->
+  match ct with
+  | [%type: [%t? _] option] | [%type: [%t? _] Option.t] -> Some None
+  | [%type: [%t? _] list] | [%type: [%t? _] List.t] -> Some (Some [%expr []])
+  | [%type: [%t? _] array] | [%type: [%t? _] Array.t] ->
+      (* need to make sure a new array is created every time *)
       Some (Some [%expr Array.of_list []])
-  | Ptyp_constr ({ txt = Lident "string"; _ }, [])
-  | Ptyp_constr ({ txt = Ldot (Lident "String", "t"); _ }, _) ->
-      Some (Some [%expr ""])
+  | [%type: string] | [%type: String.t] -> Some (Some [%expr ""])
   | _ -> None
 
 let get_attr (attrs : attribute list) =

diff --git a/src/deriver.ml b/src/deriver.ml
@@ -143,13 +143,12 @@ let str_item_of_core_type (name, params) (ct : core_type) : structure_item =
   Ast_helper.with_default_loc loc (fun () ->
       let pat = Ast_helper.Pat.var @@ Utils.gen_make_name name
       and fun_ct, expr =
-        match ct.ptyp_desc with
-        | Ptyp_tuple cts ->
+        match ct with
+        | { ptyp_desc = Ptyp_tuple cts; _ } ->
             (* T1 * ... * Tn *)
             ( fun_core_type_of_tuple ~loc (name, params) cts,
               fun_expression_of_tuple ~loc cts )
-        | Ptyp_constr ({ txt = Lident "option"; _ }, [ in_ct ])
-        | Ptyp_constr ({ txt = Ldot (Lident "Option", "t"); _ }, [ in_ct ]) ->
+        | [%type: [%t? in_ct] option] | [%type: [%t? in_ct] Option.t] ->
             (* T option *)
             ( fun_core_type_of_option ~loc (name, params) in_ct,
               fun_expression_of_option ~loc ct )
@@ -198,12 +197,11 @@ let str_item_of_variant_choice (name, params) (cd : constructor_declaration) :
 let sig_item_of_core_type (name, params) (ct : core_type) : signature_item =
   let loc = ct.ptyp_loc in
   Ast_helper.with_default_loc loc (fun () ->
-      (match ct.ptyp_desc with
-      | Ptyp_tuple cts ->
+      (match ct with
+      | { ptyp_desc = Ptyp_tuple cts; _ } ->
           (* T1 * ... * Tn *)
           fun_core_type_of_tuple ~loc (name, params) cts
-      | Ptyp_constr ({ txt = Lident "option"; _ }, [ in_ct ])
-      | Ptyp_constr ({ txt = Ldot (Lident "Option", "t"); _ }, [ in_ct ]) ->
+      | [%type: [%t? in_ct] option] | [%type: [%t? in_ct] Option.t] ->
           (* T option *)
           fun_core_type_of_option ~loc (name, params) in_ct
       | _ -> Utils.unsupported_error "core type" name)