From 40600e3bf02c6dfbd02c505007ea8426a4fb2a6f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Pottier?= Date: Sat, 14 Sep 2024 17:30:56 +0200 Subject: [PATCH] Refactoring (#94) --- src/cppo_eval.ml | 115 +++++++++++++++++++++++---------------------- src/cppo_lexer.mll | 2 +- src/cppo_types.ml | 2 +- 3 files changed, 61 insertions(+), 58 deletions(-) diff --git a/src/cppo_eval.ml b/src/cppo_eval.ml index 85f658e..11960d1 100644 --- a/src/cppo_eval.ml +++ b/src/cppo_eval.ml @@ -349,7 +349,8 @@ let rec eval_bool env (x : bool_expr) = type globals = { call_loc : Cppo_types.loc; (* location used to set the value of - __FILE__ and __LINE__ global variables *) + __FILE__ and __LINE__ global variables; + also used in the expansion of CONCAT *) mutable buf : Buffer.t; (* buffer where the output is written *) @@ -381,7 +382,13 @@ type globals = { (* mapping from extension ID to pipeline command *) } - +(* [preserving_enable_loc g action] saves [g.enable_loc], runs [action()], + then restores [g.enable_loc]. The result of [action()] is returned. *) +let preserving_enable_loc g action = + let enable_loc0 = !(g.enable_loc) in + let result = action() in + g.enable_loc := enable_loc0; + result let parse ~preserve_quotations file lexbuf = let lexer_env = Cppo_lexer.init ~preserve_quotations file lexbuf in @@ -552,65 +559,63 @@ let rec include_file g loc rel_file env = and expand_list ?(top = false) g env l = List.fold_left (expand_node ~top g) env l -and expand_node ?(top = false) g env0 (x : node) = - match x with - `Ident (loc, name, actuals) -> +(* [expand_ident] is the special case of [expand_node] where the node is + an identifier [`Ident (loc, name, actuals)]. *) +and expand_ident ~top g env0 loc name (actuals : actuals) = - let def = find_opt name env0 in - let g = - if top && def <> None || g.call_loc == dummy_loc then - { g with call_loc = loc } - else g - in + (* Test whether there exists a definition for the macro [name]. *) + let def = find_opt name env0 in + 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 def -> + expand_macro_application ~top g env0 loc name actuals def - let enable_loc0 = !(g.enable_loc) in +(* [expand_macro_application] is the special case of [expand_ident] where + it turns out that the identifier [name] is a macro. *) +and expand_macro_application ~top g env0 loc name actuals def = - if def <> None then ( - g.require_location := true; + let g = + if top || g.call_loc == dummy_loc then + { g with call_loc = loc } + else g + in - if not g.show_exact_locations then ( - (* error reports will point more or less to the point - where the code is included rather than the source location - of the macro definition *) - maybe_print_location g (fst loc); - g.enable_loc := false - ) - ); + preserving_enable_loc g @@ fun () -> - let env = - match def with + g.require_location := true; - | 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_node g env body in - (* Continue with our original environment. *) - env0 + if not g.show_exact_locations then ( + (* error reports will point more or less to the point + where the code is included rather than the source location + of the macro definition *) + maybe_print_location g (fst loc); + g.enable_loc := false + ); - in + let EDef (_loc, formals, body, env) = def in + (* Check that this macro is applied to a correct number of arguments. *) + 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_node g env body in - if def = None then - g.require_location := false - else - g.require_location := true; + g.require_location := true; - (* restore initial setting *) - g.enable_loc := enable_loc0; + (* Continue with our original environment. *) + env0 - env +and expand_node ?(top = false) g env0 (x : node) = + match x with + | `Ident (loc, name, actuals) -> + expand_ident ~top g env0 loc name actuals | `Def (loc, name, formals, body)-> g.require_location := true; @@ -668,7 +673,7 @@ and expand_node ?(top = false) g env0 (x : node) = expand_list g env0 l | `Stringify x -> - let enable_loc0 = !(g.enable_loc) in + preserving_enable_loc g @@ fun () -> g.enable_loc := false; let buf0 = g.buf in let local_buf = Buffer.create 100 in @@ -676,11 +681,10 @@ and expand_node ?(top = false) g env0 (x : node) = ignore (expand_node g env0 x); stringify buf0 (Buffer.contents local_buf); g.buf <- buf0; - g.enable_loc := enable_loc0; env0 | `Capitalize (x : node) -> - let enable_loc0 = !(g.enable_loc) in + preserving_enable_loc g @@ fun () -> g.enable_loc := false; let buf0 = g.buf in let local_buf = Buffer.create 100 in @@ -691,10 +695,10 @@ and expand_node ?(top = false) g env0 (x : node) = (* stringify buf0 (Buffer.contents local_buf); *) Buffer.add_string buf0 s ; g.buf <- buf0; - g.enable_loc := enable_loc0; env0 + | `Concat (x, y) -> - let enable_loc0 = !(g.enable_loc) in + preserving_enable_loc g @@ fun () -> g.enable_loc := false; let buf0 = g.buf in let local_buf = Buffer.create 100 in @@ -707,7 +711,6 @@ and expand_node ?(top = false) g env0 (x : node) = let s = concat g.call_loc xs ys in Buffer.add_string buf0 s; g.buf <- buf0; - g.enable_loc := enable_loc0; env0 | `Line (loc, opt_file, n) -> diff --git a/src/cppo_lexer.mll b/src/cppo_lexer.mll index e9e968f..0a7daca 100644 --- a/src/cppo_lexer.mll +++ b/src/cppo_lexer.mll @@ -223,7 +223,7 @@ and directive e = parse { let xs = [] in DEF (long_loc e, id, xs) } - (* #def is identical to #define, except it does not set [e.directive], + (* #def is identical to #define, except it does not set [e.in_directive], so backslashes and newlines do not receive special treatment. The end of the macro definition must be explicitly signaled by #enddef. *) | blank* "def" dblank1 (ident as id) "(" diff --git a/src/cppo_types.ml b/src/cppo_types.ml index f78ab1b..3835432 100644 --- a/src/cppo_types.ml +++ b/src/cppo_types.ml @@ -146,7 +146,7 @@ let warning loc s = let dummy_loc = (Lexing.dummy_pos, Lexing.dummy_pos) -let node_loc node = +let node_loc (node : node) : loc = match node with | `Ident (loc, _, _) | `Def (loc, _, _, _)