From 6acbb180e867fde79bd56a605c318ce21d5eb057 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sat, 6 Jul 2024 14:23:39 +0200 Subject: [PATCH 01/16] Cppo_eval.mli: make the type [env] abstract. Cppo_eval.ml: make the type [env] an algebraic data type. This avoids some confusion, as the constructors [`Def] and [`Defun] were previously used in two different types, namely [node] and [env], with different arguments. --- src/cppo_eval.ml | 46 +++++++++++++++++++++++++++++----------------- src/cppo_eval.mli | 19 +++++-------------- 2 files changed, 34 insertions(+), 31 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index fb3f9de..a4418d8 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -5,24 +5,36 @@ open Cppo_types module S = Set.Make (String) module M = Map.Make (String) +(* An environment entry. *) + +type entry = + | EDef of loc * string * node list * env + | EDefun of loc * string * string list * node list * env + | ESpecial + +(* An environment is a map of (macro) names to environment entries. *) + +and env = + entry M.t + let builtins = [ - "__FILE__", (fun _env -> `Special); - "__LINE__", (fun _env -> `Special); + "__FILE__", (fun _env -> ESpecial); + "__LINE__", (fun _env -> ESpecial); "STRINGIFY", (fun env -> - `Defun (dummy_loc, "STRINGIFY", + EDefun (dummy_loc, "STRINGIFY", ["x"], [`Stringify (`Ident (dummy_loc, "x", None))], env) ); "CONCAT", (fun env -> - `Defun (dummy_loc, "CONCAT", + EDefun (dummy_loc, "CONCAT", ["x";"y"], [`Concat (`Ident (dummy_loc, "x", None), `Ident (dummy_loc, "y", None))], env) ); "CAPITALIZE", (fun env -> - `Defun (dummy_loc, "CAPITALIZE", + EDefun (dummy_loc, "CAPITALIZE", ["x"], [`Capitalize (`Ident (dummy_loc, "x", None))], env) @@ -33,7 +45,7 @@ let builtins = [ let is_reserved s = 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 = @@ -141,10 +153,10 @@ let rec eval_ident env loc name = let l = try match M.find name env with - | `Def (_, _, l, _) -> l - | `Defun _ -> + | EDef (_, _, l, _) -> l + | EDefun _ -> error loc (sprintf "%S expects arguments" name) - | `Special -> assert false + | ESpecial -> assert false with Not_found -> error loc (sprintf "Undefined identifier %S" name) in let expansion_error () = @@ -481,20 +493,20 @@ and expand_node ?(top = false) g env0 (x : node) = `Text (loc, false, name ^ "(") :: List.flatten with_sep in expand_list g env0 l - | Some (`Defun (_, _, arg_names, _, _)), None -> + | Some (EDefun (_, _, arg_names, _, _)), None -> error loc (sprintf "%S expects %i arguments but is applied to none." name (List.length arg_names)) - | Some (`Def _), Some _ -> + | Some (EDef _), Some _ -> error loc (sprintf "%S expects no arguments" name) - | Some (`Def (_, _, l, env)), None -> + | Some (EDef (_, _, l, env)), None -> ignore (expand_list g env l); env0 - | Some (`Defun (_, _, arg_names, l, env)), Some args -> + | Some (EDefun (_, _, arg_names, l, env)), Some args -> let argc = List.length arg_names in let n = List.length args in let args = @@ -512,13 +524,13 @@ and expand_node ?(top = false) g env0 (x : node) = let app_env = List.fold_left2 ( fun env name l -> - M.add name (`Def (loc, name, l, env0)) env + M.add name (EDef (loc, name, l, env0)) env ) env arg_names args in ignore (expand_list g app_env l); env0 - | Some `Special, _ -> assert false + | Some ESpecial, _ -> assert false in if def = None then @@ -537,14 +549,14 @@ and expand_node ?(top = false) g env0 (x : node) = if M.mem name env0 then error loc (sprintf "%S is already defined" name) else - M.add name (`Def (loc, name, body, env0)) env0 + M.add name (EDef (loc, name, body, env0)) env0 | `Defun (loc, name, arg_names, 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 (EDefun (loc, name, arg_names, body, env0)) env0 | `Undef (loc, name) -> g.require_location := true; diff --git a/src/cppo_eval.mli b/src/cppo_eval.mli index d4302f0..077a20d 100644 --- a/src/cppo_eval.mli +++ b/src/cppo_eval.mli @@ -5,13 +5,9 @@ module S : Set.S with type elt = string module M : Map.S with type key = string -val builtin_env - : [> `Defun of - Cppo_types.loc * string * string list * - [> `Capitalize of Cppo_types.node - | `Concat of (Cppo_types.node * Cppo_types.node) - | `Stringify of Cppo_types.node ] list * 'a - | `Special ] M.t as 'a +type env + +val builtin_env : env val include_inputs : extensions:(string, Cppo_command.command_template) Hashtbl.t @@ -20,10 +16,5 @@ val include_inputs -> show_exact_locations:bool -> show_no_locations:bool -> Buffer.t - -> (([< `Def of Cppo_types.loc * string * Cppo_types.node list * 'a - | `Defun of Cppo_types.loc * string * string list * Cppo_types.node list * 'a - | `Special - > `Def `Defun ] - as 'b) - M.t as 'a) - -> (string * string * (unit -> Lexing.lexbuf) * (unit -> unit)) list -> 'a + -> env + -> (string * string * (unit -> Lexing.lexbuf) * (unit -> unit)) list -> env From 32f6e24f8d43e449470f09bf197a68a4478ab66c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sat, 6 Jul 2024 14:42:50 +0200 Subject: [PATCH 02/16] Cppo_types: break useless recursion between [node] and previous types. --- src/cppo_types.ml | 2 +- src/cppo_types.mli | 3 +-- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/src/cppo_types.ml b/src/cppo_types.ml index d6428d8..1291e72 100644 --- a/src/cppo_types.ml +++ b/src/cppo_types.ml @@ -45,7 +45,7 @@ and arith_expr = (* signed int64 *) | `Lxor of (arith_expr * arith_expr) (* lxor *) ] -and node = +type node = [ `Ident of (loc * string * node list list option) | `Def of (loc * string * node list) | `Defun of (loc * string * string list * node list) diff --git a/src/cppo_types.mli b/src/cppo_types.mli index f3b5423..a7df975 100644 --- a/src/cppo_types.mli +++ b/src/cppo_types.mli @@ -41,7 +41,7 @@ and arith_expr = (* signed int64 *) | `Lxor of (arith_expr * arith_expr) (* lxor *) ] -and node = +type node = [ `Ident of (loc * string * node list list option) | `Def of (loc * string * node list) | `Defun of (loc * string * string list * node list) @@ -67,4 +67,3 @@ val error : loc -> string -> _ val warning : loc -> string -> unit val flatten_nodes : node list -> node list - From 937f1bd1a1080b2ed49d770288170d4a7764ff63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sat, 6 Jul 2024 14:50:21 +0200 Subject: [PATCH 03/16] Cppo_types: introduce some type abbreviations, for clarity. --- src/cppo_eval.ml | 4 ++-- src/cppo_types.ml | 33 ++++++++++++++++++++++++++++----- src/cppo_types.mli | 34 +++++++++++++++++++++++++++++----- 3 files changed, 59 insertions(+), 12 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index a4418d8..af687ed 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -8,8 +8,8 @@ module M = Map.Make (String) (* An environment entry. *) type entry = - | EDef of loc * string * node list * env - | EDefun of loc * string * string list * node list * env + | EDef of loc * macro * body * env + | EDefun of loc * macro * formals * body * env | ESpecial (* An environment is a map of (macro) names to environment entries. *) diff --git a/src/cppo_types.ml b/src/cppo_types.ml index 1291e72..add36f4 100644 --- a/src/cppo_types.ml +++ b/src/cppo_types.ml @@ -6,10 +6,14 @@ module String_map = Map.Make (String) type loc = position * position +(* The name of a macro. *) +type macro = + string + type bool_expr = [ `True | `False - | `Defined of string + | `Defined of macro | `Not of bool_expr (* not *) | `And of (bool_expr * bool_expr) (* && *) | `Or of (bool_expr * bool_expr) (* || *) @@ -46,10 +50,10 @@ and arith_expr = (* signed int64 *) ] type node = - [ `Ident of (loc * string * node list list option) - | `Def of (loc * string * node list) - | `Defun of (loc * string * string list * node list) - | `Undef of (loc * string) + [ `Ident of (loc * string * actuals option) + | `Def of (loc * macro * body) + | `Defun of (loc * macro * formals * body) + | `Undef of (loc * macro) | `Include of (loc * string) | `Ext of (loc * string * string) | `Cond of (loc * bool_expr * node list * node list) @@ -64,6 +68,25 @@ type node = | `Current_line of loc | `Current_file of loc ] +(* One formal macro parameter. *) +and formal = + string + +(* A tuple of formal macro parameters. *) +and formals = + formal list + +(* One actual macro argument. *) +and actual = + node list + +(* A tuple of actual macro arguments. *) +and actuals = + actual list + +(* The body of a macro definition. *) +and body = + node list let string_of_loc (pos1, pos2) = diff --git a/src/cppo_types.mli b/src/cppo_types.mli index a7df975..b9927f3 100644 --- a/src/cppo_types.mli +++ b/src/cppo_types.mli @@ -2,10 +2,14 @@ type loc = Lexing.position * Lexing.position exception Cppo_error of string +(* The name of a macro. *) +type macro = + string + type bool_expr = [ `True | `False - | `Defined of string + | `Defined of macro | `Not of bool_expr (* not *) | `And of (bool_expr * bool_expr) (* && *) | `Or of (bool_expr * bool_expr) (* || *) @@ -42,10 +46,10 @@ and arith_expr = (* signed int64 *) ] type node = - [ `Ident of (loc * string * node list list option) - | `Def of (loc * string * node list) - | `Defun of (loc * string * string list * node list) - | `Undef of (loc * string) + [ `Ident of (loc * string * actuals option) + | `Def of (loc * macro * body) + | `Defun of (loc * macro * formals * body) + | `Undef of (loc * macro) | `Include of (loc * string) | `Ext of (loc * string * string) | `Cond of (loc * bool_expr * node list * node list) @@ -60,6 +64,26 @@ type node = | `Current_line of loc | `Current_file of loc ] +(* One formal macro parameter. *) +and formal = + string + +(* A tuple of formal macro parameters. *) +and formals = + formal list + +(* One actual macro argument. *) +and actual = + node list + +(* A tuple of actual macro arguments. *) +and actuals = + actual list + +(* The body of a macro definition. *) +and body = + node list + val dummy_loc : loc val error : loc -> string -> _ From 5a6208db996d2688b940b7137e8cb8caa3075cd3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sat, 6 Jul 2024 17:12:31 +0200 Subject: [PATCH 04/16] Cppo_eval: isolate the auxiliary function [check_arity]. --- src/cppo_eval.ml | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index af687ed..2757cd9 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -413,6 +413,14 @@ 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 + let rec include_file g loc rel_file env = let file = if not (Filename.is_relative rel_file) then @@ -515,12 +523,7 @@ and expand_node ?(top = false) g env0 (x : node) = 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 + check_arity loc name arg_names args; let app_env = List.fold_left2 ( fun env name l -> From cf90d41879a53fc07b7bfb4258d340b80a52449d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sat, 6 Jul 2024 17:13:43 +0200 Subject: [PATCH 05/16] Cppo_eval: remove a dead test. Here, [args] is never empty, so [n] is never zero, so this test is useless. --- src/cppo_eval.ml | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index 2757cd9..a061f06 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -515,14 +515,6 @@ and expand_node ?(top = false) g env0 (x : node) = env0 | Some (EDefun (_, _, 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 check_arity loc name arg_names args; let app_env = List.fold_left2 ( From e15d4d0c1b4c57b018e9e116ee8b9fcfed0ddc2c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sat, 6 Jul 2024 17:25:53 +0200 Subject: [PATCH 06/16] Cppo_types, cppo_parser, cppo_eval: simplify the type of [`Ident]. In the definition of [`Ident] in the type [node], the third parameter used to have type [actuals option]: it was either [None] or [Some args] where [args] was a nonempty list of actuals. It is simpler to let this parameter have type [actuals]. There is no need for an option. --- src/cppo_eval.ml | 26 +++++++++++++------------- src/cppo_parser.mly | 5 +++-- src/cppo_types.ml | 4 +++- src/cppo_types.mli | 4 +++- 4 files changed, 22 insertions(+), 17 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index a061f06..d5da04b 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -23,20 +23,20 @@ let builtins = [ "STRINGIFY", (fun env -> EDefun (dummy_loc, "STRINGIFY", ["x"], - [`Stringify (`Ident (dummy_loc, "x", None))], + [`Stringify (`Ident (dummy_loc, "x", []))], env) ); "CONCAT", (fun env -> EDefun (dummy_loc, "CONCAT", ["x";"y"], - [`Concat (`Ident (dummy_loc, "x", None), - `Ident (dummy_loc, "y", None))], + [`Concat (`Ident (dummy_loc, "x", []), + `Ident (dummy_loc, "y", []))], env) ); "CAPITALIZE", (fun env -> EDefun (dummy_loc, "CAPITALIZE", ["x"], - [`Capitalize (`Ident (dummy_loc, "x", None))], + [`Capitalize (`Ident (dummy_loc, "x", []))], env) ); @@ -169,7 +169,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 | _ -> @@ -461,7 +461,7 @@ 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, args) -> let def = try Some (M.find name env0) @@ -488,10 +488,10 @@ and expand_node ?(top = false) g env0 (x : node) = ); let env = - match def, opt_args with - None, None -> + match def, args with + None, [] -> expand_node g env0 (`Text (loc, false, name)) - | None, Some args -> + | None, _ :: _ -> let with_sep = add_sep [`Text (loc, false, ",")] @@ -501,20 +501,20 @@ and expand_node ?(top = false) g env0 (x : node) = `Text (loc, false, name ^ "(") :: List.flatten with_sep in expand_list g env0 l - | Some (EDefun (_, _, arg_names, _, _)), None -> + | Some (EDefun (_, _, arg_names, _, _)), [] -> error loc (sprintf "%S expects %i arguments but is applied to none." name (List.length arg_names)) - | Some (EDef _), Some _ -> + | Some (EDef _), _ :: _ -> error loc (sprintf "%S expects no arguments" name) - | Some (EDef (_, _, l, env)), None -> + | Some (EDef (_, _, l, env)), [] -> ignore (expand_list g env l); env0 - | Some (EDefun (_, _, arg_names, l, env)), Some args -> + | Some (EDefun (_, _, arg_names, l, env)), _ :: _ -> check_arity loc name arg_names args; let app_env = List.fold_left2 ( diff --git a/src/cppo_parser.mly b/src/cppo_parser.mly index 21d2cdd..d064322 100644 --- a/src/cppo_parser.mly +++ b/src/cppo_parser.mly @@ -75,7 +75,7 @@ node: | TEXT { `Text $1 } | IDENT { let loc, name = $1 in - `Ident (loc, name, None) } + `Ident (loc, name, []) } | FUNIDENT args1 CL_PAREN { @@ -85,7 +85,8 @@ node: *) let (pos1, _), name = $1 in let _, pos2 = $3 in - `Ident ((pos1, pos2), name, Some $2) } + assert ($2 <> []); + `Ident ((pos1, pos2), name, $2) } | FUNIDENT error { error (fst $1) "Invalid macro application" } diff --git a/src/cppo_types.ml b/src/cppo_types.ml index add36f4..5c0cec6 100644 --- a/src/cppo_types.ml +++ b/src/cppo_types.ml @@ -50,9 +50,11 @@ and arith_expr = (* signed int64 *) ] type node = - [ `Ident of (loc * string * actuals option) + [ `Ident of (loc * string * actuals) | `Def of (loc * macro * body) | `Defun of (loc * macro * formals * body) + (* the list [actuals] is empty if and only if no parentheses + are used at this macro invocation site. *) | `Undef of (loc * macro) | `Include of (loc * string) | `Ext of (loc * string * string) diff --git a/src/cppo_types.mli b/src/cppo_types.mli index b9927f3..a8b7b32 100644 --- a/src/cppo_types.mli +++ b/src/cppo_types.mli @@ -46,7 +46,9 @@ and arith_expr = (* signed int64 *) ] type node = - [ `Ident of (loc * string * actuals option) + [ `Ident of (loc * string * actuals) + (* the list [actuals] is empty if and only if no parentheses + are used at this macro invocation site. *) | `Def of (loc * macro * body) | `Defun of (loc * macro * formals * body) | `Undef of (loc * macro) From b503c973005ad90a66ca5969fcfee9854fe1f78b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sat, 6 Jul 2024 19:33:08 +0200 Subject: [PATCH 07/16] Cppo_eval: remove [ESpecial], which was noisy. --- src/cppo_eval.ml | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index d5da04b..5733927 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -10,7 +10,6 @@ module M = Map.Make (String) type entry = | EDef of loc * macro * body * env | EDefun of loc * macro * formals * body * env - | ESpecial (* An environment is a map of (macro) names to environment entries. *) @@ -18,8 +17,6 @@ and env = entry M.t let builtins = [ - "__FILE__", (fun _env -> ESpecial); - "__LINE__", (fun _env -> ESpecial); "STRINGIFY", (fun env -> EDefun (dummy_loc, "STRINGIFY", ["x"], @@ -43,6 +40,8 @@ let builtins = [ ] let is_reserved s = + s = "__FILE__" || + s = "__LINE__" || List.exists (fun (s', _) -> s = s') builtins let builtin_env : env = @@ -156,7 +155,6 @@ let rec eval_ident env loc name = | EDef (_, _, l, _) -> l | EDefun _ -> error loc (sprintf "%S expects arguments" name) - | ESpecial -> assert false with Not_found -> error loc (sprintf "Undefined identifier %S" name) in let expansion_error () = @@ -525,7 +523,6 @@ and expand_node ?(top = false) g env0 (x : node) = ignore (expand_list g app_env l); env0 - | Some ESpecial, _ -> assert false in if def = None then From 1a7a2bde7e6130a293af1e904094a311b6b10a90 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sun, 7 Jul 2024 19:22:41 +0200 Subject: [PATCH 08/16] Cppo_eval: clean up the definition of [builtins]. --- src/cppo_eval.ml | 43 ++++++++++++++++++++++--------------------- 1 file changed, 22 insertions(+), 21 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index 5733927..150b5b6 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -16,27 +16,28 @@ type entry = and env = entry M.t -let builtins = [ - "STRINGIFY", (fun env -> - EDefun (dummy_loc, "STRINGIFY", - ["x"], - [`Stringify (`Ident (dummy_loc, "x", []))], - env) - ); - "CONCAT", (fun env -> - EDefun (dummy_loc, "CONCAT", - ["x";"y"], - [`Concat (`Ident (dummy_loc, "x", []), - `Ident (dummy_loc, "y", []))], - env) - ); - "CAPITALIZE", (fun env -> - EDefun (dummy_loc, "CAPITALIZE", - ["x"], - [`Capitalize (`Ident (dummy_loc, "x", []))], - env) - ); - +let ident x = + `Ident (dummy_loc, x, []) + +let dummy_defun name formals body env = + EDefun (dummy_loc, name, formals, body, env) + +let builtins : (string * (env -> entry)) list = [ + "STRINGIFY", + dummy_defun "STRINGIFY" + ["x"] + [`Stringify (ident "x")] + ; + "CONCAT", + dummy_defun "CONCAT" + ["x";"y"] + [`Concat (ident "x", ident "y")] + ; + "CAPITALIZE", + dummy_defun "CAPITALIZE" + ["x"] + [`Capitalize (ident "x")] + ; ] let is_reserved s = From c6889b932e555b97c1d72273b4e8eb1a663c67c8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sun, 7 Jul 2024 20:27:04 +0200 Subject: [PATCH 09/16] Cppo_eval: introduce [find_opt]. --- src/cppo_eval.ml | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index 150b5b6..952138b 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -5,6 +5,10 @@ open Cppo_types module S = Set.Make (String) module M = Map.Make (String) +let find_opt name env = + try Some (M.find name env) + with Not_found -> None + (* An environment entry. *) type entry = @@ -151,12 +155,12 @@ let concat loc x y = *) let rec eval_ident env loc name = let l = - try - match M.find name env with - | EDef (_, _, l, _) -> l - | EDefun _ -> - error loc (sprintf "%S expects arguments" name) - with Not_found -> error loc (sprintf "Undefined identifier %S" name) + match find_opt name env with + | None -> + error loc (sprintf "Undefined identifier %S" name) + | Some (EDef (_, _, l, _)) -> l + | Some (EDefun _) -> + error loc (sprintf "%S expects arguments" name) in let expansion_error () = error loc @@ -462,10 +466,7 @@ and expand_node ?(top = false) g env0 (x : node) = match x with `Ident (loc, name, args) -> - 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 } From 4b746a4322f7f471e0d8984c1ecedf2674a975b4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sun, 7 Jul 2024 20:32:40 +0200 Subject: [PATCH 10/16] Cppo_eval: isolate the auxiliary function [text]. --- src/cppo_eval.ml | 32 +++++++++++++++++++++----------- 1 file changed, 21 insertions(+), 11 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index 952138b..baf9798 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -66,6 +66,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 @@ -489,17 +504,12 @@ and expand_node ?(top = false) g env0 (x : node) = let env = match def, args with - None, [] -> - expand_node g env0 (`Text (loc, false, name)) - | None, _ :: _ -> - 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 + + | 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 args) | Some (EDefun (_, _, arg_names, _, _)), [] -> error loc From 8b0bceb68735039f3be00b1a7d3acd3a0f89a103 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sat, 6 Jul 2024 16:27:42 +0200 Subject: [PATCH 11/16] Switch to dune 2.0. The file test/dune is modified to use more modern rule syntax. This changes the generated .opam files. The purpose of this change is to allow negative tests. `with-accepted-exit-codes` requires dune 2.0. --- cppo.opam | 40 +++++++++++++++++----------- cppo_ocamlbuild.opam | 38 +++++++++++++++----------- dune-project | 4 +-- test/dune | 63 +++++++++++++------------------------------- 4 files changed, 67 insertions(+), 78 deletions(-) diff --git a/cppo.opam b/cppo.opam index 885e52a..5c011d5 100644 --- a/cppo.opam +++ b/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 " "Yishuai Li " -] -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 " "Yishuai Li " +] +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" diff --git a/cppo_ocamlbuild.opam b/cppo_ocamlbuild.opam index bb43c71..42e14ee 100644 --- a/cppo_ocamlbuild.opam +++ b/cppo_ocamlbuild.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 " "Yishuai Li " -] -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. @@ -22,9 +7,32 @@ 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 " "Yishuai Li " +] +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" diff --git a/dune-project b/dune-project index 074b20b..8a6022e 100644 --- a/dune-project +++ b/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. diff --git a/test/dune b/test/dune index ed2584b..19cc3ce 100644 --- a/test/dune +++ b/test/dune @@ -83,56 +83,29 @@ %{targets} (run %{bin:cppo} %{<})))) -(alias - (name runtest) - (package cppo) - (action - (diff ext.ref ext.out))) +(rule (alias runtest) (package cppo) + (action (diff ext.ref ext.out))) -(alias - (name runtest) - (package cppo) - (action - (diff comments.ref comments.out))) +(rule (alias runtest) (package cppo) + (action (diff comments.ref comments.out))) -(alias - (name runtest) - (package cppo) - (action - (diff cond.ref cond.out))) +(rule (alias runtest) (package cppo) + (action (diff cond.ref cond.out))) -(alias - (name runtest) - (package cppo) - (action - (diff tuple.ref tuple.out))) +(rule (alias runtest) (package cppo) + (action (diff tuple.ref tuple.out))) -(alias - (name runtest) - (package cppo) - (action - (diff loc.ref loc.out))) +(rule (alias runtest) (package cppo) + (action (diff loc.ref loc.out))) -(alias - (name runtest) - (package cppo) - (action - (diff paren_arg.ref paren_arg.out))) +(rule (alias runtest) (package cppo) + (action (diff paren_arg.ref paren_arg.out))) -(alias - (name runtest) - (package cppo) - (action - (diff version.ref version.out))) +(rule (alias runtest) (package cppo) + (action (diff version.ref version.out))) -(alias - (name runtest) - (package cppo) - (action - (diff unmatched.ref unmatched.out))) +(rule (alias runtest) (package cppo) + (action (diff unmatched.ref unmatched.out))) -(alias - (name runtest) - (package cppo) - (action - (diff test.ref test.out))) +(rule (alias runtest) (package cppo) + (action (diff test.ref test.out))) From c9d8738eedfb6a6cc320981cb295b65697e6e8a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sat, 6 Jul 2024 16:33:19 +0200 Subject: [PATCH 12/16] Add new tests. New positive tests: lexical.cppo New negative tests: arity_mismatch.cppo applied_to_none.cppo expects_no_args.cppo already_defined.cppo at_least_one_arg.cppo --- test/already_defined.cppo | 3 ++ test/already_defined.ref | 2 ++ test/applied_to_none.cppo | 3 ++ test/applied_to_none.ref | 2 ++ test/arity_mismatch.cppo | 3 ++ test/arity_mismatch.ref | 2 ++ test/at_least_one_arg.cppo | 2 ++ test/at_least_one_arg.ref | 2 ++ test/dune | 59 ++++++++++++++++++++++++++++++++++++++ test/expects_no_args.cppo | 3 ++ test/expects_no_args.ref | 2 ++ test/lexical.cppo | 27 +++++++++++++++++ test/lexical.ref | 36 +++++++++++++++++++++++ 13 files changed, 146 insertions(+) create mode 100644 test/already_defined.cppo create mode 100644 test/already_defined.ref create mode 100644 test/applied_to_none.cppo create mode 100644 test/applied_to_none.ref create mode 100644 test/arity_mismatch.cppo create mode 100644 test/arity_mismatch.ref create mode 100644 test/at_least_one_arg.cppo create mode 100644 test/at_least_one_arg.ref create mode 100644 test/expects_no_args.cppo create mode 100644 test/expects_no_args.ref create mode 100644 test/lexical.cppo create mode 100644 test/lexical.ref diff --git a/test/already_defined.cppo b/test/already_defined.cppo new file mode 100644 index 0000000..144455e --- /dev/null +++ b/test/already_defined.cppo @@ -0,0 +1,3 @@ +(* A macro is defined twice. *) +#define FOO "oh" +#define FOO "no" diff --git a/test/already_defined.ref b/test/already_defined.ref new file mode 100644 index 0000000..b222ea8 --- /dev/null +++ b/test/already_defined.ref @@ -0,0 +1,2 @@ +Error: File "already_defined.cppo", line 3, characters 0-17 +Error: "FOO" is already defined diff --git a/test/applied_to_none.cppo b/test/applied_to_none.cppo new file mode 100644 index 0000000..e5c1e77 --- /dev/null +++ b/test/applied_to_none.cppo @@ -0,0 +1,3 @@ +(* A parameterized macro is applied to no arguments. *) +#define FOO(x) x +FOO + 1 diff --git a/test/applied_to_none.ref b/test/applied_to_none.ref new file mode 100644 index 0000000..a4f06ed --- /dev/null +++ b/test/applied_to_none.ref @@ -0,0 +1,2 @@ +Error: File "applied_to_none.cppo", line 3, characters 0-3 +Error: "FOO" expects 1 arguments but is applied to none. diff --git a/test/arity_mismatch.cppo b/test/arity_mismatch.cppo new file mode 100644 index 0000000..2cad6a1 --- /dev/null +++ b/test/arity_mismatch.cppo @@ -0,0 +1,3 @@ +(* This test shows an arity mismatch error. *) +#define INCR(x) x+1 +INCR(x, y) diff --git a/test/arity_mismatch.ref b/test/arity_mismatch.ref new file mode 100644 index 0000000..dd88a1b --- /dev/null +++ b/test/arity_mismatch.ref @@ -0,0 +1,2 @@ +Error: File "arity_mismatch.cppo", line 3, characters 0-10 +Error: "INCR" expects 1 argument but is applied to 2 arguments. diff --git a/test/at_least_one_arg.cppo b/test/at_least_one_arg.cppo new file mode 100644 index 0000000..b8d6915 --- /dev/null +++ b/test/at_least_one_arg.cppo @@ -0,0 +1,2 @@ +(* A parameterized macro cannot have zero arguments. *) +#define FOO() "not ok" diff --git a/test/at_least_one_arg.ref b/test/at_least_one_arg.ref new file mode 100644 index 0000000..84d5173 --- /dev/null +++ b/test/at_least_one_arg.ref @@ -0,0 +1,2 @@ +Error: File "at_least_one_arg.cppo", line 2, characters 0-13 +Error: At least one argument is required diff --git a/test/dune b/test/dune index 19cc3ce..aff79cc 100644 --- a/test/dune +++ b/test/dune @@ -1,3 +1,6 @@ +;; --------------------------------------------------------------------------- +;; Positive tests. + (rule (targets ext.out) (deps @@ -83,6 +86,11 @@ %{targets} (run %{bin:cppo} %{<})))) +(rule + (targets lexical.out) + (deps (:< lexical.cppo)) + (action (with-stdout-to %{targets} (run %{bin:cppo} %{<})))) + (rule (alias runtest) (package cppo) (action (diff ext.ref ext.out))) @@ -109,3 +117,54 @@ (rule (alias runtest) (package cppo) (action (diff test.ref test.out))) + +(rule (alias runtest) (package cppo) + (action (diff lexical.ref lexical.out))) + +;; --------------------------------------------------------------------------- +;; Negative tests. + +(rule + (targets arity_mismatch.err) + (deps (:< arity_mismatch.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff arity_mismatch.ref arity_mismatch.err))) + +(rule + (targets applied_to_none.err) + (deps (:< applied_to_none.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff applied_to_none.ref applied_to_none.err))) + +(rule + (targets expects_no_args.err) + (deps (:< expects_no_args.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff expects_no_args.ref expects_no_args.err))) + +(rule + (targets already_defined.err) + (deps (:< already_defined.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff already_defined.ref already_defined.err))) + +(rule + (targets at_least_one_arg.err) + (deps (:< at_least_one_arg.cppo)) + (action (with-stderr-to %{targets} + (with-accepted-exit-codes (not 0) (run %{bin:cppo} %{<}))))) + +(rule (alias runtest) (package cppo) + (action (diff at_least_one_arg.ref at_least_one_arg.err))) diff --git a/test/expects_no_args.cppo b/test/expects_no_args.cppo new file mode 100644 index 0000000..d48c0e5 --- /dev/null +++ b/test/expects_no_args.cppo @@ -0,0 +1,3 @@ +(* A non-parameterized macro is given actual arguments. *) +#define FOO "foo" +1 + FOO(42) diff --git a/test/expects_no_args.ref b/test/expects_no_args.ref new file mode 100644 index 0000000..8cd5733 --- /dev/null +++ b/test/expects_no_args.ref @@ -0,0 +1,2 @@ +Error: File "expects_no_args.cppo", line 3, characters 4-11 +Error: "FOO" expects no arguments diff --git a/test/lexical.cppo b/test/lexical.cppo new file mode 100644 index 0000000..d37958f --- /dev/null +++ b/test/lexical.cppo @@ -0,0 +1,27 @@ +(* This test shows that the definition of BAR captures the original + definition of FOO, so even if FOO is redefined, the expansion of + BAR does not change. *) +#define FOO "original definition" +#define BAR FOO +#undef FOO +#define FOO "new definition" +FOO (* expands to "new definition" *) +BAR (* expands to "original definition" *) + +(* This test shows that a formal parameter can shadow a previously + defined macro. *) +#define F(FOO) FOO +F(42) (* expands to 42 *) + +(* This test shows that two formal parameters can have the same + name. In that case, the second parameter shadows the first one. *) +#define G(X, X) X+X +G(42,23) (* expands to 23+23 *) + +(* This test shows that it is OK to pass an empty argument to a macro + that expects one parameter. This is interpreted as passing one + empty argument. *) +#define expect(x) show(x) +expect(42) +expect("23") +expect() diff --git a/test/lexical.ref b/test/lexical.ref new file mode 100644 index 0000000..d7d652f --- /dev/null +++ b/test/lexical.ref @@ -0,0 +1,36 @@ +# 1 "lexical.cppo" +(* This test shows that the definition of BAR captures the original + definition of FOO, so even if FOO is redefined, the expansion of + BAR does not change. *) +# 8 "lexical.cppo" + "new definition" +# 8 "lexical.cppo" + (* expands to "new definition" *) +# 9 "lexical.cppo" + "original definition" +# 9 "lexical.cppo" + (* expands to "original definition" *) + +(* This test shows that a formal parameter can shadow a previously + defined macro. *) +# 14 "lexical.cppo" + 42 +# 14 "lexical.cppo" + (* expands to 42 *) + +(* This test shows that two formal parameters can have the same + name. In that case, the second parameter shadows the first one. *) +# 19 "lexical.cppo" + 23+23 +# 19 "lexical.cppo" + (* expands to 23+23 *) + +(* This test shows that it is OK to pass an empty argument to a macro + that expects one parameter. This is interpreted as passing one + empty argument. *) +# 25 "lexical.cppo" + show(42) +# 26 "lexical.cppo" + show("23") +# 27 "lexical.cppo" + show() From d2f93b82f82c0288a3b12e45825943d7230b3eb1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sun, 7 Jul 2024 20:48:11 +0200 Subject: [PATCH 13/16] Cppo_eval: remove the distinction between [EDef] and [EDefun]. There was no strong reason for this distinction to exist. A few new auxiliary functions are isolated: [bind_one], [bind_many]. A few error messages change slightly (they become more uniform). The expected test output is adjusted in a separate commit. --- src/cppo_eval.ml | 88 ++++++++++++++++++++++++++---------------------- 1 file changed, 48 insertions(+), 40 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index baf9798..3ea7dc7 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -11,9 +11,14 @@ let find_opt name env = (* 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 * macro * body * env - | EDefun of loc * macro * formals * body * env + | EDef of loc * formals * body * env (* An environment is a map of (macro) names to environment entries. *) @@ -23,22 +28,22 @@ and env = let ident x = `Ident (dummy_loc, x, []) -let dummy_defun name formals body env = - EDefun (dummy_loc, name, formals, body, env) +let dummy_defun formals body env = + EDef (dummy_loc, formals, body, env) let builtins : (string * (env -> entry)) list = [ "STRINGIFY", - dummy_defun "STRINGIFY" + dummy_defun ["x"] [`Stringify (ident "x")] ; "CONCAT", - dummy_defun "CONCAT" + dummy_defun ["x";"y"] [`Concat (ident "x", ident "y")] ; "CAPITALIZE", - dummy_defun "CAPITALIZE" + dummy_defun ["x"] [`Capitalize (ident "x")] ; @@ -171,11 +176,12 @@ let concat loc x y = let rec eval_ident env loc name = let l = 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) - | Some (EDef (_, _, l, _)) -> l - | Some (EDefun _) -> - error loc (sprintf "%S expects arguments" name) in let expansion_error () = error loc @@ -439,6 +445,19 @@ let check_arity loc name (formals : _ list) (actuals : _ list) = 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 @@ -479,7 +498,7 @@ and expand_list ?(top = false) g env l = and expand_node ?(top = false) g env0 (x : node) = match x with - `Ident (loc, name, args) -> + `Ident (loc, name, actuals) -> let def = find_opt name env0 in let g = @@ -503,37 +522,26 @@ and expand_node ?(top = false) g env0 (x : node) = ); let env = - match def, args with + match def with - | None, _ -> + | 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 args) - - | Some (EDefun (_, _, arg_names, _, _)), [] -> - error loc - (sprintf "%S expects %i arguments but is applied to none." - name (List.length arg_names)) - - | Some (EDef _), _ :: _ -> - error loc - (sprintf "%S expects no arguments" name) - - | Some (EDef (_, _, l, env)), [] -> - ignore (expand_list g env l); - env0 - - | Some (EDefun (_, _, arg_names, l, env)), _ :: _ -> - check_arity loc name arg_names args; - let app_env = - List.fold_left2 ( - fun env name l -> - M.add name (EDef (loc, name, l, env0)) env - ) env arg_names args - in - ignore (expand_list g app_env l); - env0 + 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 @@ -553,14 +561,14 @@ and expand_node ?(top = false) g env0 (x : node) = if M.mem name env0 then error loc (sprintf "%S is already defined" name) else - M.add name (EDef (loc, name, body, env0)) env0 + M.add name (EDef (loc, [], body, env0)) env0 | `Defun (loc, name, arg_names, body) -> g.require_location := true; if M.mem name env0 then error loc (sprintf "%S is already defined" name) else - M.add name (EDefun (loc, name, arg_names, body, env0)) env0 + M.add name (EDef (loc, arg_names, body, env0)) env0 | `Undef (loc, name) -> g.require_location := true; From 794fd2c7580f12006564a4ebd48b093371cccbdc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sat, 6 Jul 2024 20:41:11 +0200 Subject: [PATCH 14/16] Update the expected output of two negative tests. --- test/applied_to_none.ref | 2 +- test/expects_no_args.ref | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/test/applied_to_none.ref b/test/applied_to_none.ref index a4f06ed..f339d52 100644 --- a/test/applied_to_none.ref +++ b/test/applied_to_none.ref @@ -1,2 +1,2 @@ Error: File "applied_to_none.cppo", line 3, characters 0-3 -Error: "FOO" expects 1 arguments but is applied to none. +Error: "FOO" expects 1 argument but is applied to 0 argument. diff --git a/test/expects_no_args.ref b/test/expects_no_args.ref index 8cd5733..d661b7b 100644 --- a/test/expects_no_args.ref +++ b/test/expects_no_args.ref @@ -1,2 +1,2 @@ Error: File "expects_no_args.cppo", line 3, characters 4-11 -Error: "FOO" expects no arguments +Error: "FOO" expects 0 argument but is applied to 1 argument. From 4c946886200223d2fa467acfa7840979b34f8c2b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sun, 7 Jul 2024 20:52:55 +0200 Subject: [PATCH 15/16] Remove the distinction between [`Def] and [`Defun]. There was no strong reason for this distinction to exist. --- src/cppo_eval.ml | 11 ++--------- src/cppo_parser.mly | 7 ++++--- src/cppo_types.ml | 5 +++-- src/cppo_types.mli | 5 +++-- 4 files changed, 12 insertions(+), 16 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index 3ea7dc7..6891efe 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -556,19 +556,12 @@ and expand_node ?(top = false) g env0 (x : node) = env - | `Def (loc, name, 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 (EDef (loc, [], body, env0)) env0 - - | `Defun (loc, name, arg_names, body) -> - g.require_location := true; - if M.mem name env0 then - error loc (sprintf "%S is already defined" name) - else - M.add name (EDef (loc, arg_names, body, env0)) env0 + M.add name (EDef (loc, formals, body, env0)) env0 | `Undef (loc, name) -> g.require_location := true; diff --git a/src/cppo_parser.mly b/src/cppo_parser.mly index d064322..f3c7286 100644 --- a/src/cppo_parser.mly +++ b/src/cppo_parser.mly @@ -102,11 +102,12 @@ node: let body = $2 @ [safe_space] in let _, pos2 = $3 in - `Def ((pos1, pos2), name, body) } + let formals = [] in + `Def ((pos1, pos2), name, formals, body) } | DEFUN def_args1 CL_PAREN unode_list0 ENDEF { let (pos1, _), name = $1 in - let args = $2 in + let formals = $2 in (* Additional spacing is needed for cases like 'foo()bar' where 'foo()' expands into 'abc', giving 'abcbar' @@ -117,7 +118,7 @@ node: let body = $4 @ [safe_space] in let _, pos2 = $5 in - `Defun ((pos1, pos2), name, args, body) } + `Def ((pos1, pos2), name, formals, body) } | DEFUN CL_PAREN { error (fst (fst $1), snd $2) diff --git a/src/cppo_types.ml b/src/cppo_types.ml index 5c0cec6..c221991 100644 --- a/src/cppo_types.ml +++ b/src/cppo_types.ml @@ -51,10 +51,11 @@ and arith_expr = (* signed int64 *) type node = [ `Ident of (loc * string * actuals) - | `Def of (loc * macro * body) - | `Defun of (loc * macro * formals * body) (* the list [actuals] is empty if and only if no parentheses are used at this macro invocation site. *) + | `Def of (loc * macro * formals * body) + (* the list [formals] is empty if and only if no parentheses + are used at this macro definition site. *) | `Undef of (loc * macro) | `Include of (loc * string) | `Ext of (loc * string * string) diff --git a/src/cppo_types.mli b/src/cppo_types.mli index a8b7b32..0a35533 100644 --- a/src/cppo_types.mli +++ b/src/cppo_types.mli @@ -49,8 +49,9 @@ type node = [ `Ident of (loc * string * actuals) (* the list [actuals] is empty if and only if no parentheses are used at this macro invocation site. *) - | `Def of (loc * macro * body) - | `Defun of (loc * macro * formals * body) + | `Def of (loc * macro * formals * body) + (* the list [formals] is empty if and only if no parentheses + are used at this macro definition site. *) | `Undef of (loc * macro) | `Include of (loc * string) | `Ext of (loc * string * string) From f9f246d5200afda3d7a22deb27c3e3e1f58317c1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Franc=CC=A7ois=20Pottier?= Date: Sat, 13 Jul 2024 20:32:26 +0200 Subject: [PATCH 16/16] dune-project: records that cppo_ocamlbuild needs dune 2.0 too. Maybe this is not necessary, but it seems safer. --- dune-project | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dune-project b/dune-project index 8a6022e..84f633a 100644 --- a/dune-project +++ b/dune-project @@ -33,7 +33,7 @@ Cppo is: (name cppo_ocamlbuild) (depends ocaml - (dune (>= 1.10)) + (dune (>= 2.0)) ocamlbuild ocamlfind) (synopsis "Plugin to use cppo with ocamlbuild")