parsing_c/lexer_parser.ml

   1 (* Yoann Padioleau
   2  *
   3  * Copyright (C) 2010, University of Copenhagen DIKU and INRIA.
   4  * Copyright (C) 2002, 2006 Yoann Padioleau
   5  *
   6  * This program is free software; you can redistribute it and/or
   7  * modify it under the terms of the GNU General Public License (GPL)
   8  * version 2 as published by the Free Software Foundation.
   9  *
  10  * This program is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13  * file license.txt for more details.
  14  *)
  15 open Common
  16
  17 (* Tricks used to handle the ambiguity in the grammar with the typedef
  18  * which impose a cooperation between the lexer and the parser.
  19  *
  20  * An example by hughes casse: "in the symbol table, local
  21  * definition must replace type definition in order to correctly parse
  22  * local variable in functions body. This is the only way to correctly
  23  * handle this kind of exception, that is,
  24  *
  25  * typedef ... ID; int f(int *p) {int ID; return (ID) * *p;} If ID
  26  * isn't overload, last expression is parsed as a type cast, if it
  27  * isn't, this a multiplication."
  28  *
  29  * Why parse_typedef_fix2 ? Cos when introduce new variable, for
  30  * instance when declare parameters for a function such as int var_t,
  31  * then the var_t must not be lexed as a typedef, so we must disable
  32  * temporaly the typedef mechanism to allow variable with same name as
  33  * a typedef. *)
  34
  35 (* parse_typedef_fix *)
  36 let _handle_typedef = ref true
  37
  38 let _always_look_typedef = ref false
  39
  40 (* parse_typedef_fix2 *)
  41 let enable_typedef ()  = _handle_typedef := true
  42 let disable_typedef () = _handle_typedef := false
  43
  44 let is_enabled_typedef () = !_handle_typedef
  45
  46
  47
  48
  49 type identkind = TypeDefI | IdentI
  50
  51 (* Ca marche ce code ? on peut avoir un typedef puis un ident puis
  52  * un typedef nested ? oui car Hashtbl (dans scoped_h_env) gere l'historique.
  53  *
  54  * oldsimple:  but slow,  take 2 secondes on some C files
  55  *    let (typedef: typedef list list ref) = ref [[]]
  56  *)
  57 let (_typedef : (string, identkind) Common.scoped_h_env ref) =
  58   ref (Common.empty_scoped_h_env ())
  59
  60 let is_typedef s  =
  61   if !_handle_typedef || !_always_look_typedef then
  62   (match (Common.optionise (fun () -> Common.lookup_h_env s !_typedef)) with
  63   | Some TypeDefI -> true
  64   | Some IdentI -> false
  65   | None -> false
  66   )
  67   else false
  68
  69 let new_scope() = Common.new_scope_h _typedef
  70 let del_scope() = Common.del_scope_h _typedef
  71
  72 let add_typedef  s = Common.add_in_scope_h _typedef (s, TypeDefI)
  73 let add_ident s    = Common.add_in_scope_h _typedef (s, IdentI)
  74
  75 let add_typedef_root s =
  76   if !Flag_parsing_c.add_typedef_root
  77   then
  78     Hashtbl.add !_typedef.scoped_h s TypeDefI
  79   else add_typedef s (* have far more .failed without this *)
  80
  81
  82 (* Used by parse_c when do some error recovery. The parse error may
  83  * have some bad side effects on typedef hash, so recover this.
  84  *)
  85 let _old_state = ref (Common.clone_scoped_h_env !_typedef)
  86
  87 let save_typedef_state () =
  88   _old_state := Common.clone_scoped_h_env !_typedef
  89
  90 let restore_typedef_state () =
  91   _typedef := !_old_state
  92
  93
  94
  95
  96 type context =
  97   | InTopLevel
  98   | InFunction
  99   | InStruct
 100   | InParameter
 101   | InInitializer
 102   | InEnum
 103 (* InExpr ? but then orthogonal to InFunction. Could assign InExpr for
 104  * instance after a '=' as in 'a = (irq_t) b;'
 105  *)
 106
 107 let is_top_or_struct = function
 108   | InTopLevel
 109   | InStruct
 110       -> true
 111   | _ -> false
 112
 113 type lexer_hint = {
 114   mutable context_stack: context Common.stack;
 115  }
 116
 117 let default_hint () = {
 118   context_stack = [InTopLevel];
 119 }
 120
 121 let _lexer_hint = ref (default_hint())
 122
 123 let current_context () = List.hd !_lexer_hint.context_stack
 124 let push_context ctx =
 125   !_lexer_hint.context_stack <- ctx::!_lexer_hint.context_stack
 126 let pop_context () =
 127   !_lexer_hint.context_stack <- List.tl !_lexer_hint.context_stack
 128
 129
 130
 131 let lexer_reset_typedef saved_typedefs =
 132   begin
 133     _handle_typedef := true;
 134     (match saved_typedefs with
 135       None -> _typedef := Common.empty_scoped_h_env ()
 136     | Some t -> _typedef := t);
 137     _lexer_hint := (default_hint ());
 138   end