engine/pattern_c.ml

   1 (*
   2  * Copyright 2010, INRIA, University of Copenhagen
   3  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
   4  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
   5  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
   6  * This file is part of Coccinelle.
   7  *
   8  * Coccinelle is free software: you can redistribute it and/or modify
   9  * it under the terms of the GNU General Public License as published by
  10  * the Free Software Foundation, according to version 2 of the License.
  11  *
  12  * Coccinelle is distributed in the hope that it will be useful,
  13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15  * GNU General Public License for more details.
  16  *
  17  * You should have received a copy of the GNU General Public License
  18  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  19  *
  20  * The authors reserve the right to distribute this or future versions of
  21  * Coccinelle under other licenses.
  22  *)
  23
  24
  25 (*
  26  * Copyright 2010, INRIA, University of Copenhagen
  27  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
  28  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
  29  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
  30  * This file is part of Coccinelle.
  31  *
  32  * Coccinelle is free software: you can redistribute it and/or modify
  33  * it under the terms of the GNU General Public License as published by
  34  * the Free Software Foundation, according to version 2 of the License.
  35  *
  36  * Coccinelle is distributed in the hope that it will be useful,
  37  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  38  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  39  * GNU General Public License for more details.
  40  *
  41  * You should have received a copy of the GNU General Public License
  42  * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
  43  *
  44  * The authors reserve the right to distribute this or future versions of
  45  * Coccinelle under other licenses.
  46  *)
  47
  48
  49 (* Yoann Padioleau
  50  *
  51  * Copyright (C) 2006, 2007 Ecole des Mines de Nantes
  52  *
  53  * This program is free software; you can redistribute it and/or
  54  * modify it under the terms of the GNU General Public License (GPL)
  55  * version 2 as published by the Free Software Foundation.
  56  *
  57  * This program is distributed in the hope that it will be useful,
  58  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  59  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  60  * file license.txt for more details.
  61  *
  62  * This file was part of Coccinelle.
  63  *)
  64 open Common
  65
  66 module Flag_engine = Flag_matcher
  67 (*****************************************************************************)
  68 (* The functor argument  *)
  69 (*****************************************************************************)
  70
  71 (* info passed recursively in monad in addition to binding *)
  72 type xinfo = {
  73   optional_storage_iso : bool;
  74   optional_qualifier_iso : bool;
  75   value_format_iso : bool;
  76 }
  77
  78 module XMATCH = struct
  79
  80   (* ------------------------------------------------------------------------*)
  81   (* Combinators history *)
  82   (* ------------------------------------------------------------------------*)
  83   (*
  84    * version0:
  85    *   type ('a, 'b) matcher = 'a -> 'b -> bool
  86    *
  87    * version1: same but with a global variable holding the current binding
  88    *  BUT bug
  89    *   - can have multiple possibilities
  90    *   - globals sux
  91    *   - sometimes have to undo, cos if start match, then it binds,
  92    *     and if later it does not match, then must undo the first binds.
  93    *     ex: when match parameters, can  try to match, but then we found far
  94    *     later that the last argument of a function does not match
  95    *      => have to uando the binding !!!
  96    *      (can handle that too with a global, by saving the
  97    *      global, ... but sux)
  98    *   => better not use global
  99    *
 100    * version2:
 101    *    type ('a, 'b) matcher = binding -> 'a -> 'b -> binding list
 102    *
 103    * Empty list mean failure (let matchfailure = []).
 104    * To be able to have pretty code, have to use partial application
 105    * powa, and so the type is in fact
 106    *
 107    * version3:
 108    *    type ('a, 'b) matcher =  'a -> 'b -> binding -> binding list
 109    *
 110    * Then by defining the correct combinators, can have quite pretty code (that
 111    * looks like the clean code of version0).
 112    *
 113    * opti: return a lazy list of possible matchs ?
 114    *
 115    * version4: type tin = Lib_engine.metavars_binding
 116    *)
 117
 118   (* ------------------------------------------------------------------------*)
 119   (* Standard type and operators  *)
 120   (* ------------------------------------------------------------------------*)
 121
 122   type tin = {
 123     extra: xinfo;
 124     binding: Lib_engine.metavars_binding;
 125     binding0: Lib_engine.metavars_binding; (* inherited bindings *)
 126   }
 127   (* 'x is a ('a * 'b) but in fact dont care about 'b, we just tag the SP *)
 128   (* opti? use set instead of list *)
 129   type 'x tout = ('x * Lib_engine.metavars_binding) list
 130
 131   type ('a, 'b) matcher = 'a -> 'b  -> tin -> ('a * 'b) tout
 132
 133   (* was >&&> *)
 134   let (>>=) m1 m2 = fun tin ->
 135     let xs = m1 tin in
 136     let xxs = xs +> List.map (fun ((a,b), binding) ->
 137       m2 a b {tin with binding = binding}
 138     ) in
 139     List.flatten xxs
 140
 141   (* Je compare les bindings retournés par les differentes branches.
 142    * Si la deuxieme branche amene a des bindings qui sont deja presents
 143    * dans la premiere branche, alors je ne les accepte pas.
 144    *
 145    * update: still useful now that julia better handle Exp directly via
 146    * ctl tricks using positions ?
 147    *)
 148   let (>|+|>) m1 m2 = fun tin ->
 149 (* CHOICE
 150       let xs = m1 tin in
 151       if null xs
 152       then m2 tin
 153       else xs
 154 *)
 155     let res1 = m1 tin in
 156     let res2 = m2 tin in
 157     let list_bindings_already = List.map snd res1 in
 158     res1 ++
 159       (res2 +> List.filter (fun (x, binding) ->
 160         not
 161           (list_bindings_already +> List.exists (fun already ->
 162             Lib_engine.equal_binding binding already))
 163       ))
 164
 165
 166
 167
 168   let (>||>) m1 m2 = fun tin ->
 169 (* CHOICE
 170       let xs = m1 tin in
 171       if null xs
 172       then m2 tin
 173       else xs
 174 *)
 175     (* opti? use set instead of list *)
 176     let l1 = m1 tin in
 177     let l2 = m2 tin in
 178     if l2 = [] then l1 else l1 ++ l2 (*a small benefit; avoid a trivial @*)
 179
 180
 181   let return res = fun tin ->
 182     [res, tin.binding]
 183
 184   let fail = fun tin ->
 185     []
 186
 187   let (>&&>) f m = fun tin ->
 188     if f tin
 189     then m tin
 190     else fail tin
 191
 192
 193   let mode = Cocci_vs_c.PatternMode
 194
 195   (* ------------------------------------------------------------------------*)
 196   (* Exp  *)
 197   (* ------------------------------------------------------------------------*)
 198   let cocciExp = fun expf expa node -> fun tin ->
 199
 200     let globals = ref [] in
 201     let bigf = {
 202       (* julia's style *)
 203       Visitor_c.default_visitor_c with
 204       Visitor_c.kexpr = (fun (k, bigf) expb ->
 205         match expf expa expb tin with
 206         | [] -> (* failed *) k expb
 207         | xs ->
 208             globals := xs @ !globals;
 209             if not !Flag_engine.disallow_nested_exps then k expb (* CHOICE *)
 210       );
 211       (* pad's style.
 212        * push2 expr globals;  k expr
 213        *  ...
 214        *  !globals +> List.fold_left (fun acc e -> acc >||> match_e_e expr e)
 215        * (return false)
 216        *
 217        *)
 218     }
 219     in
 220     Visitor_c.vk_node bigf node;
 221     !globals +> List.map (fun ((a, _exp), binding) ->
 222       (a, node), binding
 223     )
 224
 225   (* same as cocciExp, but for expressions in an expression, not expressions
 226      in a node *)
 227   let cocciExpExp = fun expf expa expb -> fun tin ->
 228
 229     let globals = ref [] in
 230     let bigf = {
 231       (* julia's style *)
 232       Visitor_c.default_visitor_c with
 233       Visitor_c.kexpr = (fun (k, bigf) expb ->
 234         match expf expa expb tin with
 235         | [] -> (* failed *) k expb
 236         | xs ->
 237             globals := xs @ !globals;
 238             if not !Flag_engine.disallow_nested_exps then k expb (* CHOICE *)
 239       );
 240       (* pad's style.
 241        * push2 expr globals;  k expr
 242        *  ...
 243        *  !globals +> List.fold_left (fun acc e -> acc >||> match_e_e expr e)
 244        * (return false)
 245        *
 246        *)
 247     }
 248     in
 249     Visitor_c.vk_expr bigf expb;
 250     !globals +> List.map (fun ((a, _exp), binding) ->
 251       (a, expb), binding
 252     )
 253
 254   let cocciTy = fun expf expa node -> fun tin ->
 255
 256     let globals = ref [] in
 257     let bigf = {
 258       Visitor_c.default_visitor_c with
 259         Visitor_c.ktype = (fun (k, bigf) expb ->
 260         match expf expa expb tin with
 261         | [] -> (* failed *) k expb
 262         | xs -> globals := xs @ !globals);
 263
 264     }
 265     in
 266     Visitor_c.vk_node bigf node;
 267     !globals +> List.map (fun ((a, _exp), binding) ->
 268       (a, node), binding
 269     )
 270
 271   let cocciInit = fun expf expa node -> fun tin ->
 272
 273     let globals = ref [] in
 274     let bigf = {
 275       Visitor_c.default_visitor_c with
 276         Visitor_c.kini = (fun (k, bigf) expb ->
 277         match expf expa expb tin with
 278         | [] -> (* failed *) k expb
 279         | xs -> globals := xs @ !globals);
 280
 281     }
 282     in
 283     Visitor_c.vk_node bigf node;
 284     !globals +> List.map (fun ((a, _exp), binding) ->
 285       (a, node), binding
 286     )
 287
 288
 289   (* ------------------------------------------------------------------------*)
 290   (* Distribute mcode *)
 291   (* ------------------------------------------------------------------------*)
 292   let tag_mck_pos mck posmck =
 293     match mck with
 294     | Ast_cocci.PLUS c -> Ast_cocci.PLUS c
 295     | Ast_cocci.CONTEXT (pos, xs) ->
 296         assert (pos =*= Ast_cocci.NoPos || pos =*= Ast_cocci.DontCarePos);
 297         Ast_cocci.CONTEXT (posmck, xs)
 298     | Ast_cocci.MINUS (pos, inst, adj, xs) ->
 299         assert (pos =*= Ast_cocci.NoPos || pos =*= Ast_cocci.DontCarePos);
 300         Ast_cocci.MINUS (posmck, inst, adj, xs)
 301
 302
 303   let tag_mck_pos_mcode (x,info,mck,pos) posmck stuff = fun tin ->
 304     [((x, info, tag_mck_pos mck posmck, pos),stuff), tin.binding]
 305
 306
 307   let distrf (ii_of_x_f) =
 308     fun mcode x -> fun tin ->
 309     let (max, min) = Lib_parsing_c.max_min_by_pos (ii_of_x_f x)
 310     in
 311     let posmck = Ast_cocci.FixPos (min, max) (* subtil: and not max, min !!*)
 312     in
 313     tag_mck_pos_mcode mcode posmck x tin
 314
 315   let distrf_e      = distrf (Lib_parsing_c.ii_of_expr)
 316   let distrf_args   = distrf (Lib_parsing_c.ii_of_args)
 317   let distrf_type   = distrf (Lib_parsing_c.ii_of_type)
 318   let distrf_param  = distrf (Lib_parsing_c.ii_of_param)
 319   let distrf_params = distrf (Lib_parsing_c.ii_of_params)
 320   let distrf_ini    = distrf (Lib_parsing_c.ii_of_ini)
 321   let distrf_inis   = distrf (Lib_parsing_c.ii_of_inis)
 322   let distrf_decl   = distrf (Lib_parsing_c.ii_of_decl)
 323   let distrf_field  = distrf (Lib_parsing_c.ii_of_field)
 324   let distrf_node   = distrf (Lib_parsing_c.ii_of_node)
 325   let distrf_enum_fields = distrf (Lib_parsing_c.ii_of_enum_fields)
 326   let distrf_struct_fields = distrf (Lib_parsing_c.ii_of_struct_fields)
 327   let distrf_cst    = distrf (Lib_parsing_c.ii_of_cst)
 328   let distrf_define_params = distrf (Lib_parsing_c.ii_of_define_params)
 329
 330
 331   (* ------------------------------------------------------------------------*)
 332   (* Constraints on metavariable values *)
 333   (* ------------------------------------------------------------------------*)
 334   let check_idconstraint matcher c id = fun f tin ->
 335     if matcher c id then
 336       (* success *)
 337       f () tin
 338     else
 339       (* failure *)
 340       fail tin
 341
 342   let check_constraints_ne matcher constraints exp = fun f tin ->
 343     let rec loop = function
 344         [] -> f () tin (* success *)
 345       | c::cs ->
 346           match matcher c exp tin with
 347             [] (* failure *) -> loop cs
 348           | _ (* success *) -> fail tin in
 349     loop constraints
 350
 351   let check_pos_constraints constraints pvalu f tin =
 352     check_constraints_ne
 353       (fun c exp tin ->
 354         let success = [[]] in
 355         let failure = [] in
 356         (* relies on the fact that constraints on pos variables must refer to
 357            inherited variables *)
 358         (match Common.optionise (fun () -> tin.binding0 +> List.assoc c) with
 359           Some valu' ->
 360             if Cocci_vs_c.equal_inh_metavarval exp valu'
 361             then success else failure
 362         | None ->
 363             (* if the variable is not there, it puts no constraints *)
 364             (* not sure this is still useful *)
 365             failure))
 366       constraints pvalu f tin
 367
 368   (* ------------------------------------------------------------------------*)
 369   (* Environment *)
 370   (* ------------------------------------------------------------------------*)
 371   (* pre: if have declared a new metavar that hide another one, then
 372    * must be passed with a binding that deleted this metavar
 373    *
 374    * Here we dont use the keep argument of julia. cf f(X,X), J'ai
 375    * besoin de garder le X en interne, meme si julia s'en fout elle du
 376    * X et qu'elle a mis X a DontSaved.
 377    *)
 378   let check_add_metavars_binding strip _keep inherited = fun (k, valu) tin ->
 379     if inherited
 380     then
 381       match Common.optionise (fun () -> tin.binding0 +> List.assoc k) with
 382       | Some (valu') ->
 383           if Cocci_vs_c.equal_inh_metavarval valu valu'
 384           then Some tin.binding
 385           else None
 386       | None -> None
 387     else
 388       match Common.optionise (fun () -> tin.binding +> List.assoc k) with
 389       | Some (valu') ->
 390           if Cocci_vs_c.equal_metavarval valu valu'
 391           then Some tin.binding
 392           else None
 393
 394       | None ->
 395           let success valu' =
 396             Some (tin.binding +> Common.insert_assoc (k, valu')) in
 397           (match valu with
 398             Ast_c.MetaIdVal (a,c)    ->
 399               (* c is a negated constraint *)
 400               let rec loop = function
 401                   [] -> success(Ast_c.MetaIdVal(a,[]))
 402                 | c::cs ->
 403                     let tmp =
 404                       Common.optionise
 405                         (fun () -> tin.binding0 +> List.assoc c) in
 406                     (match tmp with
 407                       Some (Ast_c.MetaIdVal(v,_)) ->
 408                         if a =$= v
 409                         then None (* failure *)
 410                         else success(Ast_c.MetaIdVal(a,[]))
 411                     | Some _ -> failwith "Not possible"
 412                     | None -> success(Ast_c.MetaIdVal(a,[]))) in
 413               loop c
 414           | Ast_c.MetaFuncVal a      ->
 415               success(Ast_c.MetaFuncVal a)
 416           | Ast_c.MetaLocalFuncVal a ->
 417               success(Ast_c.MetaLocalFuncVal a) (*more?*)
 418           | Ast_c.MetaExprVal (a,c) ->
 419               (* c in the value is only to prepare for the future in which
 420                  we figure out how to have subterm constraints on unbound
 421                  variables.  Now an environment will only contain expression
 422                  values with empty constraints, as all constraints are
 423                  resolved at binding time *)
 424               let stripped =
 425                 if strip
 426                 then Lib_parsing_c.al_expr a
 427                 else Lib_parsing_c.semi_al_expr a in
 428               let inh_stripped = Lib_parsing_c.al_inh_expr a in
 429               let rec loop = function
 430                   [] -> success(Ast_c.MetaExprVal(stripped,[]))
 431                 | c::cs ->
 432                     let tmp =
 433                       Common.optionise
 434                         (fun () -> tin.binding0 +> List.assoc c) in
 435                     (match tmp with
 436                       Some (Ast_c.MetaExprVal(v,_)) ->
 437                         if C_vs_c.subexpression_of_expression inh_stripped v
 438                         then loop cs (* forget satisfied constraints *)
 439                         else None (* failure *)
 440                     | Some _ -> failwith "not possible"
 441                       (* fail if this should be a subterm of something that
 442                          doesn't exist *)
 443                     | None -> None) in
 444               loop c
 445           | Ast_c.MetaExprListVal a ->
 446               success
 447                 (Ast_c.MetaExprListVal
 448                    (if strip
 449                    then Lib_parsing_c.al_arguments a
 450                    else Lib_parsing_c.semi_al_arguments a))
 451
 452           | Ast_c.MetaDeclVal a ->
 453               success
 454                 (Ast_c.MetaDeclVal
 455                    (if strip
 456                    then Lib_parsing_c.al_declaration a
 457                    else Lib_parsing_c.semi_al_declaration a))
 458           | Ast_c.MetaFieldVal a ->
 459               success
 460                 (Ast_c.MetaFieldVal
 461                    (if strip
 462                    then Lib_parsing_c.al_field a
 463                    else Lib_parsing_c.semi_al_field a))
 464           | Ast_c.MetaStmtVal a ->
 465               success
 466                 (Ast_c.MetaStmtVal
 467                    (if strip
 468                    then Lib_parsing_c.al_statement a
 469                    else Lib_parsing_c.semi_al_statement a))
 470           | Ast_c.MetaTypeVal a ->
 471               success
 472                 (Ast_c.MetaTypeVal
 473                    (if strip
 474                    then Lib_parsing_c.al_type a
 475                    else Lib_parsing_c.semi_al_type a))
 476
 477           | Ast_c.MetaInitVal a ->
 478               success
 479                 (Ast_c.MetaInitVal
 480                    (if strip
 481                    then Lib_parsing_c.al_init a
 482                    else Lib_parsing_c.semi_al_init a))
 483
 484           | Ast_c.MetaListlenVal a -> success(Ast_c.MetaListlenVal a)
 485
 486           | Ast_c.MetaParamVal a ->
 487               success
 488                 (Ast_c.MetaParamVal
 489                    (if strip
 490                    then Lib_parsing_c.al_param a
 491                    else Lib_parsing_c.semi_al_param a))
 492           | Ast_c.MetaParamListVal a ->
 493               success
 494                 (Ast_c.MetaParamListVal
 495                    (if strip
 496                    then Lib_parsing_c.al_params a
 497                    else Lib_parsing_c.semi_al_params a))
 498
 499           | Ast_c.MetaPosVal (pos1,pos2) ->
 500               success(Ast_c.MetaPosVal (pos1,pos2))
 501           | Ast_c.MetaPosValList l -> success (Ast_c.MetaPosValList l))
 502
 503   let envf keep inherited = fun (k, valu, get_max_min) f tin ->
 504     let x = Ast_cocci.unwrap_mcode k in
 505     match check_add_metavars_binding true keep inherited (x, valu) tin with
 506     | Some binding ->
 507         let new_tin = {tin with binding = binding} in
 508         (match Ast_cocci.get_pos_var k with
 509           Ast_cocci.MetaPos(name,constraints,per,keep,inherited) ->
 510             let pvalu =
 511               let (file,current_element,min,max) = get_max_min() in
 512               Ast_c.MetaPosValList[(file,current_element,min,max)] in
 513             (* check constraints.  success means that there is a match with
 514                one of the constraints, which will ultimately result in
 515                failure. *)
 516             check_pos_constraints constraints pvalu
 517               (function () ->
 518                 (* constraints are satisfied, now see if we are compatible
 519                    with existing bindings *)
 520                 function new_tin ->
 521                   let x = Ast_cocci.unwrap_mcode name in
 522                   (match
 523                     check_add_metavars_binding false keep inherited (x, pvalu)
 524                       new_tin with
 525                   | Some binding ->
 526                       f () {new_tin with binding = binding}
 527                   | None -> fail tin))
 528               new_tin
 529         | Ast_cocci.NoMetaPos -> f () new_tin)
 530     | None -> fail tin
 531
 532   (* ------------------------------------------------------------------------*)
 533   (* Environment, allbounds *)
 534   (* ------------------------------------------------------------------------*)
 535   (* all referenced inherited variables have to be bound. This would
 536    * be naturally checked for the minus or context ones in the
 537    * matching process, but have to check the plus ones as well. The
 538    * result of get_inherited contains all of these, but the potential
 539    * redundant checking for the minus and context ones is probably not
 540    * a big deal. If it's a problem, could fix free_vars to distinguish
 541    * between + variables and the other ones. *)
 542
 543   let (all_bound : Ast_cocci.meta_name list -> tin -> bool) = fun l tin ->
 544     l +> List.for_all (fun inhvar ->
 545       match Common.optionise (fun () -> tin.binding0 +> List.assoc inhvar) with
 546       | Some _ -> true
 547       | None -> false
 548     )
 549
 550   let optional_storage_flag f = fun tin ->
 551     f (tin.extra.optional_storage_iso) tin
 552
 553   let optional_qualifier_flag f = fun tin ->
 554     f (tin.extra.optional_qualifier_iso) tin
 555
 556   let value_format_flag f = fun tin ->
 557     f (tin.extra.value_format_iso) tin
 558
 559
 560   (* ------------------------------------------------------------------------*)
 561   (* Tokens *)
 562   (* ------------------------------------------------------------------------*)
 563   let tokenf ia ib = fun tin ->
 564     let pos = Ast_c.info_to_fixpos ib in
 565     let posmck = Ast_cocci.FixPos (pos, pos) in
 566     let finish tin = tag_mck_pos_mcode ia posmck ib tin in
 567     match Ast_cocci.get_pos_var ia with
 568       Ast_cocci.MetaPos(name,constraints,per,keep,inherited) ->
 569         let mpos = Lib_parsing_c.lin_col_by_pos [ib] in
 570         let pvalu = Ast_c.MetaPosValList [mpos] in
 571         check_pos_constraints constraints pvalu
 572           (function () ->
 573             (* constraints are satisfied, now see if we are compatible
 574                with existing bindings *)
 575             function new_tin ->
 576               let x = Ast_cocci.unwrap_mcode name in
 577               (match
 578                 check_add_metavars_binding false keep inherited (x, pvalu) tin
 579               with
 580                 Some binding -> finish {tin with binding = binding}
 581               | None -> fail tin))
 582           tin
 583     | _ -> finish tin
 584
 585   let tokenf_mck mck ib = fun tin ->
 586     let pos = Ast_c.info_to_fixpos ib in
 587     let posmck = Ast_cocci.FixPos (pos, pos) in
 588     [(tag_mck_pos mck posmck, ib), tin.binding]
 589
 590 end
 591
 592 (*****************************************************************************)
 593 (* Entry point  *)
 594 (*****************************************************************************)
 595 module MATCH  = Cocci_vs_c.COCCI_VS_C (XMATCH)
 596
 597
 598 let match_re_node2 dropped_isos a b binding0 =
 599
 600   let tin = {
 601     XMATCH.extra = {
 602       optional_storage_iso   = not(List.mem "optional_storage"   dropped_isos);
 603       optional_qualifier_iso = not(List.mem "optional_qualifier" dropped_isos);
 604       value_format_iso       = not(List.mem "value_format"       dropped_isos);
 605     };
 606     XMATCH.binding = [];
 607     XMATCH.binding0 = binding0;
 608   } in
 609
 610   MATCH.rule_elem_node a b tin
 611   (* take only the tagged-SP, the 'a' *)
 612   +> List.map (fun ((a,_b), binding) -> a, binding)
 613
 614
 615 let match_re_node a b c d =
 616   Common.profile_code "Pattern3.match_re_node"
 617     (fun () -> match_re_node2 a b c d)