src/HOL/Tools/Lifting/lifting_setup.ML
changeset 61814 1ca1142e1711
parent 61268 abe08fb15a12
child 61876 669f47397249
--- a/src/HOL/Tools/Lifting/lifting_setup.ML	Wed Dec 09 16:22:29 2015 +0100
+++ b/src/HOL/Tools/Lifting/lifting_setup.ML	Wed Dec 09 16:36:26 2015 +0100
@@ -247,10 +247,10 @@
 
     val thy = Proof_Context.theory_of lthy
     val dummy_thm = Thm.transfer thy Drule.dummy_thm
-    val pointer =
-      Token.explode (Thy_Header.get_keywords thy) Position.none (cartouche bundle_name)
     val restore_lifting_att = 
-      ([dummy_thm], [Token.src ("Lifting.lifting_restore_internal", Position.none) pointer])
+      ([dummy_thm],
+        [map (Token.make_string o rpair Position.none)
+          ["Lifting.lifting_restore_internal", bundle_name]])
   in
     lthy 
       |> Local_Theory.declaration {syntax = false, pervasive = true}
@@ -936,7 +936,7 @@
 
 val lifting_restore_internal_attribute_setup =
   Attrib.setup @{binding lifting_restore_internal}
-    (Scan.lift Parse.cartouche >>
+    (Scan.lift Parse.string >>
       (fn name => Thm.declaration_attribute (K (lifting_restore_internal name))))
     "restoring lifting infrastructure; internal attribute; not meant to be used directly by regular users"
 
@@ -982,14 +982,15 @@
 fun pointer_of_bundle_name bundle_name ctxt =
   let
     val bundle = Bundle.get_bundle_cmd ctxt bundle_name
+    fun err () = error "The provided bundle is not a lifting bundle"
   in
-    case bundle of
+    (case bundle of
       [(_, [arg_src])] => 
         let
-          val (name, _) = Token.syntax (Scan.lift Parse.cartouche) arg_src ctxt
-            handle ERROR _ => error "The provided bundle is not a lifting bundle."
+          val (name, _) = Token.syntax (Scan.lift Parse.string) arg_src ctxt
+            handle ERROR _ => err ()
         in name end
-      | _ => error "The provided bundle is not a lifting bundle."
+    | _ => err ())
   end
 
 fun pointer_of_bundle_binding ctxt binding = Name_Space.full_name (Name_Space.naming_of