q_symbol.ml 2.26 KB
Newer Older
1 2 3
open Camlp4.PreCast
module Caml_syntax = Syntax

4
let symbols = ref []
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
let debug_symbols = ref []
let debug = ref false

let split_string c s =
  let res = ref [] in
  let buff = Buffer.create 32 in
  let add s = if s <> "" then res:= s :: !res in
  for i = 0 to String.length s - 1 do
    match s.[i] with
      d when d == c -> let f = Buffer.contents buff in
                     Buffer.clear buff; add f
    | ('a'..'z' | '0'..'9' | '_' | 'A'..'Z') as d  -> Buffer.add_char buff d
    | _ -> ()
  done;
  let f = Buffer.contents buff in
  add f;
  !res
22 23

let define s =
24 25
  let i =
    try String.index s '='
26
    with Not_found -> failwith ("Invalid symbol definition :" ^ s) in
27
  let symbol = String.sub s 0 i in
28
  let value_str = String.sub s (i + 1) (String.length s - i - 1) in
29 30
  let value =
    Gram.parse_string
31
      Caml_syntax.expr (Loc.mk "<from-string>") value_str
32
  in
33 34 35 36 37 38
  symbols := (symbol, value) :: !symbols;
  if symbol = "cduce_debug" then begin
    debug := true;
    let l = split_string ',' value_str in
    debug_symbols := l @ !debug_symbols
  end
39

40
EXTEND Caml_syntax.Gram
41
  GLOBAL: Caml_syntax.str_item  Caml_syntax.expr;
42

43
  Caml_syntax.str_item: FIRST
44 45 46 47
    [ [ "ifdef"; c = UIDENT; "then"; e1 = SELF;
        "else"; e2 = SELF ->
          if List.mem_assoc c !symbols then e1 else e2
      | "ifdef"; c = UIDENT; "then"; e1 = SELF ->
48
          if List.mem_assoc c !symbols then e1 else <:str_item<>>
49 50 51 52
      | "ifndef"; c = UIDENT; "then"; e1 = SELF;
        "else"; e2 = SELF ->
          if List.mem_assoc c !symbols then e2 else e1
      | "ifndef"; c = UIDENT; "then"; e1 = SELF ->
53
          if List.mem_assoc c !symbols then <:str_item<>> else e1
54
      ] ];
55 56 57 58 59 60 61 62 63

  Caml_syntax.expr: BEFORE "simple"
    [ [
      "DEBUG" ; x = OPT [ x = LIDENT  -> x ]; "("; e = Caml_syntax.expr; ")"  ->
      let flag =
        match x with
        None -> ""
        | Some s -> s
      in
64
      if !debug && (flag = "" || List.exists (fun s -> s = "all" || s = flag) !debug_symbols) then
65 66 67 68
        e
      else <:expr< () >>
    ]
    ];
69 70
END

71
let expr _ _ s =
72
  try List.assoc s !symbols
73
  with Not_found -> failwith ("No definition for symbol " ^ s)
74 75

let _ =
76
  Quotation.add "symbol" Quotation.DynAst.expr_tag expr;
77
  Camlp4.Options.add "-symbol" (Arg.String define)
78
    "<symbol=value> Define a symbol"