-- file B_tree_for_bigs_refct.stl
package B_tree_for_bigstring;		-- B-trees, realized as objects
-- *******************************************************************************************************
-- ****** B-tree variant for big_strings, with use of disk_records, cumulants in parent, refcounts  ******
-- *******************************************************************************************************
	-- This version, which makes no use of 'objects' keeps all node cumulants in their parent nodes. 
	-- 4-byte record identifiers exactly corresponding to 32-bit record numbers replace them. 
	-- Reference count management and copying are correctly handled. Refcounts can be ignored except in the 
	-- set_comp, insert, split_node, share_right, join_left, and join_left routines.
--these nodes structure the B-tree for the big-string which holds the database records

const bnr_code_pts := {"get_last", "get_nc", "get_comp", "bnr_must_copy", "bnr_last", "bnr_ncnd", "bnr_compnd", 
	"bnr_ncd", "bnr_no_rem", "bnr_rem", "bnr_comp_del", "bnr_nojs", "bnr_can_pull", 
	"bnr_can_join", "bnr_notonly", "bnr_only", "bnr_copy_in", "bnr_exists_in", 
	"bnr_nexists_in", "bnr_end_in", "bnr_end_nosp", "bnr_end_split", "bnr_end_compound", 
	"bnr_nosp_compound", "bnr_split_compound", "bnr_nosp_top", "bnr_split_top", "bnr_ins_in_nc", 
	"bnr_ins_in_nc_nos", "bnr_ins_in_nc_split", "bnr_ins_in_comp_nos", "bnr_ins_in_comp_split", 
	"bnr_ins_in_comp_nostop", "bnr_ins_in_comp_sptop", "bnr_two_halves", "bnr_pull_from_left", 
	"bnr_pull_from_right", "bnr_share_copy", "bnr_share_copy2", "bnr_share_mleft", "bnr_share_mright", 
	"bnr_j_left", "bnr_j_left_copy", "bnr_j_left_ncopy", "bnr_j_right", "bnr_j_right_copy", 
	"bnr_j_right_ncopy"};		-- code points to be traversed

procedure bnr_dump(rec);			-- get tuple from B-tree representation (DEBUGGING ONLY)
procedure bnr_check_tree_structure(tree);		-- recursive check of tree structure (DEBUGGING ONLY)

end B_tree_for_bigstring;

package body B_tree_for_bigstring;		-- B-trees, realized as objects
use byteutil,disk_records_pak,db_records,string_utility_pak,setldb;

				-- there is only one cumulant, the total length of the string sections


procedure get_ch_cum(rec,j);	-- get the cum value for the j-th child of this node
	
	return int_of_5(dr_load(rec)(bnr_cum_start + (j - 1) * 5..bnr_cum_start + j * 5 - 1));
	
end get_ch_cum;

procedure set_ch_cum(rec,j,cum_int);	-- set the cum value for the j-th child of this node

	stg := dr_load(rec);		-- make sure that this record is loaded
	stg(bnr_cum_start + (j - 1) * 5..bnr_cum_start + j * 5 - 1) := stg_of_5(cum_int);

        dr_setrecbuf(rec,stg);
        dr_dirtify(rec);		 -- note that record has been changed
	
end set_ch_cum;

procedure vect_of_children(rec);					-- gets vector of children, as a string of 4-byte record numbers
	
	nch := num_childr(rec);		-- number of children
	return dr_load(rec)(bnr_ch_start..bnr_ch_start - 1 + nch * 4);
	
end vect_of_children;

procedure set_vect_of_children(rec,stg);	-- sets vector of children, from a string of 4-byte record numbers
--print("set_vect_of_children: ",recno," ",hexify(stg));
	set_num_childr(rec,(nstg := #stg)/4);	-- set the number of children (also loads)
	missing := bnr_cum_start - bnr_ch_start - #stg;

	bstg:=dr_load(rec);
        bstg(bnr_ch_start..bnr_cum_start - 1) := (stg + missing * "\x00");
        dr_setrecbuf(rec,bstg);
                -- set the children, remembering not to change the length of the string section containing them

        dr_dirtify(rec);
	
end set_vect_of_children;

procedure vect_of_cums(rec);					-- gets vector of cums, as a string of 4-byte fields
	
	nch := num_childr(rec);		-- number of children
	return dr_load(rec)(bnr_cum_start..bnr_cum_start - 1 + nch * 5);

end vect_of_cums;

procedure set_vect_of_cums(rec,stg);	-- sets vector of children, from a string of 4-byte record numbers

	missing := rec_size + 1 - bnr_cum_start - #stg;

        bstg:=dr_load(rec);                -- force load
        bstg(bnr_cum_start..rec_size) := (stg + missing * "\x00");
                -- set the children, remembering not to change the length of the string section containing them
        dr_setrecbuf(rec,bstg);

        dr_dirtify(rec);
	
end set_vect_of_cums;

procedure voc(rec,j);					-- n'th member of vector of children

	stg := dr_load(rec);					-- load this string
	cjstrt := (j - 1) * 4 + bnr_ch_start; 
	return stg(cjstrt..cjstrt + 3);		-- return child rec
	
end voc;

procedure set_voc(rec,j,chrec);				-- set n'th member of vector of children

        cjstrt := (j - 1) * 4 + bnr_ch_start;
        bstg:=dr_load(rec);                -- force load; then set the first character of the record
        bstg(cjstrt..cjstrt + 3) := chrec;
        dr_setrecbuf(rec,bstg);
        dr_dirtify(rec);

end set_voc;


procedure bnr_dump(rec);			-- get tuple from nested representation
				-- is compound representation or direct, depending on whether 'is_compound' flag is set
				-- note that this shows the vector of components, without their cumulants
				-- we ignore the cumulants in the tree nodes
var indent := 0;
return bnr_dump_in(rec);			-- call inner workhorse

procedure bnr_dump_in(rec);			-- inner workhorse

	if dr_is_compound(rec) then 		-- compound case
		indent +:= 1; nc := num_childr(rec);
		stg :=  (["\n" + (indent * "   ") + "("] +/ [bnr_dump_in(voc(rec,j)): j in [1..nc]]) 
					+ ["\n" + (indent * "   ")+ "[" + str(nc) + "]"  
						+ str(bnr_get_cum(rec)) + ")"]; 
		indent -:= 1;
		return stg;
	end if;						-- done with compound case

	t := [];
	for j in [1..num_childr(rec)] loop
		chj := voc(rec,j);
		svj := if (lvj := sr_length(chj)) > 0 then sr_slice(chj,1,lvj) else "" end if; t with:= svj;
	end loop;
	
	return ["\n" + (indent * "   ") + "("] + t + [str(bnr_get_cum(rec)) + ")"];

end bnr_dump_in;

end bnr_dump;

procedure bnr_check_tree_structure(tree);		-- recursive check of tree structure (DEBUGGING ONLY)

var level_now := 0,set_of_levels := { };
var smallest_branching := 10000;

	check_tree_structure_in(tree);		-- call inner recursive workhorse

	if #set_of_levels > 1 then 
		print("TREE STRUCTURE INCONSISTENCY, LEVELS ARE: ",set_of_levels," ",str(bnr_dump(tree))); return false;
	end if;

	if smallest_branching < wo_low_lim then 
		print("TREE STRUCTURE INCONSISTENCY, BRANCHING LEVEL DROPS TO: ",smallest_branching); return false;
	end if;
	
	return true;		-- otherwise OK
	 
	procedure check_tree_structure_in(tree);		-- inner recursive workhorse
		
		level_now +:= 1; 
		nc := num_childr(tree);
		if level_now > 1 then smallest_branching := smallest_branching min nc; end if;

		if dr_is_compound(tree) then 
			for j in [1..nc] loop check_tree_structure_in(voc(tree,j)); end loop;
		else		-- at leaf, so collect level of leaf
			set_of_levels with:= level_now;
		end if;
		
		level_now -:= 1; 			-- restor  te prior level
		
	end check_tree_structure_in;

end bnr_check_tree_structure;

end B_tree_for_bigstring;

program test;

use byteutil,B_tree_for_bigstring,db_records,string_utility_pak,disk_records_pak,setldb;

var tree,small_tree;		-- tree to test

code_pts := bnr_code_pts;				-- code points to be traversed
	
--print("******* test B-trees with string cumulants ********"); string_cum_tests;		-- test B-trees with string cumulants
str_len_cum_tests;		-- tests of B-tree operations for string trees

procedure str_len_cum_tests;		-- tests of B-tree operations for string trees
 		-- tests of B-tree operations for trees with one cumulant, which will be string length

	small_tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc","."))]);
	for j in [1..150] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"X" + str(j));
		bnr_insert(small_tree,1,leaf);	-- insert leaf into small tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("check_consistency: ",check_consistency(small_tree)," ",str(bnr_dump(small_tree))); 
	incref(small_tree,-1); 
	print("use_history 0:",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	use_history := [];
	for reps in [1..the_last := 15] loop
		tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc.d.ddd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj","."))]);
		xtree := tree; incref(tree,1);						-- save and note a second copy
		for j in [1..7] loop bnr_set_comp(tree,1,OM); end loop;		-- deletions in one copy
		if reps = the_last then print("tree: ",str(bnr_dump(tree))); print("xtree: ",str(bnr_dump(xtree))); end if;
		incref(tree,-1); incref(xtree,-1);		-- demolish both trees
		use_history with:= str(if is_tuple(cm := check_memory()) then cm(1) else cm end if);
	end loop;
	print("use_history A:",str(use_history));

	use_history := [];
	for reps in [1..the_last := 15] loop
		small_tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc","."))]);
		for j in [1..34] loop
			leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"X" + str(j));
			bnr_insert(small_tree,OM,leaf);	-- insert leaf into small tree
			incref(leaf,-1); 		-- the leaf is now dead
			--print("insertion: ",j," ",str(bnr_dump(small_tree)));
			--if not check_consistency(small_tree) then stop; end if;
		end loop;
		if reps = the_last then print("small tree after insertions: ",str(bnr_dump(small_tree))," ",bnr_get_cum(small_tree)," ",check_consistency(small_tree)); end if;
		incref(small_tree,-1); 		-- demolish the tree
		use_history with:= str(if is_tuple(cm := check_memory()) then cm(1) else cm end if);
	end loop;
	print("use_history B:",str(use_history));

	use_history := [];

	small_tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc","."))]);
	for j in [1..3] loop
		bnr_set_comp(small_tree,1,OM);	-- delete leaf of small tree
		print("small tree: ",str(bnr_dump(small_tree)));	-- check the tree structure
	end loop;
	incref(small_tree,-1); 		-- demolish the tree
	use_history with:= str(if is_tuple(cm := check_memory()) then cm(1) else cm end if);

	for j in [1..10] loop

		small_tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc","."))]);
--		print("small tree: ",str(bnr_dump(small_tree)));	-- check the tree structure
--		print(collect_leaves(small_tree)); print(collect_cums(small_tree));
	
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"XXX");
--		print("leaf check: ",string_of(leaf));
		bnr_set_comp(small_tree,1,leaf);	-- change leaf of small tree
		incref(leaf,-1); 		-- the leaf is now dead
--		print("small_tree check: ",str(bnr_dump(small_tree)));
	
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"YYY");
--		print("leaf recheck: ",string_of(leaf));
		bnr_set_comp(small_tree,1,leaf);	-- change leaf of small tree
		incref(leaf,-1); 		-- the leaf is now dead
--		print("small_tree recheck: ",str(bnr_dump(small_tree)));

		incref(small_tree,-1); 		-- demolish the tree
		use_history with:= str(if is_tuple(cm := check_memory()) then cm(1) else cm end if);

	end loop;
	print("use_history C:",str(use_history));

	small_tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc","."))]);
	for j in [1..3] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,str(j));
		bnr_set_comp(small_tree,j,leaf);	-- change leaf of small tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("small_tree after changes: ",collect_cums(small_tree)," ",bnr_get_cum(small_tree));
	print("check_consistency - small_tree after changes: ",check_consistency(small_tree)); 
	incref(small_tree,-1); 		-- demolish the tree
	use_history with:= str(if is_tuple(cm := check_memory()) then cm(1) else cm end if);
	print("use_history D: ",str(use_history));

	tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc.d.ddd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj","."))]);
	print(str(bnr_dump(tree)));
	print("tree length is: ",bnr_get_cum(tree));
	print("distinct tree components w cums. are: ",str(collect_cums(tree)));
	print("distinct tree components are: ",str(collect_leaves(tree)));

	for j in [1..10] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,str(j));
		bnr_set_comp(tree,j,leaf);	-- change leaf of tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("tree after changes: ",collect_cums(tree)," ",bnr_get_cum(tree));
	print("check_consistency - tree after changes: ",check_consistency(tree)); 
	incref(tree,-1); 		-- demolish the tree
	print("use_history E :",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc.d.ddd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj","."))]);
	print("tree before deletion: ",str(bnr_dump(tree))," ",bnr_get_cum(tree));
	bnr_set_comp(tree,1,OM);	-- delete leaf of small tree
	print("tree after 1 deletion: ",str(bnr_dump(tree)),"\n",str(collect_cums(tree))," ",bnr_get_cum(tree));
	print("check_consistency - tree after 1 deletion: ",check_consistency(tree)); 

	for j in [1..10] loop
		bnr_set_comp(tree,1,OM);	-- delete leaf of  tree
	end loop;
	print("check_consistency - tree after deletions: ",check_consistency(tree)); 
	incref(tree,-1); 		-- demolish the tree
	print("use_history F: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc.d.ddd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj","."))]);
	print("tree before deletion: ",str(bnr_dump(tree))," ",bnr_get_cum(tree));
	bnr_set_comp(tree,OM,OM);	-- delete leaf of small tree
	print("tree after 1 deletion: ",str(bnr_dump(tree))," ",bnr_get_cum(tree));
	print("check_consistency - tree after 1 end deletion: ",check_consistency(tree)); 

	for j in [1..10] loop
		bnr_set_comp(tree,OM,OM);	-- delete leaf of tree
	end loop;
	print("check_consistency - tree after end deletions: ",bnr_get_cum(tree)," ",check_consistency(tree)); 

	for j in [1..150] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"X" + str(j));
		bnr_insert(tree,1,leaf);	-- insert leaf into tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("check_consistency - insertions at start: ",check_consistency(tree)); 
	incref(tree,-1); 		-- demolish the tree
	print("use_history G: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc.d.ddd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj","."))]);
	for j in [1..150] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"X" + str(j));
		bnr_insert(tree,OM,leaf);	-- insert leaf into tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("check_consistency - insertions at end: ",check_consistency(tree)); 

	incref(tree,-1); 		-- demolish the tree
	print("use_history H: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	small_tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc",".")]);
	for j in [1..150] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"X" + str(j));
		bnr_insert(small_tree,1,leaf);	-- insert leaf into small tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("check_consistency - small_tree insertions at start: ",check_consistency(small_tree)); 
	incref(small_tree,-1); 		-- demolish the tree
	print("use_history I: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	small_tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc",".")]);
	for j in [1..150] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"X" + str(j));
		bnr_insert(small_tree,OM,leaf);	-- insert leaf into small tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("check_consistency - small_tree insertions at end: ",check_consistency(small_tree)); 
	incref(small_tree,-1); 		-- demolish the tree
	print("use_history J: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	small_tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc",".")]);
	print(str(bnr_dump(small_tree)));
	print("small_tree length is: ",bnr_get_cum(small_tree));
	print("small_tree components are: ",str([sr_slice(c1 := bnr_comp(small_tree,j),1,sr_length(c1)): j in [1..bnr_get_cum(small_tree)]]));
	print("small_tree components w cums. are: ",str([sr_slice(c1 := bnr_comp(small_tree,j),1,sr_length(c1)): j in [1..bnr_get_cum(small_tree)]]));
	print("distinct small_tree components w cums. are: ",collect_cums(small_tree));
	print("distinct small_tree components are: ",collect_leaves(small_tree));

	leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"Insert" + str(1));
	bnr_insert(small_tree,1,leaf);	-- insert leaf at start of tree
	incref(leaf,-1); 		-- the leaf is now dead
	print("small_tree after insertion at start: ",collect_cums(small_tree)," ",bnr_get_cum(small_tree));

	leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"Insert" + str(2));
	bnr_insert(small_tree,OM,leaf);	-- insert leaf at start of tree
	print("small_tree after insertion at end: ",collect_cums(small_tree)," ",bnr_get_cum(small_tree));
	incref(leaf,-1); 		-- the leaf is now dead

	leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"XXX");
	print("leaf check: ",string_of(leaf));
	bnr_set_comp(small_tree,1,leaf);	-- change leaf of small tree
	incref(leaf,-1); 		-- the leaf is now dead
	print("small_tree check: ",str(bnr_dump(small_tree)));

	leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"YYY");
	print("leaf recheck: ",string_of(leaf));
	bnr_set_comp(small_tree,1,leaf);	-- change leaf of small tree
	incref(leaf,-1); 		-- the leaf is now dead
	print("small_tree recheck: ",str(bnr_dump(small_tree)));

	for j in [1..3] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,str(j));
		bnr_set_comp(small_tree,j,leaf);	-- change leaf of small tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("small_tree after changes: ",collect_cums(small_tree)," ",bnr_get_cum(small_tree));
	incref(small_tree,-1); 		-- demolish the tree
	print("use_history K: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc.d.ddd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj","."))]);
	print(str(bnr_dump(tree)));
	print("tree length is: ",bnr_get_cum(tree));
	print("distinct tree components w cums. are: ",collect_cums(tree));
	print("distinct tree components are: ",collect_leaves(tree));

	for j in [1..10] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,str(j));
		bnr_set_comp(tree,j,leaf);	-- change leaf of small tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("tree after changes: ",collect_cums(tree)," ",bnr_get_cum(tree));

	for j in [1..10] loop
		bnr_set_comp(tree,1,OM);	-- delete first leaf of tree
	end loop;
	print("tree after deletion: ",10," ",collect_cums(tree)," ",bnr_get_cum(tree));
	incref(tree,-1); 		-- demolish the tree
	print("use_history LL: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc.d.ddd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj","."))]);
	for j in [1..10] loop
		bnr_set_comp(tree,OM,OM);	-- delete last leaf of tree
	end loop;
	print("tree after end deletion: ",10," ",collect_cums(tree)," ",bnr_get_cum(tree));
	incref(tree,-1); 		-- demolish the tree
	print("use_history L: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc",".")]);
	leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"Insert" + str(1));
	bnr_insert(tree,1,leaf);	-- insert leaf at start of tree
	incref(leaf,-1); 		-- the leaf is now dead
	print("tree after insertion at start: ",collect_cums(tree)," ",bnr_get_cum(tree));
	leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"Insert" + str(2));
	bnr_insert(tree,OM,leaf);	-- insert leaf at end of tree
	incref(leaf,-1); 		-- the leaf is now dead
	print("tree after insertion at end: ",collect_cums(tree)," ",bnr_get_cum(tree));
	incref(tree,-1); 		-- demolish the tree
	print("use_history M: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	small_tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc",".")]);
	for j in [1..150] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"X" + str(j));
		bnr_insert(small_tree,1,leaf);	-- insert leaf into small tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("check_consistency: ",check_consistency(small_tree));

	for j in [1..140] loop
		bnr_set_comp(small_tree,1,OM);	-- delete first leaf of tree
	end loop;
	print("small_tree after re_deletion at start: ",collect_cums(small_tree)," ",bnr_get_cum(small_tree));
	print("check_consistency: ",check_consistency(small_tree)); 
	incref(small_tree,-1); 		-- demolish the tree
	print("use_history N: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	small_tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc",".")]);
	for j in [1..150] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"X" + str(j));
		bnr_insert(small_tree,OM,leaf);	-- insert leaf into small tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("check_consistency: ",check_consistency(small_tree));

	for j in [1..140] loop
		bnr_set_comp(small_tree,OM,OM);	-- delete last leaf of tree
	end loop;
	print("small_tree after re_deletion at end: ",collect_cums(small_tree)," ",bnr_get_cum(small_tree));
	print("check_consistency: ",check_consistency(small_tree)); 
	incref(small_tree,-1); 		-- demolish the tree
	print("use_history O: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	small_tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc",".")]);
	print("last element: ",string_of((stom := bnr_comp_cum(small_tree,OM))(1))," ",stom(2)); 
	print("check_consistency: ",check_consistency(small_tree));
	
	print("small_tree cums: ");
	print("small_tree leaves with cumulants: ",str([string_and_cum(bnr_comp_cum(small_tree,j)): j in [1..bnr_get_cum(small_tree)]]));

	for j in [1..3] loop
		bnr_set_comp(small_tree,1,OM);	-- delete first leaf of small tree
		print("small_tree after deletion: ",j," ",collect_cums(small_tree)," ",bnr_get_cum(small_tree));
	end loop;

	for j in [1..34] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"X" + str(j));
		bnr_insert(small_tree,OM,leaf);	-- insert leaf into small tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("small_tree after insertion at end: ",collect_cums(small_tree)," ",bnr_get_cum(small_tree));
	print("last element: ",string_of((stom := bnr_comp_cum(small_tree,OM))(1))," ",stom(2)); 
	print("check_consistency: ",check_consistency(small_tree));
	incref(small_tree,-1); 		-- demolish the tree
	print("use_history P: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc.d.ddd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj","."))]);
	for j in [1..12] loop bnr_set_comp(tree,OM,OM); end loop;	-- delete last leaf of tree
	print("tree after right deletions: ",collect_cums(tree)," ",bnr_get_cum(tree));
	incref(tree,-1); 		-- demolish the tree
	print("use_history Q: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc.d.ddd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj","."))]);
	for j in [1..12] loop bnr_set_comp(tree,1,OM); end loop;	-- delete last leaf of tree
	print("tree after left deletions: ",collect_cums(tree)," ",bnr_get_cum(tree));
	incref(tree,-1); 		-- demolish the tree
	print("use_history R: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc.d.ddd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj","."))]);
	for j in [1..17] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,str(j));
		bnr_set_comp(tree,j,leaf);	-- change j-th leaf of tree
		incref(leaf,-1); 		-- the leaf is now dead
	end loop;
	print("tree after changes: ",collect_cums(tree)," ",bnr_get_cum(tree));
	print();
	print("check_consistency: ",check_consistency(tree));
	incref(tree,-1); 		-- demolish the tree
	print("use_history S: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	print("big_tree cums");
	tree := bnr_make_from_tuple([x: x in (bu := breakup("a.bb.ccc.d.ddd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj","."))]);
	print("tree leaves with cumulants: ",str([string_and_cum(bnr_comp_cum(tree,j)): j in [1..bnr_get_cum(tree)]]));

	print("tree leaves (with reps): ",str([string_of(bnr_comp(tree,j)): j in [1..bnr_get_cum(tree)]]));
	incref(tree,-1); 		-- demolish the tree
	print("use_history S: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

print("*********** initial_tests ***********"); initial_tests;			-- initial tests for B-trees with cumulators
print("*********** deletion_tests ***********"); deletion_tests;			-- test the deletion operations for B-trees with cumulators
print("*********** insertion_tests ***********"); insertion_tests;		-- test the insertion operations for B-trees with cumulators

--report_points_passed(); 	-- report on code points not traversed
--points not passed: {"bnr_j_left_copy", "bnr_j_right_copy", "bnr_share_copy2", "bnr_copy_in"}
end str_len_cum_tests;

procedure str_len(stg); return [sr_length(stg)]; end str_len;		-- string length function, in a unit tuple

procedure collect_leaves(t);		-- collect the distinct leaves of a tree
	return str([string_of(bnr_comp(t,j)): j in [1..bnr_get_cum(t)] | (j = 1 or bnr_comp(t,j) /= bnr_comp(t,j - 1))]);
end collect_leaves;

procedure collect_cums(t);		-- collect the distinct leaves of a tree
	return str([[string_of((tj := bnr_comp_cum(t,j))(1)),tj(2)]: j in [1..bnr_get_cum(t)] | (j = 1 or bnr_comp_cum(t,j) /= bnr_comp_cum(t,j - 1))]);
end collect_cums;

procedure string_and_cum(rno_cum);		-- convert a string node recno to the corresponding string
	[rec_no,the_cum] := rno_cum; return [string_of(rec_no),the_cum];
end string_and_cum;

procedure string_of(rec);		-- convert a string node rec to the corresponding string
	
	return sr_slice(rec,1,sr_length(rec));	-- get its string
	
end string_of;

procedure initial_tests;			-- initial tests for B-trees with cumulators

	small_tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc",".")]);
	print("small_tree - a.bb.ccc: ",str(bnr_dump(small_tree)));	
	print("small_tree leaf 1 and length: ",string_of(bnr_comp(small_tree,1)), " " ,bnr_get_cum(small_tree));
	print("small_tree leaves (with reps.) and length: ",str([string_of(bnr_comp(small_tree,j)): j in [1..bnr_get_cum(small_tree)]]));
	print("small_tree leaves (no reps.): ",collect_leaves(small_tree));
	incref(small_tree,-1); 		-- demolish the tree
	print("use_history T: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));
	
	tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc.dd.dd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj",".")]);
	print("tree leaves: ",str(bnr_dump(tree)));	
	print("tree leaf 1 and length: ",string_of(bnr_comp(tree,1)), " " ,bnr_get_cum(tree));
	print("20 tree leaves (with reps.): ",str([string_of(bnr_comp(tree,j)): j in [1..20]]));
	print("tree leaves (no reps.): ",collect_leaves(tree));

	bnr_set_comp(tree,1,OM);	-- delete the first element
	print("first element of compound tree deleted: ",bnr_get_cum(tree)," ",str(collect_cums(tree)));
	print("check_consistency: ",check_consistency(tree));

	tj := string_of(bnr_comp(tree,2)); 
	leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,tj(1) + "XXX" + tj(1));
	bnr_set_comp(tree,2,leaf);
	incref(leaf,-1); 		-- the leaf is now dead
	print("'XXX' inserted into element of compound tree: ",str(bnr_dump(tree))); 
	incref(tree,-1); 		-- demolish the tree
	print("use_history T: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	print("Iterative check; changes in successive positions");
	all_ok := true;
	tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc.dd.dd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj",".")]);
						-- re-initialize the tree
	for j in [1..10] loop
		
		tj := string_of(bnr_comp(tree,j)); 
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,tj(1) + "XXX" + tj(1));
		bnr_set_comp(tree,j,leaf);
		incref(leaf,-1); 		-- the leaf is now dead
		
		if not check_consistency(tree) then
			print("IC1 - iteration ",j," error ",bnr_dump(tree));
			print(str(bnr_dump(tree))); 
			for mm in [1..bnr_get_cum(tree)] loop print(mm,": ",bnr_comp(tree,mm)); end loop;
			all_ok := false; stop;
		end if;
		
		--print("CC1 - iteration ",j," ",str(bnr_dump(tree))); 
		--print(str(bnr_dump(tree))); 
		
	end loop;
	if all_ok then print("Iterative change test passed successfully."); end if;
	incref(tree,-1); 		-- demolish the tree
	print("use_history U: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

end initial_tests;

procedure deletion_tests;			-- test the deletion operations for B-trees with cumulators

	print("Iterative check; deletions in successive positions");
	all_ok := true;
	tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc.dd.dd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj",".")]);
						-- re-initialize the tree
	
	for j in [1..10] loop
		
		bnr_set_comp(tree,j,OM);
		
		if not check_consistency(tree) then
			print("IC1 - iteration ",j," error ",bnr_dump(tree));
			print(str(bnr_dump(tree))); 
			for mm in [1..bnr_get_cum(tree)] loop print(mm,": ",tree(mm)); end loop;
			all_ok := false; stop;
		end if;
		incref(tree,-1); 		-- demolish the tree
		
		--print("IC1 - iteration ",j," ",str(bnr_dump(tree))); 
		--print(str(bnr_dump(tree))); 
		tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc.dd.dd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj",".")]);
						-- re-initialize the tree
		
	end loop;
	
	if all_ok then print("First deletion test passed successfully."); end if;
	incref(tree,-1); 		-- demolish the tree
	print("use_history V: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));
	
	tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc.dd.dd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj",".")]);
						-- re-initialize the tree
 	all_ok := true;
	print("Iterative check; deletions at start"); 

	for j in [1..10] loop
		bnr_set_comp(tree,1,OM);		-- delete the first tree element
		if not check_consistency(tree) then
			print("IC2 - iteration ",j," error ",bnr_dump(tree));
			print(str(bnr_dump(tree))); 
			all_ok := false; stop;
		end if;
--		print("IC2 - iteration ",j," ",str(bnr_dump(tree)));
	end loop;
	
	if all_ok then print("Second deletion test passed successfully."); end if;
	incref(tree,-1); 		-- demolish the tree
	print("use_history W: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc.dd.dd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj",".")]);
						-- re-initialize the tree
	all_ok := true;
	print("Iterative check; deletions at end"); 

	for j in [1..10] loop
		bnr_set_comp(tree,bnr_get_cum(tree),OM);		-- delete the last tree element
		if not check_consistency(tree) then
			print("IC3 - iteration ",j," error ",bnr_dump(tree));
			print("#tree is: ", bnr_get_cum(tree)); print(str(bnr_dump(tree))); 
			all_ok := false; stop;
		end if;
--		print("IC3 - iteration ",j," ",str(bnr_dump(tree)));
	end loop;
	if all_ok then print("Third deletion test passed successfully."); end if;
	incref(tree,-1); 		-- demolish the tree
	print("use_history X: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

end deletion_tests;

procedure insertion_tests;			-- test the insertion operations for B-trees with cumulators

	all_ok := true;
	print("Iterative check; insertions after end, starting with null tree"); 
	tree := bnr_make_from_tuple(["a"]); bnr_set_comp(tree,1,OM);

	for j in [1..10] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"Insert" + str(j - 1));
		bnr_insert(tree,bnr_get_cum(tree) + 1,leaf);		-- make the insertion
		incref(leaf,-1); 		-- the leaf is now dead
		--print("After CUM_INS0 - iteration ",j," ",str(bnr_dump(tree)));	--print(str(bnr_dump(tree)));
		if (not check_consistency(tree)) or bnr_get_cum(tree) /= 7 * j then
			print("CUM_INS0 - iteration ",j," error ",lo," ",le);
			print(str(bnr_dump(tree))); 
			all_ok := false; stop;
		end if;
	end loop;
	if all_ok then print("Insertion starting with null tree test passed successfully."); end if;
	incref(tree,-1); 		-- demolish the tree
	print("use_history X: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc.dd.dd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj",".")]);
						-- re-initialize the tree
	all_ok := true;
	print("Iterative check; insertions after end"); 
	all_ok := true; 
	for j in [0..9] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"Insert" + str(j));
		bnr_insert(tree,bnr_get_cum(tree) + 1,leaf);		-- make the insertion
		incref(leaf,-1); 		-- the leaf is now dead
--		print("After CUM_INS1 - iteration ",j," ",str(bnr_dump(tree)));
		if not check_consistency(tree) then
			print("CUM_INS1 - iteration ",j," error ",bnr_dump(tree));
			print(str(bnr_dump(tree))); 
			all_ok := false; stop;
		end if;
	end loop;
	if all_ok then print("Insertion-at-end test passed successfully."); end if;
	incref(tree,-1); 		-- demolish the tree
	print("use_history Y: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc.dd.dd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj",".")]);
						-- re-initialize the tree
	all_ok := true;
	print("Iterative check; insertions at start"); 
	all_ok := true; 
	for j in [0..9] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"Insert" + str(j));
		bnr_insert(tree,1,leaf);		-- make the insertion
		incref(leaf,-1); 		-- the leaf is now dead
		--print("After CUM_INS2 - iteration ",j," ",str(bnr_dump(tree)));  --print(str(bnr_dump(tree)));
		if not check_consistency(tree) then
			print("CUM_INS2 - iteration ",j," error ",bnr_dump(tree));
			print(str(bnr_dump(tree))); 
			all_ok := false; stop;
		end if;
	end loop;
	if all_ok then print("Insertion-at-start test passed successfully."); end if;
	incref(tree,-1); 		-- demolish the tree
	print("use_history Z: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

	tree := bnr_make_from_tuple([x: x in breakup("a.bb.ccc.dd.dd.ee.eee.ff.ffff.g.gg.h.hhh.ii.iii.j.jj.jjj",".")]);
						-- re-initialize the tree
	all_ok := true;
	print("Iterative check; insertions after second element"); 
	for j in [0..9] loop
		leaf := set_type(dr_new_rec(),string_record); sr_set_slice(leaf,1,0,"Insert" + str(j));
		bnr_insert(tree,3,leaf);		-- make the insertion
		incref(leaf,-1); 		-- the leaf is now dead
		--print("After CUM_INS3 - iteration ",j," ",str(bnr_dump(tree)));  --print(str(bnr_dump(tree)));
		if not check_consistency(tree) then
			print("CUM_INS3 - iteration ",j," error ",bnr_dump(tree));
			print(str(bnr_dump(tree))); 
			all_ok := false; stop;
		end if;
	end loop;
	if all_ok then print("Insertion-after-second test passed successfully."); end if;
	incref(tree,-1); 		-- demolish the tree
	print("use_history A1: ",str(if is_tuple(cm := check_memory()) then cm(1) else cm end if));

end insertion_tests;

procedure check_consistency(the_tree);		-- consistency check for big_string trees
	
	if not bnr_check_tree_structure(the_tree) then return false; end if;
	
		-- check that vector of leaves obtained directly is also obtained by collecting individual components
	if (lo := str(leaves_only(bnr_dump(the_tree)))) /= (le := collect_leaves(the_tree)) then 
		print(lo," ",str(le)," ",str(bnr_dump(the_tree)));
		print("FAILURE: leaf discrepancy"); return false; 
	end if;

		-- check that cumulants advance properly
	if exists n in [2..bnr_get_cum(the_tree)] | (((tn := bnr_comp_cum(the_tree,n)) /= (tnm12 := bnr_comp_cum(the_tree,n - 1))) 
			and (tn(2) /= (tnm12(2) + #string_of(tn(1))))) then 
		print("FAILURE: cumulant bad at position ",n," ",string_and_cum(tn)," ",string_and_cum(tnm12)," ",string_of(tn(1))); return false;
	 end if;
		-- check that the first cumulant is good
	if  (cc1 := bnr_comp_cum(the_tree,1))(2) /= #string_of(cc1(1)) then 
		print("FAILURE: first node cumulant is not leaf length"); 
		return false; 
	end if;

	return true;
	
end check_consistency;

procedure leaves_only(tup); return [c: c in tup | ("(" notin c) and (")" notin c)]; end leaves_only;

end test;