# HG changeset patch # User wenzelm # Date 1460368104 -7200 # Node ID 85c6c2a1952d92aa663e7d6a2d506da58cf6aa31 # Parent 3374f3ffb2ec77daf30e6e2f7e26460232583534 tuned; diff -r 3374f3ffb2ec -r 85c6c2a1952d src/HOL/Tools/code_evaluation.ML --- a/src/HOL/Tools/code_evaluation.ML Sun Apr 10 23:15:34 2016 +0200 +++ b/src/HOL/Tools/code_evaluation.ML Mon Apr 11 11:48:24 2016 +0200 @@ -165,9 +165,9 @@ | NONE => NONE) | subst_termify t = subst_termify_app (strip_comb t) -fun check_termify _ ts = the_default ts (map_default subst_termify ts); +fun check_termify ts = the_default ts (map_default subst_termify ts); -val _ = Context.>> (Syntax_Phases.term_check 0 "termify" check_termify); +val _ = Context.>> (Syntax_Phases.term_check 0 "termify" (K check_termify)); (** evaluation **) diff -r 3374f3ffb2ec -r 85c6c2a1952d src/Pure/Isar/class_declaration.ML --- a/src/Pure/Isar/class_declaration.ML Sun Apr 10 23:15:34 2016 +0200 +++ b/src/Pure/Isar/class_declaration.ML Mon Apr 11 11:48:24 2016 +0200 @@ -107,7 +107,6 @@ fun prep_class_elems prep_decl thy sups raw_elems = let - (* user space type system: only permits 'a type variable, improves towards 'a *) val algebra = Sign.classes_of thy; val inter_sort = curry (Sorts.inter_sort algebra); @@ -118,7 +117,7 @@ val base_constraints = (map o apsnd) (map_type_tfree (K (TVar ((Name.aT, 0), proto_base_sort))) o fst o fst o snd) (Class.these_operations thy sups); - fun singleton_fixateT Ts = + val singleton_fixate = burrow_types (fn Ts => let val tfrees = fold Term.add_tfreesT Ts []; val inferred_sort = @@ -140,9 +139,8 @@ in (map o map_atyps) (fn T as TVar (xi, _) => if Type_Infer.is_param xi then fixateT else T | T => T) Ts - end; - fun singleton_fixate _ ts = burrow_types singleton_fixateT ts; - fun unify_params ctxt ts = + end); + fun unify_params ts = let val param_Ts = (fold o fold_aterms) (fn Free (v, T) => if is_param v then fold_atyps (insert (op =)) T else I | _ => I) ts []; @@ -162,10 +160,10 @@ val init_class_body = fold (Proof_Context.add_const_constraint o apsnd SOME) base_constraints #> Class.redeclare_operations thy sups - #> Context.proof_map (Syntax_Phases.term_check 0 "singleton_fixate" singleton_fixate); + #> Context.proof_map (Syntax_Phases.term_check 0 "singleton_fixate" (K singleton_fixate)); val ((raw_supparams, _, raw_inferred_elems, _), _) = Proof_Context.init_global thy - |> Context.proof_map (Syntax_Phases.term_check 0 "unify_params" unify_params) + |> Context.proof_map (Syntax_Phases.term_check 0 "unify_params" (K unify_params)) |> prep_decl raw_supexpr init_class_body raw_elems; fun filter_element (Element.Fixes []) = NONE | filter_element (e as Element.Fixes _) = SOME e diff -r 3374f3ffb2ec -r 85c6c2a1952d src/Pure/Syntax/syntax_phases.ML --- a/src/Pure/Syntax/syntax_phases.ML Sun Apr 10 23:15:34 2016 +0200 +++ b/src/Pure/Syntax/syntax_phases.ML Mon Apr 11 11:48:24 2016 +0200 @@ -970,18 +970,7 @@ end; -(* standard phases *) - -val _ = Context.>> - (typ_check 0 "standard" Proof_Context.standard_typ_check #> - term_check 0 "standard" - (fn ctxt => Type_Infer_Context.infer_types ctxt #> map (Proof_Context.expand_abbrevs ctxt)) #> - term_check 100 "standard_finish" Proof_Context.standard_term_check_finish #> - term_uncheck 0 "standard" Proof_Context.standard_term_uncheck); - - - -(** install operations **) +(* install operations *) val _ = Theory.setup @@ -1000,3 +989,13 @@ uncheck_terms = uncheck_terms}); end; + + +(* standard phases *) + +val _ = Context.>> + (Syntax_Phases.typ_check 0 "standard" Proof_Context.standard_typ_check #> + Syntax_Phases.term_check 0 "standard" + (fn ctxt => Type_Infer_Context.infer_types ctxt #> map (Proof_Context.expand_abbrevs ctxt)) #> + Syntax_Phases.term_check 100 "standard_finish" Proof_Context.standard_term_check_finish #> + Syntax_Phases.term_uncheck 0 "standard" Proof_Context.standard_term_uncheck);