1 (* Copyright (C) 2000, HELM Team.
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.
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.
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.
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,
22 * For details, see the HELM World-Wide-Web page,
23 * http://cs.unibo.it/helm/.
26 (* AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
33 (* text linearization and parsing *******************************************)
35 let txt_str out s = out ("\"" ^ s ^ "\"")
37 let txt_path out p = out "/"; P.flat_list out (txt_str out) "/" p
39 let text_of_result out x sep =
40 let txt_attr = function
41 | (p, []) -> txt_path out p
42 | (p, l) -> txt_path out p; out " = ";
43 P.flat_list out (txt_str out) ", " l
45 let txt_group l = out "{"; P.flat_list out txt_attr "; " l; out "}" in
46 let txt_res = function
47 | (s, []) -> txt_str out s
48 | (s, l) -> txt_str out s; out " attr ";
49 P.flat_list out txt_group ", " l
51 let txt_set l = P.flat_list out txt_res ("; " ^ sep) l; out sep in
54 let text_of_query out x sep =
55 let txt_svar sv = out ("%" ^ sv) in
56 let txt_avar av = out ("@" ^ av) in
57 let txt_inv i = if i then out "inverse " in
58 let txt_ref = function
60 | M.RefineSub -> out "sub "
61 | M.RefineSuper -> out "super "
63 let txt_qualif i r p = txt_inv i; txt_ref r; txt_path out p in
66 | p -> out " main "; txt_path out p
68 let txt_exp = function
69 | (pl, None) -> txt_path out pl
70 | (pl, Some pr) -> txt_path out pl; out " as "; txt_path out pr
72 let txt_exp_list = function
74 | l -> out " attr "; P.flat_list out txt_exp ", " l
76 let pattern b = if b then out "pattern " in
77 let txt_distr d = if d then out "distr " in
78 let txt_gen = function
79 | M.GenFJoin -> out " sup "
80 | M.GenFMeet -> out " inf "
82 let rec txt_con (pat, p, x) =
84 if pat then out " match " else out " in ";
86 and txt_con_list s = function
88 | l -> out s; P.flat_list out txt_con ", " l
89 and txt_istrue lt = txt_con_list " istrue " lt
90 and txt_isfalse lf = txt_con_list " isfalse " lf
91 and txt_ass (p, x) = txt_set x; out " as "; txt_path out p
92 and txt_ass_list l = P.flat_list out txt_ass ", " l
93 and txt_assg_list g = P.flat_list out txt_ass_list "; " g
94 and txt_grp = function
95 | M.Attr g -> txt_assg_list g
96 | M.From av -> txt_avar av
97 and txt_set = function
99 L.txt_out out (txt_path out) txt_set p pl xl
100 | M.Const [s, []] -> txt_str out s
101 | M.Const r -> text_of_result out r " "
102 | M.Dot av p -> txt_avar av; out "."; txt_path out p
103 | M.Ex b x -> out "ex "; txt_set x
104 (* | M.Ex b x -> out "ex ["; P.flat_list out txt_avar "," b;
106 *) | M.SVar sv -> txt_svar sv
107 | M.AVar av -> txt_avar av
108 | M.Property q0 q1 q2 mc ct cfl xl b x ->
109 out "property "; txt_qualif q0 q1 q2; main mc;
110 txt_istrue ct; P.flat_list out txt_isfalse "" cfl; txt_exp_list xl;
111 out " of "; pattern b; txt_set x
112 | M.Let sv x y -> out "let "; txt_svar sv; out " be ";
113 txt_set x; out " in "; txt_set y
114 | M.Select av x y -> out "select "; txt_avar av; out " from ";
115 txt_set x; out " where "; txt_set y
116 | M.For k av x y -> out "for "; txt_avar av; out " in ";
117 txt_set x; txt_gen k; txt_set y
118 | M.Add d g x -> out "add "; txt_distr d; txt_grp g;
119 out " in "; txt_set x
123 let query_of_text lexbuf =
124 MQueryTParser.query MQueryTLexer.query_token lexbuf
126 let result_of_text lexbuf =
127 MQueryTParser.result MQueryTLexer.result_token lexbuf