aboutsummaryrefslogtreecommitdiff
path: root/interp/smartlocate.ml
diff options
context:
space:
mode:
authorherbelin2009-09-11 17:53:30 +0000
committerherbelin2009-09-11 17:53:30 +0000
commitea85f46dc0cc34db149c24bb2da8f3130e191fc1 (patch)
tree3b8fa67f3f1dc5bb2815b38c1040a3ea192c88fe /interp/smartlocate.ml
parent7131609a82198080421b15e2c7a0d8f3b6cbd3de (diff)
Generalized the possibility to refer to a global name by a notation
string in most commands expecting a global name (e.g. 'Print "+"' for an infix notation or 'Print "{ _ } + { _ }"' for a misfix notation, possibly surrounded by a scope delimiter). Support for such smart globals in VERNAC EXTEND to do. Added a file smartlocate.ml for high-level globalization functions. Mini-nettoyage metasyntax.ml. git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@12323 85f007b7-540e-0410-9357-904b9bb8a0f7
Diffstat (limited to 'interp/smartlocate.ml')
-rw-r--r--interp/smartlocate.ml62
1 files changed, 62 insertions, 0 deletions
diff --git a/interp/smartlocate.ml b/interp/smartlocate.ml
new file mode 100644
index 0000000000..07ae87fa08
--- /dev/null
+++ b/interp/smartlocate.ml
@@ -0,0 +1,62 @@
+(************************************************************************)
+(* v * The Coq Proof Assistant / The Coq Development Team *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(* \VV/ **************************************************************)
+(* // * This file is distributed under the terms of the *)
+(* * GNU Lesser General Public License Version 2.1 *)
+(************************************************************************)
+
+(* Created by Hugo Herbelin from code formerly dispatched in
+ syntax_def.ml or tacinterp.ml, Sep 2009 *)
+
+(* This file provides high-level name globalization functions *)
+
+(* $Id:$ *)
+
+(* *)
+open Pp
+open Util
+open Names
+open Libnames
+open Genarg
+open Syntax_def
+open Topconstr
+
+let global_of_extended_global = function
+ | TrueGlobal ref -> ref
+ | SynDef kn ->
+ match search_syntactic_definition dummy_loc kn with
+ | [],ARef ref -> ref
+ | _ -> raise Not_found
+
+let locate_global_with_alias (loc,qid) =
+ let ref = Nametab.locate_extended qid in
+ try global_of_extended_global ref
+ with Not_found ->
+ user_err_loc (loc,"",pr_qualid qid ++
+ str " is bound to a notation that does not denote a reference")
+
+let global_inductive_with_alias r =
+ match locate_global_with_alias (qualid_of_reference r) with
+ | IndRef ind -> ind
+ | ref ->
+ user_err_loc (loc_of_reference r,"global_inductive",
+ pr_reference r ++ spc () ++ str "is not an inductive type")
+
+let global_with_alias r =
+ let (loc,qid as lqid) = qualid_of_reference r in
+ try locate_global_with_alias lqid
+ with Not_found -> Nametab.error_global_not_found_loc loc qid
+
+let smart_global = function
+ | AN r ->
+ global_with_alias r
+ | ByNotation (loc,ntn,sc) ->
+ Notation.interp_notation_as_global_reference loc (fun _ -> true) ntn sc
+
+let smart_global_inductive = function
+ | AN r ->
+ global_inductive_with_alias r
+ | ByNotation (loc,ntn,sc) ->
+ destIndRef
+ (Notation.interp_notation_as_global_reference loc isIndRef ntn sc)