helm/ocaml/mathql_interpreter/mQueryInterpreter.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 exception Found
  30
  31 module M = MathQL
  32 module P = MQueryUtil
  33 module C = MQIConn
  34 module U = MQIUtil
  35 module L = MQILib
  36 module F = MQueryIO
  37
  38 (* contexts *****************************************************************)
  39
  40 type svar_context = (M.svar * M.resource_set) list
  41
  42 type avar_context = (M.avar * M.resource) list
  43
  44 type group_context = (M.avar * M.attribute_group) list
  45
  46 type context = {svars: svar_context;
  47                 avars: avar_context;
  48                 groups: group_context (* auxiliary context *)
  49                }
  50
  51 (* execute ******************************************************************)
  52
  53 let execute h x =
  54    let warn q =
  55      if C.set h C.Warn then
  56      begin
  57         C.log h "MQIExecute: waring: reference to undefined variables: ";
  58         F.text_of_query (C.log h) q "\n"
  59      end
  60    in
  61    let subj v = List.map (fun s -> (s, [])) v in
  62    let proj v = List.map fst v in
  63    let rec eval_query c = function
  64       | M.Const r -> r
  65       | M.Dot i p -> begin
  66          try subj (List.assoc p (List.assoc i c.groups))
  67          with Not_found -> warn (M.Dot i p); [] end
  68       | M.Ex l y ->
  69          let rec ex_aux h = function
  70             | []        ->
  71                let d = {c with groups = h} in
  72                if eval_query d y = U.mql_false then () else raise Found
  73             | i :: tail ->
  74                begin
  75                   try
  76                      let (_, a) = List.assoc i c.avars in
  77                      let rec add_group = function
  78                         | []     -> ()
  79                         | g :: t -> ex_aux ((i, g) :: h) tail; add_group t
  80                      in
  81                      add_group a
  82                   with Not_found -> ()
  83                end
  84          in
  85          (try ex_aux [] l; U.mql_false with Found -> U.mql_true)
  86       | M.SVar i -> begin
  87          try List.assoc i c.svars
  88          with Not_found -> warn (M.SVar i); [] end
  89       | M.AVar i -> begin
  90          try [List.assoc i c.avars]
  91          with Not_found -> warn (M.AVar i); [] end
  92       | M.Let i x1 x2 ->
  93          let d = {c with svars = P.add_assoc (i, eval_query c x1) c.svars} in
  94          eval_query d x2
  95       | M.For k i x1 x2 ->
  96          let f = match k with
  97             | M.GenFJoin -> U.mql_union
  98             | M.GenFMeet -> U.mql_intersect
  99          in
 100          let rec for_aux = function
 101             | []     -> []
 102             | h :: t ->
 103                let d = {c with avars = P.add_assoc (i, h) c.avars} in
 104                f (eval_query d x2) (for_aux t)
 105          in
 106          for_aux (eval_query c x1)
 107       | M.Add b z x ->
 108          let f = if b then U.mql_prod else U.set_union in
 109          let g a s = (fst a, f (snd a) (eval_grp c z)) :: s in
 110          List.fold_right g (eval_query c x) []
 111       | M.Property q0 q1 q2 mc ct cfl el pat y ->
 112          let subj, mct =
 113             if q0 then [], (pat, q2 @ mc, eval_query c y)
 114                   else (q2 @ mc), (pat, [], eval_query c y)
 115          in
 116          let eval_cons (pat, p, y) = (pat, q2 @ p, eval_query c y) in
 117          let cons_true = mct :: List.map eval_cons ct in
 118          let cons_false = List.map (List.map eval_cons) cfl in
 119          let eval_exp (p, po) = (q2 @ p, po) in
 120          let exp = List.map eval_exp el in
 121          let t = P.start_time () in
 122          let r = MQIProperty.exec h q1 subj cons_true cons_false exp in
 123          let s = P.stop_time t in
 124          if C.set h C.Stat then
 125             C.log h (Printf.sprintf "Property: %s,%i\n" s (List.length r));
 126          r
 127       | M.Select i x y ->
 128          let rec select_aux = function
 129             | []     -> []
 130             | h :: t ->
 131                let d = {c with avars = P.add_assoc (i, h) c.avars} in
 132                if eval_query d y = U.mql_false
 133                   then select_aux t else h :: select_aux t
 134          in
 135          select_aux (eval_query c x)
 136       | M.Fun p pl xl -> L.exec (eval_query c) h p pl xl
 137    and eval_grp c = function
 138       | M.Attr gs ->
 139          let attr_aux g (p, y) = U.mql_union g [p, proj (eval_query c y)] in
 140          let attr_auxs s l = U.set_union s [List.fold_left attr_aux [] l] in
 141          List.fold_left attr_auxs [] gs
 142       | M.From i ->
 143          try snd (List.assoc i c.avars)
 144          with Not_found -> warn (M.AVar i); []
 145    in
 146    let c = {svars = []; avars = []; groups = []} in
 147    let t = P.start_time () in
 148    let r = eval_query c x in
 149    let s = P.stop_time t in
 150    if C.set h C.Stat then
 151       C.log h (Printf.sprintf "MQIExecute: %s,%s\n" s
 152          (C.string_of_flags (C.flags h)));
 153    r