test

.vscode/settings.json

@@ -0,0 +1,5 @@
+{
+    "ocaml.sandbox": {
+        "kind": "global"
+    }
+}

bin/dune

@@ -1,4 +1,5 @@
 (executable
  (public_name poplpaper)
  (name main)
- (libraries poplpaper))
+ (libraries ppx_poplpaper)
+ (preprocess (pps ppx_poplpaper)))

dune-project

@@ -1 +1,5 @@
 (lang dune 2.9)
+
+(name ppx_poplpaper)
+
+(generate_opam_files true)

flake.nix

@@ -7,7 +7,11 @@
       in {
         devShell = pkgs.mkShell {
           inputsFrom = with flakePkgs; [ main ];
-          packages = with pkgs; [ ocamlPackages.ocaml-lsp ];
+          packages = (with pkgs; [ ]) ++ (with pkgs.ocamlPackages; [ocaml-lsp ppxlib
+          alcotest
+          yojson
+          ezjsonm
+          ]);
         };
       });
 }

lib/dune

@@ -1,2 +1,6 @@
 (library
- (name poplpaper))
+ (name ppx_poplpaper)
+ (public_name ppx_poplpaper)
+ (kind ppx_rewriter)
+ (libraries ppxlib)
+ (preprocess (pps ppxlib.metaquot)))

lib/ppx_poplpaper.ml

@@ -0,0 +1,19 @@
+(* https://tarides.com/blog/2019-05-09-an-introduction-to-ocaml-ppx-ecosystem/ *)
+
+open Ppxlib
+
+let expand ~ctxt:_ (expr: expression) =
+  expr
+
+let ext = Extension.V3.declare
+  "monomorphic"
+  Extension.Context.expression
+  Ast_pattern.(single_expr_payload __)
+  expand
+
+let rule = Context_free.Rule.extension ext
+
+let () =
+  Driver.register_transformation
+    ~rules:[rule]
+    "monomorphic"

ppx_poplpaper.opam

@@ -0,0 +1,22 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+depends: [
+  "dune" {>= "2.9"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "--promote-install-files=false"
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+  ["dune" "install" "-p" name "--create-install-files" name]
+]

test/bin/dune

@@ -0,0 +1,4 @@
+(executable
+ (name pp)
+ (modules pp)
+ (libraries ppx_poplpaper ppxlib))

test/bin/pp.ml

@@ -0,0 +1 @@
+Ppxlib.Driver.standalone ()

test/dune

@@ -1,2 +1,13 @@
+(rule
+ (targets test.actual.ml)
+ (deps test.ml)
+ (action (run ./bin/pp.exe --impl %{deps} -o %{targets})))
+
+(rule
+ (alias runtest)
+ (action (diff test.expected.ml test.actual.ml)))
+
 (test
- (name poplpaper))
+ (name test)
+ (modules test)
+ (preprocess (pps ppx_poplpaper)))

test/test.ml

@@ -0,0 +1,2 @@
+let%monomorphic prop0 (f : 'a -> 'b) (xs : 'a List.t) : bool =
+  List.length (List.map f xs) = 0