parsing_c/lexer_parser.ml

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