helm/ocaml/mathql_interpreter_galax/eval.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  *
  28  *)
  29
  30 open MathQL;;
  31
  32 (*
  33  * conversione di un pattern
  34  *)
  35 let rec patterneval p =
  36  match p with
  37    [] -> ""
  38  | head::tail ->
  39     let h = match head with
  40                MQBC s -> Str.global_replace (Str.regexp "\.") "\\\\\." s
  41             |  MQBD -> "/"
  42             |  MQBQ -> "[^/#]?"
  43             |  MQBS -> "[^/#]*"
  44             |  MQBSS -> "[^#]*"
  45     in
  46      h ^ (patterneval tail)
  47 ;;
  48
  49 let rec fieval fi =
  50  match fi with
  51     [] -> ""
  52   | MQFC i :: tail -> "/" ^ (string_of_int i) ^ (fieval tail)
  53   | MQFS :: tail -> "[^/]*" ^ (fieval tail)
  54   | MQFSS :: tail -> ".*"  ^ (fieval tail)
  55 ;;
  56
  57 (*
  58  * conversione di un fragment identifier
  59  *)
  60 let fieval fi =
  61  if fi = [] then
  62   ""
  63  else
  64   "#xpointer\\\\(1" ^ fieval fi ^ "\\\\)"
  65 ;;
  66
  67 (*
  68  * valuta l'estensione
  69  *
  70  * 20/05/2002: non piu' necessario: l'estensione fa eventualmente
  71  * parte del pattern precedente
  72  *)
  73 let exteval ext =
  74  match ext with
  75     "" -> ""
  76  |  _  -> ("\." ^ ext)
  77 ;;
  78
  79 (*
  80  * valuta il preambolo
  81  *)
  82 let preeval p =
  83  match p with
  84     Some s -> s
  85   | None -> "[^/]*"
  86 ;;
  87
  88 (*
  89  * trasforma un pattern MathQL in un pattern postgresql
  90  *
  91  * si utilizzano espressioni regolari POSIX anziche' l'operatore
  92  * SQL standard LIKE perche' MathQL prevede esperssioni con "*"
  93  * e con "**".
  94  *)
  95 let pattern_match (preamble, pattern, fragid) =
  96  " ~ '^" ^ (preeval preamble) ^ ":/" ^ (patterneval pattern) ^ (fieval fragid) ^ "$'"
  97 ;;
  98