helm/ocaml/mathql_interpreter/mQueryIO.ml

   1 (* Copyright (C) 2000, 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://cs.unibo.it/helm/.
  24  *)
  25
  26 (*  AUTOR: Ferruccio Guidi <fguidi@cs.unibo.it>
  27  *)
  28
  29 module M = MathQL
  30 module P = MQueryUtil
  31 module L = MQILib
  32
  33 (* text linearization and parsing *******************************************)
  34
  35 let txt_str out s = out ("\"" ^ s ^ "\"")
  36
  37 let txt_path out p = out "/"; P.flat_list out (txt_str out) "/" p
  38
  39 let text_of_result out sep x =
  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
  44    in
  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
  50    in
  51    let txt_set l = P.flat_list out txt_res ("; " ^ sep) l; out sep in
  52    txt_set x
  53
  54 let text_of_query out sep x =
  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
  59       | M.RefineExact -> ()
  60       | M.RefineSub   -> out "sub "
  61       | M.RefineSuper -> out "super "
  62    in
  63    let txt_qualif i r p = txt_inv i; txt_ref r; txt_path out p in
  64    let main = function
  65       | [] -> ()
  66       | p  -> out " main "; txt_path out p
  67    in
  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
  71    in
  72    let txt_exp_list = function
  73       | [] -> ()
  74       | l  -> out " attr "; P.flat_list out txt_exp ", " l
  75    in
  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 "
  81    in
  82    let rec txt_con (pat, p, x) =
  83       txt_path out p;
  84       if pat then out " match " else out " in ";
  85       txt_set x
  86    and txt_con_list s = function
  87       | [] -> ()
  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
  98       | M.Fun p pl xl      ->
  99          let o = {L.out = out; L.path = txt_path out; L.query = txt_set;
 100             L.result = text_of_result out sep}
 101          in
 102          L.txt_out o p pl xl
 103       | M.Const [s, []] -> txt_str out s
 104       | M.Const r       -> text_of_result out " " r
 105       | M.Dot av p      -> txt_avar av; out "."; txt_path out p
 106       | M.Ex b x        -> out "ex "; txt_set x
 107 (*    | M.Ex b x        -> out "ex ["; P.flat_list out txt_avar "," b;
 108                            out "] "; txt_set x
 109 *)    | M.SVar sv       -> txt_svar sv
 110       | M.AVar av       -> txt_avar av
 111       | M.Property q0 q1 q2 mc ct cfl xl b x ->
 112          out "property "; txt_qualif q0 q1 q2; main mc;
 113          txt_istrue ct; P.flat_list out txt_isfalse "" cfl; txt_exp_list xl;
 114          out " of "; pattern b; txt_set x
 115       | M.Let sv x y    -> out "let "; txt_svar sv; out " = ";
 116                            txt_set x; out " in "; txt_set y
 117       | M.Select av x y -> out "select "; txt_avar av; out " from ";
 118                            txt_set x; out " where "; txt_set y
 119       | M.For k av x y  -> out "for "; txt_avar av; out " in ";
 120                            txt_set x; txt_gen k; txt_set y
 121       | M.Add d g x     -> out "add "; txt_distr d; txt_grp g;
 122                            out " in "; txt_set x
 123    in
 124    txt_set x; out sep
 125
 126 let text_out_spec out sep =
 127    {L.out = out; L.path = txt_path out; L.query = text_of_query out sep;
 128     L.result = text_of_result out sep}
 129
 130 let query_of_text lexbuf =
 131    MQueryTParser.query MQueryTLexer.query_token lexbuf
 132
 133 let result_of_text lexbuf =
 134    MQueryTParser.result MQueryTLexer.result_token lexbuf