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 |