src/runtime.ml

   1 INCLUDE "debug.ml"
   2 INCLUDE "trace.ml"
   3 INCLUDE "utils.ml"
   4
   5 open Format
   6 open Ata
   7 module type S = sig
   8   type result_set
   9   val top_down_run : Ata.t -> Tree.t -> Tree.node -> result_set
  10   val bottom_up_run : Ata.t -> Tree.t -> Compile.text_query * string -> result_set
  11   val grammar_run : Ata.t -> Grammar2.t -> unit -> result_set
  12
  13 end
  14
  15 module Make (U : ResJIT.S) : S with type result_set = U.NS.t =
  16   struct
  17
  18     type result_set = U.NS.t;;
  19
  20     let eval_form auto s1 s2 f =
  21       let rec loop f =
  22         match Formula.expr f with
  23           | Formula.False | Formula.True | Formula.Pred _ -> f, []
  24           | Formula.Atom(`Left, b, q) ->
  25               Formula.of_bool (b == (StateSet.mem q s1)),
  26               if b && StateSet.mem q auto.topdown_marking_states then [ResJIT.LEFT q] else []
  27           | Formula.Atom (`Right, b, q) ->
  28               Formula.of_bool(b == (StateSet.mem q s2)),
  29               if b && StateSet.mem q auto.topdown_marking_states then [ResJIT.RIGHT q] else []
  30           | Formula.Atom (`Epsilon, _, _) -> assert false
  31
  32           | Formula.Or(f1, f2) ->
  33               let b1, i1 = loop f1 in
  34               let b2, i2 = loop f2 in
  35               Formula.or_pred b1 b2, i1 @ i2
  36           | Formula.And(f1, f2) ->
  37               let b1, i1 = loop f1 in
  38               let b2, i2 = loop f2 in
  39               Formula.and_pred b1 b2, i1 @ i2
  40       in
  41       loop f
  42
  43
  44     let eval_trans auto s1 s2 trans =
  45       Translist.fold
  46         (fun t ((a_st, a_op, a_todo) as acc)->
  47            let q, _, m, f = Transition.node t in
  48            let form, ops = eval_form auto s1 s2 f in
  49            match Formula.expr form with
  50              | Formula.True ->
  51                StateSet.add q a_st,
  52                (q, (if m then (ResJIT.SELF() :: ops) else ops)):: a_op,
  53                a_todo
  54              | Formula.False -> acc
  55              | Formula.Pred p -> a_st, a_op,
  56                (p.Tree.Predicate.node, q, [(q,(if m then (ResJIT.SELF() :: ops) else ops))]) :: a_todo
  57              | _ -> assert false
  58         ) trans (StateSet.empty, [], [])
  59
  60
  61
  62     module L3JIT =
  63       struct
  64
  65         type opcode = (t -> t -> t -> Tree.t -> Tree.node -> StateSet.t * t)
  66
  67         type t = opcode Cache.t Cache.t Cache.t
  68
  69         let dummy _ _ _ _ _ = failwith "Uninitialized L3JIT"
  70
  71         let create () = Cache.Lvl3.create 1024 dummy
  72
  73         let stats fmt d =
  74           let d = Cache.Lvl3.to_array d in
  75           let len = Array.fold_left
  76             (fun acc a ->
  77                Array.fold_left (fun acc2 a2 -> Array.length a2 + acc2) acc a) 0 d
  78           in
  79
  80           let lvl1 =
  81             Array.fold_left
  82               (fun acc a -> if Array.length a == 0 then acc else acc+1) 0 d in
  83           let lvl2 = Array.fold_left
  84             (fun acc a ->
  85                Array.fold_left (fun acc2 a2 -> if Array.length a2 == 0 then acc2 else acc2+1)
  86                  acc a) 0 d
  87           in
  88           let lvl3 = Array.fold_left
  89             (fun acc a ->
  90               Array.fold_left (fun acc2 a2 ->
  91                 Array.fold_left
  92                   (fun acc3 a3 -> if a3 != dummy then acc3+1 else acc3)
  93                   acc2 a2)
  94                 acc a) 0 d
  95           in
  96         fprintf fmt "L3JIT Statistics:
  97 \t%i entries
  98 \t%i used L1 lines
  99 \t%i used L2 lines
 100 \t%i used L3 lines
 101 \ttable size: %ikb\n"
 102           len lvl1 lvl2 lvl3 (Ocaml.size_kb d)
 103
 104         let find t tlist s1 s2 =
 105           Cache.Lvl3.find t
 106             (Uid.to_int tlist.Translist.Node.id)
 107             (Uid.to_int s1.StateSet.Node.id)
 108             (Uid.to_int s2.StateSet.Node.id)
 109
 110         let add t tlist s1 s2 v =
 111           Cache.Lvl3.add t
 112             (Uid.to_int tlist.Translist.Node.id)
 113             (Uid.to_int s1.StateSet.Node.id)
 114             (Uid.to_int s2.StateSet.Node.id)
 115             v
 116
 117         let compile auto trl s1 s2 =
 118           let orig_s1, orig_s2 =
 119             Translist.fold (fun t (a1, a2) ->
 120                           let _, _, _, f = Transition.node t in
 121                           let (_, _, fs1), (_, _, fs2) = Formula.st f in
 122                             (StateSet.union a1 fs1, StateSet.union a2 fs2)
 123                        ) trl (StateSet.empty, StateSet.empty)
 124           in
 125           let ns1 = StateSet.inter s1 orig_s1
 126           and ns2 = StateSet.inter s2 orig_s2 in
 127           let res, ops, todo = eval_trans auto ns1 ns2 trl in
 128           let code, not_marking = ResJIT.compile ops in
 129           let todo_code, todo_notmarking =
 130             List.fold_left (fun (l, b) (p, q, o) -> let c, b' = ResJIT.compile o in
 131                                          (p, q, c)::l, b && b')
 132               ([], not_marking) todo
 133           in
 134           let opcode = res, code, todo_notmarking, todo_code in
 135           opcode
 136
 137         let gen_code auto tlist s1 s2 =
 138           let res, code, not_marking, todo_code = compile auto tlist s1 s2 in
 139           let f =
 140             if todo_code == [] then
 141               if not_marking then begin fun empty_slot sl1 sl2 _ node ->
 142                 let slot1_empty = sl1 == empty_slot
 143                 and slot2_empty = sl2 == empty_slot in
 144                 if slot1_empty && slot2_empty then res,sl2
 145                 else
 146                   let sl =
 147                     if slot2_empty then
 148                       if slot1_empty then
 149                         Array.copy empty_slot
 150                       else sl1
 151                     else sl2
 152                   in
 153                   U.exec sl sl1 sl2 node code;
 154                   res, sl
 155               end
 156               else (* marking *) begin fun empty_slot sl1 sl2 _ node ->
 157                 let sl =
 158                   if sl2 == empty_slot  then
 159                     if sl1 == empty_slot then
 160                       Array.copy empty_slot
 161                     else sl1
 162                   else sl2
 163                 in
 164                 U.exec sl sl1 sl2 node code;
 165                 res, sl
 166               end
 167               else (* todo != [] *)
 168               begin fun empty_slot sl1 sl2 tree node ->
 169                 let sl =
 170                   if sl2 == empty_slot  then
 171                     if sl1 == empty_slot then
 172                       Array.copy empty_slot
 173                     else sl1
 174                   else sl2
 175                 in
 176                 U.exec sl sl1 sl2 node code;
 177                 List.fold_left
 178                   (fun ares (p, q, code) ->
 179                     if !p tree node then begin
 180                       if code != ResJIT.Nil then U.exec sl sl1 sl2 node code;
 181                       StateSet.add q ares
 182                     end
 183                     else ares) res todo_code, sl
 184
 185               end
 186           in
 187           f
 188
 189         let cache_apply cache auto tlist s1 s2 =
 190           let f = gen_code auto tlist s1 s2 in
 191           TRACE("grammar", 2, __ "Inserting: %i, %a, %a\n%!"
 192             (Uid.to_int tlist.Translist.Node.id) StateSet.print s1 StateSet.print s2);
 193           add cache tlist s1 s2 f; f
 194       end
 195
 196 DEFINE LOOP (t, states, ctx) = (
 197   let _t = (t) in
 198   TRACE("top-down-run", 3,
 199         __ "Entering node %i with loop (tag %s, context %i) with states %a\n%!"
 200           (Node.to_int _t)
 201           (Tag.to_string (Tree.tag tree _t))
 202           (Node.to_int (ctx))
 203           (StateSet.print) (states));
 204   if _t == Tree.nil then nil_res
 205   else
 206     let tag = Tree.tag tree _t in
 207       l2jit_dispatch
 208         _t tag (states) (ctx) (L2JIT.find cache2 tag (states))
 209 )
 210
 211 DEFINE LOOP_TAG (t, states, tag, ctx) = (
 212   let _t = (t) in (* to avoid duplicating expression t *)
 213   TRACE("top-down-run", 3,
 214         __ "Entering node %i with loop_tag (tag %s, context %i) with states %a\n%!"
 215           (Node.to_int _t)
 216           (Tag.to_string (tag))
 217           (Node.to_int (ctx))
 218           (StateSet.print) (states));
 219   if _t == Tree.nil then nil_res
 220   else
 221     l2jit_dispatch
 222       _t (tag) (states) (ctx) (L2JIT.find cache2 (tag) (states)))
 223
 224     let top_down_run auto tree root states ctx =
 225       let res_len = (StateSet.max_elt auto.states) + 1 in
 226       let empty_slot = Array.create res_len U.NS.empty in
 227       let nil_res = auto.bottom_states, empty_slot in
 228       let cache3 = L3JIT.create () in
 229
 230       let l3jit_dispatch trl s1 s2 t sl1 sl2 =
 231         let f = L3JIT.find cache3 trl s1 s2 in
 232         if f == L3JIT.dummy then (L3JIT.cache_apply cache3 auto trl s1 s2) empty_slot sl1 sl2 tree t
 233         else f empty_slot sl1 sl2 tree t
 234
 235       in
 236       let cache2 = L2JIT.create () in
 237
 238       let () = D_TRACE_(at_exit (fun () -> L2JIT.stats Format.err_formatter cache2)) in
 239
 240       let rec l2jit_dispatch t tag states ctx opcode =
 241         match opcode with
 242           | L2JIT.RETURN () -> nil_res
 243           | L2JIT.CACHE () ->
 244               let opcode = L2JIT.compile cache2 auto tree tag states in
 245                 l2jit_dispatch t tag states ctx opcode
 246
 247           | L2JIT.LEFT (tr_list, instr) ->
 248               let res1, slot1 =
 249                 l2jit_dispatch_instr t tag states (Tree.closing tree t) instr true
 250               in
 251                 l3jit_dispatch tr_list res1 auto.bottom_states t slot1 empty_slot
 252
 253           | L2JIT.RIGHT (tr_list, instr) ->
 254             let res2, slot2 = l2jit_dispatch_instr t tag states ctx instr false in
 255               l3jit_dispatch tr_list auto.bottom_states res2 t empty_slot slot2
 256
 257           | L2JIT.BOTH (tr_list, instr1, instr2) ->
 258               let res1, slot1 =
 259                 l2jit_dispatch_instr t tag states (Tree.closing tree t) instr1 true
 260               in
 261               let res2, slot2 = l2jit_dispatch_instr t tag states ctx instr2 false in
 262                 l3jit_dispatch tr_list res1 res2 t slot1 slot2
 263
 264     and l2jit_dispatch_instr t tag states ctx instr _left =
 265       match instr with
 266         | L2JIT.NOP () -> nil_res
 267         | L2JIT.FIRST_CHILD s -> LOOP ((Tree.first_child tree t), s, ctx)
 268         | L2JIT.NEXT_SIBLING s -> LOOP ((Tree.next_sibling tree t), s, ctx)
 269 (*      | L2JIT.NEXT_SIBLING s -> LOOP ((Tree.next_node_before tree t ctx), s, ctx) *)
 270
 271         | L2JIT.FIRST_ELEMENT s -> LOOP ((Tree.first_element tree t), s, ctx)
 272         | L2JIT.NEXT_ELEMENT s -> LOOP ((Tree.next_element tree t), s, ctx)
 273 (*      | L2JIT.NEXT_ELEMENT s -> LOOP ((Tree.next_node_before tree t ctx), s, ctx) *)
 274
 275         | L2JIT.TAGGED_DESCENDANT (s, tag) ->
 276             LOOP_TAG ((Tree.tagged_descendant tree t tag), s, tag, ctx)
 277
 278         | L2JIT.TAGGED_FOLLOWING (s, tag) ->
 279             LOOP_TAG((Tree.tagged_following_before tree t tag ctx), s, tag, ctx)
 280
 281         | L2JIT.SELECT_DESCENDANT (s, _, us) ->
 282             LOOP((Tree.select_descendant tree t us), s, ctx)
 283
 284         | L2JIT.SELECT_FOLLOWING (s, pt, us) ->
 285             LOOP ((Tree.select_following_before tree t us ctx), s, ctx)
 286
 287         | L2JIT.TAGGED_CHILD (s, tag) ->
 288             LOOP_TAG((Tree.tagged_child tree t tag), s, tag, ctx)
 289
 290         | L2JIT.TAGGED_FOLLOWING_SIBLING (s, tag) ->
 291             LOOP_TAG((Tree.tagged_following_sibling tree t tag), s, tag, ctx)
 292
 293         | L2JIT.SELECT_CHILD (s, _, us) ->
 294             LOOP ((Tree.select_child tree t us), s, ctx)
 295
 296         | L2JIT.SELECT_FOLLOWING_SIBLING (s, _, us) ->
 297             LOOP ((Tree.select_following_sibling tree t us), s, ctx)
 298
 299         | L2JIT.TAGGED_SUBTREE(s, tag) ->
 300
 301           let count = U.NS.subtree_tags tree t tag in
 302           if count != U.NS.empty then
 303             let r = Array.copy empty_slot in
 304             r.(auto.last) <- count;
 305             s,r
 306           else
 307             s,empty_slot
 308
 309         | L2JIT.ELEMENT_SUBTREE(s) ->
 310
 311           let count = U.NS.subtree_elements tree t in
 312           if count != U.NS.empty then
 313             let r = Array.copy empty_slot in
 314             r.(auto.last) <- count;
 315             s,r
 316           else
 317             s,empty_slot
 318
 319       in
 320       let r = LOOP (root, states, ctx) in
 321       (*L3JIT.stats err_formatter cache3; *)
 322       r
 323
 324     let full_top_down_run auto states tree root =
 325       (*Ata.init (); *)
 326       top_down_run auto tree root states (Tree.closing tree root)
 327
 328     let top_down_run auto tree root =
 329       (*Ata.init (); *)
 330       let res, slot = full_top_down_run auto auto.init tree root in
 331
 332       slot.(StateSet.min_elt auto.topdown_marking_states)
 333
 334
 335     (*** Bottom-up evaluation function **)
 336
 337     let ns_print fmt t =
 338       Format.fprintf fmt "{ ";
 339       U.NS.iter begin fun node ->
 340         Format.fprintf fmt "%a " Node.print node;
 341       end t;
 342       Format.fprintf fmt "}"
 343
 344     let slot_print fmt t =
 345       Array.iteri begin fun state ns ->
 346         Format.eprintf "%a -> %a\n" State.print state ns_print ns;
 347       end t
 348
 349
 350     let eval_trans auto tree parent res1 res2 = assert false
 351
 352
 353     let bottom_up_run auto tree (query, pat) =
 354       let leaves = Array.to_list (Tree.full_text_query query tree pat) in
 355       let states = auto.states in
 356       let res_len = (StateSet.max_elt states) + 1 in
 357       let empty_slot = Array.create res_len U.NS.empty in
 358       let nil_res = auto.bottom_states, empty_slot in
 359       let cache = Cache.Lvl3.create 1024 L3JIT.dummy in
 360       let rec loop_leaves l acc =
 361         match l with
 362             [] -> acc
 363           | node :: ll ->
 364             let res, lll = bottom_up_next node ll Tree.nil in
 365             if (lll <> []) then Printf.eprintf "Leftover elements\n%!";
 366             res
 367
 368       and bottom_up_next node rest stop =
 369         let fs = Tree.first_child tree node in
 370         let res1 =
 371           if fs == Tree.nil then nil_res
 372           else full_top_down_run auto states tree fs
 373         in
 374         move_up node res1 true rest stop
 375
 376       and move_up node res is_left rest stop =
 377         if node == stop then res, rest
 378         else
 379           let prev_sibling = Tree.prev_sibling tree node in
 380           let is_left' = prev_sibling == Tree.nil in
 381           let real_parent = Tree.parent tree node in
 382           let parent =
 383             if is_left' then real_parent else max (Tree.first_child tree real_parent) stop
 384           in
 385           (* let parent = if is_left' then Tree.parent tree node else prev_sibling in *)
 386           let (s1, sl1), (s2, sl2), rest' =
 387             if is_left then match rest with
 388                 [] -> res, nil_res, rest
 389               | next :: rest' ->
 390                 if Tree.is_right_descendant tree node next
 391                 then
 392                   let res2, rest' = bottom_up_next next rest' node in
 393                   res, res2, rest'
 394                 else res, nil_res, rest
 395             else
 396               nil_res, res, rest
 397           in
 398           let tag = Tree.tag tree node in
 399           let id1 = Uid.to_int s1.StateSet.Node.id in
 400           let id2 = Uid.to_int s2.StateSet.Node.id in
 401           let code =
 402             let code = Cache.Lvl3.find cache tag id1 id2 in
 403             if code == L3JIT.dummy then
 404               let trl =
 405                 StateSet.fold
 406                   (fun q acc ->
 407                     List.fold_left (fun acc' (labels, tr) ->
 408                       if labels == TagSet.any || TagSet.mem tag labels
 409                       then Translist.cons tr acc' else acc')
 410                       acc
 411                       (Hashtbl.find auto.trans q)
 412                   )
 413                   states
 414                   Translist.nil
 415               in
 416               let code = L3JIT.gen_code auto trl s1 s2 in
 417               Cache.Lvl3.add cache tag id1 id2 code; code
 418             else code
 419           in
 420           let res' = code empty_slot sl1 sl2 tree node in
 421           move_up parent res' is_left' rest' stop
 422       in
 423       let _, slot = loop_leaves leaves (nil_res) in
 424       slot.(StateSet.min_elt auto.topdown_marking_states)
 425
 426
 427 (*  Grammar run *)
 428
 429     external is_young : 'a array -> bool = "caml_custom_is_young" "noalloc"
 430     external blit : 'a array -> int -> 'a array -> int -> int -> unit = "caml_custom_array_blit"
 431     module M = Map.Make(struct type t = Grammar.n_symbol let compare = compare end)
 432     let log = ref M.empty
 433     let log_symbol s =
 434       let c = try M.find s !log with _ -> 0 in
 435       log:= M.add s (c+1) !log
 436     ;;
 437     let () = at_exit (fun () -> M.iter (fun i j ->
 438       if j > 0 then
 439       Printf.eprintf "%i->%i\n%!"
 440         (Grammar.symbol i) j) !log )
 441     ;;
 442     let blit a1 o1 a2 o2 l = if l != 0 then
 443       for i = 0 to l - 1 do
 444         a2.(o2 + i) <- a1.(o1 + i);
 445       done
 446
 447
 448     let grammar_run auto g () =
 449
 450       let dummy_leaf = Grammar2.Leaf (Node.nil) in
 451       let res_len = (StateSet.max_elt auto.states) + 1 in
 452       let empty_slot = Array.create res_len U.NS.empty in
 453       let nil_res = auto.bottom_states, empty_slot in
 454       let empty_res = StateSet.empty, empty_slot in
 455       let cache3 = L3JIT.create () in
 456       let dummy2 = (StateSet.empty, StateSet.empty, Translist.nil) in
 457       let cache2 = Cache.Lvl2.create 512 dummy2 in
 458       let rule_counter = ref 0 in
 459       let start_counter = ref 0 in
 460       let () = at_exit (fun () -> Printf.eprintf "start_couter=%i, rule_counter=%i\n%!"
 461         !start_counter !rule_counter) in
 462       let get_trans tag states =
 463         let c = Cache.Lvl2.find cache2 tag (Uid.to_int states.StateSet.Node.id) in
 464         if c == dummy2 then
 465           let c =
 466             StateSet.fold (fun q tr_acc ->
 467               List.fold_left
 468                 (fun ((lstates, rstates, tacc) as acc) (ts, trs) ->
 469                   if TagSet.mem (Tag.translate tag) ts then
 470                     let _, _, _, phi = Transition.node trs in
 471                     let (_,_,l),(_,_,r) = Formula.st phi in
 472                     (StateSet.union l lstates,
 473                      StateSet.union r rstates,
 474                      Translist.cons trs tacc)
 475                   else acc)
 476                 tr_acc (Hashtbl.find auto.trans q)
 477             ) states (StateSet.empty, StateSet.empty, Translist.nil)
 478           in
 479           begin
 480             Cache.Lvl2.add cache2 tag (Uid.to_int states.StateSet.Node.id) c;
 481             c
 482           end
 483         else c
 484       in
 485       let rec start_loop idx states =
 486         incr (start_counter);
 487         TRACE("grammar", 2, __ "Node %i\n%!" (Node.to_int idx));
 488         if idx < Node.null then nil_res
 489         else if StateSet.is_empty states then empty_res
 490         else begin
 491           let symbol = Grammar2.start_tag g idx in
 492           if Grammar2.is_terminal g symbol then
 493             let symbol = Grammar2.terminal symbol in
 494             if symbol == Grammar2.nil_symbol then nil_res else
 495               let tag = Grammar2.tag symbol in
 496               let lst, rst, trans = get_trans tag states in
 497               let fs = Grammar2.start_first_child g idx in
 498               let s1, slot1 = start_loop fs lst in
 499               let s2, slot2 = start_loop (Grammar2.start_next_sibling g fs) rst in
 500               let opcode = L3JIT.find cache3 trans s1 s2 in
 501               if opcode == L3JIT.dummy then
 502                 (L3JIT.cache_apply cache3 auto trans s1 s2) empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic ())
 503               else opcode empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic())
 504           else
 505             let nt = Grammar2.non_terminal symbol in
 506             let rhs = Grammar2.get_rule g nt in
 507             let nparam = Grammar2.get_rank rhs in
 508             match nparam with
 509             | 0 -> rule_loop nt states 0 dummy_leaf dummy_leaf
 510             | 1 -> rule_loop nt states 1 (Grammar2.Leaf(Grammar2.start_first_child g idx)) dummy_leaf
 511             | 2 ->
 512               let fc = Grammar2.start_first_child g idx in
 513               let ns = Grammar2.start_next_sibling g fc in
 514               rule_loop nt states 2 (Grammar2.Leaf fc) (Grammar2.Leaf ns)
 515             | _ -> assert false
 516         end
 517       and rule_loop (t : Grammar2.n_symbol) states rank y0 y1 =
 518         incr rule_counter;
 519         if !rule_counter land (65535) == 0 then begin Gc.minor() end;
 520         let rhs = Grammar2.get_rule g t in
 521         let id1 = Grammar2.get_id1 rhs in
 522         let id2 = Grammar2.get_id2 rhs in
 523         let conf = Grammar2.get_conf rhs in
 524         if Grammar2.is_non_terminal g id1 then
 525           let id1 = Grammar2.non_terminal id1 in
 526           match conf with
 527           | Grammar2.C0 -> rule_loop id1 states 1 (Grammar2.Node0 id2) dummy_leaf
 528           | Grammar2.C1 -> rule_loop id1 states 1 (Grammar2.Node1(id2,y0)) dummy_leaf
 529           | Grammar2.C2 -> rule_loop id1 states 2 (Grammar2.Node0 id2) y0
 530           | Grammar2.C3 -> rule_loop id1 states 2 y0 (Grammar2.Node0 id2)
 531           | Grammar2.C4 -> rule_loop id1 states 1 (Grammar2.Node2(id2, y0, y1)) dummy_leaf
 532           | Grammar2.C5 -> rule_loop id1 states 2 (Grammar2.Node1(id2, y0)) y1
 533           | Grammar2.C6 -> rule_loop id1 states 2 y0 (Grammar2.Node1(id2, y1))
 534         else
 535           let id1 = Grammar2.terminal id1 in
 536           match conf with
 537           | Grammar2.C0 | Grammar2.C1 -> assert false
 538           | Grammar2.C2  -> terminal_loop id1 states (Grammar2.Node0 id2) y0
 539           | Grammar2.C3  -> terminal_loop id1 states y0 (Grammar2.Node0 id2)
 540           | Grammar2.C4  -> assert false
 541           | Grammar2.C5  -> terminal_loop id1 states (Grammar2.Node1(id2, y0)) y1
 542           | Grammar2.C6  -> terminal_loop id1 states y0 (Grammar2.Node1(id2, y1))
 543
 544       and terminal_loop (symbol : Grammar2.t_symbol) states y0 y1 =
 545         if symbol == Grammar2.nil_symbol then nil_res else begin
 546           (* todo factor in from start_loop *)
 547           let tag = Grammar2.tag symbol in
 548           let lst, rst, trans = get_trans tag states in
 549           let s1, slot1 = partial_loop y0 lst in
 550           let s2, slot2 = partial_loop y1 rst in
 551           let opcode = L3JIT.find cache3 trans s1 s2 in
 552           if opcode == L3JIT.dummy then
 553             (L3JIT.cache_apply cache3 auto trans s1 s2) empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic ())
 554           else
 555             opcode empty_slot slot1 slot2 (Obj.magic())  (Obj.magic())
 556         end
 557
 558       and partial_loop l states =
 559         match l with
 560         | Grammar2.Leaf id -> start_loop id states
 561         | Grammar2.Node0 id ->
 562           if (Grammar2.terminal id) == Grammar2.nil_symbol then nil_res
 563           else
 564             rule_loop (Grammar2.non_terminal id) states 0 dummy_leaf dummy_leaf
 565         | Grammar2.Node1 (id, y0) ->
 566           rule_loop (Grammar2.non_terminal id) states 1 y0 dummy_leaf
 567         | Grammar2.Node2 (id, y0, y1) ->
 568           if Grammar2.is_terminal g id then
 569             terminal_loop (Grammar2.terminal id) states y0 y1
 570           else
 571             rule_loop (Grammar2.non_terminal id) states 1 y0 y1
 572       in
 573
 574       let _, slot = start_loop (Node.null) auto.init in
 575       slot.(StateSet.min_elt auto.topdown_marking_states)
 576     ;;
 577
 578
 579
 580
 581
 582
 583
 584   end
 585