+diff.cmi: mathql_semantics.cmo
+sortedby.cmi: mathql_semantics.cmo
select.cmi: mathql_semantics.cmo
intersect.cmi: mathql_semantics.cmo
union.cmi: mathql_semantics.cmo
utility.cmx: dbconn.cmx utility.cmi
func.cmo: dbconn.cmi utility.cmi func.cmi
func.cmx: dbconn.cmx utility.cmx func.cmi
-diff.cmo: diff.cmi
-diff.cmx: diff.cmi
-sortedby.cmo: func.cmi utility.cmi sortedby.cmi
-sortedby.cmx: func.cmx utility.cmx sortedby.cmi
+diff.cmo: mathql_semantics.cmo diff.cmi
+diff.cmx: mathql_semantics.cmx diff.cmi
+sortedby.cmo: func.cmi mathql_semantics.cmo utility.cmi sortedby.cmi
+sortedby.cmx: func.cmx mathql_semantics.cmx utility.cmx sortedby.cmi
select.cmo: func.cmi mathql_semantics.cmo utility.cmi select.cmi
select.cmx: func.cmx mathql_semantics.cmx utility.cmx select.cmi
intersect.cmo: mathql_semantics.cmo intersect.cmi
* MA 02111-1307, USA.
*
* For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
+ * http://www.cs.unibo.it/helm/.
*)
(*
let pgc () =
match !conn with
None -> raise (MQInvalidConnection connection_param)
- | Some c -> c
+ | Some c -> c
;;
(*
* implementazione del comando DIFF
*)
-(*
- *
- *)
-let xres_fill_context hr h1 l1 =
- match l1 with
- [] -> []
- | _ ->
- let hh = List.combine h1 l1
- in
- List.map
- (fun x ->
- if (List.mem_assoc x hh) then
- List.assoc x hh
- else
- ""
- )
- hr
+exception NotCompatible;;
+
+(* intersect_attributes is successful iff there is no attribute with *)
+(* two different values in the two lists. The returned list is the *)
+(* union of the two lists. *)
+let rec intersect_attributes (attr1, attr2) =
+ match attr1, attr2 with
+ [],_ -> attr2
+ | _,[] -> attr1
+ | (key1,value1)::tl1, (key2,_)::_ when key1 < key2 ->
+ (key1,value1)::(intersect_attributes (tl1,attr2))
+ | (key1,_)::_, (key2,value2)::tl2 when key2 < key1 ->
+ (key2,value2)::(intersect_attributes (attr1,tl2))
+ | entry1::tl1, entry2::tl2 when entry1 = entry2 ->
+ entry1::(intersect_attributes (tl1,tl2))
+ | _, _ -> raise NotCompatible (* same keys, different values *)
;;
(*
* implementazione del comando DIFF
*)
-let diff_ex alist1 alist2 =
- let head1 = List.hd alist1
- and tail1 = List.tl alist1
- and head2 = List.hd alist2
- and tail2 = List.tl alist2 (* e fin qui ... *)
- in
- match (head1, head2) with
- ([], _) -> assert false (* gli header non devono mai essere vuoti *)
- | (_, []) -> assert false (* devono contenere almeno [retVal] *)
- | (_, _) -> let headr = (head2 @
- (List.find_all
- (function t -> not (List.mem t head2))
- head1)
- ) in (* header del risultato finale *)
- List.append (* il risultato finale e' la concatenazione ...*)
- [headr] (* ... dell'header costruito prima ...*)
- (match (tail1, tail2) with (* e di una coda "unione" *)
- ([], _) -> tail2 (* va bene perche' l'altra lista e' vuota *)
- | (_, []) -> tail1 (* va bene perche' l'altra lista e' vuota *)
- | (_, _) ->
- let first = (* parte dell'unione che riguarda solo il primo set *)
- List.map (fun l -> [List.hd l] @
- xres_fill_context
- (List.tl headr) (List.tl head1) (List.tl l)
- ) tail1
- in
- List.fold_left
- (fun par x ->
- let y = (* elemento candidato ad entrare *)
- [List.hd x]
- @
- xres_fill_context
- (List.tl headr) (List.tl head2) (List.tl x)
- in
- par @ if (List.find_all (fun t -> t = y) par) = [] then
- [y]
- else
- []
- )
- first
- tail2
-(* first @
- List.map (fun l -> [List.hd l] @
- xres_fill_context
- (List.tl headr) (List.tl head2) (List.tl l)
- ) tail2
-*)
- ) (* match *)
+let rec diff_ex l1 l2 =
+ let module S = Mathql_semantics in
+ match (l1, l2) with
+ [],_ -> []
+ | l,[] -> l
+ | {S.uri = uri1}::_, {S.uri = uri2}::tl2 when uri2 < uri1 ->
+ (diff_ex l1 tl2)
+ | {S.uri = uri1 ; S.attributes = attributes1}::tl1,
+ {S.uri = uri2}::_ when uri1 < uri2 ->
+ {S.uri = uri1 ; S.attributes = attributes1 ; S.extra = ""}::(diff_ex tl1 l2)
+ | {S.uri = uri1 ; S.attributes = attributes1}::tl1,
+ {S.uri = uri2 ; S.attributes = attributes2}::tl2 ->
+ try
+ let attributes' = intersect_attributes (attributes1, attributes2) in
+ diff_ex tl1 tl2
+ with
+ NotCompatible ->
+ {S.uri = uri1 ; S.attributes = attributes1 ; S.extra = ""}::(diff_ex tl1 tl2)
;;
-(** TEST **)
-
-(*
-let h1 = ["retVal"; "a"; "b"];;
-let l1 = ["pippo"; "3"; "3"];;
-let l3 = ["pluto"; "7"; "8"]
-let r1 = [h1; l1; l3];;
-
-(*let h2 = ["retVal"; "b"; "c"];;
-let l2 = ["pippo"; "3"; "1"];;*)
-let h2 = ["retVal"; "a"; "b"];;
-let l2 = ["pippo"; "3"; "3"];;
-let r2 = [h2; l2];;
+let diff_ex l1 l2 =
+ let before = Unix.time () in
+ let res = diff_ex l1 l2 in
+ let after = Unix.time () in
+ let ll1 = string_of_int (List.length l1) in
+ let ll2 = string_of_int (List.length l2) in
+ let diff = string_of_float (after -. before) in
+ prerr_endline
+ ("DIFF(" ^ ll1 ^ ", " ^ ll2 ^ ") = " ^ string_of_int (List.length res) ^
+ ": " ^ diff ^ "s") ;
+ flush stderr ;
+ res
+;;
-List.map (fun l -> List.iter print_endline l) (xres_union (r1, r2));;
-*)
* http://cs.unibo.it/helm/.
*)
-val diff_ex : string list list -> string list list -> string list list
+val diff_ex :
+ Mathql_semantics.result -> Mathql_semantics.result -> Mathql_semantics.result
[] -> ""
| head::tail ->
let h = match head with
- MQBC (s) -> Str.global_replace (Str.regexp "\.") "\\\\\." s
+ MQBC s -> Str.global_replace (Str.regexp "\.") "\\\\\." s
| MQBD -> "/"
| MQBQ -> "[^/#]?"
| MQBS -> "[^/#]*"
h ^ (patterneval tail)
;;
+let rec fieval fi =
+ match fi with
+ [] -> ""
+ | MQFC i :: tail -> "/" ^ (string_of_int i) ^ (fieval tail)
+ | MQFS :: tail -> "[^/]*" ^ (fieval tail)
+ | MQFSS :: tail -> ".*" ^ (fieval tail)
+;;
+
(*
* conversione di un fragment identifier
*)
let fieval fi =
-match fi with
- [] -> ""
- | MQFC i :: tail ->
- let s = "#xpointer\\\\(1/" ^ string_of_int (i) in
- match tail with
- [] -> s ^ "\\\\)"
- | MQFC j :: tail2 ->
- s ^ "/" ^ string_of_int j ^ "\\\\)"
+ if fi = [] then
+ ""
+ else
+ "#xpointer\\\\(1" ^ fieval fi ^ "\\\\)"
;;
(*
*)
let preeval p =
match p with
- Some s -> s
+ Some s -> s
+ | None -> "[^/]*"
;;
(*
* e con "**".
*)
let pattern_match (preamble, pattern, fragid) =
- " ~ '" ^ (preeval preamble) ^ ":/" ^ (patterneval pattern) ^ (fieval fragid) ^ "'"
+ " ~ '^" ^ (preeval preamble) ^ ":/" ^ (patterneval pattern) ^ (fieval fragid) ^ "$'"
;;
{S.uri = uri2 ; S.attributes = attributes2}::tl2 ->
try
let attributes' = intersect_attributes (attributes1,attributes2) in
- {S.uri = uri1 ; S.attributes = attributes'}::(intersect_ex tl1 tl2)
+ {S.uri = uri1 ; S.attributes = attributes' ; S.extra = ""}::(intersect_ex tl1 tl2)
with
NotCompatible ->
intersect_ex tl1 tl2
;;
let intersect_ex l1 l2 =
+ (* PRE-CLAUDIO
+ (*let _ = print_string ("INTERSECT ")
+ and t = Unix.time () in*)
+ let result =
+ match (l1, l2) with
+ ((head1::tail1), (head2::tail2)) ->
+ (match (head1, head2) with
+ ([], _) -> assert false (* gli header non devono mai essere vuoti *)
+ | (_, []) -> assert false (* devono contenere almeno [retVal] *)
+ | (_, _) ->
+ (match (tail1, tail2) with
+ ([], _) -> [["retVal"]] (* se una delle due code e' vuota... *)
+ | (_, []) -> [["retVal"]] (* ... l'intersezione e' vuota *)
+ | (_, _) ->
+ [head2 @
+ (List.find_all
+ (function t -> not (List.mem t head2))
+ head1
+ )
+ ] (* header del risultato finale *)
+ @
+ intersect_tails (List.tl head1) tail1 (List.tl head2) tail2
+ (*
+ List.fold_left
+ (fun par1 elem1 -> par1 @
+ List.map
+ (fun elem2 ->
+ [(List.hd elem1)] @
+ (xres_join_context (List.tl head1) (List.tl elem1)
+ (List.tl head2) (List.tl elem2)
+ )
+ )
+ (List.find_all (* *)
+ (fun elem2 -> (* trova tutti gli elementi della lista tail2 *)
+ ((List.hd elem1) = (List.hd elem2)) && (* che stanno in tail1 *)
+ not ((xres_join_context (List.tl head1) (List.tl elem1)
+ (List.tl head2) (List.tl elem2)) = [])
+ (* e per i quali la xres_join_context non sia vuota *)
+ )
+ tail2 (* List.find_all *)
+ )
+ )
+ []
+ tail1 (* per ogni elemento di tail1 applica la List.fold_left *)
+ *)
+ ) (* match *)
+ )
+ | _ -> []
+ in
+ (*let _ = print_endline (string_of_float (Unix.time () -. t)); flush stdout in*)
+ result*)
let before = Unix.time () in
let res = intersect_ex l1 l2 in
let after = Unix.time () in
* MA 02111-1307, USA.
*
* For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
+ * http://www.cs.unibo.it/helm/.
*)
(* attributes are sorted w.r.t. their name in increasing order *)
type attributed_uri =
- { uri: string ; attributes : (MathQL.mqsvar * string) list }
+ { uri: string ; attributes : (MathQL.mqsvar * string) list ; extra : string}
type attributed_uri_env =
(MathQL.mqrvar * attributed_uri) list
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)
| MQRVarOccur rvar -> [List.assoc rvar env]
MQRefs
(List.map
(function l ->
- match Str.split (Str.regexp ":\|#\|/") l with
- hd::tl -> (
+ (*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::"xpointer(1"::tail ->
+ n::"1"::"xpointer"::tail ->
(
Some hd,
List.fold_left
tail,
[MQFC (int_of_string n)]
)
- | ")"::n::m::"xpointer(1"::tail ->
+ | n::m::"1"::"xpointer"::tail ->
(
Some hd,
List.fold_left
[]
)
)
- | [] -> assert false
+ | _ -> assert false
)
tmp
)
* MA 02111-1307, USA.
*
* For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
+ * http://www.cs.unibo.it/helm/.
*)
(*
let pattern_ex (apreamble, apattern, afragid) =
let c = pgc () in
+ (*let _ = print_string ("USE ")
+ and t = Unix.time () in*)
(*let r1 = helm_class_id "MathResource" in*)
(*let qq = "select att0 from t" ^ r1 ^ " where att0 " ^ (pattern_match apreamble apattern afragid) ^ " order by t" ^ r1 ^ ".att0 asc" in*)
+ (*PRE-CLAUDIO
+ let qq = "select uri from registry where uri " ^ (pattern_match apreamble apattern afragid) ^ " order by registry.uri asc" in
+ let result =
+ let res =
+ c#exec (qq)
+ in
+ [["retVal"]] @ List.map (fun l -> [l]) (pgresult_to_string_list res)*)
let qq = "select uri from registry where uri " ^ (pattern_match (apreamble, apattern, afragid)) ^ " order by registry.uri asc" in
(*let _ = print_endline qq in*)
let res =
c#exec (qq)
in
+(* PRE-CLAUDIO
+ (*let _ = print_endline (string_of_float (Unix.time () -. t)); flush stdout in*)
+ result*)
List.map
- (function uri -> {uri = uri ; attributes = []})
+ (function uri -> {uri = uri ; attributes = [] ; extra = ""})
(pgresult_to_string_list res)
;;
* MA 02111-1307, USA.
*
* For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
+ * http://www.cs.unibo.it/helm/.
*)
(*
* implementazione del comando SORTEDBY
*)
let sortedby_ex alist order afunc =
- [List.hd alist]
- @
- List.map
- (List.tl)
- (Sort.list
- (fun a b ->
- match order with
- MQAsc -> (List.hd a) < (List.hd b)
- | MQDesc -> (List.hd a) > (List.hd b)
- )
- (List.map
- (fun l -> [apply_func afunc (List.hd l)] @ l)
- (List.tl alist)
- )
- )
+ let before = Unix.time () in
+ let res =
+ let module S = Mathql_semantics in
+ (Sort.list
+ (fun {S.extra = e1} {S.extra = e2} ->
+ match order with
+ MQAsc -> e1 < e2
+ | MQDesc -> e1 > e2
+ )
+ (List.map
+ (fun {S.uri = u ; S.attributes = attr} -> {S.uri = u ; S.attributes = attr ; S.extra = (apply_func afunc u)})
+ alist
+ )
+ )
+ in
+ let after = Unix.time ()
+ and ll1 = string_of_int (List.length alist) in
+ let diff = string_of_float (after -. before) in
+ prerr_endline
+ ("SORTEDBY(" ^ ll1 ^ ") = " ^ string_of_int (List.length res) ^
+ ": " ^ diff ^ "s") ;
+ flush stderr ;
+ res
;;
*)
val sortedby_ex :
- string list list -> MathQL.mqorder -> MathQL.mqfunc -> string list list
+ Mathql_semantics.result -> MathQL.mqorder -> MathQL.mqfunc -> Mathql_semantics.result
[],l
| l,[] -> l
| ({S.uri = uri1} as entry1)::tl1,
- ({S.uri = uri2} as entry2)::_ when uri1 < uri2 || entry1 < entry2 ->
+ ({S.uri = uri2} as entry2)::_ when uri1 < uri2 ->
entry1::(union_ex tl1 l2)
| ({S.uri = uri1} as entry1)::_,
- ({S.uri = uri2} as entry2)::tl2 when uri2 < uri1 || entry2 < entry1 ->
+ ({S.uri = uri2} as entry2)::tl2 when uri2 < uri1 ->
entry2::(union_ex l1 tl2)
| entry1::tl1,entry2::tl2 -> (* same entry *)
- entry1::(union_ex tl1 tl2)
+ if entry1 = entry2 then (* same attributes *)
+ entry1::(union_ex tl1 tl2)
+ else
+ assert false
;;
let union_ex l1 l2 =
* MA 02111-1307, USA.
*
* For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
+ * http://www.cs.unibo.it/helm/.
*)
(*
* comando USE/USED BY
*)
let use_ex alist asvar usek =
+ (*(*let _ = print_string ("USE ")
+ and t = Unix.time () in*)
+ let result =
+ let c = pgc ()
+ in
+ [ (List.hd alist) @ [asvar] ]
+ @
+ Sort.list
+ (fun l m -> List.hd l < List.hd m)
+ (List.fold_left
+ (fun parziale xres ->
+ (*let r1 = helm_property_id usek
+ and r2 = helm_property_id "position"
+ and r3 = helm_property_id "occurrence"
+ in
+ let qq = "select distinct t" ^ r3 ^ ".att1, t" ^ r2 ^ ".att1 " ^
+ "from t" ^ r3 ^ ", t" ^ r2 ^ ", t" ^ r1 ^ " " ^
+ "where " ^ "t" ^ r1 ^ ".att0 = '" ^ (List.hd xres) ^ "' and t" ^ r1 ^
+ ".att1 = t" ^ r2 ^ ".att0 and t" ^ r1 ^ ".att1 = t" ^ r3 ^
+ ".att0 order by t" ^ r3 ^ ".att1 asc"*)
+ let tv = pgresult_to_string (c#exec ("select id from registry where uri='" ^ (List.hd xres) ^ "'")) in
+ let _ = print_endline ("DEBUG (use.ml): " ^ tv) in
+ let qq = "select uri, context from t" ^ tv ^ " where back_for='" ^ usek ^ "'" in
+ let res = c#exec qq in
+ (List.map
+ (fun l -> [List.hd l] @ List.tl xres @ List.tl l)
+ res#get_list
+ )
+ @
+ parziale
+ )
+ []
+ (List.tl alist)
+ )
+ in
+ (*let _ = print_endline (string_of_float (Unix.time () -. t)); flush stdout in*)
+
+ *)
let module S = Mathql_semantics in
let _ = print_string ("USE ")
and t = Unix.time () in
(List.fold_left
(fun parziale {S.uri = uri ; S.attributes = attributes} ->
print_string uri ;
- (*let r1 = helm_property_id usek
+ (* RSSDB
+ let r1 = helm_property_id usek
and r2 = helm_property_id "position"
and r3 = helm_property_id "occurrence"
in
"from t" ^ r3 ^ ", t" ^ r2 ^ ", t" ^ r1 ^ " " ^
"where " ^ "t" ^ r1 ^ ".att0 = '" ^ (List.hd xres) ^ "' and t" ^ r1 ^
".att1 = t" ^ r2 ^ ".att0 and t" ^ r1 ^ ".att1 = t" ^ r3 ^
- ".att0 order by t" ^ r3 ^ ".att1 asc"*)
+ ".att0 order by t" ^ r3 ^ ".att1 asc"
+ *)
let tv =
pgresult_to_string
(c#exec ("select id from registry where uri='" ^ uri ^ "'"))
let res = c#exec qq in
(List.map
(function
- [uri;context] -> {S.uri = uri ; S.attributes = [asvar, context]}
+ [uri;context] -> {S.uri = uri ; S.attributes = [asvar, context] ; S.extra = ""}
| _ -> assert false
) res#get_list
) @
* MA 02111-1307, USA.
*
* For details, see the HELM World-Wide-Web page,
- * http://cs.unibo.it/helm/.
+ * http://www.cs.unibo.it/helm/.
*)
(*
projects / helm.git / commitdiff