src/Pure/Proof/reconstruct.ML
changeset 30146 a77fc0209723
parent 29635 31d14e9fa0da
child 30190 479806475f3c
equal deleted inserted replaced
30145:09817540ccae 30146:a77fc0209723
    96           Type ("fun", [U', V]) => (t' $ u', V, vTs2, unifyT thy env2 U U')
    96           Type ("fun", [U', V]) => (t' $ u', V, vTs2, unifyT thy env2 U U')
    97         | _ =>
    97         | _ =>
    98           let val (env3, V) = mk_tvar (env2, [])
    98           let val (env3, V) = mk_tvar (env2, [])
    99           in (t' $ u', V, vTs2, unifyT thy env3 T (U --> V)) end)
    99           in (t' $ u', V, vTs2, unifyT thy env3 T (U --> V)) end)
   100       end
   100       end
   101   | infer_type thy env Ts vTs (t as Bound i) = ((t, List.nth (Ts, i), vTs, env)
   101   | infer_type thy env Ts vTs (t as Bound i) = ((t, nth Ts i, vTs, env)
   102       handle Subscript => error ("infer_type: bad variable index " ^ string_of_int i));
   102       handle Subscript => error ("infer_type: bad variable index " ^ string_of_int i));
   103 
   103 
   104 fun cantunify thy (t, u) = error ("Non-unifiable terms:\n" ^
   104 fun cantunify thy (t, u) = error ("Non-unifiable terms:\n" ^
   105   Syntax.string_of_term_global thy t ^ "\n\n" ^ Syntax.string_of_term_global thy u);
   105   Syntax.string_of_term_global thy t ^ "\n\n" ^ Syntax.string_of_term_global thy u);
   106 
   106 
   150           in (prop', change_type (SOME Ts) prf, [], env', vTs) end;
   150           in (prop', change_type (SOME Ts) prf, [], env', vTs) end;
   151 
   151 
   152     fun head_norm (prop, prf, cnstrts, env, vTs) =
   152     fun head_norm (prop, prf, cnstrts, env, vTs) =
   153       (Envir.head_norm env prop, prf, cnstrts, env, vTs);
   153       (Envir.head_norm env prop, prf, cnstrts, env, vTs);
   154 
   154 
   155     fun mk_cnstrts env _ Hs vTs (PBound i) = ((List.nth (Hs, i), PBound i, [], env, vTs)
   155     fun mk_cnstrts env _ Hs vTs (PBound i) = ((nth Hs i, PBound i, [], env, vTs)
   156           handle Subscript => error ("mk_cnstrts: bad variable index " ^ string_of_int i))
   156           handle Subscript => error ("mk_cnstrts: bad variable index " ^ string_of_int i))
   157       | mk_cnstrts env Ts Hs vTs (Abst (s, opT, cprf)) =
   157       | mk_cnstrts env Ts Hs vTs (Abst (s, opT, cprf)) =
   158           let
   158           let
   159             val (env', T) = (case opT of
   159             val (env', T) = (case opT of
   160               NONE => mk_tvar (env, []) | SOME T => (env, T));
   160               NONE => mk_tvar (env, []) | SOME T => (env, T));
   302   (map TVar (OldTerm.term_tvars prop) @ map TFree (OldTerm.term_tfrees prop) ~~ Ts)
   302   (map TVar (OldTerm.term_tvars prop) @ map TFree (OldTerm.term_tfrees prop) ~~ Ts)
   303   (forall_intr_vfs prop);
   303   (forall_intr_vfs prop);
   304 
   304 
   305 val head_norm = Envir.head_norm (Envir.empty 0);
   305 val head_norm = Envir.head_norm (Envir.empty 0);
   306 
   306 
   307 fun prop_of0 Hs (PBound i) = List.nth (Hs, i)
   307 fun prop_of0 Hs (PBound i) = nth Hs i
   308   | prop_of0 Hs (Abst (s, SOME T, prf)) =
   308   | prop_of0 Hs (Abst (s, SOME T, prf)) =
   309       Term.all T $ (Abs (s, T, prop_of0 Hs prf))
   309       Term.all T $ (Abs (s, T, prop_of0 Hs prf))
   310   | prop_of0 Hs (AbsP (s, SOME t, prf)) =
   310   | prop_of0 Hs (AbsP (s, SOME t, prf)) =
   311       Logic.mk_implies (t, prop_of0 (t :: Hs) prf)
   311       Logic.mk_implies (t, prop_of0 (t :: Hs) prf)
   312   | prop_of0 Hs (prf % SOME t) = (case head_norm (prop_of0 Hs prf) of
   312   | prop_of0 Hs (prf % SOME t) = (case head_norm (prop_of0 Hs prf) of