]> matita.cs.unibo.it Git - helm.git/blob - components/hbugs/scripts/build_tutors.ml
BIG FAT COMMIT REGARDING COERCIONS:
[helm.git] / components / hbugs / scripts / build_tutors.ml
1 #!/usr/bin/ocamlrun /usr/bin/ocaml
2 (*
3  * Copyright (C) 2003-2004:
4  *    Stefano Zacchiroli <zack@cs.unibo.it>
5  *    for the HELM Team http://helm.cs.unibo.it/
6  *
7  *  This file is part of HELM, an Hypertextual, Electronic
8  *  Library of Mathematics, developed at the Computer Science
9  *  Department, University of Bologna, Italy.
10  *
11  *  HELM is free software; you can redistribute it and/or
12  *  modify it under the terms of the GNU General Public License
13  *  as published by the Free Software Foundation; either version 2
14  *  of the License, or (at your option) any later version.
15  *
16  *  HELM is distributed in the hope that it will be useful,
17  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
18  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19  *  GNU General Public License for more details.
20  *
21  *  You should have received a copy of the GNU General Public License
22  *  along with HELM; if not, write to the Free Software
23  *  Foundation, Inc., 59 Temple Place - Suite 330, Boston,
24  *  MA  02111-1307, USA.
25  *
26  *  For details, see the HELM World-Wide-Web page,
27  *  http://helm.cs.unibo.it/
28  *)
29 #use "topfind"
30 #require "pcre"
31 #require "pxp"
32 open Printf
33 open Pxp_document
34 open Pxp_dtd
35 open Pxp_types
36 open Pxp_yacc
37
38 let index = "data/tutors_index.xml"
39 let template = "data/hbugs_tutor.TPL.ml"
40
41   (* apply a set of regexp substitutions specified as a list of pairs
42   <pattern,template> to a string *)
43 let rec apply_subst ~fill s =
44   match fill with
45   | [] -> s
46   | (pat, templ)::rest ->
47       apply_subst ~fill:rest (Pcre.replace ~pat ~templ s)
48   (* fill a ~template file with substitutions specified in ~fill (see
49   apply_subst) and save output to ~output *)
50 let fill_template ~template ~fill ~output =
51   printf "Creating %s ... " output; flush stdout;
52   let (ic, oc) = (open_in template, open_out output) in
53   let rec fill_template' () =
54     output_string oc ((apply_subst ~fill (input_line ic)) ^ "\n");
55     fill_template' ()
56   in
57   try
58     output_string oc (sprintf
59 "(*
60   THIS CODE IS GENERATED - DO NOT MODIFY!
61
62   the source of this code is template \"%s\"
63   the template was filled with data read from \"%s\"
64 *)\n"
65       template index);
66     fill_template' ()
67   with End_of_file ->
68     close_in ic;
69     close_out oc;
70     printf "done!\n"; flush stdout
71 let parse_xml fname =
72   parse_wfdocument_entity default_config (from_file fname) default_spec
73 let is_tutor node =
74   match node#node_type with T_element "tutor" -> true | _ -> false
75 let is_element node =
76   match node#node_type with T_element _ -> true | _ -> false
77 let main () =
78   (parse_xml index)#root#iter_nodes
79     (fun node ->
80       try
81         (match node with
82         | node when is_tutor node ->
83             (try  (* skip hand-written tutors *)
84               ignore (find_element "no_auto" node);
85               raise Exit
86             with Not_found -> ());
87             let output =
88               try
89                 (match node#attribute "source" with
90                 | Value s -> s
91                 | _ -> assert false)
92               with Not_found -> assert false
93             in
94             let fill =
95               List.map  (* create substitution list from index data *)
96                 (fun node ->
97                   let name =  (* node name *)
98                     (match node#node_type with
99                     | T_element s -> s
100                     | _ -> assert false)
101                   in
102                   let value = node#data in  (* node value *)
103                   (sprintf "@%s@" (String.uppercase name),  (* pattern *)
104                    value))                                  (* substitution *)
105                 (List.filter is_element node#sub_nodes)
106             in
107             fill_template ~fill ~template ~output
108         | _ -> ())
109       with Exit -> ())
110
111 let _ = main ()
112