84 lines
3.0 KiB
OCaml
84 lines
3.0 KiB
OCaml
open Camlp4; (* -*- camlp4r -*- *)
|
|
(****************************************************************************)
|
|
(* *)
|
|
(* Objective Caml *)
|
|
(* *)
|
|
(* INRIA Rocquencourt *)
|
|
(* *)
|
|
(* Copyright 2006 Institut National de Recherche en Informatique et *)
|
|
(* en Automatique. All rights reserved. This file is distributed under *)
|
|
(* the terms of the GNU Library General Public License, with the special *)
|
|
(* exception on linking described in LICENSE at the top of the Objective *)
|
|
(* Caml source tree. *)
|
|
(* *)
|
|
(****************************************************************************)
|
|
|
|
(* Authors:
|
|
* - Nicolas Pouillard: initial version
|
|
*)
|
|
|
|
module Id = struct
|
|
value name = "Camlp4DebugParser";
|
|
value version = "$Id$";
|
|
end;
|
|
|
|
module Make (Syntax : Sig.Camlp4Syntax) = struct
|
|
open Sig;
|
|
include Syntax;
|
|
|
|
module StringSet = Set.Make String;
|
|
|
|
value debug_mode =
|
|
try
|
|
let str = Sys.getenv "STATIC_CAMLP4_DEBUG" in
|
|
let rec loop acc i =
|
|
try
|
|
let pos = String.index_from str i ':' in
|
|
loop (StringSet.add (String.sub str i (pos - i)) acc) (pos + 1)
|
|
with
|
|
[ Not_found ->
|
|
StringSet.add (String.sub str i (String.length str - i)) acc ] in
|
|
let sections = loop StringSet.empty 0 in
|
|
if StringSet.mem "*" sections then fun _ -> True
|
|
else fun x -> StringSet.mem x sections
|
|
with [ Not_found -> fun _ -> False ];
|
|
|
|
value rec apply accu =
|
|
fun
|
|
[ [] -> accu
|
|
| [x :: xs] ->
|
|
let _loc = Ast.loc_of_expr x
|
|
in apply <:expr< $accu$ $x$ >> xs ];
|
|
|
|
value mk_debug_mode _loc = fun [ None -> <:expr< Debug.mode >>
|
|
| Some m -> <:expr< $uid:m$.Debug.mode >> ];
|
|
|
|
value mk_debug _loc m fmt section args =
|
|
let call = apply <:expr< Debug.printf $str:section$ $str:fmt$ >> args in
|
|
<:expr< if $mk_debug_mode _loc m$ $str:section$ then $call$ else () >>;
|
|
|
|
EXTEND Gram
|
|
GLOBAL: expr;
|
|
expr:
|
|
[ [ m = start_debug; section = LIDENT; fmt = STRING;
|
|
args = LIST0 expr LEVEL "."; x = end_or_in ->
|
|
match (x, debug_mode section) with
|
|
[ (None, False) -> <:expr< () >>
|
|
| (Some e, False) -> e
|
|
| (None, _) -> mk_debug _loc m fmt section args
|
|
| (Some e, _) -> <:expr< let () = $mk_debug _loc m fmt section args$ in $e$ >> ]
|
|
] ];
|
|
end_or_in:
|
|
[ [ "end" -> None
|
|
| "in"; e = expr -> Some e
|
|
] ];
|
|
start_debug:
|
|
[ [ LIDENT "debug" -> None
|
|
| LIDENT "camlp4_debug" -> Some "Camlp4"
|
|
] ];
|
|
END;
|
|
|
|
end;
|
|
|
|
let module M = Register.OCamlSyntaxExtension Id Make in ();
|