src/HOL/Tools/primrec.ML
changeset 36960 01594f816e3a
parent 36954 ef698bd61057
child 37145 01aa36932739
equal deleted inserted replaced
36959:f5417836dbea 36960:01594f816e3a
   305   in ((ts, simps'), Local_Theory.exit_global lthy') end;
   305   in ((ts, simps'), Local_Theory.exit_global lthy') end;
   306 
   306 
   307 
   307 
   308 (* outer syntax *)
   308 (* outer syntax *)
   309 
   309 
   310 local structure P = OuterParse and K = OuterKeyword in
       
   311 
       
   312 val opt_unchecked_name =
   310 val opt_unchecked_name =
   313   Scan.optional (P.$$$ "(" |-- P.!!!
   311   Scan.optional (Parse.$$$ "(" |-- Parse.!!!
   314     (((P.$$$ "unchecked" >> K true) -- Scan.optional P.name "" ||
   312     (((Parse.$$$ "unchecked" >> K true) -- Scan.optional Parse.name "" ||
   315       P.name >> pair false) --| P.$$$ ")")) (false, "");
   313       Parse.name >> pair false) --| Parse.$$$ ")")) (false, "");
   316 
   314 
   317 val old_primrec_decl =
   315 val old_primrec_decl =
   318   opt_unchecked_name --
   316   opt_unchecked_name --
   319     Scan.repeat1 ((Parse_Spec.opt_thm_name ":" >> apfst Binding.name_of) -- P.prop);
   317     Scan.repeat1 ((Parse_Spec.opt_thm_name ":" >> apfst Binding.name_of) -- Parse.prop);
   320 
   318 
   321 val primrec_decl = P.opt_target -- P.fixes -- Parse_Spec.where_alt_specs;
   319 val primrec_decl = Parse.opt_target -- Parse.fixes -- Parse_Spec.where_alt_specs;
   322 
   320 
   323 val _ =
   321 val _ =
   324   OuterSyntax.command "primrec" "define primitive recursive functions on datatypes" K.thy_decl
   322   Outer_Syntax.command "primrec" "define primitive recursive functions on datatypes"
       
   323   Keyword.thy_decl
   325     ((primrec_decl >> (fn ((opt_target, fixes), specs) =>
   324     ((primrec_decl >> (fn ((opt_target, fixes), specs) =>
   326       Toplevel.local_theory opt_target (add_primrec_cmd fixes specs #> snd)))
   325       Toplevel.local_theory opt_target (add_primrec_cmd fixes specs #> snd)))
   327     || (old_primrec_decl >> (fn ((unchecked, alt_name), eqns) =>
   326     || (old_primrec_decl >> (fn ((unchecked, alt_name), eqns) =>
   328       Toplevel.theory (snd o
   327       Toplevel.theory (snd o
   329         (if unchecked then OldPrimrec.add_primrec_unchecked else OldPrimrec.add_primrec)
   328         (if unchecked then OldPrimrec.add_primrec_unchecked else OldPrimrec.add_primrec)
   330           alt_name (map P.triple_swap eqns) o
   329           alt_name (map Parse.triple_swap eqns) o
   331         tap (fn _ => legacy_feature "Old variant of 'primrec' command -- use new syntax instead")))));
   330         tap (fn _ => legacy_feature "Old variant of 'primrec' command -- use new syntax instead")))));
   332 
   331 
   333 end;
   332 end;
   334 
       
   335 end;