Skip to content

Commit

Permalink
Refactoring (#94)
Browse files Browse the repository at this point in the history
  • Loading branch information
fpottier authored Sep 14, 2024
1 parent cbd7dad commit 40600e3
Show file tree
Hide file tree
Showing 3 changed files with 61 additions and 58 deletions.
115 changes: 59 additions & 56 deletions src/cppo_eval.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 *)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -668,19 +673,18 @@ 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
g.buf <- local_buf;
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
Expand All @@ -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
Expand All @@ -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) ->
Expand Down
2 changes: 1 addition & 1 deletion src/cppo_lexer.mll
Original file line number Diff line number Diff line change
Expand Up @@ -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) "("
Expand Down
2 changes: 1 addition & 1 deletion src/cppo_types.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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, _, _, _)
Expand Down

0 comments on commit 40600e3

Please sign in to comment.