helm/ocaml/mathql_interpreter/select.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 (*
  27  * implementazione del comando SELECT
  28  *)
  29
  30 open Mathql;;
  31 open Func;;
  32 open Utility;;
  33
  34 (*
  35  * valutazione di una stringa
  36  *)
  37 let stringeval s l =
  38  match s with
  39     MQCons s ->
  40      s
  41  |  MQFunc (f, rvar) ->
  42      apply_func f (List.assoc rvar l)
  43  |  MQRVar rvar ->
  44      List.assoc rvar l
  45  |  MQSVar svar ->
  46      List.assoc svar l
  47  |  MQMConclusion ->
  48      "MainConclusion"
  49  |  MQConclusion ->
  50      "InConclusion"
  51 ;;
  52
  53 (*
  54  *
  55  *)
  56 let rec is_good l abool =
  57  match abool with
  58     MQAnd (b1, b2) ->
  59      (is_good l b1) && (is_good l b2)
  60  |  MQOr (b1, b2) ->
  61      (is_good l b1) || (is_good l b2)
  62  |  MQNot b1 ->
  63      not (is_good l b1)
  64  |  MQTrue ->
  65      true
  66  |  MQFalse ->
  67      false
  68  |  MQIs (s1, s2) ->
  69      (stringeval s1 l) = (stringeval s2 l)
  70 ;;
  71
  72 (*
  73  *
  74  *)
  75 let rec replace avar newval l =
  76  match l with
  77     MQAnd (b1, b2) -> MQAnd (replace avar newval b1, replace avar newval b2)
  78  |  MQOr (b1, b2)  -> MQOr  (replace avar newval b1, replace avar newval b2)
  79  |  MQNot b1       -> MQNot (replace avar newval b1)
  80  |  MQIs (s1, s2)  ->
  81      let ns1 = (
  82       match s1 with
  83          MQRVar v when v = avar      -> MQRVar newval
  84       |  MQFunc (f, v) when v = avar -> MQFunc (f, newval)
  85       |  _                           -> s1
  86      )
  87      and ns2 = (
  88       match s2 with
  89          MQRVar v when v = avar      -> MQRVar newval
  90       |  MQFunc (f, v) when v = avar -> MQFunc (f, newval)
  91       |  _                           -> s2
  92      )
  93      in
  94       MQIs (ns1, ns2)
  95  |  _              -> l (* i casi non compresi sono MQTrue e MQFalse *)
  96 ;;
  97
  98 (*let rec print_booltree b =
  99  match b with
 100     MQAnd (b1, b2) ->
 101      let i = print_booltree b1 in
 102       let j = print_string " AND " in
 103        print_booltree b2
 104  |  MQOr (b1, b2) ->
 105      let i = print_booltree b1 in
 106       let j = print_string " OR " in
 107        print_booltree b2
 108  |  MQNot b1 ->
 109      let j = print_string " NOT " in
 110       print_booltree b1
 111  |  MQTrue ->
 112      print_string " TRUE "
 113  |  MQFalse ->
 114      print_string " FALSE "
 115  |  MQIs (s1, s2) ->
 116      let s1v = match s1 with
 117         MQCons s ->
 118          "'" ^ s ^ "'"
 119      |  MQFunc (f, rvar) ->
 120         (
 121           match f with
 122            MQName         -> "NAME " ^ rvar
 123         |  MQTheory       -> "THEORY" ^ rvar
 124         |  MQTitle        -> "TITLE" ^ rvar
 125         |  MQContributor  -> "contributor" ^ rvar
 126         |  MQCreator      -> "creator" ^ rvar
 127         |  MQPublisher    -> "publisher" ^ rvar
 128         |  MQSubject      -> "subject" ^ rvar
 129         |  MQDescription  -> "description" ^ rvar
 130         |  MQDate         -> "date" ^ rvar
 131         |  MQType         -> "type" ^ rvar
 132         |  MQFormat       -> "format" ^ rvar
 133         |  MQIdentifier   -> "identifier" ^ rvar
 134         |  MQLanguage     -> "language" ^ rvar
 135         |  MQRelation     -> "relation" ^ rvar
 136         |  MQSource       -> "source" ^ rvar
 137         |  MQCoverage     -> "coverage" ^ rvar
 138         |  MQRights       -> "rights" ^ rvar
 139         |  MQInstitution  -> "institution" ^ rvar
 140         |  MQContact      -> "contact" ^ rvar
 141         |  MQFirstVersion -> "firstversion" ^ rvar
 142         |  MQModified     -> "modified" ^ rvar
 143         )
 144      |  MQRVar rvar ->
 145          rvar
 146      |  MQSVar svar ->
 147          svar
 148      |  MQMConclusion ->
 149          "MainConclusion"
 150      |  MQConclusion ->
 151          "InConclusion"
 152      and s2v = match s2 with
 153         MQCons s ->
 154          s
 155      |  MQFunc (f, rvar) ->
 156         (
 157           match f with
 158            MQName -> "NAME " ^ rvar
 159         |  MQTheory       -> "THEORY" ^ rvar
 160         |  MQTitle        -> "TITLE" ^ rvar
 161         |  MQContributor  -> "contributor" ^ rvar
 162         |  MQCreator      -> "creator" ^ rvar
 163         |  MQPublisher    -> "publisher" ^ rvar
 164         |  MQSubject      -> "subject" ^ rvar
 165         |  MQDescription  -> "description" ^ rvar
 166         |  MQDate         -> "date" ^ rvar
 167         |  MQType         -> "type" ^ rvar
 168         |  MQFormat       -> "format" ^ rvar
 169         |  MQIdentifier   -> "identifier" ^ rvar
 170         |  MQLanguage     -> "language" ^ rvar
 171         |  MQRelation     -> "relation" ^ rvar
 172         |  MQSource       -> "source" ^ rvar
 173         |  MQCoverage     -> "coverage" ^ rvar
 174         |  MQRights       -> "rights" ^ rvar
 175         |  MQInstitution  -> "institution" ^ rvar
 176         |  MQContact      -> "contact" ^ rvar
 177         |  MQFirstVersion -> "firstversion" ^ rvar
 178         |  MQModified     -> "modified" ^ rvar
 179         )
 180      |  MQRVar rvar ->
 181          rvar
 182      |  MQSVar svar ->
 183          svar
 184      |  MQMConclusion ->
 185          "MainConclusion"
 186      |  MQConclusion ->
 187          "InConclusion"
 188      in
 189       print_string (s1v ^ " = " ^ s2v)
 190 ;;
 191 *)
 192 (*
 193  * implementazione del comando SELECT
 194  *)
 195 let select_ex avar alist abool =
 196  let wrt = replace avar "retVal" abool in
 197  (*let j = print_booltree wrt in*)
 198   [List.hd alist]
 199   @
 200   List.find_all
 201    (fun l -> is_good (List.combine (List.hd alist) l) wrt)
 202    (List.tl alist)
 203 ;;
 204