From 975e536db4920307acb78de083621491f0566de1 Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Wed, 21 Dec 2005 15:45:17 +0000 Subject: [PATCH] added generic marshaller --- helm/ocaml/extlib/.depend | 2 + helm/ocaml/extlib/Makefile | 1 + helm/ocaml/extlib/hMarshal.ml | 70 ++++++++++++++++++++++++++++++++++ helm/ocaml/extlib/hMarshal.mli | 59 ++++++++++++++++++++++++++++ 4 files changed, 132 insertions(+) create mode 100644 helm/ocaml/extlib/hMarshal.ml create mode 100644 helm/ocaml/extlib/hMarshal.mli diff --git a/helm/ocaml/extlib/.depend b/helm/ocaml/extlib/.depend index a8bb3011a..b11273f7a 100644 --- a/helm/ocaml/extlib/.depend +++ b/helm/ocaml/extlib/.depend @@ -1,5 +1,7 @@ hExtlib.cmo: hExtlib.cmi hExtlib.cmx: hExtlib.cmi +hMarshal.cmo: hExtlib.cmi hMarshal.cmi +hMarshal.cmx: hExtlib.cmx hMarshal.cmi patternMatcher.cmo: patternMatcher.cmi patternMatcher.cmx: patternMatcher.cmi hLog.cmo: hLog.cmi diff --git a/helm/ocaml/extlib/Makefile b/helm/ocaml/extlib/Makefile index ae60ef005..c67778af4 100644 --- a/helm/ocaml/extlib/Makefile +++ b/helm/ocaml/extlib/Makefile @@ -3,6 +3,7 @@ PREDICATES = INTERFACE_FILES = \ hExtlib.mli \ + hMarshal.mli \ patternMatcher.mli \ hLog.mli \ trie.mli \ diff --git a/helm/ocaml/extlib/hMarshal.ml b/helm/ocaml/extlib/hMarshal.ml new file mode 100644 index 000000000..9091343e4 --- /dev/null +++ b/helm/ocaml/extlib/hMarshal.ml @@ -0,0 +1,70 @@ +(* Copyright (C) 2005, HELM Team. + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * HELM is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://helm.cs.unibo.it/ + *) + +exception Corrupt_file of string +exception Format_mismatch of string +exception Version_mismatch of string + +let ensure_path_exists fname = HExtlib.mkdir (Filename.dirname fname) +let marshal_flags = [] + +let save ~fmt ~version ~fname data = + ensure_path_exists fname; + let oc = open_out fname in + let marshalled = Marshal.to_string data marshal_flags in + output_binary_int oc (Hashtbl.hash fmt); (* field 1 *) + output_binary_int oc version; (* field 2 *) + output_string oc fmt; (* field 3 *) + output_string oc (string_of_int version); (* field 4 *) + output_binary_int oc (Hashtbl.hash marshalled); (* field 5 *) + output_string oc marshalled; (* field 6 *) + close_out oc + +let expect ic fname s = + let len = String.length s in + let buf = String.create len in + really_input ic buf 0 len; + if buf <> s then raise (Corrupt_file fname) + +let load ~fmt ~version ~fname = + let ic = open_in fname in + HExtlib.finally + (fun () -> close_in ic) + (fun () -> + try + let fmt' = input_binary_int ic in (* field 1 *) + if fmt' <> Hashtbl.hash fmt then raise (Format_mismatch fname); + let version' = input_binary_int ic in (* field 2 *) + if version' <> version then raise (Version_mismatch fname); + expect ic fname fmt; (* field 3 *) + expect ic fname (string_of_int version); (* field 4 *) + let checksum' = input_binary_int ic in (* field 5 *) + let marshalled' = HExtlib.input_all ic in (* field 6 *) + if checksum' <> Hashtbl.hash marshalled' then + raise (Corrupt_file fname); + Marshal.from_string marshalled' 0 + with End_of_file -> raise (Corrupt_file fname)) + () + diff --git a/helm/ocaml/extlib/hMarshal.mli b/helm/ocaml/extlib/hMarshal.mli new file mode 100644 index 000000000..90ce20def --- /dev/null +++ b/helm/ocaml/extlib/hMarshal.mli @@ -0,0 +1,59 @@ +(* Copyright (C) 2005, HELM Team. + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * HELM is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://helm.cs.unibo.it/ + *) + +(** {2 Marshalling with version/consistency checks} *) + +(** {3 File formats} + * + * Files saved/loaded by this module share a common format: + * + * | n | Field name | Field type | Description | + * +---+-------------+------------+---------------------------------------+ + * | 1 | format | integer | hash value of the 'fmt' parameter | + * | 2 | version | integer | 'version' parameter | + * | 3 | format dsc | string | extended 'fmt' parameter | + * | 4 | version dsc | string | extended 'version' parameter | + * | 5 | checksum | integer | hash value of the _field_ below | + * | 6 | data | raw | ocaml marshalling of 'data' parameter | + * + *) + +exception Corrupt_file of string (** checksum mismatch, or file too short *) +exception Format_mismatch of string +exception Version_mismatch of string + + (** Marhsal some data according to the file format above. + * @param fmt format name + * @param version version number + * @param fname file name to which marshal data + * @param data data to be marshalled on disk *) +val save: fmt:string -> version:int -> fname:string -> 'a -> unit + + (** parameters as above + * @raise Corrupt_file + * @raise Format_mismatch + * @raise Version_mismatch *) +val load: fmt:string -> version:int -> fname:string -> 'a + -- 2.39.2