X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Focaml%2Fmathql_interpreter%2Fmqint.ml;h=a0c56e3848835e0cc8a65212d8227ae87e28008c;hb=fb4f3bb1bafb5d5541a777758b4074ee8e2de4ae;hp=ad27d1959cc4da46bf634a76c0de5e5cf7d257c2;hpb=d77da66c4cfe47042485fe6b8cab5c44d1e03c35;p=helm.git

diff --git a/helm/ocaml/mathql_interpreter/mqint.ml b/helm/ocaml/mathql_interpreter/mqint.ml
index ad27d1959..a0c56e384 100644
--- a/helm/ocaml/mathql_interpreter/mqint.ml
+++ b/helm/ocaml/mathql_interpreter/mqint.ml
@@ -26,18 +26,27 @@
 (*
  * implementazione del'interprete MathQL
  *)
+
+(*
+(* FG: ROBA VECCHIA DA BUTTARE (tranne apertura e chiusura database *)
+
 open MathQL;;
 open Eval;;
 open Utility;;
 open Dbconn;;
 open Pattern;;
-open Union;;
+open Union;;*)
 open Intersect;;
-open Diff;;
+(*open Diff;;
 open Sortedby;;
 open Use;;
 open Select;;
 open Letin;;
+open Mathql_semantics;;
+
+
+
+let prop_pool = ref None;;
 
 let fi_to_string fi =
  match fi with
@@ -56,10 +65,38 @@ let fi_to_string fi =
      ")"
 ;;
 
+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)
+;;
+
 (*
  * inizializzazione della connessione al database
  *)
-let init () = Dbconn.init ();;
+let init () =
+ let _ = Dbconn.init () in
+  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 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]    *)
@@ -71,9 +108,9 @@ let rec execute_ex env =
     MQSelect (apvar, alist, abool) ->
      select_ex env apvar (execute_ex env alist) abool
  |  MQUsedBy (alist, asvar) ->
-     use_ex (execute_ex env alist) asvar "F" (*"refObj"*)
+     use_ex (execute_ex env alist) asvar (get_prop_id "refObj")      (* "F" (*"refObj"*) *)
  |  MQUse (alist, asvar) ->
-     use_ex (execute_ex env alist) asvar "B" (*"backPointer"*)
+     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) ->
@@ -84,12 +121,28 @@ let rec execute_ex env =
      sortedby_ex (execute_ex env l) o f
  |  MQIntersect (l1, l2) ->
      intersect_ex (execute_ex env l1) (execute_ex env l2)
- |  MQLRVar rvar -> [List.assoc rvar env]
+ |  MQListRVar rvar -> [List.assoc rvar env]
  |  MQLetIn (lvar, l1, l2) ->
-     let _ = letin_ex lvar (execute_ex env l1) in
-      execute_ex env l2
- |  MQLetRef rvar ->
-     letref_ex rvar
+     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 *)
@@ -197,3 +250,58 @@ let execute q =
  *)
 let close () = Dbconn.close ();;
 
+*****************************************************************************)
+
+let init () = () (* FG: implementare l'apertura del database *)
+
+let close () = () (* FG: implementare la chiusura del database *)
+
+
+(* contexts *****************************************************************)
+
+type svar_context = (MathQL.svar * MathQL.resource_set) list
+
+type rvar_context = (MathQL.rvar * MathQL.resource) list
+
+type group_context = (MathQL.rvar * MathQL.attribute_group) list
+
+type vvar_context = (MathQL.vvar * MathQL.value) list
+
+
+let svars = ref [] (* contesto delle svar *)
+
+let rvars = ref [] (* contesto delle rvar *)
+
+let groups = ref [] (* contesto dei gruppi *)
+
+let vvars = ref [] (* contesto delle vvar introdotte con let-in *)
+
+
+let rec exec_set_exp = function 
+   | MathQL.Ref vexp -> List.map (fun s -> (s,[])) (exec_val_exp vexp)
+   | MathQL.Intersect sexp1 sexp2 -> intersect_ex (exec_set_exp sexp1) (exec_set_exp sexp2)    
+   | _ -> assert false
+   
+(* valuta una MathQL.boole_exp e ritorna un boole *)
+
+and exec_boole_exp = function
+   | MathQL.False      -> false
+   | MathQL.True       -> true
+   | MathQL.Not x      -> not (exec_boole_exp x)
+   | MathQL.And (x, y) -> (exec_boole_exp x) && (exec_boole_exp y)
+   | MathQL.Or (x, y)  -> (exec_boole_exp x) || (exec_boole_exp y)   
+   | _ -> assert false
+
+(* valuta una MathQL.val_exp e ritorna un MathQL.value *)
+
+and exec_val_exp = function
+   | MathQL.Const x -> x
+   | _ -> assert false
+
+(* valuta una MathQL.set_exp nel contesto vuoto e ritorna un MathQL.resource_set *)
+
+(* valuta una MathQL.set_exp e ritorna un MathQL.resource_set *)
+let execute x =
+   svars := []; rvars := []; groups := []; vvars := [];
+   exec_set_exp x
+