Commits

Sébastien Ferré  committed 4baf75d

Use of only accessible variables for increments and answers.

  • Participants
  • Parent commits 0af8d55

Comments (0)

Files changed (3)

File src/lisql.ml

     type intent = p1
     type extent = Ext.t
 
-    let vars int = List.filter ((<>) var_focus) (vars_p1 int)
+    let accessible_vars int = List.filter ((<>) var_focus) (accessible_vars_p1 int)
 
     let entails ~obs store (int : intent) (x : p1) =
       entails_p1 ~obs store int x
     type intent = p1 prop
     type extent = Ext.t prop
 
-    let rec vars = function
-      | CExists c -> vars_p1 c
-      | CAnd l -> List.fold_left (fun res p -> LSet.inter res (vars p)) (LSet.empty ()) l
-      | COr l -> List.fold_left (fun res p -> LSet.inter res (vars p)) (LSet.empty ()) l
+    let rec accessible_vars = function
+      | CExists c -> accessible_vars_p1 c
+      | CAnd l -> List.fold_left (fun res p -> LSet.inter res (accessible_vars p)) (LSet.empty ()) l
+      | COr l -> List.fold_left (fun res p -> LSet.inter res (accessible_vars p)) (LSet.empty ()) l
 
     let entails ~obs store (int : intent) (x : p1) : bool =
       let rec aux = function
 
     let answers ~obs store (int : intent) : Lisql_semantics.answers = Common.prof "Lisql.ConceptS1.answers" (fun () ->
       let rec aux gv = function
-	| CExists c -> vars_p1 c, Lisql_semantics.fol_p1 ~obs store gv var_this c
+	| CExists c -> accessible_vars_p1 c, Lisql_semantics.fol_p1 ~obs store gv var_this c
 	| CAnd l ->
 	    List.fold_left
 	      (fun (lv,fol) p -> let lv1, fol1 = aux gv p in LSet.union lv lv1, Prop.And (fol, fol1))
 	Common.mapfilter (* variables refining the query *)
 	  (fun v ->
 	    increment ~obs store place current_extent ~suppmin (Var v))
-	  place#vars
+	  place#accessible_vars
       else []) @
       let l = increments0 ~obs store (fun x -> x) NameRoot (Thing, None) v in
       Common.mapfilter
     method assertion = a
     method intent = foc_int
 
-    method vars = Concept.vars foc_int
+    method accessible_vars = Concept.accessible_vars foc_int
     method new_var = new_var_s a
 
     val view_answers = (new Tarpit.view : Lisql_semantics.answers Tarpit.view)

File src/lisql_ast.ml

 let new_var_s a = get_new_var (vars_s a)
 let new_var_p1 q = get_new_var (vars_p1 q)
 
+let rec accessible_vars_s = function
+  | Is (np,c) ->
+      let acc, lv = accessible_vars_s1 np in
+      if acc
+      then LSet.union lv (accessible_vars_p1 c)
+      else LSet.empty ()
+and accessible_vars_s1 = function
+  | Qu (q, c) ->
+      ( match q with
+      | Exists -> true, accessible_vars_p1 c
+      | Forall
+      | Only -> false, LSet.empty () )
+  | NAnd l -> 
+      List.fold_left
+	(fun (acc,lv) np ->
+	  let acc1, lv1 = accessible_vars_s1 np in
+	  acc || acc1, LSet.union lv lv1)
+	(false, LSet.empty ()) l
+  | NOr l ->
+      List.fold_left
+	(fun (acc,lv) np ->
+	  let acc1, lv1 = accessible_vars_s1 np in
+	  acc || acc1, LSet.union lv lv1)
+	(false, LSet.empty ()) l
+  | NNot np -> false, LSet.empty ()
+  | NMaybe np -> accessible_vars_s1 np
+and accessible_vars_p1 q =
+  match q with
+  | Var v -> LSet.singleton v
+  | NameRoot
+  | Name _ -> LSet.empty ()
+  | Type _ -> LSet.empty ()
+  | Role (_, np) ->
+      let acc, lv = accessible_vars_s1 np in
+      lv
+  | Struct (_,args) -> Array.fold_left (fun res f -> LSet.union res (accessible_vars_p1 f)) (LSet.empty ()) args
+  | Arg (_,_,args,st) -> Array.fold_left (fun res f -> LSet.union res (accessible_vars_p1 f)) (accessible_vars_p1 st) args
+  | Pred _ -> LSet.empty ()
+  | Quote _ -> LSet.empty ()
+  | SuchThat (x,s) -> accessible_vars_s s
+  | Thing -> LSet.empty ()
+  | And l -> List.fold_left (fun res f -> LSet.union res (accessible_vars_p1 f)) (LSet.empty ()) l
+  | Or l -> List.fold_left (fun res f -> LSet.union res (accessible_vars_p1 f)) (LSet.empty ()) l
+  | Not f -> LSet.empty ()
+  | Maybe f -> accessible_vars_p1 f
+
+
 let rec subst_s env = function
   | Is (np,c) -> Is (subst_s1 env np, subst_p1 env c)
 and subst_s1 env = function

File src/lisql_semantics.ml

     let ext = Fol.extension_of_fol ~obs store fol in
     ext)
 
-type order = [ `DESC | `ASC | `PAGE_RANK | `HIDDEN ]
+type order = [ `DESC | `ASC | `PAGE_RANK ]
+
 
 let rec fold_answers store (offset : int ref) (limit : int ref) (orders : order option list) (f : 'a -> Name.t option list -> 'a) (init : 'a) (rev_line : Name.t option list) rel : 'a =
   match orders with
       end
   end
 
+(* deprecated *)
+(*
 let answers ~obs store (s : s) : answers =
   Common.prof "Lisql_semantics.relation_s" (fun () ->
-    let lv = List.rev (vars_s s) in (* TODO: should be only free variables *)
+    let lv = List.rev (accessible_vars_s s) in
     let ext = extension_s ~obs store s in
     new answers store lv (ext#relation (store :> Extension.store) lv))
+*)
 
 let extension_p1 ~obs store ?(bounded_vars = LSet.empty ()) (f : p1) : Extension.t =
   Common.prof "Root.extension" (fun () ->