- begin match EU.list_select None st.ET.r with
- | None ->
- let r = {ET.v = st.ET.s; ET.o = os; ET.n = ns} in
- st.ET.r <- EU.roles_union [false, r] st.ET.r
- | Some r ->
- if r.ET.v <> st.ET.s then EU.raise_error ET.EWrongVersion else
- r.ET.o <- EU.objs_union os r.ET.o;
- r.ET.n <- EU.names_union ns r.ET.n;
+ let add r =
+ r.ET.ro <- EU.oobj_union os r.ET.ro;
+ r.ET.rn <- EU.nobj_union ns r.ET.rn;
+ r.ET.rb <- false
+ in
+ let is_selected _ r = r.ET.rb && EU.stage_compare r.ET.rs st.ET.ss = 0 in
+ let is_new _ r = r.ET.ro = [] && EU.stage_compare r.ET.rs st.ET.ss = 0 in
+ let is_deleted _ r = r.ET.rn = [] && EU.stage_compare r.ET.rs st.ET.ss = 0 in
+ begin
+ if EU.list_apply is_selected add 0 st.ET.sr then () else
+ if os = [] && EU.list_apply is_new add 0 st.ET.sr then () else
+ if ns = [] && EU.list_apply is_deleted add 0 st.ET.sr then () else
+ let r = {ET.rb = false; ET.rx = false; ET.rs = st.ET.ss; ET.ro = os; ET.rn = ns} in
+ st.ET.sr <- EU.robj_union st.ET.sr [r]
+ end;
+ st.ET.so <- ts; st.ET.sn <- ws; st.ET.sm <- true
+
+let add_tops v =
+ let prop _ r = EU.stage_compare r.ET.rs v = 0 && r.ET.rn = [] in
+ if EU.list_apply prop ignore 0 st.ET.sr || st.ET.so <> []
+ then EU.raise_error ET.ETops else
+ let ds, ts = EU.robj_tops v st.ET.sr in
+ if ds <> [] then begin
+ let r = {ET.rb = false; ET.rx = false; ET.rs = st.ET.ss; ET.ro = ds; ET.rn = []} in
+ st.ET.sr <- EU.robj_union [r] st.ET.sr