2 ||M|| This file is part of HELM, an Hypertextual, Electronic
3 ||A|| Library of Mathematics, developed at the Computer Science
4 ||T|| Department, University of Bologna, Italy.
6 ||T|| HELM is free software; you can redistribute it and/or
7 ||A|| modify it under the terms of the GNU General Public License
8 \ / version 2 or (at your option) any later version.
9 \ / This software is distributed as is, NO WARRANTY.
10 V_______________________________________________________________ *)
12 module EG = RolesGlobal
13 module EI = RolesInput
14 module EO = RolesOutput
15 module EU = RolesUtils
16 module ET = RolesTypes
18 let st = EU.new_status
21 if st.ET.w = [] then st.ET.s <- v
22 else EU.raise_error ET.EWaiting
24 let toggle_entry = function
25 | [0] -> st.ET.r <- EU.list_toggle_all st.ET.r
26 | [0;m] -> st.ET.r <- EU.list_toggle m st.ET.r
28 let r = EU.list_nth m st.ET.r in
29 r.ET.o <- EU.list_toggle_all r.ET.o
31 let r = EU.list_nth m st.ET.r in
32 r.ET.o <- EU.list_toggle n r.ET.o
34 let r = EU.list_nth m st.ET.r in
35 r.ET.n <- EU.list_toggle_all r.ET.n
37 let r = EU.list_nth m st.ET.r in
38 r.ET.n <- EU.list_toggle n r.ET.n
39 | [1] -> st.ET.t <- EU.list_toggle_all st.ET.t
40 | [1;m] -> st.ET.t <- EU.list_toggle m st.ET.t
41 | [2] -> st.ET.w <- EU.list_toggle_all st.ET.w
42 | [2;m] -> st.ET.w <- EU.list_toggle m st.ET.w
43 | _ -> EU.raise_error ET.ENoEntry
46 let ts,os = EU.list_split st.ET.t in
47 let ws,ns = EU.list_split st.ET.w in
48 if os = [] && ns = [] then () else
49 begin match EU.list_select None st.ET.r with
51 let r = {ET.v = st.ET.s; ET.o = os; ET.n = ns} in
52 st.ET.r <- EU.roles_union [false, r] st.ET.r
54 if r.ET.v <> st.ET.s then EU.raise_error ET.EWrongVersion else
55 r.ET.o <- EU.objs_union os r.ET.o;
56 r.ET.n <- EU.names_union ns r.ET.n;
58 st.ET.t <- ts; st.ET.w <- ws
61 if EU.exists_role_deleted st.ET.s st.ET.r || st.ET.t <> []
62 then EU.raise_error ET.ETops else
63 let ds, ts = EU.get_tops v st.ET.r in
64 if ds <> [] then begin
65 let r = {ET.v = st.ET.s; ET.o = ds; ET.n = []} in
66 st.ET.r <- EU.roles_union [false, r] st.ET.r
68 if ts <> [] then st.ET.t <- ts
70 let rec add_matching () =
71 match EU.match_names 0 0 st.ET.t st.ET.w with
79 let read_waiting fname =
80 if st.ET.s = [] then EU.raise_error ET.ENoStage else
81 let ich = Scanf.Scanning.open_in fname in
82 let w = EI.read_rev_names ich [] in
83 Scanf.Scanning.close_in ich;
84 st.ET.w <- EU.names_union (List.rev w) st.ET.w
87 if st.ET.s <> [] then EU.raise_error (ET.EStage st.ET.s) else
88 let fname = Filename.concat !EG.wd "roles.osn" in
89 let ich = open_in fname in
90 let tmp = EI.read_status ich in
98 let fname = Filename.concat !EG.wd "roles.osn" in
99 let och = open_out fname in
100 EO.out_status och st;
103 let print_status () =
104 EO.out_status stdout st