src/Pure/Isar/isar_syn.ML
changeset 29576 669b560fc2b9
parent 29390 5c26e3a63b8e
child 29610 83d282f12352
equal deleted inserted replaced
29575:41d604e59e93 29576:669b560fc2b9
   416     (K.tag_proof K.prf_goal)
   416     (K.tag_proof K.prf_goal)
   417     (P.!!! SpecParse.locale_expression
   417     (P.!!! SpecParse.locale_expression
   418         >> (fn expr => Toplevel.print o
   418         >> (fn expr => Toplevel.print o
   419             Toplevel.proof' (fn int => Expression.interpret_cmd expr int)));
   419             Toplevel.proof' (fn int => Expression.interpret_cmd expr int)));
   420 
   420 
   421 local
       
   422 
       
   423 val opt_prefix = Scan.optional (P.binding --| P.$$$ ":") Binding.empty;
       
   424 
       
   425 in
       
   426 
       
   427 val locale_val =
       
   428   SpecParse.locale_expr --
       
   429     Scan.optional (P.$$$ "+" |-- P.!!! (Scan.repeat1 SpecParse.context_element)) [] ||
       
   430   Scan.repeat1 SpecParse.context_element >> pair Old_Locale.empty;
       
   431 
       
   432 val _ =
       
   433   OuterSyntax.command "class_locale" "define named proof context based on classes" K.thy_decl
       
   434     (P.name -- Scan.optional (P.$$$ "=" |-- P.!!! locale_val) (Old_Locale.empty, []) -- P.opt_begin
       
   435       >> (fn ((name, (expr, elems)), begin) =>
       
   436           (begin ? Toplevel.print) o Toplevel.begin_local_theory begin
       
   437             (Old_Locale.add_locale_cmd name expr elems #-> TheoryTarget.begin)));
       
   438 
       
   439 val _ =
       
   440   OuterSyntax.command "class_interpretation"
       
   441     "prove and register interpretation of locale expression in theory or locale" K.thy_goal
       
   442     (P.xname --| (P.$$$ "\\<subseteq>" || P.$$$ "<") -- P.!!! SpecParse.locale_expr
       
   443       >> (Toplevel.print oo (Toplevel.theory_to_proof o Old_Locale.interpretation_in_locale I)) ||
       
   444       opt_prefix  -- SpecParse.locale_expr -- SpecParse.locale_insts
       
   445         >> (fn ((name, expr), insts) => Toplevel.print o
       
   446             Toplevel.theory_to_proof
       
   447               (Old_Locale.interpretation_cmd (Binding.base_name name) expr insts)));
       
   448 
       
   449 val _ =
       
   450   OuterSyntax.command "class_interpret"
       
   451     "prove and register interpretation of locale expression in proof context"
       
   452     (K.tag_proof K.prf_goal)
       
   453     (opt_prefix -- SpecParse.locale_expr -- SpecParse.locale_insts
       
   454       >> (fn ((name, expr), insts) => Toplevel.print o
       
   455           Toplevel.proof'
       
   456             (fn int => Old_Locale.interpret_cmd (Binding.base_name name) expr insts int)));
       
   457 
       
   458 end;
       
   459 
       
   460 
   421 
   461 (* classes *)
   422 (* classes *)
   462 
   423 
   463 val class_val =
   424 val class_val =
   464   SpecParse.class_expr --
   425   SpecParse.class_expr --
   853       o Toplevel.keep (Class.print_classes o Toplevel.theory_of)));
   814       o Toplevel.keep (Class.print_classes o Toplevel.theory_of)));
   854 
   815 
   855 val _ =
   816 val _ =
   856   OuterSyntax.improper_command "print_locale" "print locale expression in this theory" K.diag
   817   OuterSyntax.improper_command "print_locale" "print locale expression in this theory" K.diag
   857     (opt_bang -- P.xname >> (Toplevel.no_timing oo IsarCmd.print_locale));
   818     (opt_bang -- P.xname >> (Toplevel.no_timing oo IsarCmd.print_locale));
   858 
       
   859 val _ =
       
   860   OuterSyntax.improper_command "print_interps"
       
   861     "print interpretations of named locale" K.diag
       
   862     (Scan.optional (P.$$$ "!" >> K true) false -- P.xname
       
   863       >> (Toplevel.no_timing oo uncurry IsarCmd.print_registrations));
       
   864 
   819 
   865 val _ =
   820 val _ =
   866   OuterSyntax.improper_command "print_attributes" "print attributes of this theory" K.diag
   821   OuterSyntax.improper_command "print_attributes" "print attributes of this theory" K.diag
   867     (Scan.succeed (Toplevel.no_timing o IsarCmd.print_attributes));
   822     (Scan.succeed (Toplevel.no_timing o IsarCmd.print_attributes));
   868 
   823