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  = if !_handle_typedef || !_always_look_typedef then
  61   (match (Common.optionise (fun () -> Common.lookup_h_env s !_typedef)) with
  62   | Some TypeDefI -> true
  63   | Some IdentI -> false
  64   | None -> false
  65   )
  66   else false
  67
  68 let new_scope() = Common.new_scope_h _typedef
  69 let del_scope() = Common.del_scope_h _typedef
  70
  71 let add_typedef  s = Common.add_in_scope_h _typedef (s, TypeDefI)
  72 let add_ident s    = Common.add_in_scope_h _typedef (s, IdentI)
  73
  74 let add_typedef_root s =
  75   if !Flag_parsing_c.add_typedef_root
  76   then
  77     Hashtbl.add !_typedef.scoped_h s TypeDefI
  78   else add_typedef s (* have far more .failed without this *)
  79
  80
  81 (* Used by parse_c when do some error recovery. The parse error may
  82  * have some bad side effects on typedef hash, so recover this.
  83  *)
  84 let _old_state = ref (Common.clone_scoped_h_env !_typedef)
  85
  86 let save_typedef_state () =
  87   _old_state := Common.clone_scoped_h_env !_typedef
  88
  89 let restore_typedef_state () =
  90   _typedef := !_old_state
  91
  92
  93
  94
  95 type context =
  96   | InTopLevel
  97   | InFunction
  98   | InStruct
  99   | InParameter
 100   | InInitializer
 101   | InEnum
 102 (* InExpr ? but then orthogonal to InFunction. Could assign InExpr for
 103  * instance after a '=' as in 'a = (irq_t) b;'
 104  *)
 105
 106 let is_top_or_struct = function
 107   | InTopLevel
 108   | InStruct
 109       -> true
 110   | _ -> false
 111
 112 type lexer_hint = {
 113   mutable context_stack: context Common.stack;
 114  }
 115
 116 let default_hint () = {
 117   context_stack = [InTopLevel];
 118 }
 119
 120 let _lexer_hint = ref (default_hint())
 121
 122 let current_context () = List.hd !_lexer_hint.context_stack
 123 let push_context ctx =
 124   !_lexer_hint.context_stack <- ctx::!_lexer_hint.context_stack
 125 let pop_context () =
 126   !_lexer_hint.context_stack <- List.tl !_lexer_hint.context_stack
 127
 128
 129
 130 let lexer_reset_typedef saved_typedefs =
 131   begin
 132     _handle_typedef := true;
 133     (match saved_typedefs with
 134       None -> _typedef := Common.empty_scoped_h_env ()
 135     | Some t -> _typedef := t);
 136     _lexer_hint := (default_hint ());
 137   end