# HG changeset patch # User berghofe # Date 1134033441 -3600 # Node ID 78b4f225b64041535f1a4f501eeb07664d65ada3 # Parent 0839b1ddc29becc92375b7905f64300de79ef9b5 Adapted to new type of PureThy.add_defs_i. diff -r 0839b1ddc29b -r 78b4f225b640 src/HOL/Nominal/nominal_atoms.ML --- a/src/HOL/Nominal/nominal_atoms.ML Wed Dec 07 16:47:04 2005 +0100 +++ b/src/HOL/Nominal/nominal_atoms.ML Thu Dec 08 10:17:21 2005 +0100 @@ -89,7 +89,7 @@ val def2 = Logic.mk_equals (cswap $ ab $ c, cswap_akname $ ab $ c) in thy |> Theory.add_consts_i [("swap_" ^ ak_name, swapT, NoSyn)] - |> (#1 o PureThy.add_defs_i true [((name, def2),[])]) + |> (#2 o PureThy.add_defs_i true [((name, def2),[])]) |> PrimrecPackage.add_primrec_i "" [(("", def1),[])] end) (thy2, ak_names_types); @@ -130,8 +130,8 @@ (* *) (* the trivial cases are added to the simplifier, while the non- *) (* have their own rules proved below *) - val (thy5, perm_defs) = foldl_map (fn (thy, (ak_name, T)) => - foldl_map (fn (thy', (ak_name', T')) => + val (perm_defs, thy5) = fold_map (fn (ak_name, T) => fn thy => + fold_map (fn (ak_name', T') => fn thy' => let val perm_def_name = ak_name ^ "_prm_" ^ ak_name'; val pi = Free ("pi", mk_permT T); @@ -143,8 +143,8 @@ val def = Logic.mk_equals (cperm $ pi $ a, if ak_name = ak_name' then cperm_def $ pi $ a else a) in - thy' |> PureThy.add_defs_i true [((name, def),[])] - end) (thy, ak_names_types)) (thy4, ak_names_types); + PureThy.add_defs_i true [((name, def),[])] thy' + end) ak_names_types thy) ak_names_types thy4; (* proves that every atom-kind is an instance of at *) (* lemma at__inst: *) diff -r 0839b1ddc29b -r 78b4f225b640 src/HOL/Nominal/nominal_package.ML --- a/src/HOL/Nominal/nominal_package.ML Wed Dec 07 16:47:04 2005 +0100 +++ b/src/HOL/Nominal/nominal_package.ML Thu Dec 08 10:17:21 2005 +0100 @@ -489,8 +489,8 @@ val _ = warning "defining type..."; - val (thy6, typedefs) = - foldl_map (fn (thy, ((((name, mx), tvs), c), name')) => + val (typedefs, thy6) = + fold_map (fn ((((name, mx), tvs), c), name') => fn thy => setmp TypedefPackage.quiet_mode true (TypedefPackage.add_typedef_i false (SOME name') (name, tvs, mx) c NONE (rtac exI 1 THEN @@ -502,7 +502,7 @@ val tvs' = map (fn s => TFree (s, the (AList.lookup op = sorts' s))) tvs; val T = Type (Sign.intern_type thy name, tvs'); val Const (_, Type (_, [U])) = c - in apsnd (pair r o hd) + in apfst (pair r o hd) (PureThy.add_defs_i true [(("prm_" ^ name ^ "_def", Logic.mk_equals (Const ("nominal.perm", permT --> T --> T) $ pi $ Free ("x", T), Const (Sign.intern_const thy ("Abs_" ^ name), U --> T) $ @@ -510,8 +510,8 @@ (Const (Sign.intern_const thy ("Rep_" ^ name), T --> U) $ Free ("x", T))))), [])] thy) end)) - (thy5, types_syntax ~~ tyvars ~~ - (List.take (ind_consts, length new_type_names)) ~~ new_type_names); + (types_syntax ~~ tyvars ~~ + (List.take (ind_consts, length new_type_names)) ~~ new_type_names) thy5; val perm_defs = map snd typedefs; val Abs_inverse_thms = map (#Abs_inverse o fst) typedefs; @@ -667,7 +667,7 @@ val eqn = HOLogic.mk_Trueprop (HOLogic.mk_eq (Const (rep_name, T --> T') $ lhs, rhs)); val def_name = (Sign.base_name cname) ^ "_def"; - val (thy', [def_thm]) = thy |> + val ([def_thm], thy') = thy |> Theory.add_consts_i [(cname', constrT, mx)] |> (PureThy.add_defs_i false o map Thm.no_attributes) [(def_name, def)] in (thy', defs @ [def_thm], eqns @ [eqn]) end;