]> matita.cs.unibo.it Git - helm.git/commitdiff
update
authorFerruccio Guidi <ferruccio.guidi@unibo.it>
Tue, 9 Dec 2003 10:30:03 +0000 (10:30 +0000)
committerFerruccio Guidi <ferruccio.guidi@unibo.it>
Tue, 9 Dec 2003 10:30:03 +0000 (10:30 +0000)
helm/ocaml/mathql_generator/.depend
helm/ocaml/mathql_generator/Makefile
helm/ocaml/mathql_generator/cGSearchPattern.ml
helm/ocaml/mathql_generator/mQGTypes.ml
helm/ocaml/mathql_generator/mQGUtil.ml
helm/ocaml/mathql_generator/mQueryGenerator.ml
helm/ocaml/mathql_generator/mQueryMisc.ml [new file with mode: 0644]
helm/ocaml/mathql_generator/mQueryMisc.mli [new file with mode: 0644]

index 820add841dc7b55b383bc1f14163acb24296d003..0619b2c034446f3cbceba4b3c8efe39de070d052 100644 (file)
@@ -7,9 +7,11 @@ mQGUtil.cmo: mQGTypes.cmo mQGUtil.cmi
 mQGUtil.cmx: mQGTypes.cmx mQGUtil.cmi 
 mQueryGenerator.cmo: mQGTypes.cmo mQGUtil.cmi mQueryGenerator.cmi 
 mQueryGenerator.cmx: mQGTypes.cmx mQGUtil.cmx mQueryGenerator.cmi 
-cGMatchConclusion.cmo: mQGTypes.cmo cGMatchConclusion.cmi 
-cGMatchConclusion.cmx: mQGTypes.cmx cGMatchConclusion.cmi 
+mQueryMisc.cmo: mQueryMisc.cmi 
+mQueryMisc.cmx: mQueryMisc.cmi 
+cGMatchConclusion.cmo: mQGTypes.cmo mQueryMisc.cmi cGMatchConclusion.cmi 
+cGMatchConclusion.cmx: mQGTypes.cmx mQueryMisc.cmx cGMatchConclusion.cmi 
 cGSearchPattern.cmo: mQGTypes.cmo mQGUtil.cmi cGSearchPattern.cmi 
 cGSearchPattern.cmx: mQGTypes.cmx mQGUtil.cmx cGSearchPattern.cmi 
-cGLocateInductive.cmo: mQGTypes.cmo cGLocateInductive.cmi 
-cGLocateInductive.cmx: mQGTypes.cmx cGLocateInductive.cmi 
+cGLocateInductive.cmo: mQGTypes.cmo mQueryMisc.cmi cGLocateInductive.cmi 
+cGLocateInductive.cmx: mQGTypes.cmx mQueryMisc.cmx cGLocateInductive.cmi 
index a72f17ab26df09d19ee0df578b127a937321827f..529b3a88b72f8a33a931623df210d36e142b7ed5 100644 (file)
@@ -1,10 +1,11 @@
 PACKAGE = mathql_generator
 
-REQUIRES = helm-cic helm-cic_proof_checking helm-mathql
+REQUIRES = helm-cic helm-cic_textual_parser helm-cic_proof_checking \
+           helm-mathql helm-mathql_interpreter
 
 PREDICATES =
 
-INTERFACE_FILES = mQGUtil.mli mQueryGenerator.mli \
+INTERFACE_FILES = mQGUtil.mli mQueryGenerator.mli mQueryMisc.mli \
                  cGMatchConclusion.mli cGSearchPattern.mli \
                  cGLocateInductive.mli
 
index 77f3b488c6e896a7285e3ef2a0c73e2f415f87d9..65c955cca7652e889aa8a3d622e796c74d159dc3 100644 (file)
@@ -93,9 +93,10 @@ let get_constraints term =
          | Branch _ ->
             let s' =
              match s with
-                Cic.Prop -> T.Prop
-              | Cic.Set -> T.Set
-              | Cic.Type -> T.Type
+                Cic.Prop  -> T.Prop
+              | Cic.Set   -> T.Set
+             | Cic.CProp -> T.CProp
+              | Cic.Type  -> T.Type
             in
             [],[],[!!kind,s']
          | _ -> [],[],[])
index 2dacfe14c5d045690a8f33f12b0bd1ae678546e6..79c10225058207e488fad6018f2ee54baae966b7 100644 (file)
@@ -39,6 +39,7 @@ type depth = int
 type sort = Set
           | Prop
           | Type
+          | CProp
  
 type spec = MustObj  of uri list * position list * depth list
           | MustSort of sort list * position list * depth list
index 36dd0653c67f83256c4276dc8b8540798739fabe..b9ff4bb153f26574eeb5f95c88f60fc67f1dba93 100644 (file)
@@ -40,9 +40,10 @@ let string_of_position p =
       | T.InBody         -> ns ^ "InBody"
       
 let string_of_sort = function
-   | T.Set  -> "Set"
-   | T.Prop -> "Prop"
-   | T.Type -> "Type"
+   | T.Set   -> "Set"
+   | T.Prop  -> "Prop"
+   | T.Type  -> "Type"
+   | T.CProp -> "CProp"
 
 let string_of_depth = string_of_int
 
@@ -54,9 +55,10 @@ let mathql_of_position = function
    | T.InBody         -> "$IB"
       
 let mathql_of_sort = function
-   | T.Set  -> "$SET"
-   | T.Prop -> "$PROP"
-   | T.Type -> "$TYPE"
+   | T.Set   -> "$SET"
+   | T.Prop  -> "$PROP"
+   | T.Type  -> "$TYPE"
+   | T.CProp -> "$CPROP"
 
 let mathql_of_depth = string_of_int
 
@@ -92,9 +94,10 @@ let position_of_mathql = function
    | _     -> raise Parsing.Parse_error 
 
 let sort_of_mathql = function
-   | "$SET"  -> T.Set 
-   | "$PROP" -> T.Prop
-   | "$TYPE" -> T.Type
+   | "$SET"   -> T.Set 
+   | "$PROP"  -> T.Prop
+   | "$TYPE"  -> T.Type
+   | "$CPROP" -> T.CProp 
    | _       -> raise Parsing.Parse_error 
 
 let depth_of_mathql s =
@@ -120,9 +123,10 @@ let text_of_depth pos no_depth_text = match pos with
    | _                        -> no_depth_text
 
 let text_of_sort = function
-   | T.Set  -> "Set"
-   | T.Prop -> "Prop"
-   | T.Type -> "Type"
+   | T.Set   -> "Set"
+   | T.Prop  -> "Prop"
+   | T.Type  -> "Type"
+   | T.CProp -> "CProp"
 
 let is_main_position = function
    | `MainHypothesis _
index 81154695621e3bfea936f1583f29cc67237c409c..e56a744cd2cde7fd31ae2deda966520138dd6478 100644 (file)
@@ -149,7 +149,7 @@ let compose cl =
    let letin_query = 
       if ! letin = [] then fun x -> x
       else 
-        let f (vvar, msval) x = M.Let (vvar, msval, x) in 
+        let f (vvar, msval) x = M.Let (Some vvar, msval, x) in 
         iter f (fun x y z -> x (y z)) ! letin
    in 
    stat (letin_query (select_query must_query))
diff --git a/helm/ocaml/mathql_generator/mQueryMisc.ml b/helm/ocaml/mathql_generator/mQueryMisc.ml
new file mode 100644 (file)
index 0000000..044b1cf
--- /dev/null
@@ -0,0 +1,164 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(****************************************************************************)
+(*                                                                          *)
+(*                               PROJECT HELM                               *)
+(*                                                                          *)
+(*                Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>             *)
+(*                Ferruccio Guidi        <fguidi@cs.unibo.it>               *)
+(*                                 15/01/2003                               *)
+(*                                                                          *)
+(*                                                                          *)
+(****************************************************************************)
+
+exception IllFormedUri of string;;
+
+let string_of_cic_textual_parser_uri uri =
+ let module C = Cic in
+ let module CTP = CicTextualParser0 in
+  let uri' =
+   match uri with
+      CTP.ConUri uri -> UriManager.string_of_uri uri
+    | CTP.VarUri uri -> UriManager.string_of_uri uri
+    | CTP.IndTyUri (uri,tyno) ->
+       UriManager.string_of_uri uri ^ "#1/" ^ string_of_int (tyno + 1)
+    | CTP.IndConUri (uri,tyno,consno) ->
+       UriManager.string_of_uri uri ^ "#1/" ^ string_of_int (tyno + 1) ^ "/" ^
+        string_of_int consno
+  in
+   (* 4 = String.length "cic:" *)
+   String.sub uri' 4 (String.length uri' - 4)
+;;
+
+let cic_textual_parser_uri_of_string uri' =
+ try
+  (* Constant *)
+  if String.sub uri' (String.length uri' - 4) 4 = ".con" then
+   CicTextualParser0.ConUri (UriManager.uri_of_string uri')
+  else
+   if String.sub uri' (String.length uri' - 4) 4 = ".var" then
+    CicTextualParser0.VarUri (UriManager.uri_of_string uri')
+   else
+    (try
+      (* Inductive Type *)
+      let uri'',typeno = CicTextualLexer.indtyuri_of_uri uri' in
+       CicTextualParser0.IndTyUri (uri'',typeno)
+     with
+        UriManager.IllFormedUri _
+      | CicTextualParser0.LexerFailure _
+      | Invalid_argument _ ->
+         (* Constructor of an Inductive Type *)
+         let uri'',typeno,consno =
+          CicTextualLexer.indconuri_of_uri uri'
+         in
+          CicTextualParser0.IndConUri (uri'',typeno,consno)
+    )
+ with
+    UriManager.IllFormedUri _
+  | CicTextualParser0.LexerFailure _
+  | Invalid_argument _ ->
+     raise (IllFormedUri uri')
+;;
+
+(* CSC: quick fix: a function from [uri#xpointer(path)] to [uri#path] *)
+let wrong_xpointer_format_from_wrong_xpointer_format' uri =
+ try
+  let index_sharp =  String.index uri '#' in
+  let index_rest = index_sharp + 10 in
+   let baseuri = String.sub uri 0 index_sharp in
+   let rest =
+    String.sub uri index_rest (String.length uri - index_rest - 1)
+   in
+    baseuri ^ "#" ^ rest
+ with Not_found -> uri
+;;
+
+let term_of_cic_textual_parser_uri uri =
+ let module C = Cic in
+ let module CTP = CicTextualParser0 in
+  match uri with
+     CTP.ConUri uri -> C.Const (uri,[])
+   | CTP.VarUri uri -> C.Var (uri,[])
+   | CTP.IndTyUri (uri,tyno) -> C.MutInd (uri,tyno,[])
+   | CTP.IndConUri (uri,tyno,consno) -> C.MutConstruct (uri,tyno,consno,[])
+;;
+
+(* conversion functions *****************************************************)
+
+type uriref = UriManager.uri * (int list)
+
+let string_of_uriref (uri, fi) =
+   let module UM = UriManager in
+   let str = UM.string_of_uri uri in
+   let xp t = "#xpointer(1/" ^ string_of_int (t + 1) in
+   match fi with
+      | []          -> str 
+      | [t]         -> str ^ xp t ^ ")" 
+      | t :: c :: _ -> str ^ xp t ^ "/" ^ string_of_int c ^ ")" 
+
+let uriref_of_string str =
+   try
+      let i0 = String.index str '#' in
+      let u = UriManager.uri_of_string (String.sub str 0 i0) in
+      let i2 = pred (String.length str) in  
+      let i0 = i0 + 12 in
+      try
+         let i1 = String.index_from str i0 '/' in
+        u, [pred (int_of_string (String.sub str i0 (i1 - i0)));
+            int_of_string (String.sub str (succ i1) (i2 - succ i1))]
+      with Not_found ->
+        u, [pred (int_of_string (String.sub str i0 (i2 - i0)))]
+   with Not_found -> UriManager.uri_of_string str, []
+
+(* object inspection ********************************************************)
+
+exception CurrentProof
+
+exception InductiveDefinition
+
+exception IllFormedFragment
+
+let get_object (u, fi) =
+   let nth l i = 
+      try List.nth l i with Failure "nth" -> raise IllFormedFragment
+   in
+   match (CicEnvironment.get_obj u) with
+      | Cic.Constant (_, Some t, ty, _)     -> t, ty
+      | Cic.Constant (_, None, ty, _)       -> Cic.Const (u, []), ty
+      | Cic.Variable (_, Some t, ty, _)     -> t, ty
+      | Cic.Variable (_, None, ty, _)       -> Cic.Var (u, []), ty
+      | Cic.CurrentProof (_, me, t, ty, _)  -> raise CurrentProof
+      | Cic.InductiveDefinition (tl, _, _)  ->
+         match fi with
+           | []     -> raise InductiveDefinition
+           | [i]    -> 
+              let _, _, ty, _ = nth tl i in
+              Cic.MutInd (u, i, []), ty
+           | [i; j] -> 
+              let _, _, _, cl = nth tl i in
+              let _, ty = nth cl (pred j) in
+              Cic.MutConstruct (u, i, j, []), ty
+            | _      -> raise IllFormedFragment
diff --git a/helm/ocaml/mathql_generator/mQueryMisc.mli b/helm/ocaml/mathql_generator/mQueryMisc.mli
new file mode 100644 (file)
index 0000000..e225ded
--- /dev/null
@@ -0,0 +1,56 @@
+(* Copyright (C) 2000-2002, HELM Team.
+ * 
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ * 
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ * 
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA  02111-1307, USA.
+ * 
+ * For details, see the HELM World-Wide-Web page,
+ * http://cs.unibo.it/helm/.
+ *)
+
+(****************************************************************************)
+(*                                                                          *)
+(*                               PROJECT HELM                               *)
+(*                                                                          *)
+(*                Claudio Sacerdoti Coen <sacerdot@cs.unibo.it>             *)
+(*                Ferruccio Guidi        <fguidi@cs.unibo.it>               *)
+(*                                 15/01/2003                               *)
+(*                                                                          *)
+(*                                                                          *)
+(****************************************************************************)
+
+exception IllFormedUri of string
+
+val string_of_cic_textual_parser_uri : CicTextualParser0.uri -> string
+val cic_textual_parser_uri_of_string : string -> CicTextualParser0.uri
+val term_of_cic_textual_parser_uri: CicTextualParser0.uri -> Cic.term
+val wrong_xpointer_format_from_wrong_xpointer_format' : string -> string
+
+type uriref = UriManager.uri * int list
+
+val string_of_uriref : uriref -> string
+
+val uriref_of_string : string -> uriref
+
+exception CurrentProof
+
+exception InductiveDefinition
+
+exception IllFormedFragment
+
+val get_object : uriref -> Cic.term * Cic.term