- match f_kind with
- |`TAG(tag) ->
- (fun t _ -> eval_fold2_slist fl_list t empty_res
- (loop_tag tag (first t) llist t))
- | `ANY ->
- (fun t _ -> eval_fold2_slist fl_list t empty_res
- (loop (first t) llist t))
- | _ -> assert false)
-
- | `NIL,_ -> (
- match n_kind with
- |`TAG(tag) ->
- (fun t ctx -> eval_fold2_slist fl_list t
- (loop_tag tag (next t ctx) rlist ctx) empty_res)
-
- | `ANY ->
- (fun t ctx -> eval_fold2_slist fl_list t
- (loop (next t ctx) rlist ctx) empty_res)
-
- | _ -> assert false)
-
- | `TAG(tag1),`TAG(tag2) ->
- (fun t ctx -> eval_fold2_slist fl_list t
- (loop (next t ctx) rlist ctx)
- (loop (first t) llist t))
-
- | `TAG(tag),`ANY ->
- (fun t ctx ->
- eval_fold2_slist fl_list t
- (loop (next t ctx) rlist ctx)
- (loop_tag tag (first t) llist t))
- | `ANY,`TAG(tag) ->
- (fun t ctx ->
- eval_fold2_slist fl_list t
- (loop_tag tag (next t ctx) rlist ctx)
- (loop (first t) llist t) )
- | `ANY,`ANY ->
- (fun t ctx ->
- eval_fold2_slist fl_list t
- (loop (next t ctx) rlist ctx)
- (loop (first t) llist t) )
- | _ -> assert false
+ match f_kind with
+ |`TAG(tag') ->
+ let default = fun t _ -> eval_fold2_slist fl_list t (Tree.tag tree t) empty_res
+ (loop_tag tag' (first t) llist t )
+ in
+ let cf = SList.hd llist in
+ if (slot_size == 1) && StateSet.is_singleton cf
+ then
+ let s = StateSet.choose cf in
+ if (Algebra.is_rec a s fst) && (Algebra.is_rec a s snd)
+ && (Algebra.is_final_marking a s)
+ then
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ RS.mk_quick_tag_loop default llist 1 tree tag'
+ else
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ default
+ else
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ default
+ | _ ->
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ (fun t _ -> eval_fold2_slist fl_list t (Tree.tag tree t) empty_res
+ (loop (first t) llist t ))
+ )
+ | `NIL,_ -> (
+ match n_kind with
+ |`TAG(tag') ->
+ if SList.equal rlist slist && tag == tag' then
+ let rec loop t ctx =
+ if t == Tree.nil then empty_res else
+ let res2 = loop (next t ctx) ctx in
+ eval_fold2_slist fl_list t tag res2 empty_res
+ in Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__);loop
+ else
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ (fun t ctx -> eval_fold2_slist fl_list t (Tree.tag tree t)
+ (loop_tag tag' (next t ctx) rlist ctx ) empty_res)
+
+ | _ ->
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ (fun t ctx -> eval_fold2_slist fl_list t (Tree.tag tree t)
+ (loop (next t ctx) rlist ctx ) empty_res)
+ )
+
+ | `TAG(tag1),`TAG(tag2) ->
+ let _ = Printf.eprintf "Using %i %s %s\n" (Loc.start_line __LOCATION__)
+ (Tag.to_string tag1)
+ (Tag.to_string tag2)
+ in
+ (fun t ctx ->
+ eval_fold2_slist fl_list t (Tree.tag tree t)
+ (loop_tag tag2 (next t ctx) rlist ctx )
+ (loop_tag tag1 (first t) llist t ))
+
+ | `TAG(tag'),`ANY ->
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ (fun t ctx ->
+ eval_fold2_slist fl_list t (Tree.tag tree t)
+ (loop (next t ctx) rlist ctx )
+ (loop_tag tag' (first t) llist t ))
+
+ | `ANY,`TAG(tag') ->
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ (fun t ctx ->
+ eval_fold2_slist fl_list t (Tree.tag tree t)
+ (loop_tag tag' (next t ctx) rlist ctx )
+ (loop (first t) llist t ))
+
+ | `ANY,`ANY ->
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ if SList.equal slist rlist && SList.equal slist llist
+ then
+ let rec loop t ctx =
+ if t == Tree.nil then empty_res else
+ let r1 = loop (first t) t
+ and r2 = loop (next t ctx) ctx
+ in
+ eval_fold2_slist fl_list t (Tree.tag tree t) r2 r1
+ in
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ loop
+ else
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ (fun t ctx ->
+ eval_fold2_slist fl_list t (Tree.tag tree t)
+ (loop (next t ctx) rlist ctx )
+ (loop (first t) llist t ))
+ | _,_ ->
+ let _ = Printf.eprintf "Using %i\n" (Loc.start_line __LOCATION__) in
+ (fun t ctx ->
+ eval_fold2_slist fl_list t (Tree.tag tree t)
+ (loop (next t ctx) rlist ctx )
+ (loop (first t) llist t ))
+