X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fmathql_interpreter%2Fmqint.ml;h=af3298cce4493df4696656db34c72393934b6cf0;hb=fd1cdc0fff3f15c67d949e016135c77c7c4a7ebd;hp=62c12d441e812022fc42a0ddcdf56f3f0713d1bb;hpb=6a1d05b388683befc860b48b4f2bbaf42f58a112;p=helm.git

diff --git a/helm/ocaml/mathql_interpreter/mqint.ml b/helm/ocaml/mathql_interpreter/mqint.ml
index 62c12d441..af3298cce 100644
--- a/helm/ocaml/mathql_interpreter/mqint.ml
+++ b/helm/ocaml/mathql_interpreter/mqint.ml
@@ -1,46 +1,140 @@
+(* 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/.
+ *)
 
 (*
  * implementazione del'interprete MathQL
  *)
-open Mathql;;
+
+(*
+(* FG: ROBA VECCHIA DA BUTTARE (tranne apertura e chiusura database *)
+
+open MathQL;;
 open Eval;;
 open Utility;;
+
+open Pattern;;*)
 open Dbconn;;
-open Pattern;;
 open Union;;
 open Intersect;;
+open Meet;;
+open Sub;;
+open Context;;
+open Diff;;
+open Relation;;
+(*open Sortedby;;
 open Use;;
 open Select;;
+open Letin;;
+open Mathql_semantics;;
 
-(*
- * 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)
+
+let prop_pool = ref None;;
+
+let fi_to_string fi =
+ match fi with
+    (None, _)   ->
+     ""
+ |  (Some i, y) ->
+     "#xpointer(1/"       ^
+     string_of_int i      ^
+     (
+      match y with
+         None   ->
+          ""
+      |  Some j ->
+          "/" ^ (string_of_int j)
+     )                    ^
+     ")"
+;;
+
+let see_prop_pool () =
+ let _ = print_endline "eccomi" in
+ List.iter
+  (fun elem -> print_endline (fst elem ^ ": " ^ snd elem))
+  (match !prop_pool with Some l -> l | _ -> print_endline "ciao"; assert false)
+;;
+
+
+
+let get_prop_id prop =
+ if prop="refObj" then "F"
+ else if prop="backPointer" then "B"
+ else List.assoc prop (match !prop_pool with Some l -> l | _ -> assert false)
 ;;
 
+(* execute_ex env q                                                   *)
+(*  [env] is the attributed uri environment in which the query [q]    *)
+(*        must be evaluated                                           *)
+(*  [q]   is the query to evaluate                                    *)
+(*  It returns a [Mathql_semantics.result]                            *)
+let rec execute_ex env =
+ function
+    MQSelect (apvar, alist, abool) ->
+     select_ex env apvar (execute_ex env alist) abool
+ |  MQUsedBy (alist, asvar) ->
+     use_ex (execute_ex env alist) asvar (get_prop_id "refObj")      (* "F" (*"refObj"*) *)
+ |  MQUse (alist, asvar) ->
+     use_ex (execute_ex env alist) asvar (get_prop_id "backPointer") (* "B" (*"backPointer"*) *)
+ |  MQPattern (apreamble, apattern, afragid) ->
+     pattern_ex (apreamble, apattern, afragid)
+ |  MQUnion (l1, l2) ->
+     union_ex (execute_ex env l1) (execute_ex env l2)
+ |  MQDiff (l1, l2) ->
+     diff_ex (execute_ex env l1) (execute_ex env l2)
+ |  MQSortedBy (l, o, f) ->
+     sortedby_ex (execute_ex env l) o f
+ |  MQIntersect (l1, l2) ->
+     intersect_ex (execute_ex env l1) (execute_ex env l2)
+ |  MQListRVar rvar -> [List.assoc rvar env]
+ |  MQLetIn (lvar, l1, l2) ->
+     let t = Unix.time () in
+      let res =
+       (*CSC: The interesting code *)
+       let _ = letin_ex lvar (execute_ex env l1) in
+        execute_ex env l2
+       (*CSC: end of the interesting code *)
+      in
+       letdispose ();
+       print_string ("LETIN = " ^ string_of_int (List.length res) ^ ": ") ;
+       print_endline (string_of_float (Unix.time () -. t) ^ "s") ;
+       flush stdout ;
+       res
+ |  MQListLVar lvar ->
+     letref_ex lvar
+ |  MQReference l ->
+     let rec build_result = function
+       | [] -> []
+       | s :: tail -> 
+	 {uri = s ; attributes = [] ; extra = ""} :: build_result tail
+     in build_result (List.sort compare l)
+;;
+
+(* Let's initialize the execute in Select, creating a cyclical recursion *)
+Select.execute := execute_ex;;
+
 (*
  * converte il risultato interno di una query (uri + contesto)
  * in un risultato di sole uri
@@ -72,24 +166,190 @@ let rec execute_ex q =
  * la uri puo' far parte del risultato.
  *)
 let xres_to_res l =
- MQStrUri
-  (
-   List.map
-    List.hd
-    (List.tl l)
-  )
+ MQRefs (List.map (function {Mathql_semantics.uri = uri} -> uri) l)
+(*
+ let tmp = List.map (function {Mathql_semantics.uri = uri} -> uri) l in
+  MQRefs
+   (List.map
+    (function l ->
+      (*let _ = print_endline ("DEBUG: (mqint.ml: xres_to_res)" ^ l) in*)
+      match Str.split (Str.regexp ":\|#\|/\|(\|)") l with
+         hd::""::tl -> (
+          match List.rev tl with
+             n::"1"::"xpointer"::tail    ->
+              (
+               Some hd,
+               List.fold_left
+                (fun par t ->
+                 match par with
+                    [] -> [MQBC t] 
+                 |  _  -> (MQBC t) :: MQBD :: par
+                )
+                []
+                tail, 
+               [MQFC (int_of_string n)]
+              )
+          |  n::m::"1"::"xpointer"::tail ->
+              (
+               Some hd,
+               List.fold_left
+                (fun par t ->
+                 match par with
+                    [] -> [MQBC t] 
+                 |  _  -> (MQBC t) :: MQBD :: par
+                )
+                []
+                tail,
+               [MQFC (int_of_string m); MQFC (int_of_string n)]
+              )
+          |  tail                          ->
+              (
+               Some hd,
+               List.fold_left
+                (fun par t ->
+                 match par with
+                    [] -> [MQBC t] 
+                 |  _  -> (MQBC t) :: MQBD :: par
+                )
+                []
+                tail, 
+               []
+              )
+      )  
+       | _ -> assert false
+    )
+    tmp
+   )
+*)
 ;;
 
+
 (*
  * 
  *)
 let execute q =
  match q with
-    MQList qq -> xres_to_res (execute_ex qq)
+    MQList qq -> xres_to_res (execute_ex [] qq)
 ;;
 
+let prop_pool = ref None;;
+
+*****************************************************************************)
+
+let init () = Dbconn.init () 
+(*
+   let c = pgc () in
+   let res = 
+      c#exec "select name,id from property where ns_id in (select id from namespace where url='http://www.cs.unibo.it/helm/schemas/mattone.rdf#')"
+   in
+   prop_pool := Some
+     (
+      List.map
+       (function
+           a::b::_ -> (a, b)
+         | _       -> print_endline "no"; assert false
+       )
+       res#get_list
+     )
+*) 
+
+let close () = Dbconn.close ()
+
+let check () = Dbconn.pgc ()
+
+exception BooleExpTrue
+
+(* valuta una MathQL.set_exp e ritorna un MathQL.resource_set *)
+
+let rec exec_set_exp c = function
+   |MathQL.SVar svar -> List.assoc svar c.svars
+   |MathQL.RVar rvar -> [List.assoc rvar c.rvars]  
+   | MathQL.Ref vexp -> List.map (fun s -> (s,[])) (exec_val_exp c vexp)
+   | MathQL.Intersect (sexp1, sexp2) -> intersect_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2)    
+   | MathQL.Union (sexp1, sexp2) -> union_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2)
+   | MathQL.LetSVar (svar, sexp1, sexp2) -> let _ = (svar, (exec_set_exp c sexp1)):: (List.remove_assoc svar c.svars) 
+   					in (exec_set_exp c sexp2)
+   | MathQL.LetVVar (vvar, vexp, sexp) -> let _ = (vvar, (exec_val_exp c vexp)):: (List.remove_assoc vvar c.vvars)
+   					in (exec_set_exp c sexp)
+   | MathQL.Relation (rop, path, sexp, attl) -> relation_ex rop path (exec_set_exp c sexp) attl
+   | MathQL.Select (rvar, sexp, bexp) -> let rset = (exec_set_exp c sexp) in
+                                          let rec select_ex rset =
+					    match rset with 
+						      [] -> []
+					    | r::tl -> let c1 = upd_rvars c ((rvar,r)::c.rvars) in                      
+	                                       if (exec_boole_exp c1 bexp) then r::(select_ex tl)
+   		                               else select_ex tl
+                                          in select_ex rset
+					               
+   					   			                   
+   
+   | MathQL.Diff (sexp1, sexp2) -> diff_ex (exec_set_exp c sexp1) (exec_set_exp c sexp2)
+   | _ -> assert false
+   
+(* valuta una MathQL.boole_exp e ritorna un boole *)
+
+and exec_boole_exp c = function
+   | MathQL.False      -> false
+   | MathQL.True       -> true
+   | MathQL.Not x      -> not (exec_boole_exp c x)
+   | MathQL.And (x, y) -> (exec_boole_exp c x) && (exec_boole_exp c y)
+   | MathQL.Or (x, y)  -> (exec_boole_exp c x) || (exec_boole_exp c y)
+   | MathQL.Sub (vexp1, vexp2) -> sub_ex (exec_val_exp c vexp1) (exec_val_exp c vexp2)
+   | MathQL.Meet (vexp1, vexp2) -> meet_ex (exec_val_exp c vexp1) (exec_val_exp c vexp2)
+   | MathQL.Eq (vexp1, vexp2) -> (exec_val_exp c vexp1) = (exec_val_exp c vexp2)
+   | MathQL.Ex l bexp -> 
+   	if l = [] then (exec_boole_exp c bexp)
+   	else
+   	  let latt = List.map (fun uri -> 
+                                       let (r,attl) = List.assoc uri c.rvars 
+				       in (uri,attl)) l (*latt = l + attributi*)
+	  in
+	   try
+	     let rec prod c = function
+	       	[] -> if (exec_boole_exp c bexp) then raise BooleExpTrue 
+	      | (uri,attl)::tail1 -> let rec sub_prod attl =
+			     	      match attl with
+(*per ogni el. di attl  *)		[] -> () 
+(*devo andare in ric. su tail1*)      | att::tail2 -> let c1 = upd_groups c ((uri,att)::c.groups) in             
+						       prod c1 tail1; sub_prod tail2 
+				     in	      
+			              sub_prod attl 
+   	     in
+	      prod c latt; false
+	   with BooleExpTrue -> true  
+   | _ -> assert false    
+
+(* valuta una MathQL.val_exp e ritorna un MathQL.value *)
+
+and exec_val_exp c = function
+   | MathQL.Const x -> let ol = List.sort compare x in 
+   			let rec edup = function
+			
+			   [] -> [] 
+			 | s::tl -> if tl <> [] then  
+			                         if s = (List.hd tl) then edup tl
+			                         else s::(edup tl)
+				    else s::[]
+	                in
+			 edup ol
+   | MathQL.Record (rvar, vvar) -> List.assoc vvar (List.assoc rvar c.groups) 
+				  
+   | MathQL.VVar s -> List.assoc s c.vvars				  
+   | MathQL.RefOf sexp -> List.map (fun (s,_) -> s) (exec_set_exp c sexp)
+   
+   | _ -> assert false
+
+
+(* valuta una MathQL.set_exp nel contesto vuoto e ritorna un MathQL.resource_set *)
+
+and execute x =
+   exec_set_exp {svars = []; rvars = []; groups = []; vvars = []} x 
+
+
+
+
 (*
  * chiusura della connessione al database
- *)
-let close () = Dbconn.close ();;
+  *)
+  let close () = Dbconn.close ();;