From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: X-Spam-Checker-Version: SpamAssassin 3.1.3 (2006-06-01) on yquem.inria.fr X-Spam-Level: X-Spam-Status: No, score=0.0 required=5.0 tests=none autolearn=disabled version=3.1.3 X-Original-To: caml-list@yquem.inria.fr Delivered-To: caml-list@yquem.inria.fr Received: from concorde.inria.fr (concorde.inria.fr [192.93.2.39]) by yquem.inria.fr (Postfix) with ESMTP id BF242BC0A for ; Tue, 17 Apr 2007 03:12:41 +0200 (CEST) Received: from hub.hrl.com (hub.hrl.com [208.179.241.200]) by concorde.inria.fr (8.13.6/8.13.6) with ESMTP id l3H1CeYJ004206 for ; Tue, 17 Apr 2007 03:12:40 +0200 Received: from [192.27.172.110] (dangle.hrl.com [192.27.172.110]) by hpux03.hrl.com (iPlanet Messaging Server 5.2 HotFix 2.10 (built Dec 26 2005)) with ESMTP id <0JGM00LIGBD376@hpux03.hrl.com> for caml-list@inria.fr; Mon, 16 Apr 2007 18:12:39 -0700 (PDT) Date: Mon, 16 Apr 2007 18:12:39 -0700 From: Aleksey Nogin Subject: 3.10.0+beta: Corrected and improved Camlp4MacroParser In-reply-to: <4623FD5F.30006@metaprl.org> To: Nicolas Pouillard Cc: Caml List Reply-To: Aleksey Nogin , Caml List Message-id: <46241F07.8090602@metaprl.org> Organization: MetaPRL/Mojave Research Group MIME-version: 1.0 Content-type: multipart/mixed; boundary="Boundary_(ID_NQQkIFJRDGOrKoyFil+gYg)" User-Agent: Thunderbird 1.5.0.10 (X11/20070301) References: <4623DA8C.1000702@metaprl.org> <4623FD5F.30006@metaprl.org> X-Miltered: at concorde with ID 46241F08.000 by Joe's j-chkmail (http://j-chkmail . ensmp . fr)! X-Spam: no; 0.00; camlp:01 camlp:01 ifdef:01 ifdef:01 lident:01 unneeded:01 arity:01 rocquencourt:01 rauglaudre:01 bug:01 struct:01 toplevel:01 lident:01 lowercase:01 toplevel:01 X-Attachments: cset="UTF-8" name="Camlp4MacroParser.ml" name="Camlp4MacroParser.ml" This is a multi-part message in MIME format. --Boundary_(ID_NQQkIFJRDGOrKoyFil+gYg) Content-type: text/plain; charset=UTF-8; format=flowed Content-transfer-encoding: 7BIT As I wrote to the list earlier, I have noticed that the Camlp4MacroParser in 3.10.0+beta has an unfortunate problem - when processing an "IFDEF" (or "IFNDEF") directive, it will execute the "DEFINE"s in _both_ branches, regardless of whether the test is true or not (this was caused by the fact that the DEFINE directives would be executed eagerly at parse-time). Attached is a corrected and improved version of the Camlp4MacroParser: - Fixes the above problem; now the execution of the "DEFINE" directives inside IFDEF/IFNDEF is correct. - Adds support for "local" definitions DEFINE = IN This is particularly useful for things like DEFINE body = ... IN IFDEF DEBUG let result = body in print_debug result; result ELSE body - Adds an ability to omit the "ELSE" part of the IFDEF/IFNDEF expressions (the "ELSE" branch is then taken to default to unit expression "()"). - Adds an ability to use the macro argument as a pattern (provided the argument is a sufficiently simple expression) - Adds a special macro "NOTHING" that can be used to "wipe out" unneeded function arguments. This is useful to be able to generate functions of different arity using the same macro. The improved Camlp4MacroParser.ml is attached. Aleksey --Boundary_(ID_NQQkIFJRDGOrKoyFil+gYg) Content-type: text/plain; name=Camlp4MacroParser.ml Content-transfer-encoding: 7BIT Content-disposition: inline; filename=Camlp4MacroParser.ml 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: * - Daniel de Rauglaudre: initial version * - Nicolas Pouillard: refactoring * - Aleksey Nogin: extra features and bug fixes. *) module Id = struct value name = "Camlp4MacroParser"; value version = "$Id: Camlp4MacroParser.ml,v 1.1 2007/02/07 10:09:22 ertai Exp $"; end; (* Added statements: At toplevel (structure item): DEFINE DEFINE = DEFINE () = IFDEF THEN [ ELSE ] (END | ENDIF) IFNDEF THEN [ ELSE ] (END | ENDIF) INCLUDE In expressions: IFDEF THEN [ ELSE ] (END | ENDIF) IFNDEF THEN [ ELSE ] (END | ENDIF) DEFINE = IN __FILE__ __LOCATION__ In patterns: IFDEF THEN ELSE (END | ENDIF) IFNDEF THEN ELSE (END | ENDIF) As Camlp4 options: -D define -U undefine it -I add to the search path for INCLUDE'd files After having used a DEFINE followed by "= ", you can use it in expressions *and* in patterns. If the expression defining the macro cannot be used as a pattern, there is an error message if it is used in a pattern. You can also define a local macro in an expression usigng the DEFINE ... IN form. Note that local macros have lowercase names and can not take parameters. If a macro is defined to = NOTHING, and then used as an argument to a function, this will be equivalent to function taking one less argument. Similarly, passing NOTHING as an argument to a macro is equivalent to "erasing" the corresponding parameter from the macro body. The toplevel statement INCLUDE can be used to include a file containing macro definitions and also any other toplevel items. The included files are looked up in directories passed in via the -I option, falling back to the current directory. The expression __FILE__ returns the current compiled file name. The expression __LOCATION__ returns the current location of itself. *) open Camlp4; module Make (Syntax : Sig.Camlp4Syntax) = struct open Sig; include Syntax; type item_or_def 'a = [ SdStr of 'a | SdDef of string and option (list string * Ast.expr) | SdUnd of string | SdITE of string and list (item_or_def 'a) and list (item_or_def 'a) | SdInc of string ]; value rec list_remove x = fun [ [(y, _) :: l] when y = x -> l | [d :: l] -> [d :: list_remove x l] | [] -> [] ]; value defined = ref []; value is_defined i = List.mem_assoc i defined.val; value bad_patt _loc = Loc.raise _loc (Failure "this macro cannot be used in a pattern (see its definition)"); value substp _loc env = loop where rec loop = fun [ <:expr< $e1$ $e2$ >> -> <:patt< $loop e1$ $loop e2$ >> | <:expr< >> -> <:patt< >> | <:expr< $lid:x$ >> -> try List.assoc x env with [ Not_found -> <:patt< $lid:x$ >> ] | <:expr< $uid:x$ >> -> try List.assoc x env with [ Not_found -> <:patt< $uid:x$ >> ] | <:expr< $int:x$ >> -> <:patt< $int:x$ >> | <:expr< $str:s$ >> -> <:patt< $str:s$ >> | <:expr< ($tup:x$) >> -> <:patt< ($tup:loop x$) >> | <:expr< $x1$, $x2$ >> -> <:patt< $loop x1$, $loop x2$ >> | <:expr< { $bi$ } >> -> let rec substbi = fun [ <:binding< $b1$; $b2$ >> -> <:patt< $substbi b1$; $substbi b2$ >> | <:binding< $p$ = $e$ >> -> <:patt< $p$ = $loop e$ >> | _ -> bad_patt _loc ] in <:patt< { $substbi bi$ } >> | _ -> bad_patt _loc ]; class reloc _loc = object inherit Ast.map as super; method _Loc_t _ = _loc; end; class subst _loc env = object inherit reloc _loc as super; method expr = fun [ <:expr< $lid:x$ >> | <:expr< $uid:x$ >> as e -> try List.assoc x env with [ Not_found -> super#expr e ] | e -> super#expr e ]; method patt = fun [ <:patt< $lid:x$ >> | <:patt< $uid:x$ >> as p -> try substp _loc [] (List.assoc x env) with [ Not_found -> super#patt p ] | p -> super#patt p ]; end; value incorrect_number loc l1 l2 = Loc.raise loc (Failure (Printf.sprintf "expected %d parameters; found %d" (List.length l2) (List.length l1))); value define eo x = do { match eo with [ Some ([], e) -> EXTEND Gram expr: LEVEL "simple" [ [ UIDENT $x$ -> (new reloc _loc)#expr e ]] ; patt: LEVEL "simple" [ [ UIDENT $x$ -> let p = substp _loc [] e in (new reloc _loc)#patt p ]] ; END | Some (sl, e) -> EXTEND Gram expr: LEVEL "apply" [ [ UIDENT $x$; param = SELF -> let el = match param with [ <:expr< ($tup:e$) >> -> Ast.list_of_expr e [] | e -> [e] ] in if List.length el = List.length sl then let env = List.combine sl el in (new subst _loc env)#expr e else incorrect_number _loc el sl ] ] ; patt: LEVEL "simple" [ [ UIDENT $x$; param = SELF -> let pl = match param with [ <:patt< ($tup:p$) >> -> Ast.list_of_patt p [] | p -> [p] ] in if List.length pl = List.length sl then let env = List.combine sl pl in let p = substp _loc env e in (new reloc _loc)#patt p else incorrect_number _loc pl sl ] ] ; END | None -> () ]; defined.val := [(x, eo) :: defined.val]; }; value undef x = try do { let eo = List.assoc x defined.val in match eo with [ Some ([], _) -> do { DELETE_RULE Gram expr: UIDENT $x$ END; DELETE_RULE Gram patt: UIDENT $x$ END; } | Some (_, _) -> do { DELETE_RULE Gram expr: UIDENT $x$; SELF END; DELETE_RULE Gram patt: UIDENT $x$; SELF END; } | None -> () ]; defined.val := list_remove x defined.val; } with [ Not_found -> () ]; (* This is a list of directories to search for INCLUDE statements. *) value include_dirs = ref []; (* Add something to the above, make sure it ends with a slash. *) value add_include_dir str = if str <> "" then let str = if String.get str ((String.length str)-1) = '/' then str else str ^ "/" in include_dirs.val := include_dirs.val @ [str] else (); value parse_include_file rule = let dir_ok file dir = Sys.file_exists (dir ^ file) in fun file -> let file = try (List.find (dir_ok file) (include_dirs.val @ ["./"])) ^ file with [ Not_found -> file ] in let ch = open_in file in let st = Stream.of_channel ch in Gram.parse rule (Loc.mk file) st; value nil_str_item = let _loc = Loc.ghost in <:str_item<>>; value rec execute_macro = fun [ SdStr i -> i | SdDef x eo -> do { define eo x; nil_str_item } | SdUnd x -> do { undef x; nil_str_item } | SdITE i l1 l2 -> execute_macro_list (if is_defined i then l1 else l2) | SdInc f -> do { parse_include_file str_items f } ] and execute_macro_list = fun [ [] -> nil_str_item | [hd::tl] -> (* The evaluation order is important here *) let il1 = execute_macro hd in let il2 = execute_macro_list tl in let _loc = Loc.ghost in <:str_item< $list: [il1; il2]$ >> ] ; EXTEND Gram GLOBAL: expr patt str_item sig_item; str_item: FIRST [ [ x = macro_def -> execute_macro x ] ] ; macro_def: [ [ "DEFINE"; i = uident; def = opt_macro_value -> SdDef i def | "UNDEF"; i = uident -> SdUnd i | "IFDEF"; i = uident; "THEN"; st1 = smlist; st2 = else_macro_def -> SdITE i st1 st2 | "IFNDEF"; i = uident; "THEN"; st2 = smlist; st1 = else_macro_def -> SdITE i st1 st2 | "INCLUDE"; fname = STRING -> SdInc fname ] ] ; else_macro_def: [ [ "ELSE"; st = smlist; _ = endif -> st | _ = endif -> [] ] ] ; smlist: [ [ sml = LIST1 [ d = macro_def -> d | si = str_item -> SdStr si ] -> sml ] ] ; sig_item: FIRST [ [ "INCLUDE"; fname = STRING -> parse_include_file sig_items fname ] ] ; endif: [ [ "END" -> () | "ENDIF" -> () ] ] ; opt_macro_value: [ [ "("; pl = LIST1 [ x = LIDENT -> x ] SEP ","; ")"; "="; e = expr -> Some (pl, e) | "="; e = expr -> Some ([], e) | -> None ] ] ; else_expr: [ [ "ELSE"; e = expr; _ = endif -> e | _ = endif -> <:expr< () >> ] ] ; expr: LEVEL "top" [ [ "IFDEF"; i = uident; "THEN"; e1 = expr; e2 = else_expr -> if is_defined i then e1 else e2 | "IFNDEF"; i = uident; "THEN"; e1 = expr; e2 = else_expr -> if is_defined i then e2 else e1 | "DEFINE"; i = LIDENT; "="; def = expr; "IN"; body = expr -> (new subst _loc [(i, def)])#expr body ] ] ; expr: LEVEL "simple" [ [ LIDENT "__FILE__" -> <:expr< $`str:Loc.file_name _loc$ >> | LIDENT "__LOCATION__" -> let (a, b, c, d, e, f, g, h) = Loc.to_tuple _loc in <:expr< Loc.of_tuple ($`str:a$, $`int:b$, $`int:c$, $`int:d$, $`int:e$, $`int:f$, $`int:g$, $if h then <:expr< True >> else <:expr< False >> $) >> ] ] ; patt: [ [ "IFDEF"; i = uident; "THEN"; p1 = patt; "ELSE"; p2 = patt; _ = endif -> if is_defined i then p1 else p2 | "IFNDEF"; i = uident; "THEN"; p1 = patt; "ELSE"; p2 = patt; _ = endif -> if is_defined i then p2 else p1 ] ] ; uident: [ [ i = UIDENT -> i ] ] ; END; Options.add "-D" (Arg.String (define None)) " Define for IFDEF instruction."; Options.add "-U" (Arg.String undef) " Undefine for IFDEF instruction."; Options.add "-I" (Arg.String add_include_dir) " Add a directory to INCLUDE search path."; end; let module M = Register.OCamlSyntaxExtension Id Make in (); module MakeNothing (AstFilters : Camlp4.Sig.AstFilters) = struct open AstFilters; open Ast; value rec map_expr = fun [ <:expr< $e$ NOTHING >> | <:expr< fun $ <:patt< NOTHING >> $ -> $e$ >> -> map_expr e | e -> e]; register_str_item_filter (new Ast.c_expr map_expr)#str_item; end; let module M = Camlp4.Register.AstFilter Id MakeNothing in (); --Boundary_(ID_NQQkIFJRDGOrKoyFil+gYg)--