From 6a1d05b388683befc860b48b4f2bbaf42f58a112 Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Tue, 14 May 2002 17:26:44 +0000 Subject: [PATCH] First very-very-very-very-alfa release of a MathQL Interpreter implemented on top of RDF-Suite. --- helm/ocaml/.cvsignore | 1 + helm/ocaml/META.helm-mathql_interpreter.src | 5 + helm/ocaml/Makefile.in | 3 +- helm/ocaml/mathql_interpreter/.cvsignore | 1 + helm/ocaml/mathql_interpreter/.depend | 26 ++++ helm/ocaml/mathql_interpreter/Makefile | 15 ++ helm/ocaml/mathql_interpreter/dbconn.ml | 52 +++++++ helm/ocaml/mathql_interpreter/dbconn.mli | 3 + helm/ocaml/mathql_interpreter/eval.ml | 49 +++++++ helm/ocaml/mathql_interpreter/eval.mli | 3 + helm/ocaml/mathql_interpreter/func.ml | 23 ++++ helm/ocaml/mathql_interpreter/func.mli | 1 + helm/ocaml/mathql_interpreter/intersect.ml | 95 +++++++++++++ helm/ocaml/mathql_interpreter/intersect.mli | 1 + helm/ocaml/mathql_interpreter/mathql.ml | 106 +++++++++++++++ helm/ocaml/mathql_interpreter/mqint.ml | 95 +++++++++++++ helm/ocaml/mathql_interpreter/mqint.mli | 21 +++ helm/ocaml/mathql_interpreter/pattern.ml | 14 ++ helm/ocaml/mathql_interpreter/pattern.mli | 4 + helm/ocaml/mathql_interpreter/select.ml | 143 ++++++++++++++++++++ helm/ocaml/mathql_interpreter/select.mli | 3 + helm/ocaml/mathql_interpreter/union.ml | 93 +++++++++++++ helm/ocaml/mathql_interpreter/union.mli | 1 + helm/ocaml/mathql_interpreter/use.ml | 133 ++++++++++++++++++ helm/ocaml/mathql_interpreter/use.mli | 1 + helm/ocaml/mathql_interpreter/utility.ml | 70 ++++++++++ helm/ocaml/mathql_interpreter/utility.mli | 3 + 27 files changed, 964 insertions(+), 1 deletion(-) create mode 100644 helm/ocaml/META.helm-mathql_interpreter.src create mode 100644 helm/ocaml/mathql_interpreter/.cvsignore create mode 100644 helm/ocaml/mathql_interpreter/.depend create mode 100644 helm/ocaml/mathql_interpreter/Makefile create mode 100644 helm/ocaml/mathql_interpreter/dbconn.ml create mode 100644 helm/ocaml/mathql_interpreter/dbconn.mli create mode 100644 helm/ocaml/mathql_interpreter/eval.ml create mode 100644 helm/ocaml/mathql_interpreter/eval.mli create mode 100644 helm/ocaml/mathql_interpreter/func.ml create mode 100644 helm/ocaml/mathql_interpreter/func.mli create mode 100644 helm/ocaml/mathql_interpreter/intersect.ml create mode 100644 helm/ocaml/mathql_interpreter/intersect.mli create mode 100644 helm/ocaml/mathql_interpreter/mathql.ml create mode 100644 helm/ocaml/mathql_interpreter/mqint.ml create mode 100644 helm/ocaml/mathql_interpreter/mqint.mli create mode 100644 helm/ocaml/mathql_interpreter/pattern.ml create mode 100644 helm/ocaml/mathql_interpreter/pattern.mli create mode 100644 helm/ocaml/mathql_interpreter/select.ml create mode 100644 helm/ocaml/mathql_interpreter/select.mli create mode 100644 helm/ocaml/mathql_interpreter/union.ml create mode 100644 helm/ocaml/mathql_interpreter/union.mli create mode 100644 helm/ocaml/mathql_interpreter/use.ml create mode 100644 helm/ocaml/mathql_interpreter/use.mli create mode 100644 helm/ocaml/mathql_interpreter/utility.ml create mode 100644 helm/ocaml/mathql_interpreter/utility.mli diff --git a/helm/ocaml/.cvsignore b/helm/ocaml/.cvsignore index f1ca37656..a12f3d97c 100644 --- a/helm/ocaml/.cvsignore +++ b/helm/ocaml/.cvsignore @@ -9,6 +9,7 @@ META.helm-xml META.helm-cic_proof_checking META.helm-cic_textual_parser META.helm-cic_unification +META.helm-mathql_interpreter Makefile Makefile.common configure diff --git a/helm/ocaml/META.helm-mathql_interpreter.src b/helm/ocaml/META.helm-mathql_interpreter.src new file mode 100644 index 000000000..1d5f71e60 --- /dev/null +++ b/helm/ocaml/META.helm-mathql_interpreter.src @@ -0,0 +1,5 @@ +requires="helm-urimanager pgocaml" +version="0.0.1" +archive(byte)="mathql_interpreter.cma" +archive(native)="mathql_interpreter.cmxa" +linkopts="" diff --git a/helm/ocaml/Makefile.in b/helm/ocaml/Makefile.in index c9bfa3008..5eb95fa83 100644 --- a/helm/ocaml/Makefile.in +++ b/helm/ocaml/Makefile.in @@ -1,6 +1,7 @@ # Warning: the modules must be in compilation order MODULES = xml urimanager getter pxp cic cic_annotations cic_annotations_cache \ - cic_cache cic_proof_checking cic_textual_parser cic_unification + cic_cache cic_proof_checking cic_textual_parser cic_unification \ + mathql_interpreter OCAMLFIND_DEST_DIR = @OCAMLFIND_DEST_DIR@ OCAMLFIND_META_DIR = @OCAMLFIND_META_DIR@ diff --git a/helm/ocaml/mathql_interpreter/.cvsignore b/helm/ocaml/mathql_interpreter/.cvsignore new file mode 100644 index 000000000..6b3eba302 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/.cvsignore @@ -0,0 +1 @@ +*.cm[iaox] *.cmxa diff --git a/helm/ocaml/mathql_interpreter/.depend b/helm/ocaml/mathql_interpreter/.depend new file mode 100644 index 000000000..f88082979 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/.depend @@ -0,0 +1,26 @@ +eval.cmi: mathql.cmo +select.cmi: mathql.cmo +pattern.cmi: mathql.cmo +mqint.cmi: mathql.cmo +dbconn.cmo: mathql.cmo dbconn.cmi +dbconn.cmx: mathql.cmx dbconn.cmi +eval.cmo: mathql.cmo eval.cmi +eval.cmx: mathql.cmx eval.cmi +utility.cmo: utility.cmi +utility.cmx: utility.cmi +func.cmo: func.cmi +func.cmx: func.cmi +select.cmo: func.cmi mathql.cmo utility.cmi select.cmi +select.cmx: func.cmx mathql.cmx utility.cmx select.cmi +intersect.cmo: intersect.cmi +intersect.cmx: intersect.cmi +union.cmo: union.cmi +union.cmx: union.cmi +pattern.cmo: dbconn.cmi eval.cmi utility.cmi pattern.cmi +pattern.cmx: dbconn.cmx eval.cmx utility.cmx pattern.cmi +use.cmo: dbconn.cmi utility.cmi use.cmi +use.cmx: dbconn.cmx utility.cmx use.cmi +mqint.cmo: dbconn.cmi eval.cmi intersect.cmi mathql.cmo pattern.cmi \ + select.cmi union.cmi use.cmi utility.cmi mqint.cmi +mqint.cmx: dbconn.cmx eval.cmx intersect.cmx mathql.cmx pattern.cmx \ + select.cmx union.cmx use.cmx utility.cmx mqint.cmi diff --git a/helm/ocaml/mathql_interpreter/Makefile b/helm/ocaml/mathql_interpreter/Makefile new file mode 100644 index 000000000..27ae1fb1d --- /dev/null +++ b/helm/ocaml/mathql_interpreter/Makefile @@ -0,0 +1,15 @@ +PACKAGE = mathql_interpreter +REQUIRES = helm-urimanager pgocaml +PREDICATES = + +INTERFACE_FILES = dbconn.mli eval.mli utility.mli func.mli \ + select.mli intersect.mli union.mli pattern.mli use.mli \ + mqint.mli + +IMPLEMENTATION_FILES = mathql.ml $(INTERFACE_FILES:%.mli=%.ml) + +EXTRA_OBJECTS_TO_INSTALL = mathql.ml mathql.cmi +EXTRA_OBJECTS_TO_CLEAN = + + +include ../Makefile.common diff --git a/helm/ocaml/mathql_interpreter/dbconn.ml b/helm/ocaml/mathql_interpreter/dbconn.ml new file mode 100644 index 000000000..5f1d25672 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/dbconn.ml @@ -0,0 +1,52 @@ + +(* + * gestione della connessione al database + *) + +(* + * le eccezzioni lanciate dalle funzioni init e pgc sono + * definite nel modulo Mathql + *) +open Mathql;; + +(* + * paramentri della connessione + *) +(*let connection_param = "host=127.0.0.1 dbname=helm";;*) +let connection_param = "host=dotto.cs.unibo.it dbname=helm user=helm";; + +(* + * connessione al db + *) +let conn = ref None;; + +(* + * controllo sulla connessione + *) +let pgc () = + match !conn with + None -> raise (MQInvalidConnection connection_param) + | Some c -> c +;; + +(* + * inizializzazione della connessione + * + * TODO + * passare i parametri della connessione come argomento di init + *) +let init () = + try ( + conn := Some (new Postgres.connection connection_param); + ) with + _ -> raise (MQConnectionFailed ("init: " ^ connection_param)) +;; + +(* + * chiusura della connessione + *) +let close () = + match !conn with + None -> () + | Some c -> c#close +;; diff --git a/helm/ocaml/mathql_interpreter/dbconn.mli b/helm/ocaml/mathql_interpreter/dbconn.mli new file mode 100644 index 000000000..c382000c6 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/dbconn.mli @@ -0,0 +1,3 @@ +val pgc : unit -> Postgres.connection +val init : unit -> unit +val close : unit -> unit diff --git a/helm/ocaml/mathql_interpreter/eval.ml b/helm/ocaml/mathql_interpreter/eval.ml new file mode 100644 index 000000000..9a5d90dee --- /dev/null +++ b/helm/ocaml/mathql_interpreter/eval.ml @@ -0,0 +1,49 @@ + +(* + * + *) + +open Mathql;; + +(* + * conversione di un pattern + *) +let rec patterneval p = + match p with + [] -> "" + | head::tail -> + let h = match head with + MQString (s) -> s + | MQSlash -> "/" + | MQAnyChr -> "[^/]?" + | MQAst -> "[^/]*" + | MQAstAst -> ".*" + in + h ^ (patterneval tail) +;; + +(* + * conversione di un fragment identifier + *) +let fieval fi = + match fst fi with + None -> "" + | Some i -> + let s = "#xpointer\(1/" ^ string_of_int (i) in + match snd fi with + None -> + s ^ "\)" + | Some j -> + s ^ "/" ^ string_of_int j ^ "\)" +;; + +(* + * trasforma un pattern MathQL in un pattern postgresql + * + * si utilizzano espressioni regolari POSIX anziche' l'operatore + * SQL standard LIKE perche' MathQL prevede esperssioni con "*" + * e con "**". + *) +let pattern_match preamble pattern ext fragid = + " ~ '" ^ preamble ^ ":/" ^ (patterneval pattern) ^ "." ^ ext ^ (fieval fragid) ^ "'" +;; diff --git a/helm/ocaml/mathql_interpreter/eval.mli b/helm/ocaml/mathql_interpreter/eval.mli new file mode 100644 index 000000000..fae7a5bc9 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/eval.mli @@ -0,0 +1,3 @@ +val pattern_match : + string -> + Mathql.mquptoken list -> string -> int option * int option -> string diff --git a/helm/ocaml/mathql_interpreter/func.ml b/helm/ocaml/mathql_interpreter/func.ml new file mode 100644 index 000000000..ae01d206a --- /dev/null +++ b/helm/ocaml/mathql_interpreter/func.ml @@ -0,0 +1,23 @@ + +(* + * + *) + +(* + * implementazione della funzione NAME + *) +let func_name value = + try ( + let i = Str.search_forward (Str.regexp "[^/]*\.") value 0 in + let s = Str.matched_string value in + let retVal = Str.string_before s ((String.length s) - 1) in + retVal + ) with + Not_found -> "" +;; + +(** TEST **) + +(* +print_endline (func_name Sys.argv.(1));; +*) diff --git a/helm/ocaml/mathql_interpreter/func.mli b/helm/ocaml/mathql_interpreter/func.mli new file mode 100644 index 000000000..3e0377615 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/func.mli @@ -0,0 +1 @@ +val func_name : string -> string diff --git a/helm/ocaml/mathql_interpreter/intersect.ml b/helm/ocaml/mathql_interpreter/intersect.ml new file mode 100644 index 000000000..7a3f47f34 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/intersect.ml @@ -0,0 +1,95 @@ + +(* + * implementazione del comando INTERSECT + *) + +(* + * eccezione sollevata quando il join dei contesti + * deve essere vuoto + *) +exception Join_must_be_empty;; + +(* + * join fra due contesti + *) +let xres_join_context h1 l1 h2 l2 = + match (l1, l2) with + ([], _) -> l2 + | (_, []) -> l1 + | (_, _) -> + let hh = h2 @ (List.find_all (function t -> not (List.mem t h2)) h1) + and m1 = List.combine h1 l1 + and m2 = List.combine h2 l2 + in + try + (List.map + (fun elem -> + let value1 = try (List.assoc elem m1) with Not_found -> List.assoc elem m2 + and value2 = try (List.assoc elem m2) with Not_found -> List.assoc elem m1 + in + if value1 = value2 then value1 else raise Join_must_be_empty + ) + hh + ) with + Join_must_be_empty -> [] +;; + +(* + * implementazione del comando INTERSECT + *) +let intersect_ex alist1 alist2 = + let head1 = List.hd alist1 + and tail1 = List.tl alist1 + and head2 = List.hd alist2 + and tail2 = List.tl alist2 (* e fin qui ... *) + in + match (head1, head2) with + ([], _) -> assert false (* gli header non devono mai essere vuoti *) + | (_, []) -> assert false (* devono contenere almeno [retVal] *) + | (_, _) -> + (match (tail1, tail2) with + ([], _) -> [["retVal"]] (* se una delle due code e' vuota... *) + | (_, []) -> [["retVal"]] (* ... l'intersezione e' vuota *) + | (_, _) -> + [head2 @ + (List.find_all + (function t -> not (List.mem t head2)) + head1 + ) + ] (* header del risultato finale *) + @ + List.fold_left + (fun par1 elem1 -> par1 @ + List.map + (fun elem2 -> + [(List.hd elem1)] @ + (xres_join_context (List.tl head1) (List.tl elem1) + (List.tl head2) (List.tl elem2)) + ) + (List.find_all + (fun elem2 -> (* trova tutti gli elementi della lista tail2 *) + ((List.hd elem1) = (List.hd elem2)) && (* che stanno in tail1 *) + not ((xres_join_context (List.tl head1) (List.tl elem1) + (List.tl head2) (List.tl elem2)) = []) + (* e per i quali la xres_join_context non sia vuota *) + ) + tail2 + ) + ) + [] + tail1 (* per ogni elemento di tail1 applica la List.fold_left *) + ) (* match *) +;; + +(* +let h1 = ["retVal"; "a"; "b"];; +let l1 = ["pippo"; "3"; "3"];; +let l3 = ["pluto"; "7";"8"] +let r1 = [h1; l1; l3];; + +let h2 = ["retVal"; "b"; "c"];; +let l2 = ["pippo"; "3"; "1"];; +let r2 = [h2; l2];; + +List.map (fun l -> List.iter print_endline l) (xres_intersect (r1, r2));; +*) diff --git a/helm/ocaml/mathql_interpreter/intersect.mli b/helm/ocaml/mathql_interpreter/intersect.mli new file mode 100644 index 000000000..f764bea7f --- /dev/null +++ b/helm/ocaml/mathql_interpreter/intersect.mli @@ -0,0 +1 @@ +val intersect_ex : string list list -> string list list -> string list list diff --git a/helm/ocaml/mathql_interpreter/mathql.ml b/helm/ocaml/mathql_interpreter/mathql.ml new file mode 100644 index 000000000..1fea24c2e --- /dev/null +++ b/helm/ocaml/mathql_interpreter/mathql.ml @@ -0,0 +1,106 @@ +(* Copyright (C) 2000, HELM Team. + * + * This file is part of HELM, an Hypertextual, Electronic + * Library of Mathematics, developed at the Computer Science + * Department, University of Bologna, Italy. + * + * HELM is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * HELM is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HELM; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, + * MA 02111-1307, USA. + * + * For details, see the HELM World-Wide-Web page, + * http://cs.unibo.it/helm/. + *) + +(******************************************************************************) +(* *) +(* PROJECT HELM *) +(* *) +(* Ferruccio Guidi *) +(* Domenico Lordi *) +(* 30/04/2002 *) +(* *) +(* *) +(******************************************************************************) + +exception MQInvalidURI of string +exception MQConnectionFailed of string +exception MQInvalidConnection of string + +(* Input types **************************************************************) +(* main type is mquery *) + +type mqrvar = string (* name *) + +type mqsvar = string (* name *) + +type mquptoken = + | MQString of string (* a constant string *) + | MQSlash (* a slash: '/' *) + | MQAnyChr (* Any single character: '?' *) + | MQAst (* single asterisk: '*' *) + | MQAstAst (* double asterisk: '**' *) + +type mqup = mquptoken list (* uri pattern (helper) *) + +type mqfi = int option * int option + +type mqtref = string * mqup * string * mqfi (* HELM preamble, + uri pattern, + extension, + fragment identifier *) + +type mqpattern = mqtref (* constant pattern *) + +type mqfunc = + | MQName (* NAME *) + +type mqstring = + | MQCons of string (* constant *) + | MQFunc of mqfunc * mqrvar (* function, rvar *) + | MQRVar of mqrvar (* rvar *) + | MQSVar of mqsvar (* svar *) + | MQMConclusion (* main conclusion *) + | MQConclusion (* inner conclusion *) + +type mqbool = + | MQTrue + | MQFalse + | MQAnd of mqbool * mqbool + | MQOr of mqbool * mqbool + | MQNot of mqbool + | MQIs of mqstring * mqstring (* operands *) + +type mqlist = + | MQSelect of mqrvar * mqlist * mqbool (* rvar, list, boolean *) + | MQUse of mqlist * mqsvar (* list, Position attribute *) + | MQUsedBy of mqlist * mqsvar (* list, Position attribute *) + | MQPattern of mqpattern (* pattern *) + | MQUnion of mqlist * mqlist (* *) + | MQIntersect of mqlist * mqlist (* *) + +type mquery = + | MQList of mqlist + +(* Output types *************************************************************) +(* main type is mqresult *) + +(* TODO: usare le uri in questo formato *) +type mquref = UriManager.uri * mqfi (* uri, fragment identifier *) + +type mqrefs = mqtref list (* list of references (helper) *) + +type mqresult = + | MQStrUri of string list + | MQRefs of mqrefs diff --git a/helm/ocaml/mathql_interpreter/mqint.ml b/helm/ocaml/mathql_interpreter/mqint.ml new file mode 100644 index 000000000..62c12d441 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/mqint.ml @@ -0,0 +1,95 @@ + +(* + * implementazione del'interprete MathQL + *) +open Mathql;; +open Eval;; +open Utility;; +open Dbconn;; +open Pattern;; +open Union;; +open Intersect;; +open Use;; +open Select;; + +(* + * inizializzazione della connessione al database + *) +let init () = Dbconn.init ();; + +(* + * esecuzione di una query + * + * parametri: + * q + * + * output: string list list; risultato internto formato da uri + contesto. + *) +let rec execute_ex q = + match q with + MQSelect (apvar, alist, abool) -> + select_ex apvar (execute_ex alist) abool + | MQUsedBy (alist, asvar) -> + use_ex (execute_ex alist) asvar "refObj" + | MQUse (alist, asvar) -> + use_ex (execute_ex alist) asvar "backPointer" + | MQPattern (apreamble, apattern, ext, afragid) -> + pattern_ex apreamble apattern ext afragid + | MQUnion (l1, l2) -> + union_ex (execute_ex l1) (execute_ex l2) + | MQIntersect (l1, l2) -> + intersect_ex (execute_ex l1) (execute_ex l2) +;; + +(* + * converte il risultato interno di una query (uri + contesto) + * in un risultato di sole uri + * + * parametri: + * l: string list list; + * + * output: mqresult; + * + * note: + * il tipo del risultato mantenuto internamente e' diverso dal tipo di risultato + * restituito in output poiche', mentre chi effettua le query vuole come risultato + * solo le eventuali uri che soddisfano le query stesse, internamente ad una uri + * sono associati anche i valori delle variabili che ancora non sono state valutate + * perche', ad esempio, si trovano in altri rami dell'albero. + * + * Esempio: + * SELECT x IN USE PATTERN "cic:/**.con" POSITION $a WHERE $a IS MainConclusion + * L'albero corrispondente a questa query e': + * + * SELECT + * / | \ + * x USE IS + * / \ /\ + * PATTERN $a $a MainConclusion + * + * Nel momento in cui si esegue il ramo USE non sono noti i vincoli sullla variabile $a + * percui e' necessario considerare, oltre alle uri, i valori della variabile per i quali + * la uri puo' far parte del risultato. + *) +let xres_to_res l = + MQStrUri + ( + List.map + List.hd + (List.tl l) + ) +;; + +(* + * + *) +let execute q = + match q with + MQList qq -> xres_to_res (execute_ex qq) +;; + +(* + * chiusura della connessione al database + *) +let close () = Dbconn.close ();; + diff --git a/helm/ocaml/mathql_interpreter/mqint.mli b/helm/ocaml/mathql_interpreter/mqint.mli new file mode 100644 index 000000000..964bacf98 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/mqint.mli @@ -0,0 +1,21 @@ + +(* + * interfaccia dell'interprete MathQL + *) + +open Mathql;; + +(* + * inizializzazione del database + *) +val init: unit -> unit + +(* + * esecuzione di query + *) +val execute: mquery -> mqresult;; + +(* + * chiusura del database + *) +val close: unit -> unit diff --git a/helm/ocaml/mathql_interpreter/pattern.ml b/helm/ocaml/mathql_interpreter/pattern.ml new file mode 100644 index 000000000..2445e1c76 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/pattern.ml @@ -0,0 +1,14 @@ + +open Dbconn;; +open Utility;; +open Eval;; + +let pattern_ex apreamble apattern ext afragid = + let c = pgc () in + let r1 = c#exec "select att0 from class where att2='Object'" in + let res = + c#exec ("select att0 from t" ^ (pgresult_to_string r1) ^ + " where att0 " ^ (pattern_match apreamble apattern ext afragid)) + in + [["retVal"]] @ List.map (fun l -> [l]) (pgresult_to_string_list res) +;; diff --git a/helm/ocaml/mathql_interpreter/pattern.mli b/helm/ocaml/mathql_interpreter/pattern.mli new file mode 100644 index 000000000..f79ec92ff --- /dev/null +++ b/helm/ocaml/mathql_interpreter/pattern.mli @@ -0,0 +1,4 @@ +val pattern_ex : + string -> + Mathql.mquptoken list -> + string -> int option * int option -> string list list diff --git a/helm/ocaml/mathql_interpreter/select.ml b/helm/ocaml/mathql_interpreter/select.ml new file mode 100644 index 000000000..6f60a3e31 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/select.ml @@ -0,0 +1,143 @@ + +(* + * implementazione del comando SELECT + *) + +open Mathql;; +open Func;; +open Utility;; + +(* + * valutazione di una stringa + *) +let stringeval s l = + match s with + MQCons s -> + s + | MQFunc (f, rvar) -> + ( + match f with + MQName -> func_name (List.assoc rvar l) + ) + | MQRVar rvar -> + List.assoc rvar l + | MQSVar svar -> + List.assoc svar l + | MQMConclusion -> + "MainConclusion" + | MQConclusion -> + "InConclusion" +;; + +(* + * + *) +let rec is_good l abool = + match abool with + MQAnd (b1, b2) -> + (is_good l b1) && (is_good l b2) + | MQOr (b1, b2) -> + (is_good l b1) || (is_good l b2) + | MQNot b1 -> + not (is_good l b1) + | MQTrue -> + true + | MQFalse -> + false + | MQIs (s1, s2) -> + (stringeval s1 l) = (stringeval s2 l) +;; + +(* + * + *) +let rec replace avar newval l = + match l with + MQAnd (b1, b2) -> MQAnd (replace avar newval b1, replace avar newval b2) + | MQOr (b1, b2) -> MQOr (replace avar newval b1, replace avar newval b2) + | MQNot b1 -> MQNot (replace avar newval b1) + | MQIs (s1, s2) -> + let ns1 = ( + match s1 with + MQRVar v when v = avar -> MQRVar newval + | MQFunc (f, v) when v = avar -> MQFunc (f, newval) + | _ -> s1 + ) + and ns2 = ( + match s2 with + MQRVar v when v = avar -> MQRVar newval + | MQFunc (f, v) when v = avar -> MQFunc (f, newval) + | _ -> s2 + ) + in + MQIs (ns1, ns2) + | _ -> l (* i casi non compresi sono MQTrue e MQFalse *) +;; + +let rec print_booltree b = + match b with + MQAnd (b1, b2) -> + let i = print_booltree b1 in + let j = print_string " AND " in + print_booltree b2 + | MQOr (b1, b2) -> + let i = print_booltree b1 in + let j = print_string " OR " in + print_booltree b2 + | MQNot b1 -> + let j = print_string " NOT " in + print_booltree b1 + | MQTrue -> + print_string " TRUE " + | MQFalse -> + print_string " FALSE " + | MQIs (s1, s2) -> + let s1v = match s1 with + MQCons s -> + "'" ^ s ^ "'" + | MQFunc (f, rvar) -> + ( + match f with + MQName -> "NAME " ^ rvar + ) + | MQRVar rvar -> + rvar + | MQSVar svar -> + svar + | MQMConclusion -> + "MainConclusion" + | MQConclusion -> + "InConclusion" + and s2v = match s2 with + MQCons s -> + s + | MQFunc (f, rvar) -> + ( + match f with + MQName -> "NAME " ^ rvar + ) + | MQRVar rvar -> + rvar + | MQSVar svar -> + svar + | MQMConclusion -> + "MainConclusion" + | MQConclusion -> + "InConclusion" + in + print_string (s1v ^ " = " ^ s2v) +;; + +(* + * implementazione del comando SELECT + *) +let select_ex avar alist abool = + let wrt = replace avar "retVal" abool in + (*let j = print_booltree wrt in*) + [List.hd alist] + @ + List.find_all + (fun l -> is_good (List.combine (List.hd alist) l) wrt) + (List.tl alist) +;; + diff --git a/helm/ocaml/mathql_interpreter/select.mli b/helm/ocaml/mathql_interpreter/select.mli new file mode 100644 index 000000000..c3af84dd6 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/select.mli @@ -0,0 +1,3 @@ +val select_ex : + Mathql.mqrvar -> + Mathql.mqsvar list list -> Mathql.mqbool -> Mathql.mqsvar list list diff --git a/helm/ocaml/mathql_interpreter/union.ml b/helm/ocaml/mathql_interpreter/union.ml new file mode 100644 index 000000000..bf402a2f1 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/union.ml @@ -0,0 +1,93 @@ + +(* + * implementazione del comando UNION + *) + +(* + * + *) +let xres_fill_context hr h1 l1 = + match l1 with + [] -> [] + | _ -> + let hh = List.combine h1 l1 + in + List.map + (fun x -> + if (List.mem_assoc x hh) then + List.assoc x hh + else + "" + ) + hr +;; + +(* + * implementazione del comando UNION + *) +let union_ex alist1 alist2 = + let head1 = List.hd alist1 + and tail1 = List.tl alist1 + and head2 = List.hd alist2 + and tail2 = List.tl alist2 (* e fin qui ... *) + in + match (head1, head2) with + ([], _) -> assert false (* gli header non devono mai essere vuoti *) + | (_, []) -> assert false (* devono contenere almeno [retVal] *) + | (_, _) -> let headr = (head2 @ + (List.find_all + (function t -> not (List.mem t head2)) + head1) + ) in (* header del risultato finale *) + List.append (* il risultato finale e' la concatenazione ...*) + [headr] (* ... dell'header costruito prima ...*) + (match (tail1, tail2) with (* e di una coda "unione" *) + ([], _) -> tail2 (* va bene perche' l'altra lista e' vuota *) + | (_, []) -> tail1 (* va bene perche' l'altra lista e' vuota *) + | (_, _) -> + let first = (* parte dell'unione che riguarda solo il primo set *) + List.map (fun l -> [List.hd l] @ + xres_fill_context + (List.tl headr) (List.tl head1) (List.tl l) + ) tail1 + in + List.fold_left + (fun par x -> + let y = (* elemento candidato ad entrare *) + [List.hd x] + @ + xres_fill_context + (List.tl headr) (List.tl head2) (List.tl x) + in + par @ if (List.find_all (fun t -> t = y) par) = [] then + [y] + else + [] + ) + first + tail2 +(* first @ + List.map (fun l -> [List.hd l] @ + xres_fill_context + (List.tl headr) (List.tl head2) (List.tl l) + ) tail2 +*) + ) (* match *) +;; + +(** TEST **) + +(* +let h1 = ["retVal"; "a"; "b"];; +let l1 = ["pippo"; "3"; "3"];; +let l3 = ["pluto"; "7"; "8"] +let r1 = [h1; l1; l3];; + +(*let h2 = ["retVal"; "b"; "c"];; +let l2 = ["pippo"; "3"; "1"];;*) +let h2 = ["retVal"; "a"; "b"];; +let l2 = ["pippo"; "3"; "3"];; +let r2 = [h2; l2];; + +List.map (fun l -> List.iter print_endline l) (xres_union (r1, r2));; +*) diff --git a/helm/ocaml/mathql_interpreter/union.mli b/helm/ocaml/mathql_interpreter/union.mli new file mode 100644 index 000000000..6444b33d2 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/union.mli @@ -0,0 +1 @@ +val union_ex : string list list -> string list list -> string list list diff --git a/helm/ocaml/mathql_interpreter/use.ml b/helm/ocaml/mathql_interpreter/use.ml new file mode 100644 index 000000000..f1ac7c779 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/use.ml @@ -0,0 +1,133 @@ + +(* + * implementazione dei comandi USE/USED BY + *) + +open Utility;; +open Dbconn;; + +(* + * implementazione dei comandi USE/USED BY + * + * parametri: + * alist: string list list; lista su cui eseguire il comando USE/USED BY + * asvar: string; nome della variabile del comando use + * usek: string; nome della tabella in cui ricercare le occorrenze; + * la distinzione fra l'esecuzione del comando USE e USED BY + * sta nell'utilizzo della tabella 'backPointer' per USE + * e 'refObj' per USED BY + * + * output: string list list; lista su cui e' stato eseguito il + * comando USE/USED BY + * + * TODO + * USE e USED BY sono identici dal punto di vista algoritmico, per questo + * sono stati accorpati in una sola funzione; stilisticamente, sarebbe meglio + * avere due implementazioni distinte... + *) +let use_ex alist asvar usek = + let c = pgc () in + List.fold_left + (fun parziale xres -> + let r1 = pgresult_to_string (c#exec + ("select att0 from property where att2='" ^ usek ^ "'")) + and r2 = pgresult_to_string (c#exec + "select att0 from property where att2='position'") + and r3 = pgresult_to_string (c#exec + "select att0 from property where att2='occurrence'") + in + let res = c#exec ( + "select distinct t" ^ r3 ^ ".att1, t" ^ r2 ^ ".att1 " ^ + "from t" ^ r3 ^ ", t" ^ r2 ^ ", t" ^ r1 ^ " " ^ + "where " ^ "t" ^ r1 ^ ".att0 = '" ^ (List.hd xres) ^ "' and t" ^ r1 ^ + ".att1 = t" ^ r2 ^ ".att0 and t" ^ r1 ^ ".att1 = t" ^ r3 ^ + ".att0") + in + parziale + @ + if not (List.mem asvar (List.tl (List.hd alist))) then + List.map + (fun l -> [List.hd l] @ List.tl xres @ List.tl l) + res#get_list + else + List.map + (fun l -> + let t = + match xres with + hd::tl -> (List.hd l)::tl + | [] -> [] + in + List.map + snd + (Utility.set_assoc + asvar + (List.hd (List.tl l)) + (List.combine (List.hd alist) t) + ) + ) + (List.find_all + (fun l -> + let currv = + List.hd (List.tl l) + and xresv = + try ( + List.assoc + asvar + (List.combine + (List.tl (List.hd alist)) + (List.tl xres) + ) + ) with + Not_found -> "" + in + xresv = "" or xresv = currv + ) + res#get_list + ) + ) + [ (List.hd alist) + @ + if not (List.mem asvar (List.tl (List.hd alist))) then + [asvar] + else + [] + ] + (List.tl alist) +;; + +(** TEST **) + +(* +let use_ex alist asvar = + if (List.find_all asvar (List.tl (List.hd alist))) = [] then + use_ex_nc alist asvar + else + use_ex_co alist asvar +;; + +List.map + (fun l -> + let t = + match xres with + hd::tl -> (List.hd l)::tl + | [] -> [] + in + let hash = List.combine (List.hd alist) t in + snd (set_assoc asvar (snd l) hash) + ) + (List.find_all + (fun l -> + let currv = + List.hd (List.tl l) + and xresv = + try ( + List.assoc asvar (List.combine (List.tl (List.hd alist)) (List.tl xres)) + ) with + Not_found -> "" + in + xresv = "" or xresv = currv + ) + res#get_list + ) +;; +*) diff --git a/helm/ocaml/mathql_interpreter/use.mli b/helm/ocaml/mathql_interpreter/use.mli new file mode 100644 index 000000000..6bef1f475 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/use.mli @@ -0,0 +1 @@ +val use_ex : string list list -> string -> string -> string list list diff --git a/helm/ocaml/mathql_interpreter/utility.ml b/helm/ocaml/mathql_interpreter/utility.ml new file mode 100644 index 000000000..38856a0e1 --- /dev/null +++ b/helm/ocaml/mathql_interpreter/utility.ml @@ -0,0 +1,70 @@ + +(* + * funzioni di utilita' generale + *) + +(* + * converte il risultato di una query in una lista di stringhe + * + * parametri: + * l: Postgres.result; risultato della query + * + * output: string list; lista di stringhe (una per tupla) + * + * assumo che il risultato della query sia + * costituito da un solo valore per tupla + * + * TODO + * verificare che l sia effettivamente costruita come richiesto + *) +let pgresult_to_string_list l = List.map (List.hd) l#get_list;; + +(* + * converte il risultato di una query in una stringa + * + * paramteri: + * l: Postgres.result; risultato della query + * + * output: string; valore dell'unica tupla del risultato + * + * mi aspetto che il risultato contenga una sola tupla + * formata da un solo valore + * + * TODO + * verificare che l sia costruita come richiesto + *) +let pgresult_to_string l = List.hd (List.hd l#get_list);; + +(* + * parametri: + * x: 'a; chiave di cui settare il valore + * v: 'b; valore da assegnare alla chiave + * l: ('a * 'b) list; lista di coppie in cui effettuare + * l'assegnamento + * + * output: ('a * 'b) list; lista di coppie contenente (x, v) + * + * TODO + * gestire i casi in cui in l compaiono piu' coppie (x, _) + * si sostituiscono tutte? se ne sostituisce una e si eliminano + * le altre? + *) +let set_assoc x v l = + let rec spila testa key value lista = + match lista with + [] -> testa @ [(key, value)] + | (j, _)::tl when j = key -> testa @ [(key, value)] @ tl + | hd::tl -> spila (testa @ [hd]) key value tl + in + spila [] x v l +;; + +(** TEST **) + +(* +let h = ["d";"b"];; +let v = ["1";"2"];; +let c = List.combine h v;; + +List.iter (fun (a,b) -> print_endline (a ^ ": " ^ b)) (set_assoc "a" "3" c);; +*) diff --git a/helm/ocaml/mathql_interpreter/utility.mli b/helm/ocaml/mathql_interpreter/utility.mli new file mode 100644 index 000000000..928ea33bf --- /dev/null +++ b/helm/ocaml/mathql_interpreter/utility.mli @@ -0,0 +1,3 @@ +val pgresult_to_string_list : < get_list : 'a list list; .. > -> 'a list +val pgresult_to_string : < get_list : 'a list list; .. > -> 'a +val set_assoc : 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list -- 2.39.2