unikernel/duniverse/ppxlib/test/deriving/inline/foo-deriver/dune

@@ -0,0 +1,5 @@
+(library
+ (package ppxlib)
+ (kind ppx_deriver)
+ (name ppx_foo_deriver)
+ (libraries ppxlib))

unikernel/duniverse/ppxlib/test/deriving/inline/foo-deriver/ppx_foo_deriver.ml

@@ -0,0 +1,99 @@
+open Ppxlib
+open Ast_builder.Default
+
+(*
+   [[@@deriving foo]] expands to:
+   {[
+     module Foo = struct end
+
+     let _ = (); (); [%foo]
+   ]}
+
+   and then [[%foo]] expands to ["foo"].
+*)
+
+let add_deriver () =
+  let str_type_decl =
+    Deriving.Generator.make_noarg
+      (fun ~loc ~path:_ _ ->
+        let expr desc : expression =
+          {
+            pexp_desc = desc;
+            pexp_loc = loc;
+            pexp_attributes = [];
+            pexp_loc_stack = [];
+          }
+        in
+        [
+          {
+            pstr_loc = loc;
+            pstr_desc =
+              Pstr_module
+                {
+                  pmb_loc = loc;
+                  pmb_name = { loc; txt = Some "Foo" };
+                  pmb_expr =
+                    {
+                      pmod_loc = loc;
+                      pmod_desc = Pmod_structure [];
+                      pmod_attributes = [];
+                    };
+                  pmb_attributes = [];
+                };
+          };
+          {
+            pstr_loc = loc;
+            pstr_desc =
+              Pstr_value
+                ( Nonrecursive,
+                  [
+                    {
+                      pvb_pat =
+                        {
+                          ppat_desc = Ppat_any;
+                          ppat_loc = loc;
+                          ppat_attributes = [];
+                          ppat_loc_stack = [];
+                        };
+                      pvb_expr =
+                        esequence ~loc
+                          [
+                            eunit ~loc;
+                            eunit ~loc;
+                            expr
+                              (Pexp_extension ({ loc; txt = "foo" }, PStr []));
+                          ];
+                      pvb_attributes = [];
+                      pvb_loc = loc;
+                      pvb_constraint = None;
+                    };
+                  ] );
+          };
+        ])
+      ~attributes:[]
+  in
+  let sig_type_decl =
+    Deriving.Generator.make_noarg (fun ~loc ~path decl ->
+        ignore loc;
+        ignore path;
+        ignore decl;
+        [])
+  in
+  Deriving.add "foo" ~str_type_decl ~sig_type_decl
+
+let () =
+  Driver.register_transformation "foo"
+    ~rules:
+      [
+        Context_free.Rule.extension
+          (Extension.declare "foo" Expression Ast_pattern.__
+             (fun ~loc ~path:_ _payload ->
+               {
+                 pexp_desc = Pexp_constant (Pconst_string ("foo", loc, None));
+                 pexp_loc = loc;
+                 pexp_attributes = [];
+                 pexp_loc_stack = [];
+               }));
+      ]
+
+let (_ : Deriving.t) = add_deriver ()