1 (* Copyright (C) 2000, HELM Team.
3 * This file is part of HELM, an Hypertextual, Electronic
4 * Library of Mathematics, developed at the Computer Science
5 * Department, University of Bologna, Italy.
7 * HELM is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
12 * HELM is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with HELM; if not, write to the Free Software
19 * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
22 * For details, see the HELM World-Wide-Web page,
23 * http://cs.unibo.it/helm/.
27 * implementazione del'interprete MathQL
38 open Mathql_semantics;;
44 let prop_pool = ref None;;
58 "/" ^ (string_of_int j)
63 let see_prop_pool () =
64 let _ = print_endline "eccomi" in
66 (fun elem -> print_endline (fst elem ^ ": " ^ snd elem))
67 (match !prop_pool with Some l -> l | _ -> print_endline "ciao"; assert false)
71 let get_prop_id prop =
72 if prop="refObj" then "F"
73 else if prop="backPointer" then "B"
74 else List.assoc prop (match !prop_pool with Some l -> l | _ -> assert false)
77 (* execute_ex env q *)
78 (* [env] is the attributed uri environment in which the query [q] *)
79 (* must be evaluated *)
80 (* [q] is the query to evaluate *)
81 (* It returns a [Mathql_semantics.result] *)
82 let rec execute_ex env =
84 MQSelect (apvar, alist, abool) -> select_ex env apvar (execute_ex env alist) abool
85 | MQUsedBy (alist, asvar) -> use_ex (execute_ex env alist) asvar (get_prop_id "refObj") (* "F"
87 | MQUse (alist, asvar) -> use_ex (execute_ex env alist) asvar (get_prop_id "backPointer") (* "B"
89 | MQPattern (apreamble, apattern, afragid) ->
90 pattern_ex (apreamble, apattern, afragid)
91 | MQUnion (l1, l2) -> union_ex (execute_ex env l1) (execute_ex env l2)
92 | MQDiff (l1, l2) -> diff_ex (execute_ex env l1) (execute_ex env l2)
93 | MQSortedBy (l, o, f) -> sortedby_ex (execute_ex env l) o f
94 | MQIntersect (l1, l2) -> intersect_ex (execute_ex env l1) (execute_ex env l2)
95 | MQListRVar rvar ->[List.assoc rvar env]
96 | MQLetIn (lvar, l1, l2) ->
97 let t = Unix.time () in
99 (*CSC: The interesting code *)
100 let _ = letin_ex lvar (execute_ex env l1) in
102 (*CSC: end of the interesting code *)
105 print_string ("LETIN = " ^ string_of_int (List.length res) ^ ": ") ;
106 print_endline (string_of_float (Unix.time () -. t) ^ "s") ;
109 | MQListLVar lvar -> letref_ex lvar
111 let rec build_result = function
115 let len = String.length s in
116 let s = (String.sub s 4 (len-4))(*^".xml"*) in
117 if String.contains s '#' then
118 let pos = String.index s '#' in
119 let s1 = Str.string_before s pos in
120 let xp = Str.string_after s pos in
121 let xp = Str.global_replace (Str.regexp "#xpointer(1") "" xp in
122 let xp = Str.global_replace (Str.regexp "\/") "," xp in
123 let xp = Str.global_replace (Str.regexp ")") "" xp in
125 {uri = s ; attributes = [] ; extra = ""} :: build_result tail
127 {uri = s ; attributes = [] ; extra = ""} :: build_result tail
128 in build_result (List.sort compare l)
131 (* Let's initialize the execute in Select, creating a cyclical recursion *)
132 Select.execute := execute_ex;;
136 (*exception ExecuteFunctionNotInitialized;;
139 (function _ -> raise ExecuteFunctionNotInitialized)
144 execute := execute_ex;;*)
149 * converte il risultato interno di una query (uri + contesto)
150 * in un risultato di sole uri
153 * l: string list list;
158 * il tipo del risultato mantenuto internamente e' diverso dal tipo di risultato
159 * restituito in output poiche', mentre chi effettua le query vuole come risultato
160 * solo le eventuali uri che soddisfano le query stesse, internamente ad una uri
161 * sono associati anche i valori delle variabili che ancora non sono state valutate
162 * perche', ad esempio, si trovano in altri rami dell'albero.
165 * SELECT x IN USE PATTERN "cic:/**.con" POSITION $a WHERE $a IS MainConclusion
166 * L'albero corrispondente a questa query e':
172 * PATTERN $a $a MainConclusion
174 * Nel momento in cui si esegue il ramo USE non sono noti i vincoli sullla variabile $a
175 * percui e' necessario considerare, oltre alle uri, i valori della variabile per i quali
176 * la uri puo' far parte del risultato.
179 (* L.N.: prende una lista di attributed_uri e la trasforma in lista di
180 uri(stringhe) costruendola con il costruttore MQRefs *)
182 MQRefs (List.map (function {Mathql_semantics.uri = uri} -> uri) l)
186 let tmp = List.map (function {Mathql_semantics.uri = uri} -> uri) l in
190 (*let _ = print_endline ("DEBUG: (mqint.ml: xres_to_res)" ^ l) in*)
191 match Str.split (Str.regexp ":\|#\|/\|(\|)") l with
193 match List.rev tl with
194 n::"1"::"xpointer"::tail ->
201 | _ -> (MQBC t) :: MQBD :: par
205 [MQFC (int_of_string n)]
207 | n::m::"1"::"xpointer"::tail ->
214 | _ -> (MQBC t) :: MQBD :: par
218 [MQFC (int_of_string m); MQFC (int_of_string n)]
227 | _ -> (MQBC t) :: MQBD :: par
248 MQList qq -> try xres_to_res (execute_ex [] qq) with e -> Error.print_exn e; raise e