discontinued separation of `define` and `declare_const`
authorhaftmann
Sun, 08 Aug 2010 20:51:02 +0200
changeset 38248 275064b5ebf9
parent 38247 12d3a5f04a72
child 38249 3925c6b47185
child 38250 b32a44361186
child 38276 3b708c0877ba
discontinued separation of `define` and `declare_const`
src/Pure/Isar/theory_target.ML
--- a/src/Pure/Isar/theory_target.ML	Sun Aug 08 20:41:25 2010 +0200
+++ b/src/Pure/Isar/theory_target.ML	Sun Aug 08 20:51:02 2010 +0200
@@ -274,44 +274,9 @@
 
 fun syntax_error c = error ("Illegal mixfix syntax for overloaded constant " ^ quote c);
 
-fun declare_const (ta as Target {target, is_locale, is_class, ...})
-    extra_tfrees xs ((b, T), mx) lthy =
-  let
-    val type_params = map (Logic.mk_type o TFree) extra_tfrees;
-    val term_params =
-      rev (Variable.fixes_of (Local_Theory.target_of lthy))
-      |> map_filter (fn (_, x) =>
-        (case AList.lookup (op =) xs x of
-          SOME T => SOME (Free (x, T))
-        | NONE => NONE));
-    val params = type_params @ term_params;
-
-    val U = map Term.fastype_of params ---> T;
-    val (mx1, mx2, mx3) = prep_mixfix lthy ta (b, extra_tfrees) mx;
-    val (const, lthy') = lthy |>
-      (case Class_Target.instantiation_param lthy b of
-        SOME c' =>
-          if mx3 <> NoSyn then syntax_error c'
-          else Local_Theory.theory_result (AxClass.declare_overloaded (c', U))
-            ##> Class_Target.confirm_declaration b
-      | NONE =>
-          (case Overloading.operation lthy b of
-            SOME (c', _) =>
-              if mx3 <> NoSyn then syntax_error c'
-              else Local_Theory.theory_result (Overloading.declare (c', U))
-                ##> Overloading.confirm b
-          | NONE => Local_Theory.theory_result (Sign.declare_const ((b, U), mx3))));
-    val t = Term.list_comb (const, params);
-  in
-    lthy'
-    |> is_locale ? syntax_declaration ta false (locale_const ta Syntax.mode_default ((b, mx2), t))
-    |> is_class ? class_target ta (Class_Target.declare target ((b, mx1), (type_params, t)))
-    |> Local_Defs.add_def ((b, NoSyn), t)
-  end;
-
 in
 
-fun define ta ((b, mx), ((name, atts), rhs)) lthy =
+fun define (ta as Target {target, is_locale, is_class, ...}) ((b, mx), ((name, atts), rhs)) lthy =
   let
     val thy = ProofContext.theory_of lthy;
     val thy_ctxt = ProofContext.init_global thy;
@@ -328,12 +293,42 @@
     val extra_tfrees = rev (subtract (op =) tfreesT (Term.add_tfrees rhs []));
 
     (*const*)
-    val ((lhs, local_def), lthy2) = lthy |> declare_const ta extra_tfrees xs ((b, T), mx);
+    val type_params = map (Logic.mk_type o TFree) extra_tfrees;
+    val term_params =
+      rev (Variable.fixes_of (Local_Theory.target_of lthy))
+      |> map_filter (fn (_, x) =>
+        (case AList.lookup (op =) xs x of
+          SOME T => SOME (Free (x, T))
+        | NONE => NONE));
+    val params = type_params @ term_params;
+
+    val U = map Term.fastype_of params ---> T;
+    val (mx1, mx2, mx3) = prep_mixfix lthy ta (b, extra_tfrees) mx;
+
+    val (const, lthy2) = lthy |>
+      (case Class_Target.instantiation_param lthy b of
+        SOME c' =>
+          if mx3 <> NoSyn then syntax_error c'
+          else Local_Theory.theory_result (AxClass.declare_overloaded (c', U))
+            ##> Class_Target.confirm_declaration b
+      | NONE =>
+          (case Overloading.operation lthy b of
+            SOME (c', _) =>
+              if mx3 <> NoSyn then syntax_error c'
+              else Local_Theory.theory_result (Overloading.declare (c', U))
+                ##> Overloading.confirm b
+          | NONE => Local_Theory.theory_result (Sign.declare_const ((b, U), mx3))));
+    val t = Term.list_comb (const, params);
+
+    val ((lhs, local_def), lthy3) = lthy2
+      |> is_locale ? syntax_declaration ta false (locale_const ta Syntax.mode_default ((b, mx2), t))
+      |> is_class ? class_target ta (Class_Target.declare target ((b, mx1), (type_params, t)))
+      |> Local_Defs.add_def ((b, NoSyn), t);
     val (_, lhs') = Logic.dest_equals (Thm.prop_of local_def);
     val Const (head, _) = Term.head_of lhs';
 
     (*def*)
-    val (global_def, lthy3) = lthy2
+    val (global_def, lthy4) = lthy3
       |> Local_Theory.theory_result
         (case Overloading.operation lthy b of
           SOME (_, checked) => Overloading.define checked name' (head, rhs')
@@ -341,15 +336,15 @@
             if is_some (Class_Target.instantiation_param lthy b)
             then AxClass.define_overloaded name' (head, rhs')
             else Thm.add_def false false (name', Logic.mk_equals (lhs', rhs')) #>> snd);
-    val def = Local_Defs.trans_terms lthy3
+    val def = Local_Defs.trans_terms lthy4
       [(*c == global.c xs*)     local_def,
        (*global.c xs == rhs'*)  global_def,
        (*rhs' == rhs*)          Thm.symmetric rhs_conv];
 
     (*note*)
-    val ([(res_name, [res])], lthy4) = lthy3
+    val ([(res_name, [res])], lthy5) = lthy4
       |> notes ta "" [((name', atts), [([def], [])])];
-  in ((lhs, (res_name, res)), lthy4) end;
+  in ((lhs, (res_name, res)), lthy5) end;
 
 end;