moved fork_mixfix to theory_target
authorhaftmann
Thu, 18 Oct 2007 09:20:59 +0200
changeset 25079db5fdc34f3af
parent 25078 a1ddc5206cb1
child 25080 21d44e3aea4c
moved fork_mixfix to theory_target
src/Pure/Isar/theory_target.ML
     1.1 --- a/src/Pure/Isar/theory_target.ML	Thu Oct 18 09:20:58 2007 +0200
     1.2 +++ b/src/Pure/Isar/theory_target.ML	Thu Oct 18 09:20:59 2007 +0200
     1.3 @@ -161,9 +161,9 @@
     1.4  
     1.5  (* consts *)
     1.6  
     1.7 -fun fork_mixfix false _ mx = (NoSyn, NoSyn, mx)
     1.8 -  | fork_mixfix true false mx = (NoSyn, mx, NoSyn)
     1.9 -  | fork_mixfix true true mx = (mx, NoSyn, NoSyn);
    1.10 +fun fork_mixfix false _ mx = ((NoSyn, NoSyn), mx)
    1.11 +  | fork_mixfix true false mx = ((NoSyn, mx), NoSyn)
    1.12 +  | fork_mixfix true true mx = ((mx, NoSyn), NoSyn);
    1.13  
    1.14  fun locale_const (prmode as (mode, _)) pos ((c, mx), rhs) phi =
    1.15    let
    1.16 @@ -190,21 +190,22 @@
    1.17      fun const ((c, T), mx) thy =
    1.18        let
    1.19          val U = map #2 xs ---> T;
    1.20 -        val (mx1, mx2, mx3) = fork_mixfix is_locale is_class mx;
    1.21 +        val (mx12, mx3) = fork_mixfix is_locale is_class mx;
    1.22          val (const, thy') = Sign.declare_const pos (c, U, mx3) thy;
    1.23          val t = Term.list_comb (const, map Free xs);
    1.24 -      in (((c, mx2), t), thy') end;
    1.25 -    fun class_const ((c, _), mx) (_, t) =
    1.26 -      LocalTheory.raw_theory_result (Class.add_const_in_class target ((c, mx), t))
    1.27 +      in (((c, mx12), t), thy') end;
    1.28 +    fun class_const ((c, _), _) ((_, (mx1, _)), t) =
    1.29 +      LocalTheory.raw_theory_result (Class.add_const_in_class target ((c, mx1), t))
    1.30        #-> LocalTheory.target o Class.remove_constraint target;
    1.31  
    1.32      val (abbrs, lthy') = lthy
    1.33        |> LocalTheory.theory_result (fold_map const decls)
    1.34 +    val abbrs' = (map o apfst o apsnd) snd abbrs;
    1.35    in
    1.36      lthy'
    1.37 -    |> is_locale ? fold (term_syntax ta o locale_const Syntax.mode_default pos) abbrs
    1.38 +    |> is_locale ? fold (term_syntax ta o locale_const Syntax.mode_default pos) abbrs'
    1.39      |> is_class ? fold2 class_const decls abbrs
    1.40 -    |> fold_map (apfst (apsnd snd) oo LocalDefs.add_def) abbrs
    1.41 +    |> fold_map (apfst (apsnd snd) oo LocalDefs.add_def) abbrs'
    1.42    end;
    1.43  
    1.44  
    1.45 @@ -233,7 +234,7 @@
    1.46      val t = Morphism.term target_morphism raw_t;
    1.47  
    1.48      val xs = map Free (rev (Variable.add_fixed target_ctxt t []));
    1.49 -    val (mx1, mx2, mx3) = fork_mixfix is_locale is_class mx;
    1.50 +    val ((mx1, mx2), mx3) = fork_mixfix is_locale is_class mx;
    1.51  
    1.52      val global_rhs =
    1.53        singleton (Variable.export_terms (Variable.declare_term t target_ctxt) thy_ctxt)