Add poc files

lang_c/parsing/.depend

@@ -0,0 +1,49 @@
+ast_c.cmo : ../../commons/common2.cmi ../../commons/common.cmi \
+    ../../lang_cpp/parsing/ast_cpp.cmo
+ast_c.cmx : ../../commons/common2.cmx ../../commons/common.cmx \
+    ../../lang_cpp/parsing/ast_cpp.cmx
+ast_c_simple_build.cmo : ../../h_program-lang/parse_info.cmi \
+    ../../commons/ocaml.cmi ../../lang_cpp/parsing/meta_ast_cpp.cmi \
+    ../../commons/common2.cmi ../../commons/common.cmi \
+    ../../lang_cpp/parsing/ast_cpp.cmo ast_c.cmo ast_c_simple_build.cmi
+ast_c_simple_build.cmx : ../../h_program-lang/parse_info.cmx \
+    ../../commons/ocaml.cmx ../../lang_cpp/parsing/meta_ast_cpp.cmx \
+    ../../commons/common2.cmx ../../commons/common.cmx \
+    ../../lang_cpp/parsing/ast_cpp.cmx ast_c.cmx ast_c_simple_build.cmi
+ast_c_simple_build.cmi : ../../h_program-lang/parse_info.cmi \
+    ../../lang_cpp/parsing/ast_cpp.cmo ast_c.cmo
+lib_parsing_c.cmo : visitor_c.cmo ../../commons/file_type.cmi \
+    ../../commons/common.cmi lib_parsing_c.cmi
+lib_parsing_c.cmx : visitor_c.cmx ../../commons/file_type.cmx \
+    ../../commons/common.cmx lib_parsing_c.cmi
+lib_parsing_c.cmi : ../../h_program-lang/parse_info.cmi \
+    ../../commons/common.cmi ast_c.cmo
+meta_ast_c.cmo : ../../h_program-lang/parse_info.cmi ../../commons/ocaml.cmi \
+    ../../lang_cpp/parsing/ast_cpp.cmo ast_c.cmo meta_ast_c.cmi
+meta_ast_c.cmx : ../../h_program-lang/parse_info.cmx ../../commons/ocaml.cmx \
+    ../../lang_cpp/parsing/ast_cpp.cmx ast_c.cmx meta_ast_c.cmi
+meta_ast_c.cmi : ../../commons/ocaml.cmi ast_c.cmo
+parse_c.cmo : ../../lang_cpp/parsing/parser_cpp.cmi \
+    ../../h_program-lang/parse_info.cmi ../../lang_cpp/parsing/parse_cpp.cmi \
+    ../../lang_cpp/parsing/flag_parsing_cpp.cmo ../../commons/common2.cmi \
+    ../../commons/common.cmi ast_c_simple_build.cmi ast_c.cmo parse_c.cmi
+parse_c.cmx : ../../lang_cpp/parsing/parser_cpp.cmx \
+    ../../h_program-lang/parse_info.cmx ../../lang_cpp/parsing/parse_cpp.cmx \
+    ../../lang_cpp/parsing/flag_parsing_cpp.cmx ../../commons/common2.cmx \
+    ../../commons/common.cmx ast_c_simple_build.cmx ast_c.cmx parse_c.cmi
+parse_c.cmi : ../../lang_cpp/parsing/parser_cpp.cmi \
+    ../../h_program-lang/parse_info.cmi ../../commons/common.cmi ast_c.cmo
+test_parsing_c.cmo : ../../h_program-lang/parse_info.cmi parse_c.cmi \
+    ../../commons/ocaml.cmi meta_ast_c.cmi lib_parsing_c.cmi \
+    ../../commons/common.cmi test_parsing_c.cmi
+test_parsing_c.cmx : ../../h_program-lang/parse_info.cmx parse_c.cmx \
+    ../../commons/ocaml.cmx meta_ast_c.cmx lib_parsing_c.cmx \
+    ../../commons/common.cmx test_parsing_c.cmi
+test_parsing_c.cmi : ../../commons/common.cmi
+unit_parsing_c.cmo : unit_parsing_c.cmi
+unit_parsing_c.cmx : unit_parsing_c.cmi
+unit_parsing_c.cmi :
+visitor_c.cmo : ../../commons/ocaml.cmi ../../lang_cpp/parsing/ast_cpp.cmo \
+    ast_c.cmo
+visitor_c.cmx : ../../commons/ocaml.cmx ../../lang_cpp/parsing/ast_cpp.cmx \
+    ast_c.cmx

lang_c/parsing/Makefile

@@ -0,0 +1,60 @@
+TOP=../..
+##############################################################################
+# Variables
+##############################################################################
+TARGET=lib
+
+-include $(TOP)/Makefile.config
+
+SRC= ast_c.ml meta_ast_c.ml visitor_c.ml \
+     ast_c_simple_build.ml \
+     lib_parsing_c.ml \
+     parse_c.ml \
+     test_parsing_c.ml unit_parsing_c.ml \
+
+SYSLIBS= str.cma unix.cma 
+
+LIBS=$(TOP)/commons/lib.cma \
+ $(TOP)/h_program-lang/lib.cma \
+ $(TOP)/lang_cpp/parsing/lib.cma
+
+INCLUDEDIRS= \
+ $(TOP)/commons\
+ $(TOP)/globals \
+ $(TOP)/h_program-lang \
+ $(TOP)/lang_cpp/parsing \
+
+##############################################################################
+# Generic variables
+##############################################################################
+
+-include $(TOP)/Makefile.common
+
+##############################################################################
+# Top rules
+##############################################################################
+all:: $(TARGET).cma
+all.opt:: $(TARGET).cmxa
+
+$(TARGET).cma: $(OBJS)
+	$(OCAMLC) -a -o $(TARGET).cma $(OBJS)
+
+$(TARGET).cmxa: $(OPTOBJS) $(LIBS:.cma=.cmxa)
+	$(OCAMLOPT) -a -o $(TARGET).cmxa $(OPTOBJS)
+
+$(TARGET).top: $(OBJS) $(LIBS)
+	$(OCAMLMKTOP) -o $(TARGET).top $(SYSLIBS) $(LIBS) $(OBJS)
+
+clean::
+	rm -f $(TARGET).top
+
+visitor_c.cmo: visitor_c.ml
+	$(OCAMLC) -w y -c $<
+
+##############################################################################
+# Generic rules
+##############################################################################
+
+##############################################################################
+# Literate Programming rules
+##############################################################################

lang_c/parsing/ast_c.ml

@@ -0,0 +1,305 @@
+(* Yoann Padioleau
+ *
+ * Copyright (C) 2012, 2014 Facebook
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * version 2.1 as published by the Free Software Foundation, with the
+ * special exception on linking described in file license.txt.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
+ * license.txt for more details.
+ *)
+open Common2.Infix
+
+(*****************************************************************************)
+(* Prelude *)
+(*****************************************************************************)
+(* 
+ * A (real) Abstract Syntax Tree for C, not a Concrete Syntax Tree
+ * as in ast_cpp.ml.
+ * 
+ * This file contains a simplified C abstract syntax tree. The original
+ * C/C++ syntax tree (ast_cpp.ml) is good for code refactoring or
+ * code visualization; the types used match exactly the source. However,
+ * for other algorithms, the nature of the AST makes the code a bit
+ * redundant. Moreover many analysis are far simpler to write on
+ * C than C++. Hence the idea of a SimpleAST which is the
+ * original AST where certain constructions have been factorized
+ * or even removed.
+
+ * Here is a list of the simplications/factorizations:
+ *  - no C++ constructs, just plain C
+ *  - no purely syntactical tokens in the AST like parenthesis, brackets, 
+ *    braces, commas, semicolons, etc. No ParenExpr. No FinalDef. No
+ *    NotParsedCorrectly. The only token information kept is for identifiers
+ *    for error reporting. See name below.
+ *  - ...
+ *  - no nested struct, they are lifted to the toplevel
+ *  - no anonymous structure (an artificial name is gensym'ed)
+ *  - no mix of typedef with decl
+ *  - sugar is removed, no RecordAccess vs RecordPtAccess, ...
+ *  - no init vs expr
+ *  - no Case/Default in statement but instead a focused 'case' type
+ * 
+ * less: ast_c_simple_build.ml is probably incomplete, but for now
+ * is good enough for codegraph purposes on xv6, plan9 and other small C
+ * projects.
+ * 
+ * related work: 
+ *  - CIL, but it works after preprocessing; it makes it harder to connect
+ *    analysis results to tools like codemap. It also does not handle some of
+ *    the kencc extensions and does not allow to analyze cpp constructs.
+ *    CIL has two pointer analysis but they were written with bug finding
+ *    in mind I think, not code comprehension which we really care about 
+ *    in pfff.
+ *    In the end I thought generating datalog facts for plan9 using lang_c/ 
+ *    was simpler that modifying CIL (moreover fixing lang_cpp/ and lang_c/
+ *    to handle plan9 code was anyway needed for codemap).
+ *  - SIL's monoidics. SIL looks a bit complicated, but it might be a good
+ *    candidate, unforunately their API are not easily accessible in
+ *    a findlib library form yet.
+ *  - Clang, but like CIL it works after preprocessing, does not handle kencc,
+ *    and does not provide by default a convenient ocaml AST. I could use
+ *    clang-ocaml though but it's not easily accessible in a findlib
+ *    library form yet.
+ *  - we could also use the AST used by cc in plan9 :)
+ * 
+ * See lang_cpp/parsing/ast_cpp.ml.
+ *
+ *)
+
+(*****************************************************************************)
+(* The AST related types *)
+(*****************************************************************************)
+
+type 'a wrap = 'a * Ast_cpp.tok
+
+(* ------------------------------------------------------------------------- *)
+(* Name *)
+(* ------------------------------------------------------------------------- *)
+
+type name = string wrap
+ (* with tarzan *)
+
+(* ------------------------------------------------------------------------- *)
+(* Types *)
+(* ------------------------------------------------------------------------- *)
+
+(* less: qualifier (const/volatile) *)
+type type_ =
+  | TBase of name (* int, float, etc *)
+  | TPointer of type_
+  | TArray of const_expr option * type_
+  | TFunction of function_type
+  | TStructName of struct_kind * name
+  (* hmmm but in C it's really like an int no? but scheck could be
+   * extended at some point to do more strict type checking! 
+   *)
+  | TEnumName of name
+  | TTypeName of name
+
+ (* less:  '...' varargs support *)
+ and function_type = (type_ * parameter list)
+
+  and parameter = {
+    p_type: type_;
+    (* when part of a prototype, the name is not always mentionned *)
+    p_name: name option;
+  }
+
+ and struct_kind = Struct | Union
+
+(* ------------------------------------------------------------------------- *)
+(* Expression *)
+(* ------------------------------------------------------------------------- *)
+and expr =
+  | Int of string wrap
+  | Float of string wrap
+  | String of string wrap
+  | Char of string wrap
+
+  (* can be a cpp or enum constant (e.g. FOO), or a local/global/parameter
+   * variable, or a function name.
+   *)
+  | Id of name
+
+  | Call of expr * argument list
+
+  (* should be a statement ... but see Datalog_c.instr *)
+  | Assign of Ast_cpp.assignOp wrap * expr * expr
+
+  | ArrayAccess of expr * expr (* x[y] *)
+  (* Why x->y instead of x.y choice? it's easier then with datalog
+   * and it's more consistent with ArrayAccess where expr has to be
+   * a kind of pointer too. That means x.y is actually unsugared in (&x)->y
+   *)
+  | RecordPtAccess of expr * name (* x->y,  and not x.y!! *)
+
+  | Cast of type_ * expr
+
+  (* less: transform into Call (builtin ...) ? *)
+  | Postfix of expr * Ast_cpp.fixOp wrap
+  | Infix of expr * Ast_cpp.fixOp wrap
+  (* contains GetRef and Deref!! todo: lift up? *)
+  | Unary of expr * Ast_cpp.unaryOp wrap
+  | Binary of expr * Ast_cpp.binaryOp wrap * expr
+
+  | CondExpr of expr * expr * expr
+  (* should be a statement ... *)
+  | Sequence of expr * expr
+
+  | SizeOf of (expr, type_) Common.either
+
+  (* should appear only in a variable initializer, or after GccConstructor *)
+  | ArrayInit of (expr option * expr) list
+  | RecordInit of (name * expr) list
+  (* gccext: kenccext: *)
+  | GccConstructor  of type_ * expr (* always an ArrayInit (or RecordInit?) *)
+
+and argument = expr
+
+(* really should just contain constants and Id that are #define *)
+and const_expr = expr
+
+ (* with tarzan *)
+
+(* ------------------------------------------------------------------------- *)
+(* Statement *)
+(* ------------------------------------------------------------------------- *)
+type stmt = 
+  | ExprSt of expr
+  | Block of stmt list
+
+  | If of expr * stmt * stmt
+  | Switch of expr * case list
+
+  | While of expr * stmt
+  | DoWhile of stmt * expr
+  | For of expr option * expr option * expr option * stmt
+
+  | Return of expr option
+  | Continue | Break
+
+  | Label of name * stmt
+  | Goto of name
+
+  | Vars of var_decl list
+  (* todo: it's actually a special kind of format, not just an expr *)
+  | Asm of expr list
+
+  and case =
+    | Case of expr * stmt list
+    | Default of stmt list
+
+(* ------------------------------------------------------------------------- *)
+(* Variables *)
+(* ------------------------------------------------------------------------- *)
+
+and var_decl = {
+  v_name: name;
+  v_type: type_;
+  v_storage: storage;
+  v_init: initialiser option;
+}
+ (* can have ArrayInit and RecordInit here in addition to other expr *)
+ and initialiser = expr
+ and storage = Extern | Static | DefaultStorage
+
+ (* with tarzan *)
+
+(* ------------------------------------------------------------------------- *)
+(* Definitions *)
+(* ------------------------------------------------------------------------- *)
+
+type func_def = {
+  f_name: name;
+  f_type: function_type;
+  f_body: stmt list;
+  f_static: bool;
+}
+ (* with tarzan *)
+
+
+type struct_def = {
+  s_name: name;
+  s_kind: struct_kind;
+  s_flds: field_def list;
+}
+  (* less: could merge with var_decl, but field have no storage normally *)
+  and field_def = { 
+   (* less: bitfield annotation
+    * kenccext: the option on fld_name is for inlined anonymous structure.
+    *)
+    fld_name: name option;
+    fld_type: type_;
+  }
+ (* with tarzan *)
+
+(* less: use a record *)
+type enum_def = name * (name * const_expr option) list
+ (* with tarzan *)
+
+(* less: use a record *)
+type type_def = name * type_
+ (* with tarzan *)
+
+(* ------------------------------------------------------------------------- *)
+(* Cpp *)
+(* ------------------------------------------------------------------------- *)
+
+type define_body = 
+  | CppExpr of expr (* actually const_expr when in Define context *)
+  (* todo: we want that? even dowhile0 are actually transformed in CppExpr.
+   * We have no way to reference a CppStmt in 'stmt' since MacroStmt
+   * is not here? So we can probably remove this constructor no?
+   *)
+  | CppStmt of stmt
+ (* with tarzan *)
+
+(* ------------------------------------------------------------------------- *)
+(* Program *)
+(* ------------------------------------------------------------------------- *)
+type toplevel =
+  | Include of string wrap (* path *)
+  | Define of name * define_body 
+  | Macro of name * (name list) * define_body
+
+  (* less: what about ForwardStructDecl? for mutually recursive structures? 
+   * probably can deal with it by using typedefs as intermediates.
+   *)
+  | StructDef of struct_def
+  | TypeDef of type_def
+  | EnumDef of enum_def
+  | FuncDef of func_def
+  | Global of var_decl (* also contain extern decl *)
+  | Prototype of func_def (* empty body *)
+ (* with tarzan *)
+
+type program = toplevel list
+ (* with tarzan *)
+
+(* ------------------------------------------------------------------------- *)
+(* Any *)
+(* ------------------------------------------------------------------------- *)
+type any =
+  | Expr of expr
+  | Stmt of stmt
+  | Type of type_
+  | Toplevel of toplevel
+  | Program of program
+ (* with tarzan *)
+
+(*****************************************************************************)
+(* Helpers *)
+(*****************************************************************************)
+
+let str_of_name (s, _) = s
+
+let looks_like_macro name =
+  let s = str_of_name name in
+  s =~ "^[A-Z][A-Z_0-9]*$"
+
+let unwrap x = fst x

lang_c/parsing/ast_c_simple_build.ml

@@ -0,0 +1,772 @@
+(* Yoann Padioleau
+ *
+ * Copyright (C) 2012, 2014 Facebook
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * version 2.1 as published by the Free Software Foundation, with the
+ * special exception on linking described in file license.txt.
+ *
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
+ * license.txt for more details.
+ *)
+open Common
+
+open Ast_cpp
+module A = Ast_c
+
+(*****************************************************************************)
+(* Prelude *)
+(*****************************************************************************)
+(*
+ * Ast_cpp to Ast_c_simple.
+ * 
+ * We skip the then part of ifdefs.
+ * 
+ * todo: 
+ *  - lift up local union and struct defined in functions?
+ *    (hmm but better to rewrite the code I think)
+ *)
+
+(*****************************************************************************)
+(* Globals *)
+(*****************************************************************************)
+(* for anon struct, which is dangerous! because the main function
+ * will return different results given the same input when called
+ * two times in a row
+ *)
+let cnt = ref 0
+
+(*****************************************************************************)
+(* Types *)
+(*****************************************************************************)
+
+exception ObsoleteConstruct of string * Parse_info.info
+exception CplusplusConstruct
+exception TodoConstruct of string * Parse_info.info
+exception CaseOutsideSwitch
+exception MacroInCase
+
+type env = { 
+  mutable struct_defs_toadd: A.struct_def list;
+  mutable enum_defs_toadd: A.enum_def list;
+  mutable typedefs_toadd: A.type_def list;
+}
+
+let empty_env () = {
+  struct_defs_toadd = [];
+  enum_defs_toadd = [];
+  typedefs_toadd = [];
+}
+
+(*****************************************************************************)
+(* Helpers *)
+(*****************************************************************************)
+
+let debug any =
+  let v = Meta_ast_cpp.vof_any any in
+  let s = Ocaml.string_of_v v in
+  pr2 s
+
+let rec ifdef_skipper xs f =
+
+  match xs with
+  | [] -> []
+  | x::xs ->
+    (match f x with
+    | None -> x::ifdef_skipper xs f
+    | Some ifdef ->
+      (match ifdef with
+      | Ifdef, tok ->
+        pr2_once (spf "skipping: %s" (Parse_info.str_of_info tok));
+        (try 
+          let (_, x, rest) = 
+            xs +> Common2.split_when (fun x -> 
+              match f x with
+              | Some (IfdefElse, _) -> true
+              | Some (IfdefEndif, _) -> true
+              | _ -> false
+            )
+          in
+          (match f x with
+          | Some (IfdefEndif, _) ->
+              ifdef_skipper rest f
+          | Some (IfdefElse, _) ->
+            let (before, _x, rest) = 
+              rest +> Common2.split_when (fun x -> 
+                match f x with
+                | Some (IfdefEndif, _) -> true
+              | _ -> false
+              )
+            in
+            ifdef_skipper before f @ ifdef_skipper rest f
+          | _ -> raise Impossible
+          )
+        with Not_found ->
+          failwith (spf "%s: unclosed ifdef" (Parse_info.string_of_info tok))
+        )
+      | _, tok ->
+          failwith (spf "%s: no ifdef" (Parse_info.string_of_info tok))
+      )
+    )
+
+(*****************************************************************************)
+(* Main entry point *)
+(*****************************************************************************)
+
+let rec program xs =
+  let env = empty_env () in
+  toplevels env xs +> List.flatten
+
+(* ---------------------------------------------------------------------- *)
+(* Toplevels *)
+(* ---------------------------------------------------------------------- *)
+
+and toplevels env xs =
+  ifdef_skipper xs (function IfdefDecl x -> Some x | _ -> None)
+    +> List.map (toplevel env)
+
+and toplevel env x =
+  match x with
+  | DeclElem decl -> declaration env decl
+  | CppDirectiveDecl x -> cpp_directive env x
+
+  | (MacroVarTop (_, _)|MacroTop (_, _, _)) ->
+      debug (Toplevel x); raise Todo
+
+  | IfdefDecl _ -> raise Impossible (* see ifdef_skipper *)
+  (* not much we can do here, at least the parsing statistics should warn the
+   * user that some code was not processed
+   *)
+  | NotParsedCorrectly _ -> []
+
+
+and declaration env x =
+  match x with
+  | Func (func_or_else) ->
+      (match func_or_else with
+      | FunctionOrMethod def ->
+          [A.FuncDef (func_def env def)]
+      | Constructor _ | Destructor _ ->
+          debug (Toplevel (DeclElem x)); raise CplusplusConstruct
+      )
+
+  | BlockDecl bd ->
+      (match block_declaration env bd with
+      | A.Vars xs -> 
+          let structs = env.struct_defs_toadd in
+          let enums = env.enum_defs_toadd in
+          let typedefs = env.typedefs_toadd in
+          env.struct_defs_toadd <- [];
+          env.enum_defs_toadd <- [];
+          env.typedefs_toadd <- [];
+          (structs +> List.map (fun x -> A.StructDef x)) @
+          (enums +> List.map (fun x -> A.EnumDef x)) @
+          (typedefs +> List.map (fun x -> A.TypeDef x)) @
+          (xs +> List.map (fun x ->
+            (* could skip extern declaration? *)
+            match x with
+            | { A.v_type = A.TFunction ft; v_storage = storage; _ } ->
+                A.Prototype { A.
+                  f_name = x.A.v_name;
+                  f_type = ft;
+                  f_static = (storage =*= A.Static);
+                  f_body = [];
+                }
+            | _ -> A.Global x
+          ))
+      | _ -> 
+        debug (Toplevel (DeclElem x)); raise Todo
+      )
+
+  | EmptyDef _ -> []
+
+  | NameSpaceAnon (_, _)|NameSpaceExtend (_, _)|NameSpace (_, _, _) 
+  | ExternCList (_, _, _)|ExternC (_, _, _)|TemplateSpecialization (_, _, _)
+  | TemplateDecl _ ->    
+      debug (Toplevel (DeclElem x)); raise CplusplusConstruct
+  | DeclTodo ->
+      debug (Toplevel (DeclElem x)); raise Todo
+
+
+(* ---------------------------------------------------------------------- *)
+(* Functions *)
+(* ---------------------------------------------------------------------- *)
+and func_def env def = 
+  { A.
+    f_name = name env def.f_name;
+    f_type = function_type env def.f_type;
+    f_static = 
+      (match def.f_storage with
+      | Sto (Static, _) -> true
+      | _ -> false
+      );
+    f_body = compound env def.f_body;
+  }
+
+and function_type env x = 
+  match x with
+  { ft_ret = ret;
+    ft_params = params;
+    ft_dots = _dotsTODO;
+    ft_const = const;
+    ft_throw = throw;
+  } ->
+    (match const, throw with
+    | None, None -> ()
+    | _ -> raise CplusplusConstruct
+    );
+    
+    (full_type env ret,
+   List.map (parameter env) (params +> unparen +> uncomma)
+  )
+
+and parameter env x =
+  match x with
+  { p_name = n;
+    p_type = t;
+    p_register = _regTODO;
+    p_val = v;
+  } ->
+    (match v with
+    | None -> ()
+    | Some _ -> debug (Parameter x); raise CplusplusConstruct
+    );
+    { A.
+      p_name = 
+        (match n with
+        (* probably a prototype where didn't specify the name *)
+        | None -> None
+        | Some (name) -> Some name
+        );
+      p_type = full_type env t;
+    }
+
+(* ---------------------------------------------------------------------- *)
+(* Variables *)
+(* ---------------------------------------------------------------------- *)
+and onedecl env d = 
+  match d with
+  { v_namei = ni;
+    v_type = ft;
+    v_storage = sto;
+  } ->
+    (match ni, sto with
+    | Some (n, iopt), (NoSto | Sto _)  ->
+        let init_opt =
+          match iopt with
+          | None -> None
+          | Some (EqInit (_, ini)) -> Some (initialiser env ini)
+          | Some (ObjInit _) -> 
+              debug (OneDecl d);
+              raise CplusplusConstruct
+        in
+        Some { A.
+          v_name = name env n;
+          v_type = full_type env ft;
+          v_storage = storage env sto;
+          v_init = init_opt;
+        }
+    | Some (n, None), (StoTypedef _) ->
+        let def = (name env n, full_type env ft) in
+        env.typedefs_toadd <- def :: env.typedefs_toadd;
+        None
+    | None, NoSto ->
+        (match Ast_cpp.unwrap_typeC ft with
+        (* it's ok to not have any var decl as long as a type
+         * was defined. struct_defs_toadd should not be empty then.
+         *)
+        | StructDef _ | EnumDef _ -> 
+            let _ = full_type env ft in
+            None
+        (* forward declaration *)
+        | StructUnionName _ ->
+            None
+            
+        | _ -> debug (OneDecl d); raise Todo
+        )
+    | _ -> debug (OneDecl d); raise Todo
+    )        
+
+and initialiser env x =
+  match x with
+  | InitExpr e -> expr env e
+  | InitList xs ->
+     (match xs +> unbrace +> uncomma with
+     | [] -> debug (Init x); raise Impossible
+     | (InitDesignators ([DesignatorField (_, _)], _, _init))::_ ->
+       A.RecordInit (
+         xs +> unbrace +> uncomma +> List.map (function
+           | InitDesignators ([DesignatorField (_, ident)], _, init) ->
+             ident, initialiser env init
+           | _ -> debug (Init x); raise Todo
+         ))
+     | _ ->
+       A.ArrayInit ((xs +> unbrace +> uncomma) +> List.map (function
+         (* less: todo? *)
+         | InitIndexOld ((_, idx, _), ini) ->
+             Some (expr env idx), initialiser env ini
+         | InitDesignators([DesignatorIndex((_, idx, _))], _, ini) -> 
+             Some (expr env idx), initialiser env ini
+         | x -> None, initialiser env x
+       ))
+     )
+
+  (* should be covered by caller *)
+  | InitDesignators _ -> debug (Init x); raise Todo
+  | InitIndexOld _ | InitFieldOld _ -> debug (Init x); raise Todo
+
+and storage _env x =
+  match x with
+  | NoSto -> A.DefaultStorage
+  | StoTypedef _ -> raise Impossible
+  | Sto (y, _) ->
+      (match y with
+      | Static -> A.Static
+      | Extern -> A.Extern
+      | Auto | Register -> A.DefaultStorage
+      )
+
+(* ---------------------------------------------------------------------- *)
+(* Cpp *)
+(* ---------------------------------------------------------------------- *)
+  
+and cpp_directive env x =
+  match x with
+  | Define (_tok, name, def_kind, def_val) ->
+      let v = cpp_def_val x env def_val in
+      (match def_kind with
+      | DefineVar ->
+          [A.Define (name, v)]
+      | DefineFunc(args) ->
+          [A.Macro(name, 
+                 args +> unparen +> uncomma +> List.map (fun (s, ii) ->
+                   (s, List.hd ii)
+                 ),
+                 v)]
+      )
+  | Include (tok, inc_kind, path) ->
+      let s =
+        match inc_kind with
+        | Local -> "\"" ^ path ^ "\""
+        | Standard -> "<" ^ path ^ ">"
+        | Weird -> debug (Cpp x); raise Todo
+      in
+      [A.Include (s, tok)]
+  | Undef _ -> debug (Cpp x); raise Todo
+  | PragmaAndCo _ -> []
+
+and cpp_def_val for_debug env x = 
+  match x with
+  | DefineExpr e -> A.CppExpr (expr env e)
+  | DefineStmt st -> A.CppStmt (stmt env st)
+  | DefineDoWhileZero (st, _) -> A.CppStmt (stmt env st)
+  | DefinePrintWrapper (_, (_, e, _), id) -> 
+    A.CppExpr (
+      A.CondExpr (expr env e,
+                  A.Id (name env id),
+                  A.Id (name env id)))
+
+  | DefineInit init -> A.CppExpr (initialiser env init)
+
+  | DefineEmpty (* A.CppEmpty*) 
+  | ( DefineText _| DefineFunction _
+    | DefineType _
+    | DefineTodo
+    ) -> 
+      debug (Cpp for_debug); raise Todo
+
+(* ---------------------------------------------------------------------- *)
+(* Stmt *)
+(* ---------------------------------------------------------------------- *)
+
+and stmt env x =
+  let (st, ii) = x in
+  match st with
+  | Compound x -> A.Block (compound env x)
+  | Selection s ->
+      (match s with
+      | If (_, (_, e, _), st1, _, st2) ->
+          A.If (expr env e, stmt env st1, stmt env st2)
+      | Switch (_, (_, e, _), st) ->
+          A.Switch (expr env e, cases env st)
+        )
+  | Iteration i ->
+      (match i with
+      | While (_, (_, e, _), st) ->
+          A.While (expr env e, stmt env st)
+      | DoWhile (_, st, _, (_, e, _), _) ->
+          A.DoWhile (stmt env st, expr env e)
+      | For (_, (_, ((est1, _), (est2, _), (est3, _)), _), st) ->
+          A.For (
+            Common2.fmap (expr env) est1,
+            Common2.fmap (expr env) est2,
+            Common2.fmap (expr env) est3,
+            stmt env st
+          )
+
+      | MacroIteration _ ->
+          debug (Stmt x); raise Todo
+      )
+  | ExprStatement eopt ->
+      (match eopt with
+      | None -> A.Block []
+      | Some e -> A.ExprSt (expr env e)
+      )
+  | DeclStmt block_decl ->
+      block_declaration env block_decl
+
+  | Labeled lbl ->
+      (match lbl with
+      | Label (s, st) ->
+          A.Label ((s, List.hd ii), stmt env st)
+      | Case _ | CaseRange _ | Default _ ->
+          debug (Stmt x); raise CaseOutsideSwitch
+      )
+  | Jump j ->
+      (match j with
+      | Goto s -> A.Goto ((s, List.hd ii))
+      | Return -> A.Return None;
+      | ReturnExpr e -> A.Return (Some (expr env e))
+      | Continue -> A.Continue
+      | Break -> A.Break
+      | GotoComputed _ -> debug (Stmt x); raise Todo
+      )
+
+  | Try (_, _, _) ->
+      debug (Stmt x); raise CplusplusConstruct
+
+  | (NestedFunc _ | StmtTodo | MacroStmt ) ->
+      debug (Stmt x); raise Todo
+
+and compound env (_, xs, _) =
+  statements_sequencable env xs +> List.flatten
+
+and statements_sequencable env xs =
+  ifdef_skipper xs (function IfdefStmt x -> Some x | _ -> None)
+    +> List.map (statement_sequencable env)
+
+
+and statement_sequencable env x =
+  match x with
+  | StmtElem st -> [stmt env st]
+  | CppDirectiveStmt x -> debug (Cpp x); raise Todo
+  | IfdefStmt _ -> raise Impossible
+
+and cases env x =
+  let (st, ii) = x in
+  match st with
+  | Compound (l, xs, r) ->
+      let rec aux xs =
+        match xs with
+        | [] -> []
+        | x::xs ->
+            (match x with
+            | StmtElem ((Labeled (Case (_, st))), _)
+            | StmtElem ((Labeled (Default st)), _)
+              ->
+                let xs', rest =
+                  (StmtElem st::xs) +> Common.span (function
+                  | StmtElem ((Labeled (Case (_, _st))), _)
+                  | StmtElem ((Labeled (Default _st)), _) -> false
+                  | _ -> true
+                  )
+                in
+                let stmts = List.map (function
+                  | StmtElem st -> stmt env st
+                  | x -> 
+                    debug (Stmt (Compound (l, [x], r), ii));
+                    raise MacroInCase
+                ) xs' in
+                (match x with
+                | StmtElem ((Labeled (Case (e, _))), _) ->
+                    A.Case (expr env e, stmts)
+                | StmtElem ((Labeled (Default _st)), _) ->
+                    A.Default (stmts)
+                | _ -> raise Impossible
+                )::aux rest
+            | x -> debug (Body (l, [x], r)); raise Todo
+            )
+      in
+      aux xs
+  | _ -> 
+      debug (Stmt x); raise Todo
+
+and block_declaration env block_decl =
+  match block_decl with
+  | DeclList (xs, _) ->
+      let xs = uncomma xs in
+      A.Vars (Common.map_filter (onedecl env) xs)
+
+  (* todo *)
+  | Asm (_tok1, _volatile_opt, _asmbody, _tok2) -> 
+      A.Asm []
+
+  | MacroDecl _ -> debug (BlockDecl2 block_decl); raise Todo
+      
+  | UsingDecl _ | UsingDirective _ | NameSpaceAlias _ -> 
+      raise CplusplusConstruct
+
+
+(* ---------------------------------------------------------------------- *)
+(* Expr *)
+(* ---------------------------------------------------------------------- *)
+
+and expr env e =
+  let (e', toks) = e in
+  match e' with
+  | C cst -> constant env toks cst
+
+  | Id (n, _) -> A.Id (name env n)
+
+  | RecordAccess (e, n) ->
+      A.RecordPtAccess (A.Unary (expr env e, (GetRef,List.hd toks)), name env n)
+  | RecordPtAccess (e, n) ->
+      A.RecordPtAccess (expr env e, name env n)
+
+  | Cast ((_, ft, _), e) -> 
+      A.Cast (full_type env ft, expr env e)
+
+  | ArrayAccess (e1, (_, e2, _)) ->
+      A.ArrayAccess (expr env e1, expr env e2)
+  | Binary (e1, op, e2) -> A.Binary (expr env e1, (op, List.hd toks), expr env e2)
+  | Unary (e, op) -> A.Unary (expr env e, (op, List.hd toks))
+  | Infix  (e, op) -> A.Infix (expr env e, (op, List.hd toks))
+  | Postfix (e, op) -> A.Postfix (expr env e, (op, List.hd toks))
+
+  | Assignment (e1, op, e2) -> 
+      A.Assign ((op, List.hd toks), expr env e1, expr env e2)
+  | Sequence (e1, e2) -> 
+      A.Sequence (expr env e1, expr env e2)
+  | CondExpr (e1, e2opt, e3) ->
+      A.CondExpr (expr env e1, 
+                 (match e2opt with
+                 | Some e2 -> expr env e2
+                 | None -> 
+                     debug (Expr e); raise Todo
+                 ), 
+                 expr env e3)
+  | Call (e, args) ->
+      A.Call (expr env e,
+             Common.map_filter (argument env) (args +> unparen +> uncomma))
+
+  | SizeOfExpr (_tok, e) ->
+      A.SizeOf(Left (expr env e))
+  | SizeOfType (_tok, (_, ft, _)) ->
+      A.SizeOf(Right (full_type env ft))
+  | GccConstructor ((_, ft, _), xs) ->
+      A.GccConstructor (full_type env ft,
+                       initialiser env (InitList xs))
+
+  | ConstructedObject (_, _) ->
+    pr2_once "BUG PARSING LOCAL DECL PROBABLY";
+    debug (Expr e); 
+    raise CplusplusConstruct
+
+  | StatementExpr _
+  | ExprTodo
+    ->
+      debug (Expr e); raise Todo
+  | Throw _|DeleteArray (_, _)|Delete (_, _)|New (_, _, _, _, _)
+  | CplusplusCast (_, _, _)
+  | This _
+  | RecordPtStarAccess (_, _)|RecordStarAccess (_, _)
+  | TypeId (_, _)
+      ->
+      debug (Expr e); raise CplusplusConstruct
+
+  | ParenExpr (_, e, _) -> expr env e
+
+and constant _env toks x = 
+  match x with
+  | Int s -> A.Int (s, List.hd toks)
+  | Float (s, _) -> A.Float (s, List.hd toks)
+  | Char (s, _) -> A.Char (s, List.hd toks)
+  | String (s, _) -> A.String (s, List.hd toks)
+
+  | Bool _ -> raise CplusplusConstruct
+  | MultiString -> A.String ("TODO", List.hd toks)
+
+and argument env x =
+  match x with
+  | Left e -> Some (expr env e)
+  (* TODO! can't just skip it ... *)
+  | Right _w -> 
+      pr2 ("type argument, maybe wrong typedef inference!");
+      debug (Argument x); 
+      None
+
+(* ---------------------------------------------------------------------- *)
+(* Type *)
+(* ---------------------------------------------------------------------- *)
+and full_type env x =
+  let (_qu, (t, ii)) = x in
+  match t with
+  | Pointer t -> A.TPointer (full_type env t)
+  | BaseType t ->
+      let s = 
+        (match t with
+        | Void -> "void"
+        | FloatType ft ->
+            (match ft with
+            | CFloat -> "float" 
+            | CDouble -> "double" 
+            | CLongDouble -> "long_double"
+            )
+        | IntType it ->
+            (match it with
+            | CChar -> "char"
+            | Si (si, base) ->
+                (match si with
+                | Signed -> ""
+                | UnSigned -> "unsigned_"
+                ) ^
+                (match base with
+                (* 'char' is a CChar and 'unsigned char' is a Si (_, CChar2) *)
+                | CChar2 -> "char"
+                | CShort -> "short"
+                | CInt -> "int"
+                | CLong -> "long"
+                (* gccext: *)
+                | CLongLong -> "long_long" 
+                )
+            | CBool | WChar_t ->
+                debug (Type x); raise CplusplusConstruct
+            )
+        )
+      in
+      A.TBase (s, List.hd ii)
+
+  | FunctionType ft -> A.TFunction (function_type env ft)
+  | Array ((_, eopt, _), ft) -> 
+    A.TArray (Common.map_opt (expr env) eopt, full_type env ft)
+  | TypeName (n) -> A.TTypeName (name env n)
+
+  | StructUnionName ((kind, _), name) ->
+      A.TStructName (struct_kind env kind, name)
+  | StructDef def ->
+      (match def with
+      { c_kind = (kind, tok);
+        c_name = name_opt;
+        c_inherit = _inh;
+        c_members = (_, xs, _);
+      } ->
+        let name =
+          match name_opt with
+          | None ->
+              incr cnt;
+              let s = spf "__anon_struct_%d" !cnt in
+              (s, tok)
+          | Some n -> name env n
+        in
+        let def' = { A.
+          s_name = name;
+          s_kind = struct_kind env kind;
+          s_flds = class_members_sequencable env xs +> List.flatten;
+        }
+        in
+        env.struct_defs_toadd <- def' :: env.struct_defs_toadd;
+        A.TStructName (struct_kind env kind, name)
+      )
+
+  | EnumName (_tok, name) -> A.TEnumName (name)
+  | EnumDef (tok, name_opt, xs) ->
+      let name =
+        match name_opt with
+        | None ->
+            incr cnt;
+            let s = spf "__anon_enum_%d" !cnt in
+            (s, tok)
+        | Some n -> n
+      in
+      let xs' =
+        xs +> unbrace +> uncomma +> List.map (fun eelem ->
+          let (name, e_opt) = eelem.e_name, eelem.e_val in
+          name, 
+          match e_opt with
+          | None -> None
+          | Some (_tok, e) -> Some (expr env e)
+        )
+      in
+      let def = name, xs' in
+      env.enum_defs_toadd <- def :: env.enum_defs_toadd;
+      A.TEnumName (name)
+
+  | TypeOf (_, _) -> 
+    debug (Type x); raise Todo
+  | TypenameKwd (_, _) | Reference _ ->
+    debug (Type x); raise CplusplusConstruct
+
+  | ParenType (_, t, _) -> full_type env t
+
+(* ---------------------------------------------------------------------- *)
+(* structure *)
+(* ---------------------------------------------------------------------- *)
+and class_member env x =
+  match x with
+  | MemberField (fldkind, _) ->
+      let xs = uncomma fldkind in
+      xs +> List.map (fieldkind env)
+  | ( UsingDeclInClass _| TemplateDeclInClass _
+    | QualifiedIdInClass (_, _)| MemberDecl _| MemberFunc _| Access (_, _)
+    ) ->
+      debug (ClassMember x); raise Todo
+  | EmptyField _ -> []
+
+
+and class_members_sequencable env xs =
+  ifdef_skipper xs (function IfdefStruct x -> Some x | _ -> None)
+    +> List.map (class_member_sequencable env)
+
+and class_member_sequencable env x =
+  match x with
+  | ClassElem x -> class_member env x
+  | CppDirectiveStruct dir ->
+      debug (Cpp dir); raise Todo
+  | IfdefStruct _ -> raise Impossible
+
+and fieldkind env x =
+  match x with
+  | FieldDecl decl ->
+      (match decl with
+      { v_namei = ni;
+        v_type = ft;
+        v_storage = sto;
+      } ->
+        (match ni, sto with
+        | Some (n, None), NoSto ->
+            { A.
+              fld_name = Some (name env n);
+              fld_type = full_type env ft;
+            }
+        | None, NoSto ->
+            { A.
+              fld_name = None;
+              fld_type = full_type env ft;
+            }
+
+        | _ -> debug (OneDecl decl); raise Todo
+        )
+      )
+  | BitField (name_opt, _tok, ft, e) -> 
+      let _ = expr env e in
+      { A.
+        fld_name = name_opt;
+        fld_type = full_type env ft;
+      }
+
+(* ---------------------------------------------------------------------- *)
+(* Misc *)
+(* ---------------------------------------------------------------------- *)
+
+and name _env x =
+  match x with
+  | (None, [], IdIdent (name)) -> name
+  | _ -> debug (Name x); raise CplusplusConstruct
+
+and struct_kind _env = function
+  | Struct -> A.Struct
+  | Union -> A.Union
+  | Class -> raise CplusplusConstruct

lang_c/parsing/ast_c_simple_build.mli

@@ -0,0 +1,12 @@
+
+exception ObsoleteConstruct of string * Parse_info.info
+exception CplusplusConstruct
+exception TodoConstruct of string * Parse_info.info
+exception CaseOutsideSwitch
+exception MacroInCase
+
+(* take care! this use Common.gensym to generate fresh unique anon structures
+ * so this function may return a different program given the same input
+ *)
+val program: 
+  Ast_cpp.program -> Ast_c.program

lang_c/parsing/lib_parsing_c.ml

@@ -0,0 +1,49 @@
+(* Yoann Padioleau
+ *
+ * Copyright (C) 2012 Facebook
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * version 2.1 as published by the Free Software Foundation, with the
+ * special exception on linking described in file license.txt.
+ * 
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
+ * license.txt for more details.
+ *)
+open Common
+
+module FT = File_type
+module V = Visitor_c
+
+(*****************************************************************************)
+(* Filenames *)
+(*****************************************************************************)
+
+let find_source_files_of_dir_or_files xs = 
+  Common.files_of_dir_or_files_no_vcs_nofilter xs 
+  +> List.filter (fun filename ->
+    match File_type.file_type_of_file filename with
+    | FT.PL (FT.C ("l" | "y")) -> false
+    | FT.PL (FT.C _) -> 
+      (* todo: fix syncweb so don't need this! *)
+      not (FT.is_syncweb_obj_file filename)
+    | _ -> false
+  ) +> Common.sort
+
+
+(*****************************************************************************)
+(* ii_of_any *)
+(*****************************************************************************)
+
+let ii_of_any any =
+  let globals = ref [] in
+  let visitor = V.mk_visitor { V.default_visitor with
+    V.kinfo = (fun (_k,_) i -> Common.push i globals)
+  }
+  in
+  visitor any;
+  List.rev !globals
+
+

lang_c/parsing/lib_parsing_c.mli

@@ -0,0 +1,6 @@
+
+val find_source_files_of_dir_or_files: 
+  Common.path list -> Common.filename list
+
+val ii_of_any: 
+  Ast_c.any -> Parse_info.info list

lang_c/parsing/meta_ast_c.ml

@@ -0,0 +1,357 @@
+
+(* generated by ocamltarzan with: camlp4o -o /tmp/yyy.ml -I pa/ pa_type_conv.cmo pa_vof.cmo  pr_o.cmo /tmp/xxx.ml  *)
+open Ast_c
+
+let vof_info x = Parse_info.vof_info x
+let vof_wrap _of_a (v1, v2) =
+  let v1 = _of_a v1
+  and _v2TODO = vof_info v2
+  in
+  Ocaml.VTuple [ v1 (* ; v2 *) ]
+
+and vof_unaryOp =
+  function
+  | Ast_cpp.GetRef -> Ocaml.VSum (("GetRef", []))
+  | Ast_cpp.DeRef -> Ocaml.VSum (("DeRef", []))
+  | Ast_cpp.UnPlus -> Ocaml.VSum (("UnPlus", []))
+  | Ast_cpp.UnMinus -> Ocaml.VSum (("UnMinus", []))
+  | Ast_cpp.Tilde -> Ocaml.VSum (("Tilde", []))
+  | Ast_cpp.Not -> Ocaml.VSum (("Not", []))
+  | Ast_cpp.GetRefLabel -> Ocaml.VSum (("GetRefLabel", []))
+
+let rec vof_assignOp =
+  function
+  | Ast_cpp.SimpleAssign -> Ocaml.VSum (("SimpleAssign", []))
+  | Ast_cpp.OpAssign v1 ->
+      let v1 = vof_arithOp v1 in Ocaml.VSum (("OpAssign", [ v1 ]))
+and vof_fixOp =
+  function
+  | Ast_cpp.Dec -> Ocaml.VSum (("Dec", []))
+  | Ast_cpp.Inc -> Ocaml.VSum (("Inc", []))
+and vof_binaryOp =
+  function
+  | Ast_cpp.Arith v1 -> let v1 = vof_arithOp v1 in Ocaml.VSum (("Arith", [ v1 ]))
+  | Ast_cpp.Logical v1 ->
+      let v1 = vof_logicalOp v1 in Ocaml.VSum (("Logical", [ v1 ]))
+and vof_arithOp =
+  function
+  | Ast_cpp.Plus -> Ocaml.VSum (("Plus", []))
+  | Ast_cpp.Minus -> Ocaml.VSum (("Minus", []))
+  | Ast_cpp.Mul -> Ocaml.VSum (("Mul", []))
+  | Ast_cpp.Div -> Ocaml.VSum (("Div", []))
+  | Ast_cpp.Mod -> Ocaml.VSum (("Mod", []))
+  | Ast_cpp.DecLeft -> Ocaml.VSum (("DecLeft", []))
+  | Ast_cpp.DecRight -> Ocaml.VSum (("DecRight", []))
+  | Ast_cpp.And -> Ocaml.VSum (("And", []))
+  | Ast_cpp.Or -> Ocaml.VSum (("Or", []))
+  | Ast_cpp.Xor -> Ocaml.VSum (("Xor", []))
+and vof_logicalOp =
+  function
+  | Ast_cpp.Inf -> Ocaml.VSum (("Inf", []))
+  | Ast_cpp.Sup -> Ocaml.VSum (("Sup", []))
+  | Ast_cpp.InfEq -> Ocaml.VSum (("InfEq", []))
+  | Ast_cpp.SupEq -> Ocaml.VSum (("SupEq", []))
+  | Ast_cpp.Eq -> Ocaml.VSum (("Eq", []))
+  | Ast_cpp.NotEq -> Ocaml.VSum (("NotEq", []))
+  | Ast_cpp.AndLog -> Ocaml.VSum (("AndLog", []))
+  | Ast_cpp.OrLog -> Ocaml.VSum (("OrLog", []))
+
+
+let vof_name v = vof_wrap Ocaml.vof_string v
+  
+let rec vof_type_ =
+  function
+  | TBase v1 -> let v1 = vof_name v1 in Ocaml.VSum (("TBase", [ v1 ]))
+  | TPointer v1 -> let v1 = vof_type_ v1 in Ocaml.VSum (("TPointer", [ v1 ]))
+  | TArray ((v1, v2)) ->
+      let v1 = Ocaml.vof_option vof_const_expr v1
+      and v2 = vof_type_ v2
+      in Ocaml.VSum (("TArray", [ v1; v2 ]))
+  | TFunction v1 ->
+      let v1 = vof_function_type v1 in Ocaml.VSum (("TFunction", [ v1 ]))
+  | TStructName ((v1, v2)) ->
+      let v1 = vof_struct_kind v1
+      and v2 = vof_name v2
+      in Ocaml.VSum (("TStructName", [ v1; v2 ]))
+  | TEnumName v1 ->
+      let v1 = vof_name v1 in Ocaml.VSum (("TEnumName", [ v1 ]))
+  | TTypeName v1 ->
+      let v1 = vof_name v1 in Ocaml.VSum (("TTypeName", [ v1 ]))
+and vof_function_type (v1, v2) =
+  let v1 = vof_type_ v1
+  and v2 = Ocaml.vof_list vof_parameter v2
+  in Ocaml.VTuple [ v1; v2 ]
+and vof_parameter { p_type = v_p_type; p_name = v_p_name } =
+  let bnds = [] in
+  let arg = Ocaml.vof_option vof_name v_p_name in
+  let bnd = ("p_name", arg) in
+  let bnds = bnd :: bnds in
+  let arg = vof_type_ v_p_type in
+  let bnd = ("p_type", arg) in let bnds = bnd :: bnds in Ocaml.VDict bnds
+and vof_struct_kind =
+  function
+  | Struct -> Ocaml.VSum (("Struct", []))
+  | Union -> Ocaml.VSum (("Union", []))
+and vof_const_expr v = vof_expr v
+  
+and vof_expr =
+  function
+  | Int v1 ->
+      let v1 = vof_wrap Ocaml.vof_string v1 in Ocaml.VSum (("Int", [ v1 ]))
+  | Float v1 ->
+      let v1 = vof_wrap Ocaml.vof_string v1 in Ocaml.VSum (("Float", [ v1 ]))
+  | String v1 ->
+      let v1 = vof_wrap Ocaml.vof_string v1
+      in Ocaml.VSum (("String", [ v1 ]))
+  | Char v1 ->
+      let v1 = vof_wrap Ocaml.vof_string v1 in Ocaml.VSum (("Char", [ v1 ]))
+  | Id v1 -> let v1 = vof_name v1 in Ocaml.VSum (("Id", [ v1 ]))
+  | Call ((v1, v2)) ->
+      let v1 = vof_expr v1
+      and v2 = Ocaml.vof_list vof_expr v2
+      in Ocaml.VSum (("Call", [ v1; v2 ]))
+  | Assign ((v1, v2, v3)) ->
+      let v1 = vof_wrap vof_assignOp v1
+      and v2 = vof_expr v2
+      and v3 = vof_expr v3
+      in Ocaml.VSum (("Assign", [ v1; v2; v3 ]))
+  | ArrayAccess ((v1, v2)) ->
+      let v1 = vof_expr v1
+      and v2 = vof_expr v2
+      in Ocaml.VSum (("ArrayAccess", [ v1; v2 ]))
+  | RecordPtAccess ((v1, v2)) ->
+      let v1 = vof_expr v1
+      and v2 = vof_name v2
+      in Ocaml.VSum (("RecordPtAccess", [ v1; v2 ]))
+  | Cast ((v1, v2)) ->
+      let v1 = vof_type_ v1
+      and v2 = vof_expr v2
+      in Ocaml.VSum (("Cast", [ v1; v2 ]))
+  | Postfix ((v1, v2)) ->
+      let v1 = vof_expr v1
+      and v2 = vof_wrap vof_fixOp v2
+      in Ocaml.VSum (("Postfix", [ v1; v2 ]))
+  | Infix ((v1, v2)) ->
+      let v1 = vof_expr v1
+      and v2 = vof_wrap vof_fixOp v2
+      in Ocaml.VSum (("Infix", [ v1; v2 ]))
+  | Unary ((v1, v2)) ->
+      let v1 = vof_expr v1
+      and v2 = vof_wrap vof_unaryOp v2
+      in Ocaml.VSum (("Unary", [ v1; v2 ]))
+  | Binary ((v1, v2, v3)) ->
+      let v1 = vof_expr v1
+      and v2 = vof_wrap vof_binaryOp v2
+      and v3 = vof_expr v3
+      in Ocaml.VSum (("Binary", [ v1; v2; v3 ]))
+  | CondExpr ((v1, v2, v3)) ->
+      let v1 = vof_expr v1
+      and v2 = vof_expr v2
+      and v3 = vof_expr v3
+      in Ocaml.VSum (("CondExpr", [ v1; v2; v3 ]))
+  | Sequence ((v1, v2)) ->
+      let v1 = vof_expr v1
+      and v2 = vof_expr v2
+      in Ocaml.VSum (("Sequence", [ v1; v2 ]))
+  | SizeOf v1 ->
+      let v1 = Ocaml.vof_either vof_expr vof_type_ v1
+      in Ocaml.VSum (("SizeOf", [ v1 ]))
+  | ArrayInit v1 ->
+      let v1 =
+        Ocaml.vof_list
+          (fun (v1, v2) ->
+             let v1 = Ocaml.vof_option vof_expr v1
+             and v2 = vof_expr v2
+             in Ocaml.VTuple [ v1; v2 ])
+          v1
+      in Ocaml.VSum (("ArrayInit", [ v1 ]))
+  | RecordInit v1 ->
+      let v1 =
+        Ocaml.vof_list
+          (fun (v1, v2) ->
+             let v1 = vof_name v1
+             and v2 = vof_expr v2
+             in Ocaml.VTuple [ v1; v2 ])
+          v1
+      in Ocaml.VSum (("RecordInit", [ v1 ]))
+  | GccConstructor ((v1, v2)) ->
+      let v1 = vof_type_ v1
+      and v2 = vof_expr v2
+      in Ocaml.VSum (("GccConstructor", [ v1; v2 ]))
+  
+let rec vof_stmt =
+  function
+  | ExprSt v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("ExprSt", [ v1 ]))
+  | Block v1 ->
+      let v1 = Ocaml.vof_list vof_stmt v1 in Ocaml.VSum (("Block", [ v1 ]))
+  | If ((v1, v2, v3)) ->
+      let v1 = vof_expr v1
+      and v2 = vof_stmt v2
+      and v3 = vof_stmt v3
+      in Ocaml.VSum (("If", [ v1; v2; v3 ]))
+  | Switch ((v1, v2)) ->
+      let v1 = vof_expr v1
+      and v2 = Ocaml.vof_list vof_case v2
+      in Ocaml.VSum (("Switch", [ v1; v2 ]))
+  | While ((v1, v2)) ->
+      let v1 = vof_expr v1
+      and v2 = vof_stmt v2
+      in Ocaml.VSum (("While", [ v1; v2 ]))
+  | DoWhile ((v1, v2)) ->
+      let v1 = vof_stmt v1
+      and v2 = vof_expr v2
+      in Ocaml.VSum (("DoWhile", [ v1; v2 ]))
+  | For ((v1, v2, v3, v4)) ->
+      let v1 = Ocaml.vof_option vof_expr v1
+      and v2 = Ocaml.vof_option vof_expr v2
+      and v3 = Ocaml.vof_option vof_expr v3
+      and v4 = vof_stmt v4
+      in Ocaml.VSum (("For", [ v1; v2; v3; v4 ]))
+  | Return v1 ->
+      let v1 = Ocaml.vof_option vof_expr v1
+      in Ocaml.VSum (("Return", [ v1 ]))
+  | Continue -> Ocaml.VSum (("Continue", []))
+  | Break -> Ocaml.VSum (("Break", []))
+  | Label ((v1, v2)) ->
+      let v1 = vof_name v1
+      and v2 = vof_stmt v2
+      in Ocaml.VSum (("Label", [ v1; v2 ]))
+  | Goto v1 -> let v1 = vof_name v1 in Ocaml.VSum (("Goto", [ v1 ]))
+  | Vars v1 ->
+      let v1 = Ocaml.vof_list vof_var_decl v1
+      in Ocaml.VSum (("Vars", [ v1 ]))
+  | Asm v1 ->
+      let v1 = Ocaml.vof_list vof_expr v1 in Ocaml.VSum (("Asm", [ v1 ]))
+and vof_case =
+  function
+  | Case ((v1, v2)) ->
+      let v1 = vof_expr v1
+      and v2 = Ocaml.vof_list vof_stmt v2
+      in Ocaml.VSum (("Case", [ v1; v2 ]))
+  | Default v1 ->
+      let v1 = Ocaml.vof_list vof_stmt v1 in Ocaml.VSum (("Default", [ v1 ]))
+and
+  vof_var_decl {
+                 v_name = v_v_name;
+                 v_type = v_v_type;
+                 v_storage = v_v_storage;
+                 v_init = v_v_init
+               } =
+  let bnds = [] in
+  let arg = Ocaml.vof_option vof_initialiser v_v_init in
+  let bnd = ("v_init", arg) in
+  let bnds = bnd :: bnds in
+  let arg = vof_storage v_v_storage in
+  let bnd = ("v_storage", arg) in
+  let bnds = bnd :: bnds in
+  let arg = vof_type_ v_v_type in
+  let bnd = ("v_type", arg) in
+  let bnds = bnd :: bnds in
+  let arg = vof_name v_v_name in
+  let bnd = ("v_name", arg) in let bnds = bnd :: bnds in Ocaml.VDict bnds
+and vof_initialiser v = vof_expr v
+and vof_storage =
+  function
+  | Extern -> Ocaml.VSum (("Extern", []))
+  | Static -> Ocaml.VSum (("Static", []))
+  | DefaultStorage -> Ocaml.VSum (("DefaultStorage", []))
+  
+let vof_func_def 
+    { f_name = v_f_name; f_type = v_f_type; f_body = v_f_body; 
+      f_static = v_f_static }
+                 =
+  let bnds = [] in
+  let arg = Ocaml.vof_list vof_stmt v_f_body in
+  let bnd = ("f_body", arg) in
+  let bnds = bnd :: bnds in
+  let arg = vof_function_type v_f_type in
+  let bnd = ("f_type", arg) in
+  let bnds = bnd :: bnds in
+  let arg = vof_name v_f_name in
+  let bnd = ("f_name", arg) in 
+  let bnds = bnd :: bnds in 
+  let arg = Ocaml.vof_bool v_f_static in
+  let bnd = ("f_static", arg) in 
+  let bnds = bnd :: bnds in 
+  Ocaml.VDict bnds
+  
+and vof_field_def { fld_name = v_fld_name; fld_type = v_fld_type } =
+  let bnds = [] in
+  let arg = vof_type_ v_fld_type in
+  let bnd = ("fld_type", arg) in
+  let bnds = bnd :: bnds in
+  let arg = Ocaml.vof_option vof_name v_fld_name in
+  let bnd = ("fld_name", arg) in let bnds = bnd :: bnds in Ocaml.VDict bnds
+  
+let vof_enum_def (v1, v2) =
+  let v1 = vof_name v1
+  and v2 =
+    Ocaml.vof_list
+      (fun (v1, v2) ->
+         let v1 = vof_name v1
+         and v2 = Ocaml.vof_option vof_expr v2
+         in Ocaml.VTuple [ v1; v2 ])
+      v2
+  in Ocaml.VTuple [ v1; v2 ]
+  
+let vof_type_def (v1, v2) =
+  let v1 = vof_name v1 and v2 = vof_type_ v2 in Ocaml.VTuple [ v1; v2 ]
+  
+let vof_define_body =
+  function
+  | CppExpr v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("CppExpr", [ v1 ]))
+  | CppStmt v1 -> let v1 = vof_stmt v1 in Ocaml.VSum (("CppStmt", [ v1 ]))
+(*  | CppEmpty -> Ocaml.VSum (("CppEmpty", [])) *)
+
+let
+  vof_struct_def { s_name = v_s_name; s_kind = v_s_kind; s_flds = v_s_flds }
+                 =
+  let bnds = [] in
+  let arg = Ocaml.vof_list vof_field_def v_s_flds in
+  let bnd = ("s_flds", arg) in
+  let bnds = bnd :: bnds in
+  let arg = vof_struct_kind v_s_kind in
+  let bnd = ("s_kind", arg) in
+  let bnds = bnd :: bnds in
+  let arg = vof_name v_s_name in
+  let bnd = ("s_name", arg) in let bnds = bnd :: bnds in Ocaml.VDict bnds
+
+ 
+let vof_toplevel =
+  function
+  | Define ((v1, v2)) ->
+      let v1 = vof_name v1
+      and v2 = vof_define_body v2
+      in Ocaml.VSum (("Define", [ v1; v2 ]))
+(*  | Undef v1 -> let v1 = vof_name v1 in Ocaml.VSum (("Undef", [ v1 ])) *)
+  | Include v1 ->
+      let v1 = vof_wrap Ocaml.vof_string v1
+      in Ocaml.VSum (("Include", [ v1 ]))
+  | Macro ((v1, v2, v3)) ->
+      let v1 = vof_name v1
+      and v2 = Ocaml.vof_list vof_name v2
+      and v3 = vof_define_body v3
+      in Ocaml.VSum (("Macro", [ v1; v2; v3 ]))
+  | StructDef v1 ->
+      let v1 = vof_struct_def v1 in Ocaml.VSum (("StructDef", [ v1 ]))
+  | TypeDef v1 ->
+      let v1 = vof_type_def v1 in Ocaml.VSum (("TypeDef", [ v1 ]))
+  | EnumDef v1 ->
+      let v1 = vof_enum_def v1 in Ocaml.VSum (("EnumDef", [ v1 ]))
+  | FuncDef v1 ->
+      let v1 = vof_func_def v1 in Ocaml.VSum (("FuncDef", [ v1 ]))
+  | Global v1 -> let v1 = vof_var_decl v1 in Ocaml.VSum (("Global", [ v1 ]))
+  | Prototype v1 ->
+      let v1 = vof_func_def v1 in Ocaml.VSum (("Prototype", [ v1 ]))
+  
+let vof_program v = Ocaml.vof_list vof_toplevel v
+  
+let vof_any =
+  function
+  | Expr v1 -> let v1 = vof_expr v1 in Ocaml.VSum (("Expr", [ v1 ]))
+  | Stmt v1 -> let v1 = vof_stmt v1 in Ocaml.VSum (("Stmt", [ v1 ]))
+  | Type v1 -> let v1 = vof_type_ v1 in Ocaml.VSum (("Type", [ v1 ]))
+  | Toplevel v1 ->
+      let v1 = vof_toplevel v1 in Ocaml.VSum (("Toplevel", [ v1 ]))
+  | Program v1 -> let v1 = vof_program v1 in Ocaml.VSum (("Program", [ v1 ]))
+  

lang_c/parsing/meta_ast_c.mli

@@ -0,0 +1,7 @@
+
+val vof_program: Ast_c.program -> Ocaml.v
+val vof_any: Ast_c.any -> Ocaml.v
+
+(* used by meta_ast_cil.ml *)
+val vof_type_: Ast_c.type_ -> Ocaml.v
+

lang_c/parsing/parse_c.ml

@@ -0,0 +1,51 @@
+(* Yoann Padioleau
+ *
+ * Copyright (C) 2012 Yoann Padioleau
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License (GPL)
+ * version 2 as published by the Free Software Foundation.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * file license.txt for more details.
+ *)
+open Common
+
+module Stat = Parse_info
+
+(*****************************************************************************)
+(* Prelude *)
+(*****************************************************************************)
+(*
+ * Just a small wrapper around the C++ parser
+ *)
+
+(*****************************************************************************)
+(* Types *)
+(*****************************************************************************)
+
+type program_and_tokens = 
+  Ast_c.program option * Parser_cpp.token list
+
+(*****************************************************************************)
+(* Main entry point *)
+(*****************************************************************************)
+
+let parse file =
+  let (ast2, stat) = Parse_cpp.parse_with_lang ~lang:Flag_parsing_cpp.C file in
+  let ast = ast2 +> List.map fst in
+  let toks = ast2 +> List.map snd +> List.flatten in
+  let ast_opt, stat = 
+    try Some (Ast_c_simple_build.program ast), stat
+    with exn ->
+      pr2 (spf "PB: Ast_c_build, on %s (exn = %s)" file (Common.exn_to_s exn));
+      (*None, { stat with Stat.bad = stat.Stat.bad + stat.Stat.correct } *)
+      raise exn
+  in
+  (ast_opt, toks), stat
+
+let parse_program file =
+  let (program_and_tokens, _stat) = parse file in
+  Common2.some (fst program_and_tokens)

lang_c/parsing/parse_c.mli

@@ -0,0 +1,13 @@
+
+(* the token list contains also the comment-tokens *)
+type program_and_tokens = 
+  Ast_c.program option * Parser_cpp.token list
+
+(* take care! this use Common.gensym to generate fresh unique anon structures
+ * so this function may return a different program given the same input
+ *)
+val parse: 
+  Common.filename -> (program_and_tokens * Parse_info.parsing_stat)
+
+val parse_program:
+  Common.filename -> Ast_c.program

lang_c/parsing/test_parsing_c.ml

@@ -0,0 +1,39 @@
+open Common
+
+module Stat = Parse_info
+(*****************************************************************************)
+(* Subsystem testing *)
+(*****************************************************************************)
+
+let test_parse_c xs =
+  let fullxs = Lib_parsing_c.find_source_files_of_dir_or_files xs in
+  let stat_list = ref [] in
+
+  fullxs +> (*Console.progress (fun k -> *) List.iter ((fun file -> 
+    (*k(); *)
+    pr (spf "PARSING: %s" file);
+    let (_xs, stat) = 
+      Parse_c.parse file 
+    in
+    Common.push stat stat_list;
+  ));
+  Stat.print_recurring_problematic_tokens !stat_list;
+  Stat.print_parsing_stat_list !stat_list;
+  ()
+
+let test_dump_c file =
+  let ast = Parse_c.parse_program file in
+  let v = Meta_ast_c.vof_program ast in
+  let s = Ocaml.string_of_v v in
+  pr s
+  
+(*****************************************************************************)
+(* Main entry for Arg *)
+(*****************************************************************************)
+
+let actions () = [
+    "-parse_c", "   <file or dir>", 
+    Common.mk_action_n_arg test_parse_c;
+    "-dump_c", "   <file>", 
+    Common.mk_action_1_arg test_dump_c;
+]

lang_c/parsing/test_parsing_c.mli

@@ -0,0 +1,3 @@
+
+val actions: unit -> Common.cmdline_actions
+

lang_c/parsing/visitor_c.ml

@@ -0,0 +1,227 @@
+(* Yoann Padioleau
+ * 
+ * Copyright (C) 2014 Facebook
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License (GPL)
+ * version 2 as published by the Free Software Foundation.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * file license.txt for more details.
+ *)
+
+open Ocaml
+open Ast_c
+
+(*****************************************************************************)
+(* Prelude *)
+(*****************************************************************************)
+
+(*****************************************************************************)
+(* Types *)
+(*****************************************************************************)
+
+(* hooks *)
+type visitor_in = {
+  kexpr: Ast_c.expr vin;
+  kinfo: Ast_cpp.tok vin;
+}
+and visitor_out = any -> unit
+and 'a vin = ('a  -> unit) * visitor_out -> 'a  -> unit
+
+module Ast_cpp = struct
+  let v_assignOp _ = ()
+  let v_fixOp _ = ()
+  let v_unaryOp _ = ()
+  let v_binaryOp _ = ()
+end
+
+let default_visitor = {
+  kinfo = (fun (k,_) x -> k x);
+  kexpr = (fun (k,_) x -> k x);
+}
+
+let (mk_visitor: visitor_in -> visitor_out) = fun vin ->
+
+let rec v_info x =
+  let k _ = () in
+  vin.kinfo (k, all_functions) x
+
+and v_wrap:'a. ('a -> unit) -> 'a wrap -> unit = 
+ fun _of_a (v1, v2) -> 
+   let v1 = _of_a v1 and v2 = v_info v2 in ()
+
+and v_name v = v_wrap v_string v
+
+and v_type_ =
+  function
+  | TBase v1 -> let v1 = v_name v1 in ()
+  | TPointer v1 -> let v1 = v_type_ v1 in ()
+  | TArray ((v1, v2)) ->
+      let v1 = v_option v_const_expr v1 and v2 = v_type_ v2 in ()
+  | TFunction v1 -> let v1 = v_function_type v1 in ()
+  | TStructName ((v1, v2)) ->
+      let v1 = v_struct_kind v1 and v2 = v_name v2 in ()
+  | TEnumName v1 -> let v1 = v_name v1 in ()
+  | TTypeName v1 -> let v1 = v_name v1 in ()
+
+and v_function_type (v1, v2) =
+  let v1 = v_type_ v1 and v2 = v_list v_parameter v2 in ()
+and v_parameter { p_type = v_p_type; p_name = v_p_name } =
+  let arg = v_type_ v_p_type in let arg = v_option v_name v_p_name in ()
+and v_struct_kind = function | Struct -> () | Union -> ()
+and v_const_expr v = v_expr v
+and v_expr x =
+  let k x = match x with
+  | Int v1 -> let v1 = v_wrap v_string v1 in ()
+  | Float v1 -> let v1 = v_wrap v_string v1 in ()
+  | String v1 -> let v1 = v_wrap v_string v1 in ()
+  | Char v1 -> let v1 = v_wrap v_string v1 in ()
+  | Id v1 -> let v1 = v_name v1 in ()
+  | Call ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_list v_argument v2 in ()
+  | Assign ((v1, v2, v3)) ->
+      let v1 = v_wrap Ast_cpp.v_assignOp v1
+      and v2 = v_expr v2
+      and v3 = v_expr v3
+      in ()
+  | ArrayAccess ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_expr v2 in ()
+  | RecordPtAccess ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_name v2 in ()
+  | Cast ((v1, v2)) -> let v1 = v_type_ v1 and v2 = v_expr v2 in ()
+  | Postfix ((v1, v2)) ->
+      let v1 = v_expr v1 and v2 = v_wrap Ast_cpp.v_fixOp v2 in ()
+  | Infix ((v1, v2)) ->
+      let v1 = v_expr v1 and v2 = v_wrap Ast_cpp.v_fixOp v2 in ()
+  | Unary ((v1, v2)) ->
+      let v1 = v_expr v1 and v2 = v_wrap Ast_cpp.v_unaryOp v2 in ()
+  | Binary ((v1, v2, v3)) ->
+      let v1 = v_expr v1
+      and v2 = v_wrap Ast_cpp.v_binaryOp v2
+      and v3 = v_expr v3
+      in ()
+  | CondExpr ((v1, v2, v3)) ->
+      let v1 = v_expr v1 and v2 = v_expr v2 and v3 = v_expr v3 in ()
+  | Sequence ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_expr v2 in ()
+  | SizeOf v1 -> let v1 = Ocaml.v_either v_expr v_type_ v1 in ()
+  | ArrayInit v1 ->
+      let v1 =
+        v_list
+          (fun (v1, v2) ->
+             let v1 = v_option v_expr v1 and v2 = v_expr v2 in ())
+          v1
+      in ()
+  | RecordInit v1 ->
+      let v1 =
+        v_list (fun (v1, v2) -> let v1 = v_name v1 and v2 = v_expr v2 in ())
+          v1
+      in ()
+  | GccConstructor ((v1, v2)) -> let v1 = v_type_ v1 and v2 = v_expr v2 in ()
+  in
+  vin.kexpr (k, all_functions) x
+and v_argument v = v_expr v
+  
+and v_stmt =
+  function
+  | ExprSt v1 -> let v1 = v_expr v1 in ()
+  | Block v1 -> let v1 = v_list v_stmt v1 in ()
+  | If ((v1, v2, v3)) ->
+      let v1 = v_expr v1 and v2 = v_stmt v2 and v3 = v_stmt v3 in ()
+  | Switch ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_list v_case v2 in ()
+  | While ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_stmt v2 in ()
+  | DoWhile ((v1, v2)) -> let v1 = v_stmt v1 and v2 = v_expr v2 in ()
+  | For ((v1, v2, v3, v4)) ->
+      let v1 = v_option v_expr v1
+      and v2 = v_option v_expr v2
+      and v3 = v_option v_expr v3
+      and v4 = v_stmt v4
+      in ()
+  | Return v1 -> let v1 = v_option v_expr v1 in ()
+  | Continue -> ()
+  | Break -> ()
+  | Label ((v1, v2)) -> let v1 = v_name v1 and v2 = v_stmt v2 in ()
+  | Goto v1 -> let v1 = v_name v1 in ()
+  | Vars v1 -> let v1 = v_list v_var_decl v1 in ()
+  | Asm v1 -> let v1 = v_list v_expr v1 in ()
+
+and v_case =
+  function
+  | Case ((v1, v2)) -> let v1 = v_expr v1 and v2 = v_list v_stmt v2 in ()
+  | Default v1 -> let v1 = v_list v_stmt v1 in ()
+and
+  v_var_decl {
+               v_name = v_v_name;
+               v_type = v_v_type;
+               v_storage = v_v_storage;
+               v_init = v_v_init
+             } =
+  let arg = v_name v_v_name in
+  let arg = v_type_ v_v_type in
+  let arg = v_storage v_v_storage in
+  let arg = v_option v_initialiser v_v_init in ()
+and v_initialiser v = v_expr v
+and v_storage = function | Extern -> () | Static -> () | DefaultStorage -> ()
+
+and  v_struct_def { s_name = v_s_name; s_kind = v_s_kind; s_flds = v_s_flds } =
+  let arg = v_name v_s_name in
+  let arg = v_struct_kind v_s_kind in
+  let arg = v_list v_field_def v_s_flds in ()
+  
+and v_field_def { fld_name = v_fld_name; fld_type = v_fld_type } =
+  let arg = v_option v_name v_fld_name in let arg = v_type_ v_fld_type in ()
+
+and v_func_def {
+                 f_name = v_f_name;
+                 f_type = v_f_type;
+                 f_body = v_f_body;
+                 f_static = v_f_static
+               } =
+  let arg = v_name v_f_name in
+  let arg = v_function_type v_f_type in
+  let arg = v_list v_stmt v_f_body in let arg = v_bool v_f_static in ()
+
+and v_define_body =
+  function
+  | CppExpr v1 -> let v1 = v_expr v1 in ()
+  | CppStmt v1 -> let v1 = v_stmt v1 in ()
+
+and v_toplevel =
+  function
+  | Include v1 -> let v1 = v_wrap v_string v1 in ()
+  | Define ((v1, v2)) -> let v1 = v_name v1 and v2 = v_define_body v2 in ()
+  | Macro ((v1, v2, v3)) ->
+      let v1 = v_name v1
+      and v2 = v_list v_name v2
+      and v3 = v_define_body v3
+      in ()
+  | StructDef v1 -> let v1 = v_struct_def v1 in ()
+  | TypeDef v1 -> let v1 = v_type_def v1 in ()
+  | EnumDef v1 -> let v1 = v_enum_def v1 in ()
+  | FuncDef v1 -> let v1 = v_func_def v1 in ()
+  | Global v1 -> let v1 = v_var_decl v1 in ()
+  | Prototype v1 -> let v1 = v_func_def v1 in ()
+
+and v_type_def (v1, v2) = let v1 = v_name v1 and v2 = v_type_ v2 in ()
+
+and v_enum_def (v1, v2) =
+  let v1 = v_name v1
+  and v2 =
+    v_list
+      (fun (v1, v2) -> let v1 = v_name v1 and v2 = v_option v_expr v2 in ())
+      v2
+  in ()
+
+and v_any =
+  function
+  | Expr v1 -> let v1 = v_expr v1 in ()
+  | Stmt v1 -> let v1 = v_stmt v1 in ()
+  | Type v1 -> let v1 = v_type_ v1 in ()
+  | Toplevel v1 -> let v1 = v_toplevel v1 in ()
+  | Program v1 -> let v1 = v_program v1 in ()
+
+and v_program v = v_list v_toplevel v
+
+ and all_functions x = v_any x
+in
+ v_any
+