]> matita.cs.unibo.it Git - helm.git/blobdiff - helm/ocaml/mathql_interpreter_galax/use.ml
commit of galax mathql interpreter
[helm.git] / helm / ocaml / mathql_interpreter_galax / use.ml
diff --git a/helm/ocaml/mathql_interpreter_galax/use.ml b/helm/ocaml/mathql_interpreter_galax/use.ml
new file mode 100644 (file)
index 0000000..c2a716b
--- /dev/null
@@ -0,0 +1,69 @@
+open Mathql_semantics;;
+
+
+(* prende una lista di uri (contenente alternativamente uri e pos) e costruisce una lista di attributed_uri *)
+let rec attl uril svar = 
+            match uril with                   
+              | head::tail ->  let suri = List.hd uril in
+                               let len = String.length suri in
+                                let scuri = String.sub suri 4 (len-4) in
+                                  if String.contains scuri '#' then
+                                   let pos = String.index scuri '#' in
+                                    let s1 = Str.string_before scuri pos in
+                                      let xp = Str.string_after scuri pos in
+                                      let xp = Str.global_replace (Str.regexp "#xpointer(1") "" xp in
+                                       let xp = Str.global_replace (Str.regexp "\/") "," xp in
+                                        let xp = Str.global_replace (Str.regexp ")") "" xp in
+                                         let scuri = (s1 ^ xp) in
+
+                                           let uril_tl = List.tl uril in
+                                            {uri = scuri; attributes = [(svar, (List.hd
+                                             uril_tl))]; extra = ""} :: (attl (List.tl uril_tl) svar) 
+                                  else
+                                    let uril_tl = List.tl uril in
+                                     {uri = scuri; attributes = [(svar, (List.hd
+                                      uril_tl))]; extra = ""} :: (attl (List.tl uril_tl) svar)
+              | [] -> [] 
+
+
+
+
+
+(* prende un attributed_uri e una svar e  restituisce la lista degli
+attributed_uri (backward o forward in base al parametro "d") associando
+la posizione alla var passata *)
+
+let muse svar d path =
+        let dir =
+          match d with
+              "F" -> "/projects/helm/metadata/create4/forward"
+            | _ -> "/projects/helm/metadata/create4/backward"
+        in 
+          let dtag =
+            match d with
+              "F" -> "refObj"
+            | _ -> "backPointer" in
+
+          let xq ="namespace h=\"http://www.cs.unibo.it/helm/schemas/mattone.rdf#\"
+                   namespace rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"
+                for $i in document(" ^ "\"" ^ dir ^ path.uri ^ ".xml" ^ "\"" ^
+                ")/rdf:RDF/h:Object//h:" ^ dtag ^ "/h:Occurrence
+                return ($i/h:occurrence, $i/h:position)"
+        
+          in 
+            let uril = Toputils.eval_query_string xq in (* e' una lista di liste di stringhe*)
+             let  hd_uril = List.hd uril in(*prendo l'elemento in testa che e' quello
+                                      che contiene la lista di uri*)
+              attl hd_uril svar (* adesso dalla lista di uri(hd_uril) costruisco una lista di attributed_uri*)
+
+            
+
+
+(* prende una lista di uri (Mathql_semantics.result), una variabile (a cui
+associare la posizione), e la direzione (forward o backward) e per ogni uri chiama la muse *)
+let use_ex ulist svar d =
+      List.stable_sort (fun {uri = uri1} {uri = uri2} -> compare uri1 uri2) (List.concat (List.map (muse svar d) ulist))
+;;
+
+
+