forked from coccinelle/coccinelle
-
Notifications
You must be signed in to change notification settings - Fork 1
/
iso_pattern.ml
2334 lines (2183 loc) · 84.9 KB
/
iso_pattern.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(*
* Copyright 2005-2008, Ecole des Mines de Nantes, University of Copenhagen
* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
* This file is part of Coccinelle.
*
* Coccinelle is free software: you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation, according to version 2 of the License.
*
* Coccinelle is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
*
* The authors reserve the right to distribute this or future versions of
* Coccinelle under other licenses.
*)
(* Potential problem: offset of mcode is not updated when an iso is
instantiated, implying that a term may end up with many mcodes with the
same offset. On the other hand, at the moment offset only seems to be used
before this phase. Furthermore add_dot_binding relies on the offset to
remain the same between matching an iso and instantiating it with bindings. *)
(* --------------------------------------------------------------------- *)
(* match a SmPL expression against a SmPL abstract syntax tree,
either - or + *)
module Ast = Ast_cocci
module Ast0 = Ast0_cocci
module V0 = Visitor_ast0
let current_rule = ref ""
(* --------------------------------------------------------------------- *)
type isomorphism =
Ast_cocci.metavar list * Ast0_cocci.anything list list * string (* name *)
let strip_info =
let mcode (term,_,_,_,_) =
(term,Ast0.NONE,Ast0.default_info(),Ast0.PLUS,ref Ast0.NoMetaPos) in
let donothing r k e =
let x = k e in
{(Ast0.wrap (Ast0.unwrap x)) with
Ast0.mcodekind = ref Ast0.PLUS;
Ast0.true_if_test = x.Ast0.true_if_test} in
V0.rebuilder
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
mcode
donothing donothing donothing donothing donothing donothing
donothing donothing donothing donothing donothing donothing donothing
donothing donothing
let anything_equal = function
(Ast0.DotsExprTag(d1),Ast0.DotsExprTag(d2)) ->
failwith "not a possible variable binding" (*not sure why these are pbs*)
| (Ast0.DotsInitTag(d1),Ast0.DotsInitTag(d2)) ->
failwith "not a possible variable binding"
| (Ast0.DotsParamTag(d1),Ast0.DotsParamTag(d2)) ->
failwith "not a possible variable binding"
| (Ast0.DotsStmtTag(d1),Ast0.DotsStmtTag(d2)) ->
(strip_info.V0.rebuilder_statement_dots d1) =
(strip_info.V0.rebuilder_statement_dots d2)
| (Ast0.DotsDeclTag(d1),Ast0.DotsDeclTag(d2)) ->
failwith "not a possible variable binding"
| (Ast0.DotsCaseTag(d1),Ast0.DotsCaseTag(d2)) ->
failwith "not a possible variable binding"
| (Ast0.IdentTag(d1),Ast0.IdentTag(d2)) ->
(strip_info.V0.rebuilder_ident d1) = (strip_info.V0.rebuilder_ident d2)
| (Ast0.ExprTag(d1),Ast0.ExprTag(d2)) ->
(strip_info.V0.rebuilder_expression d1) =
(strip_info.V0.rebuilder_expression d2)
| (Ast0.ArgExprTag(_),_) | (_,Ast0.ArgExprTag(_)) ->
failwith "not possible - only in isos1"
| (Ast0.TestExprTag(_),_) | (_,Ast0.TestExprTag(_)) ->
failwith "not possible - only in isos1"
| (Ast0.TypeCTag(d1),Ast0.TypeCTag(d2)) ->
(strip_info.V0.rebuilder_typeC d1) =
(strip_info.V0.rebuilder_typeC d2)
| (Ast0.InitTag(d1),Ast0.InitTag(d2)) ->
(strip_info.V0.rebuilder_initialiser d1) =
(strip_info.V0.rebuilder_initialiser d2)
| (Ast0.ParamTag(d1),Ast0.ParamTag(d2)) ->
(strip_info.V0.rebuilder_parameter d1) =
(strip_info.V0.rebuilder_parameter d2)
| (Ast0.DeclTag(d1),Ast0.DeclTag(d2)) ->
(strip_info.V0.rebuilder_declaration d1) =
(strip_info.V0.rebuilder_declaration d2)
| (Ast0.StmtTag(d1),Ast0.StmtTag(d2)) ->
(strip_info.V0.rebuilder_statement d1) =
(strip_info.V0.rebuilder_statement d2)
| (Ast0.CaseLineTag(d1),Ast0.CaseLineTag(d2)) ->
(strip_info.V0.rebuilder_case_line d1) =
(strip_info.V0.rebuilder_case_line d2)
| (Ast0.TopTag(d1),Ast0.TopTag(d2)) ->
(strip_info.V0.rebuilder_top_level d1) =
(strip_info.V0.rebuilder_top_level d2)
| (Ast0.IsoWhenTTag(_),_) | (_,Ast0.IsoWhenTTag(_)) ->
failwith "only for isos within iso phase"
| (Ast0.IsoWhenFTag(_),_) | (_,Ast0.IsoWhenFTag(_)) ->
failwith "only for isos within iso phase"
| (Ast0.IsoWhenTag(_),_) | (_,Ast0.IsoWhenTag(_)) ->
failwith "only for isos within iso phase"
| _ -> false
let term (var1,_,_,_,_) = var1
let dot_term (var1,_,info,_,_) = ("", var1 ^ (string_of_int info.Ast0.offset))
type reason =
NotPure of Ast0.pure * (string * string) * Ast0.anything
| NotPureLength of (string * string)
| ContextRequired of Ast0.anything
| NonMatch
| Braces of Ast0.statement
| Position of string * string
| TypeMatch of reason list
let rec interpret_reason name line reason printer =
Printf.printf
"warning: iso %s does not match the code below on line %d\n" name line;
printer(); Format.print_newline();
match reason with
NotPure(Ast0.Pure,(_,var),nonpure) ->
Printf.printf
"pure metavariable %s is matched against the following nonpure code:\n"
var;
Unparse_ast0.unparse_anything nonpure
| NotPure(Ast0.Context,(_,var),nonpure) ->
Printf.printf
"context metavariable %s is matched against the following\nnoncontext code:\n"
var;
Unparse_ast0.unparse_anything nonpure
| NotPure(Ast0.PureContext,(_,var),nonpure) ->
Printf.printf
"pure context metavariable %s is matched against the following\nnonpure or noncontext code:\n"
var;
Unparse_ast0.unparse_anything nonpure
| NotPureLength((_,var)) ->
Printf.printf
"pure metavariable %s is matched against too much or too little code\n"
var;
| ContextRequired(term) ->
Printf.printf
"the following code matched is not uniformly minus or context,\nor contains a disjunction:\n";
Unparse_ast0.unparse_anything term
| Braces(s) ->
Printf.printf "braces must be all minus (plus code allowed) or all\ncontext (plus code not allowed in the body) to match:\n";
Unparse_ast0.statement "" s;
Format.print_newline()
| Position(rule,name) ->
Printf.printf "position variable %s.%s conflicts with an isomorphism\n"
rule name;
| TypeMatch reason_list ->
List.iter (function r -> interpret_reason name line r printer)
reason_list
| _ -> failwith "not possible"
type 'a either = OK of 'a | Fail of reason
let add_binding var exp bindings =
let var = term var in
let attempt bindings =
try
let cur = List.assoc var bindings in
if anything_equal(exp,cur) then [bindings] else []
with Not_found -> [((var,exp)::bindings)] in
match List.concat(List.map attempt bindings) with
[] -> Fail NonMatch
| x -> OK x
let add_dot_binding var exp bindings =
let var = dot_term var in
let attempt bindings =
try
let cur = List.assoc var bindings in
if anything_equal(exp,cur) then [bindings] else []
with Not_found -> [((var,exp)::bindings)] in
match List.concat(List.map attempt bindings) with
[] -> Fail NonMatch
| x -> OK x
(* multi-valued *)
let add_multi_dot_binding var exp bindings =
let var = dot_term var in
let attempt bindings = [((var,exp)::bindings)] in
match List.concat(List.map attempt bindings) with
[] -> Fail NonMatch
| x -> OK x
let rec nub ls =
match ls with
[] -> []
| (x::xs) when (List.mem x xs) -> nub xs
| (x::xs) -> x::(nub xs)
(* --------------------------------------------------------------------- *)
let init_env = [[]]
let debug str m binding =
let res = m binding in
(match res with
None -> Printf.printf "%s: failed\n" str
| Some binding ->
List.iter
(function binding ->
Printf.printf "%s: %s\n" str
(String.concat " " (List.map (function (x,_) -> x) binding)))
binding);
res
let conjunct_bindings
(m1 : 'binding -> 'binding either)
(m2 : 'binding -> 'binding either)
(binding : 'binding) : 'binding either =
match m1 binding with Fail(reason) -> Fail(reason) | OK binding -> m2 binding
let rec conjunct_many_bindings = function
[] -> failwith "not possible"
| [x] -> x
| x::xs -> conjunct_bindings x (conjunct_many_bindings xs)
let mcode_equal (x,_,_,_,_) (y,_,_,_,_) = x = y
let return b binding = if b then OK binding else Fail NonMatch
let return_false reason binding = Fail reason
let match_option f t1 t2 =
match (t1,t2) with
(Some t1, Some t2) -> f t1 t2
| (None, None) -> return true
| _ -> return false
let bool_match_option f t1 t2 =
match (t1,t2) with
(Some t1, Some t2) -> f t1 t2
| (None, None) -> true
| _ -> false
(* context_required is for the example
if (
+ (int * )
x == NULL)
where we can't change x == NULL to eg NULL == x. So there can either be
nothing attached to the root or the term has to be all removed.
if would be nice if we knew more about the relationship between the - and +
code, because in the case where the + code is a separate statement in a
sequence, this is not a problem. Perhaps something could be done in
insert_plus
The example seems strange. Why isn't the cast attached to x?
*)
let is_context e =
!Flag.sgrep_mode2 or (* everything is context for sgrep *)
(match Ast0.get_mcodekind e with
Ast0.CONTEXT(cell) -> true
| _ -> false)
(* needs a special case when there is a Disj or an empty DOTS
the following stops at the statement level, and gives true if one
statement is replaced by another *)
let rec is_pure_context s =
!Flag.sgrep_mode2 or (* everything is context for sgrep *)
(match Ast0.unwrap s with
Ast0.Disj(starter,statement_dots_list,mids,ender) ->
List.for_all
(function x ->
match Ast0.undots x with
[s] -> is_pure_context s
| _ -> false (* could we do better? *))
statement_dots_list
| _ ->
(match Ast0.get_mcodekind s with
Ast0.CONTEXT(mc) ->
(match !mc with
(Ast.NOTHING,_,_) -> true
| _ -> false)
| Ast0.MINUS(mc) ->
(match !mc with
(* do better for the common case of replacing a stmt by another one *)
([[Ast.StatementTag(s)]],_) ->
(match Ast.unwrap s with
Ast.IfThen(_,_,_) -> false (* potentially dangerous *)
| _ -> true)
| (_,_) -> false)
| _ -> false))
let is_minus e =
match Ast0.get_mcodekind e with Ast0.MINUS(cell) -> true | _ -> false
let match_list matcher is_list_matcher do_list_match la lb =
let rec loop = function
([],[]) -> return true
| ([x],lb) when is_list_matcher x -> do_list_match x lb
| (x::xs,y::ys) -> conjunct_bindings (matcher x y) (loop (xs,ys))
| _ -> return false in
loop (la,lb)
let match_maker checks_needed context_required whencode_allowed =
let check_mcode pmc cmc binding =
if checks_needed
then
match Ast0.get_pos cmc with
(Ast0.MetaPos (name,_,_)) as x ->
(match Ast0.get_pos pmc with
Ast0.MetaPos (name1,_,_) ->
add_binding name1 (Ast0.MetaPosTag x) binding
| Ast0.NoMetaPos ->
let (rule,name) = Ast0.unwrap_mcode name in
Fail (Position(rule,name)))
| Ast0.NoMetaPos -> OK binding
else OK binding in
let match_dots matcher is_list_matcher do_list_match d1 d2 =
match (Ast0.unwrap d1, Ast0.unwrap d2) with
(Ast0.DOTS(la),Ast0.DOTS(lb))
| (Ast0.CIRCLES(la),Ast0.CIRCLES(lb))
| (Ast0.STARS(la),Ast0.STARS(lb)) ->
match_list matcher is_list_matcher (do_list_match d2) la lb
| _ -> return false in
let is_elist_matcher el =
match Ast0.unwrap el with Ast0.MetaExprList(_,_,_) -> true | _ -> false in
let is_plist_matcher pl =
match Ast0.unwrap pl with Ast0.MetaParamList(_,_,_) -> true | _ -> false in
let is_slist_matcher pl =
match Ast0.unwrap pl with Ast0.MetaStmtList(_,_) -> true | _ -> false in
let no_list _ = false in
let build_dots pattern data =
match Ast0.unwrap pattern with
Ast0.DOTS(_) -> Ast0.rewrap pattern (Ast0.DOTS(data))
| Ast0.CIRCLES(_) -> Ast0.rewrap pattern (Ast0.CIRCLES(data))
| Ast0.STARS(_) -> Ast0.rewrap pattern (Ast0.STARS(data)) in
let pure_sp_code =
let bind = Ast0.lub_pure in
let option_default = Ast0.Context in
let pure_mcodekind mc =
if !Flag.sgrep_mode2
then Ast0.PureContext
else
match mc with
Ast0.CONTEXT(mc) ->
(match !mc with
(Ast.NOTHING,_,_) -> Ast0.PureContext
| _ -> Ast0.Context)
| Ast0.MINUS(mc) ->
(match !mc with ([],_) -> Ast0.Pure | _ -> Ast0.Impure)
| _ -> Ast0.Impure in
let donothing r k e =
bind (pure_mcodekind (Ast0.get_mcodekind e)) (k e) in
let mcode m = pure_mcodekind (Ast0.get_mcode_mcodekind m) in
(* a case for everything that has a metavariable *)
(* pure is supposed to match only unitary metavars, not anything that
contains only unitary metavars *)
let ident r k i =
bind (bind (pure_mcodekind (Ast0.get_mcodekind i)) (k i))
(match Ast0.unwrap i with
Ast0.MetaId(name,_,pure) | Ast0.MetaFunc(name,_,pure)
| Ast0.MetaLocalFunc(name,_,pure) -> pure
| _ -> Ast0.Impure) in
let expression r k e =
bind (bind (pure_mcodekind (Ast0.get_mcodekind e)) (k e))
(match Ast0.unwrap e with
Ast0.MetaErr(name,_,pure)
| Ast0.MetaExpr(name,_,_,_,pure) | Ast0.MetaExprList(name,_,pure) ->
pure
| _ -> Ast0.Impure) in
let typeC r k t =
bind (bind (pure_mcodekind (Ast0.get_mcodekind t)) (k t))
(match Ast0.unwrap t with
Ast0.MetaType(name,pure) -> pure
| _ -> Ast0.Impure) in
let param r k p =
bind (bind (pure_mcodekind (Ast0.get_mcodekind p)) (k p))
(match Ast0.unwrap p with
Ast0.MetaParam(name,pure) | Ast0.MetaParamList(name,_,pure) -> pure
| _ -> Ast0.Impure) in
let stmt r k s =
bind (bind (pure_mcodekind (Ast0.get_mcodekind s)) (k s))
(match Ast0.unwrap s with
Ast0.MetaStmt(name,pure) | Ast0.MetaStmtList(name,pure) -> pure
| _ -> Ast0.Impure) in
V0.combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
mcode
donothing donothing donothing donothing donothing donothing
ident expression typeC donothing param donothing stmt donothing
donothing in
let add_pure_list_binding name pure is_pure builder1 builder2 lst =
match (checks_needed,pure) with
(true,Ast0.Pure) | (true,Ast0.Context) | (true,Ast0.PureContext) ->
(match lst with
[x] ->
if (Ast0.lub_pure (is_pure x) pure) = pure
then add_binding name (builder1 lst)
else return_false (NotPure (pure,term name,builder1 lst))
| _ -> return_false (NotPureLength (term name)))
| (false,_) | (_,Ast0.Impure) -> add_binding name (builder2 lst) in
let add_pure_binding name pure is_pure builder x =
match (checks_needed,pure) with
(true,Ast0.Pure) | (true,Ast0.Context) | (true,Ast0.PureContext) ->
if (Ast0.lub_pure (is_pure x) pure) = pure
then add_binding name (builder x)
else return_false (NotPure (pure,term name, builder x))
| (false,_) | (_,Ast0.Impure) -> add_binding name (builder x) in
let do_elist_match builder el lst =
match Ast0.unwrap el with
Ast0.MetaExprList(name,lenname,pure) ->
(*how to handle lenname? should it be an option type and always None?*)
failwith "expr list pattern not supported in iso"
(*add_pure_list_binding name pure
pure_sp_code.V0.combiner_expression
(function lst -> Ast0.ExprTag(List.hd lst))
(function lst -> Ast0.DotsExprTag(build_dots builder lst))
lst*)
| _ -> failwith "not possible" in
let do_plist_match builder pl lst =
match Ast0.unwrap pl with
Ast0.MetaParamList(name,lename,pure) ->
failwith "param list pattern not supported in iso"
(*add_pure_list_binding name pure
pure_sp_code.V0.combiner_parameter
(function lst -> Ast0.ParamTag(List.hd lst))
(function lst -> Ast0.DotsParamTag(build_dots builder lst))
lst*)
| _ -> failwith "not possible" in
let do_slist_match builder sl lst =
match Ast0.unwrap sl with
Ast0.MetaStmtList(name,pure) ->
add_pure_list_binding name pure
pure_sp_code.V0.combiner_statement
(function lst -> Ast0.StmtTag(List.hd lst))
(function lst -> Ast0.DotsStmtTag(build_dots builder lst))
lst
| _ -> failwith "not possible" in
let do_nolist_match _ _ = failwith "not possible" in
let rec match_ident pattern id =
match Ast0.unwrap pattern with
Ast0.MetaId(name,_,pure) ->
(add_pure_binding name pure pure_sp_code.V0.combiner_ident
(function id -> Ast0.IdentTag id) id)
| Ast0.MetaFunc(name,_,pure) -> failwith "metafunc not supported"
| Ast0.MetaLocalFunc(name,_,pure) -> failwith "metalocalfunc not supported"
| up ->
if not(checks_needed) or not(context_required) or is_context id
then
match (up,Ast0.unwrap id) with
(Ast0.Id(namea),Ast0.Id(nameb)) ->
if mcode_equal namea nameb
then check_mcode namea nameb
else return false
| (Ast0.OptIdent(ida),Ast0.OptIdent(idb))
| (Ast0.UniqueIdent(ida),Ast0.UniqueIdent(idb)) ->
match_ident ida idb
| (_,Ast0.OptIdent(idb))
| (_,Ast0.UniqueIdent(idb)) -> match_ident pattern idb
| _ -> return false
else return_false (ContextRequired (Ast0.IdentTag id)) in
(* should we do something about matching metavars against ...? *)
let rec match_expr pattern expr =
match Ast0.unwrap pattern with
Ast0.MetaExpr(name,_,ty,form,pure) ->
let form_ok =
match (form,expr) with
(Ast.ANY,_) -> true
| (Ast.CONST,e) ->
let rec matches e =
match Ast0.unwrap e with
Ast0.Constant(c) -> true
| Ast0.Cast(lp,ty,rp,e) -> matches e
| Ast0.SizeOfExpr(se,exp) -> true
| Ast0.SizeOfType(se,lp,ty,rp) -> true
| Ast0.MetaExpr(nm,_,_,Ast.CONST,p) ->
(Ast0.lub_pure p pure) = pure
| _ -> false in
matches e
| (Ast.ID,e) | (Ast.LocalID,e) ->
let rec matches e =
match Ast0.unwrap e with
Ast0.Ident(c) -> true
| Ast0.Cast(lp,ty,rp,e) -> matches e
| Ast0.MetaExpr(nm,_,_,Ast.ID,p) ->
(Ast0.lub_pure p pure) = pure
| _ -> false in
matches e in
if form_ok
then
match ty with
Some ts ->
if List.exists
(function Type_cocci.MetaType(_,_,_) -> true | _ -> false)
ts
then
(match ts with
[Type_cocci.MetaType(tyname,_,_)] ->
let expty =
match (Ast0.unwrap expr,Ast0.get_type expr) with
(* easier than updating type inferencer to manage multiple
types *)
(Ast0.MetaExpr(_,_,Some tts,_,_),_) -> Some tts
| (_,Some ty) -> Some [ty]
| _ -> None in
(match expty with
Some expty ->
let tyname = Ast0.rewrap_mcode name tyname in
conjunct_bindings
(add_pure_binding name pure
pure_sp_code.V0.combiner_expression
(function expr -> Ast0.ExprTag expr)
expr)
(function bindings ->
let attempts =
List.map
(function expty ->
(try
add_pure_binding tyname Ast0.Impure
(function _ -> Ast0.Impure)
(function ty -> Ast0.TypeCTag ty)
(Ast0.rewrap expr
(Ast0.reverse_type expty))
bindings
with Ast0.TyConv ->
Printf.printf
"warning: unconvertible type";
return false bindings))
expty in
if List.exists
(function Fail _ -> false | OK x -> true)
attempts
then
(* not sure why this is ok. can there be more
than one OK? *)
OK (List.concat
(List.map
(function Fail _ -> [] | OK x -> x)
attempts))
else
Fail
(TypeMatch
(List.map
(function
Fail r -> r
| OK x -> failwith "not possible")
attempts)))
| _ ->
(*Printf.printf
"warning: type metavar can only match one type";*)
return false)
| _ ->
failwith
"mixture of metatype and other types not supported")
else
let expty = Ast0.get_type expr in
if List.exists (function t -> Type_cocci.compatible t expty) ts
then
add_pure_binding name pure
pure_sp_code.V0.combiner_expression
(function expr -> Ast0.ExprTag expr)
expr
else return false
| None ->
add_pure_binding name pure pure_sp_code.V0.combiner_expression
(function expr -> Ast0.ExprTag expr)
expr
else return false
| Ast0.MetaErr(namea,_,pure) -> failwith "metaerr not supported"
| Ast0.MetaExprList(_,_,_) -> failwith "metaexprlist not supported"
| up ->
if not(checks_needed) or not(context_required) or is_context expr
then
match (up,Ast0.unwrap expr) with
(Ast0.Ident(ida),Ast0.Ident(idb)) ->
match_ident ida idb
| (Ast0.Constant(consta),Ast0.Constant(constb)) ->
if mcode_equal consta constb
then check_mcode consta constb
else return false
| (Ast0.FunCall(fna,lp1,argsa,rp1),Ast0.FunCall(fnb,lp,argsb,rp)) ->
conjunct_many_bindings
[check_mcode lp1 lp; check_mcode rp1 rp; match_expr fna fnb;
match_dots match_expr is_elist_matcher do_elist_match
argsa argsb]
| (Ast0.Assignment(lefta,opa,righta,_),
Ast0.Assignment(leftb,opb,rightb,_)) ->
if mcode_equal opa opb
then
conjunct_many_bindings
[check_mcode opa opb; match_expr lefta leftb;
match_expr righta rightb]
else return false
| (Ast0.CondExpr(exp1a,lp1,exp2a,rp1,exp3a),
Ast0.CondExpr(exp1b,lp,exp2b,rp,exp3b)) ->
conjunct_many_bindings
[check_mcode lp1 lp; check_mcode rp1 rp;
match_expr exp1a exp1b; match_option match_expr exp2a exp2b;
match_expr exp3a exp3b]
| (Ast0.Postfix(expa,opa),Ast0.Postfix(expb,opb)) ->
if mcode_equal opa opb
then
conjunct_bindings (check_mcode opa opb) (match_expr expa expb)
else return false
| (Ast0.Infix(expa,opa),Ast0.Infix(expb,opb)) ->
if mcode_equal opa opb
then
conjunct_bindings (check_mcode opa opb) (match_expr expa expb)
else return false
| (Ast0.Unary(expa,opa),Ast0.Unary(expb,opb)) ->
if mcode_equal opa opb
then
conjunct_bindings (check_mcode opa opb) (match_expr expa expb)
else return false
| (Ast0.Binary(lefta,opa,righta),Ast0.Binary(leftb,opb,rightb)) ->
if mcode_equal opa opb
then
conjunct_many_bindings
[check_mcode opa opb; match_expr lefta leftb;
match_expr righta rightb]
else return false
| (Ast0.Paren(lp1,expa,rp1),Ast0.Paren(lp,expb,rp)) ->
conjunct_many_bindings
[check_mcode lp1 lp; check_mcode rp1 rp; match_expr expa expb]
| (Ast0.ArrayAccess(exp1a,lb1,exp2a,rb1),
Ast0.ArrayAccess(exp1b,lb,exp2b,rb)) ->
conjunct_many_bindings
[check_mcode lb1 lb; check_mcode rb1 rb;
match_expr exp1a exp1b; match_expr exp2a exp2b]
| (Ast0.RecordAccess(expa,opa,fielda),
Ast0.RecordAccess(expb,op,fieldb))
| (Ast0.RecordPtAccess(expa,opa,fielda),
Ast0.RecordPtAccess(expb,op,fieldb)) ->
conjunct_many_bindings
[check_mcode opa op; match_expr expa expb;
match_ident fielda fieldb]
| (Ast0.Cast(lp1,tya,rp1,expa),Ast0.Cast(lp,tyb,rp,expb)) ->
conjunct_many_bindings
[check_mcode lp1 lp; check_mcode rp1 rp;
match_typeC tya tyb; match_expr expa expb]
| (Ast0.SizeOfExpr(szf1,expa),Ast0.SizeOfExpr(szf,expb)) ->
conjunct_bindings (check_mcode szf1 szf) (match_expr expa expb)
| (Ast0.SizeOfType(szf1,lp1,tya,rp1),
Ast0.SizeOfType(szf,lp,tyb,rp)) ->
conjunct_many_bindings
[check_mcode lp1 lp; check_mcode rp1 rp;
check_mcode szf1 szf; match_typeC tya tyb]
| (Ast0.TypeExp(tya),Ast0.TypeExp(tyb)) ->
match_typeC tya tyb
| (Ast0.EComma(cm1),Ast0.EComma(cm)) -> check_mcode cm1 cm
| (Ast0.DisjExpr(_,expsa,_,_),_) ->
failwith "not allowed in the pattern of an isomorphism"
| (Ast0.NestExpr(_,exp_dotsa,_,_,_),_) ->
failwith "not allowed in the pattern of an isomorphism"
| (Ast0.Edots(d,None),Ast0.Edots(d1,None))
| (Ast0.Ecircles(d,None),Ast0.Ecircles(d1,None))
| (Ast0.Estars(d,None),Ast0.Estars(d1,None)) -> check_mcode d d1
| (Ast0.Edots(ed,None),Ast0.Edots(ed1,Some wc))
| (Ast0.Ecircles(ed,None),Ast0.Ecircles(ed1,Some wc))
| (Ast0.Estars(ed,None),Ast0.Estars(ed1,Some wc)) ->
(* hope that mcode of edots is unique somehow *)
conjunct_bindings (check_mcode ed ed1)
(let (edots_whencode_allowed,_,_) = whencode_allowed in
if edots_whencode_allowed
then add_dot_binding ed (Ast0.ExprTag wc)
else
(Printf.printf
"warning: not applying iso because of whencode";
return false))
| (Ast0.Edots(_,Some _),_) | (Ast0.Ecircles(_,Some _),_)
| (Ast0.Estars(_,Some _),_) ->
failwith "whencode not allowed in a pattern1"
| (Ast0.OptExp(expa),Ast0.OptExp(expb))
| (Ast0.UniqueExp(expa),Ast0.UniqueExp(expb)) -> match_expr expa expb
| (_,Ast0.OptExp(expb))
| (_,Ast0.UniqueExp(expb)) -> match_expr pattern expb
| _ -> return false
else return_false (ContextRequired (Ast0.ExprTag expr))
(* the special case for function types prevents the eg T X; -> T X = E; iso
from applying, which doesn't seem very relevant, but it also avoids a
mysterious bug that is obtained with eg int attach(...); *)
and match_typeC pattern t =
match Ast0.unwrap pattern with
Ast0.MetaType(name,pure) ->
(match Ast0.unwrap t with
Ast0.FunctionType(tya,lp1a,paramsa,rp1a) -> return false
| _ ->
add_pure_binding name pure pure_sp_code.V0.combiner_typeC
(function ty -> Ast0.TypeCTag ty)
t)
| up ->
if not(checks_needed) or not(context_required) or is_context t
then
match (up,Ast0.unwrap t) with
(Ast0.ConstVol(cva,tya),Ast0.ConstVol(cvb,tyb)) ->
if mcode_equal cva cvb
then
conjunct_bindings (check_mcode cva cvb) (match_typeC tya tyb)
else return false
| (Ast0.BaseType(tya,signa),Ast0.BaseType(tyb,signb)) ->
if (mcode_equal tya tyb &&
bool_match_option mcode_equal signa signb)
then
conjunct_bindings (check_mcode tya tyb)
(match_option check_mcode signa signb)
else return false
| (Ast0.ImplicitInt(signa),Ast0.ImplicitInt(signb)) ->
if mcode_equal signa signb
then check_mcode signa signb
else return false
| (Ast0.Pointer(tya,star1),Ast0.Pointer(tyb,star)) ->
conjunct_bindings (check_mcode star1 star) (match_typeC tya tyb)
| (Ast0.FunctionPointer(tya,lp1a,stara,rp1a,lp2a,paramsa,rp2a),
Ast0.FunctionPointer(tyb,lp1b,starb,rp1b,lp2b,paramsb,rp2b)) ->
conjunct_many_bindings
[check_mcode stara starb; check_mcode lp1a lp1b;
check_mcode rp1a rp1b; check_mcode lp2a lp2b;
check_mcode rp2a rp2b; match_typeC tya tyb;
match_dots match_param is_plist_matcher
do_plist_match paramsa paramsb]
| (Ast0.FunctionType(tya,lp1a,paramsa,rp1a),
Ast0.FunctionType(tyb,lp1b,paramsb,rp1b)) ->
conjunct_many_bindings
[check_mcode lp1a lp1b; check_mcode rp1a rp1b;
match_option match_typeC tya tyb;
match_dots match_param is_plist_matcher do_plist_match
paramsa paramsb]
| (Ast0.Array(tya,lb1,sizea,rb1),Ast0.Array(tyb,lb,sizeb,rb)) ->
conjunct_many_bindings
[check_mcode lb1 lb; check_mcode rb1 rb;
match_typeC tya tyb; match_option match_expr sizea sizeb]
| (Ast0.StructUnionName(kinda,Some namea),
Ast0.StructUnionName(kindb,Some nameb)) ->
if mcode_equal kinda kindb
then
conjunct_bindings (check_mcode kinda kindb)
(match_ident namea nameb)
else return false
| (Ast0.StructUnionDef(tya,lb1,declsa,rb1),
Ast0.StructUnionDef(tyb,lb,declsb,rb)) ->
conjunct_many_bindings
[check_mcode lb1 lb; check_mcode rb1 rb;
match_typeC tya tyb;
match_dots match_decl no_list do_nolist_match declsa declsb]
| (Ast0.TypeName(namea),Ast0.TypeName(nameb)) ->
if mcode_equal namea nameb
then check_mcode namea nameb
else return false
| (Ast0.DisjType(_,typesa,_,_),Ast0.DisjType(_,typesb,_,_)) ->
failwith "not allowed in the pattern of an isomorphism"
| (Ast0.OptType(tya),Ast0.OptType(tyb))
| (Ast0.UniqueType(tya),Ast0.UniqueType(tyb)) -> match_typeC tya tyb
| (_,Ast0.OptType(tyb))
| (_,Ast0.UniqueType(tyb)) -> match_typeC pattern tyb
| _ -> return false
else return_false (ContextRequired (Ast0.TypeCTag t))
and match_decl pattern d =
if not(checks_needed) or not(context_required) or is_context d
then
match (Ast0.unwrap pattern,Ast0.unwrap d) with
(Ast0.Init(stga,tya,ida,eq1,inia,sc1),
Ast0.Init(stgb,tyb,idb,eq,inib,sc)) ->
if bool_match_option mcode_equal stga stgb
then
conjunct_many_bindings
[check_mcode eq1 eq; check_mcode sc1 sc;
match_option check_mcode stga stgb;
match_typeC tya tyb; match_ident ida idb;
match_init inia inib]
else return false
| (Ast0.UnInit(stga,tya,ida,sc1),Ast0.UnInit(stgb,tyb,idb,sc)) ->
if bool_match_option mcode_equal stga stgb
then
conjunct_many_bindings
[check_mcode sc1 sc; match_option check_mcode stga stgb;
match_typeC tya tyb; match_ident ida idb]
else return false
| (Ast0.MacroDecl(namea,lp1,argsa,rp1,sc1),
Ast0.MacroDecl(nameb,lp,argsb,rp,sc)) ->
conjunct_many_bindings
[match_ident namea nameb;
check_mcode lp1 lp; check_mcode rp1 rp;
check_mcode sc1 sc;
match_dots match_expr is_elist_matcher do_elist_match
argsa argsb]
| (Ast0.TyDecl(tya,sc1),Ast0.TyDecl(tyb,sc)) ->
conjunct_bindings (check_mcode sc1 sc) (match_typeC tya tyb)
| (Ast0.Typedef(stga,tya,ida,sc1),Ast0.Typedef(stgb,tyb,idb,sc)) ->
conjunct_bindings (check_mcode sc1 sc)
(conjunct_bindings (match_typeC tya tyb) (match_typeC ida idb))
| (Ast0.DisjDecl(_,declsa,_,_),Ast0.DisjDecl(_,declsb,_,_)) ->
failwith "not allowed in the pattern of an isomorphism"
| (Ast0.Ddots(d1,None),Ast0.Ddots(d,None)) -> check_mcode d1 d
| (Ast0.Ddots(dd,None),Ast0.Ddots(d,Some wc)) ->
conjunct_bindings (check_mcode dd d)
(* hope that mcode of ddots is unique somehow *)
(let (ddots_whencode_allowed,_,_) = whencode_allowed in
if ddots_whencode_allowed
then add_dot_binding dd (Ast0.DeclTag wc)
else
(Printf.printf "warning: not applying iso because of whencode";
return false))
| (Ast0.Ddots(_,Some _),_) ->
failwith "whencode not allowed in a pattern1"
| (Ast0.OptDecl(decla),Ast0.OptDecl(declb))
| (Ast0.UniqueDecl(decla),Ast0.UniqueDecl(declb)) ->
match_decl decla declb
| (_,Ast0.OptDecl(declb))
| (_,Ast0.UniqueDecl(declb)) ->
match_decl pattern declb
| _ -> return false
else return_false (ContextRequired (Ast0.DeclTag d))
and match_init pattern i =
if not(checks_needed) or not(context_required) or is_context i
then
match (Ast0.unwrap pattern,Ast0.unwrap i) with
(Ast0.InitExpr(expa),Ast0.InitExpr(expb)) ->
match_expr expa expb
| (Ast0.InitList(lb1,initlista,rb1),Ast0.InitList(lb,initlistb,rb)) ->
conjunct_many_bindings
[check_mcode lb1 lb; check_mcode rb1 rb;
match_dots match_init no_list do_nolist_match
initlista initlistb]
| (Ast0.InitGccDotName(d1,namea,e1,inia),
Ast0.InitGccDotName(d,nameb,e,inib)) ->
conjunct_many_bindings
[check_mcode d1 d; check_mcode e1 e;
match_ident namea nameb; match_init inia inib]
| (Ast0.InitGccName(namea,c1,inia),Ast0.InitGccName(nameb,c,inib)) ->
conjunct_many_bindings
[check_mcode c1 c; match_ident namea nameb;
match_init inia inib]
| (Ast0.InitGccIndex(lb1,expa,rb1,e1,inia),
Ast0.InitGccIndex(lb2,expb,rb2,e2,inib)) ->
conjunct_many_bindings
[check_mcode lb1 lb2; check_mcode rb1 rb2; check_mcode e1 e2;
match_expr expa expb; match_init inia inib]
| (Ast0.InitGccRange(lb1,exp1a,d1,exp2a,rb1,e1,inia),
Ast0.InitGccRange(lb2,exp1b,d2,exp2b,rb2,e2,inib)) ->
conjunct_many_bindings
[check_mcode lb1 lb2; check_mcode d1 d2;
check_mcode rb1 rb2; check_mcode e1 e2;
match_expr exp1a exp1b; match_expr exp2a exp2b;
match_init inia inib]
| (Ast0.IComma(c1),Ast0.IComma(c)) -> check_mcode c1 c
| (Ast0.Idots(d1,None),Ast0.Idots(d,None)) -> check_mcode d1 d
| (Ast0.Idots(id,None),Ast0.Idots(d,Some wc)) ->
conjunct_bindings (check_mcode id d)
(* hope that mcode of edots is unique somehow *)
(let (_,idots_whencode_allowed,_) = whencode_allowed in
if idots_whencode_allowed
then add_dot_binding id (Ast0.InitTag wc)
else
(Printf.printf "warning: not applying iso because of whencode";
return false))
| (Ast0.Idots(_,Some _),_) ->
failwith "whencode not allowed in a pattern2"
| (Ast0.OptIni(ia),Ast0.OptIni(ib))
| (Ast0.UniqueIni(ia),Ast0.UniqueIni(ib)) -> match_init ia ib
| (_,Ast0.OptIni(ib))
| (_,Ast0.UniqueIni(ib)) -> match_init pattern ib
| _ -> return false
else return_false (ContextRequired (Ast0.InitTag i))
and match_param pattern p =
match Ast0.unwrap pattern with
Ast0.MetaParam(name,pure) ->
add_pure_binding name pure pure_sp_code.V0.combiner_parameter
(function p -> Ast0.ParamTag p)
p
| Ast0.MetaParamList(name,_,pure) -> failwith "metaparamlist not supported"
| up ->
if not(checks_needed) or not(context_required) or is_context p
then
match (up,Ast0.unwrap p) with
(Ast0.VoidParam(tya),Ast0.VoidParam(tyb)) -> match_typeC tya tyb
| (Ast0.Param(tya,ida),Ast0.Param(tyb,idb)) ->
conjunct_bindings (match_typeC tya tyb)
(match_option match_ident ida idb)
| (Ast0.PComma(c1),Ast0.PComma(c)) -> check_mcode c1 c
| (Ast0.Pdots(d1),Ast0.Pdots(d))
| (Ast0.Pcircles(d1),Ast0.Pcircles(d)) -> check_mcode d1 d
| (Ast0.OptParam(parama),Ast0.OptParam(paramb))
| (Ast0.UniqueParam(parama),Ast0.UniqueParam(paramb)) ->
match_param parama paramb
| (_,Ast0.OptParam(paramb))
| (_,Ast0.UniqueParam(paramb)) -> match_param pattern paramb
| _ -> return false
else return_false (ContextRequired (Ast0.ParamTag p))
and match_statement pattern s =
match Ast0.unwrap pattern with
Ast0.MetaStmt(name,pure) ->
(match Ast0.unwrap s with
Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) ->
return false (* ... is not a single statement *)
| _ ->
add_pure_binding name pure pure_sp_code.V0.combiner_statement
(function ty -> Ast0.StmtTag ty)
s)
| Ast0.MetaStmtList(name,pure) -> failwith "metastmtlist not supported"
| up ->
if not(checks_needed) or not(context_required) or is_context s
then
match (up,Ast0.unwrap s) with
(Ast0.FunDecl(_,fninfoa,namea,lp1,paramsa,rp1,lb1,bodya,rb1),
Ast0.FunDecl(_,fninfob,nameb,lp,paramsb,rp,lb,bodyb,rb)) ->
conjunct_many_bindings
[check_mcode lp1 lp; check_mcode rp1 rp;
check_mcode lb1 lb; check_mcode rb1 rb;
match_fninfo fninfoa fninfob; match_ident namea nameb;
match_dots match_param is_plist_matcher do_plist_match
paramsa paramsb;
match_dots match_statement is_slist_matcher do_slist_match
bodya bodyb]
| (Ast0.Decl(_,decla),Ast0.Decl(_,declb)) ->
match_decl decla declb
| (Ast0.Seq(lb1,bodya,rb1),Ast0.Seq(lb,bodyb,rb)) ->
(* seqs can only match if they are all minus (plus code
allowed) or all context (plus code not allowed in the body).
we could be more permissive if the expansions of the isos are
also all seqs, but this would be hard to check except at top
level, and perhaps not worth checking even in that case.
Overall, the issue is that braces are used where single
statements are required, and something not satisfying these
conditions can cause a single statement to become a
non-single statement after the transformation.
example: if { ... -foo(); ... }
if we let the sequence convert to just -foo();
then we produce invalid code. For some reason,
single_statement can't deal with this case, perhaps because
it starts introducing too many braces? don't remember the
exact problem...
*)
conjunct_bindings (check_mcode lb1 lb)
(conjunct_bindings (check_mcode rb1 rb)
(if not(checks_needed) or is_minus s or
(is_context s &&
List.for_all is_pure_context (Ast0.undots bodyb))
then
match_dots match_statement is_slist_matcher do_slist_match
bodya bodyb
else return_false (Braces(s))))
| (Ast0.ExprStatement(expa,sc1),Ast0.ExprStatement(expb,sc)) ->
conjunct_bindings (check_mcode sc1 sc) (match_expr expa expb)
| (Ast0.IfThen(if1,lp1,expa,rp1,branch1a,_),
Ast0.IfThen(if2,lp2,expb,rp2,branch1b,_)) ->
conjunct_many_bindings
[check_mcode if1 if2; check_mcode lp1 lp2;
check_mcode rp1 rp2;
match_expr expa expb;
match_statement branch1a branch1b]
| (Ast0.IfThenElse(if1,lp1,expa,rp1,branch1a,e1,branch2a,_),
Ast0.IfThenElse(if2,lp2,expb,rp2,branch1b,e2,branch2b,_)) ->
conjunct_many_bindings
[check_mcode if1 if2; check_mcode lp1 lp2;
check_mcode rp1 rp2; check_mcode e1 e2;
match_expr expa expb;
match_statement branch1a branch1b;
match_statement branch2a branch2b]
| (Ast0.While(w1,lp1,expa,rp1,bodya,_),
Ast0.While(w,lp,expb,rp,bodyb,_)) ->
conjunct_many_bindings
[check_mcode w1 w; check_mcode lp1 lp;
check_mcode rp1 rp; match_expr expa expb;
match_statement bodya bodyb]
| (Ast0.Do(d1,bodya,w1,lp1,expa,rp1,_),
Ast0.Do(d,bodyb,w,lp,expb,rp,_)) ->
conjunct_many_bindings
[check_mcode d1 d; check_mcode w1 w; check_mcode lp1 lp;
check_mcode rp1 rp; match_statement bodya bodyb;