Initial revision

[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 00f6b1c271bde58f3add94cf595b41c3e8eb0bd8..b275de355372b898404fe49d85f668acb5fff179 100644 (file)
--- a/helm/ocaml/mathql_interpreter/mqint.ml
+++ b/helm/ocaml/mathql_interpreter/mqint.ml
@@ -37,14 +37,19 @@ open Dbconn;;
 open Union;;
 open Intersect;;
 open Meet;;
+open Property;;
 open Sub;;
 open Context;;
 open Diff;;
 open Relation;;
 open Func;;
-open Attribute;;
 open Pattern;;
 
+exception SVarUnbound of string;;
+exception RVarUnbound of string;;
+exception VVarUnbound of string;;
+exception PathUnbound of (string * string list);;
+
 exception BooleExpTrue
 
 let init connection_param = Dbconn.init connection_param 
@@ -76,8 +81,16 @@ let get_database () = ! dbname
 (* 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.SVar svar ->
+      (try
+        List.assoc svar c.svars
+       with Not_found ->
+        raise (SVarUnbound svar))
+   | MathQL.RVar rvar ->
+      (try
+        [List.assoc rvar c.rvars]  
+       with Not_found ->
+        raise (RVarUnbound rvar))
    | MathQL.Ref vexp -> List.map (fun s -> (s,[])) (exec_val_exp c vexp)
    | MathQL.Pattern vexp -> pattern_ex (exec_val_exp c vexp)
    | MathQL.Intersect (sexp1, sexp2) ->    
@@ -121,17 +134,18 @@ let rec exec_set_exp c = function
          print_endline (string_of_float (Sys.time() -. before) ^ "s");
          flush stdout); 
        res
-   | MathQL.Relation (inv, rop, path, sexp, attl) -> 
+   | MathQL.Relation (inv, rop, path, sexp, assl) -> 
         let before = Sys.time() in
        if ! dbname = postgres_db then
-        (let res = relation_ex inv rop path (exec_set_exp c sexp) attl in
+        (let res = relation_ex inv rop path (exec_set_exp c sexp) assl in
         if ! stat then 
         (print_string ("RELATION " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": ");
           print_endline (string_of_float (Sys.time() -. before) ^ "s");
           flush stdout);
          res)
+       
        else
-        (let res = relation_galax_ex inv rop path (exec_set_exp c sexp) attl in
+        (let res = relation_galax_ex inv rop path (exec_set_exp c sexp) assl in
          if !stat then
          (print_string ("RELATION-GALAX " ^ (fst path) ^ " = " ^ string_of_int(List.length res) ^ ": ");
           print_endline (string_of_float (Sys.time() -. before) ^ "s");
@@ -156,38 +170,52 @@ let rec exec_set_exp c = function
          flush stdout); 
        res
    | 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*)
+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) =
+              (try
+                List.assoc uri c.rvars
+               with Not_found -> assert false)
+             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
+         try
+          let rec prod c =
+            function
+              [] -> if (exec_boole_exp c bexp) then raise BooleExpTrue 
+            | (uri,attl)::tail1 ->
+                 (*per ogni el. di attl devo andare in ric. su tail1*)
+                 let rec sub_prod attl =
+                  match attl with
+                     [] -> () 
+                   | 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
 
 (* valuta una MathQL.val_exp e ritorna un MathQL.value *)
 
@@ -203,12 +231,23 @@ and exec_val_exp c = function
                                    else s::[]
                        in
                         edup ol
-   | MathQL.Record (rvar, path) -> List.assoc path (List.assoc rvar c.groups) 
-                                 
-   | MathQL.VVar s -> List.assoc s c.vvars                               
+   | MathQL.Record (rvar, path) ->
+      (try
+        List.assoc path
+         (try
+           List.assoc rvar c.groups
+          with Not_found ->
+           raise (RVarUnbound rvar))
+       with Not_found ->
+        raise (PathUnbound path))
+   | MathQL.VVar s ->
+      (try
+        List.assoc s c.vvars
+       with Not_found ->
+        raise (VVarUnbound s))
    | MathQL.RefOf sexp -> List.map (fun (s,_) -> s) (exec_set_exp c sexp)
    | MathQL.Fun (s, vexp) -> fun_ex s (exec_val_exp c vexp)
-   | MathQL.Attribute (inv, rop, path, vexp) -> attribute_ex rop path inv (exec_val_exp c vexp) 
+   | MathQL.Property (inv, rop, path, vexp) -> property_ex rop path inv (exec_val_exp c vexp) 
 
 (* valuta una MathQL.set_exp nel contesto vuoto e ritorna un MathQL.resource_set *)
 and execute x =