~ubuntu-branches/ubuntu/karmic/coccinelle/karmic

« back to all changes in this revision

Viewing changes to parsing_c/ast_c.ml

  • Committer: Bazaar Package Importer
  • Author(s): Євгеній Мещеряков
  • Date: 2009-05-11 15:32:24 UTC
  • mfrom: (1.1.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090511153224-1odv41d4dkr3y80v
Tags: 0.1.8.deb-2
Use common install Makefile target for both native and bytecode
build. This hopefully fixes FTBFS on bytecode archs 

Show diffs side-by-side

added added

removed removed

Lines of Context:
67
67
(* forunparser: *)
68
68
 
69
69
type posl = int * int (* line-col, for MetaPosValList, for position variables *)
 
70
 (* with sexp *)
70
71
 
71
72
(* the virtual position is set in Parsing_hacks.insert_virtual_positions *)
72
73
type virtual_position = Common.parse_info * int (* character offset *)
 
74
 (* with sexp *)
73
75
 
74
76
type parse_info = 
75
77
  (* Present both in ast and list of tokens *)
85
87
   * are used to be able to use '=' to compare big ast portions.
86
88
   *)
87
89
  | AbstractLineTok of Common.parse_info (* local to the abstracted thing *)
 
90
 (* with sexp *)
88
91
 
89
92
type info = { 
90
93
  pinfo : parse_info;
92
95
  (* this cocci_tag can be changed, which is how we can express some program
93
96
   * transformations by tagging the tokens involved in this transformation. 
94
97
   *)
95
 
  cocci_tag: (Ast_cocci.mcodekind * metavars_binding) ref;
 
98
  cocci_tag: (Ast_cocci.mcodekind * metavars_binding) option ref;
96
99
  (* set in comment_annotater_c.ml *)
97
100
  comments_tag: comments_around ref;
98
101
 
102
105
 
103
106
(* wrap2 is like wrap, except that I use it often for separator such
104
107
 * as ','. In that case the info is associated to the argument that
105
 
 * follows, so in 'a,b' I will have in the list [(a,[]); (b,[','])]. *)
 
108
 * follows, so in 'a,b' I will have in the list [(a,[]); (b,[','])]. 
 
109
 * 
 
110
 * wrap3 is like wrap, except that I use it in case sometimes it 
 
111
 * will be empty because the info will be included in a nested
 
112
 * entity (e.g. for Ident in expr because it's inlined in the name)
 
113
 * so user should never assume List.length wrap3 > 0.
 
114
 *)
106
115
and 'a wrap  = 'a * il
107
116
and 'a wrap2 = 'a * il
 
117
and 'a wrap3 = 'a * il (* * evotype*)
108
118
 
109
119
(* ------------------------------------------------------------------------- *)
110
120
(* Name *)
113
123
(* was called 'ident' before, but 'name' is I think better
114
124
 * as concatenated strings can be used not only for identifiers and for 
115
125
 * declarators, but also for fields, for labels, etc.
 
126
 * 
 
127
 * Note: because now the info is embeded in the name, the info for
 
128
 * expression like Ident, or types like Typename, are not anymore
 
129
 * stored in the expression or type. Hence if you assume this,
 
130
 * which was true before, you are now wrong. So never write code like
 
131
 * let (unwrape,_), ii = e  and use 'ii' believing it contains
 
132
 * the local ii to e. If you want to do that, use the appropiate
 
133
 * wrapper get_local_ii_of_expr_inlining_ii_of_name.
116
134
 *)
117
135
and name = 
118
136
   | RegularName of string wrap
150
168
 
151
169
 
152
170
and fullType = typeQualifier * typeC
153
 
 and typeC = typeCbis wrap
 
171
 and typeC = typeCbis wrap (* todo reput wrap3 *)
154
172
 
155
173
  and typeCbis =
156
174
  | BaseType        of baseType
208
226
     (* -------------------------------------- *)    
209
227
     and structUnion = Struct | Union
210
228
     and structType  = field list 
211
 
        and field = fieldbis wrap 
212
 
         and fieldbis = 
 
229
         and field = 
213
230
           | DeclarationField of field_declaration
214
231
           (* gccext: *)
215
 
           | EmptyField 
 
232
           | EmptyField of info
216
233
 
217
234
            (* cppext: *)
218
 
           | MacroStructDeclTodo
 
235
           | MacroDeclField of (string * argument wrap2 list) 
 
236
                               wrap (* optional ';'*)
219
237
 
220
238
            (* cppext: *)
221
239
           | CppDirectiveStruct of cpp_directive
265
283
(* ------------------------------------------------------------------------- *)
266
284
(* C expression *)
267
285
(* ------------------------------------------------------------------------- *)
268
 
and expression = (expressionbis * exp_info ref (* semantic: *)) wrap
 
286
and expression = (expressionbis * exp_info ref (* semantic: *)) wrap3
269
287
 and exp_info = exp_type option * test
270
288
  and exp_type = fullType (* Type_c.completed_and_simplified *) * local
271
289
    and local = LocalVar of parse_info | NotLocalVar (* cocci: *)
306
324
  | Cast           of fullType * expression                     
307
325
 
308
326
  (* gccext: *)        
309
 
  | StatementExpr of compound wrap (* (�)     new scope *) 
 
327
  | StatementExpr of compound wrap (* ( )     new scope *) 
310
328
  | Constructor  of fullType * initialiser wrap2 (* , *) list 
311
329
 
312
330
  (* forunparser: *)
315
333
  (* cppext: IfdefExpr TODO *)
316
334
 
317
335
  (* cppext: normmally just expression *)
318
 
  and argument = (expression, weird_argument) either
 
336
  and argument = (expression, weird_argument) Common.either
319
337
   and weird_argument = 
320
338
       | ArgType of parameterType
321
339
       | ArgAction of action_macro
336
354
    | String of (string * isWchar)
337
355
    | MultiString of string list (* can contain MacroString, todo: more info *)
338
356
    | Char   of (string * isWchar) (* normally it is equivalent to Int *)
339
 
    | Int    of (string  (* * intType*)) 
 
357
    | Int    of (string * intType)
340
358
    | Float  of (string * floatType)
341
359
 
342
360
    and isWchar = IsWchar | IsChar
373
391
 * 
374
392
 *)
375
393
 
376
 
and statement = statementbis wrap 
 
394
and statement = statementbis wrap3
377
395
 and statementbis = 
378
396
  | Labeled       of labeled
379
397
  | Compound      of compound   (* new scope *)
394
412
  
395
413
 
396
414
 
397
 
  and labeled = Label   of string * statement
 
415
  and labeled = Label   of name * statement
398
416
              | Case    of expression * statement 
399
417
              | CaseRange of expression * expression * statement (* gccext: *)
400
418
              | Default of statement
455
473
    (* cppext: *)
456
474
    | MacroIteration of string * argument wrap2 list * statement
457
475
 
458
 
  and jump  = Goto of string
 
476
  and jump  = Goto of name
459
477
            | Continue | Break 
460
478
            | Return   | ReturnExpr of expression
461
479
            | GotoComputed of expression (* gccext: goto *exp ';' *)
488
506
and declaration = 
489
507
  | DeclList of onedecl wrap2 (* , *) list wrap (* ; fakestart sto *)
490
508
  (* cppext: *)
491
 
  | MacroDecl of (string * argument wrap2 list) wrap
 
509
  | MacroDecl of (string * argument wrap2 list) wrap (* fakestart *)
492
510
 
493
511
     and onedecl = 
494
512
       { v_namei: (name * (info (* = *) * initialiser) option) option;
535
553
and definition = definitionbis wrap (* ( ) { } fakestart sto *)
536
554
  and definitionbis = 
537
555
  { f_name: name;
538
 
    f_type: functionType; (* todo? a functionType2 ? *)
 
556
    f_type: functionType; (* less? a functionType2 ? *)
539
557
    f_storage: storage;
540
558
    f_body: compound;
541
559
    f_attr: attribute list; (* gccext: *)
553
571
  | PragmaAndCo of il 
554
572
(*| Ifdef ? no, ifdefs are handled differently, cf ifdef_directive below *)
555
573
 
556
 
and define = string wrap (* #define s *) * (define_kind * define_val)
 
574
and define = string wrap (* #define s eol *) * (define_kind * define_val)
557
575
   and define_kind =
558
576
   | DefineVar
559
577
   | DefineFunc   of ((string wrap) wrap2 list) wrap (* () *)
650
668
(* ------------------------------------------------------------------------- *)
651
669
and program = toplevel list
652
670
 
653
 
 
654
671
(*****************************************************************************)
655
672
(* Cocci Bindings *)
656
673
(*****************************************************************************)
697
714
and comments_around = {
698
715
  mbefore: Token_c.comment_like_token list;
699
716
  mafter:  Token_c.comment_like_token list;
700
 
}
701
 
(* old: can do something simpler than CComment for coccinelle, cf above.
702
 
  mbefore: comment_and_relative_pos list;
703
 
  mafter:  comment_and_relative_pos list;
 
717
 
 
718
  (* less: could remove ? do something simpler than CComment for
 
719
   * coccinelle, cf above. *)
 
720
  mbefore2: comment_and_relative_pos list;
 
721
  mafter2:  comment_and_relative_pos list;
 
722
  }
704
723
  and comment_and_relative_pos = {
705
724
 
706
725
   minfo: Common.parse_info;
715
734
    *  cppbetween: bool; touse? if false positive 
716
735
    *  is_alone_in_line: bool; (*for labels, to avoid false positive*)
717
736
   *)
718
 
 }
 
737
  }
719
738
 
720
739
and comment = Common.parse_info
721
740
and com = comment list ref
722
 
*)
723
 
 
724
 
 
 
741
 
 
742
 (* with sexp *)
725
743
 
726
744
 
727
745
(*****************************************************************************)
736
754
let noInstr = (ExprStatement (None), [])
737
755
let noTypedefDef () = None
738
756
 
739
 
 
740
757
let emptyMetavarsBinding = 
741
758
  ([]: metavars_binding)
742
759
 
743
 
let emptyAnnot = 
 
760
let emptyAnnotCocci =
744
761
  (Ast_cocci.CONTEXT (Ast_cocci.NoPos,Ast_cocci.NOTHING),
745
762
  emptyMetavarsBinding)
746
763
 
 
764
let emptyAnnot = 
 
765
  (None: (Ast_cocci.mcodekind * metavars_binding) option)
 
766
 
 
767
(* compatibility mode *)
 
768
let mcode_and_env_of_cocciref aref = 
 
769
  match !aref with
 
770
  | Some x -> x
 
771
  | None -> emptyAnnotCocci
 
772
 
 
773
 
747
774
let emptyComments= {
748
775
  mbefore = [];
749
776
  mafter = [];
 
777
  mbefore2 = [];
 
778
  mafter2 = [];
750
779
}
751
780
 
752
781
 
781
810
 
782
811
let unwrap2 = fst
783
812
 
784
 
 
785
813
let unwrap_expr ((unwrap_e, typ), iie) = unwrap_e
786
814
let rewrap_expr ((_old_unwrap_e, typ), iie)  newe = ((newe, typ), iie)
787
815
 
 
816
let unwrap_typeC (qu, (typeC, ii)) = typeC
 
817
let rewrap_typeC (qu, (typeC, ii)) newtypeC  = (qu, (newtypeC, ii))
 
818
 
 
819
let unwrap_typeCbis (typeC, ii) = typeC
 
820
 
 
821
let unwrap_st (unwrap_st, ii) = unwrap_st
 
822
 
 
823
(* ------------------------------------------------------------------------- *)
 
824
let mk_e unwrap_e ii = (unwrap_e, noType()), ii
 
825
let mk_e_bis unwrap_e ty ii = (unwrap_e, ty), ii
 
826
 
 
827
let mk_ty typeC ii = nQ, (typeC, ii)
 
828
let mk_tybis typeC ii = (typeC, ii)
 
829
 
 
830
let mk_st unwrap_st ii = (unwrap_st, ii)
 
831
 
 
832
(* ------------------------------------------------------------------------- *)
 
833
let get_ii_typeC_take_care (typeC, ii) = ii
 
834
let get_ii_st_take_care (st, ii) = ii
 
835
let get_ii_expr_take_care (e, ii) = ii
 
836
 
 
837
let get_st_and_ii (st, ii) = st, ii
 
838
let get_ty_and_ii (qu, (typeC, ii)) = qu, (typeC, ii)
 
839
let get_e_and_ii  (e, ii) = e, ii
 
840
 
 
841
 
 
842
(* ------------------------------------------------------------------------- *)
788
843
let get_type_expr ((unwrap_e, typ), iie) = !typ
789
844
let set_type_expr ((unwrap_e, oldtyp), iie) newtyp =
790
845
  oldtyp := newtyp
800
855
  | Some (ft,local), _test -> Some local
801
856
  | None, _ -> None
802
857
 
803
 
 
804
 
 
805
 
let unwrap_typeC (qu, (typeC, ii)) = typeC
806
 
let rewrap_typeC (qu, (typeC, ii)) newtypeC  = (qu, (newtypeC, ii))
807
 
 
808
 
 
809
858
(* ------------------------------------------------------------------------- *)
810
859
let rewrap_str s ii =  
811
860
  {ii with pinfo =
818
867
let rewrap_pinfo pi ii =  
819
868
  {ii with pinfo = pi}
820
869
 
 
870
 
 
871
 
821
872
(* info about the current location *)
822
873
let get_pi = function
823
874
    OriginTok pi -> pi
828
879
(* original info *)
829
880
let get_opi = function
830
881
    OriginTok pi -> pi
831
 
  | ExpandedTok (pi,_) -> pi
 
882
  | ExpandedTok (pi,_) -> pi (* diff with get_pi *)
832
883
  | FakeTok (_,_) -> failwith "no position information"
833
884
  | AbstractLineTok pi -> pi
834
885
 
849
900
let get_orig_info f ii =
850
901
  match ii.pinfo with
851
902
    OriginTok pi -> f pi
852
 
  | ExpandedTok (pi,_) -> f pi
 
903
  | ExpandedTok (pi,_) -> f pi (* diff with get_info *)
853
904
  | FakeTok (_,(pi,_)) -> f pi
854
905
  | AbstractLineTok pi -> f pi
855
906
 
861
912
let line_of_info  ii = get_orig_info (function x -> x.Common.line)    ii
862
913
let col_of_info   ii = get_orig_info (function x -> x.Common.column)  ii
863
914
let file_of_info  ii = get_orig_info (function x -> x.Common.file)    ii
864
 
let mcode_of_info ii = fst (!(ii.cocci_tag))
 
915
let mcode_of_info ii = fst (mcode_and_env_of_cocciref ii.cocci_tag)
865
916
let pinfo_of_info ii = ii.pinfo
866
917
let parse_info_of_info ii = get_pi ii.pinfo
867
918
 
915
966
 
916
967
(* cocci: *)
917
968
let is_test (e : expression) =
918
 
  let (_,info) = unwrap e in
 
969
  let (_,info), _ = e in
919
970
  let (_,test) = !info in
920
971
  test =*= Test
921
972
 
973
1024
         Common.line = magic_real_number;
974
1025
         Common.column = magic_real_number}) in
975
1026
  {mbefore = []; (* duplicates mafter of the previous token *)
976
 
    mafter = List.map al_com (keep_cpp x.mafter)}
 
1027
   mafter = List.map al_com (keep_cpp x.mafter);
 
1028
   mbefore2=[];
 
1029
   mafter2=[];
 
1030
  }
977
1031
 
978
1032
let al_info_cpp tokenindex x = 
979
1033
  { pinfo =
1044
1098
(* Helpers, could also be put in lib_parsing_c.ml instead *)
1045
1099
(*****************************************************************************)
1046
1100
 
1047
 
let rec stmt_elems_of_sequencable xs = 
1048
 
  xs +> Common.map (fun x -> 
1049
 
    match x with
1050
 
    | StmtElem e -> [e]
1051
 
    | CppDirectiveStmt _
1052
 
    | IfdefStmt _ 
1053
 
        -> 
1054
 
        pr2_once ("stmt_elems_of_sequencable: filter a directive");
1055
 
        []
1056
 
    | IfdefStmt2 (_ifdef, xxs) -> 
1057
 
        pr2 ("stmt_elems_of_sequencable: IfdefStm2 TODO?");
1058
 
        xxs +> List.map (fun xs -> 
1059
 
          let xs' = stmt_elems_of_sequencable xs in
1060
 
          xs'
1061
 
        ) +> List.flatten
1062
 
  ) +> List.flatten
1063
 
        
1064
 
  
1065
 
 
1066
 
 
1067
1101
(* should maybe be in pretty_print_c ? *)
1068
1102
 
1069
1103
let s_of_inc_file inc_file = 
1089
1123
  +> List.map (fun (Attribute s, ii) -> s)
1090
1124
  +> Common.join ","
1091
1125
 
 
1126
 
 
1127
(* ------------------------------------------------------------------------- *)
1092
1128
let str_of_name ident = 
1093
1129
  match ident with
1094
1130
  | RegularName (s,ii) -> s
1100
1136
        (xs +> List.map (fun ((x,iix), iicomma) -> x) +> Common.join ",") ^
1101
1137
        ")"
1102
1138
 
1103
 
let info_of_name ident = 
1104
 
  match ident with
1105
 
  | RegularName (s,ii) -> List.hd ii
 
1139
let get_s_and_ii_of_name name = 
 
1140
  match name with
 
1141
  | RegularName (s, iis) -> s, iis 
 
1142
  | CppIdentBuilder ((s, iis), xs) -> s, iis
 
1143
  | CppVariadicName (s,iis)  -> 
 
1144
      let (iop, iis) = Common.tuple_of_list2 iis in
 
1145
      s, [iis]
1106
1146
  | CppConcatenatedName xs -> 
1107
1147
      (match xs with
1108
1148
      | [] -> raise Impossible
1109
 
      | ((x,ii1),ii2)::xs -> 
1110
 
          List.hd ii1
 
1149
      | ((s,iis),noiiop)::xs -> 
 
1150
          s, iis
1111
1151
      )
1112
 
  | CppVariadicName (s, ii) -> 
1113
 
      let (iihash, iis) = Common.tuple_of_list2 ii in 
1114
 
      iihash
1115
 
  | CppIdentBuilder ((s,iis),xs) -> 
1116
 
      List.hd iis
1117
 
 
1118
 
let get_s_and_ii_of_name name = 
1119
 
  match name with
1120
 
  | RegularName (s, iis) -> s, List.hd iis 
1121
 
  | _ -> raise Todo
1122
 
 
1123
 
 
 
1152
 
 
1153
let get_s_and_info_of_name name = 
 
1154
  let (s,ii) = get_s_and_ii_of_name name in
 
1155
  s, List.hd ii
 
1156
 
 
1157
let info_of_name name = 
 
1158
  let (s,ii) = get_s_and_ii_of_name name in
 
1159
  List.hd ii
 
1160
 
 
1161
let ii_of_name name = 
 
1162
  let (s,ii) = get_s_and_ii_of_name name in
 
1163
  ii
 
1164
 
 
1165
 
 
1166
 
 
1167
let get_local_ii_of_expr_inlining_ii_of_name e = 
 
1168
  let (ebis,_),ii = e in
 
1169
  match ebis, ii with
 
1170
  | Ident name, noii -> 
 
1171
      assert(null noii);
 
1172
      ii_of_name name
 
1173
  | RecordAccess   (e, name), ii -> 
 
1174
      ii @ ii_of_name name
 
1175
  | RecordPtAccess (e, name), ii -> 
 
1176
      ii @ ii_of_name name
 
1177
  | _, ii -> ii
 
1178
 
 
1179
 
 
1180
let get_local_ii_of_tybis_inlining_ii_of_name ty =
 
1181
  match ty with
 
1182
  | TypeName (name, _typ), [] -> ii_of_name name
 
1183
  | _, ii -> ii
 
1184
 
 
1185
(* only Label and Goto have name *)
 
1186
let get_local_ii_of_st_inlining_ii_of_name st =
 
1187
  match st with
 
1188
  | Labeled (Label (name, st)), ii -> ii_of_name name @ ii
 
1189
  | Jump (Goto name), ii -> 
 
1190
      let (i1, i3) = Common.tuple_of_list2 ii in
 
1191
      [i1] @ ii_of_name name @ [i3]
 
1192
  | _, ii -> ii
 
1193
 
 
1194
  
 
1195
 
 
1196
(* ------------------------------------------------------------------------- *)
1124
1197
let name_of_parameter param = 
1125
1198
  param.p_namei +> Common.map_option (str_of_name)
1126
1199