[r2002-11-10 02:31:52 by cvscast] Empty log message

Original author: cvscast
Date: 2002-11-10 02:31:52+00:00

depend

@@ -65,10 +65,10 @@ types/types.cmx: types/atoms.cmx types/boolean.cmx types/chars.cmx \
     types/recursive_noshare.cmx types/sortedList.cmx types/sortedMap.cmx \
     misc/state.cmx types/types.cmi 
 runtime/eval.cmo: runtime/load_xml.cmi runtime/print_xml.cmo \
-    runtime/run_dispatch.cmi typing/typed.cmo types/types.cmi \
+    runtime/run_dispatch.cmi misc/state.cmi typing/typed.cmo types/types.cmi \
     runtime/value.cmi runtime/eval.cmi 
 runtime/eval.cmx: runtime/load_xml.cmx runtime/print_xml.cmx \
-    runtime/run_dispatch.cmx typing/typed.cmx types/types.cmx \
+    runtime/run_dispatch.cmx misc/state.cmx typing/typed.cmx types/types.cmx \
     runtime/value.cmx runtime/eval.cmi 
 runtime/load_xml.cmo: parser/location.cmi types/sortedMap.cmi types/types.cmi \
     runtime/value.cmi runtime/load_xml.cmi 

driver/webiface.ml

@@ -14,7 +14,8 @@ let main (cgi : Netcgi.std_activation) =
     Location.set_viewport `Html;
     Load_xml.set_auth false;
     
-    Cduce.run ppf input;
+    let ok = Cduce.run ppf input in
+    if ok then Format.fprintf ppf "@\nOk.@\n";
     let res = Format.flush_str_formatter () in
 
     cgi # output # output_string ("\

misc/state.ml

+let state = ref []
+let complete = ref false
+
+let close () =
+  complete := true
+
+let register name r =
+  if !complete then failwith "State.register: state already closed";
+  state := (name,Obj.magic r) :: !state 
+
+let ref name v =
+  let r = ref v in
+  register name r;
+  r
+
+let get () =
+  if not !complete then failwith "State.get: need to close the state";
+  Obj.magic (List.map (fun (name,r) -> (name, !r)) !state)
+
+let set s =
+  if not !complete then failwith "State.set: need to close the state";
+  let rec aux = function
+    | [],[] -> ()
+    | (n1,v)::l1, (n2,r)::l2 when n1 = n2 -> r := v; aux (l1,l2)
+    | _ -> failwith "State.set_state: failed"
+  in
+  aux (Obj.magic s,!state)
+  
+  

misc/state.mli

+(* This module provides a minimal and unsafe support for
+   saving/restoring the global state of the program.
+
+   It assumes that the global state is fully described by
+   Marshal'able references. 
+*)
+
+val ref: string -> 'a -> 'a ref
+  (* Replacement for Pervasives.ref. Creates a persistant reference.
+     Two runs of the programs must yield the same calls to this function,
+     in the correct order. The arbitrary string argument is used to 
+     check this order (give a different string for different calls).
+  *)
+
+val close: unit -> unit
+  (* Close registration for the global state. When this function
+     has been called, ref becomes illegal, and get/set become
+     legal *)
+
+val get: unit -> 'a
+  (* Get a marshal'able value representing the global state *)
+
+val set: 'a   -> unit
+  (* Set the global state *)