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