]> matita.cs.unibo.it Git - helm.git/blob - components/lexicon/lexiconMarshal.ml
...
[helm.git] / components / lexicon / lexiconMarshal.ml
1 (* Copyright (C) 2005, HELM Team.
2  * 
3  * This file is part of HELM, an Hypertextual, Electronic
4  * Library of Mathematics, developed at the Computer Science
5  * Department, University of Bologna, Italy.
6  * 
7  * HELM is free software; you can redistribute it and/or
8  * modify it under the terms of the GNU General Public License
9  * as published by the Free Software Foundation; either version 2
10  * of the License, or (at your option) any later version.
11  * 
12  * HELM is distributed in the hope that it will be useful,
13  * but WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with HELM; if not, write to the Free Software
19  * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
20  * MA  02111-1307, USA.
21  * 
22  * For details, see the HELM World-Wide-Web page,
23  * http://helm.cs.unibo.it/
24  *)
25
26 (* $Id$ *)
27
28 type lexicon = LexiconAst.command list
29
30 let format_name = "lexicon"
31
32 let save_lexicon_to_file ~fname lexicon =
33   HMarshal.save ~fmt:format_name ~version:LexiconAst.magic ~fname lexicon
34
35 let load_lexicon_from_file ~fname =
36   let raw = HMarshal.load ~fmt:format_name ~version:LexiconAst.magic ~fname in
37   (raw: lexicon)
38
39 let rehash_cmd_uris =
40   let rehash_uri uri =
41     UriManager.uri_of_string (UriManager.string_of_uri uri) in
42   function
43   | LexiconAst.Interpretation (loc, dsc, args, cic_appl_pattern) ->
44       let rec aux =
45         function
46         | CicNotationPt.UriPattern uri ->
47             CicNotationPt.UriPattern (rehash_uri uri)
48         | CicNotationPt.ApplPattern args ->
49             CicNotationPt.ApplPattern (List.map aux args)
50         | CicNotationPt.VarPattern _
51         | CicNotationPt.ImplicitPattern as pat -> pat
52       in
53       let appl_pattern = aux cic_appl_pattern in
54       LexiconAst.Interpretation (loc, dsc, args, appl_pattern)
55   | LexiconAst.Notation _
56   | LexiconAst.Alias _ as cmd -> cmd
57   | cmd ->
58       prerr_endline "Found a command not expected in a .lexicon:";
59       prerr_endline (LexiconAstPp.pp_command cmd);
60       assert false
61
62 let save_lexicon ~fname lexicon = save_lexicon_to_file ~fname (List.rev lexicon)
63
64 let load_lexicon ~fname =
65   let lexicon = load_lexicon_from_file ~fname in
66   List.map rehash_cmd_uris lexicon
67