Cleanup and new tests

cppo.opam

@@ -1,20 +1,5 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-build: [
-  ["dune" "subst"] {pinned}
-  ["dune" "build" "-p" name "-j" jobs]
-  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
-  ["dune" "build" "-p" name "@doc"] {with-doc}
-]
-maintainer: [
-  "Martin Jambon <[email protected]>" "Yishuai Li <[email protected]>"
-]
-authors: ["Martin Jambon"]
-bug-reports: "https://github.com/ocaml-community/cppo/issues"
-homepage: "https://github.com/ocaml-community/cppo"
-doc: "https://ocaml-community.github.io/cppo"
-license: "BSD-3-Clause"
-dev-repo: "git+https://github.com/ocaml-community/cppo.git"
 synopsis: "Code preprocessor like cpp for OCaml"
 description: """
 Cppo is an equivalent of the C preprocessor for OCaml programs.
@@ -27,8 +12,31 @@ Cppo is:
 * reasonably fast
 * simple to install and to maintain
 """
+maintainer: [
+  "Martin Jambon <[email protected]>" "Yishuai Li <[email protected]>"
+]
+authors: ["Martin Jambon"]
+license: "BSD-3-Clause"
+homepage: "https://github.com/ocaml-community/cppo"
+doc: "https://ocaml-community.github.io/cppo"
+bug-reports: "https://github.com/ocaml-community/cppo/issues"
 depends: [
   "ocaml" {>= "4.02.3"}
-  "dune" {>= "1.10"}
+  "dune" {>= "2.0"}
   "base-unix"
 ]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/ocaml-community/cppo.git"

cppo_ocamlbuild.opam

@@ -1,30 +1,38 @@
 # This file is generated by dune, edit dune-project instead
 opam-version: "2.0"
-build: [
-  ["dune" "subst"] {pinned}
-  ["dune" "build" "-p" name "-j" jobs]
-  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
-  ["dune" "build" "-p" name "@doc"] {with-doc}
-]
-maintainer: [
-  "Martin Jambon <[email protected]>" "Yishuai Li <[email protected]>"
-]
-authors: ["Martin Jambon"]
-bug-reports: "https://github.com/ocaml-community/cppo/issues"
-homepage: "https://github.com/ocaml-community/cppo"
-doc: "https://ocaml-community.github.io/cppo"
-license: "BSD-3-Clause"
-dev-repo: "git+https://github.com/ocaml-community/cppo.git"
 synopsis: "Plugin to use cppo with ocamlbuild"
 description: """
 This ocamlbuild plugin lets you use cppo in ocamlbuild projects.
 
 To use it, you can call ocamlbuild with the argument `-plugin-tag
 package(cppo_ocamlbuild)` (only since ocaml 4.01 and cppo >= 0.9.4).
 """
+maintainer: [
+  "Martin Jambon <[email protected]>" "Yishuai Li <[email protected]>"
+]
+authors: ["Martin Jambon"]
+license: "BSD-3-Clause"
+homepage: "https://github.com/ocaml-community/cppo"
+doc: "https://ocaml-community.github.io/cppo"
+bug-reports: "https://github.com/ocaml-community/cppo/issues"
 depends: [
   "ocaml"
   "dune" {>= "1.10"}
   "ocamlbuild"
   "ocamlfind"
 ]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/ocaml-community/cppo.git"

dune-project

@@ -1,4 +1,4 @@
-(lang dune 1.10)
+(lang dune 2.0)
 (name cppo)
 
 (generate_opam_files true)
@@ -15,7 +15,7 @@
  (name cppo)
  (depends
   (ocaml (>= 4.02.3))
-  (dune  (>= 1.10))
+  (dune  (>= 2.0))
    base-unix)
  (synopsis "Code preprocessor like cpp for OCaml")
  (description "Cppo is an equivalent of the C preprocessor for OCaml programs.

src/cppo_eval.ml

@@ -5,35 +5,56 @@ open Cppo_types
 module S = Set.Make (String)
 module M = Map.Make (String)
 
-let builtins = [
-  "__FILE__", (fun _env -> `Special);
-  "__LINE__", (fun _env -> `Special);
-  "STRINGIFY", (fun env ->
-                  `Defun (dummy_loc, "STRINGIFY",
-                          ["x"],
-                          [`Stringify (`Ident (dummy_loc, "x", None))],
-                          env)
-               );
-  "CONCAT", (fun env ->
-               `Defun (dummy_loc, "CONCAT",
-                       ["x";"y"],
-                       [`Concat (`Ident (dummy_loc, "x", None),
-                                 `Ident (dummy_loc, "y", None))],
-                       env)
-            );
-  "CAPITALIZE", (fun env ->
-    `Defun (dummy_loc, "CAPITALIZE",
-            ["x"],
-            [`Capitalize (`Ident (dummy_loc, "x", None))],
-            env)
-  );
-
+let find_opt name env =
+  try Some (M.find name env)
+  with Not_found -> None
+
+(* An environment entry. *)
+
+(* In a macro definition [EDef (loc, formals, body, env)],
+
+   + [loc] is the location of the macro definition,
+   + [formals] is the list of formal parameters,
+   + [body] and [env] represent the closed body of the macro definition. *)
+
+type entry =
+  | EDef of loc * formals * body * env
+
+(* An environment is a map of (macro) names to environment entries. *)
+
+and env =
+  entry M.t
+
+let ident x =
+  `Ident (dummy_loc, x, [])
+
+let dummy_defun formals body env =
+  EDef (dummy_loc, formals, body, env)
+
+let builtins : (string * (env -> entry)) list = [
+  "STRINGIFY",
+  dummy_defun
+    ["x"]
+    [`Stringify (ident "x")]
+  ;
+  "CONCAT",
+  dummy_defun
+    ["x";"y"]
+    [`Concat (ident "x", ident "y")]
+  ;
+  "CAPITALIZE",
+  dummy_defun
+    ["x"]
+    [`Capitalize (ident "x")]
+  ;
 ]
 
 let is_reserved s =
+  s = "__FILE__" ||
+  s = "__LINE__" ||
   List.exists (fun (s', _) -> s = s') builtins
 
-let builtin_env =
+let builtin_env : env =
   List.fold_left (fun env (s, f) -> M.add s (f env) env) M.empty builtins
 
 let line_directive buf pos =
@@ -50,6 +71,21 @@ let rec add_sep sep last = function
   | [x] -> [ x; last ]
   | x :: l -> x :: sep :: add_sep sep last l
 
+(* Transform a list of actual macro arguments back into ordinary text,
+   after discovering that they are not macro arguments after all. *)
+let text loc name actuals : node list =
+  match actuals with
+  | [] ->
+      [`Text (loc, false, name)]
+  | _ :: _ ->
+      let with_sep =
+        add_sep
+          [`Text (loc, false, ",")]
+          [`Text (loc, false, ")")]
+          actuals
+      in
+      `Text (loc, false, name ^ "(") ::
+      List.flatten with_sep
 
 let remove_space l =
   List.filter (function `Text (_, true, _) -> false | _ -> true) l
@@ -139,13 +175,13 @@ let concat loc x y =
 *)
 let rec eval_ident env loc name =
   let l =
-    try
-      match M.find name env with
-      | `Def (_, _, l, _) -> l
-      | `Defun _ ->
-          error loc (sprintf "%S expects arguments" name)
-      | `Special -> assert false
-    with Not_found -> error loc (sprintf "Undefined identifier %S" name)
+    match find_opt name env with
+    | Some (EDef (_loc, [], body, _env)) ->
+        body
+    | Some (EDef _) ->
+        error loc (sprintf "%S expects arguments" name)
+    | None ->
+        error loc (sprintf "Undefined identifier %S" name)
   in
   let expansion_error () =
     error loc
@@ -157,7 +193,7 @@ or into a variable with the same properties."
   in
   (try
      match remove_space l with
-       [ `Ident (loc, name, None) ] ->
+       [ `Ident (loc, name, []) ] ->
          (* single identifier that we expand recursively *)
          eval_ident env loc name
      | _ ->
@@ -401,6 +437,27 @@ let expand_ext g loc id data =
     | _ ->
         failwith (sprintf "Command %S failed" cmd)
 
+let check_arity loc name (formals : _ list) (actuals : _ list) =
+  let formals = List.length formals
+  and actuals = List.length actuals in
+  if formals <> actuals then
+    sprintf "%S expects %i argument%s but is applied to %i argument%s."
+      name formals (plural formals) actuals (plural actuals)
+    |> error loc
+
+(* [bind_one formal (loc, actual, env) accu] binds one formal parameter
+   to one actual argument, extending the environment [accu]. This formal
+   parameter becomes an ordinary (unparameterized) macro. *)
+let bind_one formal (loc, actual, env) accu =
+  M.add formal (EDef (loc, [], actual, env)) accu
+
+(* [bind_many formals (loc, actuals, env) accu] a tuple of formal parameters
+   to a tuple of actual arguments, extending the environment [accu]. *)
+let bind_many formals (loc, actuals, env) accu =
+  List.fold_left2 (fun accu formal actual ->
+    bind_one formal (loc, actual, env) accu
+  ) accu formals actuals
+
 let rec include_file g loc rel_file env =
   let file =
     if not (Filename.is_relative rel_file) then
@@ -441,12 +498,9 @@ and expand_list ?(top = false) g env l =
 
 and expand_node ?(top = false) g env0 (x : node) =
   match x with
-      `Ident (loc, name, opt_args) ->
+      `Ident (loc, name, actuals) ->
 
-        let def =
-          try Some (M.find name env0)
-          with Not_found -> None
-        in
+        let def = find_opt name env0 in
         let g =
           if top && def <> None || g.call_loc == dummy_loc then
             { g with call_loc = loc }
@@ -468,57 +522,27 @@ and expand_node ?(top = false) g env0 (x : node) =
         );
 
         let env =
-          match def, opt_args with
-              None, None ->
-                expand_node g env0 (`Text (loc, false, name))
-            | None, Some args ->
-                let with_sep =
-                  add_sep
-                    [`Text (loc, false, ",")]
-                    [`Text (loc, false, ")")]
-                    args in
-                let l =
-                  `Text (loc, false, name ^ "(") :: List.flatten with_sep in
-                expand_list g env0 l
-
-            | Some (`Defun (_, _, arg_names, _, _)), None ->
-                error loc
-                  (sprintf "%S expects %i arguments but is applied to none."
-                     name (List.length arg_names))
-
-            | Some (`Def _), Some _ ->
-                error loc
-                  (sprintf "%S expects no arguments" name)
-
-            | Some (`Def (_, _, l, env)), None ->
-                ignore (expand_list g env l);
-                env0
-
-            | Some (`Defun (_, _, arg_names, l, env)), Some args ->
-                let argc = List.length arg_names in
-                let n = List.length args in
-                let args =
-                  (* it's ok to pass an empty arg if one arg
-                     is expected *)
-                  if n = 0 && argc = 1 then [[]]
-                  else args
-                in
-                if argc <> n then
-                  error loc
-                    (sprintf "%S expects %i argument%s but is applied to \
-                              %i argument%s."
-                       name argc (plural argc) n (plural n))
-                else
-                  let app_env =
-                    List.fold_left2 (
-                      fun env name l ->
-                        M.add name (`Def (loc, name, l, env0)) env
-                    ) env arg_names args
-                  in
-                  ignore (expand_list g app_env l);
-                  env0
-
-            | Some `Special, _ -> assert false
+          match def with
+
+          | None ->
+              (* There is no definition for the macro [name], so this is not
+                 a macro application after all. Transform it back into text,
+                 and process it. *)
+              expand_list g env0 (text loc name actuals)
+
+          | Some (EDef (_loc, formals, body, env)) ->
+              (* There is a definition for the macro [name], so this is a
+                 macro application. *)
+              check_arity loc name formals actuals;
+              (* Extend the macro's captured environment [env] with bindings of
+                 formals to actuals. Each actual captures the environment [env0]
+                 that exists here, at the macro application site. *)
+              let env = bind_many formals (loc, actuals, env0) env in
+              (* Process the macro's body in this extended environment. *)
+              let (_ : env) = expand_list g env body in
+              (* Continue with our original environment. *)
+              env0
+
         in
 
         if def = None then
@@ -532,19 +556,12 @@ and expand_node ?(top = false) g env0 (x : node) =
         env
 
 
-    | `Def (loc, name, body)->
-        g.require_location := true;
-        if M.mem name env0 then
-          error loc (sprintf "%S is already defined" name)
-        else
-          M.add name (`Def (loc, name, body, env0)) env0
-
-    | `Defun (loc, name, arg_names, body) ->
+    | `Def (loc, name, formals, body)->
         g.require_location := true;
         if M.mem name env0 then
           error loc (sprintf "%S is already defined" name)
         else
-          M.add name (`Defun (loc, name, arg_names, body, env0)) env0
+          M.add name (EDef (loc, formals, body, env0)) env0
 
     | `Undef (loc, name) ->
         g.require_location := true;