vvar context component added

[helm.git] / helm / ocaml / mathql_interpreter / mqint.ml

diff --git a/helm/ocaml/mathql_interpreter/mqint.ml b/helm/ocaml/mathql_interpreter/mqint.ml
index 0de53503ec72edc48f11c0190b9a5ab80a8ac635..02055f72792b023e51fa5714ef1e8c013304d68f 100644 (file)
--- a/helm/ocaml/mathql_interpreter/mqint.ml
+++ b/helm/ocaml/mathql_interpreter/mqint.ml
@@ -26,6 +26,10 @@
 (*
  * implementazione del'interprete MathQL
  *)
+
+(*
+(* FG: ROBA VECCHIA DA BUTTARE (tranne apertura e chiusura database *)
+
 open MathQL;;
 open Eval;;
 open Utility;;
@@ -40,6 +44,8 @@ open Select;;
 open Letin;;
 open Mathql_semantics;;
 
+
+
 let prop_pool = ref None;;
 
 let fi_to_string fi =
@@ -92,13 +98,6 @@ let get_prop_id prop =
  else List.assoc prop (match !prop_pool with Some l -> l | _ -> assert false)
 ;;
 
-(* automatically performes the union of a given list of patterns *)
-let rec pattern_list_ex = function
-   | [] -> []
-   | [(apreamble, apattern, afragid)] -> pattern_ex (apreamble, apattern, afragid)
-   | (apreamble, apattern, afragid) :: tail -> 
-      union_ex (pattern_ex (apreamble, apattern, afragid)) (pattern_list_ex tail)
-
 (* execute_ex env q                                                   *)
 (*  [env] is the attributed uri environment in which the query [q]    *)
 (*        must be evaluated                                           *)
@@ -112,8 +111,8 @@ let rec execute_ex env =
      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 l ->
-     pattern_list_ex l
+ |  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) ->
@@ -138,14 +137,12 @@ let rec execute_ex env =
        res
  |  MQListLVar lvar ->
      letref_ex lvar
- |  MQReference l -> (* FG: *)
+ |  MQReference l ->
      let rec build_result = function
        | [] -> []
        | s :: tail -> 
         {uri = s ; attributes = [] ; extra = ""} :: build_result tail
-     in build_result l
- | MQMinimize l ->     (* FG: sostituire con l'implementazione vera *)
-     execute_ex env l 
+     in build_result (List.sort compare l)
 ;;
 
 (* Let's initialize the execute in Select, creating a cyclical recursion *)
@@ -253,3 +250,56 @@ 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 *)
+
+(* valuta una MathQL.set_exp e ritorna un MathQL.resource_set *)
+
+let rec exec_set_exp = function 
+   | MathQL.Ref x -> []
+
+
+(* 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)
+
+
+(* valuta una MathQL.val_exp e ritorna un MathQL.value *)
+
+and exec_val_exp = function
+   | MathQL.Const l -> []
+
+
+(* valuta una MathQL.set_exp nel contesto vuoto e ritorna un MathQL.resource_set *)
+
+let execute x =
+   svars := []; rvars := []; groups := [];
+   exec_set_exp x