1 2open HolKernel Parse boolLib bossLib; val _ = new_theory "milawa_proofp"; 3 4open lisp_sexpTheory lisp_semanticsTheory lisp_extractTheory; 5open milawa_defsTheory milawa_logicTheory milawa_execTheory; 6 7open arithmeticTheory listTheory pred_setTheory finite_mapTheory combinTheory; 8open pairTheory; 9 10infix \\ 11val op \\ = op THEN; 12 13 14val rw = ref (tl [TRUTH]); 15 16fun add_rw th = (rw := th::(!rw); th); 17fun add_rws thms = (rw := thms @ (!rw)); 18val add_prove = add_rw o prove 19 20val LISP_TEST_THM = prove( 21 ``!b. (isTrue (LISP_TEST b) = b) /\ 22 ((LISP_TEST b = Sym "NIL") = ~b) /\ ((LISP_TEST b = Sym "T") = b)``, 23 Cases \\ FULL_SIMP_TAC std_ss [] \\ EVAL_TAC); 24 25val _ = add_rws [isTrue_CLAUSES, 26 CDR_def,CAR_def,getVal_def,SExp_11,SExp_distinct, 27 isDot_def,isVal_def,isSym_def,LISP_ADD_def,LISP_SUB_def,list2sexp_def,MEM, 28 EVAL ``LISP_TEST F``,EVAL ``LISP_TEST T``,LISP_CONS_def,LISP_TEST_THM, 29 FIRST_def,SECOND_def, 30 THIRD_def,FOURTH_def, 31 FIFTH_def,NOT_CONS_NIL] 32 33fun SS thms = SIMP_TAC std_ss (thms @ !rw) 34fun FS thms = FULL_SIMP_TAC std_ss (thms @ !rw) 35fun SR thms = SIMP_RULE std_ss (thms @ !rw) 36 37 38(* various auxilliary functions *) 39 40val alist2sexp_def = (add_rw o Define) ` 41 (alist2sexp [] = Sym "NIL") /\ 42 (alist2sexp ((x,y)::xs) = Dot (Dot x y) (alist2sexp xs))`; 43 44val isTrue_not = add_prove( 45 ``!x. isTrue (not x) = ~(isTrue x)``, 46 SIMP_TAC std_ss [not_def] \\ REPEAT STRIP_TAC 47 \\ Cases_on `isTrue x` \\ ASM_SIMP_TAC std_ss [] \\ EVAL_TAC); 48 49val nfix_thm = add_prove( 50 ``!x. nfix x = Val (getVal x)``, 51 Cases \\ EVAL_TAC); 52 53val less_eq_thm = add_prove( 54 ``!x y. less_eq x y = LISP_TEST (getVal x <= getVal y)``, 55 Cases \\ Cases \\ EVAL_TAC \\ SIMP_TAC std_ss [GSYM NOT_LESS] 56 \\ Cases_on `0 < n` \\ ASM_SIMP_TAC std_ss [DECIDE ``(n = 0) = ~(0<n:num)``] 57 \\ Cases_on `n'<n` \\ FULL_SIMP_TAC std_ss []); 58 59val len_thm = add_prove( 60 ``!xs. len (list2sexp xs) = Val (LENGTH xs)``, 61 Induct THEN1 EVAL_TAC 62 \\ SIMP_TAC std_ss [list2sexp_def] 63 \\ ONCE_REWRITE_TAC [len_def] 64 \\ FS [LENGTH,ADD1,AC ADD_COMM ADD_ASSOC]); 65 66val memberp_thm = add_prove( 67 ``!xs a. memberp a (list2sexp xs) = LISP_TEST (MEM a xs)``, 68 Induct \\ ONCE_REWRITE_TAC [memberp_def] \\ FS [] 69 \\ SRW_TAC [] [LISP_EQUAL_def] \\ FS []); 70 71val uniquep_thm = add_prove( 72 ``!xs. uniquep (list2sexp xs) = LISP_TEST (ALL_DISTINCT xs)``, 73 Induct \\ ONCE_REWRITE_TAC [uniquep_def] \\ FS [ALL_DISTINCT] 74 \\ STRIP_TAC \\ Cases_on `MEM h xs` \\ FS []); 75 76val list_fix_thm = add_prove( 77 ``!xs. list_fix (list2sexp xs) = list2sexp xs``, 78 Induct \\ ONCE_REWRITE_TAC [list_fix_def] \\ FS []); 79 80val app_thm = add_prove( 81 ``!xs ys. app (list2sexp xs) (list2sexp ys) = list2sexp (xs ++ ys)``, 82 Induct \\ ONCE_REWRITE_TAC [app_def] \\ FS [APPEND]); 83 84val rev_thm = add_prove( 85 ``!xs. rev (list2sexp xs) = list2sexp (REVERSE xs)``, 86 Induct \\ ONCE_REWRITE_TAC [rev_def] \\ FS [REVERSE_DEF] 87 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,app_thm]); 88 89val true_listp_thm = add_prove( 90 ``!xs. true_listp (list2sexp xs) = Sym "T"``, 91 Induct \\ ONCE_REWRITE_TAC [true_listp_def] \\ FS [LISP_EQUAL_def]); 92 93val isTrue_true_listp = add_prove( 94 ``!x. isTrue (true_listp x) = ?xs. x = list2sexp xs``, 95 REVERSE (REPEAT STRIP_TAC \\ EQ_TAC) THEN1 (REPEAT STRIP_TAC \\ FS []) 96 \\ REVERSE (Induct_on `x`) \\ ONCE_REWRITE_TAC [true_listp_def] \\ FS [] 97 THEN1 (Q.EXISTS_TAC `[]` \\ FS []) 98 \\ REPEAT STRIP_TAC \\ RES_TAC 99 \\ Q.EXISTS_TAC `x::xs` \\ EVAL_TAC \\ FULL_SIMP_TAC std_ss []); 100 101val isTrue_zp = add_prove( 102 ``!x. isTrue (zp x) = (getVal x = 0)``, 103 Cases \\ EVAL_TAC \\ SRW_TAC [] []); 104 105val subset_thm = add_prove( 106 ``!xs ys. subsetp (list2sexp xs) (list2sexp ys) = 107 LISP_TEST (set xs SUBSET set ys)``, 108 Induct \\ ONCE_REWRITE_TAC [subsetp_def] 109 \\ FS [LIST_TO_SET_THM,EMPTY_SUBSET,INSERT_SUBSET] \\ REPEAT STRIP_TAC 110 \\ Cases_on `MEM h ys` \\ FS []); 111 112val list_exists_def = Define ` 113 list_exists n x = ?xs. (LENGTH xs = n) /\ (x = list2sexp xs)`; 114 115val tuplep_thm = add_prove( 116 ``!x n. tuplep n x = LISP_TEST (list_exists (getVal n) x)``, 117 SIMP_TAC std_ss [list_exists_def] 118 \\ Induct_on `getVal n` \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 119 \\ ONCE_REWRITE_TAC [tuplep_def] \\ FS [LENGTH_NIL,LISP_EQUAL_def,ADD1] 120 \\ REPEAT STRIP_TAC \\ Cases_on `isDot x` \\ FS [] THEN1 121 (AP_TERM_TAC \\ FS [isDot_thm] \\ EQ_TAC \\ REPEAT STRIP_TAC 122 THEN1 (Cases_on `xs` \\ FS [LENGTH,ADD1] \\ Q.EXISTS_TAC `t` \\ FS [LENGTH]) 123 THEN1 (Q.EXISTS_TAC `a::xs` \\ FS [LENGTH,ADD1])) 124 \\ CCONTR_TAC \\ FS [] \\ Cases_on `xs` \\ FS [LENGTH]); 125 126val tuple_listp_thm = add_prove( 127 ``!xs n. tuple_listp n (list2sexp xs) = 128 LISP_TEST (EVERY (list_exists (getVal n)) xs)``, 129 Induct \\ ONCE_REWRITE_TAC [tuple_listp_def] \\ FS [EVERY_DEF] 130 \\ REPEAT STRIP_TAC \\ Cases_on `list_exists (getVal n) h` \\ FS []); 131 132val list_exists_simp = add_prove( 133 ``(list_exists n (Val k) = F) /\ 134 (list_exists n (Sym s) = (n = 0) /\ (s = "NIL")) /\ 135 (list_exists n (Dot x y) = list_exists (n-1) y /\ 0 < n)``, 136 SIMP_TAC std_ss [list_exists_def] 137 \\ REPEAT STRIP_TAC \\ REPEAT EQ_TAC \\ REPEAT STRIP_TAC 138 THEN1 (Cases_on `xs` \\ FS [LENGTH]) 139 THEN1 (Cases_on `xs` \\ FS [LENGTH]) 140 THEN1 (Cases_on `xs` \\ FS [LENGTH]) 141 THEN1 (FS [LENGTH_NIL]) 142 THEN1 (Cases_on `xs` \\ FS [LENGTH] \\ Q.EXISTS_TAC `t` \\ FS [] \\ DECIDE_TAC) 143 THEN1 (Cases_on `xs` \\ FS [LENGTH] \\ DECIDE_TAC) 144 THEN1 (Q.EXISTS_TAC `x::xs` \\ FS [LENGTH] \\ DECIDE_TAC)); 145 146val remove_all_thm = add_prove( 147 ``!xs a. remove_all a (list2sexp xs) = list2sexp (FILTER (\x. ~(x = a)) xs)``, 148 Induct \\ ONCE_REWRITE_TAC [remove_all_def] \\ FS [FILTER] 149 \\ REPEAT STRIP_TAC \\ Cases_on `h = a` \\ FS []); 150 151val remove_duplicates_thm = add_prove( 152 ``!xs. remove_duplicates (list2sexp xs) = 153 list2sexp (REMOVE_DUPLICATES xs)``, 154 Induct \\ ONCE_REWRITE_TAC [remove_duplicates_def] 155 \\ FS [REMOVE_DUPLICATES_def] \\ Cases_on `MEM h xs` \\ FS []); 156 157val difference_thm = add_prove( 158 ``!xs ys. difference (list2sexp xs) (list2sexp ys) = 159 list2sexp (FILTER (\x. ~MEM x ys) xs)``, 160 Induct \\ ONCE_REWRITE_TAC [difference_def] \\ FS [FILTER] 161 \\ REPEAT STRIP_TAC \\ Cases_on `MEM h ys` \\ FS []); 162 163val strip_firsts_thm = add_prove( 164 ``!xs. strip_firsts (list2sexp xs) = list2sexp (MAP CAR xs)``, 165 Induct \\ ONCE_REWRITE_TAC [strip_firsts_def] \\ FS [MAP]); 166 167val strip_seconds_thm = add_prove( 168 ``!xs. strip_seconds (list2sexp xs) = list2sexp (MAP (CAR o CDR) xs)``, 169 Induct \\ ONCE_REWRITE_TAC [strip_seconds_def] \\ FS [MAP]); 170 171val CONS_ZIP_def = Define ` 172 (CONS_ZIP [] [] = []) /\ 173 (CONS_ZIP [] (y::ys) = []) /\ 174 (CONS_ZIP (x::xs) [] = (LISP_CONS x (Sym "NIL")) :: CONS_ZIP xs []) /\ 175 (CONS_ZIP (x::xs) (y::ys) = (LISP_CONS x y) :: CONS_ZIP xs ys)`; 176 177val pair_lists_thm = add_prove( 178 ``!xs ys. pair_lists (list2sexp xs) (list2sexp ys) = list2sexp (CONS_ZIP xs ys)``, 179 Induct \\ Cases_on `ys` \\ ONCE_REWRITE_TAC [pair_lists_def] \\ FS [CONS_ZIP_def] 180 \\ ASM_SIMP_TAC std_ss [GSYM list2sexp_def]); 181 182val GENLIST_CONS = prove( 183 ``!n. GENLIST (K x) (SUC n) = x::GENLIST (K x) n``, 184 Induct \\ SRW_TAC [] [] \\ FULL_SIMP_TAC std_ss [GENLIST] 185 \\ FULL_SIMP_TAC std_ss [SNOC_APPEND,APPEND]); 186 187val repeat_thm = add_prove( 188 ``!a n. repeat a n = list2sexp (GENLIST (K a) (getVal n))``, 189 Induct_on `getVal n` 190 \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] \\ ASM_SIMP_TAC std_ss [] 191 \\ ONCE_REWRITE_TAC [repeat_def] THEN1 (FS [GENLIST]) 192 \\ FS [GENLIST_CONS,ADD1]); 193 194val string_le = prove( 195 ``!s t. s <= t = ~(t < (s:string))``, 196 FULL_SIMP_TAC std_ss [stringTheory.string_le_def] \\ REPEAT STRIP_TAC 197 \\ METIS_TAC [stringTheory.string_lt_cases,stringTheory.string_lt_antisym, 198 stringTheory.string_lt_nonrefl]); 199 200val sort_symbols_insert_thm = add_prove( 201 ``!xs a. sort_symbols_insert a (list2sexp xs) = 202 list2sexp (ISORT_INSERT (\x y. getSym x <= getSym y) a xs)``, 203 Induct \\ ONCE_REWRITE_TAC [sort_symbols_insert_def] 204 \\ FS [ISORT_INSERT_def,LISP_SYMBOL_LESS_def,string_le] 205 \\ REPEAT STRIP_TAC \\ Cases_on `getSym a < getSym h` \\ FS []); 206 207val sort_symbols_thm = add_prove( 208 ``!xs. sort_symbols (list2sexp xs) = 209 list2sexp (ISORT (\x y. getSym x <= getSym y) xs)``, 210 Induct \\ ONCE_REWRITE_TAC [sort_symbols_def] \\ FS [ISORT_def]); 211 212val LOOKUP_DOT_def = Define ` 213 (LOOKUP_DOT a [] = Sym "NIL") /\ 214 (LOOKUP_DOT a ((x,y)::xs) = if a = x then Dot x y else LOOKUP_DOT a xs)`; 215 216val lookup_thm = add_prove( 217 ``!xs a. lookup a (alist2sexp xs) = LOOKUP_DOT a xs``, 218 Induct \\ ONCE_REWRITE_TAC [milawa_defsTheory.lookup_def] \\ FS [LOOKUP_DOT_def] 219 \\ Cases \\ FS [LOOKUP_DOT_def]); 220 221val MEM_IMP_INDEX_OF = prove( 222 ``!xs y n. MEM y xs ==> 223 ?k. (milawa_exec$INDEX_OF n y xs = SOME (n+k)) /\ (EL k xs = y)``, 224 Induct \\ SIMP_TAC std_ss [MEM,milawa_execTheory.INDEX_OF_def] 225 \\ NTAC 3 STRIP_TAC 226 \\ Cases_on `y = h` \\ FULL_SIMP_TAC std_ss [] \\ REPEAT STRIP_TAC 227 THEN1 (Q.EXISTS_TAC `0` \\ FULL_SIMP_TAC std_ss [EL,HD]) 228 \\ RES_TAC \\ POP_ASSUM (STRIP_ASSUME_TAC o Q.SPEC `n+1`) 229 \\ Q.EXISTS_TAC `k+1` \\ ASM_SIMP_TAC std_ss [EL,GSYM ADD1,TL] \\ DECIDE_TAC); 230 231val bad_names_tm = 232 ``["NIL"; "QUOTE"; "CONS"; "EQUAL"; "<"; "SYMBOL-<"; "+"; "-"; "CONSP"; 233 "NATP"; "SYMBOLP"; "CAR"; "CDR"; "NOT"; "RANK"; "IF"; "ORDP"; "ORD<"]`` 234 235val logic_func2sexp_11 = add_prove( 236 ``((logic_func2sexp x = logic_func2sexp y) = (x = y)) /\ 237 ~(logic_func2sexp x = Sym "QUOTE") /\ 238 ~(logic_func2sexp x = Sym "NIL")``, 239 REVERSE STRIP_TAC THEN1 240 (Cases_on `x` THEN1 (Cases_on `l` \\ EVAL_TAC) 241 \\ SIMP_TAC (srw_ss()) [logic_func2sexp_def,isSym_def] 242 \\ SRW_TAC [] [] \\ FULL_SIMP_TAC std_ss []) 243 \\ Cases_on `x` \\ Cases_on `y` 244 THEN1 (Cases_on `l` \\ Cases_on `l'` \\ EVAL_TAC \\ SRW_TAC [] []) 245 THEN1 (Cases_on `l` \\ SRW_TAC [] [logic_func2sexp_def,logic_prim2sym_def] 246 \\ FULL_SIMP_TAC std_ss []) 247 THEN1 (Cases_on `l` \\ SRW_TAC [] [logic_func2sexp_def,logic_prim2sym_def] 248 \\ FULL_SIMP_TAC std_ss []) 249 \\ SIMP_TAC std_ss [logic_func2sexp_def] 250 \\ Cases_on `MEM s ^bad_names_tm` \\ Cases_on `MEM s' ^bad_names_tm` 251 \\ FULL_SIMP_TAC std_ss [SExp_11,SExp_distinct,logic_func_11,logic_func_distinct] 252 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 253 \\ IMP_RES_TAC (Q.SPECL [`xs`,`x`,`0`] MEM_IMP_INDEX_OF) 254 \\ FULL_SIMP_TAC std_ss [] 255 \\ REPEAT STRIP_TAC \\ EQ_TAC \\ REPEAT STRIP_TAC 256 \\ FULL_SIMP_TAC std_ss []); 257 258val func_syntax_ok_def = Define ` 259 (func_syntax_ok (mPrimitiveFun p) = T) /\ 260 (func_syntax_ok (mFun f) = ~(MEM f ["NIL"; "QUOTE"; "PEQUAL*"; 261 "PNOT*"; "POR*"; "FIRST"; "SECOND"; "THIRD"; "FOURTH"; 262 "FIFTH"; "AND"; "OR"; "LIST"; "COND"; "LET"; "LET*"; "CONS"; 263 "EQUAL"; "<"; "SYMBOL-<"; "+"; "-"; "CONSP"; "NATP"; "SYMBOLP"; 264 "CAR"; "CDR"; "NOT"; "RANK"; "IF"; "ORDP"; "ORD<" ]))`; 265 266val var_ok_def = Define ` 267 var_ok x = ~(x = "NIL") /\ ~(x = "T")`; 268 269val term_syntax_ok_def = tDefine "term_syntax_ok" ` 270 (term_syntax_ok (mConst s) = T) /\ 271 (term_syntax_ok (mVar v) = ~(MEM v ["NIL";"T"])) /\ 272 (term_syntax_ok (mApp fc vs) = func_syntax_ok fc /\ EVERY (term_syntax_ok) vs) /\ 273 (term_syntax_ok (mLamApp xs y zs) = 274 (LIST_TO_SET (free_vars y) SUBSET LIST_TO_SET xs) /\ ALL_DISTINCT xs /\ 275 EVERY var_ok xs /\ 276 EVERY (term_syntax_ok) zs /\ term_syntax_ok y /\ (LENGTH xs = LENGTH zs))` 277 (WF_REL_TAC `measure (logic_term_size)` \\ SRW_TAC [] [] THEN1 DECIDE_TAC 278 THEN1 (Induct_on `vs` \\ SRW_TAC [] [MEM,logic_term_size_def] \\ RES_TAC \\ DECIDE_TAC) 279 THEN1 (Induct_on `zs` \\ SRW_TAC [] [MEM,logic_term_size_def] \\ RES_TAC \\ DECIDE_TAC) 280 \\ DECIDE_TAC); 281 282val formula_syntax_ok_def = Define ` 283 (formula_syntax_ok (Not x) = formula_syntax_ok x) /\ 284 (formula_syntax_ok (Or x y) = formula_syntax_ok x /\ formula_syntax_ok y) /\ 285 (formula_syntax_ok (Equal t1 t2) = term_syntax_ok t1 /\ term_syntax_ok t2)`; 286 287val logic_flag_term_vars_Dot = 288 ``logic_flag_term_vars (Sym "LIST") (Dot x y) acc`` 289 |> ONCE_REWRITE_CONV [logic_flag_term_vars_def] 290 |> SIMP_RULE (srw_ss()) [isTrue_CLAUSES,isDot_def,CDR_def,CAR_def] 291 292val logic_flag_term_vars_Sym = 293 ``logic_flag_term_vars (Sym "LIST") (Sym s) acc`` 294 |> ONCE_REWRITE_CONV [logic_flag_term_vars_def] 295 |> SIMP_RULE (srw_ss()) [isTrue_CLAUSES,isDot_def,CDR_def,CAR_def] 296 297val PULL_FORALL_IMP = METIS_PROVE [] ``(p ==> !x. q x) = !x. p ==> q x``; 298 299val _ = add_rw (EVAL ``"LIST" = "TERM"``); 300val _ = add_rw (EVAL ``"TERM" = "LIST"``); 301val _ = add_rw (EVAL ``isTrue (Sym "NIL")``); 302val _ = add_rw (ETA_THM); 303 304val term_vars_ok_def = tDefine "term_vars_ok" ` 305 (term_vars_ok (mConst s) = T) /\ 306 (term_vars_ok (mVar v) = ~(MEM v ["NIL";"T"])) /\ 307 (term_vars_ok (mApp fc vs) = ~(fc = mFun "QUOTE") /\ EVERY (term_vars_ok) vs) /\ 308 (term_vars_ok (mLamApp xs y zs) = 309 EVERY (term_vars_ok) zs /\ term_vars_ok y)` 310 (WF_REL_TAC `measure (logic_term_size)` \\ SRW_TAC [] [] THEN1 DECIDE_TAC 311 THEN1 (Induct_on `vs` \\ SRW_TAC [] [MEM,logic_term_size_def] \\ RES_TAC \\ DECIDE_TAC) 312 THEN1 (Induct_on `zs` \\ SRW_TAC [] [MEM,logic_term_size_def] \\ RES_TAC \\ DECIDE_TAC) 313 \\ DECIDE_TAC); 314 315val logic_flag_term_vars_TERM = prove( 316 ``logic_flag_term_vars (Sym "LIST") (Dot (t2sexp l) (Sym "NIL")) acc = 317 logic_flag_term_vars (Sym "TERM") (t2sexp l) acc``, 318 SIMP_TAC std_ss [Once logic_flag_term_vars_def] 319 \\ FS [EVAL ``logic_flag_term_vars (Sym "LIST") (Sym "NIL") acc``]); 320 321val logic_func2sexp_NOT_EQAL_NIL = add_prove( 322 ``LISP_EQUAL (logic_func2sexp l0) (Sym "QUOTE") = Sym "NIL"``, 323 FS [LISP_EQUAL_def]); 324 325val logic_flag_term_vars_thm = prove( 326 ``!l acc. 327 EVERY term_vars_ok l ==> 328 (logic_flag_term_vars (Sym "LIST") (list2sexp (MAP t2sexp l)) (list2sexp (MAP Sym acc)) = 329 list2sexp (MAP Sym ((FLAT (MAP (\a. free_vars a) l)) ++ acc)))``, 330 STRIP_TAC \\ completeInduct_on `logic_term1_size l` \\ REPEAT STRIP_TAC 331 \\ FS [PULL_FORALL_IMP] \\ Cases_on `l` 332 \\ ONCE_REWRITE_TAC [logic_flag_term_vars_def] 333 \\ FS [t2sexp_def,list2sexp_def,logic_constantp_def,free_vars_def, 334 REVERSE_DEF,APPEND,MAP,FLAT,REVERSE_DEF,EVERY_DEF] 335 \\ `logic_term1_size t < logic_term1_size (h::t)` by (EVAL_TAC \\ DECIDE_TAC) 336 \\ ASM_SIMP_TAC std_ss [] 337 \\ Cases_on `h` THEN1 338 (ONCE_REWRITE_TAC [logic_flag_term_vars_def] 339 \\ FS [t2sexp_def,list2sexp_def,logic_constantp_def,free_vars_def, 340 APPEND]) 341 THEN1 342 (ONCE_REWRITE_TAC [logic_flag_term_vars_def] 343 \\ FS [t2sexp_def,list2sexp_def,logic_constantp_def,free_vars_def, 344 logic_variablep_def,APPEND,term_vars_ok_def,MAP,MAP_APPEND]) 345 THEN1 346 (ONCE_REWRITE_TAC [logic_flag_term_vars_def] 347 \\ FS [t2sexp_def,list2sexp_def,logic_constantp_def,free_vars_def, 348 logic_variablep_def,APPEND,term_vars_ok_def,MAP,MAP_APPEND] 349 \\ FS [logic_term_size_def] 350 \\ `logic_term1_size l < 351 1 + (1 + (logic_func_size l0 + logic_term1_size l) + logic_term1_size t)` 352 by DECIDE_TAC 353 \\ `(\a. term_vars_ok a) = term_vars_ok` by FULL_SIMP_TAC std_ss [FUN_EQ_THM] 354 \\ `(\a. t2sexp a) = t2sexp` by FULL_SIMP_TAC std_ss [FUN_EQ_THM] 355 \\ FS [] \\ RES_TAC \\ FS [GSYM MAP_APPEND] \\ FS [APPEND_ASSOC]) 356 THEN1 357 (ONCE_REWRITE_TAC [logic_flag_term_vars_def] 358 \\ FS [t2sexp_def,list2sexp_def,logic_constantp_def,free_vars_def, 359 REVERSE_DEF,logic_variablep_def,APPEND,term_vars_ok_def,MAP, 360 logic_flag_term_vars_Dot,logic_flag_term_vars_Sym,REVERSE_APPEND, 361 APPEND_ASSOC] \\ FS [LISP_EQUAL_def] 362 \\ `(\a. term_vars_ok a) = term_vars_ok` by FULL_SIMP_TAC std_ss [FUN_EQ_THM] 363 \\ `(\a. t2sexp a) = t2sexp` by FULL_SIMP_TAC std_ss [FUN_EQ_THM] 364 \\ `logic_term1_size l0 < logic_term1_size (mLamApp l1 l l0::t)` by 365 (FS [logic_term_size_def] \\ DECIDE_TAC) 366 \\ FS [APPEND_ASSOC])); 367 368val IMP_IMP = METIS_PROVE [] ``b1 /\ (b2 ==> b3) ==> ((b1 ==> b2) ==> b3)``; 369 370val MEM_logic_term_size = prove( 371 ``!xs x. MEM x xs ==> logic_term_size x < logic_term1_size xs``, 372 Induct \\ SIMP_TAC std_ss [MEM] \\ NTAC 2 STRIP_TAC 373 \\ Cases_on `x = h` \\ FULL_SIMP_TAC std_ss [EVERY_DEF,logic_term_size_def] 374 \\ REPEAT STRIP_TAC \\ RES_TAC \\ DECIDE_TAC); 375 376val syntax_ok_IMP_vars_ok = add_prove( 377 ``!t. term_syntax_ok t ==> term_vars_ok t``, 378 STRIP_TAC \\ completeInduct_on `logic_term_size t` \\ REPEAT STRIP_TAC 379 \\ Cases_on `t` \\ FS [PULL_FORALL_IMP] 380 \\ FS [term_syntax_ok_def,term_vars_ok_def] 381 \\ REPEAT STRIP_TAC \\ FS [func_syntax_ok_def] 382 \\ FS [EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC THEN1 383 (Q.PAT_X_ASSUM `!t.bbb ==> b2 ==> b3` (MP_TAC o Q.SPEC `e`) 384 \\ MATCH_MP_TAC IMP_IMP \\ FS [] 385 \\ EVAL_TAC \\ IMP_RES_TAC MEM_logic_term_size \\ DECIDE_TAC) THEN1 386 (Q.PAT_X_ASSUM `!t.bbb ==> b2 ==> b3` (MP_TAC o Q.SPEC `e`) 387 \\ MATCH_MP_TAC IMP_IMP \\ FS [] 388 \\ EVAL_TAC \\ IMP_RES_TAC MEM_logic_term_size \\ DECIDE_TAC) THEN1 389 (Q.PAT_X_ASSUM `!t.bbb ==> b2 ==> b3` (MP_TAC o Q.SPEC `l`) 390 \\ MATCH_MP_TAC IMP_IMP \\ FS [] 391 \\ EVAL_TAC \\ IMP_RES_TAC MEM_logic_term_size \\ DECIDE_TAC)); 392 393val logic_term_vars_raw_thm = add_prove( 394 ``!x. term_vars_ok x ==> 395 (logic_term_vars (t2sexp x) = list2sexp (MAP Sym (free_vars x)))``, 396 SIMP_TAC std_ss [logic_term_vars_def,GSYM logic_flag_term_vars_TERM] 397 \\ REPEAT STRIP_TAC \\ MP_TAC (Q.SPECL [`[x]`,`[]`] logic_flag_term_vars_thm) 398 \\ FS [EVERY_DEF,MAP,FLAT,APPEND_NIL]); 399 400val logic_term_vars_thm = add_prove( 401 ``!x. term_syntax_ok x ==> 402 (logic_term_vars (t2sexp x) = list2sexp (MAP Sym (free_vars x)))``, 403 SIMP_TAC std_ss [logic_term_vars_raw_thm,syntax_ok_IMP_vars_ok]); 404 405val LIST_LSIZE_def = Define ` 406 (LIST_LSIZE [] = 0) /\ 407 (LIST_LSIZE (x::xs) = 1 + LSIZE x + LIST_LSIZE xs)`; 408 409val lisp2sexp_11 = add_prove( 410 ``!xs ys. (list2sexp xs = list2sexp ys) = (xs = ys)``, 411 Induct \\ Cases_on `ys` \\ FS [NOT_CONS_NIL,CONS_11]); 412 413val LIST_LSIZE_LESS_EQ = prove( 414 ``!xs. LIST_LSIZE xs <= LSIZE (list2sexp xs)``, 415 Induct \\ EVAL_TAC \\ DECIDE_TAC); 416 417val logic_variable_listp_IMP = prove( 418 ``!xs. isTrue (logic_variable_listp (list2sexp xs)) ==> 419 ?zs. (xs = MAP Sym zs) /\ EVERY var_ok zs``, 420 Induct \\ ONCE_REWRITE_TAC [logic_variable_listp_def] 421 THEN1 (FS [logic_variablep_def] \\ METIS_TAC [MAP,EVERY_DEF]) 422 \\ FS [logic_variablep_def,EVERY_DEF] \\ SRW_TAC [] [] \\ FS [] 423 \\ Cases_on `isSym h` \\ FS [] 424 \\ FULL_SIMP_TAC std_ss [isSym_thm] 425 \\ Q.EXISTS_TAC `a::zs` \\ FS [MAP,EVERY_DEF] 426 \\ FULL_SIMP_TAC std_ss [var_ok_def] \\ REPEAT STRIP_TAC 427 \\ FS [NOT_CONS_NIL,CONS_11]); 428 429val IMP_IMP = METIS_PROVE [] ``b1 /\ (b2 ==> b3) ==> ((b1 ==> b2) ==> b3)``; 430 431val logic_flag_termp_TERM = prove( 432 ``isTrue (logic_flag_termp (Sym "LIST") (list2sexp [x])) = 433 isTrue (logic_flag_termp (Sym "TERM") x)``, 434 SIMP_TAC std_ss [Once logic_flag_termp_def] \\ FS [] 435 \\ Cases_on `isTrue (logic_flag_termp (Sym "TERM") x)` \\ FS [] 436 \\ SIMP_TAC std_ss [Once logic_flag_termp_def] \\ FS []); 437 438val ALL_DISTINCT_Sym = add_prove( 439 ``!xs. ALL_DISTINCT (MAP Sym xs) = ALL_DISTINCT xs``, 440 Induct \\ FS [ALL_DISTINCT,MAP,MEM_MAP]); 441 442val logic_sym2prim_thm = add_prove( 443 ``(logic_sym2prim a = SOME x) ==> (a = logic_prim2sym x)``, 444 Cases_on `x` \\ FULL_SIMP_TAC std_ss [logic_sym2prim_def] 445 \\ SRW_TAC [] [logic_prim2sym_def]); 446 447val logic_flag_termp_thm = prove( 448 ``!xs. isTrue (logic_flag_termp (Sym "LIST") (list2sexp xs)) ==> 449 ?ts. (xs = MAP t2sexp ts) /\ EVERY term_syntax_ok ts``, 450 STRIP_TAC \\ completeInduct_on `LIST_LSIZE xs` \\ STRIP_TAC \\ STRIP_TAC 451 \\ FS [PULL_FORALL_IMP] \\ Cases_on `xs` 452 \\ ONCE_REWRITE_TAC [logic_flag_termp_def] 453 \\ FS [] \\ REPEAT STRIP_TAC THEN1 (Q.EXISTS_TAC `[]` \\ EVAL_TAC) 454 \\ POP_ASSUM MP_TAC \\ SRW_TAC [] [] \\ FS [] 455 \\ `?ts2. (h = t2sexp ts2) /\ term_syntax_ok ts2` suffices_by (STRIP_TAC THEN `LIST_LSIZE t < LIST_LSIZE (h::t)` by (FS [LIST_LSIZE_def] \\ DECIDE_TAC) 456 \\ RES_TAC \\ Q.EXISTS_TAC `ts2::ts` \\ FS [MAP,EVERY_DEF]) 457 \\ POP_ASSUM (K ALL_TAC) \\ POP_ASSUM MP_TAC \\ REVERSE (Cases_on `h`) 458 THEN1 459 (ONCE_REWRITE_TAC [logic_flag_termp_def] 460 \\ FS [logic_variablep_def,logic_constantp_def] 461 \\ Cases_on `s = "T"` \\ FS [] 462 \\ Cases_on `s = "NIL"` \\ FS [] 463 \\ Q.EXISTS_TAC `mVar s` \\ EVAL_TAC \\ FS []) 464 THEN1 465 (ONCE_REWRITE_TAC [logic_flag_termp_def] 466 \\ FS [logic_variablep_def,logic_constantp_def] 467 \\ FS [LISP_EQUAL_def] \\ SIMP_TAC (srw_ss()) [] \\ FS []) 468 \\ ONCE_REWRITE_TAC [logic_flag_termp_def] \\ FS [logic_variablep_def] 469 \\ Cases_on `isTrue (logic_constantp (Dot S' S0))` \\ FS [] THEN1 470 (POP_ASSUM MP_TAC \\ Cases_on `S0` \\ FS [logic_constantp_def] 471 \\ Cases_on `S0'` \\ FS [] \\ SRW_TAC [] [] \\ FS [] 472 \\ Q.EXISTS_TAC `mConst S''` \\ EVAL_TAC) 473 \\ REVERSE (Cases_on `isTrue (logic_function_namep S')`) \\ FS [] THEN1 474 (Cases_on `list_exists 3 S'` \\ FS [LET_DEF] 475 \\ Cases_on `?xs. CAR (CDR S') = list2sexp xs` \\ FS [] 476 \\ Cases_on `?ys. S0 = list2sexp ys` \\ FS [] 477 \\ Cases_on `isTrue (logic_flag_termp (Sym "LIST") (list2sexp ys))` \\ FS [] 478 \\ SRW_TAC [] [] \\ FS [] 479 \\ `LIST_LSIZE ys < LIST_LSIZE (Dot S' (list2sexp ys)::t)` by 480 (SIMP_TAC std_ss [LIST_LSIZE_def,LSIZE_def] 481 \\ `LIST_LSIZE ys <= LSIZE (list2sexp ys)` by FS [LIST_LSIZE_LESS_EQ] 482 \\ DECIDE_TAC) 483 \\ RES_TAC 484 \\ Cases_on `S'` \\ FS [] 485 \\ Cases_on `S0` \\ FS [] 486 \\ Cases_on `S0'` \\ FS [] 487 \\ Cases_on `S0` \\ FS [] 488 \\ IMP_RES_TAC logic_variable_listp_IMP 489 \\ FS [LIST_LSIZE_def,LSIZE_def] 490 \\ Q.PAT_X_ASSUM `!xs.bbb` (MP_TAC o Q.SPEC `[S''']`) 491 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) 492 \\ ASM_SIMP_TAC std_ss [logic_flag_termp_TERM] \\ STRIP_TAC 493 \\ Cases_on `ts'` \\ FS [MAP,NOT_CONS_NIL] 494 \\ Cases_on `t'` \\ FS [MAP,NOT_CONS_NIL,CONS_11] 495 \\ Q.EXISTS_TAC `mLamApp zs h ts` \\ FS [t2sexp_def,term_syntax_ok_def,EVERY_DEF] 496 \\ FS [LENGTH_MAP] \\ FS [SUBSET_DEF,MEM_MAP] 497 \\ REPEAT STRIP_TAC 498 \\ Q.PAT_X_ASSUM `!x. bb1 ==> bb2` (MP_TAC o Q.SPEC `Sym x`) \\ FS []) 499 \\ FS [LET_DEF] \\ Cases_on `?xs. S0 = list2sexp xs` \\ FS [] 500 \\ Cases_on `isTrue (logic_flag_termp (Sym "LIST") (list2sexp xs))` \\ FS [] 501 \\ `LIST_LSIZE xs < LIST_LSIZE (Dot S' (list2sexp xs)::t)` by 502 (SIMP_TAC std_ss [LIST_LSIZE_def,LSIZE_def] 503 \\ `LIST_LSIZE xs <= LSIZE (list2sexp xs)` by FS [LIST_LSIZE_LESS_EQ] 504 \\ DECIDE_TAC) 505 \\ RES_TAC \\ FS [logic_function_namep_def] 506 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,memberp_thm] 507 \\ Cases_on `isSym S'` \\ FS [] \\ FS [isSym_thm] 508 \\ Cases_on `logic_sym2prim a` THEN1 509 (Q.EXISTS_TAC `mApp (mFun a) ts` 510 \\ FS [t2sexp_def,term_syntax_ok_def,EVERY_DEF, 511 logic_func2sexp_def,func_syntax_ok_def] 512 \\ POP_ASSUM MP_TAC 513 \\ SIMP_TAC std_ss [logic_sym2prim_def] \\ SRW_TAC [] []) 514 \\ Q.EXISTS_TAC `mApp (mPrimitiveFun x) ts` 515 \\ FS [t2sexp_def,term_syntax_ok_def,EVERY_DEF, 516 logic_func2sexp_def,func_syntax_ok_def]); 517 518val logic_termp_thm = prove( 519 ``!x. isTrue (logic_termp x) ==> ?t. (x = t2sexp t) /\ term_syntax_ok t``, 520 REPEAT STRIP_TAC \\ MP_TAC (Q.SPEC `[x]` logic_flag_termp_thm) 521 \\ FS [logic_flag_termp_TERM,logic_termp_def] 522 \\ REPEAT STRIP_TAC 523 \\ Cases_on `ts` \\ FULL_SIMP_TAC (srw_ss()) [] 524 \\ Cases_on `t` \\ FULL_SIMP_TAC (srw_ss()) [] \\ METIS_TAC []); 525 526val _ = add_rws [logic_unquote_def, logic_functionp_def, 527 logic_function_name_def, logic_function_args_def, 528 logic_function_def, logic_lambdap_def, 529 logic_lambda_formals_def, logic_lambda_body_def, 530 logic_lambda_actuals_def, logic_lambda_def, 531 logic_constantp_def]; 532 533val logic_func2sexp_QUOTE = add_prove( 534 ``func_syntax_ok l0 ==> 535 (LISP_EQUAL (logic_func2sexp l0) (Sym "QUOTE") = Sym "NIL")``, 536 FS []); 537 538val logic_func2sexp_NOT_QUOTE = add_prove( 539 ``func_syntax_ok l0 ==> ~(logic_func2sexp l0 = Sym "QUOTE")``, 540 FS []); 541 542val logic_function_namep_Dot = add_prove( 543 ``logic_function_namep (Dot x y) = Sym "NIL"``, EVAL_TAC); 544 545val LISP_EQUAL_Dot_Sym = add_prove( 546 ``LISP_EQUAL (Dot x y) (Sym z) = Sym "NIL"``, EVAL_TAC); 547 548val logic_function_namep_thm = add_prove( 549 ``func_syntax_ok l0 ==> (logic_function_namep (logic_func2sexp l0) = Sym "T")``, 550 Cases_on `l0` \\ FS [] THEN1 (Cases_on `l` \\ EVAL_TAC) 551 \\ FS [logic_func2sexp_def,logic_function_namep_def] 552 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,memberp_thm] 553 \\ FS [not_def] \\ EVAL_TAC 554 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC (srw_ss()) [isSym_def]); 555 556val logic_flag_term_atblp_TERM = prove( 557 ``isTrue (logic_flag_term_atblp (Sym "LIST") (list2sexp (MAP t2sexp [l])) atbl) = 558 isTrue (logic_flag_term_atblp (Sym "TERM") (t2sexp l) atbl)``, 559 SIMP_TAC std_ss [Once logic_flag_term_atblp_def] \\ FS [MAP] 560 \\ Cases_on `isTrue (logic_flag_term_atblp (Sym "TERM") (t2sexp l) atbl)` \\ FS [] 561 \\ SIMP_TAC std_ss [Once logic_flag_term_atblp_def] \\ FS [MAP]); 562 563(* informally domain atbl = primitives UNION domain ctxt, they agree on content *) 564val atbl_ok_def = Define ` 565 atbl_ok (ctxt:context_type) atbl = 566 !f. func_syntax_ok f ==> 567 (CDR (lookup (logic_func2sexp f) atbl) = 568 if func_arity ctxt f = NONE then Sym "NIL" else 569 Val (THE (func_arity ctxt f)))` 570 571val logic_flag_term_atblp_thm = prove( 572 ``!ts. 573 EVERY term_syntax_ok ts /\ atbl_ok ctxt atbl ==> 574 isTrue (logic_flag_term_atblp (Sym "LIST") (list2sexp (MAP t2sexp ts)) atbl) ==> 575 EVERY (term_ok ctxt) ts``, 576 STRIP_TAC \\ completeInduct_on `logic_term1_size ts` \\ STRIP_TAC \\ STRIP_TAC 577 \\ FS [PULL_FORALL_IMP] \\ Cases_on `ts` \\ FS [EVERY_DEF] \\ STRIP_TAC 578 \\ ONCE_REWRITE_TAC [logic_flag_term_atblp_def] \\ FS [MAP] 579 \\ Cases_on `isTrue (logic_flag_term_atblp (Sym "TERM") (t2sexp h) atbl)` \\ FS [] 580 \\ `logic_term1_size t < logic_term1_size (h::t)` by (EVAL_TAC \\ DECIDE_TAC) 581 \\ FS [] \\ REPEAT STRIP_TAC 582 \\ Q.PAT_X_ASSUM `isTrue (logic_flag_term_atblp (Sym "TERM") (t2sexp h) atbl)` MP_TAC 583 \\ ONCE_REWRITE_TAC [logic_flag_term_atblp_def] \\ FS [MAP] 584 \\ REVERSE (Cases_on `h`) 585 \\ FS [t2sexp_def,term_ok_def,logic_variablep_def,term_syntax_ok_def] 586 \\ FS [LET_DEF,LENGTH_MAP] THEN1 587 (Cases_on `isTrue (logic_flag_term_atblp (Sym "TERM") (t2sexp l) atbl)` \\ FS [] 588 \\ STRIP_TAC 589 \\ Q.PAT_X_ASSUM `!ts.bbb` (fn th => (MP_TAC o Q.SPEC `l0`) th THEN 590 (MP_TAC o Q.SPEC `[l]`) th) 591 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) 592 \\ FULL_SIMP_TAC std_ss [EVERY_DEF,logic_flag_term_atblp_TERM] \\ STRIP_TAC 593 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) 594 \\ FS [EVERY_MEM]) 595 \\ Cases_on `Val (LENGTH l) = CDR (lookup (logic_func2sexp l0) atbl)` \\ FS [] 596 \\ STRIP_TAC \\ Q.PAT_X_ASSUM `!ts.bbb` (MP_TAC o Q.SPEC `l`) 597 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) 598 \\ FS [] \\ FS [EVERY_MEM] \\ STRIP_TAC 599 \\ FS [atbl_ok_def] \\ RES_TAC \\ FS [] 600 \\ Cases_on `func_arity ctxt l0` \\ FS []); 601 602val logic_term_atblp_thm = prove( 603 ``term_syntax_ok t /\ atbl_ok ctxt atbl ==> 604 isTrue (logic_term_atblp (t2sexp t) atbl) ==> 605 term_ok ctxt t``, 606 REPEAT STRIP_TAC \\ FS [logic_term_atblp_def] 607 \\ MP_TAC (Q.SPEC `[t]` logic_flag_term_atblp_thm) 608 \\ FS [EVERY_DEF,logic_flag_term_atblp_TERM]); 609 610val _ = add_rws [logic_fmtype_def, logic__lhs_def, logic__rhs_def, 611 logic__arg_def, logic_vlhs_def, logic_vrhs_def, 612 logic_pequal_def, logic_pnot_def, logic_por_def]; 613 614val logic_formulap_thm = prove( 615 ``!x. isTrue (logic_formulap x) ==> ?t. (x = f2sexp t) /\ formula_syntax_ok t``, 616 STRIP_TAC \\ completeInduct_on `LSIZE x` \\ STRIP_TAC \\ STRIP_TAC 617 \\ FS [PULL_FORALL_IMP] \\ ONCE_REWRITE_TAC [logic_formulap_def] \\ FS [] 618 \\ Cases_on `x` \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] \\ FS [] 619 \\ Cases_on `S'` \\ FS [] \\ Cases_on `S0` \\ FS [] 620 \\ SRW_TAC [] [] \\ FS [] THEN1 621 (Cases_on `S0'` \\ FS [] \\ Cases_on `S0` \\ FS [] 622 \\ IMP_RES_TAC logic_termp_thm \\ FS [] 623 \\ Q.EXISTS_TAC `Equal t' t` \\ EVAL_TAC \\ FS []) 624 THEN1 625 (Cases_on `S0'` \\ FS [LSIZE_def] 626 \\ `LSIZE S' < SUC (SUC (LSIZE S'))` by DECIDE_TAC \\ RES_TAC 627 \\ Q.EXISTS_TAC `Not t` \\ EVAL_TAC \\ FS []) 628 THEN1 629 (Cases_on `S0'` \\ FS [] \\ Cases_on `S0` \\ FS [LSIZE_def] 630 \\ `LSIZE S' < SUC (SUC (LSIZE S' + SUC (LSIZE S''))) /\ 631 LSIZE S'' < SUC (SUC (LSIZE S' + SUC (LSIZE S'')))` by DECIDE_TAC 632 \\ RES_TAC \\ FS [] 633 \\ Q.EXISTS_TAC `Or t' t` \\ EVAL_TAC \\ FS [])); 634 635val logic_formula_atblp_thm = prove( 636 ``!t. formula_syntax_ok t /\ atbl_ok ctxt atbl ==> 637 isTrue (logic_formula_atblp (f2sexp t) atbl) ==> 638 formula_ok ctxt t``, 639 Induct \\ ONCE_REWRITE_TAC [logic_formula_atblp_def] 640 \\ FS [formula_syntax_ok_def,formula_ok_def,LET_DEF,f2sexp_def] 641 \\ FULL_SIMP_TAC (srw_ss()) [] 642 THEN1 (Cases_on `isTrue (logic_formula_atblp (f2sexp t) atbl)` \\ FS []) 643 \\ NTAC 3 STRIP_TAC 644 \\ Cases_on `isTrue (logic_term_atblp (t2sexp l) atbl)` \\ FS [] \\ STRIP_TAC 645 \\ IMP_RES_TAC logic_term_atblp_thm \\ FS []); 646 647val logic_disjoin_formulas_thm = add_prove( 648 ``!xs. (logic_disjoin_formulas (list2sexp (MAP f2sexp xs)) = 649 if xs = [] then Sym "NIL" else f2sexp (or_list xs))``, 650 Induct THEN1 EVAL_TAC \\ REPEAT STRIP_TAC \\ FS [] 651 \\ Cases_on `xs` \\ FS [MAP,or_list_def] 652 \\ ONCE_REWRITE_TAC [logic_disjoin_formulas_def] \\ FS [f2sexp_def]); 653 654val _ = Hol_datatype ` 655 logic_appeal = 656 Appeal of string => formula => (logic_appeal list # (SExp option)) option` 657 658val logic_appeal_size_def = fetch "-" "logic_appeal_size_def" 659 660val CONCL_def = Define `CONCL (Appeal name concl x) = concl`; 661val HYPS_def = Define ` 662 (HYPS (Appeal name concl NONE) = []) /\ 663 (HYPS (Appeal name concl (SOME(x,y))) = x)`; 664 665val logic_appeal_size_def = fetch "-" "logic_appeal_size_def" 666 667val logic_appeal3_size_lemma = prove( 668 ``!q a. MEM a q ==> logic_appeal_size a < logic_appeal3_size q``, 669 Induct \\ FULL_SIMP_TAC (srw_ss()) [logic_appeal_size_def] 670 \\ REPEAT STRIP_TAC \\ RES_TAC 671 \\ FULL_SIMP_TAC (srw_ss()) [logic_appeal_size_def] \\ DECIDE_TAC); 672 673val a2sexp_def = tDefine "a2sexp" ` 674 a2sexp (Appeal name concl subproofs_extras) = 675 let xs = 676 (if subproofs_extras = NONE then [] else 677 [list2sexp (MAP a2sexp (FST (THE subproofs_extras)))] ++ 678 if SND (THE subproofs_extras) = NONE then [] else 679 [THE (SND (THE subproofs_extras))]) in 680 list2sexp ([Sym name; f2sexp concl] ++ xs)` 681 (WF_REL_TAC `measure (logic_appeal_size)` \\ REPEAT STRIP_TAC 682 \\ Cases_on `subproofs_extras` \\ FULL_SIMP_TAC (srw_ss()) [logic_appeal_size_def] 683 \\ Cases_on `x` \\ FULL_SIMP_TAC (srw_ss()) [logic_appeal_size_def] 684 \\ IMP_RES_TAC logic_appeal3_size_lemma \\ DECIDE_TAC) 685 686val appeal_syntax_ok_def = tDefine "appeal_syntax_ok" ` 687 appeal_syntax_ok (Appeal name concl subproofs_extras) = 688 formula_syntax_ok concl /\ 689 (~(subproofs_extras = NONE) ==> 690 EVERY appeal_syntax_ok (FST (THE subproofs_extras)))` 691 (WF_REL_TAC `measure (logic_appeal_size)` \\ REPEAT STRIP_TAC 692 \\ Cases_on `subproofs_extras` \\ FULL_SIMP_TAC (srw_ss()) [logic_appeal_size_def] 693 \\ Cases_on `x` \\ FULL_SIMP_TAC (srw_ss()) [logic_appeal_size_def] 694 \\ IMP_RES_TAC logic_appeal3_size_lemma \\ DECIDE_TAC); 695 696val appeal_syntax_ok_thm = prove( 697 ``appeal_syntax_ok a = 698 formula_syntax_ok (CONCL a) /\ 699 EVERY appeal_syntax_ok (HYPS a)``, 700 Cases_on `a` \\ SIMP_TAC std_ss [Once appeal_syntax_ok_def,CONCL_def,HYPS_def] 701 \\ Cases_on `o'` \\ FS [HYPS_def,EVERY_DEF] 702 \\ Cases_on `x` \\ FS [HYPS_def,EVERY_DEF]); 703 704val anylist2sexp_def = (add_rw o Define) ` 705 (anylist2sexp [] x = x) /\ 706 (anylist2sexp (y::ys) x = Dot y (anylist2sexp ys x))`; 707 708val logic_flag_appealp_lemma = add_prove( 709 ``isTrue (logic_formulap (Sym "NIL")) = F``, 710 EVAL_TAC); 711 712val anylist2sexp_NIL = add_prove( 713 ``!xs. anylist2sexp xs (Sym "NIL") = list2sexp xs``, 714 Induct \\ FS []); 715 716val anylist2sexp_EXISTS = prove( 717 ``!x. ?zs z. (x = anylist2sexp zs z) /\ ~(isDot z)``, 718 REVERSE Induct 719 THEN1 (REPEAT STRIP_TAC \\ Q.LIST_EXISTS_TAC [`[]`,`Sym s`] \\ EVAL_TAC) 720 THEN1 (REPEAT STRIP_TAC \\ Q.LIST_EXISTS_TAC [`[]`,`Val n`] \\ EVAL_TAC) 721 \\ FS [] \\ Q.LIST_EXISTS_TAC [`x::zs'`,`z'`] \\ FS []); 722 723val logic_flag_appealp_thm = prove( 724 ``!xs. isTrue (logic_flag_appealp (Sym "LIST") (list2sexp xs)) ==> 725 ?ts. (xs = MAP a2sexp ts) /\ EVERY appeal_syntax_ok ts``, 726 STRIP_TAC \\ completeInduct_on `LIST_LSIZE xs` \\ STRIP_TAC \\ STRIP_TAC 727 \\ ONCE_REWRITE_TAC [logic_flag_appealp_def] 728 \\ FS [PULL_FORALL_IMP] \\ FULL_SIMP_TAC (srw_ss()) [] 729 \\ Cases_on `xs` \\ FS [] 730 THEN1 (FS [GSYM AND_IMP_INTRO] \\ REPEAT STRIP_TAC \\ Q.EXISTS_TAC `[]` \\ EVAL_TAC) 731 \\ Cases_on `isTrue (logic_flag_appealp (Sym "PROOF") h)` \\ FS [] 732 \\ REPEAT STRIP_TAC 733 \\ REVERSE (sg `?t. (h = a2sexp t) /\ appeal_syntax_ok t`) 734 \\ `LIST_LSIZE t < LIST_LSIZE (h::t)` by (EVAL_TAC \\ DECIDE_TAC) \\ RES_TAC 735 THEN1 (Q.EXISTS_TAC `t'::ts` \\ FS [CONS_11,APPEND,MAP,EVERY_DEF]) 736 \\ Q.PAT_X_ASSUM `isTrue (logic_flag_appealp (Sym "PROOF") h)` MP_TAC 737 \\ ONCE_REWRITE_TAC [logic_flag_appealp_def] 738 \\ SRW_TAC [] [] \\ FS [] 739 \\ Q.PAT_X_ASSUM `h = list2sexp xs` ASSUME_TAC \\ FS [] 740 \\ Cases_on `xs` THEN1 (FS [] \\ Cases_on `xs'` \\ FS []) 741 \\ Cases_on `t` THEN1 (FS [] \\ Cases_on `xs'` \\ FS []) 742 \\ Cases_on `t'` THEN1 743 (FS [isSym_thm] \\ IMP_RES_TAC logic_formulap_thm \\ FS [] 744 \\ Cases_on `xs'` \\ FS [] 745 \\ Q.EXISTS_TAC `Appeal a t NONE` 746 \\ FS [appeal_syntax_ok_def,a2sexp_def,list2sexp_def,LET_DEF,APPEND]) 747 \\ Cases_on `t` THEN1 748 (FS [isSym_thm] \\ IMP_RES_TAC logic_formulap_thm \\ FS [] 749 \\ Q.PAT_X_ASSUM `!xs.bb` (MP_TAC o Q.SPEC `xs'`) 750 \\ FULL_SIMP_TAC std_ss [isDot_def] 751 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 752 (FULL_SIMP_TAC std_ss [LIST_LSIZE_def,LSIZE_def] 753 \\ `LIST_LSIZE xs' <= LSIZE (list2sexp xs')` by FS [LIST_LSIZE_LESS_EQ] 754 \\ DECIDE_TAC) 755 \\ Q.PAT_X_ASSUM `h''' = list2sexp xs'` ASSUME_TAC \\ FS [] 756 \\ REPEAT STRIP_TAC 757 \\ Q.EXISTS_TAC `Appeal a t (SOME(ts',NONE))` 758 \\ FS [appeal_syntax_ok_def,a2sexp_def,list2sexp_def,LET_DEF,APPEND]) 759 \\ Cases_on `t'` THEN1 760 (FS [isSym_thm] \\ IMP_RES_TAC logic_formulap_thm \\ FS [] 761 \\ Q.PAT_X_ASSUM `!xs.bb` (MP_TAC o Q.SPEC `xs'`) \\ FS [] 762 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 763 (FULL_SIMP_TAC std_ss [LIST_LSIZE_def,LSIZE_def] 764 \\ `LIST_LSIZE xs' <= LSIZE (list2sexp xs')` by FS [LIST_LSIZE_LESS_EQ] 765 \\ DECIDE_TAC) 766 \\ Q.PAT_X_ASSUM `h''' = list2sexp xs'` ASSUME_TAC \\ FS [] 767 \\ REPEAT STRIP_TAC 768 \\ Q.EXISTS_TAC `Appeal a t (SOME(ts',SOME h''''))` 769 \\ FS [appeal_syntax_ok_def,a2sexp_def,list2sexp_def,LET_DEF,APPEND]) 770 \\ FS [LENGTH] \\ `F` by DECIDE_TAC); 771 772val logic_appealp_thm = prove( 773 ``!x. isTrue (logic_appealp x) ==> ?t. (x = a2sexp t) /\ appeal_syntax_ok t``, 774 FS [logic_appealp_def] \\ REPEAT STRIP_TAC 775 \\ MP_TAC (Q.SPEC `[x]` logic_flag_appealp_thm) 776 \\ ONCE_REWRITE_TAC [logic_flag_appealp_def] 777 \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] 778 \\ ONCE_REWRITE_TAC [logic_flag_appealp_def] 779 \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] \\ FS [] 780 \\ REPEAT STRIP_TAC \\ Cases_on `ts` \\ FULL_SIMP_TAC (srw_ss()) [MAP] 781 \\ METIS_TAC []); 782 783val logic_appeal_listp_thm = prove( 784 ``!xs. isTrue (logic_appeal_listp (list2sexp xs)) ==> 785 ?ts. (xs = MAP a2sexp ts) /\ EVERY appeal_syntax_ok ts``, 786 FS [logic_appeal_listp_def,logic_flag_appealp_thm]); 787 788val logic_appeal_anylistp_thm = prove( 789 ``!xs y. ~(isDot y) /\ isTrue (logic_appeal_listp (anylist2sexp xs y)) ==> 790 ?ts. (xs = MAP a2sexp ts) /\ EVERY appeal_syntax_ok ts``, 791 SIMP_TAC std_ss [logic_appeal_listp_def] 792 \\ Induct \\ REPEAT STRIP_TAC THEN1 (Q.EXISTS_TAC `[]` \\ EVAL_TAC) 793 \\ POP_ASSUM MP_TAC \\ ONCE_REWRITE_TAC [logic_flag_appealp_def] 794 \\ FS [anylist2sexp_def] \\ SIMP_TAC (srw_ss()) [] 795 \\ SRW_TAC [] [] \\ FS [] \\ FS [GSYM logic_appealp_def] 796 \\ IMP_RES_TAC logic_appealp_thm \\ RES_TAC \\ FS [] 797 \\ Q.EXISTS_TAC `t::ts` \\ FS [MAP,EVERY_DEF]); 798 799 800val _ = add_rws [logic_method_def, logic_conclusion_def, 801 logic_subproofs_def, logic_extras_def] 802 803val logic_strip_conclusions_thm = add_prove( 804 ``!xs. logic_strip_conclusions (list2sexp xs) = list2sexp (MAP (CAR o CDR) xs)``, 805 Induct THEN1 EVAL_TAC 806 \\ ONCE_REWRITE_TAC [logic_strip_conclusions_def] \\ FS [MAP]); 807 808val logic_func2sexp_NOT_Dot = add_prove( 809 ``~(logic_func2sexp l0 = Dot x y)``, 810 Cases_on `l0` \\ FS [func_syntax_ok_def] 811 THEN1 (Cases_on `l` \\ EVAL_TAC) 812 \\ SRW_TAC [] [logic_func2sexp_def]); 813 814val MAP_EQ_MAP = prove( 815 ``!xs ys. 816 (!x y. MEM x xs /\ MEM y ys /\ (f x = f y) ==> (x = y)) ==> 817 ((MAP f xs = MAP f ys) = (xs = ys))``, 818 Induct \\ Cases_on `ys` \\ FS [MAP,LENGTH] 819 \\ POP_ASSUM (ASSUME_TAC o Q.SPEC `t`) 820 \\ REPEAT STRIP_TAC \\ SIMP_TAC std_ss [CONS_11] 821 \\ `(!x y. MEM x xs /\ MEM y t /\ (f x = f y) ==> (x = y))` by METIS_TAC [] 822 \\ `((MAP f xs = MAP f t) <=> (xs = t))` by RES_TAC 823 \\ POP_ASSUM (fn th => ONCE_REWRITE_TAC [th]) 824 \\ Cases_on `h = h'` \\ METIS_TAC []); 825 826val MEM_logic_term_size = prove( 827 ``!l x. MEM x l ==> logic_term_size x <= logic_term1_size l``, 828 Induct \\ FULL_SIMP_TAC (srw_ss()) [logic_term_size_def] \\ REPEAT STRIP_TAC 829 \\ RES_TAC \\ FULL_SIMP_TAC std_ss [] \\ DECIDE_TAC); 830 831val t2sexp_11 = add_prove( 832 ``!x y. ((t2sexp x = t2sexp y) = (x = y))``, 833 STRIP_TAC \\ completeInduct_on `logic_term_size x` 834 \\ REPEAT STRIP_TAC \\ FS [PULL_FORALL_IMP] 835 \\ Cases_on `x` \\ Cases_on `y` \\ FS [t2sexp_def] 836 \\ FULL_SIMP_TAC (srw_ss()) [term_syntax_ok_def] \\ FS [logic_func2sexp_11] THEN1 837 (sg `(MAP t2sexp l = MAP t2sexp l') = (l = l')` \\ FS [] 838 \\ MATCH_MP_TAC MAP_EQ_MAP \\ REPEAT STRIP_TAC 839 \\ FS [EVERY_MEM] \\ RES_TAC 840 \\ `logic_term_size x < logic_term_size (mApp l0 l)` by 841 (EVAL_TAC \\ IMP_RES_TAC MEM_logic_term_size \\ DECIDE_TAC) 842 \\ METIS_TAC []) 843 \\ `(MAP Sym l1 = MAP Sym l1') = (l1 = l1')` by 844 (MATCH_MP_TAC MAP_EQ_MAP \\ REPEAT STRIP_TAC \\ FS []) 845 \\ `(t2sexp l = t2sexp l') = (l = l')` by 846 (Q.PAT_X_ASSUM `!xx.bbb` (MATCH_MP_TAC o REWRITE_RULE [AND_IMP_INTRO]) 847 \\ FS [] \\ EVAL_TAC \\ DECIDE_TAC) 848 \\ ASM_SIMP_TAC std_ss [] 849 \\ sg `(MAP t2sexp l0 = MAP t2sexp l0') = (l0 = l0')` 850 \\ FS [CONJ_ASSOC] 851 \\ MATCH_MP_TAC MAP_EQ_MAP \\ REPEAT STRIP_TAC 852 \\ FS [EVERY_MEM] \\ RES_TAC 853 \\ `logic_term_size x < logic_term_size (mLamApp l1 l l0)` by 854 (EVAL_TAC \\ IMP_RES_TAC MEM_logic_term_size \\ DECIDE_TAC) 855 \\ METIS_TAC []); 856 857val f2sexp_11 = add_prove( 858 ``!x y. ((f2sexp x = f2sexp y) = (x = y))``, 859 Induct \\ Cases_on `y` \\ FS [formula_syntax_ok_def,f2sexp_def] 860 \\ FULL_SIMP_TAC (srw_ss()) [] \\ FS []); 861 862 863(* step checking *) 864 865val appeal_assum_def = (add_rw o Define) ` 866 appeal_assum ctxt atbl a = 867 appeal_syntax_ok a /\ atbl_ok ctxt atbl /\ 868 EVERY (MilawaTrue ctxt) (MAP CONCL (HYPS a))`; 869 870val thms_inv_def = Define ` 871 thms_inv ctxt xs = EVERY (MilawaTrue ctxt) xs /\ 872 EVERY formula_syntax_ok xs`; 873 874val a2sexp_CONCL = add_prove( 875 ``CAR (CDR (a2sexp a)) = f2sexp (CONCL a)``, 876 Cases_on `a` \\ FS [a2sexp_def,LET_DEF,APPEND,CONCL_def]); 877 878val appela_syntax_ok_CONCL = add_prove( 879 ``appeal_syntax_ok a ==> formula_syntax_ok (CONCL a)``, 880 Cases_on `a` \\ EVAL_TAC \\ FS []); 881 882val logic_axiom_okp_thm = add_prove( 883 ``appeal_assum ctxt atbl a /\ thms_inv ctxt axioms ==> 884 isTrue (logic_axiom_okp (a2sexp a) (list2sexp (MAP f2sexp axioms)) atbl) ==> 885 MilawaTrue ctxt (CONCL a)``, 886 SIMP_TAC std_ss [logic_axiom_okp_def,LET_DEF] \\ SRW_TAC [] [] \\ FS [] 887 \\ FS [appeal_assum_def,thms_inv_def,MEM_MAP,EVERY_MEM] \\ RES_TAC \\ FS []); 888 889val logic_theorem_okp_thm = add_prove( 890 ``appeal_assum ctxt atbl a /\ thms_inv ctxt thms ==> 891 isTrue (logic_theorem_okp (a2sexp a) (list2sexp (MAP f2sexp thms)) atbl) ==> 892 MilawaTrue ctxt (CONCL a)``, 893 SIMP_TAC std_ss [logic_theorem_okp_def,LET_DEF] \\ SRW_TAC [] [] \\ FS [] 894 \\ FS [appeal_assum_def,thms_inv_def,MEM_MAP,EVERY_MEM] \\ RES_TAC \\ FS []); 895 896val a2sexp_HYPS = prove( 897 ``(list_exists 1 (CAR (CDR (CDR (a2sexp a)))) ==> ?h1. HYPS a = [h1]) /\ 898 (list_exists 2 (CAR (CDR (CDR (a2sexp a)))) ==> ?h1 h2. HYPS a = [h1;h2])``, 899 Cases_on `a` \\ FS [a2sexp_def,LET_DEF,APPEND] 900 \\ Cases_on `o'` \\ FS [] \\ Cases_on `x` \\ FS [HYPS_def] 901 \\ Cases_on `q` \\ FS [MAP] \\ Cases_on `t` \\ FS [MAP,CONS_11] 902 \\ Cases_on `t'` \\ FS [MAP,CONS_11]); 903 904val a2sexp_SELECT = add_prove( 905 ``!a. 906 (HYPS a = x::xs) ==> 907 (CAR (CDR (CDR (a2sexp a))) = list2sexp (MAP a2sexp (x::xs)))``, 908 Cases \\ SIMP_TAC std_ss [a2sexp_def,LET_DEF,APPEND] \\ FS [] 909 \\ Cases_on `o'` \\ FS [HYPS_def] \\ Cases_on `x'` \\ FS [HYPS_def]); 910 911val f2sexp_IMP = prove( 912 ``!a. ((CAR (f2sexp a) = Sym "POR*") ==> ?x1 x2. a = Or x1 x2) /\ 913 ((CAR (f2sexp a) = Sym "PNOT*") ==> ?x1. a = Not x1) /\ 914 ((CAR (f2sexp a) = Sym "PEQUAL*") ==> ?t1 t2. a = Equal t1 t2)``, 915 Cases \\ FS [f2sexp_def] \\ FULL_SIMP_TAC (srw_ss()) []); 916 917val logic_associativity_okp_thm = add_prove( 918 ``appeal_assum ctxt atbl a ==> 919 isTrue (logic_associativity_okp (a2sexp a)) ==> 920 MilawaTrue ctxt (CONCL a)``, 921 SIMP_TAC std_ss [logic_associativity_okp_def,LET_DEF] 922 \\ SRW_TAC [] [] \\ FS [appeal_syntax_ok_thm] 923 \\ IMP_RES_TAC a2sexp_HYPS 924 \\ IMP_RES_TAC a2sexp_SELECT 925 \\ FS [MAP] 926 \\ IMP_RES_TAC f2sexp_IMP 927 \\ FS [f2sexp_def] 928 \\ IMP_RES_TAC f2sexp_IMP 929 \\ FS [f2sexp_def,formula_syntax_ok_def,EVERY_DEF,appeal_syntax_ok_thm] 930 \\ REPEAT (Q.PAT_X_ASSUM `f2sexp yyy = f2sexp xxx` MP_TAC) 931 \\ FS [f2sexp_def,formula_syntax_ok_def,EVERY_DEF,appeal_syntax_ok_thm] 932 \\ REPEAT STRIP_TAC 933 \\ FS [f2sexp_def,formula_syntax_ok_def,EVERY_DEF,appeal_syntax_ok_thm] 934 \\ ONCE_REWRITE_TAC [MilawaTrue_cases] \\ ASM_SIMP_TAC (srw_ss()) []); 935 936val logic_contraction_okp_thm = add_prove( 937 ``appeal_assum ctxt atbl a ==> 938 isTrue (logic_contraction_okp (a2sexp a)) ==> 939 MilawaTrue ctxt (CONCL a)``, 940 SIMP_TAC std_ss [logic_contraction_okp_def,LET_DEF] 941 \\ SRW_TAC [] [] \\ FS [appeal_syntax_ok_thm] 942 \\ IMP_RES_TAC a2sexp_HYPS 943 \\ IMP_RES_TAC a2sexp_SELECT 944 \\ FS [MAP] 945 \\ IMP_RES_TAC f2sexp_IMP 946 \\ FS [f2sexp_def] 947 \\ FS [f2sexp_def,formula_syntax_ok_def,EVERY_DEF,appeal_syntax_ok_thm] 948 \\ REPEAT STRIP_TAC \\ FS [] 949 \\ ONCE_REWRITE_TAC [MilawaTrue_cases] \\ ASM_SIMP_TAC (srw_ss()) [] 950 \\ METIS_TAC []); 951 952val logic_cut_okp_thm = add_prove( 953 ``appeal_assum ctxt atbl a ==> 954 isTrue (logic_cut_okp (a2sexp a)) ==> 955 MilawaTrue ctxt (CONCL a)``, 956 SIMP_TAC std_ss [logic_cut_okp_def,LET_DEF] 957 \\ SRW_TAC [] [] \\ FS [appeal_syntax_ok_thm] 958 \\ IMP_RES_TAC a2sexp_HYPS 959 \\ IMP_RES_TAC a2sexp_SELECT 960 \\ FS [MAP,EVERY_DEF] 961 \\ IMP_RES_TAC f2sexp_IMP 962 \\ FS [f2sexp_def] 963 \\ IMP_RES_TAC f2sexp_IMP 964 \\ FS [f2sexp_def] 965 \\ FS [f2sexp_def,formula_syntax_ok_def,EVERY_DEF,appeal_syntax_ok_thm] 966 \\ REPEAT STRIP_TAC \\ FS [] 967 \\ ONCE_REWRITE_TAC [MilawaTrue_cases] \\ ASM_SIMP_TAC (srw_ss()) [] 968 \\ METIS_TAC []); 969 970val logic_expansion_okp_thm = add_prove( 971 ``appeal_assum ctxt atbl a ==> 972 isTrue (logic_expansion_okp (a2sexp a) atbl) ==> 973 MilawaTrue ctxt (CONCL a)``, 974 SIMP_TAC std_ss [logic_expansion_okp_def,LET_DEF] 975 \\ SRW_TAC [] [] \\ FS [appeal_syntax_ok_thm] 976 \\ IMP_RES_TAC a2sexp_HYPS 977 \\ IMP_RES_TAC a2sexp_SELECT 978 \\ FS [MAP,EVERY_DEF] 979 \\ IMP_RES_TAC f2sexp_IMP 980 \\ FS [f2sexp_def] 981 \\ REPEAT (Q.PAT_X_ASSUM `f2sexp yyy = f2sexp xxx` MP_TAC) 982 \\ FS [f2sexp_def,formula_syntax_ok_def,EVERY_DEF,appeal_syntax_ok_thm] 983 \\ REPEAT STRIP_TAC \\ FS [] 984 \\ IMP_RES_TAC logic_formula_atblp_thm 985 \\ ONCE_REWRITE_TAC [MilawaTrue_cases] \\ ASM_SIMP_TAC (srw_ss()) [] 986 \\ METIS_TAC []); 987 988val logic_propositional_schema_okp_thm = add_prove( 989 ``appeal_assum ctxt atbl a ==> 990 isTrue (logic_propositional_schema_okp (a2sexp a) atbl) ==> 991 MilawaTrue ctxt (CONCL a)``, 992 SIMP_TAC std_ss [logic_propositional_schema_okp_def,LET_DEF] 993 \\ SRW_TAC [] [] \\ FS [appeal_syntax_ok_thm] 994 \\ IMP_RES_TAC a2sexp_HYPS 995 \\ IMP_RES_TAC a2sexp_SELECT 996 \\ FS [MAP,EVERY_DEF] 997 \\ IMP_RES_TAC f2sexp_IMP 998 \\ FS [f2sexp_def] 999 \\ IMP_RES_TAC f2sexp_IMP 1000 \\ FS [f2sexp_def] 1001 \\ REPEAT (Q.PAT_X_ASSUM `f2sexp yyy = f2sexp xxx` MP_TAC) 1002 \\ FS [f2sexp_def,formula_syntax_ok_def,EVERY_DEF,appeal_syntax_ok_thm] 1003 \\ REPEAT STRIP_TAC \\ FS [] 1004 \\ IMP_RES_TAC logic_formula_atblp_thm 1005 \\ ONCE_REWRITE_TAC [MilawaTrue_cases] \\ ASM_SIMP_TAC (srw_ss()) [] 1006 \\ METIS_TAC []); 1007 1008val logic_function_namep_IMP = prove( 1009 ``!x. isTrue (logic_function_namep x) ==> 1010 ?f. (x = logic_func2sexp f) /\ func_syntax_ok f``, 1011 FS [logic_function_namep_def] \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def] 1012 \\ FULL_SIMP_TAC std_ss [memberp_thm] \\ STRIP_TAC 1013 \\ Cases_on `isSym x` \\ FS [] \\ FULL_SIMP_TAC std_ss [isSym_thm] \\ FS [] 1014 \\ REPEAT STRIP_TAC 1015 \\ Cases_on `logic_sym2prim a` THEN1 1016 (POP_ASSUM MP_TAC \\ SIMP_TAC std_ss [logic_sym2prim_def] \\ SRW_TAC [] [] 1017 \\ Q.EXISTS_TAC `mFun a` \\ FS [logic_func2sexp_def,func_syntax_ok_def,MEM]) 1018 \\ Q.EXISTS_TAC `mPrimitiveFun x'` 1019 \\ FULL_SIMP_TAC std_ss [logic_func2sexp_def,func_syntax_ok_def] \\ FS []); 1020 1021val logic_check_functional_axiom_lemma = prove( 1022 ``term_syntax_ok l /\ func_syntax_ok f ==> 1023 (CAR (t2sexp l) = logic_func2sexp f) ==> 1024 ?x2. l = mApp f x2``, 1025 Cases_on `l` \\ FS [t2sexp_def,term_syntax_ok_def] 1026 \\ FULL_SIMP_TAC (srw_ss()) [] \\ REPEAT (Cases_on `l0`) 1027 \\ Cases_on `f` \\ REPEAT (Cases_on `l`) \\ REPEAT (Cases_on `l''`) \\ EVAL_TAC 1028 \\ SIMP_TAC std_ss []); 1029 1030val logic_check_functional_axiom_thm = prove( 1031 ``!f xs ys. 1032 (LENGTH xs = LENGTH ys) ==> 1033 formula_syntax_ok f /\ 1034 EVERY term_syntax_ok (REVERSE xs) /\ 1035 EVERY term_syntax_ok (REVERSE ys) /\ 1036 isTrue (logic_check_functional_axiom 1037 (f2sexp f) 1038 (list2sexp (MAP t2sexp xs)) 1039 (list2sexp (MAP t2sexp ys))) ==> 1040 ?ts g res. 1041 (f = (or_not_equal_list ts 1042 (Equal (mApp g (REVERSE xs ++ (MAP FST ts))) 1043 (mApp g (REVERSE ys ++ (MAP SND ts))))))``, 1044 STRIP_TAC \\ completeInduct_on `formula_size f` \\ NTAC 5 STRIP_TAC 1045 \\ FS [PULL_FORALL_IMP] 1046 \\ ONCE_REWRITE_TAC [logic_check_functional_axiom_def] \\ FS [] 1047 \\ Cases_on `f` \\ FS [f2sexp_def] \\ FULL_SIMP_TAC (srw_ss()) [] \\ FS [] 1048 \\ SRW_TAC [] [] \\ FS [] THEN1 1049 (Cases_on `f'` \\ FS [f2sexp_def] \\ SRW_TAC [] [] \\ FS [] 1050 \\ Cases_on `f` \\ FS [f2sexp_def] \\ SRW_TAC [] [] \\ FS [] 1051 \\ `formula_size f0 < formula_size (Or (Not (Equal l l0)) f0)` by 1052 (EVAL_TAC \\ DECIDE_TAC) 1053 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,GSYM MAP,formula_syntax_ok_def] 1054 \\ Q.PAT_X_ASSUM `!ff xx. bb` (MP_TAC o Q.SPECL [`f0`,`l::xs`,`l0::ys`]) 1055 \\ FS [LENGTH,REVERSE_DEF,EVERY_APPEND,EVERY_DEF] \\ REPEAT STRIP_TAC 1056 \\ FS [GSYM or_not_equal_list_def] 1057 \\ Q.LIST_EXISTS_TAC [`(l,l0)::ts`,`g`] 1058 \\ FS [MAP,REVERSE_DEF] \\ FS [GSYM APPEND_ASSOC,APPEND]) 1059 \\ Q.LIST_EXISTS_TAC [`[]`] 1060 \\ FS [or_not_equal_list_def] \\ SRW_TAC [] [] 1061 \\ IMP_RES_TAC logic_function_namep_IMP 1062 \\ FS [formula_syntax_ok_def] 1063 \\ IMP_RES_TAC logic_check_functional_axiom_lemma 1064 \\ FS [t2sexp_def] \\ FULL_SIMP_TAC (srw_ss()) [] 1065 \\ FS [GSYM rich_listTheory.MAP_REVERSE,term_syntax_ok_def] 1066 \\ `!x y. MEM x x2' /\ MEM y (REVERSE xs) /\ (t2sexp x = t2sexp y) ==> (x = y)` by 1067 (FS [EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC \\ FS []) 1068 \\ `!x y. MEM x x2 /\ MEM y (REVERSE ys) /\ (t2sexp x = t2sexp y) ==> (x = y)` by 1069 (FS [EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC \\ FS []) 1070 \\ IMP_RES_TAC MAP_EQ_MAP \\ FS []) 1071 |> Q.SPECL [`f`,`[]`,`[]`] 1072 |> SIMP_RULE std_ss [REVERSE_DEF,MAP,EVERY_DEF,list2sexp_def,APPEND] 1073 1074val logic_functional_equality_okp_thm = add_prove( 1075 ``appeal_assum ctxt atbl a ==> 1076 isTrue (logic_functional_equality_okp (a2sexp a) atbl) ==> 1077 MilawaTrue ctxt (CONCL a)``, 1078 SIMP_TAC std_ss [logic_functional_equality_okp_def,LET_DEF] 1079 \\ SRW_TAC [] [] \\ FS [appeal_syntax_ok_thm] 1080 \\ IMP_RES_TAC logic_check_functional_axiom_thm 1081 \\ ASM_SIMP_TAC std_ss [] 1082 \\ IMP_RES_TAC logic_formula_atblp_thm 1083 \\ ONCE_REWRITE_TAC [MilawaTrue_cases] \\ ASM_SIMP_TAC (srw_ss()) [] \\ METIS_TAC []); 1084 1085val t2sexp_IMP = prove( 1086 ``term_syntax_ok t ==> (CAR (t2sexp t) = Sym "QUOTE") ==> ?x. t = mConst x``, 1087 Cases_on `t` \\ FS [t2sexp_def] \\ FULL_SIMP_TAC (srw_ss()) [] 1088 \\ Cases_on `l0` \\ TRY (Cases_on `l'`) \\ EVAL_TAC \\ ASM_SIMP_TAC std_ss []); 1089 1090val prims_tm = ``[(logic_IF,[x1;x2;x3]); (logic_EQUAL,[x1;x2]); 1091 (logic_CONSP,[x1]); (logic_CONS,[x1;x2]); 1092 (logic_CAR,[x1]); (logic_CDR,[x1]); 1093 (logic_SYMBOLP,[x1]); (logic_SYMBOL_LESS,[x1;x2]); 1094 (logic_NATP,[x1]); (logic_LESS,[x1;x2]); 1095 (logic_ADD,[x1;x2]); (logic_SUB,[x1;x2:SExp])]`` 1096 1097val logic_base_evaluablep_thm = prove( 1098 ``term_syntax_ok t /\ 1099 isTrue (logic_base_evaluablep (t2sexp t)) ==> 1100 ?p xs x1 x2 x3. 1101 (LENGTH xs = primitive_arity p) /\ 1102 (t = mApp (mPrimitiveFun p) (MAP mConst xs)) /\ 1103 MEM (p,xs) ^prims_tm``, 1104 FS [logic_base_evaluablep_def,LET_DEF] \\ SRW_TAC [] [] \\ FS [] 1105 \\ REPEAT (POP_ASSUM MP_TAC) 1106 \\ FS [logic_initial_arity_table_def] 1107 \\ FULL_SIMP_TAC std_ss [GSYM alist2sexp_def,lookup_thm] 1108 \\ FULL_SIMP_TAC std_ss [LOOKUP_DOT_def] 1109 \\ Cases_on `t` \\ FS [t2sexp_def] \\ SRW_TAC [] [] \\ FS [] 1110 \\ Q.PAT_X_ASSUM `logic_func2sexp l0 = xxx` MP_TAC \\ FS [term_syntax_ok_def] 1111 \\ Cases_on `l0` \\ SRW_TAC [] [logic_func2sexp_def] 1112 \\ FS [func_syntax_ok_def] \\ FULL_SIMP_TAC (srw_ss()) [] \\ Cases_on `l'` 1113 \\ FULL_SIMP_TAC (srw_ss()) [primitive_arity_def,logic_prim2sym_def] 1114 \\ TRY (Cases_on `l` \\ FS [MAP]) 1115 \\ TRY (Cases_on `t` \\ FS [MAP]) 1116 \\ TRY (Cases_on `t'` \\ FS [MAP]) 1117 \\ TRY (Cases_on `t` \\ FS [MAP]) 1118 \\ FULL_SIMP_TAC std_ss [Once logic_constant_listp_def] \\ FS [] 1119 \\ FULL_SIMP_TAC std_ss [Once logic_constant_listp_def] \\ FS [] 1120 \\ FULL_SIMP_TAC std_ss [Once logic_constant_listp_def] \\ FS [] 1121 \\ FULL_SIMP_TAC std_ss [Once logic_constant_listp_def] \\ FS [] 1122 \\ REPEAT (POP_ASSUM MP_TAC) \\ SRW_TAC [] [] 1123 \\ REPEAT (POP_ASSUM MP_TAC) \\ SRW_TAC [] [] \\ FS [] 1124 \\ IMP_RES_TAC t2sexp_IMP 1125 \\ FULL_SIMP_TAC std_ss [MEM] \\ FULL_SIMP_TAC (srw_ss()) []); 1126 1127val logic_unquote_list_thm = add_prove( 1128 ``!xs. logic_unquote_list (list2sexp (MAP t2sexp (MAP mConst xs))) = list2sexp xs``, 1129 Induct \\ ONCE_REWRITE_TAC [logic_unquote_list_def] \\ FS [MAP,t2sexp_def]); 1130 1131val logic_base_evaluator_thm = prove( 1132 ``MEM (p,xs) ^prims_tm ==> 1133 (logic_base_evaluator (t2sexp (mApp (mPrimitiveFun p) (MAP mConst xs))) = 1134 t2sexp (mConst (EVAL_PRIMITIVE p xs)))``, 1135 FS [MEM] \\ REPEAT STRIP_TAC \\ FS [t2sexp_def] 1136 \\ FS [logic_base_evaluator_def,logic_func2sexp_def,LET_DEF,logic_prim2sym_def] 1137 \\ FULL_SIMP_TAC (srw_ss()) [EVAL_PRIMITIVE_def,LISP_IF_def,LISP_CONS_def, 1138 LISP_ADD_def,LISP_SUB_def]); 1139 1140val logic_base_eval_okp_thm = add_prove( 1141 ``appeal_assum ctxt atbl a ==> 1142 isTrue (logic_base_eval_okp (a2sexp a) atbl) ==> 1143 MilawaTrue ctxt (CONCL a)``, 1144 SIMP_TAC std_ss [logic_base_eval_okp_def,LET_DEF] 1145 \\ SRW_TAC [] [] \\ FS [appeal_syntax_ok_thm] 1146 \\ IMP_RES_TAC f2sexp_IMP 1147 \\ FS [f2sexp_def,formula_syntax_ok_def] 1148 \\ MP_TAC (Q.INST [`t`|->`t1`] logic_base_evaluablep_thm) 1149 \\ FULL_SIMP_TAC std_ss [] \\ REPEAT STRIP_TAC 1150 \\ FULL_SIMP_TAC std_ss [] 1151 \\ IMP_RES_TAC logic_base_evaluator_thm 1152 \\ FULL_SIMP_TAC std_ss [t2sexp_11,term_syntax_ok_def] 1153 \\ Q.PAT_X_ASSUM `xxx = t2` (fn th => FULL_SIMP_TAC std_ss [GSYM th]) 1154 \\ ONCE_REWRITE_TAC [MilawaTrue_cases] \\ ASM_SIMP_TAC (srw_ss()) [] \\ METIS_TAC []); 1155 1156val sigmap2sexp_def = (add_rw o Define) ` 1157 (sigmap2sexp [] z = z) /\ 1158 (sigmap2sexp ((x,y)::xs) z = Dot (Dot (Sym x) (t2sexp y)) (sigmap2sexp xs z))`; 1159 1160val lookup_sigmap2sexp_thm = add_prove( 1161 ``~isDot z ==> 1162 !xs a. lookup a (sigmap2sexp xs z) = 1163 LOOKUP a (MAP (\(x,y). (Sym x, (Dot (Sym x) (t2sexp y)))) xs) (Sym "NIL")``, 1164 STRIP_TAC \\ Induct \\ ONCE_REWRITE_TAC [milawa_defsTheory.lookup_def] 1165 \\ FS [LOOKUP_def,MAP] \\ Cases \\ FS [LOOKUP_def,MAP]); 1166 1167val logic_sigmap_thm = prove( 1168 ``!x. isTrue (logic_sigmap x) ==> 1169 ?xs z. (x = sigmap2sexp xs z) /\ ~isDot z``, 1170 REVERSE Induct \\ ONCE_REWRITE_TAC [logic_sigmap_def] \\ FS [] \\ REPEAT STRIP_TAC 1171 THEN1 (Q.EXISTS_TAC `[]` \\ FS []) THEN1 (Q.EXISTS_TAC `[]` \\ FS []) 1172 \\ POP_ASSUM MP_TAC \\ SRW_TAC [] [] \\ FS [] 1173 \\ Cases_on `x` \\ FS [] 1174 \\ Q.PAT_X_ASSUM `isTrue (logic_variablep xxx)` MP_TAC 1175 \\ IMP_RES_TAC logic_termp_thm \\ FS [logic_variablep_def] 1176 \\ SRW_TAC [] [] \\ FS [] \\ FS [isSym_thm] 1177 \\ Q.LIST_EXISTS_TAC [`(a,t)::xs`,`z`] 1178 \\ EVAL_TAC \\ ASM_SIMP_TAC std_ss []); 1179 1180val logic_flag_substitute_thm = prove( 1181 ``!ts. 1182 EVERY term_syntax_ok ts /\ ~isDot z ==> 1183 (logic_flag_substitute (Sym "LIST") (list2sexp (MAP t2sexp ts)) (sigmap2sexp xs z) = 1184 list2sexp (MAP (t2sexp o term_sub xs) ts))``, 1185 STRIP_TAC \\ completeInduct_on `logic_term1_size ts` \\ NTAC 3 STRIP_TAC 1186 \\ FS [PULL_FORALL_IMP] \\ ONCE_REWRITE_TAC [logic_flag_substitute_def] 1187 \\ Cases_on `ts` \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] \\ FS [] 1188 \\ `logic_term1_size t < logic_term1_size (h::t)` by (EVAL_TAC \\ DECIDE_TAC) 1189 \\ FS [] \\ Cases_on `h` \\ ONCE_REWRITE_TAC [logic_flag_substitute_def] 1190 \\ FS [t2sexp_def,term_sub_def,logic_variablep_def,LET_DEF,term_syntax_ok_def] 1191 THEN1 1192 (REPEAT (POP_ASSUM (K ALL_TAC)) \\ Induct_on `xs` 1193 \\ FS [MAP,LOOKUP_def,t2sexp_def,FORALL_PROD] 1194 \\ SRW_TAC [] [] \\ FS [] \\ FS [isTrue_def]) 1195 THEN1 1196 (`logic_term1_size l < logic_term1_size (mApp l0 l::t)` by (EVAL_TAC \\ DECIDE_TAC) 1197 \\ FS [] \\ REPEAT (POP_ASSUM (K ALL_TAC)) \\ Induct_on `l` \\ FS [MAP]) 1198 THEN1 1199 (`logic_term1_size l0 < logic_term1_size (mLamApp l1 l l0::t)` by (EVAL_TAC \\ DECIDE_TAC) 1200 \\ FS [] \\ REPEAT (POP_ASSUM (K ALL_TAC)) \\ Induct_on `l0` \\ FS [MAP])); 1201 1202val logic_substitute_thm = add_prove( 1203 ``term_syntax_ok t /\ ~isDot z ==> 1204 (logic_substitute (t2sexp t) (sigmap2sexp xs z) = t2sexp (term_sub xs t))``, 1205 REPEAT STRIP_TAC \\ MP_TAC (Q.SPEC `[t]` logic_flag_substitute_thm) 1206 \\ FS [EVERY_DEF] 1207 \\ ONCE_REWRITE_TAC [logic_flag_substitute_def] 1208 \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] \\ FS [logic_substitute_def]); 1209 1210val logic_substitute_list_thm = 1211 REWRITE_RULE [GSYM logic_substitute_list_def] logic_flag_substitute_thm; 1212 1213val logic_substitute_formula_thm = prove( 1214 ``!f. formula_syntax_ok f /\ ~isDot z ==> 1215 (logic_substitute_formula (f2sexp f) (sigmap2sexp xs z) = 1216 f2sexp (formula_sub xs f))``, 1217 Induct \\ FS [formula_syntax_ok_def] \\ REPEAT STRIP_TAC \\ FS [] 1218 \\ ONCE_REWRITE_TAC [logic_substitute_formula_def] 1219 \\ FS [LET_DEF,f2sexp_def,formula_sub_def] \\ FULL_SIMP_TAC (srw_ss()) []); 1220 1221val logic_instantiation_okp_thm = add_prove( 1222 ``appeal_assum ctxt atbl a ==> 1223 isTrue (logic_instantiation_okp (a2sexp a) atbl) ==> 1224 MilawaTrue ctxt (CONCL a)``, 1225 SIMP_TAC std_ss [logic_instantiation_okp_def,LET_DEF] 1226 \\ SRW_TAC [] [] \\ FS [appeal_syntax_ok_thm] 1227 \\ IMP_RES_TAC a2sexp_HYPS 1228 \\ IMP_RES_TAC a2sexp_SELECT 1229 \\ FS [MAP] 1230 \\ IMP_RES_TAC logic_sigmap_thm 1231 \\ FS [logic_substitute_formula_thm,EVERY_DEF,appeal_syntax_ok_thm] 1232 \\ IMP_RES_TAC logic_formula_atblp_thm 1233 \\ FS [f2sexp_11] 1234 \\ Q.PAT_X_ASSUM `formula_sub xs (CONCL h1) = CONCL a` (ASSUME_TAC o GSYM) 1235 \\ REPEAT STRIP_TAC \\ FS [] 1236 \\ ONCE_REWRITE_TAC [MilawaTrue_cases] \\ ASM_SIMP_TAC (srw_ss()) [] 1237 \\ METIS_TAC []); 1238 1239val isDot_logic_func2sexp = add_prove( 1240 ``!l0. isDot (logic_func2sexp l0) = F``, 1241 Cases \\ TRY (Cases_on `l`) \\ EVAL_TAC \\ SRW_TAC [] [isDot_def]); 1242 1243val list2sexp_CONS_ZIP = prove( 1244 ``!xs ys. 1245 (LENGTH xs = LENGTH ys) ==> 1246 (list2sexp (CONS_ZIP (MAP Sym xs) (MAP t2sexp ys)) = 1247 sigmap2sexp (ZIP (xs,ys)) (Sym "NIL"))``, 1248 Induct \\ Cases_on `ys` 1249 \\ SRW_TAC [] [sigmap2sexp_def,CONS_ZIP_def,list2sexp_def,LISP_CONS_def]); 1250 1251val logic_beta_reduction_okp_thm = add_prove( 1252 ``appeal_assum ctxt atbl a ==> 1253 isTrue (logic_beta_reduction_okp (a2sexp a) atbl) ==> 1254 MilawaTrue ctxt (CONCL a)``, 1255 SIMP_TAC std_ss [logic_beta_reduction_okp_def,LET_DEF] 1256 \\ SRW_TAC [] [] \\ FS [appeal_syntax_ok_thm] 1257 \\ IMP_RES_TAC a2sexp_HYPS 1258 \\ IMP_RES_TAC a2sexp_SELECT 1259 \\ FS [MAP] 1260 \\ IMP_RES_TAC f2sexp_IMP 1261 \\ IMP_RES_TAC logic_formula_atblp_thm 1262 \\ FS [f2sexp_def] 1263 \\ Cases_on `t1` 1264 \\ FS [t2sexp_def,formula_syntax_ok_def,term_syntax_ok_def] 1265 \\ Q.PAT_X_ASSUM `xxx = t2sexp t2` (MP_TAC o GSYM) 1266 \\ FS [list2sexp_CONS_ZIP,t2sexp_11] \\ REPEAT STRIP_TAC \\ FS [] 1267 \\ REPEAT STRIP_TAC 1268 \\ ONCE_REWRITE_TAC [MilawaTrue_cases] \\ ASM_SIMP_TAC (srw_ss()) [] 1269 \\ METIS_TAC []); 1270 1271val logic_formula_listp_thm = prove( 1272 ``!x. isTrue (logic_formula_listp x) ==> 1273 ?qs r. EVERY formula_syntax_ok qs /\ 1274 (x = anylist2sexp (MAP f2sexp qs) r) /\ ~isDot r``, 1275 REVERSE Induct \\ ONCE_REWRITE_TAC [logic_formula_listp_def] 1276 \\ FS [MAP] \\ REPEAT STRIP_TAC 1277 THEN1 (Q.EXISTS_TAC `[]` \\ EVAL_TAC \\ SIMP_TAC std_ss [isDot_def]) 1278 THEN1 (Q.EXISTS_TAC `[]` \\ EVAL_TAC \\ SIMP_TAC std_ss [isDot_def]) 1279 \\ POP_ASSUM MP_TAC \\ SRW_TAC [] [] \\ FS [] 1280 \\ IMP_RES_TAC logic_formulap_thm 1281 \\ Q.LIST_EXISTS_TAC [`t::qs`,`r`] \\ FS [EVERY_DEF,MAP]); 1282 1283val logic_substitute_each_sigma_into_formula_thm = prove( 1284 ``!ys. 1285 formula_syntax_ok f /\ EVERY (\(xs,z). ~isDot z) ys /\ ~isDot r ==> 1286 (logic_substitute_each_sigma_into_formula (f2sexp f) 1287 (anylist2sexp (MAP (\(xs,z). sigmap2sexp xs z) ys) r) = 1288 list2sexp (MAP (\s. f2sexp (formula_sub s f)) (MAP FST ys)))``, 1289 Induct \\ ONCE_REWRITE_TAC [logic_substitute_each_sigma_into_formula_def] 1290 \\ FS [MAP,FORALL_PROD,logic_substitute_formula_thm,EVERY_DEF]) 1291 1292val logic_pnot_thm = prove( 1293 ``logic_pnot (f2sexp f) = f2sexp (Not f)``, 1294 FS [f2sexp_def]); 1295 1296val logic_make_induction_step_lemma = prove( 1297 ``!ys. MAP (\(xs,z). f2sexp (formula_sub xs (Not f))) ys = 1298 MAP f2sexp (MAP (\(xs,z). formula_sub xs (Not f)) ys)``, 1299 Induct \\ SRW_TAC [] [] \\ Cases_on `h` \\ SRW_TAC [] []); 1300 1301val logic_make_induction_step_thm = prove( 1302 ``!ys. 1303 formula_syntax_ok f /\ EVERY ( \ (xs,z). ~isDot z) ys /\ ~isDot r ==> 1304 (logic_make_induction_step (f2sexp f) (f2sexp q_i) 1305 (anylist2sexp (MAP ( \ (xs,z). sigmap2sexp xs z) ys) r) = 1306 f2sexp (or_list (f::Not q_i::MAP ( \ s. formula_sub s (Not f)) (MAP FST ys))))``, 1307 FULL_SIMP_TAC std_ss [logic_make_induction_step_def,formula_syntax_ok_def, 1308 logic_substitute_each_sigma_into_formula_thm,logic_pnot_thm] 1309 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,LISP_CONS_def] 1310 \\ ASSUME_TAC (GSYM (GEN_ALL (Q.SPEC `(x::xs)` logic_disjoin_formulas_thm))) 1311 \\ FULL_SIMP_TAC (srw_ss()) [logic_make_induction_step_lemma,MAP_MAP_o] 1312 \\ REPEAT STRIP_TAC \\ AP_TERM_TAC \\ AP_TERM_TAC \\ AP_TERM_TAC 1313 \\ AP_TERM_TAC \\ AP_THM_TAC \\ AP_TERM_TAC \\ FS [FUN_EQ_THM]); 1314 1315val logic_make_induction_steps_thm = prove( 1316 ``!qs yss. 1317 formula_syntax_ok f /\ ~isDot r /\ ~isDot r2 /\ 1318 EVERY (\ (ys,r). EVERY ( \ (xs,z). ~isDot z) ys /\ ~isDot r) yss /\ 1319 (LENGTH qs = LENGTH yss) ==> 1320 (logic_make_induction_steps (f2sexp f) (anylist2sexp (MAP f2sexp qs) r2) 1321 (anylist2sexp (MAP (\ (ys,r). anylist2sexp 1322 (MAP (\ (xs,z). sigmap2sexp xs z) ys) r) yss) r) = 1323 list2sexp (MAP (\(q_i,ys,r). f2sexp 1324 (or_list (f::Not q_i::MAP ( \s. formula_sub s (Not f)) (MAP FST ys)))) (ZIP (qs,yss))))``, 1325 Induct \\ ONCE_REWRITE_TAC [logic_make_induction_steps_def] 1326 \\ Cases_on `yss` \\ FS [LENGTH,MAP,ZIP,ADD1,EVERY_DEF, 1327 logic_make_induction_step_thm] 1328 \\ Cases_on `h` \\ FS [LENGTH,MAP,ZIP,ADD1,EVERY_DEF, 1329 logic_make_induction_step_thm]); 1330 1331val ordp = ``mApp (mPrimitiveFun logic_ORDP)`` 1332val ord_less = ``mApp (mPrimitiveFun logic_ORD_LESS)`` 1333 1334val logic_make_measure_step_thm = add_prove( 1335 ``formula_syntax_ok q_i /\ ~isDot z /\ term_syntax_ok m ==> 1336 (logic_make_measure_step (t2sexp m) (f2sexp q_i) (sigmap2sexp s z) = 1337 f2sexp (Or (Not q_i) (Equal (^ord_less [term_sub s m;m]) (mConst (Sym "T")))))``, 1338 FS [logic_make_measure_step_def,f2sexp_def,t2sexp_def,MAP] \\ EVAL_TAC); 1339 1340val logic_make_measure_steps_thm = add_prove( 1341 ``!ys. 1342 formula_syntax_ok q_i /\ EVERY ( \ (xs,z). ~isDot z) ys /\ 1343 term_syntax_ok m /\ ~isDot r ==> 1344 (logic_make_measure_steps (t2sexp m) (f2sexp q_i) 1345 (anylist2sexp (MAP ( \ (s,z). sigmap2sexp s z) ys) r) = 1346 list2sexp (MAP ( \ (s,z). 1347 f2sexp (Or (Not q_i) (Equal (^ord_less [term_sub s m;m]) (mConst (Sym "T"))))) 1348 ys))``, 1349 Induct \\ ONCE_REWRITE_TAC [logic_make_measure_steps_def] \\ FS [MAP] 1350 \\ Cases \\ FS [EVERY_DEF]); 1351 1352val logic_make_all_measure_steps_thm = add_prove( 1353 ``!qs yss f. 1354 term_syntax_ok m /\ ~isDot r /\ ~isDot r2 /\ 1355 EVERY (\ (ys,r). EVERY ( \ (xs,z). ~isDot z) ys /\ ~isDot r) yss /\ 1356 EVERY formula_syntax_ok qs /\ (LENGTH qs = LENGTH yss) ==> 1357 (logic_make_all_measure_steps (t2sexp m) (anylist2sexp (MAP f2sexp qs) r2) 1358 (anylist2sexp (MAP (\ (ys,r). anylist2sexp 1359 (MAP (\ (xs,z). sigmap2sexp xs z) ys) r) yss) r) = 1360 list2sexp (FLAT (MAP (\ (q_i,ys,r). 1361 (MAP ( \ (s,z). 1362 f2sexp (Or (Not q_i) (Equal (^ord_less [term_sub s m;m]) (mConst (Sym "T"))))) 1363 ys)) 1364 (ZIP(qs,yss)))))``, 1365 Induct \\ SIMP_TAC std_ss [] 1366 \\ ONCE_REWRITE_TAC [logic_make_all_measure_steps_def] 1367 \\ Cases_on `yss` \\ FS [LENGTH,MAP,ZIP,ADD1,EVERY_DEF,FLAT,EVERY_DEF] 1368 \\ Cases_on `h` \\ FS [LENGTH,MAP,ZIP,ADD1,EVERY_DEF,FLAT,EVERY_DEF]); 1369 1370val a2sexp_HYPS = prove( 1371 ``!a. CAR (CDR (CDR (a2sexp a))) = list2sexp (MAP a2sexp (HYPS a))``, 1372 Cases \\ Cases_on `o'` THEN1 EVAL_TAC \\ Cases_on `x` \\ EVAL_TAC \\ FS []); 1373 1374val MAP_CAR_CDR_a2sexp = add_prove( 1375 ``!xs. MAP (CAR o CDR) (MAP a2sexp xs) = MAP f2sexp (MAP CONCL xs)``, 1376 Induct \\ SRW_TAC [] [a2sexp_def] \\ Cases_on `h` \\ FS []); 1377 1378val logic_make_ordinal_step_thm = add_prove( 1379 ``logic_make_ordinal_step (t2sexp m) = 1380 f2sexp (Equal (^ordp [m]) (mConst (Sym "T")))``, 1381 EVAL_TAC); 1382 1383val MEM_f2sexp = add_prove( 1384 ``!xs. MEM (f2sexp x) (MAP f2sexp xs) = MEM x xs``, 1385 Induct \\ SRW_TAC [] [f2sexp_11]); 1386 1387val logic_disjoin_formulas_alt = add_prove( 1388 ``!xs. ~isDot r ==> 1389 (logic_disjoin_formulas (anylist2sexp (MAP f2sexp xs) r) = 1390 if xs = [] then Sym "NIL" else f2sexp (or_list xs))``, 1391 Induct \\ ONCE_REWRITE_TAC [logic_disjoin_formulas_def] \\ FS [MAP] 1392 \\ REPEAT STRIP_TAC \\ Cases_on `xs` \\ FS [or_list_def,MAP,f2sexp_def]); 1393 1394val logic_sigma_listp_thm = prove( 1395 ``!x. isTrue (logic_sigma_listp x) ==> 1396 ?ys r. (x = anylist2sexp (MAP (\(xs,z). sigmap2sexp xs z) ys) r) /\ 1397 EVERY (\(xs,z). ~isDot z) ys /\ ~(isDot r)``, 1398 REVERSE Induct \\ ONCE_REWRITE_TAC [logic_sigma_listp_def] 1399 \\ FS [MAP] \\ REPEAT STRIP_TAC 1400 THEN1 (Q.EXISTS_TAC `[]` \\ EVAL_TAC \\ SIMP_TAC std_ss [isDot_def]) 1401 THEN1 (Q.EXISTS_TAC `[]` \\ EVAL_TAC \\ SIMP_TAC std_ss [isDot_def]) 1402 \\ POP_ASSUM MP_TAC \\ SRW_TAC [] [] \\ FS [] 1403 \\ IMP_RES_TAC logic_sigmap_thm \\ FS [] 1404 \\ Q.LIST_EXISTS_TAC [`(xs,z)::ys`,`r`] \\ FS [EVERY_DEF,MAP]); 1405 1406val logic_sigma_list_listp_thm = prove( 1407 ``!x. isTrue (logic_sigma_list_listp x) ==> 1408 ?yss r. (x = (anylist2sexp (MAP ( \ (ys,r). 1409 anylist2sexp (MAP ( \ (xs,z). sigmap2sexp xs z) ys) r) yss) r)) /\ 1410 EVERY ( \ (ys,r). EVERY ( \ (xs,z). ~isDot z) ys /\ ~(isDot r)) yss /\ 1411 ~(isDot r)``, 1412 REVERSE Induct \\ ONCE_REWRITE_TAC [logic_sigma_list_listp_def] 1413 \\ FS [MAP] \\ REPEAT STRIP_TAC 1414 THEN1 (Q.EXISTS_TAC `[]` \\ EVAL_TAC \\ SIMP_TAC std_ss [isDot_def]) 1415 THEN1 (Q.EXISTS_TAC `[]` \\ EVAL_TAC \\ SIMP_TAC std_ss [isDot_def]) 1416 \\ POP_ASSUM MP_TAC \\ SRW_TAC [] [] \\ FS [] 1417 \\ IMP_RES_TAC logic_sigma_listp_thm \\ FS [] 1418 \\ Q.LIST_EXISTS_TAC [`(ys,r')::yss`,`r`] \\ FS [EVERY_DEF,MAP]); 1419 1420val len_anlist2sexp = add_prove( 1421 ``!xs. ~isDot r ==> (len (anylist2sexp xs r) = Val (LENGTH xs))``, 1422 Induct \\ ONCE_REWRITE_TAC [len_def] 1423 \\ FS [LENGTH,ADD1] \\ REPEAT STRIP_TAC \\ DECIDE_TAC); 1424 1425val MAP_FST_ZIP = prove( 1426 ``!xs ys. (LENGTH xs = LENGTH ys) ==> (MAP FST (ZIP (xs,ys)) = xs)``, 1427 Induct \\ Cases_on `ys` \\ FS [LENGTH,ADD1,ZIP,MAP]); 1428 1429val PULL_EXISTS_IMP = METIS_PROVE [] ``((?x. P x) ==> b) = !x. P x ==> b`` 1430val PULL_CONJ = METIS_PROVE [] 1431 ``((?x. P x) /\ Q = ?x. P x /\ Q) /\ 1432 (Q /\ (?x. P x) = ?x. Q /\ P x)`` 1433 1434val logic_induction_okp_thm = add_prove( 1435 ``appeal_assum ctxt atbl a ==> 1436 isTrue (logic_induction_okp (a2sexp a)) ==> 1437 MilawaTrue ctxt (CONCL a)``, 1438 SIMP_TAC std_ss [logic_induction_okp_def,LET_DEF] 1439 \\ SRW_TAC [] [] \\ FS [appeal_syntax_ok_thm] 1440 \\ IMP_RES_TAC a2sexp_HYPS 1441 \\ IMP_RES_TAC a2sexp_SELECT 1442 \\ FS [MAP] 1443 \\ `?mx qsx sigsx. CAR (CDR (CDR (CDR (a2sexp a)))) = list2sexp [mx;qsx;sigsx]` by 1444 (FS [list_exists_def] \\ Cases_on `xs` \\ FS [LENGTH,ADD1] 1445 \\ Cases_on `t` \\ FS [LENGTH,ADD1] 1446 \\ Cases_on `t'` \\ FS [LENGTH,ADD1] 1447 \\ Cases_on `t` \\ FS [LENGTH,ADD1] \\ DECIDE_TAC) 1448 \\ FS [] \\ IMP_RES_TAC logic_termp_thm \\ FS [a2sexp_HYPS] 1449 \\ IMP_RES_TAC logic_formula_listp_thm \\ FS [] 1450 \\ IMP_RES_TAC logic_sigma_list_listp_thm \\ FS [] 1451 \\ FS [logic_make_basis_step_def] 1452 \\ FULL_SIMP_TAC std_ss [GSYM anylist2sexp_def,logic_disjoin_formulas_alt, 1453 GSYM MAP,NOT_CONS_NIL] \\ FS [] 1454 \\ ONCE_REWRITE_TAC [MilawaTrue_cases] 1455 \\ REPEAT DISJ2_TAC 1456 \\ Q.ABBREV_TAC `qss = MAP (MAP FST o FST) yss` 1457 \\ Q.LIST_EXISTS_TAC [`ZIP (qs,qss)`,`t`] 1458 \\ `LENGTH qs = LENGTH qss` by 1459 (Q.UNABBREV_TAC `qss` \\ SRW_TAC [] [] \\ FS [LENGTH_MAP]) 1460 \\ FS [LENGTH_MAP,MAP_FST_ZIP] 1461 \\ `MilawaTrue ctxt (or_list (CONCL a::qs))` by FS [EVERY_MEM] 1462 \\ `MilawaTrue ctxt (Equal (mApp (mPrimitiveFun logic_ORDP) [t]) 1463 (mConst (Sym "T")))` by FS [EVERY_MEM] 1464 \\ FULL_SIMP_TAC std_ss [] 1465 \\ REPEAT (Q.PAT_X_ASSUM `isTrue xxx` MP_TAC) 1466 \\ FS [logic_make_all_measure_steps_thm] 1467 \\ FS [logic_make_induction_steps_thm] 1468 \\ FS [SUBSET_DEF,MEM_FLAT,MEM_MAP,f2sexp_11, 1469 PULL_EXISTS_IMP,EXISTS_PROD,PULL_CONJ] 1470 \\ REPEAT STRIP_TAC 1471 \\ `?x1 zs1. MEM (q,zs1,x1) (ZIP (qs,yss)) /\ (ss = MAP FST zs1)` by 1472 (Q.PAT_X_ASSUM `MEM (q,ss) (ZIP (qs,qss))` MP_TAC \\ Q.UNABBREV_TAC `qss` 1473 \\ FULL_SIMP_TAC std_ss [MEM_ZIP] \\ REPEAT STRIP_TAC 1474 \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [EL_MAP] \\ REPEAT STRIP_TAC 1475 \\ Q.EXISTS_TAC `SND (EL n yss)` 1476 \\ Q.EXISTS_TAC `FST (EL n yss)` 1477 \\ FS [] \\ Q.EXISTS_TAC `n` \\ FS []) 1478 \\ FS [] \\ RES_TAC \\ FS [EVERY_MEM,MEM_MAP,formula_sub_def] 1479 \\ Q.PAT_X_ASSUM `!e. bbb ==> MilawaTrue ctxt e` MATCH_MP_TAC 1480 THEN1 (METIS_TAC []) 1481 \\ Cases_on `y'''` \\ FS [] \\ RES_TAC \\ METIS_TAC []); 1482 1483val logic_appeal_step_okp_thm = add_prove( 1484 ``appeal_assum ctxt atbl a /\ thms_inv ctxt thms /\ thms_inv ctxt axioms ==> 1485 isTrue (logic_appeal_step_okp (a2sexp a) (list2sexp (MAP f2sexp axioms)) 1486 (list2sexp (MAP f2sexp thms)) atbl) ==> 1487 MilawaTrue ctxt (CONCL a)``, 1488 SIMP_TAC std_ss [logic_appeal_step_okp_def,LET_DEF] \\ SRW_TAC [] [] 1489 \\ IMP_RES_TAC logic_axiom_okp_thm \\ ASM_SIMP_TAC std_ss [] 1490 \\ IMP_RES_TAC logic_theorem_okp_thm \\ ASM_SIMP_TAC std_ss [] 1491 \\ IMP_RES_TAC logic_propositional_schema_okp_thm \\ ASM_SIMP_TAC std_ss [] 1492 \\ IMP_RES_TAC logic_functional_equality_okp_thm \\ ASM_SIMP_TAC std_ss [] 1493 \\ IMP_RES_TAC logic_expansion_okp_thm \\ ASM_SIMP_TAC std_ss [] 1494 \\ IMP_RES_TAC logic_contraction_okp_thm \\ ASM_SIMP_TAC std_ss [] 1495 \\ IMP_RES_TAC logic_beta_reduction_okp_thm \\ ASM_SIMP_TAC std_ss [] 1496 \\ IMP_RES_TAC logic_associativity_okp_thm \\ ASM_SIMP_TAC std_ss [] 1497 \\ IMP_RES_TAC logic_cut_okp_thm \\ ASM_SIMP_TAC std_ss [] 1498 \\ IMP_RES_TAC logic_instantiation_okp_thm \\ ASM_SIMP_TAC std_ss [] 1499 \\ IMP_RES_TAC logic_induction_okp_thm \\ ASM_SIMP_TAC std_ss [] 1500 \\ IMP_RES_TAC logic_base_eval_okp_thm \\ ASM_SIMP_TAC std_ss [] 1501 \\ FS []); 1502 1503val logic_flag_proofp_thm = prove( 1504 ``!al. 1505 EVERY appeal_syntax_ok al /\ atbl_ok ctxt atbl /\ 1506 thms_inv ctxt thms /\ thms_inv ctxt axioms ==> 1507 isTrue (logic_flag_proofp (Sym "LIST") 1508 (list2sexp (MAP a2sexp al)) 1509 (list2sexp (MAP f2sexp axioms)) 1510 (list2sexp (MAP f2sexp thms)) atbl) ==> 1511 EVERY (MilawaTrue ctxt o CONCL) al``, 1512 STRIP_TAC \\ completeInduct_on `logic_appeal3_size al` \\ NTAC 3 STRIP_TAC 1513 \\ FS [PULL_FORALL_IMP] \\ Cases_on `al` \\ FS [EVERY_DEF] 1514 \\ ONCE_REWRITE_TAC [logic_flag_proofp_def] 1515 \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] \\ FS [MAP] \\ SRW_TAC [] [] \\ FS [] 1516 \\ `logic_appeal3_size t < logic_appeal3_size (h::t)` by (EVAL_TAC \\ DECIDE_TAC) 1517 \\ FS [] \\ POP_ASSUM (K ALL_TAC) \\ POP_ASSUM (K ALL_TAC) \\ POP_ASSUM MP_TAC 1518 \\ ONCE_REWRITE_TAC [logic_flag_proofp_def] \\ FS [a2sexp_HYPS] 1519 \\ SRW_TAC [] [] \\ FS [] 1520 \\ MATCH_MP_TAC (REWRITE_RULE [AND_IMP_INTRO] logic_appeal_step_okp_thm) 1521 \\ FS [AND_IMP_INTRO,REWRITE_RULE [GSYM o_DEF] EVERY_MAP] 1522 \\ Q.PAT_X_ASSUM `!xx.bbb` MATCH_MP_TAC 1523 \\ FULL_SIMP_TAC std_ss [] 1524 \\ Cases_on `h` \\ Cases_on `o'` \\ FULL_SIMP_TAC std_ss [HYPS_def,EVERY_DEF] 1525 THEN1 (EVAL_TAC \\ DECIDE_TAC) 1526 \\ Cases_on `x` \\ FULL_SIMP_TAC std_ss [HYPS_def,EVERY_DEF,appeal_syntax_ok_def] 1527 \\ FS [EVERY_MEM] \\ EVAL_TAC \\ DECIDE_TAC); 1528 1529val logic_proofp_thm = prove( 1530 ``appeal_syntax_ok a /\ atbl_ok ctxt atbl /\ 1531 thms_inv ctxt thms /\ thms_inv ctxt axioms ==> 1532 isTrue (logic_proofp (a2sexp a) (list2sexp (MAP f2sexp axioms)) 1533 (list2sexp (MAP f2sexp thms)) atbl) ==> 1534 MilawaTrue ctxt (CONCL a)``, 1535 REPEAT STRIP_TAC \\ MP_TAC (Q.SPEC `[a]` logic_flag_proofp_thm) 1536 \\ FS [EVERY_DEF] \\ ONCE_REWRITE_TAC [logic_flag_proofp_def] 1537 \\ FS [MAP,logic_proofp_def] \\ FULL_SIMP_TAC (srw_ss()) [] 1538 \\ ONCE_REWRITE_TAC [logic_flag_proofp_def] \\ FS [] 1539 \\ FULL_SIMP_TAC (srw_ss()) [] \\ FS []); 1540 1541 1542 1543 1544val callmap2sexp_def = Define ` 1545 callmap2sexp ts = 1546 list2sexp (MAP (\(xs,ys). Dot (list2sexp (MAP t2sexp xs)) 1547 (list2sexp (MAP t2sexp ys))) ts)`; 1548 1549val app_EQ_list2sexp = prove( 1550 ``!y ys. (app y (Sym "NIL") = list2sexp ys) /\ isTrue (true_listp y) ==> 1551 (y = list2sexp ys)``, 1552 REVERSE Induct \\ ONCE_REWRITE_TAC [app_def] \\ FS [] 1553 \\ Cases_on `ys` \\ FS [] 1554 \\ ONCE_REWRITE_TAC [list_fix_def] \\ FS [] 1555 \\ REPEAT STRIP_TAC \\ FS [] \\ Cases_on `xs` \\ FS []); 1556 1557val true_listp_nil = prove( 1558 ``isTrue (true_listp (Sym "NIL"))``, 1559 EVAL_TAC); 1560 1561val true_listp_cons = prove( 1562 ``isTrue (true_listp (LISP_CONS x y)) = isTrue (true_listp y)``, 1563 SIMP_TAC std_ss [Once true_listp_def] \\ FS []); 1564 1565val true_listp_list_fix = prove( 1566 ``!y. isTrue (true_listp (list_fix y))``, 1567 REVERSE Induct 1568 THEN1 (EVAL_TAC \\ SIMP_TAC std_ss []) 1569 THEN1 (EVAL_TAC \\ SIMP_TAC std_ss []) 1570 \\ ONCE_REWRITE_TAC [list_fix_def] 1571 \\ SIMP_TAC std_ss [LISP_CONSP_def,isDot_def,LISP_TEST_def,isTrue_def] 1572 \\ SRW_TAC [] [CAR_def,CDR_def,true_listp_cons,LISP_CONS_def] 1573 \\ ONCE_REWRITE_TAC [true_listp_def] \\ FS [] \\ EVAL_TAC); 1574 1575val true_listp_app = prove( 1576 ``!x y. isTrue (true_listp (app x y))``, 1577 Induct \\ ONCE_REWRITE_TAC [app_def] 1578 \\ FULL_SIMP_TAC std_ss [isTrue_CLAUSES, 1579 isDot_def,CAR_def,CDR_def,true_listp_cons,true_listp_list_fix]); 1580 1581val true_listp_logic_flag_callmap_list = prove( 1582 ``isTrue (true_listp (logic_flag_callmap (Sym "LIST") y z))``, 1583 ONCE_REWRITE_TAC [logic_flag_callmap_def] \\ SIMP_TAC std_ss [LET_DEF] 1584 \\ SRW_TAC [] [] \\ FULL_SIMP_TAC std_ss [true_listp_app] \\ FS [] 1585 \\ Q.EXISTS_TAC `[]` \\ FS []); 1586 1587val true_listp_logic_flag_callmap = prove( 1588 ``isTrue (true_listp (logic_flag_callmap x y z))``, 1589 ONCE_REWRITE_TAC [logic_flag_callmap_def] 1590 \\ FULL_SIMP_TAC std_ss [LET_DEF] \\ SRW_TAC [] [] 1591 \\ FULL_SIMP_TAC std_ss [true_listp_nil,true_listp_cons,true_listp_app] 1592 \\ FULL_SIMP_TAC std_ss [true_listp_logic_flag_callmap_list]); 1593 1594val logic_flag_callmap_TERM = prove( 1595 ``(logic_flag_callmap (Sym "LIST") (Sym name) (Dot (t2sexp x) (Sym "NIL")) = 1596 callmap2sexp (callmap name x)) ==> 1597 (logic_flag_callmap (Sym "TERM") (Sym name) (t2sexp x) = 1598 callmap2sexp (callmap name x))``, 1599 SIMP_TAC std_ss [Once logic_flag_callmap_def] \\ FS [] 1600 \\ Q.ABBREV_TAC `y = logic_flag_callmap (Sym "TERM") (Sym name) (t2sexp x)` 1601 \\ SIMP_TAC std_ss [Once logic_flag_callmap_def] \\ FS [] 1602 \\ FS [callmap2sexp_def] \\ REPEAT STRIP_TAC 1603 \\ MATCH_MP_TAC app_EQ_list2sexp \\ ASM_SIMP_TAC std_ss [] 1604 \\ Q.UNABBREV_TAC `y` \\ FS [true_listp_logic_flag_callmap]); 1605 1606val t2sexp_mApp_mPrimitiveFun = prove( 1607 ``t2sexp (mApp (mPrimitiveFun logic_NOT) [x1]) = 1608 Dot (Sym "NOT") (Dot (t2sexp x1) (Sym "NIL"))``, 1609 EVAL_TAC); 1610 1611val cons_onto_ranges_thm = prove( 1612 ``!xs. cons_onto_ranges (t2sexp x1) (callmap2sexp xs) = 1613 callmap2sexp (MAP (\(x,y). (x,x1::y)) xs)``, 1614 Induct THEN1 EVAL_TAC \\ Cases \\ FS [MAP,callmap2sexp_def] 1615 \\ ONCE_REWRITE_TAC [cons_onto_ranges_def] \\ FS []); 1616 1617val logic_func2sexp_NEQ_IF = prove( 1618 ``func_syntax_ok l0 /\ ~(l0 = mPrimitiveFun logic_IF) ==> 1619 ~(logic_func2sexp l0 = Sym "IF")``, 1620 REPEAT STRIP_TAC \\ Cases_on `l0` \\ FULL_SIMP_TAC (srw_ss()) [] 1621 \\ REPEAT (Cases_on `l`) 1622 \\ FULL_SIMP_TAC (srw_ss()) [logic_func2sexp_def,logic_prim2sym_def] 1623 \\ POP_ASSUM MP_TAC \\ SRW_TAC [] [] \\ FULL_SIMP_TAC std_ss []); 1624 1625val sigmap2sexp_intro = add_prove( 1626 ``!xs ys. 1627 (LENGTH xs = LENGTH ys) ==> 1628 (list2sexp (CONS_ZIP (MAP Sym xs) (MAP t2sexp ys)) = 1629 sigmap2sexp (ZIP (xs, ys)) (Sym "NIL"))``, 1630 Induct \\ Cases_on `ys` \\ FS [LENGTH,ADD,ZIP,MAP,ADD1,CONS_ZIP_def]); 1631 1632val logic_substitute_callmap_thm = prove( 1633 ``!ts xs. 1634 EVERY (EVERY term_syntax_ok o FST) ts /\ 1635 EVERY (EVERY term_syntax_ok o SND) ts ==> 1636 (logic_substitute_callmap (callmap2sexp ts) (sigmap2sexp xs (Sym "NIL")) = 1637 callmap2sexp (callmap_sub xs ts))``, 1638 Induct \\ ONCE_REWRITE_TAC [logic_substitute_callmap_def] 1639 \\ FS [callmap2sexp_def,callmap_sub_def,MAP,EVERY_DEF] \\ Cases_on `h` 1640 \\ FS [callmap2sexp_def,callmap_sub_def,MAP,LET_DEF] 1641 \\ FS [logic_substitute_list_thm,isDot_def,GSYM MAP_MAP_o]); 1642 1643val LOOKUP_IMP = prove( 1644 ``!xs. EVERY (P o SND) xs /\ P y ==> P (LOOKUP s xs y)``, 1645 Induct \\ SIMP_TAC std_ss [LOOKUP_def] \\ Cases 1646 \\ SIMP_TAC std_ss [LOOKUP_def,EVERY_DEF] \\ SRW_TAC [] [] \\ FS []); 1647 1648val term_syntax_ok_term_sub = prove( 1649 ``term_syntax_ok t /\ EVERY (term_syntax_ok o SND) xs ==> 1650 term_syntax_ok (term_sub xs t)``, 1651 completeInduct_on `logic_term_size t` \\ NTAC 3 STRIP_TAC 1652 \\ FS [PULL_FORALL_IMP] \\ Cases_on `t` 1653 \\ FULL_SIMP_TAC std_ss [term_sub_def,term_syntax_ok_def,LENGTH_MAP] 1654 THEN1 (MATCH_MP_TAC LOOKUP_IMP \\ FULL_SIMP_TAC std_ss [term_syntax_ok_def]) 1655 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,MEM_MAP,PULL_EXISTS_IMP,AND_IMP_INTRO] 1656 \\ REPEAT STRIP_TAC \\ Q.PAT_X_ASSUM `!t. b1 /\ b2 ==> b3` MATCH_MP_TAC \\ FS [] 1657 \\ EVAL_TAC \\ IMP_RES_TAC MEM_logic_term_size \\ DECIDE_TAC); 1658 1659val logic_flag_callmap_thm = prove( 1660 ``!ts. 1661 EVERY term_syntax_ok ts /\ EVERY (term_ok ctxt) ts /\ 1662 (logic_func2sexp (mFun name) = Sym name) ==> 1663 (logic_flag_callmap (Sym "LIST") (Sym name) (list2sexp (MAP t2sexp ts)) = 1664 callmap2sexp (FLAT (MAP (callmap name) ts))) /\ 1665 EVERY (EVERY term_syntax_ok o FST) (FLAT (MAP (callmap name) ts)) /\ 1666 EVERY (EVERY term_syntax_ok o SND) (FLAT (MAP (callmap name) ts)) /\ 1667 EVERY (\x. LENGTH (FST x) = LENGTH (FST (ctxt ' name))) 1668 (FLAT (MAP (callmap name) ts))``, 1669 STRIP_TAC \\ completeInduct_on `logic_term1_size ts` \\ NTAC 3 STRIP_TAC 1670 \\ FS [PULL_FORALL_IMP] \\ Cases_on `ts` 1671 \\ ONCE_REWRITE_TAC [logic_flag_callmap_def] 1672 \\ FS [MAP,FLAT,callmap2sexp_def,MAP_APPEND,EVERY_DEF,EVERY_APPEND] 1673 \\ `logic_term1_size t < logic_term1_size (h::t)` by (EVAL_TAC \\ DECIDE_TAC) 1674 \\ sg `(logic_flag_callmap (Sym "TERM") (Sym name) (t2sexp h) = 1675 callmap2sexp (callmap name h)) /\ 1676 EVERY (EVERY term_syntax_ok o FST) (callmap name h) /\ 1677 EVERY (EVERY term_syntax_ok o SND) (callmap name h) /\ 1678 EVERY (\x. LENGTH (FST x) = LENGTH (FST (ctxt ' name))) (callmap name h)` 1679 \\ FS [callmap2sexp_def] 1680 \\ ONCE_REWRITE_TAC [logic_flag_callmap_def] \\ FS [LET_DEF,MAP] 1681 \\ Cases_on `h` \\ FS [t2sexp_def,callmap_def,MAP, 1682 logic_variablep_def,term_syntax_ok_def,EVERY_DEF] 1683 THEN1 1684 (Cases_on `l0 = mPrimitiveFun logic_IF` THEN1 1685 (FS [logic_func2sexp_def,logic_prim2sym_def,GSYM callmap2sexp_def] 1686 \\ FS [func_syntax_ok_def,term_ok_def,func_arity_def,primitive_arity_def] 1687 \\ FS [LENGTH_MAP] 1688 \\ `?x1 x2 x3. l = [x1;x2;x3]` by 1689 (Cases_on `l` \\ FULL_SIMP_TAC std_ss [LENGTH] 1690 \\ Cases_on `t'` \\ FULL_SIMP_TAC std_ss [LENGTH] 1691 \\ Cases_on `t''` \\ FULL_SIMP_TAC std_ss [LENGTH] 1692 \\ Cases_on `t'` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,CONS_11] 1693 \\ `F` by DECIDE_TAC) 1694 \\ FS [EVERY_DEF,MAP,EL,HD,TL,EVAL ``EL 1 (x1::x2::x3::xs)``, 1695 EVAL ``EL 2 (x1::x2::x3::xs)``] 1696 \\ Q.PAT_X_ASSUM `!ts.bbb` (fn th => 1697 (MP_TAC o Q.SPEC `[x1]`) th THEN 1698 (MP_TAC o Q.SPEC `[x2]`) th THEN 1699 (MP_TAC o Q.SPEC `[x3]`) th) 1700 \\ FS [EVERY_DEF,MAP,FLAT,APPEND_NIL] 1701 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) \\ STRIP_TAC 1702 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) \\ STRIP_TAC 1703 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) \\ STRIP_TAC 1704 \\ IMP_RES_TAC logic_flag_callmap_TERM \\ FS [] 1705 \\ FULL_SIMP_TAC std_ss [GSYM t2sexp_mApp_mPrimitiveFun,cons_onto_ranges_thm] 1706 \\ FS [callmap2sexp_def,MAP_APPEND] \\ FS [APPEND_ASSOC] 1707 \\ FS [EVERY_APPEND,EVERY_MAP] 1708 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 1709 \\ FS [EVERY_DEF,term_syntax_ok_def,func_syntax_ok_def] 1710 \\ FS [o_DEF]) 1711 \\ FS [logic_func2sexp_NEQ_IF] 1712 \\ Cases_on `l0 = mFun name` \\ FS [] THEN1 1713 (`(\a. callmap name a) = callmap name` by FULL_SIMP_TAC std_ss [FUN_EQ_THM] 1714 \\ FS [EVERY_DEF,MAP,term_ok_def,func_arity_def] 1715 \\ FS [MAP,AND_IMP_INTRO] \\ Q.PAT_X_ASSUM `!ts.bbb` MATCH_MP_TAC 1716 \\ FS [term_ok_def,EVERY_MEM,logic_term_size_def] \\ DECIDE_TAC) 1717 \\ `~(logic_func2sexp l0 = Sym name)` by 1718 (ONCE_REWRITE_TAC [EQ_SYM_EQ] \\ Cases_on `l0` 1719 \\ SIMP_TAC (srw_ss()) [logic_func2sexp_def] 1720 \\ REPEAT STRIP_TAC \\ FS [] THEN1 1721 (Q.PAT_X_ASSUM `logic_func2sexp (mFun (logic_prim2sym l')) = 1722 Sym (logic_prim2sym l')` MP_TAC 1723 \\ Cases_on `l'` \\ EVAL_TAC) 1724 \\ POP_ASSUM MP_TAC \\ SRW_TAC [] [] \\ FULL_SIMP_TAC std_ss []) 1725 \\ FS [] THEN1 1726 (`(\a. callmap name a) = callmap name` by FULL_SIMP_TAC std_ss [FUN_EQ_THM] 1727 \\ FS [MAP,AND_IMP_INTRO] \\ Q.PAT_X_ASSUM `!ts.bbb` MATCH_MP_TAC 1728 \\ FS [term_ok_def,EVERY_MEM,logic_term_size_def] \\ DECIDE_TAC)) 1729 \\ Q.PAT_X_ASSUM `!ts.bbb` (fn th => 1730 (MP_TAC o Q.SPEC `l0`) th THEN (MP_TAC o Q.SPEC `[l]`) th) 1731 \\ FULL_SIMP_TAC std_ss [EVERY_DEF,term_ok_def] 1732 \\ `EVERY (term_ok ctxt) l0` by FULL_SIMP_TAC std_ss [EVERY_MEM] 1733 \\ FULL_SIMP_TAC std_ss [EVERY_DEF,term_ok_def] 1734 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) \\ STRIP_TAC 1735 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) \\ STRIP_TAC 1736 \\ FS [MAP,GSYM callmap2sexp_def,FLAT,APPEND_NIL] 1737 \\ IMP_RES_TAC logic_flag_callmap_TERM \\ FS [EVERY_APPEND] 1738 \\ `(\a. callmap name a) = callmap name` by FULL_SIMP_TAC std_ss [FUN_EQ_THM] 1739 \\ FS [logic_substitute_callmap_thm] \\ FS [callmap2sexp_def,MAP_APPEND] 1740 \\ Q.PAT_X_ASSUM `EVERY (\x. LENGTH (FST x) = LENGTH (FST (ctxt ' name))) 1741 (callmap name l)` MP_TAC 1742 \\ Q.PAT_X_ASSUM `EVERY (EVERY term_syntax_ok o xx) (callmap name l)` MP_TAC 1743 \\ Q.PAT_X_ASSUM `EVERY (EVERY term_syntax_ok o xx) (callmap name l)` MP_TAC 1744 \\ Q.PAT_X_ASSUM `LENGTH l1 = LENGTH l0` MP_TAC 1745 \\ Q.PAT_X_ASSUM `EVERY (term_syntax_ok) l0` MP_TAC 1746 \\ Q.SPEC_TAC (`callmap name l`,`qs`) 1747 \\ REPEAT (POP_ASSUM (K ALL_TAC)) \\ FS [AND_IMP_INTRO] 1748 \\ FS [callmap_sub_def] 1749 \\ SIMP_TAC std_ss [EVERY_MEM,EXISTS_PROD,FORALL_PROD, 1750 MEM_MAP,PULL_EXISTS_IMP] \\ REPEAT STRIP_TAC \\ RES_TAC \\ FS [] 1751 \\ FS [LENGTH_MAP,MEM_FLAT,MEM_MAP,PULL_EXISTS_IMP,PULL_CONJ] 1752 \\ MATCH_MP_TAC term_syntax_ok_term_sub \\ ASM_SIMP_TAC std_ss [] 1753 \\ FS [EVERY_MEM,MEM_ZIP] \\ Cases \\ FS [] \\ REPEAT STRIP_TAC 1754 \\ IMP_RES_TAC rich_listTheory.EL_IS_EL \\ RES_TAC \\ FS []); 1755 1756val logic_callmap_thm = prove( 1757 ``term_syntax_ok t /\ term_ok ctxt t /\ 1758 (logic_func2sexp (mFun name) = Sym name) ==> 1759 (logic_callmap (Sym name) (t2sexp t) = 1760 callmap2sexp (callmap name t)) /\ 1761 EVERY (EVERY term_syntax_ok o FST) (callmap name t) /\ 1762 EVERY (EVERY term_syntax_ok o SND) (callmap name t) /\ 1763 EVERY (\x. LENGTH (FST x) = LENGTH (FST (ctxt ' name))) (callmap name t)``, 1764 STRIP_TAC \\ MP_TAC (Q.SPEC `[t]` logic_flag_callmap_thm) 1765 \\ FULL_SIMP_TAC std_ss [EVERY_DEF,MAP,FLAT,APPEND_NIL,logic_callmap_def] 1766 \\ REPEAT STRIP_TAC \\ FS [] 1767 \\ IMP_RES_TAC logic_flag_callmap_TERM \\ FS []); 1768 1769val logic_pequal_list_thm = add_prove( 1770 ``!xs ys. 1771 (LENGTH xs = LENGTH ys) ==> 1772 (logic_pequal_list (list2sexp (MAP t2sexp xs)) (list2sexp (MAP t2sexp ys)) = 1773 list2sexp (MAP (\ (x,y). f2sexp (Equal x y)) (ZIP(xs,ys))))``, 1774 Induct \\ Cases_on `ys` \\ ONCE_REWRITE_TAC [logic_pequal_list_def] 1775 \\ FS [MAP,LENGTH,ADD1,ZIP,f2sexp_def]); 1776 1777val GENLIST_K_LENGTH = prove( 1778 ``!xs. GENLIST (K x) (LENGTH xs) = MAP (K x) xs``, 1779 Induct \\ FULL_SIMP_TAC std_ss [MAP,GENLIST,LENGTH] 1780 \\ POP_ASSUM (K ALL_TAC) \\ Induct_on `xs` 1781 \\ FULL_SIMP_TAC std_ss [MAP,GENLIST,LENGTH,SNOC]); 1782 1783val logic_progress_obligation_thm = add_prove( 1784 ``(LENGTH formals = LENGTH actuals) /\ term_syntax_ok t ==> 1785 (logic_progress_obligation (t2sexp t) (list2sexp (MAP Sym formals)) 1786 (list2sexp (MAP t2sexp actuals)) 1787 (list2sexp (MAP t2sexp rulers)) = 1788 f2sexp (progress_obligation t formals (actuals,rulers)))``, 1789 SIMP_TAC std_ss [progress_obligation_def] 1790 \\ FS [logic_progress_obligation_def,LET_DEF,LENGTH_MAP,LENGTH_GENLIST] 1791 \\ `(GENLIST (K (Dot (Sym "QUOTE") (Dot (Sym "NIL") (Sym "NIL")))) (LENGTH rulers)) = 1792 MAP t2sexp (GENLIST (K (mConst (Sym "NIL"))) (LENGTH rulers))` by 1793 (FS [MAP_GENLIST,t2sexp_def]) 1794 \\ FS [LENGTH_MAP,LENGTH_GENLIST] 1795 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def] 1796 \\ SIMP_TAC std_ss [f2sexp_def,t2sexp_def,SIMP_RULE std_ss [NOT_CONS_NIL] 1797 (Q.SPEC `x::xs` (GSYM logic_disjoin_formulas_thm)),list2sexp_def,MAP, 1798 logic_func2sexp_def,MAP_MAP_o,o_DEF] 1799 \\ CONV_TAC (DEPTH_CONV (PairRules.PBETA_CONV)) 1800 \\ FS [f2sexp_def,logic_prim2sym_def] 1801 \\ REPEAT STRIP_TAC \\ REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC) 1802 \\ FULL_SIMP_TAC std_ss [GENLIST_K_LENGTH] 1803 \\ REPEAT (POP_ASSUM (K ALL_TAC)) 1804 \\ Induct_on `rulers` 1805 \\ FULL_SIMP_TAC std_ss [MAP,ZIP,FORALL_PROD,CONS_11,t2sexp_def,list2sexp_def]); 1806 1807val logic_progress_obligations_thm = prove( 1808 ``!ts. 1809 EVERY (\t. LENGTH formals = LENGTH (FST t)) ts /\ term_syntax_ok t ==> 1810 (logic_progress_obligations (t2sexp t) (list2sexp (MAP Sym formals)) 1811 (callmap2sexp ts) = 1812 list2sexp (MAP f2sexp (MAP (progress_obligation t formals) ts)))``, 1813 Induct \\ ONCE_REWRITE_TAC [logic_progress_obligations_def] 1814 \\ FS [MAP,callmap2sexp_def,EVERY_DEF] \\ Cases_on `h` \\ FS [LET_DEF]); 1815 1816val logic_termination_obligations_thm = prove( 1817 ``term_syntax_ok m /\ term_syntax_ok body /\ term_ok ctxt body /\ 1818 (LENGTH formals = LENGTH (FST (ctxt ' name))) /\ 1819 (logic_func2sexp (mFun name) = Sym name) ==> 1820 (logic_termination_obligations (Sym name) (list2sexp (MAP Sym formals)) 1821 (t2sexp body) (t2sexp m) = 1822 if (callmap name body = []) then Sym "NIL" else 1823 list2sexp (MAP f2sexp 1824 ((Equal (mApp (mPrimitiveFun logic_ORDP) [m]) (mConst (Sym "T"))):: 1825 (MAP (progress_obligation m formals) (callmap name body)))))``, 1826 SIMP_TAC std_ss [logic_termination_obligations_def,LET_DEF] \\ REPEAT STRIP_TAC 1827 \\ IMP_RES_TAC logic_callmap_thm \\ FULL_SIMP_TAC std_ss [] 1828 \\ Cases_on `callmap name body = []` THEN1 (FS [callmap2sexp_def,MAP]) \\ FS [] 1829 \\ `isTrue (callmap2sexp (callmap name body))` by (Cases_on `callmap name body` \\ FS [] \\ Cases_on `h` \\ FS [] \\ EVAL_TAC) 1830 \\ FS [MAP,f2sexp_def] \\ STRIP_TAC THEN1 EVAL_TAC 1831 \\ `EVERY (\t. LENGTH formals = LENGTH (FST t)) (callmap name body)` suffices_by 1832 (STRIP_TAC THEN IMP_RES_TAC logic_progress_obligations_thm \\ FS []) 1833 \\ FS [EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC); 1834 1835val logic_termination_obligations_thm = prove( 1836 ``term_syntax_ok m /\ term_syntax_ok body /\ term_ok ctxt body /\ 1837 (LENGTH formals = LENGTH (FST (ctxt ' name))) /\ 1838 (logic_func2sexp (mFun name) = Sym name) ==> 1839 (logic_termination_obligations (Sym name) (list2sexp (MAP Sym formals)) 1840 (t2sexp body) (t2sexp m) = 1841 list2sexp (MAP f2sexp (termination_obligations name body formals m)))``, 1842 SIMP_TAC std_ss [termination_obligations_def] 1843 \\ SIMP_TAC std_ss [logic_termination_obligations_def,LET_DEF] \\ REPEAT STRIP_TAC 1844 \\ IMP_RES_TAC logic_callmap_thm \\ FULL_SIMP_TAC std_ss [] 1845 \\ Cases_on `callmap name body = []` THEN1 (FS [callmap2sexp_def,MAP]) \\ FS [] 1846 \\ `isTrue (callmap2sexp (callmap name body))` by (Cases_on `callmap name body` \\ FS [] \\ Cases_on `h` \\ FS [] \\ EVAL_TAC) 1847 \\ FS [MAP,f2sexp_def] \\ STRIP_TAC THEN1 EVAL_TAC 1848 \\ `EVERY (\t. LENGTH formals = LENGTH (FST t)) (callmap name body)` by 1849 (FS [EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC) 1850 \\ IMP_RES_TAC logic_progress_obligations_thm \\ FS []); 1851 1852val IMP_isDot = prove( 1853 ``!x. ~isVal x /\ ~isSym x ==> isDot x``, 1854 Cases \\ EVAL_TAC); 1855 1856val MEM_sexp2list_LSIZE = prove( 1857 ``!b a. MEM a (sexp2list b) ==> LSIZE a < LSIZE b``, 1858 Induct \\ SIMP_TAC std_ss [sexp2list_def,MEM,LSIZE_def] \\ REPEAT STRIP_TAC 1859 \\ FULL_SIMP_TAC std_ss [] \\ RES_TAC \\ DECIDE_TAC); 1860 1861val LSIZE_CAR_LESS = prove( 1862 ``!x m. LSIZE x < m ==> LSIZE (CAR x) < m``, 1863 Cases \\ SIMP_TAC std_ss [CAR_def,LSIZE_def] \\ DECIDE_TAC); 1864 1865val LSIZE_CDR_LESS = prove( 1866 ``!x m. LSIZE x < m ==> LSIZE (CDR x) < m``, 1867 Cases \\ SIMP_TAC std_ss [CDR_def,LSIZE_def] \\ DECIDE_TAC); 1868 1869val sexp3term_def = tDefine "sexp3term" ` 1870 sexp3term x = if x = Sym "T" then Const x else 1871 if x = Sym "NIL" then Const x else 1872 if isVal x then Const x else 1873 if isSym x then Var (getSym x) else 1874 let x1 = CAR x in 1875 let x2 = CAR (CDR x) in 1876 let x3 = CAR (CDR (CDR x)) in 1877 let x4 = CAR (CDR (CDR (CDR x))) in 1878 if x1 = Sym "QUOTE" then Const x2 else 1879 if ~(sym2prim (getSym x1) = NONE) then 1880 App (PrimitiveFun (THE (sym2prim (getSym x1)))) 1881 (MAP sexp3term (sexp2list (CDR x))) else 1882 if x1 = Sym "FIRST" then First (sexp3term x2) else 1883 if x1 = Sym "SECOND" then Second (sexp3term x2) else 1884 if x1 = Sym "THIRD" then Third (sexp3term x2) else 1885 if x1 = Sym "FOURTH" then Fourth (sexp3term x2) else 1886 if x1 = Sym "FIFTH" then Fifth (sexp3term x2) else 1887 if x1 = Sym "OR" then Or (MAP sexp3term (sexp2list (CDR x))) else 1888 if x1 = Sym "AND" then And (MAP sexp3term (sexp2list (CDR x))) else 1889 if x1 = Sym "LIST" then List (MAP sexp3term (sexp2list (CDR x))) else 1890 if x1 = Sym "COND" then 1891 Cond (MAP (\y. (sexp3term (CAR y), sexp3term (CAR (CDR y)))) 1892 (sexp2list (CDR x))) else 1893 if x1 = Sym "LET" then 1894 Let (MAP (\y. (getSym (CAR y), sexp3term (CAR (CDR y)))) 1895 (sexp2list x2)) (sexp3term x3) else 1896 if x1 = Sym "LET*" then 1897 LetStar (MAP (\y. (getSym (CAR y), sexp3term (CAR (CDR y)))) 1898 (sexp2list x2)) (sexp3term x3) else 1899 if CAR x1 = Sym "LAMBDA" then 1900 let y2 = CAR (CDR x1) in 1901 let y3 = CAR (CDR (CDR x1)) in 1902 LamApp (MAP getSym (sexp2list y2)) (sexp3term y3) 1903 (MAP sexp3term (sexp2list (CDR x))) 1904 else (* user-defined fun *) 1905 App (Fun (getSym x1)) 1906 (MAP sexp3term (sexp2list (CDR x)))` 1907 (WF_REL_TAC `measure LSIZE` 1908 \\ REPEAT STRIP_TAC \\ IMP_RES_TAC IMP_isDot 1909 \\ FULL_SIMP_TAC std_ss [isDot_thm,LSIZE_def,CDR_def,CAR_def] 1910 \\ IMP_RES_TAC MEM_sexp2list_LSIZE 1911 \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss [CDR_def] 1912 \\ REPEAT STRIP_TAC 1913 \\ REPEAT (MATCH_MP_TAC LSIZE_CAR_LESS) 1914 \\ REPEAT (MATCH_MP_TAC LSIZE_CDR_LESS) \\ REPEAT DECIDE_TAC 1915 \\ Cases_on `b` \\ FULL_SIMP_TAC std_ss [CAR_def,LSIZE_def] \\ DECIDE_TAC); 1916 1917val sexp2sexp_def = Define ` 1918 sexp2sexp x = t2sexp (term2t (sexp3term x))`; 1919 1920val list_exists3 = prove( 1921 ``!x. list_exists 3 x ==> ?x1 x2 x3. x = list2sexp [x1;x2;x3]``, 1922 Cases \\ FS [] \\ Cases_on `S0` \\ FS [] 1923 \\ Cases_on `S0'` \\ FS [] \\ Cases_on `S0` \\ FS []); 1924 1925val isTrue_logic_flag_translate_TERM = prove( 1926 ``(isTrue (CAR (logic_flag_translate (Sym "LIST") (Dot x3 (Sym "NIL")))) = 1927 isTrue (logic_flag_translate (Sym "TERM") x3))``, 1928 SIMP_TAC std_ss [Once logic_flag_translate_def] \\ FS [LET_DEF] 1929 \\ Cases_on `isTrue (logic_flag_translate (Sym "TERM") x3)` \\ FS [] 1930 \\ SIMP_TAC std_ss [Once logic_flag_translate_def] \\ FS [LET_DEF]) 1931 1932val logic_flag_translate_TERM = prove( 1933 ``isTrue (logic_flag_translate (Sym "TERM") x3) ==> 1934 (logic_flag_translate (Sym "LIST") (Dot x3 (Sym "NIL")) = 1935 Dot (Sym "T") (Dot (logic_flag_translate (Sym "TERM") x3) (Sym "NIL")))``, 1936 STRIP_TAC \\ SIMP_TAC std_ss [Once logic_flag_translate_def] \\ FS [LET_DEF] 1937 \\ SIMP_TAC std_ss [Once logic_flag_translate_def] \\ FS [LET_DEF] 1938 \\ SIMP_TAC std_ss [EVAL ``logic_flag_translate (Sym "LIST") (Sym "NIL")``] 1939 \\ FS []); 1940 1941val sexp2list_list2sexp = add_prove( 1942 ``!xs. sexp2list (list2sexp xs) = xs``, 1943 Induct \\ EVAL_TAC \\ FULL_SIMP_TAC std_ss []); 1944 1945val logic_variable_listp_thm = add_prove( 1946 ``!xs. isTrue (logic_variable_listp (list2sexp xs)) ==> 1947 (MAP Sym (MAP getSym xs) = xs)``, 1948 Induct THEN1 EVAL_TAC 1949 \\ ONCE_REWRITE_TAC [logic_variable_listp_def] \\ FS [logic_variablep_def] 1950 \\ SRW_TAC [] [] \\ FS [] 1951 \\ REPEAT (POP_ASSUM MP_TAC) \\ SRW_TAC [] [] \\ FS [] 1952 \\ FULL_SIMP_TAC std_ss [isSym_thm] \\ FS [getSym_def]); 1953 1954val logic_variable_listp_MAP_CAR = add_prove( 1955 ``!xs. isTrue (logic_variable_listp (list2sexp (MAP CAR xs))) ==> 1956 (MAP (\x. Sym (getSym (CAR x))) xs = MAP CAR xs)``, 1957 Induct THEN1 EVAL_TAC 1958 \\ ONCE_REWRITE_TAC [logic_variable_listp_def] \\ FS [logic_variablep_def] 1959 \\ FS [MAP] \\ SRW_TAC [] [] \\ FS [] 1960 \\ REPEAT (POP_ASSUM MP_TAC) \\ SRW_TAC [] [] \\ FS [] 1961 \\ FULL_SIMP_TAC std_ss [isSym_thm] \\ FS [getSym_def]); 1962 1963val isTrue_memberp_rw = prove( 1964 ``isTrue (memberp (Sym name) (Dot (Sym x) y)) = 1965 (name = x) \/ isTrue (memberp (Sym name) y)``, 1966 SIMP_TAC std_ss [Once memberp_def] \\ FS [] \\ SRW_TAC [] [] \\ FS []); 1967 1968val logic_translate_cond_term_thm = prove( 1969 ``!xs. 1970 EVERY (\x. term_vars_ok (term2t (sexp3term x))) (MAP (CAR o CDR) xs) /\ 1971 EVERY (\x. term_vars_ok (term2t (sexp3term x))) (MAP CAR xs) ==> 1972 (logic_translate_cond_term (list2sexp (MAP sexp2sexp (MAP CAR xs))) 1973 (list2sexp (MAP sexp2sexp (MAP (CAR o CDR) xs))) = 1974 t2sexp (term2t 1975 (Cond (MAP (\y. (sexp3term (CAR y),sexp3term (CAR (CDR y)))) xs)))) /\ 1976 term_vars_ok (term2t 1977 (Cond (MAP (\y. (sexp3term (CAR y),sexp3term (CAR (CDR y)))) xs)))``, 1978 Induct THEN1 EVAL_TAC 1979 \\ FS [MAP] \\ ONCE_REWRITE_TAC [logic_translate_cond_term_def] 1980 \\ FS [term2t_def,t2sexp_def,MAP,LET_DEF] 1981 \\ FS [sexp2sexp_def,EVERY_DEF,term_vars_ok_def] \\ NTAC 2 STRIP_TAC \\ EVAL_TAC); 1982 1983val LIST_LSIZE_MAP = prove( 1984 ``!xs. LIST_LSIZE (MAP (CAR o CDR) xs) <= LSIZE (list2sexp xs) /\ 1985 LIST_LSIZE (MAP (CAR) xs) <= LSIZE (list2sexp xs)``, 1986 Induct \\ EVAL_TAC \\ REPEAT STRIP_TAC 1987 \\ Cases_on `h` \\ EVAL_TAC \\ TRY (Cases_on `S0`) \\ EVAL_TAC \\ DECIDE_TAC); 1988 1989val MAP_sexp2sexp = prove( 1990 ``!xs. MAP t2sexp (MAP term2t (MAP sexp3term xs)) = MAP sexp2sexp xs``, 1991 Induct \\ ASM_SIMP_TAC std_ss [MAP,CONS_11,sexp2sexp_def]); 1992 1993val EVERY_MAP_ID = prove( 1994 ``!xs f P. (!x. P x ==> (f x = x)) /\ EVERY P xs ==> (xs = MAP f xs)``, 1995 Induct \\ SRW_TAC [] [] \\ METIS_TAC []); 1996 1997val EVERY_ISORT_INSERT = prove( 1998 ``!xs f P. EVERY P xs /\ P h ==> EVERY P (ISORT_INSERT f h xs)``, 1999 Induct \\ SRW_TAC [] [ISORT_INSERT_def]); 2000 2001val EVERY_ISORT = prove( 2002 ``!xs f P. EVERY P xs ==> EVERY P (ISORT f xs)``, 2003 Induct \\ SRW_TAC [] [ISORT_def,EVERY_ISORT_INSERT]); 2004 2005val EVERY_FILTER = prove( 2006 ``!xs f P. EVERY P xs ==> EVERY P (FILTER f xs)``, 2007 Induct \\ SRW_TAC [] [FILTER]); 2008 2009val EVERY_REMOVE_DUPLICATES = prove( 2010 ``!xs P. EVERY P xs ==> EVERY P (REMOVE_DUPLICATES xs)``, 2011 Induct \\ SRW_TAC [] [REMOVE_DUPLICATES_def]); 2012 2013val EVERY_FLAT = prove( 2014 ``!xs P. EVERY P (FLAT xs) = !x. MEM x xs ==> EVERY P x``, 2015 Induct \\ FS [MEM,FLAT,EVERY_DEF,EVERY_APPEND] \\ METIS_TAC []); 2016 2017val EVERY_free_vars = prove( 2018 ``!y. term_vars_ok y ==> EVERY (\x. x <> "NIL" /\ x <> "T") (free_vars y)``, 2019 STRIP_TAC \\ completeInduct_on `logic_term_size y` \\ NTAC 3 STRIP_TAC 2020 \\ FULL_SIMP_TAC std_ss [PULL_FORALL_IMP,AND_IMP_INTRO] \\ Cases_on `y` 2021 \\ FS [free_vars_def,EVERY_DEF,term_vars_ok_def,EVERY_FLAT,MEM_MAP,PULL_EXISTS_IMP] 2022 \\ REPEAT STRIP_TAC \\ Q.PAT_X_ASSUM `!y.bbb` MATCH_MP_TAC \\ FS [EVERY_MEM] 2023 \\ EVAL_TAC \\ IMP_RES_TAC MEM_logic_term_size \\ DECIDE_TAC); 2024 2025val logic_translate_let_term_apply = prove( 2026 ``!xs. 2027 isTrue (logic_variable_listp (list2sexp (MAP CAR xs))) ==> 2028 EVERY (\x. term_vars_ok (term2t (sexp3term (CAR (CDR x))))) xs ==> 2029 term_vars_ok y ==> 2030 (logic_translate_let_term (list2sexp (MAP CAR xs)) 2031 (list2sexp (MAP (\x. sexp2sexp (CAR (CDR x))) xs)) 2032 (t2sexp y) = 2033 t2sexp 2034 (let2t 2035 (MAP (\y. (getSym (CAR y),term2t (sexp3term (CAR (CDR y))))) xs) y)) /\ 2036 term_vars_ok (let2t 2037 (MAP (\y. (getSym (CAR y),term2t (sexp3term (CAR (CDR y))))) xs) y)``, 2038 SIMP_TAC std_ss [term2t_def,MAP_MAP_o,o_DEF,let2t_def] 2039 \\ FS [logic_translate_let_term_def,LET_DEF,t2sexp_def] 2040 \\ FS [MAP_APPEND,MAP_MAP_o,o_DEF,GSYM sexp2sexp_def,t2sexp_def] 2041 \\ FS [APPEND_11] \\ REPEAT STRIP_TAC THEN1 2042 (MATCH_MP_TAC EVERY_MAP_ID \\ Q.EXISTS_TAC `isSym` 2043 \\ STRIP_TAC THEN1 (Cases \\ FS [getSym_def]) 2044 \\ MATCH_MP_TAC EVERY_ISORT 2045 \\ MATCH_MP_TAC EVERY_FILTER 2046 \\ MATCH_MP_TAC EVERY_REMOVE_DUPLICATES 2047 \\ FS [EVERY_MEM,MEM_MAP,PULL_EXISTS_IMP]) 2048 \\ FS [term_vars_ok_def,LENGTH_MAP,LENGTH_APPEND,EVERY_APPEND,EVERY_MAP] 2049 \\ MATCH_MP_TAC EVERY_ISORT 2050 \\ MATCH_MP_TAC EVERY_FILTER 2051 \\ MATCH_MP_TAC EVERY_REMOVE_DUPLICATES 2052 \\ FS [EVERY_MAP,getSym_def,EVERY_free_vars]); 2053 2054val logic_translate_let_term_thm = prove( 2055 ``!xs. 2056 isTrue (logic_variable_listp (list2sexp (MAP CAR xs))) ==> 2057 EVERY (\x. term_vars_ok (term2t (sexp3term x))) (MAP (CAR o CDR) xs) ==> 2058 term_vars_ok (term2t y) ==> 2059 (logic_translate_let_term (list2sexp (MAP CAR xs)) 2060 (list2sexp (MAP sexp2sexp (MAP (CAR o CDR) xs))) (t2sexp (term2t y)) = 2061 t2sexp 2062 (term2t 2063 (Let (MAP (\y. (getSym (CAR y),sexp3term (CAR (CDR y)))) xs) 2064 y))) /\ 2065 term_vars_ok 2066 (term2t 2067 (Let (MAP (\y. (getSym (CAR y),sexp3term (CAR (CDR y)))) xs) 2068 y))``, 2069 REPEAT STRIP_TAC 2070 \\ FS [term2t_def,MAP_MAP_o,o_DEF,EVERY_MAP] 2071 \\ IMP_RES_TAC logic_translate_let_term_apply); 2072 2073val logic_translate_let_term_lemma = 2074 logic_translate_let_term_thm |> SIMP_RULE std_ss [term2t_def] 2075 |> Q.SPEC `[x]` |> SIMP_RULE std_ss [MAP,list2sexp_def,CAR_def,CDR_def] 2076 |> ONCE_REWRITE_RULE [logic_variable_listp_def] 2077 |> ONCE_REWRITE_RULE [logic_variable_listp_def] 2078 |> DISCH ``isTrue (logic_variablep (CAR x))`` 2079 |> SR [EVERY_DEF] 2080 2081val logic_translate_let_term_alt = prove( 2082 ``term_vars_ok y /\ ~(v = "NIL") /\ ~(v = "T") /\ 2083 term_vars_ok (term2t (sexp3term x)) ==> 2084 (t2sexp (let2t [(v,term2t (sexp3term x))] y) = 2085 logic_translate_let_term (Dot (Sym v) (Sym "NIL")) 2086 (Dot (t2sexp (term2t (sexp3term x))) (Sym "NIL")) (t2sexp y)) /\ 2087 term_vars_ok (let2t [(getSym (Sym v),term2t (sexp3term x))] y)``, 2088 REPEAT STRIP_TAC 2089 \\ MP_TAC (Q.SPEC `[Dot (Sym v) (Dot x (Sym "NIL"))]` (logic_translate_let_term_apply)) 2090 \\ FS [MAP,EVERY_DEF] 2091 \\ ONCE_REWRITE_TAC [logic_variable_listp_def] 2092 \\ ONCE_REWRITE_TAC [logic_variable_listp_def] 2093 \\ FS [MAP,logic_variablep_def] 2094 \\ SRW_TAC [] [] \\ FS [] \\ REPEAT (POP_ASSUM MP_TAC) 2095 \\ SRW_TAC [] [] \\ FS [sexp2sexp_def,getSym_def]); 2096 2097val logic_translate_let__term_thm = prove( 2098 ``!xs. 2099 term_vars_ok (term2t (sexp3term y)) /\ 2100 EVERY (\x. term_vars_ok (term2t (sexp3term x))) (MAP (CAR o CDR) xs) /\ 2101 isTrue (logic_variable_listp (list2sexp (MAP CAR xs))) ==> 2102 (logic_translate_let__term (list2sexp (MAP CAR xs)) 2103 (list2sexp (MAP sexp2sexp (MAP (CAR o CDR) xs))) (sexp2sexp y) = 2104 t2sexp 2105 (term2t 2106 (LetStar (MAP (\y. (getSym (CAR y),sexp3term (CAR (CDR y)))) xs) 2107 (sexp3term y)))) /\ 2108 term_vars_ok 2109 (term2t 2110 (LetStar (MAP (\y. (getSym (CAR y),sexp3term (CAR (CDR y)))) xs) 2111 (sexp3term y)))``, 2112 Induct \\ SIMP_TAC std_ss [] \\ ONCE_REWRITE_TAC [logic_translate_let__term_def] 2113 \\ FS [MAP,term2t_def,sexp2sexp_def] 2114 \\ ONCE_REWRITE_TAC [logic_variable_listp_def] \\ FS [] 2115 \\ FS [GSYM AND_IMP_INTRO] \\ STRIP_TAC \\ STRIP_TAC 2116 \\ FS [EVERY_DEF] \\ STRIP_TAC 2117 \\ Cases_on `isTrue (logic_variablep (CAR h))` \\ FS [] \\ STRIP_TAC \\ FS [] 2118 \\ IMP_RES_TAC logic_translate_let_term_lemma 2119 \\ FULL_SIMP_TAC std_ss [sexp2sexp_def]); 2120 2121val logic_translate_or_term_thm = prove( 2122 ``!xs. 2123 EVERY (\x. term_vars_ok (term2t (sexp3term x))) xs ==> 2124 (t2sexp (term2t (Or (MAP sexp3term xs))) = 2125 logic_translate_or_term (list2sexp (MAP sexp2sexp xs))) /\ 2126 term_vars_ok (term2t (Or (MAP sexp3term xs)))``, 2127 ONCE_REWRITE_TAC [EQ_SYM_EQ] 2128 \\ SIMP_TAC std_ss [term2t_def] \\ Induct THEN1 EVAL_TAC 2129 \\ Cases_on `xs` THEN1 2130 (SIMP_TAC std_ss [MAP,or2t_def,list2sexp_def] 2131 \\ ONCE_REWRITE_TAC [logic_translate_or_term_def] 2132 \\ FS [LET_DEF,sexp2sexp_def,EVERY_DEF]) 2133 \\ SIMP_TAC std_ss [MAP,or2t_def,list2sexp_def] 2134 \\ ONCE_REWRITE_TAC [logic_translate_or_term_def] 2135 \\ FS [LET_DEF,EVERY_DEF] \\ STRIP_TAC \\ STRIP_TAC 2136 \\ Cases_on `isTrue (logic_variablep (sexp2sexp h'))` 2137 \\ FS [sexp2sexp_def,logic_func2sexp_def,logic_prim2sym_def,t2sexp_def,MAP, 2138 term_vars_ok_def,EVERY_DEF,logic_func_distinct] 2139 \\ Cases_on `isTrue (logic_constantp (sexp2sexp h'))` 2140 \\ FS [sexp2sexp_def,logic_func2sexp_def,logic_prim2sym_def,t2sexp_def,MAP, 2141 term_vars_ok_def,EVERY_DEF,logic_func_distinct] 2142 \\ FS [logic_term_vars_thm,MEM_MAP] 2143 \\ SRW_TAC [] [] \\ FS [] 2144 \\ ONCE_REWRITE_TAC [t2sexp_def] 2145 \\ FS [MAP,logic_func2sexp_def,logic_prim2sym_def,term_vars_ok_def, 2146 EVERY_DEF,logic_func_distinct] 2147 \\ MP_TAC (logic_translate_let_term_alt |> Q.INST [`v`|->`"SPECIAL-VAR-FOR-OR"`, 2148 `y`|->`(mApp (mPrimitiveFun logic_IF) 2149 [mVar "SPECIAL-VAR-FOR-OR"; mVar "SPECIAL-VAR-FOR-OR"; 2150 or2t (term2t (sexp3term h)::MAP term2t (MAP sexp3term t))])`, 2151 `x`|->`h'`]) 2152 \\ FS [term_vars_ok_def,logic_func_distinct,EVERY_DEF] 2153 \\ FULL_SIMP_TAC (srw_ss()) [] 2154 \\ REPEAT STRIP_TAC \\ FS [t2sexp_def,MAP,term_vars_ok_def,getSym_def] 2155 \\ REPEAT (AP_TERM_TAC ORELSE AP_THM_TAC) \\ EVAL_TAC); 2156 2157val logic_translate_list_term_thm = prove( 2158 ``!xs. 2159 EVERY (\x. term_vars_ok (term2t (sexp3term x))) xs ==> 2160 (t2sexp (term2t (List (MAP sexp3term xs))) = 2161 logic_translate_list_term (list2sexp (MAP sexp2sexp xs))) /\ 2162 term_vars_ok (term2t (List (MAP sexp3term xs)))``, 2163 Induct_on `xs` THEN1 (EVAL_TAC \\ METIS_TAC []) 2164 \\ ONCE_REWRITE_TAC [term2t_def] 2165 \\ ONCE_REWRITE_TAC [logic_translate_list_term_def] \\ FS [sexp2sexp_def,MAP] 2166 \\ FULL_SIMP_TAC std_ss [EVERY_DEF] 2167 \\ SIMP_TAC std_ss [term2t_def,t2sexp_def,MAP,list2sexp_def, 2168 term_vars_ok_def,EVERY_DEF,logic_func2sexp_def,logic_prim2sym_def] 2169 \\ FS [] \\ REPEAT STRIP_TAC \\ FS [] \\ POP_ASSUM MP_TAC \\ EVAL_TAC); 2170 2171val logic_translate_and_term_thm = prove( 2172 ``!xs. 2173 EVERY (\x. term_vars_ok (term2t (sexp3term x))) xs ==> 2174 (t2sexp (term2t (And (MAP sexp3term xs))) = 2175 logic_translate_and_term (list2sexp (MAP sexp2sexp xs))) /\ 2176 term_vars_ok (term2t (And (MAP sexp3term xs)))``, 2177 Induct_on `xs` THEN1 (EVAL_TAC \\ METIS_TAC []) 2178 \\ Cases_on `xs` \\ FS [MAP] 2179 \\ ONCE_REWRITE_TAC [term2t_def] 2180 \\ ONCE_REWRITE_TAC [logic_translate_and_term_def] \\ FS [sexp2sexp_def,MAP] 2181 \\ FULL_SIMP_TAC std_ss [EVERY_DEF] 2182 \\ SIMP_TAC std_ss [term2t_def,t2sexp_def,MAP,list2sexp_def, 2183 term_vars_ok_def,EVERY_DEF] \\ REPEAT STRIP_TAC 2184 \\ FS [markerTheory.Abbrev_def,EVERY_DEF] 2185 \\ EVAL_TAC \\ POP_ASSUM MP_TAC \\ EVAL_TAC); 2186 2187val logic_flag_translate_thm = prove( 2188 ``!xs. 2189 let res = logic_flag_translate (Sym "LIST") (list2sexp xs) in 2190 (isTrue (CAR res) ==> (res = Dot (Sym "T") (list2sexp (MAP sexp2sexp xs))) /\ 2191 EVERY (\x. term_vars_ok (term2t (sexp3term x))) xs)``, 2192 STRIP_TAC \\ completeInduct_on `LIST_LSIZE xs` \\ NTAC 2 STRIP_TAC 2193 \\ Cases_on `xs` \\ FULL_SIMP_TAC std_ss [PULL_FORALL_IMP] 2194 \\ ONCE_REWRITE_TAC [logic_flag_translate_def] \\ FS [] THEN1 EVAL_TAC 2195 \\ REVERSE (Cases_on `isTrue (logic_flag_translate (Sym "TERM") h)`) 2196 \\ FS [LET_DEF] 2197 \\ Cases_on `isTrue (CAR (logic_flag_translate (Sym "LIST") (list2sexp t)))` 2198 \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] 2199 \\ `LIST_LSIZE t < LIST_LSIZE (h::t)` by (EVAL_TAC \\ DECIDE_TAC) 2200 \\ RES_TAC \\ FS [] 2201 \\ `let res = logic_flag_translate (Sym "TERM") h in 2202 (isTrue res ==> Abbrev ((res = sexp2sexp h) /\ 2203 term_vars_ok (term2t (sexp3term h))))` suffices_by 2204 (STRIP_TAC THEN FS [LET_DEF,markerTheory.Abbrev_def]) 2205 \\ REVERSE (Cases_on `h`) THEN1 2206 (ONCE_REWRITE_TAC [logic_flag_translate_def] 2207 \\ FS [LET_DEF,markerTheory.Abbrev_def] 2208 \\ SRW_TAC [] [] \\ EVAL_TAC \\ FS [] \\ EVAL_TAC \\ FS [isTrue_def]) 2209 THEN1 (ONCE_REWRITE_TAC [logic_flag_translate_def] \\ FS [LET_DEF] 2210 \\ FS [LET_DEF,markerTheory.Abbrev_def] \\ EVAL_TAC) 2211 \\ ONCE_REWRITE_TAC [logic_flag_translate_def] \\ FS [] 2212 \\ REVERSE (Cases_on `isSym S'`) \\ FS [LET_DEF] THEN1 2213 (SRW_TAC [] [] \\ FS [] 2214 \\ IMP_RES_TAC list_exists3 \\ FS [] 2215 \\ Q.PAT_X_ASSUM `!xss.bbb` (fn th => (MP_TAC o Q.SPEC `xs'`) th THEN 2216 (MP_TAC o Q.SPEC `[x3]`) th) 2217 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2218 THEN1 (EVAL_TAC \\ MP_TAC (Q.SPEC `xs'` LIST_LSIZE_LESS_EQ) \\ DECIDE_TAC) 2219 \\ ASM_SIMP_TAC std_ss [] \\ FS [] 2220 \\ FS [isTrue_logic_flag_translate_TERM] 2221 \\ FS [logic_flag_translate_TERM] \\ STRIP_TAC 2222 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2223 THEN1 (EVAL_TAC \\ MP_TAC (Q.SPEC `xs'` LIST_LSIZE_LESS_EQ) \\ DECIDE_TAC) 2224 \\ ASM_SIMP_TAC std_ss [] \\ STRIP_TAC \\ FS [MAP] 2225 \\ SIMP_TAC std_ss [markerTheory.Abbrev_def] \\ STRIP_TAC 2226 \\ SIMP_TAC std_ss [sexp2sexp_def] \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2227 \\ SIMP_TAC std_ss [Once sexp3term_def] 2228 \\ FS [LET_DEF,getSym_def,EVAL ``sym2prim "NIL"``] 2229 \\ FS [term2t_def,t2sexp_def,sexp2list_list2sexp] 2230 \\ FS [term_vars_ok_def,EVERY_MAP,MAP_MAP_o,o_DEF,EVERY_DEF] 2231 \\ REPEAT (POP_ASSUM (K ALL_TAC)) 2232 \\ Induct_on `xs'` \\ FS [MAP,CONS_11] \\ FS [sexp2sexp_def]) 2233 \\ SRW_TAC [] [] \\ FS [] 2234 THEN1 2235 (SIMP_TAC std_ss [sexp2sexp_def] \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2236 \\ SIMP_TAC std_ss [markerTheory.Abbrev_def] \\ REPEAT STRIP_TAC 2237 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2238 \\ FS [term2t_def,t2sexp_def] \\ Cases_on `S0` \\ FS [] 2239 \\ Cases_on `S0'` \\ FS [term_vars_ok_def]) 2240 THEN1 2241 (SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2242 \\ SIMP_TAC std_ss [sexp2sexp_def] \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2243 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2244 \\ FULL_SIMP_TAC (srw_ss()) [EVAL ``sym2prim "FIRST"``] 2245 \\ FS [term2t_def,t2sexp_def,logic_func2sexp_def,logic_prim2sym_def,MAP] 2246 \\ Cases_on `S0` \\ FS [] \\ Cases_on `S0'` \\ FS [] 2247 \\ Q.PAT_X_ASSUM `!xs.bbb` (MP_TAC o Q.SPEC `[S']`) 2248 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) 2249 \\ FS [isTrue_logic_flag_translate_TERM,MAP,logic_flag_translate_TERM] 2250 \\ SIMP_TAC std_ss [sexp2sexp_def,markerTheory.Abbrev_def,term_vars_ok_def, 2251 EVERY_DEF] \\ STRIP_TAC \\ EVAL_TAC) 2252 THEN1 2253 (SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2254 \\ SIMP_TAC std_ss [sexp2sexp_def] \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2255 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2256 \\ FULL_SIMP_TAC (srw_ss()) [EVAL ``sym2prim "SECOND"``] 2257 \\ FS [term2t_def,t2sexp_def,logic_func2sexp_def,logic_prim2sym_def,MAP] 2258 \\ Cases_on `S0` \\ FS [] \\ Cases_on `S0'` \\ FS [] 2259 \\ Q.PAT_X_ASSUM `!xs.bbb` (MP_TAC o Q.SPEC `[S']`) 2260 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) 2261 \\ FS [isTrue_logic_flag_translate_TERM,MAP,logic_flag_translate_TERM] 2262 \\ SIMP_TAC std_ss [sexp2sexp_def,markerTheory.Abbrev_def,term_vars_ok_def, 2263 EVERY_DEF] \\ STRIP_TAC \\ EVAL_TAC) 2264 THEN1 2265 (SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2266 \\ SIMP_TAC std_ss [sexp2sexp_def] \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2267 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2268 \\ FULL_SIMP_TAC (srw_ss()) [EVAL ``sym2prim "THIRD"``] 2269 \\ FS [term2t_def,t2sexp_def,logic_func2sexp_def,logic_prim2sym_def,MAP] 2270 \\ Cases_on `S0` \\ FS [] \\ Cases_on `S0'` \\ FS [] 2271 \\ Q.PAT_X_ASSUM `!xs.bbb` (MP_TAC o Q.SPEC `[S']`) 2272 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) 2273 \\ FS [isTrue_logic_flag_translate_TERM,MAP,logic_flag_translate_TERM] 2274 \\ SIMP_TAC std_ss [sexp2sexp_def,markerTheory.Abbrev_def,term_vars_ok_def, 2275 EVERY_DEF] \\ STRIP_TAC \\ EVAL_TAC) 2276 THEN1 2277 (SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2278 \\ SIMP_TAC std_ss [sexp2sexp_def] \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2279 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2280 \\ FULL_SIMP_TAC (srw_ss()) [EVAL ``sym2prim "FOURTH"``] 2281 \\ FS [term2t_def,t2sexp_def,logic_func2sexp_def,logic_prim2sym_def,MAP] 2282 \\ Cases_on `S0` \\ FS [] \\ Cases_on `S0'` \\ FS [] 2283 \\ Q.PAT_X_ASSUM `!xs.bbb` (MP_TAC o Q.SPEC `[S']`) 2284 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) 2285 \\ FS [isTrue_logic_flag_translate_TERM,MAP,logic_flag_translate_TERM] 2286 \\ SIMP_TAC std_ss [sexp2sexp_def,markerTheory.Abbrev_def,term_vars_ok_def, 2287 EVERY_DEF] \\ STRIP_TAC \\ EVAL_TAC) 2288 THEN1 2289 (FULL_SIMP_TAC std_ss [GSYM list2sexp_def,memberp_thm] \\ FS [] 2290 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2291 \\ SIMP_TAC std_ss [sexp2sexp_def] \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2292 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2293 \\ FULL_SIMP_TAC (srw_ss()) [EVAL ``sym2prim "FIFTH"``] 2294 \\ FS [term2t_def,t2sexp_def,logic_func2sexp_def,logic_prim2sym_def,MAP] 2295 \\ Cases_on `S0` \\ FS [] \\ Cases_on `S0'` \\ FS [] 2296 \\ Q.PAT_X_ASSUM `!xs.bbb` (MP_TAC o Q.SPEC `[S'']`) 2297 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC THEN1 (EVAL_TAC \\ DECIDE_TAC) 2298 \\ FS [isTrue_logic_flag_translate_TERM,MAP,logic_flag_translate_TERM] 2299 \\ SIMP_TAC std_ss [sexp2sexp_def,markerTheory.Abbrev_def,term_vars_ok_def, 2300 EVERY_DEF] \\ STRIP_TAC \\ EVAL_TAC) 2301 THEN1 2302 (Q.PAT_X_ASSUM `!xss.bbb` (MP_TAC o Q.SPEC `xs`) 2303 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2304 THEN1 (EVAL_TAC \\ MP_TAC (Q.SPEC `xs` LIST_LSIZE_LESS_EQ) \\ DECIDE_TAC) 2305 \\ FS [] \\ REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2306 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2307 \\ SIMP_TAC std_ss [sexp2sexp_def] 2308 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2309 \\ FULL_SIMP_TAC (srw_ss()) [EVAL ``sym2prim "AND"``] 2310 \\ POP_ASSUM MP_TAC 2311 \\ REPEAT (POP_ASSUM (K ALL_TAC)) 2312 \\ FS [markerTheory.Abbrev_def] 2313 \\ FS [logic_translate_and_term_thm]) 2314 THEN1 2315 (Q.PAT_X_ASSUM `!xss.bbb` (MP_TAC o Q.SPEC `xs`) 2316 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2317 THEN1 (EVAL_TAC \\ MP_TAC (Q.SPEC `xs` LIST_LSIZE_LESS_EQ) \\ DECIDE_TAC) 2318 \\ FS [] \\ REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2319 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2320 \\ SIMP_TAC std_ss [sexp2sexp_def] 2321 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2322 \\ FULL_SIMP_TAC (srw_ss()) [EVAL ``sym2prim "OR"``] 2323 \\ FS [markerTheory.Abbrev_def] 2324 \\ FS [logic_translate_or_term_thm]) 2325 THEN1 2326 (FULL_SIMP_TAC std_ss [GSYM list2sexp_def,memberp_thm] \\ FS [] 2327 \\ Q.PAT_X_ASSUM `!xss.bbb` (MP_TAC o Q.SPEC `xs`) 2328 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2329 THEN1 (EVAL_TAC \\ MP_TAC (Q.SPEC `xs` LIST_LSIZE_LESS_EQ) \\ DECIDE_TAC) 2330 \\ FS [] \\ REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 2331 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2332 \\ SIMP_TAC std_ss [sexp2sexp_def] 2333 \\ SIMP_TAC std_ss [Once sexp3term_def] \\ FS [LET_DEF,getSym_def] 2334 \\ FULL_SIMP_TAC (srw_ss()) [EVAL ``sym2prim "LIST"``] 2335 \\ FS [markerTheory.Abbrev_def] 2336 \\ FS [logic_translate_list_term_thm]) 2337 THEN1 2338 (SIMP_TAC std_ss [sexp2sexp_def] \\ ONCE_REWRITE_TAC [sexp3term_def] 2339 \\ FS [LET_DEF] \\ FULL_SIMP_TAC (srw_ss()) [getSym_def,sym2prim_def] 2340 \\ Q.PAT_X_ASSUM `!ts.bbb` (fn th => (MP_TAC o Q.SPEC `MAP CAR xs`) th THEN 2341 (MP_TAC o Q.SPEC `MAP (CAR o CDR) xs`) th) 2342 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2343 THEN1 (EVAL_TAC \\ MP_TAC (Q.SPEC `xs` LIST_LSIZE_MAP) \\ DECIDE_TAC) 2344 \\ FS [] \\ STRIP_TAC 2345 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2346 THEN1 (EVAL_TAC \\ MP_TAC (Q.SPEC `xs` LIST_LSIZE_MAP) \\ DECIDE_TAC) 2347 \\ FS [markerTheory.Abbrev_def] 2348 \\ FS [] \\ STRIP_TAC \\ FS [logic_translate_cond_term_thm]) 2349 THEN1 2350 (SIMP_TAC std_ss [sexp2sexp_def] \\ ONCE_REWRITE_TAC [sexp3term_def] 2351 \\ FS [LET_DEF] \\ FULL_SIMP_TAC (srw_ss()) [getSym_def,sym2prim_def] 2352 \\ Cases_on `S0` \\ FS [] \\ Cases_on `S0'` \\ FS [] \\ Cases_on `S0` \\ FS [] 2353 \\ Q.PAT_X_ASSUM `!ts.bbb` (fn th => 2354 (MP_TAC o Q.SPEC `MAP (CAR o CDR) xs`) th THEN 2355 (MP_TAC o Q.SPEC `[S'']`) th) 2356 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2357 THEN1 (EVAL_TAC \\ MP_TAC (Q.SPEC `xs` LIST_LSIZE_MAP) \\ DECIDE_TAC) 2358 \\ FS [isTrue_logic_flag_translate_TERM,logic_flag_translate_TERM,MAP] 2359 \\ STRIP_TAC \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2360 THEN1 (EVAL_TAC \\ MP_TAC (Q.SPEC `xs` LIST_LSIZE_MAP) \\ DECIDE_TAC) 2361 \\ FS [markerTheory.Abbrev_def,EVERY_DEF] \\ STRIP_TAC 2362 \\ FS [logic_translate_let_term_thm,sexp2sexp_def]) 2363 THEN1 2364 (FULL_SIMP_TAC std_ss [GSYM list2sexp_def,memberp_thm,MEM] \\ FS [] 2365 \\ SIMP_TAC std_ss [sexp2sexp_def] \\ ONCE_REWRITE_TAC [sexp3term_def] 2366 \\ FS [LET_DEF] \\ FULL_SIMP_TAC (srw_ss()) [getSym_def,sym2prim_def] 2367 \\ Cases_on `S0` \\ FS [] \\ Cases_on `S0'` \\ FS [] \\ Cases_on `S0` \\ FS [] 2368 \\ Q.PAT_X_ASSUM `!ts.bbb` (fn th => 2369 (MP_TAC o Q.SPEC `MAP (CAR o CDR) xs`) th THEN 2370 (MP_TAC o Q.SPEC `[S''']`) th) 2371 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2372 THEN1 (EVAL_TAC \\ DECIDE_TAC) 2373 \\ FS [isTrue_logic_flag_translate_TERM,logic_flag_translate_TERM,MAP] 2374 \\ STRIP_TAC \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2375 THEN1 (EVAL_TAC \\ MP_TAC (Q.SPEC `xs` LIST_LSIZE_MAP) \\ DECIDE_TAC) 2376 \\ FS [markerTheory.Abbrev_def,EVERY_DEF] \\ STRIP_TAC 2377 \\ FS [logic_translate_let__term_thm,sexp2sexp_def]) 2378 THEN1 2379 (Q.PAT_X_ASSUM `!xx.bbb` (MP_TAC o Q.SPEC `xs`) 2380 \\ MATCH_MP_TAC IMP_IMP \\ STRIP_TAC 2381 THEN1 (EVAL_TAC \\ MP_TAC (Q.SPEC `xs` LIST_LSIZE_LESS_EQ) \\ DECIDE_TAC) 2382 \\ FS [] \\ REPEAT STRIP_TAC 2383 \\ `?name. S' = Sym name` by FS [isSym_thm] 2384 \\ FS [sexp2sexp_def] 2385 \\ ONCE_REWRITE_TAC [sexp3term_def] \\ FS [LET_DEF,getSym_def,isTrue_memberp_rw] 2386 \\ FULL_SIMP_TAC (srw_ss()) [] 2387 \\ Cases_on `sym2prim name` \\ FS [] \\ POP_ASSUM MP_TAC 2388 \\ SIMP_TAC std_ss [sym2prim_def] \\ SRW_TAC [] [] THEN1 2389 (ONCE_REWRITE_TAC [term2t_def,func2f_def] 2390 \\ FS [t2sexp_def,MAP_sexp2sexp,func2f_def] 2391 \\ SRW_TAC [] [] \\ ASM_SIMP_TAC std_ss [logic_func2sexp_def,logic_prim2sym_def] 2392 \\ FS [logic_function_namep_def,isTrue_memberp_rw] 2393 \\ FS [term_vars_ok_def,EVERY_MAP,MAP_MAP_o,o_DEF] 2394 \\ EVAL_TAC \\ ASM_SIMP_TAC std_ss [markerTheory.Abbrev_def]) 2395 \\ FS [GSYM MAP_sexp2sexp] \\ EVAL_TAC \\ ASM_SIMP_TAC std_ss [] 2396 \\ FS [term_vars_ok_def,EVERY_MAP,MAP_MAP_o,o_DEF] 2397 \\ EVAL_TAC \\ ASM_SIMP_TAC std_ss [markerTheory.Abbrev_def])); 2398 2399val logic_translate_thm = prove( 2400 ``isTrue (logic_translate x) ==> (logic_translate x = sexp2sexp x)``, 2401 SIMP_TAC std_ss [logic_translate_def] \\ REPEAT STRIP_TAC 2402 \\ MP_TAC (Q.SPEC `[x]` logic_flag_translate_thm) 2403 \\ FULL_SIMP_TAC std_ss [logic_flag_translate_TERM,LET_DEF, 2404 isTrue_logic_flag_translate_TERM,list2sexp_def] \\ FS [MAP]); 2405 2406 2407val lookup_safe_STEP = prove( 2408 ``lookup_safe (Sym name) (Dot (Dot (Sym k) x) y) = 2409 if name = k then (Dot (Sym k) x) else 2410 lookup_safe (Sym name) y``, 2411 SIMP_TAC std_ss [Once lookup_safe_def] \\ FS []); 2412 2413val lookup_safe_init_ftbl_EXISTS = prove( 2414 ``MEM fname ["NOT"; "RANK"; "ORD<"; "ORDP"] ==> 2415 ?fparams raw_body. 2416 (list2sexp [Sym fname; list2sexp (MAP Sym fparams); raw_body] = 2417 lookup_safe (Sym fname) init_ftbl)``, 2418 SIMP_TAC std_ss [MEM] \\ REPEAT STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 2419 \\ ONCE_REWRITE_TAC [milawa_initTheory.init_ftbl_def] 2420 \\ REWRITE_TAC [lookup_safe_STEP,CONS_11,NOT_CONS_NIL,NOT_NIL_CONS] 2421 \\ SIMP_TAC (srw_ss()) [] \\ FS [list2sexp_def] 2422 THEN1 (Q.EXISTS_TAC `["X"]` \\ FS [MAP,list2sexp_def]) 2423 THEN1 (Q.EXISTS_TAC `["X"]` \\ FS [MAP,list2sexp_def]) 2424 THEN1 (Q.EXISTS_TAC `["X";"Y"]` \\ FS [MAP,list2sexp_def]) 2425 THEN1 (Q.EXISTS_TAC `["X"]` \\ FS [MAP,list2sexp_def])); 2426 2427val set_MAP_SUBSET = add_prove( 2428 ``!xs ys. set (MAP Sym xs) SUBSET set (MAP Sym ys) = set xs SUBSET set ys``, 2429 SIMP_TAC std_ss [SUBSET_DEF,MEM_MAP] 2430 \\ REPEAT STRIP_TAC \\ EQ_TAC \\ REPEAT STRIP_TAC \\ FS [] 2431 \\ METIS_TAC [SExp_11,SExp_distinct]); 2432 2433val logic_flag_termp_LIST = prove( 2434 ``!xs. isTrue (logic_flag_termp (Sym "LIST") (list2sexp xs)) = 2435 EVERY (\x. isTrue (logic_flag_termp (Sym "TERM") x)) xs``, 2436 Induct \\ SIMP_TAC std_ss [Once logic_flag_termp_def] 2437 \\ FS [EVERY_DEF] \\ Cases_on `isTrue (logic_flag_termp (Sym "TERM") h)` \\ FS []); 2438 2439val logic_variablep_EQ_var_ok = prove( 2440 ``!h. isTrue (logic_variablep (Sym h)) = var_ok h``, 2441 SIMP_TAC std_ss [logic_variablep_def] \\ FS [] \\ REPEAT STRIP_TAC 2442 \\ Cases_on `h = "T"` \\ FS [var_ok_def]); 2443 2444val logic_variable_listp_EQ_var_ok = prove( 2445 ``!xs. isTrue (logic_variable_listp (list2sexp (MAP Sym xs))) = EVERY var_ok xs``, 2446 Induct \\ SIMP_TAC std_ss [Once logic_variable_listp_def] 2447 \\ FS [EVERY_DEF,MAP,logic_variablep_EQ_var_ok] 2448 \\ REPEAT STRIP_TAC \\ Cases_on `var_ok h` \\ FS []); 2449 2450val term_syntax_ok_lemma = prove( 2451 ``!t. term_syntax_ok t ==> 2452 isTrue (logic_flag_termp (Sym "TERM") (t2sexp t))``, 2453 HO_MATCH_MP_TAC t2sexp_ind \\ REPEAT STRIP_TAC 2454 THEN1 (SIMP_TAC std_ss [t2sexp_def] 2455 \\ ONCE_REWRITE_TAC [logic_flag_termp_def] 2456 \\ FS [logic_variablep_def,term_syntax_ok_def,logic_constantp_def]) 2457 THEN1 (SIMP_TAC std_ss [t2sexp_def] 2458 \\ ONCE_REWRITE_TAC [logic_flag_termp_def] 2459 \\ FS [logic_variablep_def,term_syntax_ok_def]) 2460 THEN1 (SIMP_TAC std_ss [t2sexp_def] 2461 \\ ONCE_REWRITE_TAC [logic_flag_termp_def] 2462 \\ FS [logic_variablep_def,term_syntax_ok_def,LET_DEF] 2463 \\ Cases_on `isTrue (logic_flag_termp (Sym "LIST") (list2sexp (MAP t2sexp vs)))` 2464 \\ FS [] \\ FS [logic_flag_termp_LIST,EVERY_MEM,MEM_MAP] \\ METIS_TAC []) 2465 THEN1 (SIMP_TAC std_ss [t2sexp_def] 2466 \\ ONCE_REWRITE_TAC [logic_flag_termp_def] 2467 \\ FS [logic_variablep_def,term_syntax_ok_def,LET_DEF,LENGTH_MAP] 2468 \\ FS [logic_variable_listp_EQ_var_ok] 2469 \\ Cases_on `isTrue (logic_flag_termp (Sym "LIST") (list2sexp (MAP t2sexp ys)))` 2470 \\ FS [] \\ FS [logic_flag_termp_LIST,EVERY_MEM,MEM_MAP] \\ METIS_TAC [])); 2471 2472val term_syntax_ok_thm = prove( 2473 ``!t. term_syntax_ok t ==> isTrue (logic_termp (t2sexp t))``, 2474 SIMP_TAC std_ss [term_syntax_ok_lemma,logic_termp_def]); 2475 2476val formula_syntax_ok_thm = prove( 2477 ``!t. formula_syntax_ok t ==> isTrue (logic_formulap (f2sexp t))``, 2478 Induct \\ FS [formula_syntax_ok_def,f2sexp_def] 2479 \\ ONCE_REWRITE_TAC [logic_formulap_def] \\ FS [] 2480 \\ FULL_SIMP_TAC (srw_ss()) [term_syntax_ok_thm]); 2481 2482val list2sexp_11 = prove( 2483 ``!xs ys. (list2sexp xs = list2sexp ys) = (xs = ys)``, 2484 Induct \\ Cases_on `ys` \\ FS []); 2485 2486val logic_flag_appealp_LIST = prove( 2487 ``!xs. isTrue (logic_flag_appealp (Sym "LIST") (list2sexp xs)) = 2488 EVERY (\x. isTrue (logic_flag_appealp (Sym "PROOF") x)) xs``, 2489 Induct \\ SIMP_TAC std_ss [Once logic_flag_appealp_def] 2490 \\ FS [EVERY_DEF] \\ FULL_SIMP_TAC (srw_ss()) [] \\ FS [] 2491 \\ Cases_on `isTrue (logic_flag_appealp (Sym "PROOF") h)` \\ FS []); 2492 2493val appeal_syntax_ok_thm = prove( 2494 ``!t. appeal_syntax_ok t ==> isTrue (logic_appealp (a2sexp t))``, 2495 HO_MATCH_MP_TAC (fetch "-" "a2sexp_ind") \\ REPEAT STRIP_TAC 2496 \\ Cases_on `subproofs_extras` 2497 \\ FS [appeal_syntax_ok_def,a2sexp_def,LET_DEF] 2498 \\ REPEAT STRIP_TAC \\ FS [APPEND] 2499 \\ ONCE_REWRITE_TAC [logic_appealp_def] \\ FS [] 2500 \\ ONCE_REWRITE_TAC [logic_flag_appealp_def] \\ FS [] 2501 \\ SIMP_TAC std_ss [GSYM list2sexp_def,list2sexp_11] 2502 \\ ASM_SIMP_TAC std_ss [len_thm,getVal_def,LENGTH,formula_syntax_ok_thm] 2503 THEN1 EVAL_TAC \\ Cases_on `SND x` \\ FS [LENGTH] 2504 \\ FS [logic_flag_appealp_LIST,EVERY_MEM,MEM_MAP,PULL_EXISTS_IMP] 2505 \\ REPEAT STRIP_TAC \\ RES_TAC \\ FULL_SIMP_TAC std_ss [logic_appealp_def]); 2506 2507 2508(* Milawa's top-level invariant *) 2509 2510val _ = add_rws [core_checker_def,core_axioms_def,core_thms_def,core_atbl_def,core_ftbl_def] 2511 2512val core_check_proof_inv_def = Define ` 2513 core_check_proof_inv checker k = 2514 ?name. 2515 (checker = Sym name) /\ 2516 !x1 x2 x3 x4 io ok. ?res ok2 io2. 2517 R_ap (Fun name,[x1;x2;x3;x4],ARB,k,io,ok) (res,k,io ++ io2,ok2) /\ 2518 (ok2 ==> (io2 = "")) /\ 2519 !proof axioms thms atbl ctxt. 2520 appeal_syntax_ok proof /\ atbl_ok ctxt atbl /\ 2521 thms_inv ctxt thms /\ thms_inv ctxt axioms /\ 2522 isTrue res /\ (x1 = a2sexp proof) /\ 2523 (x2 = list2sexp (MAP f2sexp axioms)) /\ 2524 (x3 = list2sexp (MAP f2sexp thms)) /\ (x4 = atbl) /\ ok2 ==> 2525 MilawaTrue ctxt (CONCL proof)`; 2526 2527val core_check_proof_inv_init = prove( 2528 ``core_check_proof_inv (Sym "LOGIC.PROOFP") core_funs``, 2529 SIMP_TAC (srw_ss()) [core_check_proof_inv_def] \\ REPEAT STRIP_TAC 2530 \\ Q.EXISTS_TAC `logic_proofp x1 x2 x3 x4` \\ Q.EXISTS_TAC `ok` 2531 \\ Q.EXISTS_TAC `""` \\ SIMP_TAC std_ss [APPEND_NIL] 2532 \\ STRIP_TAC THEN1 2533 (MATCH_MP_TAC R_ev_logic_proofp 2534 \\ SIMP_TAC std_ss [milawa_initTheory.core_assum_thm]) 2535 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [] \\ IMP_RES_TAC logic_proofp_thm); 2536 2537val add_def_lemma = prove( 2538 ``(FDOM (add_def k x) = FDOM k UNION {FST x}) /\ 2539 (add_def k x ' n = if n IN FDOM k then k ' n else 2540 if n = FST x then SND x else FEMPTY ' n)``, 2541 Cases_on `x` 2542 \\ ASM_SIMP_TAC std_ss [SUBMAP_DEF,add_def_def, 2543 FUNION_DEF,FAPPLY_FUPDATE_THM, 2544 FDOM_FUPDATE,IN_UNION,FDOM_FUPDATE, 2545 FDOM_FEMPTY]); 2546 2547val R_ev_SUBMAP = prove( 2548 ``(!x y. R_ap x y ==> (FST (SND (SND (SND x)))) SUBMAP (FST (SND y))) /\ 2549 (!x y. R_evl x y ==> (FST (SND (SND x))) SUBMAP (FST (SND y))) /\ 2550 (!x y. R_ev x y ==> (FST (SND (SND x))) SUBMAP (FST (SND y)))``, 2551 HO_MATCH_MP_TAC R_ev_ind \\ SIMP_TAC std_ss [FORALL_PROD,LET_DEF] 2552 \\ SIMP_TAC std_ss [SUBMAP_REFL] \\ REPEAT STRIP_TAC 2553 \\ IMP_RES_TAC SUBMAP_TRANS \\ ASM_SIMP_TAC std_ss [] 2554 \\ ASM_SIMP_TAC std_ss [add_def_lemma,SUBMAP_DEF,IN_UNION]); 2555 2556val R_ev_OK = prove( 2557 ``(!x y. R_ap x y ==> SND (SND (SND y)) ==> (SND (SND (SND (SND (SND x)))))) /\ 2558 (!x y. R_evl x y ==> SND (SND (SND y)) ==> (SND (SND (SND (SND (x)))))) /\ 2559 (!x y. R_ev x y ==> SND (SND (SND y)) ==> (SND (SND (SND (SND (x))))))``, 2560 HO_MATCH_MP_TAC R_ev_ind \\ SIMP_TAC std_ss [FORALL_PROD,LET_DEF]); 2561 2562val PREFIX_def = Define ` 2563 (PREFIX [] _ = T) /\ 2564 (PREFIX (x::xs) (y::ys) = (x = y) /\ PREFIX xs ys) /\ 2565 (PREFIX (x::xs) [] = F)`; 2566 2567val PREFIX_REFL = prove( 2568 ``!xs. PREFIX xs xs``, 2569 Induct \\ ASM_SIMP_TAC std_ss [PREFIX_def]); 2570 2571val PREFIX_ANTISYM = prove( 2572 ``!xs ys. PREFIX xs ys /\ PREFIX ys xs = (xs = ys)``, 2573 Induct \\ Cases_on `ys` \\ FULL_SIMP_TAC (srw_ss()) [PREFIX_def] \\ METIS_TAC []); 2574 2575val PREFIX_TRANS = prove( 2576 ``!xs ys zs. PREFIX xs ys /\ PREFIX ys zs ==> PREFIX xs zs``, 2577 Induct \\ Cases_on `ys` \\ Cases_on `zs` 2578 \\ FULL_SIMP_TAC (srw_ss()) [PREFIX_def] \\ METIS_TAC []); 2579 2580val PREFIX_APPEND = prove( 2581 ``!xs ys. PREFIX xs (xs ++ ys)``, 2582 Induct \\ FULL_SIMP_TAC (srw_ss()) [PREFIX_def,APPEND] \\ METIS_TAC []); 2583 2584val R_ev_PREFIX = prove( 2585 ``(!x y. R_ap x y ==> PREFIX (FST (SND (SND (SND (SND x))))) (FST (SND (SND y)))) /\ 2586 (!x y. R_evl x y ==> PREFIX (FST (SND (SND (SND x)))) (FST (SND (SND y)))) /\ 2587 (!x y. R_ev x y ==> PREFIX (FST (SND (SND (SND x)))) (FST (SND (SND y))))``, 2588 HO_MATCH_MP_TAC R_ev_ind \\ SIMP_TAC std_ss [FORALL_PROD,LET_DEF] 2589 \\ SIMP_TAC std_ss [PREFIX_REFL] \\ REPEAT STRIP_TAC 2590 \\ IMP_RES_TAC PREFIX_TRANS \\ ASM_SIMP_TAC std_ss [] 2591 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,PREFIX_APPEND]); 2592 2593val add_def_SUBMAP = prove( 2594 ``add_def fns (x,y) SUBMAP fns ==> x IN FDOM fns``, 2595 ASM_SIMP_TAC std_ss [SUBMAP_DEF,add_def_lemma, 2596 IN_UNION,IN_INSERT,NOT_IN_EMPTY]); 2597 2598val R_ev_induct = IndDefLib.derive_strong_induction(R_ev_rules,R_ev_ind); 2599 2600val R_ev_add_def = prove( 2601 ``(!x y. R_ap x y ==> 2602 let (f,args,env,k,io,ok) = x in 2603 let (res,k2,io2,ok2) = y in 2604 (k2 = k) ==> 2605 R_ap (f,args,env,add_def k d,io,ok) (res,add_def k2 d,io2,ok2)) /\ 2606 (!x y. R_evl x y ==> 2607 let (e,env,k,io,ok) = x in 2608 let (res,k2,io2,ok2) = y in 2609 (k2 = k) ==> 2610 R_evl (e,env,add_def k d,io,ok) (res,add_def k2 d,io2,ok2)) /\ 2611 (!x y. R_ev x y ==> 2612 let (e,env,k,io,ok) = x in 2613 let (res,k2,io2,ok2) = y in 2614 (k2 = k) ==> 2615 R_ev (e,env,add_def k d,io,ok) (res,add_def k2 d,io2,ok2))``, 2616 HO_MATCH_MP_TAC R_ev_induct \\ SIMP_TAC std_ss [FORALL_PROD,LET_DEF] 2617 \\ REVERSE (REPEAT STRIP_TAC) 2618 \\ ONCE_REWRITE_TAC [R_ev_cases] \\ ASM_SIMP_TAC (srw_ss()) [] 2619 \\ IMP_RES_TAC R_ev_SUBMAP \\ FULL_SIMP_TAC std_ss [] 2620 \\ IMP_RES_TAC SUBMAP_ANTISYM \\ FULL_SIMP_TAC std_ss [] 2621 \\ FULL_SIMP_TAC std_ss [add_def_lemma,IN_UNION] 2622 \\ IMP_RES_TAC add_def_SUBMAP \\ FULL_SIMP_TAC std_ss [] 2623 \\ SIMP_TAC std_ss [GSYM SUBMAP_ANTISYM] 2624 \\ SIMP_TAC std_ss [SUBMAP_DEF,add_def_lemma,IN_UNION, 2625 IN_INSERT,NOT_IN_EMPTY] \\ REPEAT STRIP_TAC \\ ASM_SIMP_TAC std_ss [] 2626 \\ METIS_TAC []) |> SIMP_RULE std_ss [FORALL_PROD,LET_DEF]; 2627 2628val R_ap_add_def = prove( 2629 ``R_ap (f,args,env,k,io,ok) (res,k,io2,ok2) ==> 2630 R_ap (f,args,env,add_def k d,io,ok) (res,add_def k d,io2,ok2)``, 2631 METIS_TAC [R_ev_add_def]); 2632 2633val core_check_proof_inv_step = prove( 2634 ``core_check_proof_inv name k ==> 2635 core_check_proof_inv name (add_def k new_def)``, 2636 SIMP_TAC std_ss [core_check_proof_inv_def] \\ REPEAT STRIP_TAC 2637 \\ FULL_SIMP_TAC (srw_ss()) [] \\ REPEAT STRIP_TAC 2638 \\ POP_ASSUM (STRIP_ASSUME_TAC o SPEC_ALL) 2639 \\ Q.LIST_EXISTS_TAC [`res`,`ok2`,`io2`] \\ REVERSE STRIP_TAC THEN1 METIS_TAC [] 2640 \\ MATCH_MP_TAC R_ap_add_def \\ FULL_SIMP_TAC std_ss []); 2641 2642val core_check_proof_inv_IMP_RAW = prove( 2643 ``core_check_proof_inv checker k ==> 2644 core_check_proof_side checker t axioms thms atbl k io ok /\ 2645 (SND (SND (SND (core_check_proof checker t axioms thms atbl k io ok))) ==> ok /\ 2646 (FST (SND (core_check_proof checker t axioms thms atbl k io ok)) = k) /\ 2647 (FST (SND (SND (core_check_proof checker t axioms thms atbl k io ok))) = io))``, 2648 SIMP_TAC std_ss [core_check_proof_inv_def] \\ STRIP_TAC 2649 \\ REPEAT (POP_ASSUM MP_TAC) \\ STRIP_TAC \\ STRIP_TAC 2650 \\ POP_ASSUM (STRIP_ASSUME_TAC o Q.SPECL [`t`,`axioms`,`thms`,`atbl`,`io`,`ok`]) 2651 \\ `R_ap (Funcall,[Sym name; t; axioms; thms; atbl],ARB,k,io,ok) (res,k,io ++ io2,ok2)` by 2652 (POP_ASSUM (K ALL_TAC) \\ POP_ASSUM (K ALL_TAC) \\ POP_ASSUM MP_TAC 2653 \\ ONCE_REWRITE_TAC [R_ev_cases] \\ SIMP_TAC (srw_ss()) [] \\ METIS_TAC []) 2654 \\ SIMP_TAC std_ss [core_check_proof_side_def] 2655 \\ `funcall_ok [checker; t; axioms; thms; atbl] k io ok` by 2656 (SIMP_TAC std_ss [funcall_ok_def] \\ METIS_TAC []) 2657 \\ SIMP_TAC std_ss [core_check_proof_def] 2658 \\ ASM_SIMP_TAC std_ss [funcall_def] 2659 \\ Cases_on `ok2` THEN1 2660 (FULL_SIMP_TAC std_ss [] \\ Q.PAT_X_ASSUM `io2 = ""` ASSUME_TAC 2661 \\ FULL_SIMP_TAC std_ss [APPEND_NIL] 2662 \\ `!x. R_ap (Funcall,[Sym name; t; axioms; thms; atbl],ARB,k,io,ok) x = 2663 (x = (res,k,io,T))` by METIS_TAC [R_ap_T_11] 2664 \\ FULL_SIMP_TAC std_ss [] 2665 \\ IMP_RES_TAC R_ev_OK \\ FULL_SIMP_TAC std_ss []) 2666 \\ Q.ABBREV_TAC `xxx = (@result. 2667 R_ap (Funcall,[Sym name; t; axioms; thms; atbl],ARB,k,io,ok) 2668 result)` 2669 \\ `R_ap (Funcall,[Sym name; t; axioms; thms; atbl],ARB,k,io,ok) xxx` by METIS_TAC [] 2670 \\ `?x1 x2 x3 b. xxx = (x1,x2,x3,b)` by METIS_TAC [PAIR] 2671 \\ FULL_SIMP_TAC std_ss [] \\ METIS_TAC [R_ap_F_11]); 2672 2673val core_check_proof_inv_IMP = prove( 2674 ``core_check_proof_inv checker k ==> 2675 core_check_proof_side checker t axioms thms atbl k io ok /\ 2676 (SND (SND (SND (core_check_proof checker t axioms thms atbl k io ok))) ==> 2677 (FST (SND (core_check_proof checker t axioms thms atbl k io ok)) = k) /\ 2678 (FST (SND (SND (core_check_proof checker t axioms thms atbl k io ok))) = io))``, 2679 METIS_TAC [core_check_proof_inv_IMP_RAW]); 2680 2681val core_check_proof_inv_IMP_OK = prove( 2682 ``core_check_proof_inv checker k ==> 2683 (SND (SND (SND (core_check_proof checker t axioms thms atbl k io ok))) ==> ok)``, 2684 METIS_TAC [core_check_proof_inv_IMP_RAW]); 2685 2686val core_check_proof_IMP_OK = prove( 2687 ``SND (SND (SND (core_check_proof checker proofs axioms thms atbl k io ok))) ==> 2688 ok``, 2689 SIMP_TAC std_ss [core_check_proof_def,funcall_def] 2690 \\ Cases_on `funcall_ok [checker; proofs; axioms; thms; atbl] k io ok` 2691 \\ FULL_SIMP_TAC std_ss [] 2692 \\ FULL_SIMP_TAC std_ss [funcall_ok_def] 2693 \\ Cases_on `ok` \\ FULL_SIMP_TAC std_ss [] 2694 \\ Q.ABBREV_TAC `xxx = R_ap (Funcall,[checker; proofs; axioms; thms; atbl],ARB,k,io,F)` 2695 \\ `xxx (@result. xxx result)` by METIS_TAC [] 2696 \\ `?x1 x2 x3 x4. (@result. xxx result) = (x1,x2,x3,x4)` by METIS_TAC [PAIR] 2697 \\ Q.UNABBREV_TAC `xxx` \\ FULL_SIMP_TAC std_ss [] 2698 \\ IMP_RES_TAC R_ev_OK \\ FULL_SIMP_TAC std_ss []); 2699 2700val core_check_proof_list_IMP_OK = prove( 2701 ``!proofs k io ok. 2702 SND (SND (SND (core_check_proof_list checker proofs axioms thms atbl k io ok))) ==> 2703 ok``, 2704 REVERSE Induct \\ ONCE_REWRITE_TAC [core_check_proof_list_def] 2705 \\ SS [LET_DEF] \\ CONV_TAC (DEPTH_CONV (PairRules.PBETA_CONV)) 2706 \\ Cases_on `isTrue (FST 2707 (core_check_proof checker proofs axioms thms atbl k io ok))` 2708 \\ SIMP_TAC std_ss [] \\ REPEAT STRIP_TAC \\ RES_TAC 2709 \\ IMP_RES_TAC core_check_proof_IMP_OK); 2710 2711val SUBMAP_core_check_proof = prove( 2712 ``k SUBMAP (FST (SND (core_check_proof checker t axioms thms atbl k io ok)))``, 2713 SIMP_TAC std_ss [core_check_proof_def,funcall_def] 2714 \\ Cases_on `funcall_ok [checker; t; axioms; thms; atbl] k io ok` \\ FS [] 2715 \\ FULL_SIMP_TAC std_ss [SUBMAP_REFL] 2716 \\ FULL_SIMP_TAC std_ss [funcall_ok_def] 2717 \\ Q.ABBREV_TAC `xxx = (@result. 2718 R_ap (Funcall,[checker; t; axioms; thms; atbl],ARB,k,io,ok) 2719 result)` 2720 \\ `R_ap (Funcall,[checker; t; axioms; thms; atbl],ARB,k,io,ok) xxx` by METIS_TAC [] 2721 \\ IMP_RES_TAC R_ev_SUBMAP \\ FULL_SIMP_TAC std_ss []); 2722 2723val add_def_SUBMAP = prove( 2724 ``add_def fns (x,y,z) SUBMAP fns ==> x IN FDOM fns``, 2725 SIMP_TAC std_ss [SUBMAP_DEF,add_def_def,FUNION_DEF,FDOM_FUPDATE, 2726 FDOM_FEMPTY,FAPPLY_FUPDATE_THM,IN_UNION,IN_INSERT,NOT_IN_EMPTY]); 2727 2728val add_def_EQ = prove( 2729 ``x IN FDOM k ==> (k = add_def k (x,y,z))``, 2730 SIMP_TAC std_ss [GSYM SUBMAP_ANTISYM] 2731 \\ SIMP_TAC std_ss [SUBMAP_DEF,add_def_def,FUNION_DEF,FDOM_FUPDATE, 2732 FDOM_FEMPTY,FAPPLY_FUPDATE_THM,IN_UNION,IN_INSERT,NOT_IN_EMPTY] 2733 \\ METIS_TAC []); 2734 2735val SUBMAP_IMP_R_ev_lemma = prove( 2736 ``(!x y. R_ap x y ==> 2737 let (f,args,env,k,io,ok) = x in 2738 let (res,k2,io2,ok2) = y in 2739 !k3. (k = k2) /\ k SUBMAP k3 ==> 2740 R_ap (f,args,env,k3,io,ok) (res,k3,io2,ok2)) /\ 2741 (!x y. R_evl x y ==> 2742 let (exp,env,k,io,ok) = x in 2743 let (res,k2,io2,ok2) = y in 2744 !k3. (k = k2) /\ k SUBMAP k3 ==> 2745 R_evl (exp,env,k3,io,ok) (res,k3,io2,ok2)) /\ 2746 (!x y. R_ev x y ==> 2747 let (exp,env,k,io,ok) = x in 2748 let (res,k2,io2,ok2) = y in 2749 !k3. (k = k2) /\ k SUBMAP k3 ==> 2750 R_ev (exp,env,k3,io,ok) (res,k3,io2,ok2))``, 2751 HO_MATCH_MP_TAC R_ev_induct \\ SIMP_TAC std_ss [LET_DEF] 2752 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 2753 \\ REPEAT (ONCE_REWRITE_TAC [R_ev_cases] \\ FULL_SIMP_TAC (srw_ss()) [] 2754 \\ IMP_RES_TAC R_ev_SUBMAP \\ FULL_SIMP_TAC std_ss [] 2755 \\ IMP_RES_TAC SUBMAP_ANTISYM 2756 \\ FULL_SIMP_TAC std_ss [] \\ RES_TAC 2757 \\ IMP_RES_TAC add_def_SUBMAP \\ FULL_SIMP_TAC std_ss [] 2758 \\ METIS_TAC [SUBMAP_DEF,add_def_SUBMAP,add_def_EQ])) 2759 |> SIMP_RULE std_ss [FORALL_PROD,LET_DEF] 2760 2761val SUBMAP_IMP_R_ev = prove( 2762 ``k SUBMAP k2 /\ 2763 R_ap (f,args,env,k,io,ok) (res,k,io2,ok2) ==> 2764 R_ap (f,args,env,k2,io,ok) (res,k2,io2,ok2)``, 2765 METIS_TAC [SUBMAP_IMP_R_ev_lemma]); 2766 2767val core_check_proof_list_inv_IMP_side = prove( 2768 ``!ok io k. 2769 core_check_proof_inv checker k ==> 2770 core_check_proof_list_side checker t axioms thms atbl k io ok``, 2771 REVERSE (Induct_on `t`) 2772 \\ ONCE_REWRITE_TAC [core_check_proof_list_def,core_check_proof_list_side_def] 2773 \\ FS [LET_DEF] \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 2774 \\ FULL_SIMP_TAC std_ss [core_check_proof_inv_IMP] 2775 \\ REPEAT STRIP_TAC \\ Q.PAT_X_ASSUM `!bb.bbb` MATCH_MP_TAC 2776 \\ Q.ABBREV_TAC `k2 = (FST (SND (core_check_proof checker t axioms thms atbl k io ok)))` 2777 \\ `k SUBMAP k2` by METIS_TAC [SUBMAP_core_check_proof] 2778 \\ FULL_SIMP_TAC std_ss [core_check_proof_inv_def] 2779 \\ FULL_SIMP_TAC (srw_ss()) [] \\ REPEAT STRIP_TAC 2780 \\ Q.PAT_X_ASSUM `!x1.bbb` (STRIP_ASSUME_TAC o Q.SPECL [`x1`,`x2`,`x3`,`x4`,`io'`,`ok'`]) 2781 \\ Q.LIST_EXISTS_TAC [`res`,`ok2`,`io2`] \\ FULL_SIMP_TAC std_ss [] 2782 \\ METIS_TAC [SUBMAP_IMP_R_ev]); 2783 2784val core_check_proof_list_inv_IMP = prove( 2785 ``core_check_proof_inv checker k /\ 2786 SND (SND (SND (core_check_proof_list checker t axioms thms atbl k io ok))) ==> 2787 (FST (SND (core_check_proof_list checker t axioms thms atbl k io ok)) = k) /\ 2788 (FST (SND (SND (core_check_proof_list checker t axioms thms atbl k io ok))) = io)``, 2789 REVERSE (Induct_on `t`) 2790 \\ ONCE_REWRITE_TAC [core_check_proof_list_def,core_check_proof_list_side_def] 2791 \\ FS [LET_DEF] \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 2792 \\ FULL_SIMP_TAC std_ss [] 2793 \\ Cases_on `isTrue (FST (core_check_proof checker t axioms thms atbl k io ok))` 2794 \\ FS [] \\ STRIP_TAC 2795 \\ IMP_RES_TAC core_check_proof_list_IMP_OK 2796 \\ IMP_RES_TAC core_check_proof_IMP_OK 2797 \\ FULL_SIMP_TAC std_ss [] 2798 \\ IMP_RES_TAC core_check_proof_inv_IMP 2799 \\ FULL_SIMP_TAC std_ss [] 2800 \\ Q.PAT_X_ASSUM `ok` ASSUME_TAC \\ FULL_SIMP_TAC std_ss []) 2801 |> DISCH_ALL |> SIMP_RULE std_ss []; 2802 2803val core_check_proof_list_inv_IMP_OK = prove( 2804 ``!ok. core_check_proof_inv checker k ==> 2805 (SND (SND (SND (core_check_proof_list checker t axioms thms atbl k io ok))) ==> ok)``, 2806 METIS_TAC [core_check_proof_list_IMP_OK]); 2807 2808val ftbl_inv_def = Define ` 2809 ftbl_inv k ftbl = 2810 (* every proper ftbl entry exists in the runtime *) 2811 EVERY (\x. if isTrue (CDR x) then 2812 let name = getSym (CAR x) in 2813 let formals = MAP getSym (sexp2list (CAR (CDR x))) in 2814 let body = sexp2term (CAR (CDR (CDR x))) in 2815 name IN FDOM k /\ (k ' name = (formals,body)) 2816 else T) 2817 (sexp2list ftbl) /\ 2818 (* a list of fake ftbl entries are present, the fake entries 2819 make it impossible to define functions with certain names 2820 using define-safe and admit-defun. *) 2821 EVERY (\s. lookup_safe (Sym s) ftbl = list2sexp [Sym s]) fake_ftbl_entries 2822 (* the initial content is present throughout execution *) /\ 2823 (* all entries are conses and the keys are distinct *) 2824 EVERY isDot (sexp2list ftbl) /\ ALL_DISTINCT (MAP CAR (sexp2list ftbl)) /\ 2825 (* the initial ftbl is at the bottom of the list *) 2826 ?old. FUNPOW CDR old ftbl = init_ftbl`; 2827 2828val str2func_def = Define ` 2829 str2func str = if str = "RANK" then mPrimitiveFun logic_RANK else 2830 if str = "NOT" then mPrimitiveFun logic_NOT else 2831 if str = "ORDP" then mPrimitiveFun logic_ORDP else 2832 if str = "ORD<" then mPrimitiveFun logic_ORD_LESS else mFun str`; 2833 2834val def_axiom_def = Define ` 2835 (def_axiom name (params,BODY_FUN body,sem) = 2836 (Equal (mApp (str2func name) (MAP mVar params)) body)) /\ 2837 (def_axiom name (params,WITNESS_FUN exp var_name,sem) = 2838 (Or (Equal exp (mConst (Sym "NIL"))) 2839 (Not (Equal (mLamApp (var_name::params) exp 2840 (mApp (str2func name) (MAP mVar params)::MAP mVar params)) 2841 (mConst (Sym "NIL"))))))`; 2842 2843val func_definition_exists_def = Define ` 2844 func_definition_exists ctxt name params body sem = 2845 name IN FDOM ctxt /\ (ctxt ' name = (params,body,sem)) \/ 2846 ?raw_body. 2847 MEM name ["NOT";"RANK";"ORD<";"ORDP"] /\ 2848 (list2sexp [Sym name; list2sexp (MAP Sym params); raw_body] = 2849 lookup_safe (Sym name) init_ftbl) /\ 2850 (body = BODY_FUN (term2t (sexp3term raw_body)))`; 2851 2852val logic_func_inv_def = Define ` 2853 logic_func_inv name ctxt raw_body = 2854 (MEM name ["NOT";"RANK";"ORD<";"ORDP"] \/ 2855 let logic_body = term2t (sexp3term raw_body) in 2856 !a. M_ev name (logic_body,a,ctxt) (EvalTerm (a,ctxt) logic_body))`; 2857 2858val witness_body_def = Define ` 2859 witness_body name var_name params raw_body = 2860 list2sexp [Sym "ERROR"; list2sexp [Sym "QUOTE"; 2861 list2sexp [Sym name; Sym var_name; list2sexp (MAP Sym params); raw_body]]]`; 2862 2863val axioms_aux_def = Define ` 2864 (axioms_aux name ctxt axioms ftbl params sem (BODY_FUN body) = 2865 ?raw_body. 2866 (MEM (list2sexp [Sym name; list2sexp (MAP Sym params); raw_body]) (sexp2list ftbl)) /\ 2867 (body = (term2t (sexp3term raw_body))) /\ 2868 (MEM (def_axiom name (params,BODY_FUN body,sem)) axioms) /\ 2869 logic_func_inv name ctxt raw_body /\ ~(CAR raw_body = Sym "ERROR")) /\ 2870 (axioms_aux name ctxt axioms ftbl params sem (WITNESS_FUN body var_name) = 2871 ?raw_body. 2872 (MEM (list2sexp [Sym name; list2sexp (MAP Sym params); 2873 witness_body name var_name params raw_body]) (sexp2list ftbl)) /\ 2874 (body = (term2t (sexp3term raw_body))) /\ 2875 (MEM (def_axiom name (params,WITNESS_FUN body var_name,sem)) axioms)) /\ 2876 (axioms_aux name ctxt axioms ftbl params sem NO_FUN = F)`; 2877 2878val axioms_inv_def = Define ` 2879 axioms_inv ctxt ftbl axioms = 2880 EVERY (\x. ~(x IN FDOM ctxt)) ["NOT";"RANK";"ORDP";"ORD<"] /\ 2881 !name params body sem. 2882 func_definition_exists ctxt name params body sem ==> 2883 axioms_aux name ctxt axioms ftbl params sem body`; 2884 2885val atbl_ftbl_inv_def = Define ` 2886 atbl_ftbl_inv atbl ftbl = 2887 !fname. isTrue (lookup (Sym fname) atbl) ==> 2888 MEM (Sym fname) (MAP CAR (sexp2list ftbl)) /\ ~(fname = "ERROR")`; 2889 2890val atbl_inv_def = Define ` 2891 atbl_inv atbl = EVERY (\x. isVal (CDR x)) (sexp2list atbl)`; 2892 2893val context_inv_def = Define ` 2894 context_inv ctxt = 2895 (!fname params body sem. 2896 fname IN FDOM ctxt /\ (ctxt ' fname = (params,BODY_FUN body,sem)) ==> 2897 (sem = EvalFun fname ctxt)) /\ 2898 (!fname params var body sem. 2899 fname IN FDOM ctxt /\ (ctxt ' fname = (params,WITNESS_FUN body var,sem)) ==> 2900 (sem = \args. 2901 @v. isTrue (EvalTerm (FunVarBind (var::params) (v::args),ctxt) body)))`; 2902 2903val context_syntax_same_def = Define ` 2904 context_syntax_same ctxt simple_ctxt = 2905 (FDOM simple_ctxt = FDOM ctxt) /\ 2906 FEVERY (\(name,formals,body,interp). 2907 name IN FDOM ctxt /\ 2908 ?sem. ctxt ' name = (formals,body,sem)) simple_ctxt`; 2909 2910val similar_context_def = Define ` 2911 similar_context ctxt simple_ctxt = 2912 context_ok simple_ctxt /\ context_syntax_same ctxt simple_ctxt` 2913 |> REWRITE_RULE [context_syntax_same_def,GSYM CONJ_ASSOC]; 2914 2915val milawa_inv_def = Define ` 2916 milawa_inv ctxt simple_ctxt k (axioms,thms,atbl,checker,ftbl) = 2917 context_ok ctxt /\ context_inv ctxt /\ 2918 similar_context ctxt simple_ctxt /\ 2919 atbl_ok ctxt atbl /\ atbl_inv atbl /\ 2920 thms_inv ctxt thms /\ thms_inv ctxt axioms /\ 2921 core_check_proof_inv checker k /\ ftbl_inv k ftbl /\ 2922 axioms_inv ctxt ftbl axioms /\ atbl_ftbl_inv atbl ftbl /\ 2923 runtime_inv ctxt k /\ core_assum k`; 2924 2925val milawa_state_def = Define ` 2926 milawa_state (axioms,thms,atbl,checker,ftbl) = 2927 core_state (list2sexp (MAP f2sexp axioms)) 2928 (list2sexp (MAP f2sexp thms)) atbl checker ftbl`; 2929 2930val DISJ_EQ_IMP = METIS_PROVE [] ``x \/ y = ~x ==> y``; 2931 2932 2933(* admit theorem *) 2934 2935val Funcall_lemma = prove( 2936 ``R_ap (Fun name,xs,env,k,io,ok) res ==> 2937 R_ap (Funcall,(Sym name)::xs,env,k,io,ok) res``, 2938 ONCE_REWRITE_TAC [R_ev_cases] 2939 \\ SIMP_TAC (srw_ss()) [] \\ METIS_TAC []); 2940 2941val core_check_proof_thm = prove( 2942 ``core_check_proof_inv checker k /\ appeal_syntax_ok t /\ atbl_ok ctxt atbl /\ 2943 context_ok ctxt /\ thms_inv ctxt thms /\ thms_inv ctxt axioms /\ 2944 SND (SND (SND (core_check_proof checker (a2sexp t) 2945 (list2sexp (MAP f2sexp axioms)) 2946 (list2sexp (MAP f2sexp thms)) atbl k io ok))) /\ 2947 isTrue (FST (core_check_proof checker (a2sexp t) 2948 (list2sexp (MAP f2sexp axioms)) 2949 (list2sexp (MAP f2sexp thms)) atbl k io ok)) ==> 2950 MilawaTrue ctxt (CONCL t)``, 2951 REPEAT STRIP_TAC 2952 \\ STRIP_ASSUME_TAC (UNDISCH core_check_proof_inv_IMP |> CONJUNCT1 |> GEN_ALL) 2953 \\ FULL_SIMP_TAC std_ss [core_check_proof_inv_def] 2954 \\ FULL_SIMP_TAC std_ss [Once core_check_proof_side_def] 2955 \\ POP_ASSUM MP_TAC 2956 \\ Q.PAT_X_ASSUM `!(x1:SExp). bbb` (MP_TAC o Q.SPECL [`a2sexp t`, 2957 `list2sexp (MAP f2sexp axioms)`, 2958 `list2sexp (MAP f2sexp thms)`,`atbl`,`io`,`ok`]) 2959 \\ REPEAT STRIP_TAC 2960 \\ FULL_SIMP_TAC std_ss [core_check_proof_def,funcall_def] 2961 \\ Q.PAT_X_ASSUM `checker = Sym name` (ASSUME_TAC) 2962 \\ IMP_RES_TAC Funcall_lemma 2963 \\ Cases_on `ok2` THEN1 2964 (FULL_SIMP_TAC std_ss [APPEND_NIL] 2965 \\ Q.PAT_X_ASSUM `io2 = ""` ASSUME_TAC \\ FULL_SIMP_TAC std_ss [APPEND_NIL] 2966 \\ `!x. R_ap (Funcall, 2967 [Sym name; a2sexp t; list2sexp (MAP f2sexp axioms); 2968 list2sexp (MAP f2sexp thms); atbl],ARB,k,io,ok) x = 2969 (x = (res,k,io,T))` by METIS_TAC [R_ap_T_11] 2970 \\ FULL_SIMP_TAC std_ss [] \\ METIS_TAC []) 2971 \\ Q.ABBREV_TAC `xxx = (@result. 2972 R_ap (Funcall, 2973 [Sym name; a2sexp t; list2sexp (MAP f2sexp axioms); 2974 list2sexp (MAP f2sexp thms); atbl],ARB,k,io,ok) 2975 result)` 2976 \\ `R_ap (Funcall, 2977 [Sym name; a2sexp t; list2sexp (MAP f2sexp axioms); 2978 list2sexp (MAP f2sexp thms); atbl],ARB,k,io,ok) xxx` by METIS_TAC [] 2979 \\ `?x1 x2 x3 b. xxx = (x1,x2,x3,b)` by METIS_TAC [PAIR] 2980 \\ FULL_SIMP_TAC std_ss [] \\ METIS_TAC [R_ap_F_11]); 2981 2982val core_admit_theorem_thm = prove( 2983 ``milawa_inv ctxt simple_ctxt k (axioms,thms,atbl,checker,ftbl) ==> 2984 ?x k2 io2 ok2 result. 2985 core_admit_theorem_side cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok /\ 2986 (core_admit_theorem cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok = 2987 (x,k2,io2,ok2)) /\ 2988 (ok2 ==> (k2 = k) /\ (io2 = io) /\ 2989 ?result. (x = milawa_state result) /\ milawa_inv ctxt simple_ctxt k result)``, 2990 FS [core_admit_theorem_def,LET_DEF,milawa_state_def,core_state_def, 2991 SIMP_RULE std_ss [DISJ_EQ_IMP,GSYM AND_IMP_INTRO,LET_DEF] core_admit_theorem_side_def] 2992 \\ SRW_TAC [] [] \\ FS [] \\ FS [] 2993 \\ IMP_RES_TAC logic_appealp_thm \\ FS [] 2994 \\ Q.PAT_X_ASSUM `f2sexp (CONCL t) = xxx` (ASSUME_TAC o GSYM) \\ FS [] 2995 \\ FS [milawa_inv_def,EVERY_DEF] 2996 \\ STRIP_ASSUME_TAC (core_check_proof_inv_IMP |> UNDISCH |> GEN_ALL) 2997 \\ FS [] THEN1 2998 (Q.EXISTS_TAC `(axioms,thms,atbl,checker,ftbl)` 2999 \\ ASM_SIMP_TAC std_ss [milawa_inv_def] \\ EVAL_TAC) 3000 \\ Q.EXISTS_TAC `(axioms,CONCL t::thms,atbl,checker,ftbl)` 3001 \\ STRIP_TAC THEN1 EVAL_TAC 3002 \\ FS [milawa_inv_def,thms_inv_def,EVERY_DEF] 3003 \\ METIS_TAC [core_check_proof_thm,thms_inv_def]); 3004 3005 3006(* admit defun *) 3007 3008val if_memberp_def = Define ` 3009 if_memberp new_axiom axioms = 3010 if isTrue (memberp new_axiom axioms) then axioms else LISP_CONS new_axiom axioms` 3011 3012val if_lookup_def = Define ` 3013 if_lookup name atbl new_atbl = 3014 if isTrue (lookup name atbl) then atbl else new_atbl`; 3015 3016val core_admit_defun_lemma = core_admit_defun_def 3017 |> SIMP_RULE std_ss [GSYM if_memberp_def,GSYM if_lookup_def] 3018 3019val core_admit_defun_side_lemma = core_admit_defun_side_def 3020 |> SIMP_RULE std_ss [DISJ_EQ_IMP,GSYM AND_IMP_INTRO,LET_DEF,define_safe_side_def] 3021 3022val SND_SND_SND_define_safe_IMP = prove( 3023 ``SND (SND (SND (define_safe ftbl name formals body k io ok))) ==> ok``, 3024 SIMP_TAC std_ss [define_safe_def,LET_DEF] \\ SRW_TAC [] []); 3025 3026val fake_ftbl_entries = prove( 3027 ``ftbl_inv k ftbl /\ 3028 SND (SND (SND (define_safe ftbl (Sym fname) ys body k io ok))) ==> 3029 ~(MEM fname fake_ftbl_entries)``, 3030 SIMP_TAC std_ss [define_safe_def] \\ FS [LET_DEF] \\ REPEAT STRIP_TAC 3031 \\ sg `lookup_safe (Sym fname) ftbl = list2sexp [Sym fname]` 3032 \\ FS [EVAL ``isTrue (Dot x y)``] 3033 \\ FS [ftbl_inv_def,EVERY_MEM]); 3034 3035val MAP_t2sexp_MAP_mVar = add_prove( 3036 ``!xs. MAP t2sexp (MAP mVar xs) = MAP Sym xs``, 3037 Induct \\ FS [] \\ EVAL_TAC \\ FULL_SIMP_TAC std_ss []); 3038 3039val core_admit_defun_cmd = prove( 3040 ``list_exists 6 cmd ==> 3041 ?x name formals body meas proof_list. 3042 cmd = list2sexp [x;name;formals;body;meas;proof_list]``, 3043 REPEAT STRIP_TAC \\ EVAL_TAC \\ Cases_on `cmd` \\ FS [] 3044 \\ REPEAT ((Cases_on `S0` \\ FS []) ORELSE (Cases_on `S0'` \\ FS [])) \\ FS []); 3045 3046val logic_variable_listp_ALL_DISTINCT_IMP = prove( 3047 ``!xs. isTrue (logic_variable_listp (list2sexp xs)) /\ ALL_DISTINCT xs ==> 3048 ALL_DISTINCT (MAP getSym xs)``, 3049 Induct THEN1 EVAL_TAC \\ ONCE_REWRITE_TAC [logic_variable_listp_def] 3050 \\ FS [MAP,ALL_DISTINCT,MEM_MAP,EVERY_DEF] \\ STRIP_TAC 3051 \\ Cases_on `isTrue (logic_variablep h)` \\ FS [] 3052 \\ REPEAT STRIP_TAC \\ Cases_on `MEM y xs` \\ FS [] 3053 \\ REPEAT STRIP_TAC \\ FS [logic_variablep_def] 3054 \\ Cases_on `isSym h` \\ FS [] 3055 \\ Cases_on `h = Sym "T"` \\ FS [] 3056 \\ FS [isSym_thm] \\ Cases_on `y` \\ FS [getSym_def]); 3057 3058val logic_variable_listp_IMP_EVERY = prove( 3059 ``!xs. isTrue (logic_variable_listp (list2sexp xs)) ==> 3060 EVERY (\x. getSym x <> "NIL" /\ getSym x <> "T") xs``, 3061 Induct THEN1 EVAL_TAC \\ SIMP_TAC std_ss [Once logic_variable_listp_def] 3062 \\ FS [] \\ SRW_TAC [] [] \\ FS [] \\ FS [logic_variablep_def] 3063 \\ Cases_on `isSym h` \\ FS [] \\ Cases_on `h = Sym "T"` \\ FS [] 3064 \\ Cases_on `h = Sym "NIL"` \\ FS [] \\ Cases_on `h` \\ FS [getSym_def]); 3065 3066val logic_strip_conclusions_thm = prove( 3067 ``!ts z. ~isDot z ==> 3068 (logic_strip_conclusions (anylist2sexp (MAP a2sexp ts) z) = 3069 list2sexp (MAP f2sexp (MAP CONCL ts)))``, 3070 REPEAT STRIP_TAC \\ Induct_on `ts` 3071 \\ ONCE_REWRITE_TAC [logic_strip_conclusions_def] \\ FS [MAP]); 3072 3073val MAP_f2sexp_11 = prove( 3074 ``!xs ys. (MAP f2sexp xs = MAP f2sexp ys) = (xs = ys)``, 3075 Induct \\ Cases_on `ys` \\ FS [MAP,CONS_11]); 3076 3077val MAP_getSym_Sym = prove( 3078 ``!xs. MAP getSym (MAP Sym xs) = xs``, 3079 Induct \\ FS [MAP,getSym_def]); 3080 3081val core_check_proof_list_thm = prove( 3082 ``!ok. 3083 core_check_proof_inv checker k /\ ~isDot z /\ atbl_ok ctxt atbl /\ context_ok ctxt /\ 3084 thms_inv ctxt thms /\ thms_inv ctxt axioms /\ EVERY appeal_syntax_ok ts ==> 3085 SND (SND (SND 3086 (core_check_proof_list checker 3087 (anylist2sexp (MAP a2sexp ts) z) 3088 (list2sexp (MAP f2sexp axioms)) 3089 (list2sexp (MAP f2sexp thms)) atbl k io ok))) /\ 3090 isTrue (FST 3091 (core_check_proof_list checker 3092 (anylist2sexp (MAP a2sexp ts) z) 3093 (list2sexp (MAP f2sexp axioms)) 3094 (list2sexp (MAP f2sexp thms)) atbl k io ok)) ==> 3095 EVERY (MilawaTrue ctxt) (MAP CONCL ts)``, 3096 SIMP_TAC std_ss [GSYM AND_IMP_INTRO] \\ NTAC 5 STRIP_TAC 3097 \\ Induct_on `ts` \\ FS [EVERY_DEF,MAP] 3098 \\ ONCE_REWRITE_TAC [core_check_proof_list_def] \\ FS [LET_DEF] 3099 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ FS [] 3100 \\ STRIP_TAC \\ STRIP_TAC \\ STRIP_TAC \\ STRIP_TAC 3101 \\ Cases_on `isTrue (FST 3102 (core_check_proof checker (a2sexp h) 3103 (list2sexp (MAP f2sexp axioms)) 3104 (list2sexp (MAP f2sexp thms)) atbl k io ok))` \\ FS [] 3105 \\ STRIP_TAC 3106 \\ IMP_RES_TAC core_check_proof_list_IMP_OK 3107 \\ IMP_RES_TAC core_check_proof_IMP_OK 3108 \\ FULL_SIMP_TAC std_ss [] 3109 \\ IMP_RES_TAC core_check_proof_inv_IMP 3110 \\ FULL_SIMP_TAC std_ss [] 3111 \\ Q.PAT_X_ASSUM `ok` ASSUME_TAC \\ FULL_SIMP_TAC std_ss [] 3112 \\ FS [] \\ METIS_TAC [core_check_proof_thm]); 3113 3114val isTrue_lookup_safe = prove( 3115 ``!ftbl. 3116 isTrue (lookup_safe (Sym fname) ftbl) /\ EVERY isDot (sexp2list ftbl) ==> 3117 MEM (lookup_safe (Sym fname) ftbl) (sexp2list ftbl)``, 3118 REVERSE Induct \\ ONCE_REWRITE_TAC [lookup_safe_def] \\ FS [sexp2list_def] 3119 \\ Cases_on `Sym fname = CAR ftbl` \\ FS [] 3120 \\ Cases_on `isDot ftbl` \\ FS [EVERY_DEF]); 3121 3122val lookup_safe_EQ_MEM = prove( 3123 ``!ftbl. MEM (Sym fname) (MAP CAR (sexp2list ftbl)) = 3124 isTrue (lookup_safe (Sym fname) ftbl)``, 3125 REVERSE Induct \\ SIMP_TAC std_ss [sexp2list_def,MAP,MEM] 3126 \\ ONCE_REWRITE_TAC [lookup_safe_def] \\ FS [] 3127 \\ Cases_on `Sym fname = CAR ftbl` \\ FS [] 3128 \\ Cases_on `ftbl` \\ EVAL_TAC); 3129 3130val define_safe_ID = prove( 3131 ``SND (SND (SND (define_safe ftbl (Sym fname) (list2sexp xs) body k io T))) /\ 3132 MEM (Sym fname) (MAP CAR (sexp2list ftbl)) ==> 3133 (define_safe ftbl (Sym fname) (list2sexp xs) body k io T = 3134 (ftbl,k,io,T))``, 3135 SIMP_TAC std_ss [define_safe_def,LET_DEF] 3136 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` \\ FS [] 3137 \\ REPEAT STRIP_TAC \\ METIS_TAC [lookup_safe_EQ_MEM]); 3138 3139val CDR_lookup_NOT_NIL = prove( 3140 ``!atbl. isTrue (lookup (Sym fname) atbl) /\ atbl_inv atbl ==> 3141 CDR (lookup (Sym fname) atbl) <> Sym "NIL"``, 3142 REVERSE Induct \\ ONCE_REWRITE_TAC [lookup_def] 3143 \\ FS [atbl_inv_def,sexp2list_def,EVERY_DEF] 3144 \\ SRW_TAC [] [] \\ FS [] \\ FS [isVal_thm]); 3145 3146val MEM_ftbl = prove( 3147 ``MEM (Sym fname) (MAP CAR (sexp2list ftbl)) /\ ftbl_inv k ftbl /\ 3148 SND (SND (SND (define_safe ftbl (Sym fname) x body k io T))) ==> 3149 MEM (Dot (Sym fname) (Dot x (Dot body (Sym "NIL")))) (sexp2list ftbl)``, 3150 SIMP_TAC std_ss [define_safe_def,LET_DEF,GSYM AND_IMP_INTRO,GSYM lookup_safe_EQ_MEM] 3151 \\ FS [] \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] 3152 \\ REPEAT STRIP_TAC \\ FS [ftbl_inv_def] 3153 \\ METIS_TAC [isTrue_lookup_safe,lookup_safe_EQ_MEM]); 3154 3155val MEM_MEM_ftbl = prove( 3156 ``MEM (Dot (Sym fname) x1) (sexp2list ftbl) /\ 3157 MEM (Dot (Sym fname) x2) (sexp2list ftbl) /\ 3158 ftbl_inv k ftbl ==> (x1 = x2)``, 3159 SIMP_TAC std_ss [ftbl_inv_def] \\ Q.SPEC_TAC (`sexp2list ftbl`,`xs`) 3160 \\ REPEAT STRIP_TAC \\ Q.PAT_X_ASSUM `MEM xx yy` MP_TAC 3161 \\ SIMP_TAC std_ss [MEM_SPLIT] \\ REPEAT STRIP_TAC 3162 \\ FULL_SIMP_TAC std_ss [MEM_APPEND,MEM] 3163 \\ FS [MAP_APPEND,MAP,ALL_DISTINCT_APPEND,MEM_MAP,PULL_EXISTS_IMP,ALL_DISTINCT] 3164 \\ FS [METIS_PROVE [] ``(b \/ ~c) = (c ==> b:bool)``] \\ RES_TAC \\ FS []); 3165 3166val func_definition_exists_NEQ = prove( 3167 ``name <> fname ==> 3168 (func_definition_exists (ctxt |+ (fname,ps,b,ef)) name params body sem = 3169 func_definition_exists ctxt name params body sem)``, 3170 SIMP_TAC std_ss [func_definition_exists_def,FAPPLY_FUPDATE_THM, 3171 FDOM_FUPDATE,IN_INSERT,LET_DEF]); 3172 3173val func_definition_exists_EQ = prove( 3174 ``~MEM fname ["NOT";"RANK";"ORD<";"ORDP"] ==> 3175 (func_definition_exists (ctxt |+ (fname,ps,b,ef)) fname params body sem = 3176 (ps = params) /\ (b = body) /\ (ef = sem))``, 3177 SIMP_TAC std_ss [func_definition_exists_def,FAPPLY_FUPDATE_THM,FDOM_FUPDATE, 3178 IN_INSERT]); 3179 3180val logic_func_inv_NEQ = prove( 3181 ``term_ok ctxt (term2t (sexp3term raw_body)) /\ 3182 context_ok ctxt /\ name IN FDOM ctxt /\ 3183 logic_func_inv name ctxt raw_body /\ fname NOTIN FDOM ctxt /\ name <> fname ==> 3184 logic_func_inv name (ctxt |+ (fname,MAP getSym xs,bb,ef)) raw_body``, 3185 SIMP_TAC std_ss [logic_func_inv_def] \\ REPEAT STRIP_TAC 3186 \\ FULL_SIMP_TAC std_ss [LET_DEF] \\ DISJ2_TAC \\ REPEAT STRIP_TAC 3187 \\ ASM_SIMP_TAC std_ss [GSYM EvalTerm_FUPDATE] 3188 \\ MATCH_MP_TAC (GEN_ALL M_ev_EQ_CTXT_LEMMA) \\ Q.EXISTS_TAC `ctxt` 3189 \\ FULL_SIMP_TAC (srw_ss()) [FAPPLY_FUPDATE_THM] 3190 \\ `?params bbb sem. ctxt ' name = (params,bbb,sem)` by METIS_TAC [PAIR] 3191 \\ FULL_SIMP_TAC std_ss [] \\ Cases_on `bbb` \\ FULL_SIMP_TAC (srw_ss()) [] 3192 \\ REPEAT STRIP_TAC \\ Cases_on `m = fname` \\ FS [] 3193 \\ FULL_SIMP_TAC std_ss [context_ok_def] 3194 \\ RES_TAC \\ IMP_RES_TAC term_ok_MEM_funs_IMP); 3195 3196val ALL_DISTINCT_MAP_getSym = prove( 3197 ``!xs. ALL_DISTINCT xs /\ EVERY isSym xs ==> ALL_DISTINCT (MAP getSym xs)``, 3198 Induct \\ SIMP_TAC std_ss [ALL_DISTINCT,MAP,EVERY_DEF,isSym_thm] 3199 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [MEM_MAP] 3200 \\ Q.PAT_X_ASSUM `h = Sym a` ASSUME_TAC 3201 \\ FULL_SIMP_TAC std_ss [getSym_def] 3202 \\ FULL_SIMP_TAC std_ss [EVERY_MEM] \\ RES_TAC 3203 \\ FULL_SIMP_TAC std_ss [isSym_thm] 3204 \\ FULL_SIMP_TAC std_ss [getSym_def]); 3205 3206val logic_func_inv_EQ = prove( 3207 ``context_ok (ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef)) /\ 3208 ALL_DISTINCT xs /\ EVERY isSym xs /\ 3209 term_ok (ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef)) b /\ 3210 EVERY (MilawaTrue (ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef))) 3211 (termination_obligations fname b (MAP getSym xs) m) /\ 3212 (EvalFun fname (ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef)) = ef) /\ 3213 set (free_vars b) SUBSET set (MAP getSym xs) /\ 3214 ((term2t (sexp3term body)) = b) ==> 3215 logic_func_inv fname (ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef)) body``, 3216 SIMP_TAC std_ss [logic_func_inv_def] 3217 \\ Cases_on `MEM fname ["NOT"; "RANK"; "ORD<"; "ORDP"]` \\ ASM_SIMP_TAC std_ss [] 3218 \\ REPEAT STRIP_TAC \\ SIMP_TAC std_ss [LET_DEF] 3219 \\ Q.ABBREV_TAC `ctxt2 = ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef)` 3220 \\ MATCH_MP_TAC (GEN_ALL M_ev_TERMINATES) 3221 \\ Q.LIST_EXISTS_TAC [`MAP getSym xs`,`m`] 3222 \\ FULL_SIMP_TAC std_ss [] 3223 \\ CONV_TAC (DEPTH_CONV ETA_CONV) \\ FULL_SIMP_TAC std_ss [] 3224 \\ Q.UNABBREV_TAC `ctxt2` 3225 \\ FULL_SIMP_TAC std_ss [FAPPLY_FUPDATE_THM,FDOM_FUPDATE,IN_INSERT] 3226 \\ STRIP_TAC THEN1 (FULL_SIMP_TAC std_ss [ALL_DISTINCT_MAP_getSym]) 3227 \\ FULL_SIMP_TAC std_ss [EVERY_MEM] 3228 \\ REPEAT STRIP_TAC \\ RES_TAC \\ IMP_RES_TAC Milawa_SOUNDESS); 3229 3230val logic_variable_listp_IMP_EVERY_Sym = prove( 3231 ``!xs. isTrue (logic_variable_listp (list2sexp xs)) ==> EVERY isSym xs``, 3232 REPEAT STRIP_TAC \\ IMP_RES_TAC logic_variable_listp_IMP 3233 \\ FS [EVERY_MEM,MEM_MAP] \\ REPEAT STRIP_TAC \\ FS []); 3234 3235val NAME_NOT_ERROR = prove( 3236 ``SND (SND (SND(define_safe ftbl (Sym fname) (list2sexp xs) body k io T))) /\ 3237 ftbl_inv k ftbl ==> ~(fname = "ERROR")``, 3238 REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [define_safe_def,LET_DEF,getSym_def] 3239 \\ FULL_SIMP_TAC std_ss [ftbl_inv_def,fake_ftbl_entries_def,EVERY_DEF] 3240 \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [isTrue_def]); 3241 3242val NOT_CAR_EQ_ERROR = prove( 3243 ``term_ok ctxt (term2t (sexp3term body)) /\ ~("ERROR" IN FDOM ctxt) ==> 3244 ~(CAR body = Sym "ERROR")``, 3245 REPEAT STRIP_TAC \\ Cases_on `body` \\ TRY (Cases_on `S'`) \\ FS [] 3246 \\ FULL_SIMP_TAC (srw_ss()) [] \\ REPEAT (POP_ASSUM MP_TAC) 3247 \\ ONCE_REWRITE_TAC [sexp3term_def] \\ FS [LET_DEF] 3248 \\ FULL_SIMP_TAC (srw_ss()) [getSym_def,sym2prim_def,term2t_def, 3249 func2f_def,term_ok_def,func_arity_def]); 3250 3251local 3252 val PUSH_STRIP_LEMMA = METIS_PROVE [] ``b /\ (b ==> x) ==> b /\ x`` 3253in 3254 val PUSH_STRIP_TAC = 3255 MATCH_MP_TAC PUSH_STRIP_LEMMA THEN STRIP_TAC 3256 THENL [ALL_TAC, STRIP_TAC] 3257end 3258 3259val MAP_EQ_MAP = prove( 3260 ``!xs. (MAP f xs = MAP g xs) = !x. MEM x xs ==> (f x = g x)``, 3261 Induct \\ SIMP_TAC std_ss [MAP,MEM,CONS_11] \\ METIS_TAC []) 3262 3263val sexp2list_EQ_3 = prove( 3264 ``(3 = LENGTH (sexp2list (CDR raw_body))) ==> 3265 ?x1 x2 x3 x4 x5. (raw_body = Dot x1 (Dot x2 (Dot x3 (Dot x4 x5)))) /\ ~isDot x5``, 3266 Cases_on `raw_body` \\ FULL_SIMP_TAC std_ss [CDR_def,sexp2list_def,LENGTH] 3267 \\ Cases_on `S0` \\ FULL_SIMP_TAC std_ss [CDR_def,sexp2list_def,LENGTH] 3268 \\ Cases_on `S0'` \\ FULL_SIMP_TAC std_ss [CDR_def,sexp2list_def,LENGTH] 3269 \\ Cases_on `S0` \\ FULL_SIMP_TAC std_ss [CDR_def,sexp2list_def,LENGTH] 3270 \\ Cases_on `S0'` \\ FULL_SIMP_TAC std_ss [CDR_def,sexp2list_def,LENGTH] 3271 \\ FULL_SIMP_TAC (srw_ss()) [isDot_def] \\ DECIDE_TAC); 3272 3273val sexp2list_NIL = prove( 3274 ``!x. ~isDot x ==> (sexp2list x = [])``, 3275 Cases \\ EVAL_TAC); 3276 3277val sexp3term_And_lemma = prove( 3278 ``!xs. 3279 (EVERY (term_ok ctxt) (MAP (term2t o sexp3term) xs) ==> 3280 EVERY (\x. term2t (sexp3term x) = term2t (sexp2term x)) xs) ==> 3281 term_ok ctxt (term2t (And (MAP (\a. sexp3term a) xs))) ==> 3282 (term2t (And (MAP (\a. sexp3term a) xs)) = 3283 term2t (And (MAP (\a. sexp2term a) xs)))``, 3284 Induct \\ SIMP_TAC std_ss [MAP,term2t_def,EVERY_DEF] 3285 \\ Cases_on `xs` \\ FULL_SIMP_TAC (srw_ss()) [MAP,term2t_def,EVERY_DEF,term_ok_def] 3286 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 3287 \\ sg `term_ok ctxt (term2t (sexp3term h)) /\ 3288 EVERY (term_ok ctxt) (MAP (term2t o sexp3term) t)` 3289 \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC 3290 THEN1 (Cases_on `t` \\ FULL_SIMP_TAC (srw_ss()) [MAP,term2t_def,EVERY_DEF,term_ok_def]) 3291 \\ POP_ASSUM MP_TAC \\ REPEAT (POP_ASSUM (K ALL_TAC)) 3292 \\ Q.SPEC_TAC (`h`,`h`) \\ Q.SPEC_TAC (`t`,`t`) 3293 \\ Induct 3294 \\ FULL_SIMP_TAC (srw_ss()) [MAP,term2t_def,EVERY_DEF,term_ok_def] 3295 \\ Cases_on `t` 3296 \\ FULL_SIMP_TAC (srw_ss()) [MAP,term2t_def,EVERY_DEF,term_ok_def] 3297 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [] \\ RES_TAC); 3298 3299val sexp3term_List_lemma = prove( 3300 ``(EVERY (term_ok ctxt) (MAP (term2t o sexp3term) xs) ==> 3301 EVERY (\x. term2t (sexp3term x) = term2t (sexp2term x)) xs) ==> 3302 term_ok ctxt (term2t (List (MAP (\a. sexp3term a) xs))) ==> 3303 (term2t (List (MAP (\a. sexp3term a) xs)) = 3304 term2t (List (MAP (\a. sexp2term a) xs)))``, 3305 Induct_on `xs` \\ SIMP_TAC std_ss [MAP,term2t_def,EVERY_DEF] 3306 \\ Cases_on `xs` \\ FULL_SIMP_TAC (srw_ss()) [MAP,term2t_def,EVERY_DEF,term_ok_def] 3307 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 3308 \\ sg `EVERY (term_ok ctxt) (MAP (term2t o sexp3term) t)` 3309 \\ FULL_SIMP_TAC std_ss [] 3310 \\ POP_ASSUM MP_TAC \\ REPEAT (POP_ASSUM (K ALL_TAC)) 3311 \\ Q.SPEC_TAC (`t`,`t`) \\ Induct 3312 \\ FULL_SIMP_TAC (srw_ss()) [MAP,term2t_def,EVERY_DEF,term_ok_def]); 3313 3314val term_ok_Cond_lemma = prove( 3315 ``term_ok ctxt (term2t 3316 (Cond (MAP (\y. (sexp3term (CAR y),sexp3term (CAR (CDR y)))) xs))) = 3317 EVERY (\x. term_ok ctxt (term2t (sexp3term (CAR x)))) xs /\ 3318 EVERY (\x. term_ok ctxt (term2t (sexp3term (CAR (CDR x))))) xs``, 3319 Induct_on `xs` \\ ASM_SIMP_TAC std_ss [term2t_def,MAP,term_ok_def,LENGTH,EVERY_DEF] 3320 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [func_arity_def,primitive_arity_def] 3321 \\ METIS_TAC []); 3322 3323val term2t_Cond_lemma = prove( 3324 ``(term2t (Cond (MAP (\y. (sexp3term (CAR y),sexp3term (CAR (CDR y)))) xs)) = 3325 term2t (Cond (MAP (\y. (sexp2term (CAR y),sexp2term (CAR (CDR y)))) xs))) = 3326 EVERY (\x. term2t (sexp3term (CAR x)) = term2t (sexp2term (CAR x))) xs /\ 3327 EVERY (\x. term2t (sexp3term (CAR (CDR x))) = term2t (sexp2term (CAR (CDR x)))) xs``, 3328 Induct_on `xs` \\ ASM_SIMP_TAC (srw_ss()) [MAP,EVERY_DEF,term2t_def] 3329 \\ METIS_TAC []); 3330 3331val term2t_LamApp_lemma = prove( 3332 ``(term2t 3333 (LamApp (MAP getSym (sexp2list xs)) 3334 (sexp3term y) 3335 (MAP (\a. sexp3term a) ys)) = 3336 term2t 3337 (LamApp (MAP getSym (sexp2list xs)) 3338 (sexp2term y) 3339 (MAP (\a. sexp2term a) ys))) = 3340 EVERY (\x. term2t (sexp3term x) = term2t (sexp2term x)) ys /\ 3341 (term2t (sexp3term y) = term2t (sexp2term y))``, 3342 SIMP_TAC (srw_ss()) [term2t_def,MAP_MAP_o,MAP_EQ_MAP,EVERY_MEM] \\ METIS_TAC []); 3343 3344val term_ok_LamApp_lemma = prove( 3345 ``term_ok ctxt (term2t (LamApp (MAP getSym (sexp2list xs)) (sexp3term y) 3346 (MAP (\a. sexp3term a) ys))) ==> 3347 EVERY (\x. term_ok ctxt (term2t (sexp3term x))) ys /\ 3348 term_ok ctxt (term2t (sexp3term y))``, 3349 SIMP_TAC std_ss [term2t_def,term_ok_def,LENGTH_MAP,EVERY_MEM] 3350 \\ FULL_SIMP_TAC std_ss [MEM_MAP,PULL_EXISTS_IMP]); 3351 3352val DISJ_EQ_IMP = METIS_PROVE [] ``b \/ c = ~b ==> c`` 3353 3354val term_ok_let2t = prove( 3355 ``term_ok ctxt (let2t xs y) ==> 3356 EVERY (\x. term_ok ctxt (SND x)) xs /\ term_ok ctxt y``, 3357 SIMP_TAC std_ss [let2t_def,LET_DEF,term_ok_def,EVERY_APPEND,EVERY_MEM,MEM_MAP] 3358 \\ SIMP_TAC std_ss [PULL_EXISTS_IMP]); 3359 3360val term_ok_let_star2t = prove( 3361 ``term_ok ctxt (term2t (LetStar xs y)) ==> 3362 EVERY (\x. term_ok ctxt (term2t (SND x))) xs /\ term_ok ctxt (term2t y)``, 3363 Induct_on `xs` \\ SIMP_TAC std_ss [term2t_def,EVERY_DEF] \\ Cases 3364 \\ ASM_SIMP_TAC std_ss [term2t_def,EVERY_DEF] \\ STRIP_TAC 3365 \\ IMP_RES_TAC term_ok_let2t \\ RES_TAC 3366 \\ ASM_SIMP_TAC std_ss [] \\ FULL_SIMP_TAC std_ss [EVERY_DEF,MAP]); 3367 3368val term_ok_or2t = prove( 3369 ``!xs. term_ok ctxt (or2t (MAP (\a. term2t a) (MAP (\a. sexp3term a) xs))) ==> 3370 EVERY (\x. term_ok ctxt (term2t (sexp3term x))) xs``, 3371 Cases THEN1 SIMP_TAC std_ss [or2t_def,MAP,term_ok_def,EVERY_DEF] 3372 \\ Q.SPEC_TAC (`h`,`h`) \\ Induct_on `t` 3373 \\ SIMP_TAC std_ss [or2t_def,MAP,term_ok_def,EVERY_DEF] 3374 \\ SIMP_TAC std_ss [LET_DEF] 3375 \\ STRIP_TAC \\ STRIP_TAC \\ SIMP_TAC std_ss [DISJ_EQ_IMP] 3376 \\ Cases_on `~isTrue (logic_variablep (t2sexp (term2t (sexp3term h')))) /\ 3377 ~isTrue (logic_constantp (t2sexp (term2t (sexp3term h')))) ==> 3378 MEM "SPECIAL-VAR-FOR-OR" 3379 (free_vars 3380 (or2t 3381 (term2t (sexp3term h):: 3382 MAP (\a. term2t a) (MAP (\a. sexp3term a) t))))` \\ FS [] 3383 THEN1 3384 (FULL_SIMP_TAC std_ss [term_ok_def,EVERY_DEF,MAP] \\ REPEAT STRIP_TAC \\ RES_TAC) 3385 \\ FULL_SIMP_TAC std_ss [term_ok_def,EVERY_DEF,MAP] \\ STRIP_TAC 3386 \\ IMP_RES_TAC term_ok_let2t 3387 \\ FULL_SIMP_TAC std_ss [EVERY_DEF,term_ok_def] \\ RES_TAC); 3388 3389val let2t_IMP = prove( 3390 ``(xs = ys) /\ (x = y) ==> (let2t xs x = let2t ys y)``, 3391 SIMP_TAC std_ss []); 3392 3393val or2t_IMP = prove( 3394 ``(xs = ys) ==> (or2t xs = or2t ys)``, 3395 SIMP_TAC std_ss []); 3396 3397val let_star2t_IMP = prove( 3398 ``(MAP (\x. (FST x, term2t (SND x))) xs = MAP (\x. (FST x, term2t (SND x))) ys) /\ 3399 (term2t x = term2t y) ==> 3400 (term2t (LetStar xs x) = term2t (LetStar ys y))``, 3401 Q.SPEC_TAC (`ys`,`ys`) \\ Induct_on `xs` 3402 \\ Cases_on `ys` \\ FULL_SIMP_TAC (srw_ss()) [MAP,term2t_def] 3403 \\ Cases \\ FULL_SIMP_TAC (srw_ss()) [MAP,term2t_def] 3404 \\ Cases_on `h` \\ FULL_SIMP_TAC (srw_ss()) [MAP,term2t_def] 3405 \\ METIS_TAC []); 3406 3407val term2t_sexp3term_LEMMA = prove( 3408 ``!raw_body. 3409 ~("DEFUN" IN FDOM ctxt) /\ term_ok ctxt (term2t (sexp3term raw_body)) ==> 3410 (term2t (sexp3term raw_body) = term2t (sexp2term raw_body))``, 3411 HO_MATCH_MP_TAC sexp2term_ind \\ REPEAT STRIP_TAC 3412 \\ POP_ASSUM MP_TAC \\ ONCE_REWRITE_TAC [sexp3term_def,sexp2term_def] 3413 \\ Cases_on `raw_body = Sym "T"` THEN1 ASM_SIMP_TAC std_ss [] 3414 \\ Cases_on `raw_body = Sym "NIL"` THEN1 ASM_SIMP_TAC std_ss [] 3415 \\ Cases_on `isVal raw_body` THEN1 ASM_SIMP_TAC std_ss [] 3416 \\ Cases_on `isSym raw_body` THEN1 ASM_SIMP_TAC std_ss [] 3417 \\ ASM_SIMP_TAC std_ss [LET_DEF] 3418 \\ Cases_on `CAR raw_body = Sym "QUOTE"` THEN1 ASM_SIMP_TAC std_ss [] 3419 \\ Cases_on `CAR raw_body = Sym "IF"` THEN1 3420 (ASM_SIMP_TAC (srw_ss()) [getSym_def,sym2prim_def,CAR_def, 3421 term2t_def,func2f_def,term_ok_def,func_arity_def,primitive_arity_def] 3422 \\ SIMP_TAC std_ss [GSYM AND_IMP_INTRO] \\ STRIP_TAC 3423 \\ IMP_RES_TAC sexp2list_EQ_3 \\ IMP_RES_TAC sexp2list_NIL 3424 \\ ASM_REWRITE_TAC [sexp2list_def,CDR_def,MAP,CAR_def] 3425 \\ SIMP_TAC std_ss [EVERY_DEF,CONS_11] 3426 \\ REPEAT (Q.PAT_X_ASSUM `!xx.bb` MP_TAC) 3427 \\ Q.PAT_X_ASSUM `CAR raw_body = Sym "IF"` MP_TAC 3428 \\ ASM_REWRITE_TAC [CAR_def,CDR_def,sexp2list_def,MEM,EVERY_DEF] 3429 \\ STRIP_TAC 3430 \\ NTAC 22 (MATCH_MP_TAC (METIS_PROVE [] ``b ==> (c ==> b)``)) 3431 \\ `~(x1 = Sym "QUOTE")` by (REPEAT STRIP_TAC \\ FULL_SIMP_TAC (srw_ss()) []) 3432 \\ Q.PAT_X_ASSUM `CAR raw_body <> bbb` (K ALL_TAC) 3433 \\ REPEAT STRIP_TAC \\ RES_TAC \\ FULL_SIMP_TAC std_ss []) 3434 \\ ASM_SIMP_TAC std_ss [] 3435 \\ Cases_on `sym2prim (getSym (CAR raw_body)) <> NONE` THEN1 3436 (ASM_SIMP_TAC std_ss [] \\ FULL_SIMP_TAC std_ss [] 3437 \\ FULL_SIMP_TAC (srw_ss()) [term2t_def,term_ok_def,MAP_MAP_o] 3438 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,MEM_MAP,PULL_EXISTS_IMP,MAP_EQ_MAP]) 3439 \\ ASM_SIMP_TAC std_ss [] 3440 \\ Cases_on `CAR raw_body = Sym "FIRST"` \\ ASM_SIMP_TAC std_ss [] 3441 THEN1 (FULL_SIMP_TAC (srw_ss()) [term2t_def,term_ok_def]) 3442 \\ Cases_on `CAR raw_body = Sym "SECOND"` \\ ASM_SIMP_TAC std_ss [] 3443 THEN1 (FULL_SIMP_TAC (srw_ss()) [term2t_def,term_ok_def]) 3444 \\ Cases_on `CAR raw_body = Sym "THIRD"` \\ ASM_SIMP_TAC std_ss [] 3445 THEN1 (FULL_SIMP_TAC (srw_ss()) [term2t_def,term_ok_def]) 3446 \\ Cases_on `CAR raw_body = Sym "FOURTH"` \\ ASM_SIMP_TAC std_ss [] 3447 THEN1 (FULL_SIMP_TAC (srw_ss()) [term2t_def,term_ok_def]) 3448 \\ Cases_on `CAR raw_body = Sym "FIFTH"` \\ ASM_SIMP_TAC std_ss [] 3449 THEN1 (FULL_SIMP_TAC (srw_ss()) [term2t_def,term_ok_def]) 3450 \\ Cases_on `CAR raw_body = Sym "OR"` \\ ASM_SIMP_TAC std_ss [] 3451 THEN1 3452 (SIMP_TAC std_ss [term2t_def] \\ STRIP_TAC \\ IMP_RES_TAC term_ok_or2t 3453 \\ MATCH_MP_TAC or2t_IMP \\ SIMP_TAC std_ss [MAP_EQ_MAP,MAP_MAP_o] 3454 \\ FULL_SIMP_TAC std_ss [EVERY_MEM]) 3455 \\ Cases_on `CAR raw_body = Sym "AND"` \\ ASM_SIMP_TAC std_ss [] 3456 THEN1 (MATCH_MP_TAC sexp3term_And_lemma 3457 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,MEM_MAP,PULL_EXISTS_IMP]) 3458 \\ Cases_on `CAR raw_body = Sym "LIST"` \\ ASM_SIMP_TAC std_ss [] 3459 THEN1 (MATCH_MP_TAC sexp3term_List_lemma 3460 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,MEM_MAP,PULL_EXISTS_IMP]) 3461 \\ Cases_on `CAR raw_body = Sym "DEFUN"` \\ ASM_SIMP_TAC std_ss [] 3462 THEN1 (FULL_SIMP_TAC (srw_ss()) [CAR_def,term2t_def,term_ok_def, 3463 func_arity_def,func2f_def,getSym_def]) 3464 \\ Cases_on `CAR raw_body = Sym "COND"` \\ ASM_SIMP_TAC std_ss [] 3465 THEN1 (SIMP_TAC std_ss [term_ok_Cond_lemma,term2t_Cond_lemma,EVERY_MEM] 3466 \\ FULL_SIMP_TAC std_ss []) 3467 \\ Cases_on `CAR raw_body = Sym "LET"` \\ ASM_SIMP_TAC std_ss [] 3468 THEN1 3469 (SIMP_TAC std_ss [term2t_def] \\ STRIP_TAC \\ IMP_RES_TAC term_ok_let2t 3470 \\ MATCH_MP_TAC let2t_IMP \\ SIMP_TAC std_ss [MAP_EQ_MAP,MAP_MAP_o] 3471 \\ FULL_SIMP_TAC std_ss [EVERY_MEM] 3472 \\ FULL_SIMP_TAC std_ss [MEM_MAP,PULL_EXISTS_IMP]) 3473 \\ Cases_on `CAR raw_body = Sym "LET*"` \\ ASM_SIMP_TAC std_ss [] 3474 THEN1 3475 (SIMP_TAC std_ss [term2t_def] \\ STRIP_TAC \\ IMP_RES_TAC term_ok_let_star2t 3476 \\ MATCH_MP_TAC let_star2t_IMP \\ SIMP_TAC std_ss [MAP_EQ_MAP,MAP_MAP_o] 3477 \\ FULL_SIMP_TAC std_ss [EVERY_MEM] 3478 \\ FULL_SIMP_TAC std_ss [MEM_MAP,PULL_EXISTS_IMP]) 3479 \\ Cases_on `CAR (CAR raw_body) = Sym "LAMBDA"` \\ ASM_SIMP_TAC std_ss [] 3480 THEN1 3481 (REPEAT STRIP_TAC \\ IMP_RES_TAC term_ok_LamApp_lemma \\ NTAC 3 (POP_ASSUM MP_TAC) 3482 \\ SIMP_TAC std_ss [term2t_LamApp_lemma,EVERY_MEM] \\ METIS_TAC []) 3483 \\ Cases_on `CAR raw_body = Sym "DEFINE"` \\ ASM_SIMP_TAC std_ss [] THEN1 3484 (FULL_SIMP_TAC (srw_ss()) [term2t_def,func2f_def,getSym_def] 3485 \\ FULL_SIMP_TAC (srw_ss()) [term2t_def,term_ok_def,MAP_MAP_o] 3486 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,MEM_MAP,PULL_EXISTS_IMP,MAP_EQ_MAP]) 3487 \\ Cases_on `CAR raw_body = Sym "ERROR"` \\ ASM_SIMP_TAC std_ss [] THEN1 3488 (FULL_SIMP_TAC (srw_ss()) [term2t_def,func2f_def,getSym_def] 3489 \\ FULL_SIMP_TAC (srw_ss()) [term2t_def,term_ok_def,MAP_MAP_o] 3490 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,MEM_MAP,PULL_EXISTS_IMP,MAP_EQ_MAP]) 3491 \\ Cases_on `CAR raw_body = Sym "FUNCALL"` \\ ASM_SIMP_TAC std_ss [] THEN1 3492 (FULL_SIMP_TAC (srw_ss()) [term2t_def,func2f_def,getSym_def] 3493 \\ FULL_SIMP_TAC (srw_ss()) [term2t_def,term_ok_def,MAP_MAP_o] 3494 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,MEM_MAP,PULL_EXISTS_IMP,MAP_EQ_MAP]) 3495 \\ Cases_on `CAR raw_body = Sym "PRINT"` \\ ASM_SIMP_TAC std_ss [] THEN1 3496 (FULL_SIMP_TAC (srw_ss()) [term2t_def,func2f_def,getSym_def] 3497 \\ FULL_SIMP_TAC (srw_ss()) [term2t_def,term_ok_def,MAP_MAP_o] 3498 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,MEM_MAP,PULL_EXISTS_IMP,MAP_EQ_MAP]) 3499 \\ ASM_SIMP_TAC (srw_ss()) [term2t_def,func2f_def,getSym_def, 3500 term2t_def,term_ok_def,MAP_MAP_o] 3501 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,MEM_MAP,PULL_EXISTS_IMP,MAP_EQ_MAP]) 3502 3503val SUBMAP_add_def = prove( 3504 ``k SUBMAP add_def k (x,y,z)``, 3505 SIMP_TAC std_ss [SUBMAP_DEF,add_def_def,FUNION_DEF,IN_UNION]); 3506 3507val lookup_safe_IMP_MEM = prove( 3508 ``!ftbl. (lookup_safe (Sym x) ftbl = Dot y z) /\ ~(x = "NIL") ==> 3509 MEM (Dot y z) (sexp2list ftbl)``, 3510 REVERSE Induct \\ ONCE_REWRITE_TAC [lookup_safe_def] \\ FS [] 3511 \\ Cases_on `Sym x = CAR ftbl` \\ FS [] THEN1 3512 (Cases_on `isDot ftbl` \\ FS [sexp2list_def,MEM] \\ Cases_on `ftbl` \\ FS []) 3513 \\ FS [sexp2list_def,MEM]); 3514 3515val ALL_DISTINCT_IMP_11 = prove( 3516 ``!xs. ALL_DISTINCT (MAP f xs) /\ MEM x xs /\ MEM y xs /\ (f x = f y) ==> (x = y)``, 3517 Induct \\ SIMP_TAC std_ss [MEM,MAP,ALL_DISTINCT] 3518 \\ FULL_SIMP_TAC std_ss [MEM_MAP] \\ REPEAT STRIP_TAC \\ METIS_TAC []); 3519 3520val fake_ftbl_entries_NOT_IN_CTXT = prove( 3521 ``axioms_inv ctxt ftbl axioms /\ ftbl_inv k ftbl ==> 3522 EVERY (\x. x NOTIN FDOM ctxt) fake_ftbl_entries``, 3523 SIMP_TAC std_ss [ftbl_inv_def,axioms_inv_def] 3524 \\ FULL_SIMP_TAC std_ss [EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC 3525 \\ `?params body sem. ctxt ' x = (params,body,sem)` by METIS_TAC [PAIR] 3526 \\ `func_definition_exists ctxt x params body sem` by METIS_TAC [func_definition_exists_def] 3527 \\ RES_TAC \\ `?y z. MEM (list2sexp [Sym x; y; z]) (sexp2list ftbl)` by (Cases_on `body` \\ FULL_SIMP_TAC std_ss [axioms_aux_def] \\ METIS_TAC []) 3528 \\ FS [] \\ `~(x = "NIL")` by FULL_SIMP_TAC (srw_ss()) [fake_ftbl_entries_def,MEM] 3529 \\ IMP_RES_TAC lookup_safe_IMP_MEM 3530 \\ `CAR (Dot (Sym x) (Dot y (Dot z (Sym "NIL")))) = CAR (Dot (Sym x) (Sym "NIL"))` by EVAL_TAC 3531 \\ IMP_RES_TAC ALL_DISTINCT_IMP_11 3532 \\ Q.PAT_X_ASSUM `xxx = yyy` MP_TAC \\ SS []); 3533 3534val MR_ap_CTXT = 3535 MR_ev_CTXT 3536 |> CONJUNCTS |> hd |> SPEC_ALL |> Q.INST [`ctxt`|->`ctxt |+ (name,x)`] 3537 |> SIMP_RULE std_ss [DOMSUB_FUPDATE] 3538 |> DISCH ``~(name IN FDOM (ctxt:context_type))`` 3539 |> SIMP_RULE std_ss [DOMSUB_NOT_IN_DOM] 3540 |> SIMP_RULE std_ss [AND_IMP_INTRO] 3541 3542val IMP_LSIZE_CAR = prove( 3543 ``!x. LSIZE x < n ==> LSIZE (CAR x) < n``, 3544 Cases \\ EVAL_TAC \\ DECIDE_TAC); 3545 3546val IMP_LSIZE_CDR = prove( 3547 ``!x. LSIZE x < n ==> LSIZE (CDR x) < n``, 3548 Cases \\ EVAL_TAC \\ DECIDE_TAC); 3549 3550val MEM_sexp2list_IMP = prove( 3551 ``!x a. MEM a (sexp2list x) ==> LSIZE a < LSIZE x``, 3552 Induct \\ FULL_SIMP_TAC std_ss [LSIZE_def,sexp2list_def,MEM] 3553 \\ REPEAT STRIP_TAC \\ RES_TAC \\ FS [] \\ DECIDE_TAC); 3554 3555val string2func_def = Define ` 3556 string2func name = 3557 case logic_sym2prim name of 3558 SOME op => mPrimitiveFun op 3559 | NONE => mFun name`; 3560 3561val sexp2t_def = tDefine "sexp2t" ` 3562 sexp2t x = if isSym x then mVar (getSym x) else 3563 if isVal x then mConst x else 3564 if CAR x = Sym "QUOTE" then mConst (CAR (CDR x)) else 3565 if isDot (CAR x) then 3566 let lam = CAR x in 3567 let vs = MAP getSym (sexp2list (CAR (CDR lam))) in 3568 let body = sexp2t (CAR (CDR (CDR lam))) in 3569 let xs = MAP sexp2t (sexp2list (CDR x)) in 3570 mLamApp vs body xs 3571 else 3572 let xs = MAP sexp2t (sexp2list (CDR x)) in 3573 mApp (string2func (getSym (CAR x))) xs` 3574 (WF_REL_TAC `measure LSIZE` \\ REPEAT STRIP_TAC \\ Cases_on `x` 3575 \\ FULL_SIMP_TAC std_ss [LSIZE_def,isSym_def,isVal_def,CAR_def,CDR_def] 3576 THEN1 (IMP_RES_TAC MEM_sexp2list_IMP \\ DECIDE_TAC) 3577 THEN1 (FULL_SIMP_TAC std_ss [isDot_thm,CAR_def,CDR_def,LSIZE_def] 3578 \\ MATCH_MP_TAC IMP_LSIZE_CAR \\ MATCH_MP_TAC IMP_LSIZE_CDR \\ DECIDE_TAC) 3579 THEN1 (IMP_RES_TAC MEM_sexp2list_IMP \\ DECIDE_TAC)); 3580 3581val defun_ctxt_def = Define ` 3582 defun_ctxt ctxt cmd = 3583 let name = getSym (CAR (CDR cmd)) in 3584 let formals = MAP getSym (sexp2list (CAR (CDR (CDR cmd)))) in 3585 let body = BODY_FUN (sexp2t (sexp2sexp (CAR (CDR (CDR (CDR cmd)))))) in 3586 let interp = @interp. context_ok (ctxt |+ (name,formals,body,interp)) in 3587 if name IN FDOM ctxt UNION {"NOT";"RANK";"ORDP";"ORD<"} then ctxt 3588 else ctxt |+ (name,formals,body,interp)`; 3589 3590val sexp2t_t2sexp_thm = prove( 3591 ``!b. term_syntax_ok b ==> (sexp2t (t2sexp b) = b)``, 3592 HO_MATCH_MP_TAC t2sexp_ind \\ REPEAT STRIP_TAC 3593 THEN1 (FS [t2sexp_def,Once sexp2t_def,getSym_def,LET_DEF]) 3594 THEN1 (FS [t2sexp_def,Once sexp2t_def,getSym_def,LET_DEF]) 3595 THEN1 3596 (FULL_SIMP_TAC std_ss [t2sexp_def,term_syntax_ok_def,EVERY_MEM,list2sexp_def] 3597 \\ ONCE_REWRITE_TAC [sexp2t_def] \\ FS [LET_DEF] 3598 \\ SIMP_TAC (srw_ss()) [] \\ STRIP_TAC THEN1 3599 (Cases_on `fc` \\ FS [func_syntax_ok_def,getSym_def,logic_func2sexp_def] 3600 THEN1 (Cases_on `l` \\ EVAL_TAC) \\ EVAL_TAC \\ FS [getSym_def]) 3601 \\ Induct_on `vs` \\ FS [MAP]) 3602 THEN1 3603 (FULL_SIMP_TAC std_ss [t2sexp_def,term_syntax_ok_def,EVERY_MEM,list2sexp_def] 3604 \\ ONCE_REWRITE_TAC [sexp2t_def] \\ FS [LET_DEF] 3605 \\ SIMP_TAC (srw_ss()) [] \\ STRIP_TAC 3606 \\ Q.PAT_X_ASSUM `LENGTH xs = LENGTH ys` (K ALL_TAC) 3607 \\ Q.PAT_X_ASSUM `set (free_vars b) SUBSET set xs` (K ALL_TAC) 3608 THEN1 (Induct_on `xs` \\ FS [MAP,getSym_def,CONS_11,ALL_DISTINCT]) 3609 THEN1 (Induct_on `ys` \\ FS [MAP,getSym_def,CONS_11,ALL_DISTINCT]))); 3610 3611val term_ok_syntax_same = prove( 3612 ``!ctxt x ctxt2. term_ok ctxt x /\ context_syntax_same ctxt ctxt2 ==> term_ok ctxt2 x``, 3613 HO_MATCH_MP_TAC term_ok_ind \\ FULL_SIMP_TAC std_ss [term_ok_def,EVERY_MEM] 3614 \\ REPEAT STRIP_TAC \\ Cases_on `fc` 3615 \\ FULL_SIMP_TAC std_ss [func_arity_def,context_syntax_same_def,FEVERY_DEF] 3616 \\ POP_ASSUM MP_TAC \\ FS [] \\ STRIP_TAC \\ RES_TAC 3617 \\ POP_ASSUM MP_TAC \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 3618 \\ REPEAT STRIP_TAC \\ FS []); 3619 3620val formula_ok_syntax_same = prove( 3621 ``!ctxt x ctxt2. formula_ok ctxt x /\ context_syntax_same ctxt ctxt2 ==> formula_ok ctxt2 x``, 3622 STRIP_TAC \\ Induct \\ FS [formula_ok_def] \\ METIS_TAC [term_ok_syntax_same]); 3623 3624fun TAC n = 3625 (SIMP_TAC std_ss [Once MilawaTrue_cases] 3626 \\ NTAC n DISJ2_TAC \\ TRY DISJ1_TAC 3627 \\ FULL_SIMP_TAC (srw_ss()) [FAPPLY_FUPDATE_THM] 3628 \\ METIS_TAC [formula_ok_syntax_same]) 3629 3630val MilawaTrue_context_syntax_same = prove( 3631 ``!ctxt x. 3632 MilawaTrue ctxt x ==> context_syntax_same ctxt ctxt2 ==> 3633 MilawaTrue ctxt2 x``, 3634 HO_MATCH_MP_TAC MilawaTrue_ind \\ FULL_SIMP_TAC std_ss [] 3635 \\ REPEAT STRIP_TAC 3636 THEN1 TAC 0 THEN1 TAC 1 THEN1 TAC 2 THEN1 TAC 3 THEN1 TAC 4 THEN1 TAC 5 3637 THEN1 TAC 6 THEN1 TAC 7 THEN1 TAC 8 THEN1 TAC 9 3638 THEN1 3639 (SIMP_TAC std_ss [Once MilawaTrue_cases] 3640 \\ NTAC 10 DISJ2_TAC \\ TRY DISJ1_TAC 3641 \\ FULL_SIMP_TAC (srw_ss()) [FAPPLY_FUPDATE_THM] 3642 \\ FS [context_syntax_same_def,FEVERY_DEF] 3643 \\ POP_ASSUM MP_TAC \\ FS [] 3644 \\ REPEAT STRIP_TAC \\ RES_TAC \\ POP_ASSUM MP_TAC \\ POP_ASSUM (K ALL_TAC) 3645 \\ `?x1 x2 x3. ctxt2 ' f = (x1,x2,x3)` by METIS_TAC [PAIR] \\ FS []) 3646 THEN1 3647 (SIMP_TAC std_ss [Once MilawaTrue_cases] 3648 \\ NTAC 11 DISJ2_TAC \\ TRY DISJ1_TAC 3649 \\ FULL_SIMP_TAC (srw_ss()) [FAPPLY_FUPDATE_THM] 3650 \\ FS [context_syntax_same_def,FEVERY_DEF] 3651 \\ POP_ASSUM MP_TAC \\ FS [] 3652 \\ REPEAT STRIP_TAC \\ RES_TAC \\ POP_ASSUM MP_TAC \\ POP_ASSUM (K ALL_TAC) 3653 \\ `?x1 x2 x3. ctxt2 ' f = (x1,x2,x3)` by METIS_TAC [PAIR] \\ FS []) 3654 \\ SIMP_TAC std_ss [Once MilawaTrue_cases] 3655 \\ NTAC 12 DISJ2_TAC \\ Q.LIST_EXISTS_TAC [`qs_ss`,`m`] 3656 \\ FULL_SIMP_TAC std_ss [] \\ REPEAT STRIP_TAC \\ RES_TAC) 3657 |> SIMP_RULE std_ss []; 3658 3659val context_syntax_same_FUPDATE = prove( 3660 ``!x. context_syntax_same ctxt ctxt2 ==> 3661 context_syntax_same (ctxt |+ x) (ctxt2 |+ x)``, 3662 FS [context_syntax_same_def,FORALL_PROD,FDOM_FUPDATE,FEVERY_DEF, 3663 FAPPLY_FUPDATE_THM,IN_INSERT] 3664 \\ NTAC 6 STRIP_TAC \\ Cases_on `x = p_1` \\ FS [] \\ STRIP_TAC 3665 \\ Q.PAT_X_ASSUM `!x.bbb` MP_TAC \\ FS []); 3666 3667val similar_context_definition_ok = prove( 3668 ``similar_context ctxt ctxt2 ==> 3669 definition_ok (fname,params,b,ctxt) ==> 3670 definition_ok (fname,params,b,ctxt2)``, 3671 REVERSE (Cases_on `b`) \\ FULL_SIMP_TAC std_ss [definition_ok_def] 3672 THEN1 (FS [similar_context_def]) 3673 THEN1 (REPEAT STRIP_TAC \\ TRY (MATCH_MP_TAC term_ok_syntax_same) 3674 \\ TRY (Q.EXISTS_TAC `ctxt`) 3675 \\ FS [similar_context_def,context_syntax_same_def] 3676 \\ METIS_TAC []) 3677 THEN1 3678 (REPEAT STRIP_TAC 3679 \\ `context_syntax_same ctxt ctxt2` by FS [context_syntax_same_def,similar_context_def] 3680 \\ `context_syntax_same (ctxt |+ (fname,params,NO_FUN,ARB)) 3681 (ctxt2 |+ (fname,params,NO_FUN,ARB))` by 3682 METIS_TAC [context_syntax_same_FUPDATE] 3683 \\ `context_syntax_same (ctxt |+ (fname,params,BODY_FUN l,ARB)) 3684 (ctxt2 |+ (fname,params,BODY_FUN l,ARB))` by 3685 METIS_TAC [context_syntax_same_FUPDATE] 3686 THEN1 (METIS_TAC [term_ok_syntax_same]) 3687 THEN1 (FS [similar_context_def] \\ METIS_TAC []) 3688 \\ FS [EVERY_MEM] \\ METIS_TAC [MilawaTrue_context_syntax_same])); 3689 3690val core_admit_defun_thm = prove( 3691 ``milawa_inv ctxt simple_ctxt k (axioms,thms,atbl,checker,ftbl) ==> 3692 ?x k2 io2 ok2 result. 3693 core_admit_defun_side cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok /\ 3694 (core_admit_defun cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok = 3695 (x,k2,io2,ok2)) /\ 3696 (ok2 ==> (io2 = io) /\ 3697 ?result ctxt. 3698 (x = milawa_state result) /\ 3699 milawa_inv ctxt (defun_ctxt simple_ctxt cmd) k2 result)``, 3700 FS [core_admit_defun_side_lemma,core_admit_defun_lemma, 3701 LET_DEF,milawa_state_def,core_state_def] 3702 \\ SRW_TAC [] [] \\ FS [] \\ FS [milawa_inv_def] 3703 \\ ASM_SIMP_TAC std_ss [core_check_proof_list_inv_IMP_side] 3704 \\ IMP_RES_TAC SND_SND_SND_define_safe_IMP 3705 \\ IMP_RES_TAC core_check_proof_list_inv_IMP 3706 \\ IMP_RES_TAC core_admit_defun_cmd \\ FS [] 3707 \\ Q.PAT_X_ASSUM `formals = list2sexp xs` ASSUME_TAC \\ FS [] 3708 THEN1 (SRW_TAC [] [define_safe_def] \\ FS [define_safe_def] 3709 \\ SRW_TAC [] [] \\ FULL_SIMP_TAC std_ss [LET_DEF]) 3710 \\ REPEAT (Q.PAT_X_ASSUM `!xx.bbb` (K ALL_TAC)) \\ POP_ASSUM (K ALL_TAC) 3711 \\ Q.PAT_X_ASSUM `xxx = io` (K ALL_TAC) 3712 \\ Q.PAT_X_ASSUM `xxx = k` (K ALL_TAC) 3713 \\ POP_ASSUM (K ALL_TAC) 3714 \\ IMP_RES_TAC core_check_proof_list_inv_IMP_OK \\ FULL_SIMP_TAC std_ss [] 3715 \\ `isTrue (logic_translate body) /\ isTrue (logic_translate meas)` by 3716 (SIMP_TAC std_ss [isTrue_def] \\ REPEAT STRIP_TAC 3717 \\ FS [EVAL ``logic_termp (Sym "NIL")``]) 3718 \\ FS [logic_translate_thm] \\ NTAC 2 (POP_ASSUM (K ALL_TAC)) 3719 \\ `?b. term_syntax_ok b /\ (sexp2sexp body = t2sexp b)` by METIS_TAC [logic_termp_thm] 3720 \\ `?m. term_syntax_ok m /\ (sexp2sexp meas = t2sexp m)` by METIS_TAC [logic_termp_thm] 3721 \\ FS [] \\ `?fname. name = Sym fname` by 3722 (Cases_on `isSym name` \\ FS [logic_function_namep_def] \\ FS [isSym_thm]) 3723 \\ FS [] \\ POP_ASSUM (K ALL_TAC) 3724 \\ REPEAT (Q.PAT_X_ASSUM `isTrue (logic_termp (t2sexp xxx))` (K ALL_TAC)) 3725 \\ `set xs = set (MAP Sym (MAP getSym xs))` by 3726 (IMP_RES_TAC logic_variable_listp_thm \\ FS []) 3727 \\ FS [] \\ POP_ASSUM (K ALL_TAC) 3728 \\ Q.ABBREV_TAC `new_axiom = Equal ((mApp (func2f (Fun fname)) (MAP mVar (MAP getSym xs)))) b` 3729 \\ Q.ABBREV_TAC `if_new_axiom = if MEM new_axiom axioms then axioms else new_axiom :: axioms` 3730 \\ Q.ABBREV_TAC `if_new_atbl = if_lookup (Sym fname) atbl (Dot (Dot (Sym fname) (Val (LENGTH xs))) atbl)` 3731 \\ `~(fname = "ERROR")` by METIS_TAC [NAME_NOT_ERROR] 3732 \\ Cases_on `isTrue (lookup (Sym fname) atbl)` THEN1 3733 (Q.EXISTS_TAC `(axioms,thms,atbl,checker,ftbl)` \\ Q.EXISTS_TAC `ctxt` 3734 \\ FS [milawa_inv_def,milawa_state_def,core_state_def] 3735 \\ Q.UNABBREV_TAC `if_new_atbl` \\ FS [if_lookup_def] 3736 \\ FULL_SIMP_TAC std_ss [if_memberp_def] 3737 \\ SIMP_TAC std_ss [GSYM CONJ_ASSOC] 3738 \\ Q.PAT_X_ASSUM `axioms_inv ctxt ftbl axioms` ASSUME_TAC 3739 \\ FS [atbl_ftbl_inv_def] \\ RES_TAC 3740 \\ FS [define_safe_ID] 3741 \\ `?fparams fbody fsem. 3742 func_definition_exists ctxt fname fparams fbody fsem` suffices_by (STRIP_TAC THEN REVERSE STRIP_TAC THEN1 3743 (SUFF_TAC ``fname IN FDOM (ctxt:context_type) UNION {"NOT";"RANK";"ORDP";"ORD<"}`` 3744 THEN1 (FS [defun_ctxt_def,similar_context_def,LET_DEF,getSym_def]) 3745 \\ FS [axioms_inv_def,EVERY_DEF,func_definition_exists_def,IN_UNION,IN_INSERT]) 3746 \\ MATCH_MP_TAC (METIS_PROVE [] ``x ==> ((if x then y else z) = y)``) 3747 \\ FS [axioms_inv_def] \\ REVERSE (Cases_on `fbody`) 3748 \\ RES_TAC \\ FS [axioms_aux_def] \\ FS [] THEN1 3749 (IMP_RES_TAC MEM_ftbl 3750 \\ IMP_RES_TAC MEM_MEM_ftbl 3751 \\ FS [] \\ FS [sexp2sexp_def,witness_body_def] 3752 \\ REPEAT (Q.PAT_X_ASSUM `T` (K ALL_TAC)) 3753 \\ Q.PAT_X_ASSUM `xxx = body` (fn th => FULL_SIMP_TAC std_ss [GSYM th]) 3754 \\ Q.PAT_X_ASSUM `term2t (sexp3term xx) = b` MP_TAC 3755 \\ SIMP_TAC (srw_ss()) [Once sexp3term_def,LET_DEF] \\ FS [] 3756 \\ SIMP_TAC (srw_ss()) [] \\ FS [getSym_def,sym2prim_def] 3757 \\ SIMP_TAC (srw_ss()) [] \\ FS [] 3758 \\ SIMP_TAC std_ss [sexp2list_def,MAP] 3759 \\ SIMP_TAC (srw_ss()) [Once sexp3term_def,LET_DEF] \\ FS [] 3760 \\ ONCE_REWRITE_TAC [EQ_SYM_EQ] \\ STRIP_TAC \\ FS [] 3761 \\ REPEAT (Q.PAT_X_ASSUM `isTrue (logic_term_atblp xxx yyy)` MP_TAC) 3762 \\ SIMP_TAC (srw_ss()) [logic_term_atblp_def,t2sexp_def, 3763 term2t_def,MAP,func2f_def,logic_func2sexp_def,list2sexp_def] 3764 \\ ONCE_REWRITE_TAC [logic_flag_term_atblp_def] \\ FS [] 3765 \\ FS [logic_variablep_def,logic_function_namep_def] 3766 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,memberp_thm] \\ FS [] 3767 \\ FULL_SIMP_TAC (srw_ss()) [LET_DEF] 3768 \\ `CDR (lookup (Sym "ERROR") 3769 (Dot (Dot (Sym fname) (Val (LENGTH xs))) atbl)) = Sym "NIL"` by 3770 (ONCE_REWRITE_TAC [lookup_def] \\ FS [] 3771 \\ CCONTR_TAC \\ FULL_SIMP_TAC std_ss [GSYM isTrue_def] 3772 \\ `isTrue ((lookup (Sym "ERROR") atbl))` by 3773 (Cases_on `lookup (Sym "ERROR") atbl` 3774 \\ FULL_SIMP_TAC (srw_ss()) [isTrue_def,CDR_def]) 3775 \\ RES_TAC \\ FULL_SIMP_TAC std_ss []) 3776 \\ FS [] \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,len_thm] \\ FS []) 3777 \\ Q.PAT_X_ASSUM `MEM xx axioms` MP_TAC 3778 \\ ASM_SIMP_TAC std_ss [def_axiom_def] 3779 \\ SIMP_TAC std_ss [MEM_MAP] 3780 \\ HO_MATCH_MP_TAC (METIS_PROVE [] ``P x ==> (MEM x xs ==> ?y. P y /\ MEM y xs)``) 3781 \\ FS [f2sexp_def,t2sexp_def] 3782 \\ IMP_RES_TAC MEM_ftbl 3783 \\ IMP_RES_TAC MEM_MEM_ftbl 3784 \\ FS [] \\ FS [sexp2sexp_def] 3785 \\ Cases_on `MEM fname ["NOT";"RANK";"ORDP";"ORD<"]` THEN1 (FS [] \\ EVAL_TAC) 3786 \\ FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 3787 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM] \\ FS [] 3788 \\ FS [func_syntax_ok_def,logic_func2sexp_def,str2func_def,logic_prim2sym_def] 3789 \\ IMP_RES_TAC fake_ftbl_entries \\ FS [fake_ftbl_entries_def]) 3790 \\ Cases_on `MEM fname ["NOT";"RANK";"ORDP";"ORD<"]` THEN1 3791 (ASM_SIMP_TAC std_ss [func_definition_exists_def] 3792 \\ METIS_TAC [lookup_safe_init_ftbl_EXISTS,MEM]) 3793 \\ `(logic_func2sexp (mFun fname) = Sym fname) /\ 3794 func_syntax_ok (mFun fname)` by 3795 (FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 3796 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM] \\ FS [] 3797 \\ FS [func_syntax_ok_def,logic_func2sexp_def,str2func_def] 3798 \\ IMP_RES_TAC fake_ftbl_entries \\ FS [fake_ftbl_entries_def]) 3799 \\ `fname IN FDOM ctxt` by 3800 (CCONTR_TAC \\ Q.PAT_X_ASSUM `atbl_ok ctxt atbl` ASSUME_TAC 3801 \\ FULL_SIMP_TAC std_ss [atbl_ok_def] 3802 \\ POP_ASSUM (MP_TAC o Q.SPEC `mFun fname`) 3803 \\ FS [func_arity_def,CDR_lookup_NOT_NIL]) 3804 \\ `?fparams fbody fsem. ctxt ' fname = (fparams,fbody,fsem)` by METIS_TAC [PAIR] 3805 \\ METIS_TAC [func_definition_exists_def]) 3806 \\ `~MEM fname ["NOT";"RANK";"ORDP";"ORD<"]` by 3807 (STRIP_TAC \\ Q.PAT_X_ASSUM `atbl_ok ctxt atbl` ASSUME_TAC 3808 \\ FS [atbl_ok_def] THENL [ 3809 POP_ASSUM (MP_TAC o Q.SPEC `mPrimitiveFun logic_NOT`) 3810 \\ FS [func_syntax_ok_def,isTrue_def,logic_func2sexp_def, 3811 logic_prim2sym_def,func_arity_def], 3812 POP_ASSUM (MP_TAC o Q.SPEC `mPrimitiveFun logic_RANK`) 3813 \\ FS [func_syntax_ok_def,isTrue_def,logic_func2sexp_def, 3814 logic_prim2sym_def,func_arity_def], 3815 POP_ASSUM (MP_TAC o Q.SPEC `mPrimitiveFun logic_ORDP`) 3816 \\ FS [func_syntax_ok_def,isTrue_def,logic_func2sexp_def, 3817 logic_prim2sym_def,func_arity_def], 3818 POP_ASSUM (MP_TAC o Q.SPEC `mPrimitiveFun logic_ORD_LESS`) 3819 \\ FS [func_syntax_ok_def,isTrue_def,logic_func2sexp_def, 3820 logic_prim2sym_def,func_arity_def]]) 3821 \\ FS [if_lookup_def] 3822 \\ Q.EXISTS_TAC `(if_new_axiom,thms,if_new_atbl,checker, 3823 FST (define_safe ftbl (Sym fname) (list2sexp xs) body k io T))` 3824 \\ Q.ABBREV_TAC `ef = EvalFun fname (ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ARB))` 3825 \\ Q.EXISTS_TAC `ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef)` 3826 \\ IMP_RES_TAC fake_ftbl_entries 3827 \\ STRIP_TAC THEN1 3828 (UNABBREV_ALL_TAC \\ FS [milawa_state_def,core_state_def] \\ FS [if_memberp_def] 3829 \\ FS [MEM,fake_ftbl_entries_def] 3830 \\ `f2sexp (Equal ((mApp (func2f (Fun fname)) (MAP mVar (MAP getSym xs)))) b) = 3831 Dot (Sym "PEQUAL*") (Dot 3832 (Dot (Sym fname) (list2sexp (MAP t2sexp (MAP mVar (MAP getSym xs))))) 3833 (Dot (t2sexp b) (Sym "NIL")))` by 3834 (FS [EVAL ``f2sexp (Equal ((mApp (func2f (Fun fname)) (MAP mVar (MAP getSym xs)))) b)``] 3835 \\ SRW_TAC [] [] \\ EVAL_TAC 3836 \\ FS [MEM,fake_ftbl_entries_def] 3837 \\ SRW_TAC [] [] \\ FS [logic_function_namep_def] 3838 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,memberp_thm,MEM] \\ FS []) 3839 \\ POP_ASSUM (ASSUME_TAC o GSYM) \\ FS [] 3840 \\ IMP_RES_TAC (logic_variable_listp_thm) \\ FS [] \\ SRW_TAC [] [] \\ FS []) 3841 \\ FULL_SIMP_TAC std_ss [milawa_inv_def] 3842 \\ `ALL_DISTINCT (MAP getSym xs)` by METIS_TAC [logic_variable_listp_ALL_DISTINCT_IMP] 3843 \\ `~(fname IN FDOM ctxt)` by 3844 (REPEAT STRIP_TAC \\ Q.PAT_X_ASSUM `atbl_ok ctxt atbl` MP_TAC 3845 \\ FS [atbl_ok_def] \\ Q.EXISTS_TAC `mFun fname` 3846 \\ FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 3847 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM] \\ FS [] 3848 \\ STRIP_TAC THEN1 (EVAL_TAC \\ FS []) 3849 \\ ASM_SIMP_TAC std_ss [logic_func2sexp_def,MEM] \\ FS [isTrue_def] 3850 \\ FS [func_arity_def]) 3851 \\ `!body. atbl_ok (ctxt |+ (fname,MAP getSym xs,body,ef)) if_new_atbl` by 3852 (FS [atbl_ok_def] \\ REPEAT STRIP_TAC \\ RES_TAC \\ Q.UNABBREV_TAC `if_new_atbl` 3853 \\ Cases_on `f` \\ FULL_SIMP_TAC std_ss [func_arity_def] 3854 \\ `!l. ~(logic_func2sexp (mPrimitiveFun l) = Sym fname)` by 3855 (FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 3856 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM] \\ FS [] 3857 \\ Cases \\ EVAL_TAC \\ FS []) 3858 \\ ONCE_REWRITE_TAC [lookup_def] \\ FS [] 3859 \\ `(logic_func2sexp (mFun s) = Sym fname) = (s = fname)` by 3860 (FULL_SIMP_TAC std_ss [logic_func2sexp_def] \\ SRW_TAC [] [] 3861 \\ FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 3862 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM] \\ FS []) 3863 \\ FS [FDOM_FUPDATE,IN_INSERT,FAPPLY_FUPDATE_THM] 3864 \\ Cases_on `s = fname` \\ FS [LENGTH_MAP]) 3865 \\ `atbl_ok (ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef)) if_new_atbl /\ 3866 atbl_ok (ctxt |+ (fname,MAP getSym xs,NO_FUN,ef)) if_new_atbl` by METIS_TAC [] 3867 \\ `thms_inv (ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef)) thms` by 3868 (FS [thms_inv_def,EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC 3869 \\ IMP_RES_TAC MilawaTrue_new_definition \\ METIS_TAC []) 3870 \\ `thms_inv (ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef)) axioms` by 3871 (FS [thms_inv_def,EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC 3872 \\ IMP_RES_TAC MilawaTrue_new_definition \\ METIS_TAC []) 3873 \\ FS [] 3874 \\ `func2f (Fun fname) = mFun fname` by 3875 (FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 3876 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM,func2f_def]) 3877 \\ `term_ok (ctxt |+ (fname,MAP getSym xs,NO_FUN,ef)) b /\ 3878 EVERY (MilawaTrue (ctxt |+ (fname,MAP getSym xs,NO_FUN,ef))) 3879 (termination_obligations fname b (MAP getSym xs) m)` by 3880 (`term_ok (ctxt |+ (fname,MAP getSym xs,NO_FUN,ef)) b` by (IMP_RES_TAC logic_term_atblp_thm) \\ FS [] 3881 \\ MP_TAC (logic_termination_obligations_thm 3882 |> Q.INST [`body`|->`b`,`name`|->`fname`,`formals`|->`MAP getSym xs`, 3883 `ctxt`|->`ctxt |+ (fname,MAP getSym xs,NO_FUN,ef)`]) 3884 \\ FS [FAPPLY_FUPDATE_THM,LENGTH_MAP] 3885 \\ MATCH_MP_TAC IMP_IMP 3886 \\ STRIP_TAC THEN1 (FS [logic_func2sexp_def] 3887 \\ FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 3888 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM] \\ FS []) 3889 \\ STRIP_TAC \\ FS [] \\ POP_ASSUM (K ALL_TAC) 3890 \\ STRIP_ASSUME_TAC (Q.SPEC `proof_list` anylist2sexp_EXISTS) 3891 \\ FS [] \\ IMP_RES_TAC logic_appeal_anylistp_thm 3892 \\ POP_ASSUM (K ALL_TAC) \\ POP_ASSUM (K ALL_TAC) \\ FS [] 3893 \\ FS [logic_strip_conclusions_thm,MAP_f2sexp_11] 3894 \\ Q.PAT_X_ASSUM `MAP CONCL ts = bbb` (ASSUME_TAC o GSYM) 3895 \\ FULL_SIMP_TAC std_ss [] 3896 \\ Q.PAT_X_ASSUM `isTrue bbb` MP_TAC 3897 \\ Q.PAT_X_ASSUM `SND (SND xxx)` MP_TAC 3898 \\ SIMP_TAC std_ss [AND_IMP_INTRO] 3899 \\ MATCH_MP_TAC core_check_proof_list_thm \\ FS [] 3900 \\ STRIP_TAC THEN1 (MATCH_MP_TAC context_ok_None \\ FS []) 3901 \\ FS [thms_inv_def,EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC 3902 \\ IMP_RES_TAC MilawaTrue_new_definition \\ METIS_TAC []) 3903 \\ `term_ok (ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef)) b` by (FS [EvalTerm_IGNORE_BODY]) 3904 \\ `definition_ok (fname,MAP getSym xs,BODY_FUN b,ctxt)` by 3905 (FS [definition_ok_def,term_ok_IGNORE_SEM,MilawaTrue_IGNORE_SEM, 3906 EvalTerm_IGNORE_BODY] \\ Q.EXISTS_TAC `m` \\ FS []) \\ FS [] 3907 \\ PUSH_STRIP_TAC THEN1 (METIS_TAC [definition_ok_BODY_FUN]) 3908 \\ PUSH_STRIP_TAC THEN1 3909 (FS [context_inv_def] \\ STRIP_TAC \\ STRIP_TAC \\ Cases_on `fname = fname'` 3910 \\ FULL_SIMP_TAC (srw_ss()) [FAPPLY_FUPDATE_THM] 3911 THEN1 (Q.UNABBREV_TAC `ef` \\ FS [EvalFun_IGNORE_SEM]) 3912 \\ REPEAT STRIP_TAC \\ FS [context_inv_def] \\ RES_TAC \\ FS [] 3913 \\ `term_ok ctxt body'` by (FS [context_ok_def] \\ RES_TAC) 3914 \\ IMP_RES_TAC EvalFun_FUPDATE \\ FS [GSYM EvalTerm_FUPDATE]) 3915 \\ PUSH_STRIP_TAC THEN1 3916 (IMP_RES_TAC similar_context_definition_ok 3917 \\ FS [similar_context_def,defun_ctxt_def,getSym_def,LET_DEF] 3918 \\ `~(fname IN FDOM ctxt UNION {"NOT"; "RANK"; "ORDP"; "ORD<"})` by FS [IN_INSERT,IN_UNION,NOT_IN_EMPTY] \\ FS [FDOM_FUPDATE] 3919 \\ FS [sexp2t_t2sexp_thm] \\ STRIP_TAC THEN1 (METIS_TAC [definition_ok_thm]) 3920 \\ FS [FEVERY_DEF,FDOM_FUPDATE,IN_INSERT,FAPPLY_FUPDATE_THM] \\ STRIP_TAC 3921 \\ Cases_on `x' = fname` \\ FS [] 3922 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ REPEAT STRIP_TAC 3923 \\ Q.PAT_X_ASSUM `FDOM simple_ctxt = FDOM ctxt` ASSUME_TAC \\ FS [] 3924 \\ RES_TAC \\ POP_ASSUM MP_TAC 3925 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ REPEAT STRIP_TAC 3926 \\ FS []) 3927 \\ PUSH_STRIP_TAC THEN1 3928 (Q.UNABBREV_TAC `if_new_atbl` \\ FS [atbl_inv_def,EVERY_DEF,sexp2list_def]) 3929 \\ PUSH_STRIP_TAC THEN1 3930 (Q.UNABBREV_TAC `if_new_axiom` 3931 \\ `thms_inv (ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef)) (new_axiom::axioms)` suffices_by 3932 (STRIP_TAC THEN FS [thms_inv_def,EVERY_DEF] \\ SRW_TAC [] [EVERY_DEF]) 3933 \\ FS [thms_inv_def,EVERY_DEF] 3934 \\ REVERSE (REPEAT STRIP_TAC) \\ Q.UNABBREV_TAC `new_axiom` THEN1 3935 (FS [formula_syntax_ok_def,term_syntax_ok_def,EVERY_MEM,MEM_MAP,func_syntax_ok_def] 3936 \\ FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 3937 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM,func2f_def] 3938 \\ FS [] \\ REPEAT STRIP_TAC \\ FS [term_syntax_ok_def] 3939 \\ IMP_RES_TAC logic_variable_listp_IMP_EVERY 3940 \\ FS [EVERY_MEM]) 3941 \\ ((CONJUNCTS MilawaTrue_rules) 3942 |> filter (can (find_term (fn tm => tm = ``BODY_FUN``) o concl)) 3943 |> hd |> MATCH_MP_TAC) 3944 \\ FS [FDOM_FUPDATE,IN_INSERT, 3945 FAPPLY_FUPDATE_THM] 3946 \\ Q.EXISTS_TAC `m` \\ FULL_SIMP_TAC std_ss []) 3947 \\ PUSH_STRIP_TAC THEN1 3948 (Cases_on `(FST (SND (define_safe ftbl (Sym fname) (list2sexp xs) body k io T))) = k` 3949 \\ FULL_SIMP_TAC std_ss [] 3950 \\ `?new_def. (FST (SND (define_safe ftbl (Sym fname) (list2sexp xs) body k io T))) = 3951 add_def k new_def` by 3952 (FULL_SIMP_TAC std_ss [define_safe_def,LET_DEF] \\ METIS_TAC []) 3953 \\ FULL_SIMP_TAC std_ss [] 3954 \\ Q.PAT_X_ASSUM `core_check_proof_inv checker k` MP_TAC 3955 \\ METIS_TAC [core_check_proof_inv_step]) 3956 \\ PUSH_STRIP_TAC THEN1 3957 (FS [define_safe_def,LET_DEF] 3958 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` \\ FS [] 3959 \\ FS [ftbl_inv_def,getSym_def] 3960 \\ REVERSE STRIP_TAC THEN1 3961 (FS [sexp2list_def,EVERY_DEF] 3962 \\ ONCE_REWRITE_TAC [lookup_safe_def] \\ FS [EVERY_MEM] 3963 \\ REPEAT STRIP_TAC \\ SRW_TAC [] [] \\ FS [lookup_safe_EQ_MEM] 3964 \\ Q.EXISTS_TAC `SUC old` \\ FS [FUNPOW]) 3965 \\ SIMP_TAC std_ss [sexp2list_def,EVERY_DEF] 3966 \\ STRIP_TAC THEN1 3967 (FS [LET_DEF,getSym_def,add_def_def,FDOM_FUNION, 3968 IN_UNION,FDOM_FEMPTY,FDOM_FUPDATE, 3969 IN_INSERT,FUNION_DEF,FAPPLY_FUPDATE_THM]) 3970 \\ FS [EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC THEN1 3971 (FS [LET_DEF,getSym_def,add_def_def,FDOM_FUNION, 3972 IN_UNION,FDOM_FEMPTY,FDOM_FUPDATE, 3973 IN_INSERT,FUNION_DEF,FAPPLY_FUPDATE_THM])) 3974 \\ PUSH_STRIP_TAC THEN1 3975 (SIMP_TAC std_ss [axioms_inv_def] \\ STRIP_TAC 3976 THEN1 (FULL_SIMP_TAC std_ss [EVERY_DEF,FDOM_FUPDATE,IN_INSERT,axioms_inv_def]) 3977 \\ FS [axioms_inv_def,FDOM_FUPDATE,FAPPLY_FUPDATE_THM] \\ STRIP_TAC 3978 \\ REVERSE (Cases_on `name = fname`) \\ FS [IN_INSERT] 3979 \\ FS [func_definition_exists_NEQ] THEN1 3980 (REPEAT STRIP_TAC \\ Q.PAT_X_ASSUM `!name params body sem. bbb` IMP_RES_TAC 3981 \\ REVERSE (Cases_on `body'`) \\ FULL_SIMP_TAC std_ss [axioms_aux_def] THEN1 3982 (Q.EXISTS_TAC `raw_body` \\ POP_ASSUM MP_TAC \\ FS [] \\ STRIP_TAC 3983 \\ STRIP_TAC THEN1 3984 (FS [define_safe_def,LET_DEF] 3985 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` 3986 \\ FS [sexp2list_def,MEM]) 3987 \\ Q.UNABBREV_TAC `if_new_axiom` \\ METIS_TAC [MEM]) 3988 \\ Q.EXISTS_TAC `raw_body` \\ POP_ASSUM MP_TAC \\ FS [] \\ STRIP_TAC 3989 \\ STRIP_TAC THEN1 3990 (FS [define_safe_def,LET_DEF] 3991 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` 3992 \\ FS [sexp2list_def,MEM]) 3993 \\ STRIP_TAC THEN1 (Q.UNABBREV_TAC `if_new_axiom` \\ METIS_TAC [MEM]) 3994 \\ Cases_on `MEM name ["NOT"; "RANK"; "ORD<"; "ORDP"]` 3995 THEN1 (FS [logic_func_inv_def]) 3996 \\ `name IN FDOM ctxt` by METIS_TAC [func_definition_exists_def] 3997 \\ MATCH_MP_TAC logic_func_inv_NEQ \\ FS [sexp2sexp_def] 3998 \\ FS [func_definition_exists_def] 3999 \\ METIS_TAC [context_ok_def]) 4000 \\ FS [func_definition_exists_EQ,MEM,axioms_aux_def] 4001 \\ Q.EXISTS_TAC `body` \\ FS [] \\ REPEAT STRIP_TAC THEN1 4002 (FS [define_safe_def,LET_DEF] 4003 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` \\ FS [sexp2list_def,MEM] 4004 \\ Q.PAT_X_ASSUM `lookup_safe (Sym fname) ftbl = bb` (ASSUME_TAC o GSYM) 4005 \\ FS [ftbl_inv_def] \\ FULL_SIMP_TAC std_ss [isTrue_lookup_safe]) 4006 THEN1 (FS [sexp2sexp_def]) THEN1 4007 (FS [sexp2sexp_def] 4008 \\ Q.UNABBREV_TAC `if_new_axiom` \\ Q.UNABBREV_TAC `new_axiom` 4009 \\ `(func2f (Fun fname) = mFun fname) /\ (str2func fname = mFun fname)` by 4010 (FS [str2func_def,fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 4011 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM,func2f_def]) 4012 \\ FULL_SIMP_TAC std_ss [def_axiom_def] 4013 \\ SRW_TAC [] []) 4014 THEN1 4015 (MATCH_MP_TAC logic_func_inv_EQ 4016 \\ ASM_SIMP_TAC std_ss [logic_variable_listp_IMP_EVERY_Sym] 4017 \\ FS [EvalTerm_IGNORE_BODY,EvalFun_IGNORE_SEM] 4018 \\ REVERSE STRIP_TAC THEN1 (FS [sexp2sexp_def]) 4019 \\ FS [EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC 4020 \\ MATCH_MP_TAC MilawaTrue_REPLACE_NO_FUN \\ FS []) 4021 \\ `~("ERROR" IN FDOM ((ctxt |+ (fname,MAP getSym xs,BODY_FUN b,ef))))` by 4022 (FULL_SIMP_TAC std_ss [FDOM_FUPDATE,IN_INSERT] 4023 \\ FULL_SIMP_TAC std_ss [atbl_ok_def] \\ REPEAT STRIP_TAC 4024 \\ Q.PAT_X_ASSUM `!f. func_syntax_ok f ==> bbb` (MP_TAC o Q.SPEC `mFun "ERROR"`) 4025 \\ FULL_SIMP_TAC (srw_ss()) [func_syntax_ok_def,MEM,logic_func2sexp_def] 4026 \\ FULL_SIMP_TAC std_ss [func_arity_def,FDOM_FUPDATE,IN_INSERT] 4027 \\ `lookup (Sym "ERROR") atbl = Sym "NIL"` by METIS_TAC [atbl_ftbl_inv_def,isTrue_def] 4028 \\ Q.UNABBREV_TAC `if_new_atbl` 4029 \\ ONCE_REWRITE_TAC [lookup_def] \\ FS []) 4030 \\ FS [sexp2sexp_def] \\ METIS_TAC [NOT_CAR_EQ_ERROR,EvalTerm_IGNORE_BODY]) 4031 \\ PUSH_STRIP_TAC THEN1 4032 (FS [atbl_ftbl_inv_def] \\ Q.UNABBREV_TAC `if_new_atbl` \\ FS [] 4033 \\ ONCE_REWRITE_TAC [lookup_def] \\ FS [] \\ STRIP_TAC 4034 \\ Cases_on `fname' = fname` \\ FS [] THEN1 4035 (FS [define_safe_def,LET_DEF] 4036 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` \\ FS [] 4037 \\ ASM_SIMP_TAC std_ss [lookup_safe_EQ_MEM] 4038 \\ FS [sexp2list_def,MAP,MEM] 4039 \\ ONCE_REWRITE_TAC [lookup_safe_def] 4040 \\ FS [] \\ FS [isTrue_def]) 4041 \\ STRIP_TAC \\ RES_TAC 4042 \\ FS [define_safe_def,LET_DEF] 4043 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` \\ FS [] 4044 \\ FS [sexp2list_def,MAP]) 4045 \\ STRIP_TAC THEN1 4046 (SIMP_TAC std_ss [runtime_inv_def] \\ REPEAT STRIP_TAC 4047 \\ FULL_SIMP_TAC std_ss [FDOM_FUPDATE] 4048 \\ REVERSE (Cases_on `fname = name`) \\ FULL_SIMP_TAC std_ss [] THEN1 4049 (FULL_SIMP_TAC std_ss [IN_INSERT,FAPPLY_FUPDATE_THM,runtime_inv_def] 4050 \\ Q.PAT_X_ASSUM `!name params. bbb` (MP_TAC o Q.SPEC `name`) 4051 \\ ASM_SIMP_TAC std_ss [] 4052 \\ STRIP_TAC \\ POP_ASSUM (MP_TAC o Q.SPECL [`args`,`ok'`]) 4053 \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC 4054 \\ Q.EXISTS_TAC `ok2` \\ STRIP_TAC THEN1 4055 (MATCH_MP_TAC MR_ap_CTXT 4056 \\ FULL_SIMP_TAC std_ss [] 4057 \\ RES_TAC \\ SIMP_TAC std_ss [define_safe_def,LET_DEF] \\ SRW_TAC [] [] 4058 \\ METIS_TAC [MR_ev_add_def]) 4059 \\ FULL_SIMP_TAC std_ss [MilawaTrueFun_def] 4060 \\ METIS_TAC [MilawaTrue_new_definition]) 4061 \\ FULL_SIMP_TAC std_ss [IN_INSERT,FAPPLY_FUPDATE_THM] 4062 \\ Q.ABBREV_TAC `k2 = FST (SND (define_safe ftbl (Sym name) (list2sexp xs) body k io T))` 4063 \\ Q.ABBREV_TAC `ftbl2 = (FST (define_safe ftbl (Sym name) (list2sexp xs) body k io T))` 4064 \\ Q.ABBREV_TAC `ctxt2 = (ctxt |+ (name,params,body',sem))` 4065 \\ Q.PAT_X_ASSUM `xxx = body'` (ASSUME_TAC o GSYM) 4066 \\ FULL_SIMP_TAC std_ss [axioms_inv_def] 4067 \\ `func_definition_exists ctxt2 name params (BODY_FUN b) sem` by 4068 (FULL_SIMP_TAC std_ss [func_definition_exists_def] 4069 \\ Q.UNABBREV_TAC `ctxt2` \\ EVAL_TAC) 4070 \\ RES_TAC \\ FULL_SIMP_TAC std_ss [axioms_aux_def] 4071 \\ Q.PAT_X_ASSUM `ftbl_inv k2 ftbl2` (fn th => ASSUME_TAC th THEN MP_TAC th) 4072 \\ SIMP_TAC std_ss [ftbl_inv_def,EVERY_MEM] \\ STRIP_TAC 4073 \\ RES_TAC \\ FS [LET_DEF,isTrue_def,getSym_def,MAP_getSym_Sym] 4074 \\ ONCE_REWRITE_TAC [MR_ev_cases] \\ FULL_SIMP_TAC (srw_ss()) [] 4075 \\ Q.PAT_X_ASSUM `logic_func_inv name ctxt2 raw_body` MP_TAC 4076 \\ SS [logic_func_inv_def,LET_DEF] \\ ASM_SIMP_TAC std_ss [] 4077 \\ STRIP_TAC \\ POP_ASSUM (MP_TAC o Q.SPEC `FunVarBind params args`) 4078 \\ `name IN FDOM ctxt2 /\ 4079 (ctxt2 ' name = (params,BODY_FUN (term2t (sexp3term raw_body)),sem))` by 4080 (Q.UNABBREV_TAC `ctxt2` 4081 \\ FULL_SIMP_TAC std_ss [FAPPLY_FUPDATE_THM,FDOM_FUPDATE,IN_INSERT]) 4082 \\ `sem = EvalFun name ctxt2` by 4083 (FULL_SIMP_TAC std_ss [context_inv_def] \\ METIS_TAC []) 4084 \\ ASM_SIMP_TAC std_ss [EvalFun_def] 4085 \\ STRIP_TAC \\ SIMP_TAC std_ss [Eval_M_ap_def] 4086 \\ ONCE_REWRITE_TAC [M_ev_cases] \\ FULL_SIMP_TAC (srw_ss()) [] 4087 \\ Q.ABBREV_TAC `result = (EvalTerm (FunVarBind params args,ctxt2) 4088 (term2t (sexp3term raw_body)))` 4089 \\ `!a. M_ev name 4090 (term2t (sexp3term raw_body),FunVarBind params args,ctxt2) a = 4091 (result = a)` by METIS_TAC [M_ev_DETERMINISTIC] 4092 \\ ASM_SIMP_TAC std_ss [] \\ POP_ASSUM (K ALL_TAC) 4093 \\ `axioms_inv ctxt2 ftbl2 if_new_axiom` by 4094 FULL_SIMP_TAC (srw_ss()) [axioms_inv_def] 4095 \\ `EVERY (\x. x NOTIN FDOM ctxt2) fake_ftbl_entries` by 4096 METIS_TAC [fake_ftbl_entries_NOT_IN_CTXT] 4097 \\ `~("DEFUN" IN FDOM ctxt2) /\ ~("ERROR" IN FDOM ctxt2)` by 4098 FULL_SIMP_TAC std_ss [fake_ftbl_entries_def,EVERY_DEF] 4099 \\ IMP_RES_TAC term2t_sexp3term_LEMMA \\ FULL_SIMP_TAC std_ss [] 4100 \\ Q.ABBREV_TAC `bb = sexp2term raw_body` 4101 \\ `funcs_ok bb` by METIS_TAC [funcs_ok_sexp2term] 4102 \\ `?ok2. 4103 MR_ev (term2term bb,VarBind params args,ctxt2,k2,ok') (result,ok2) /\ 4104 (ok2 ==> MilawaTrue ctxt2 (Equal (inst_term (FunVarBind params args) (term2t bb)) (mConst result)))` suffices_by (STRIP_TAC THEN Q.EXISTS_TAC `ok2` \\ STRIP_TAC THEN1 4105 (DISJ1_TAC \\ REVERSE STRIP_TAC 4106 THEN1 (MATCH_MP_TAC (GEN_ALL MR_ev_term2term) \\ FULL_SIMP_TAC std_ss [] \\ METIS_TAC [EvalTerm_IGNORE_BODY]) 4107 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [term2t_def] 4108 \\ Q.PAT_X_ASSUM `term2t (sexp3term raw_body) = xx` MP_TAC 4109 \\ SIMP_TAC std_ss [] 4110 \\ Q.PAT_X_ASSUM `term_ok ctxt2 (mApp (func2f Error) (MAP (\a. term2t a) xs'))` MP_TAC 4111 \\ ASM_SIMP_TAC std_ss [term_ok_def,func2f_def,func_arity_def]) 4112 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [MilawaTrueFun_def] 4113 \\ MATCH_MP_TAC (GEN_ALL MilawaTrue_TRANS) 4114 \\ Q.EXISTS_TAC `(inst_term (FunVarBind params args) (term2t bb))` 4115 \\ ASM_SIMP_TAC std_ss [] 4116 \\ `(Equal (mApp (mFun name) (MAP mConst args)) 4117 (inst_term (FunVarBind params args) (term2t bb))) = 4118 formula_sub (ZIP(params,MAP mConst args)) 4119 (Equal (mApp (mFun name) (MAP mVar params)) (term2t bb))` by 4120 (FULL_SIMP_TAC (srw_ss()) [formula_sub_def,term_sub_def,MAP_MAP_o,o_DEF] 4121 \\ ASM_SIMP_TAC std_ss [MAP_LOOKUP_LEMMA,inst_term_def] 4122 \\ FULL_SIMP_TAC std_ss [context_ok_def] 4123 \\ RES_TAC \\ IMP_RES_TAC (GSYM term_sub_EQ) 4124 \\ POP_ASSUM (ASSUME_TAC o Q.SPEC `mConst o FunVarBind params args`) 4125 \\ FULL_SIMP_TAC std_ss [o_DEF,MAP_FunVarBind_LEMMA]) 4126 \\ ASM_SIMP_TAC std_ss [] 4127 \\ MATCH_MP_TAC (MilawaTrue_rules |> CONJUNCTS |> el 7) 4128 \\ STRIP_TAC THEN1 4129 (Q.UNABBREV_TAC `new_axiom` 4130 \\ FULL_SIMP_TAC std_ss [formula_sub_def,formula_ok_def, 4131 term_sub_def,term_ok_def,func_arity_def,LENGTH_MAP] 4132 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,MEM_MAP,PULL_IMP] 4133 \\ REPEAT STRIP_TAC \\ MATCH_MP_TAC term_ok_sub 4134 \\ FULL_SIMP_TAC std_ss [term_ok_def,EVERY_MEM,MEM_MAP,PULL_IMP] 4135 \\ Cases \\ ASM_SIMP_TAC std_ss [MEM_MAP,pairTheory.EXISTS_PROD, 4136 ZIP_MAP |> Q.SPECL [`xs`,`ys`] |> Q.ISPEC `I` |> SIMP_RULE std_ss [MAP_ID]] 4137 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [term_ok_def]) 4138 \\ FULL_SIMP_TAC std_ss [axioms_inv_def] 4139 \\ `axioms_aux name ctxt2 if_new_axiom ftbl2 params sem 4140 (BODY_FUN (term2t bb))` by METIS_TAC [func_definition_exists_def] 4141 \\ FULL_SIMP_TAC std_ss [axioms_aux_def,def_axiom_def] 4142 \\ `str2func name = mFun name` by (SRW_TAC [] [str2func_def]) 4143 \\ FULL_SIMP_TAC std_ss [] \\ Q.UNABBREV_TAC `new_axiom` 4144 \\ FULL_SIMP_TAC std_ss [thms_inv_def,EVERY_MEM] \\ METIS_TAC []) 4145 \\ SIMP_TAC std_ss [term2term_def] 4146 \\ `core_assum k2` by 4147 (Q.UNABBREV_TAC `k2` 4148 \\ SIMP_TAC std_ss [define_safe_def,LET_DEF] \\ SRW_TAC [] [] 4149 \\ Q.PAT_X_ASSUM `core_assum kk` MP_TAC 4150 \\ ONCE_REWRITE_TAC [milawa_initTheory.core_assum_def] 4151 \\ MATCH_MP_TAC (METIS_PROVE [] ``(!x. f a x ==> f b x) ==> (f a x ==> f b x)``) 4152 \\ SIMP_TAC std_ss [fns_assum_add_def_IMP]) 4153 \\ MATCH_MP_TAC (GEN_ALL MR_ev_thm |> Q.SPECL [`result`,`name`,`k2`,`term2t bb`,`ctxt2`,`FunVarBind params args`,`ok'`,`VarBind params args`]) 4154 \\ FULL_SIMP_TAC (srw_ss()) [] 4155 \\ `ctxt2 \\ name = ctxt` by (Q.UNABBREV_TAC `ctxt2` \\ ASM_SIMP_TAC (srw_ss()) [DOMSUB_NOT_IN_DOM]) 4156 \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC THEN1 4157 (FULL_SIMP_TAC std_ss [term_funs_def,axioms_inv_def] \\ REPEAT STRIP_TAC 4158 \\ `axioms_aux name' ctxt2 if_new_axiom ftbl2 params' sem' 4159 (BODY_FUN body'')` by METIS_TAC [func_definition_exists_def] 4160 \\ FULL_SIMP_TAC std_ss [axioms_aux_def,def_axiom_def] 4161 \\ `str2func name' = mFun name'` by 4162 (FULL_SIMP_TAC std_ss [EVERY_DEF,str2func_def] \\ SRW_TAC [] [] 4163 \\ FULL_SIMP_TAC std_ss []) 4164 \\ FULL_SIMP_TAC std_ss [thms_inv_def,EVERY_MEM] \\ METIS_TAC []) 4165 \\ STRIP_TAC THEN1 4166 (FULL_SIMP_TAC std_ss [runtime_inv_def] \\ REPEAT STRIP_TAC 4167 \\ Q.UNABBREV_TAC `k2` \\ SRW_TAC [] [define_safe_def,LET_DEF] 4168 \\ METIS_TAC [MR_ev_add_def]) 4169 \\ STRIP_TAC THEN1 4170 (FULL_SIMP_TAC std_ss [proof_in_full_ctxt_def] \\ REPEAT STRIP_TAC 4171 \\ Q.PAT_X_ASSUM `Abbrev (ctxt2 = pat)` (fn th => 4172 ASSUME_TAC th THEN ONCE_REWRITE_TAC [REWRITE_RULE [markerTheory.Abbrev_def] th]) 4173 \\ METIS_TAC [MilawaTrue_new_definition]) 4174 \\ NTAC 2 STRIP_TAC 4175 \\ FULL_SIMP_TAC std_ss [SUBSET_DEF] 4176 \\ `MEM v params` by FULL_SIMP_TAC std_ss [] 4177 \\ FULL_SIMP_TAC std_ss [params_lemma]) 4178 THEN1 (* core_assums *) 4179 (SIMP_TAC std_ss [define_safe_def,LET_DEF] \\ SRW_TAC [] [] 4180 \\ Q.PAT_X_ASSUM `core_assum kk` MP_TAC 4181 \\ ONCE_REWRITE_TAC [milawa_initTheory.core_assum_def] 4182 \\ MATCH_MP_TAC (METIS_PROVE [] ``(!x. f a x ==> f b x) ==> (f a x ==> f b x)``) 4183 \\ SIMP_TAC std_ss [fns_assum_add_def_IMP])); 4184 4185 4186(* admit witness *) 4187 4188val core_admit_witness_cmd = prove( 4189 ``list_exists 5 cmd ==> 4190 ?x name bound_var free_vars raw_body. 4191 cmd = list2sexp [x;name;bound_var;free_vars;raw_body]``, 4192 REPEAT STRIP_TAC \\ EVAL_TAC \\ Cases_on `cmd` \\ FS [] 4193 \\ REPEAT ((Cases_on `S0` \\ FS []) ORELSE (Cases_on `S0'` \\ FS [])) \\ FS []); 4194 4195val core_admit_witness_lemma = core_admit_witness_def 4196 |> SIMP_RULE std_ss [DISJ_EQ_IMP,GSYM if_memberp_def,GSYM if_lookup_def,LET_DEF] 4197 4198val core_admit_witness_side_lemma = core_admit_witness_side_def 4199 |> SIMP_RULE std_ss [DISJ_EQ_IMP,GSYM AND_IMP_INTRO,LET_DEF,define_safe_side_def,LET_DEF] 4200 4201val ALL_DISTINCT_MAP_Sym = prove( 4202 ``!xs. ALL_DISTINCT (MAP Sym xs) = ALL_DISTINCT xs``, 4203 Induct \\ FS [MAP,ALL_DISTINCT]); 4204 4205val ALL_DISTINCT_LEMMA = prove( 4206 ``isTrue (logic_variable_listp (list2sexp xs)) /\ ALL_DISTINCT (Sym var::xs) ==> 4207 ALL_DISTINCT (var::MAP getSym xs)``, 4208 REPEAT STRIP_TAC \\ IMP_RES_TAC logic_variable_listp_IMP 4209 \\ FULL_SIMP_TAC std_ss [MAP_getSym_Sym] 4210 \\ FULL_SIMP_TAC std_ss [GSYM MAP,ALL_DISTINCT_MAP_Sym]); 4211 4212val term_ok_IMP_FUPDATE = prove( 4213 ``!ctxt body. 4214 ~(n IN FDOM ctxt) /\ term_ok ctxt body ==> term_ok (ctxt |+ (n,x)) body``, 4215 HO_MATCH_MP_TAC term_ok_ind \\ SIMP_TAC std_ss [term_ok_def,EVERY_MEM] 4216 \\ REPEAT STRIP_TAC \\ Cases_on `fc` 4217 \\ FULL_SIMP_TAC std_ss [func_arity_def,FDOM_FUPDATE,IN_INSERT, 4218 FAPPLY_FUPDATE_THM] \\ METIS_TAC []); 4219 4220val logic_variable_listp_NOT_NIL = prove( 4221 ``!xs. isTrue (logic_variable_listp (list2sexp xs)) ==> 4222 EVERY (\x. ~(getSym x = "NIL") /\ ~(getSym x = "T")) xs /\ 4223 EVERY (\x. var_ok (getSym x)) xs``, 4224 Induct \\ SIMP_TAC std_ss [EVERY_DEF] 4225 \\ SIMP_TAC std_ss [Once logic_variable_listp_def] \\ FS [] \\ SRW_TAC [] [] 4226 \\ FS [logic_variablep_def] \\ Cases_on `h` \\ FS [getSym_def,var_ok_def] 4227 \\ FULL_SIMP_TAC (srw_ss()) [] \\ REPEAT STRIP_TAC \\ FS [CONS_11]); 4228 4229val witness_ctxt_def = Define ` 4230 witness_ctxt ctxt cmd = 4231 let name = getSym (CAR (CDR cmd)) in 4232 let var = getSym (CAR (CDR (CDR cmd))) in 4233 let formals = MAP getSym (sexp2list (CAR (CDR (CDR (CDR cmd))))) in 4234 let prop = sexp2t (sexp2sexp (CAR (CDR (CDR (CDR (CDR cmd)))))) in 4235 let body = WITNESS_FUN prop var in 4236 let interp = @interp. context_ok (ctxt |+ (name,formals,body,interp)) in 4237 if name IN FDOM ctxt UNION {"NOT";"RANK";"ORDP";"ORD<"} then ctxt 4238 else ctxt |+ (name,formals,body,interp)`; 4239 4240val core_admit_witness_thm = prove( 4241 ``milawa_inv ctxt simple_ctxt k (axioms,thms,atbl,checker,ftbl) ==> 4242 ?x k2 io2 ok2 result. 4243 core_admit_witness_side cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok /\ 4244 (core_admit_witness cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok = 4245 (x,k2,io2,ok2)) /\ 4246 (ok2 ==> (io2 = io) /\ 4247 ?result ctxt. (x = milawa_state result) /\ milawa_inv ctxt (witness_ctxt simple_ctxt cmd) k2 result)``, 4248 FS [core_admit_witness_side_lemma,core_admit_witness_lemma, 4249 LET_DEF,milawa_state_def,core_state_def] 4250 \\ SRW_TAC [] [] \\ FS [] \\ FS [milawa_inv_def] 4251 THEN1 (SRW_TAC [] [define_safe_def] \\ FS [define_safe_def] 4252 \\ SRW_TAC [] [] \\ FULL_SIMP_TAC std_ss [LET_DEF] 4253 \\ Q.UNABBREV_TAC `prev_def` \\ Q.UNABBREV_TAC `this_def` 4254 \\ POP_ASSUM MP_TAC \\ FULL_SIMP_TAC std_ss []) 4255 \\ IMP_RES_TAC core_admit_witness_cmd 4256 \\ IMP_RES_TAC SND_SND_SND_define_safe_IMP \\ FS [] 4257 \\ `isTrue (logic_translate raw_body)` by 4258 (SIMP_TAC std_ss [isTrue_def] \\ REPEAT STRIP_TAC 4259 \\ FS [EVAL ``logic_termp (Sym "NIL")``]) 4260 \\ FS [logic_translate_thm] 4261 \\ `?body. term_syntax_ok body /\ (sexp2sexp raw_body = t2sexp body)` by METIS_TAC [logic_termp_thm] 4262 \\ Q.PAT_X_ASSUM `free_vars' = list2sexp xs` ASSUME_TAC \\ FS [] 4263 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,uniquep_thm] \\ FS [] 4264 \\ `?fname. name = Sym fname` by 4265 (Cases_on `isSym name` \\ FS [logic_function_namep_def] \\ FS [isSym_thm]) 4266 \\ FS [] \\ POP_ASSUM (K ALL_TAC) \\ Q.PAT_X_ASSUM `cmd = bbb` (K ALL_TAC) 4267 \\ `?var. bound_var = Sym var` by 4268 (Cases_on `isSym bound_var` \\ FS [logic_variablep_def] \\ FS [isSym_thm]) 4269 \\ `set (Sym var::xs) = set (MAP Sym (var::MAP getSym xs))` by 4270 (IMP_RES_TAC logic_variable_listp_thm \\ FS [MAP]) 4271 \\ FULL_SIMP_TAC std_ss [set_MAP_SUBSET] \\ POP_ASSUM (K ALL_TAC) \\ FS [] 4272 \\ IMP_RES_TAC logic_term_atblp_thm 4273 \\ `~(fname = "ERROR")` by METIS_TAC [NAME_NOT_ERROR] 4274 \\ Q.ABBREV_TAC `new_axiom = def_axiom fname 4275 (MAP getSym xs,WITNESS_FUN body var,ARB)` 4276 \\ Q.ABBREV_TAC `if_new_axiom = if MEM new_axiom axioms then axioms else new_axiom :: axioms` 4277 \\ Q.ABBREV_TAC `if_new_atbl = if_lookup (Sym fname) atbl (Dot (Dot (Sym fname) (Val (LENGTH xs))) atbl)` 4278 \\ Cases_on `isTrue (lookup (Sym fname) atbl)` THEN1 4279 (Q.EXISTS_TAC `(axioms,thms,atbl,checker,ftbl)` \\ Q.EXISTS_TAC `ctxt` 4280 \\ FS [milawa_inv_def,milawa_state_def,core_state_def] 4281 \\ Q.UNABBREV_TAC `if_new_atbl` \\ FS [if_lookup_def] 4282 \\ FULL_SIMP_TAC std_ss [if_memberp_def] 4283 \\ SIMP_TAC std_ss [GSYM CONJ_ASSOC] 4284 \\ Q.PAT_X_ASSUM `axioms_inv ctxt ftbl axioms` ASSUME_TAC 4285 \\ FS [atbl_ftbl_inv_def] \\ RES_TAC 4286 \\ FS [define_safe_ID] 4287 \\ `?fparams fbody fsem. 4288 func_definition_exists ctxt fname fparams fbody fsem` suffices_by (STRIP_TAC THEN REVERSE STRIP_TAC THEN1 4289 (SUFF_TAC ``fname IN FDOM (ctxt:context_type) UNION {"NOT";"RANK";"ORDP";"ORD<"}`` 4290 THEN1 (FS [witness_ctxt_def,similar_context_def,LET_DEF,getSym_def]) 4291 \\ FS [axioms_inv_def,EVERY_DEF,func_definition_exists_def,IN_UNION,IN_INSERT]) 4292 \\ MATCH_MP_TAC (METIS_PROVE [] ``x ==> ((if x then y else z) = y)``) 4293 \\ FS [axioms_inv_def] \\ Cases_on `fbody` 4294 \\ RES_TAC \\ FS [axioms_aux_def] THEN1 4295 (IMP_RES_TAC MEM_ftbl 4296 \\ IMP_RES_TAC MEM_MEM_ftbl 4297 \\ FS [] \\ FS [sexp2sexp_def,witness_body_def]) 4298 \\ Q.PAT_X_ASSUM `MEM xx axioms` MP_TAC 4299 \\ ASM_SIMP_TAC std_ss [def_axiom_def] 4300 \\ SIMP_TAC std_ss [MEM_MAP] 4301 \\ HO_MATCH_MP_TAC (METIS_PROVE [] ``P x ==> (MEM x xs ==> ?y. P y /\ MEM y xs)``) 4302 \\ FS [f2sexp_def,t2sexp_def] 4303 \\ IMP_RES_TAC MEM_ftbl 4304 \\ IMP_RES_TAC MEM_MEM_ftbl 4305 \\ FS [] \\ FS [sexp2sexp_def,witness_body_def,list2sexp_def,MAP,t2sexp_def] 4306 \\ Cases_on `MEM fname ["NOT";"RANK";"ORDP";"ORD<"]` THEN1 (FS [] \\ EVAL_TAC) 4307 \\ FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 4308 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM] \\ FS [] 4309 \\ FS [func_syntax_ok_def,logic_func2sexp_def,str2func_def,logic_prim2sym_def] 4310 \\ IMP_RES_TAC fake_ftbl_entries \\ FS [fake_ftbl_entries_def]) 4311 \\ Cases_on `MEM fname ["NOT";"RANK";"ORDP";"ORD<"]` THEN1 4312 (ASM_SIMP_TAC std_ss [func_definition_exists_def] 4313 \\ METIS_TAC [lookup_safe_init_ftbl_EXISTS,MEM]) 4314 \\ `(logic_func2sexp (mFun fname) = Sym fname) /\ 4315 func_syntax_ok (mFun fname)` by 4316 (FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 4317 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM] \\ FS [] 4318 \\ FS [func_syntax_ok_def,logic_func2sexp_def,str2func_def] 4319 \\ IMP_RES_TAC fake_ftbl_entries \\ FS [fake_ftbl_entries_def]) 4320 \\ `fname IN FDOM ctxt` by 4321 (CCONTR_TAC \\ Q.PAT_X_ASSUM `atbl_ok ctxt atbl` ASSUME_TAC 4322 \\ FULL_SIMP_TAC std_ss [atbl_ok_def] 4323 \\ POP_ASSUM (MP_TAC o Q.SPEC `mFun fname`) 4324 \\ FS [func_arity_def,CDR_lookup_NOT_NIL]) 4325 \\ `?fparams fbody fsem. ctxt ' fname = (fparams,fbody,fsem)` by METIS_TAC [PAIR] 4326 \\ METIS_TAC [func_definition_exists_def]) 4327 \\ `~MEM fname ["NOT";"RANK";"ORDP";"ORD<"]` by 4328 (STRIP_TAC \\ Q.PAT_X_ASSUM `atbl_ok ctxt atbl` ASSUME_TAC 4329 \\ FS [atbl_ok_def] THENL [ 4330 POP_ASSUM (MP_TAC o Q.SPEC `mPrimitiveFun logic_NOT`) 4331 \\ FS [func_syntax_ok_def,isTrue_def,logic_func2sexp_def, 4332 logic_prim2sym_def,func_arity_def], 4333 POP_ASSUM (MP_TAC o Q.SPEC `mPrimitiveFun logic_RANK`) 4334 \\ FS [func_syntax_ok_def,isTrue_def,logic_func2sexp_def, 4335 logic_prim2sym_def,func_arity_def], 4336 POP_ASSUM (MP_TAC o Q.SPEC `mPrimitiveFun logic_ORDP`) 4337 \\ FS [func_syntax_ok_def,isTrue_def,logic_func2sexp_def, 4338 logic_prim2sym_def,func_arity_def], 4339 POP_ASSUM (MP_TAC o Q.SPEC `mPrimitiveFun logic_ORD_LESS`) 4340 \\ FS [func_syntax_ok_def,isTrue_def,logic_func2sexp_def, 4341 logic_prim2sym_def,func_arity_def]]) 4342 \\ FS [if_lookup_def] 4343 \\ Q.ABBREV_TAC `r = 4344 (Dot (Sym "ERROR") (Dot (Dot (Sym "QUOTE") (Dot (Dot (Sym fname) 4345 (Dot (Sym var) (Dot (list2sexp xs) (Dot raw_body (Sym "NIL"))))) 4346 (Sym "NIL"))) (Sym "NIL")))` 4347 \\ Q.EXISTS_TAC `(if_new_axiom,thms,if_new_atbl,checker, 4348 FST (define_safe ftbl (Sym fname) (list2sexp xs) r k io T))` 4349 \\ Q.ABBREV_TAC `ef = \args. 4350 @v. isTrue (EvalTerm (FunVarBind (var::MAP getSym xs) (v::args),ctxt) body)` 4351 \\ Q.EXISTS_TAC `ctxt |+ (fname,MAP getSym xs,WITNESS_FUN body var,ef)` 4352 \\ IMP_RES_TAC fake_ftbl_entries 4353 \\ STRIP_TAC THEN1 4354 (UNABBREV_ALL_TAC \\ FS [milawa_state_def,core_state_def] \\ FS [if_memberp_def] 4355 \\ FS [MEM,fake_ftbl_entries_def] 4356 \\ (EVAL ``f2sexp (def_axiom fname (MAP getSym xs,WITNESS_FUN body var,ARB))`` 4357 |> GSYM |> MP_TAC) \\ FS [logic_func2sexp_def] 4358 \\ `~(fname = "NIL") /\ ~(fname = "QUOTE")` by 4359 (REPEAT STRIP_TAC 4360 \\ FULL_SIMP_TAC std_ss [logic_function_namep_def,GSYM list2sexp_def, 4361 memberp_thm,MEM] \\ FS []) \\ FS [] \\ STRIP_TAC \\ POP_ASSUM (K ALL_TAC) 4362 \\ SRW_TAC [] [] \\ FS []) 4363 \\ FULL_SIMP_TAC std_ss [milawa_inv_def] 4364 \\ `~(fname IN FDOM ctxt)` by 4365 (REPEAT STRIP_TAC \\ Q.PAT_X_ASSUM `atbl_ok ctxt atbl` MP_TAC 4366 \\ FS [atbl_ok_def] \\ Q.EXISTS_TAC `mFun fname` 4367 \\ FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 4368 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM] \\ FS [] 4369 \\ STRIP_TAC THEN1 (EVAL_TAC \\ FS []) 4370 \\ ASM_SIMP_TAC std_ss [logic_func2sexp_def,MEM] \\ FS [isTrue_def] 4371 \\ FS [func_arity_def]) 4372 \\ `atbl_ok (ctxt |+ (fname,MAP getSym xs,WITNESS_FUN body var,ef)) if_new_atbl` by 4373 (FS [atbl_ok_def] \\ REPEAT STRIP_TAC \\ RES_TAC \\ Q.UNABBREV_TAC `if_new_atbl` 4374 \\ Cases_on `f` \\ FULL_SIMP_TAC std_ss [func_arity_def] 4375 \\ `!l. ~(logic_func2sexp (mPrimitiveFun l) = Sym fname)` by 4376 (FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 4377 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM] \\ FS [] 4378 \\ Cases \\ EVAL_TAC \\ FS []) \\ FS [] 4379 \\ ONCE_REWRITE_TAC [lookup_def] \\ FS [] 4380 \\ `(logic_func2sexp (mFun s) = Sym fname) = (s = fname)` by 4381 (FULL_SIMP_TAC std_ss [logic_func2sexp_def] \\ SRW_TAC [] [] 4382 \\ FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 4383 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM] \\ FS []) 4384 \\ FS [FDOM_FUPDATE,IN_INSERT,FAPPLY_FUPDATE_THM] 4385 \\ Cases_on `s = fname` \\ FS [LENGTH_MAP]) 4386 \\ `definition_ok (fname,MAP getSym xs,WITNESS_FUN body var,ctxt)` by 4387 (FS [definition_ok_def] \\ FS [ALL_DISTINCT_LEMMA]) \\ FS [] 4388 \\ `thms_inv (ctxt |+ (fname,MAP getSym xs,WITNESS_FUN body var,ef)) thms` by 4389 (FS [thms_inv_def,EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC 4390 \\ IMP_RES_TAC MilawaTrue_new_definition \\ METIS_TAC []) 4391 \\ `thms_inv (ctxt |+ (fname,MAP getSym xs,WITNESS_FUN body var,ef)) axioms` by 4392 (FS [thms_inv_def,EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC 4393 \\ IMP_RES_TAC MilawaTrue_new_definition \\ METIS_TAC []) \\ FS [] 4394 \\ PUSH_STRIP_TAC THEN1 4395 (Q.UNABBREV_TAC `ef` \\ MATCH_MP_TAC definition_ok_WITNESS_FUN 4396 \\ ASM_SIMP_TAC std_ss []) 4397 \\ PUSH_STRIP_TAC THEN1 4398 (FS [context_inv_def] \\ STRIP_TAC \\ STRIP_TAC \\ Cases_on `fname = fname'` 4399 \\ FULL_SIMP_TAC (srw_ss()) [FAPPLY_FUPDATE_THM] \\ REPEAT STRIP_TAC 4400 THEN1 (`term_ok ctxt body'` by (FS [context_ok_def] \\ RES_TAC \\ NO_TAC) 4401 \\ METIS_TAC [EvalFun_FUPDATE]) 4402 THEN1 (Q.UNABBREV_TAC `ef` \\ FS [GSYM EvalTerm_FUPDATE]) 4403 \\ REPEAT STRIP_TAC \\ FS [context_inv_def] \\ RES_TAC \\ FS [] 4404 \\ `term_ok ctxt body'` by (FS [context_ok_def] \\ RES_TAC \\ NO_TAC) 4405 \\ FS [GSYM EvalTerm_FUPDATE]) 4406 \\ PUSH_STRIP_TAC THEN1 4407 (IMP_RES_TAC similar_context_definition_ok 4408 \\ FS [similar_context_def,witness_ctxt_def,getSym_def,LET_DEF] 4409 \\ `~(fname IN FDOM ctxt UNION {"NOT"; "RANK"; "ORDP"; "ORD<"})` by FS [IN_INSERT,IN_UNION,NOT_IN_EMPTY] \\ FS [FDOM_FUPDATE] 4410 \\ FS [sexp2t_t2sexp_thm] \\ STRIP_TAC THEN1 (METIS_TAC [definition_ok_thm]) 4411 \\ FS [FEVERY_DEF,FDOM_FUPDATE,IN_INSERT,FAPPLY_FUPDATE_THM] \\ STRIP_TAC 4412 \\ Cases_on `x' = fname` \\ FS [] 4413 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ REPEAT STRIP_TAC 4414 \\ Q.PAT_X_ASSUM `FDOM simple_ctxt = FDOM ctxt` ASSUME_TAC \\ FS [] 4415 \\ RES_TAC \\ POP_ASSUM MP_TAC 4416 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ REPEAT STRIP_TAC 4417 \\ FS []) 4418 \\ PUSH_STRIP_TAC THEN1 4419 (Q.UNABBREV_TAC `if_new_atbl` \\ FS [atbl_inv_def,EVERY_DEF,sexp2list_def]) 4420 \\ `func2f (Fun fname) = mFun fname` by 4421 (FS [fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 4422 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM,func2f_def]) 4423 \\ `str2func fname = mFun fname` by 4424 (FS [fake_ftbl_entries_def,str2func_def] \\ FULL_SIMP_TAC std_ss 4425 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM,func2f_def]) 4426 \\ PUSH_STRIP_TAC THEN1 4427 (Q.UNABBREV_TAC `if_new_axiom` 4428 \\ `thms_inv (ctxt |+ (fname,MAP getSym xs,WITNESS_FUN body var,ef)) (new_axiom::axioms)` suffices_by 4429 (STRIP_TAC THEN FS [thms_inv_def,EVERY_DEF] \\ SRW_TAC [] [EVERY_DEF]) 4430 \\ FS [thms_inv_def,EVERY_DEF] \\ REPEAT STRIP_TAC \\ Q.UNABBREV_TAC `new_axiom` 4431 \\ FULL_SIMP_TAC std_ss [def_axiom_def] THEN1 4432 (((CONJUNCTS MilawaTrue_rules) 4433 |> filter (can (find_term (fn tm => tm = ``WITNESS_FUN``) o concl)) 4434 |> hd |> MATCH_MP_TAC) 4435 \\ Q.EXISTS_TAC `ef` \\ FULL_SIMP_TAC std_ss [ALL_DISTINCT_LEMMA] 4436 \\ FS [FDOM_FUPDATE,IN_INSERT,FAPPLY_FUPDATE_THM] 4437 \\ MATCH_MP_TAC term_ok_IMP_FUPDATE \\ FS []) 4438 \\ FULL_SIMP_TAC std_ss [formula_syntax_ok_def,term_syntax_ok_def,LENGTH, 4439 LENGTH_MAP,ALL_DISTINCT_LEMMA,EVERY_DEF,func_syntax_ok_def,MEM] 4440 \\ FS [fake_ftbl_entries_def,str2func_def] \\ FULL_SIMP_TAC std_ss 4441 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM,func2f_def] 4442 \\ FS [] \\ SIMP_TAC std_ss [EVERY_MEM,MEM_MAP] \\ REPEAT STRIP_TAC 4443 \\ FS [term_syntax_ok_def] 4444 \\ IMP_RES_TAC logic_variable_listp_NOT_NIL 4445 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,logic_variablep_EQ_var_ok]) 4446 \\ PUSH_STRIP_TAC THEN1 4447 (Cases_on `(FST (SND (define_safe ftbl (Sym fname) (list2sexp xs) r k io T))) = k` 4448 \\ FULL_SIMP_TAC std_ss [] 4449 \\ `?new_def. (FST (SND (define_safe ftbl (Sym fname) (list2sexp xs) r k io T))) = 4450 add_def k new_def` by 4451 (FULL_SIMP_TAC std_ss [define_safe_def,LET_DEF] \\ METIS_TAC []) 4452 \\ FULL_SIMP_TAC std_ss [] 4453 \\ Q.PAT_X_ASSUM `core_check_proof_inv checker k` MP_TAC 4454 \\ METIS_TAC [core_check_proof_inv_step]) 4455 \\ PUSH_STRIP_TAC THEN1 4456 (FS [define_safe_def,LET_DEF] 4457 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` \\ FS [] 4458 \\ FS [ftbl_inv_def,getSym_def] 4459 \\ REVERSE STRIP_TAC THEN1 4460 (FS [sexp2list_def,EVERY_DEF] 4461 \\ ONCE_REWRITE_TAC [lookup_safe_def] \\ FS [EVERY_MEM] 4462 \\ REPEAT STRIP_TAC \\ SRW_TAC [] [] \\ FS [lookup_safe_EQ_MEM] 4463 \\ Q.EXISTS_TAC `SUC old` \\ FS [FUNPOW]) 4464 \\ SIMP_TAC std_ss [sexp2list_def,EVERY_DEF] 4465 \\ STRIP_TAC THEN1 4466 (FS [LET_DEF,getSym_def,add_def_def,FDOM_FUNION, 4467 IN_UNION,FDOM_FEMPTY,FDOM_FUPDATE, 4468 IN_INSERT,FUNION_DEF,FAPPLY_FUPDATE_THM]) 4469 \\ FS [EVERY_MEM] \\ REPEAT STRIP_TAC \\ RES_TAC THEN1 4470 (FS [LET_DEF,getSym_def,add_def_def,FDOM_FUNION, 4471 IN_UNION,FDOM_FEMPTY,FDOM_FUPDATE, 4472 IN_INSERT,FUNION_DEF,FAPPLY_FUPDATE_THM])) 4473 \\ PUSH_STRIP_TAC THEN1 4474 (FULL_SIMP_TAC std_ss [axioms_inv_def] \\ STRIP_TAC 4475 THEN1 (FULL_SIMP_TAC (srw_ss()) []) 4476 \\ FS [axioms_inv_def,FDOM_FUPDATE,FAPPLY_FUPDATE_THM] \\ STRIP_TAC 4477 \\ REVERSE (Cases_on `name = fname`) \\ FS [IN_INSERT] 4478 \\ FS [func_definition_exists_NEQ] THEN1 4479 (REPEAT STRIP_TAC \\ Q.PAT_X_ASSUM `!name params body sem. bbb` IMP_RES_TAC 4480 \\ REVERSE (Cases_on `body'`) \\ FULL_SIMP_TAC std_ss [axioms_aux_def] THEN1 4481 (Q.EXISTS_TAC `raw_body'` \\ POP_ASSUM MP_TAC \\ FS [] \\ STRIP_TAC 4482 \\ STRIP_TAC THEN1 4483 (FS [define_safe_def,LET_DEF] 4484 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` 4485 \\ FS [sexp2list_def,MEM]) 4486 \\ Q.UNABBREV_TAC `if_new_axiom` \\ METIS_TAC [MEM]) 4487 \\ Q.EXISTS_TAC `raw_body'` \\ POP_ASSUM MP_TAC \\ FS [] \\ STRIP_TAC 4488 \\ STRIP_TAC THEN1 4489 (FS [define_safe_def,LET_DEF] 4490 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` 4491 \\ FS [sexp2list_def,MEM]) 4492 \\ STRIP_TAC THEN1 (Q.UNABBREV_TAC `if_new_axiom` \\ METIS_TAC [MEM]) 4493 \\ Cases_on `MEM name ["NOT"; "RANK"; "ORD<"; "ORDP"]` 4494 THEN1 (FS [logic_func_inv_def]) 4495 \\ `name IN FDOM ctxt` by METIS_TAC [func_definition_exists_def] 4496 \\ MATCH_MP_TAC logic_func_inv_NEQ \\ FS [sexp2sexp_def] 4497 \\ FS [func_definition_exists_def] 4498 \\ METIS_TAC [context_ok_def]) 4499 \\ FS [func_definition_exists_EQ,MEM,axioms_aux_def] 4500 \\ Q.EXISTS_TAC `raw_body` \\ FS [] \\ REPEAT STRIP_TAC THEN1 4501 (FS [define_safe_def,LET_DEF] 4502 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` \\ FS [sexp2list_def,MEM] 4503 \\ FULL_SIMP_TAC std_ss [witness_body_def,list2sexp_def] \\ Q.UNABBREV_TAC `r` 4504 \\ IMP_RES_TAC logic_variable_listp_thm \\ ASM_SIMP_TAC std_ss [] 4505 \\ Q.PAT_X_ASSUM `lookup_safe (Sym fname) ftbl = bb` (ASSUME_TAC o GSYM) 4506 \\ FS [ftbl_inv_def] \\ FULL_SIMP_TAC std_ss [isTrue_lookup_safe]) 4507 THEN1 (FS [sexp2sexp_def]) THEN1 4508 (FS [sexp2sexp_def] 4509 \\ Q.UNABBREV_TAC `if_new_axiom` \\ Q.UNABBREV_TAC `new_axiom` 4510 \\ `(func2f (Fun fname) = mFun fname) /\ (str2func fname = mFun fname)` by 4511 (FS [str2func_def,fake_ftbl_entries_def] \\ FULL_SIMP_TAC std_ss 4512 [logic_function_namep_def,GSYM list2sexp_def,memberp_thm,MEM,func2f_def]) 4513 \\ FULL_SIMP_TAC std_ss [def_axiom_def] 4514 \\ SRW_TAC [] [])) 4515 \\ PUSH_STRIP_TAC THEN1 4516 (FS [atbl_ftbl_inv_def] \\ Q.UNABBREV_TAC `if_new_atbl` \\ FS [] 4517 \\ ONCE_REWRITE_TAC [lookup_def] \\ FS [] \\ STRIP_TAC 4518 \\ Cases_on `fname' = fname` \\ FS [] THEN1 4519 (FS [define_safe_def,LET_DEF] 4520 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` \\ FS [] 4521 \\ ASM_SIMP_TAC std_ss [lookup_safe_EQ_MEM] 4522 \\ FS [sexp2list_def,MAP,MEM] 4523 \\ ONCE_REWRITE_TAC [lookup_safe_def] 4524 \\ FS [] \\ FS [isTrue_def]) 4525 \\ STRIP_TAC \\ RES_TAC 4526 \\ FS [define_safe_def,LET_DEF] 4527 \\ Cases_on `isTrue (lookup_safe (Sym fname) ftbl)` \\ FS [] 4528 \\ FS [sexp2list_def,MAP]) 4529 \\ STRIP_TAC THEN1 (* runtime_inv *) 4530 (SIMP_TAC std_ss [runtime_inv_def] \\ REPEAT STRIP_TAC 4531 \\ FULL_SIMP_TAC std_ss [FDOM_FUPDATE] 4532 \\ REVERSE (Cases_on `fname = name`) \\ FULL_SIMP_TAC std_ss [] THEN1 4533 (FULL_SIMP_TAC std_ss [IN_INSERT,FAPPLY_FUPDATE_THM,runtime_inv_def] 4534 \\ `?ok2. MR_ap (Fun name,args,ARB,ctxt,k,ok') (sem args,ok2) /\ 4535 (ok2 ==> MilawaTrueFun ctxt name args (sem args))` by METIS_TAC [] 4536 \\ Q.EXISTS_TAC `ok2` \\ ASM_SIMP_TAC std_ss [] \\ STRIP_TAC THEN1 4537 (MATCH_MP_TAC MR_ap_CTXT 4538 \\ FULL_SIMP_TAC std_ss [] 4539 \\ RES_TAC \\ SIMP_TAC std_ss [define_safe_def,LET_DEF] \\ SRW_TAC [] [] 4540 \\ METIS_TAC [MR_ev_add_def]) 4541 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [MilawaTrueFun_def] 4542 \\ METIS_TAC [MilawaTrue_new_definition]) 4543 \\ FULL_SIMP_TAC std_ss [IN_INSERT,FAPPLY_FUPDATE_THM] 4544 \\ Q.ABBREV_TAC `k2 = FST (SND (define_safe ftbl (Sym name) (list2sexp xs) r k io T))` 4545 \\ Q.ABBREV_TAC `ftbl2 = (FST (define_safe ftbl (Sym name) (list2sexp xs) r k io T))` 4546 \\ Q.ABBREV_TAC `ctxt2 = (ctxt |+ (name,params,body',sem))` 4547 \\ Q.EXISTS_TAC `F` \\ SIMP_TAC std_ss [] 4548 \\ FULL_SIMP_TAC std_ss [axioms_inv_def] 4549 \\ Q.PAT_X_ASSUM `xxx = body'` (ASSUME_TAC o GSYM) 4550 \\ `func_definition_exists ctxt2 name params (WITNESS_FUN body var) sem` by 4551 (FULL_SIMP_TAC std_ss [func_definition_exists_def] 4552 \\ Q.UNABBREV_TAC `ctxt2` \\ EVAL_TAC) 4553 \\ RES_TAC \\ FULL_SIMP_TAC std_ss [axioms_aux_def] 4554 \\ FULL_SIMP_TAC std_ss [ftbl_inv_def,EVERY_MEM] 4555 \\ RES_TAC \\ FS [LET_DEF,isTrue_def,getSym_def,MAP_getSym_Sym] 4556 \\ ONCE_REWRITE_TAC [MR_ev_cases] \\ FULL_SIMP_TAC (srw_ss()) [] 4557 \\ SIMP_TAC std_ss [EVAL ``sexp2term (witness_body name var params raw_body')``] 4558 \\ SIMP_TAC (srw_ss()) [] 4559 \\ Q.UNABBREV_TAC `ctxt2` \\ SIMP_TAC (srw_ss()) []) 4560 THEN1 (* core_assums *) 4561 (SIMP_TAC std_ss [define_safe_def,LET_DEF] \\ SRW_TAC [] [] 4562 \\ Q.PAT_X_ASSUM `core_assum kk` MP_TAC 4563 \\ ONCE_REWRITE_TAC [milawa_initTheory.core_assum_def] 4564 \\ MATCH_MP_TAC (METIS_PROVE [] ``(!x. f a x ==> f b x) ==> (f a x ==> f b x)``) 4565 \\ SIMP_TAC std_ss [fns_assum_add_def_IMP])); 4566 4567 4568(* admit switch *) 4569 4570val lookup_lemma1 = SR [] milawa_defsTheory.lookup_def 4571val lookup_lemma2 = lookup_lemma1 |> Q.INST [`x`|->`Sym t`] |> SR [isDot_def] 4572val lookup_lemma2a = lookup_lemma1 |> Q.INST [`x`|->`Val t`] |> SR [isDot_def] 4573val lookup_lemma3 = lookup_lemma1 4574 |> Q.INST [`x`|->`Dot (Dot (Sym s) y) z`,`a`|->`Sym t`] 4575 |> SR [isDot_def,CAR_def,CDR_def,SExp_11] 4576 4577val lookup_provablep = 4578 ``lookup (Sym "LOGIC.PROVABLEP") init_ftbl`` 4579 |> (ONCE_REWRITE_CONV [milawa_initTheory.init_ftbl_def] THENC 4580 REWRITE_CONV [lookup_lemma2,lookup_lemma3,CONS_11,NOT_CONS_NIL,NOT_NIL_CONS] THENC 4581 SIMP_CONV (srw_ss()) []); 4582 4583val lookup_provablep_body = lookup_provablep |> concl |> dest_comb |> snd 4584 |> dest_comb |> snd |> dest_comb |> snd |> dest_comb |> fst |> dest_comb |> snd 4585 4586val lookup_provablep_body_def = Define ` 4587 lookup_provablep_body = ^lookup_provablep_body`; 4588 4589val lookup_provablep_thm = 4590 REWRITE_RULE [GSYM lookup_provablep_body_def] lookup_provablep 4591 4592val lookup_provable_witness = 4593 ``lookup (Sym "LOGIC.PROVABLE-WITNESS") init_ftbl`` 4594 |> (ONCE_REWRITE_CONV [milawa_initTheory.init_ftbl_def] THENC 4595 REWRITE_CONV [lookup_lemma2,lookup_lemma3,CONS_11,NOT_CONS_NIL,NOT_NIL_CONS] THENC 4596 SIMP_CONV (srw_ss()) []); 4597 4598val lookup_provable_witness_body = lookup_provable_witness |> concl 4599 |> dest_comb |> snd |> dest_comb |> snd |> dest_comb |> snd 4600 |> dest_comb |> fst |> dest_comb |> snd |> dest_comb |> snd 4601 |> dest_comb |> fst |> dest_comb |> snd 4602 |> dest_comb |> snd |> dest_comb |> fst |> dest_comb |> snd 4603 4604val lookup_provable_witness_body_def = Define ` 4605 lookup_provable_witness_body = ^lookup_provable_witness_body`; 4606 4607val lookup_provable_witness_thm = 4608 REWRITE_RULE [GSYM lookup_provable_witness_body_def] lookup_provable_witness 4609 4610val lookup_init_ftbl_lemma = prove( 4611 ``!ftbl. 4612 (lookup name ftbl = Dot name (Dot params (Dot body (Sym "NIL")))) ==> 4613 MEM (list2sexp [name; params; body]) (sexp2list ftbl)``, 4614 REVERSE Induct \\ FS [lookup_lemma2,lookup_lemma2a] 4615 \\ ONCE_REWRITE_TAC [lookup_def] \\ FS [] 4616 \\ REVERSE (Cases_on `name = CAR ftbl`) \\ FS [] 4617 THEN1 (REPEAT STRIP_TAC \\ RES_TAC \\ FULL_SIMP_TAC std_ss [sexp2list_def,MEM]) 4618 \\ Cases_on `ftbl` \\ FS [sexp2list_def,MEM]); 4619 4620val FUNPOW_CDR = prove( 4621 ``!n. FUNPOW CDR n (Sym "NIL") = Sym "NIL"``, 4622 Induct \\ FS [FUNPOW]); 4623 4624val MEM_init_ftbl_IMP = prove( 4625 ``MEM x (sexp2list init_ftbl) /\ ftbl_inv k ftbl ==> 4626 MEM x (sexp2list ftbl)``, 4627 REPEAT STRIP_TAC \\ Q.PAT_X_ASSUM `MEM x (sexp2list init_ftbl)` MP_TAC 4628 \\ FULL_SIMP_TAC std_ss [ftbl_inv_def] \\ POP_ASSUM MP_TAC 4629 \\ REPEAT (POP_ASSUM (K ALL_TAC)) 4630 \\ Q.SPEC_TAC (`ftbl`,`ftbl`) 4631 \\ Q.SPEC_TAC (`old`,`n`) 4632 \\ Induct \\ SIMP_TAC (srw_ss()) [FUNPOW] 4633 \\ Cases \\ FS [sexp2list_def,MEM,FUNPOW_CDR] 4634 \\ ONCE_REWRITE_TAC [milawa_initTheory.init_ftbl_def] 4635 \\ REWRITE_TAC [GSYM SExp_distinct]); 4636 4637val MEM_EQ_APPEND = prove( 4638 ``!xs x. MEM x xs ==> ?ys zs. xs = ys ++ x :: zs``, 4639 Induct \\ SIMP_TAC std_ss [MEM] \\ REPEAT STRIP_TAC 4640 \\ FULL_SIMP_TAC std_ss [] \\ METIS_TAC [APPEND_NIL,APPEND]); 4641 4642val MEM_ftbl_11 = prove( 4643 ``MEM (list2sexp [x1;x2;x3]) (sexp2list ftbl) /\ ftbl_inv k ftbl /\ 4644 MEM (list2sexp [x1;y2;y3]) (sexp2list ftbl) ==> 4645 (x2=y2) /\ (x3=y3)``, 4646 SIMP_TAC std_ss [ftbl_inv_def] \\ STRIP_TAC 4647 \\ `?ys zs. sexp2list ftbl = ys ++ (list2sexp [x1; y2; y3]) :: zs` by 4648 METIS_TAC [MEM_EQ_APPEND] 4649 \\ FULL_SIMP_TAC std_ss [ALL_DISTINCT_APPEND,MAP,CAR_def,MAP_APPEND, 4650 list2sexp_def,ALL_DISTINCT,MEM,MEM_APPEND,MEM_MAP,PULL_EXISTS_IMP] 4651 \\ RES_TAC \\ FULL_SIMP_TAC std_ss [CAR_def] \\ FS [] \\ METIS_TAC [CAR_def]); 4652 4653val lookup_init_lemma = prove( 4654 ``(lookup name init_ftbl = Dot name (Dot params (Dot body (Sym "NIL")))) ==> 4655 MEM (list2sexp [name; params2; body2]) (sexp2list ftbl) /\ ftbl_inv k ftbl ==> 4656 (params2 = params) /\ (body2 = body)``, 4657 REPEAT STRIP_TAC 4658 \\ IMP_RES_TAC lookup_init_ftbl_lemma 4659 \\ IMP_RES_TAC MEM_init_ftbl_IMP 4660 \\ IMP_RES_TAC MEM_ftbl_11); 4661 4662val core_admit_switch_lemma = prove( 4663 ``(@y. ~b /\ (x = y) \/ b /\ (~c /\ (x = y) \/ c /\ (y = d))) = 4664 if ~b then x else if ~c then x else d``, 4665 Cases_on `b` \\ Cases_on `c` \\ SIMP_TAC std_ss []) 4666 4667val core_admit_switch_thm = prove( 4668 ``milawa_inv ctxt simple_ctxt k (axioms,thms,atbl,checker,ftbl) ==> 4669 ?x io2 ok2 result. 4670 core_admit_switch_side cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok /\ 4671 (core_admit_switch cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok = 4672 (x,k,io2,ok2)) /\ 4673 (ok2 ==> (io2 = io) /\ 4674 ?result. (x = milawa_state result) /\ milawa_inv ctxt simple_ctxt k result)``, 4675 FS [core_admit_switch_def,LET_DEF,milawa_state_def,core_state_def, 4676 SIMP_RULE std_ss [DISJ_EQ_IMP,GSYM AND_IMP_INTRO,LET_DEF] core_admit_switch_side_def] 4677 \\ SRW_TAC [] [] \\ FS [] \\ FS [] 4678 \\ Q.EXISTS_TAC `(axioms,thms,atbl,CAR (CDR cmd),ftbl)` 4679 \\ STRIP_TAC THEN1 (FS [milawa_state_def,core_state_def]) 4680 \\ FS [milawa_inv_def] 4681 \\ `?name. CAR (CDR cmd) = Sym name` by 4682 (Cases_on `CAR (CDR cmd)` \\ FS [logic_function_namep_def]) 4683 \\ FS [] \\ SIMP_TAC std_ss [core_check_proof_inv_def] 4684 \\ Q.EXISTS_TAC `name` \\ FULL_SIMP_TAC std_ss [] \\ REPEAT STRIP_TAC 4685 \\ POP_ASSUM (K ALL_TAC) \\ POP_ASSUM MP_TAC 4686 \\ FS [logic_soundness_claim_def,logic_por_def] 4687 \\ `?g. Sym name = logic_func2sexp g` by 4688 (Cases_on `name = "NOT"` THEN1 4689 (Q.EXISTS_TAC `mPrimitiveFun logic_NOT` \\ EVAL_TAC \\ ASM_SIMP_TAC std_ss []) 4690 \\ Cases_on `name = "RANK"` THEN1 4691 (Q.EXISTS_TAC `mPrimitiveFun logic_RANK` \\ EVAL_TAC \\ ASM_SIMP_TAC std_ss []) 4692 \\ Cases_on `name = "ORDP"` THEN1 4693 (Q.EXISTS_TAC `mPrimitiveFun logic_ORDP` \\ EVAL_TAC \\ ASM_SIMP_TAC std_ss []) 4694 \\ Cases_on `name = "ORD<"` THEN1 4695 (Q.EXISTS_TAC `mPrimitiveFun logic_ORD_LESS` \\ EVAL_TAC \\ ASM_SIMP_TAC std_ss []) 4696 \\ Cases_on `name = "IF"` THEN1 4697 (Q.EXISTS_TAC `mPrimitiveFun logic_IF` \\ EVAL_TAC \\ ASM_SIMP_TAC std_ss []) 4698 \\ FS [logic_function_namep_def] 4699 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,memberp_thm,MEM] \\ FS [] 4700 \\ REVERSE (Cases_on `sym2prim name`) THEN1 4701 (Q.EXISTS_TAC `mPrimitiveFun (prim2p (THE (sym2prim name)))` 4702 \\ FULL_SIMP_TAC std_ss [sym2prim_def] \\ POP_ASSUM MP_TAC 4703 \\ SRW_TAC [] [] \\ EVAL_TAC) 4704 \\ Q.EXISTS_TAC `mFun name` 4705 \\ ASM_SIMP_TAC std_ss [logic_func2sexp_def,MEM] 4706 \\ SRW_TAC [] [] \\ POP_ASSUM MP_TAC \\ EVAL_TAC) 4707 \\ FULL_SIMP_TAC std_ss [] 4708 \\ SIMP_TAC std_ss [GSYM list2sexp_def, 4709 GSYM (EVAL ``t2sexp (mVar "X")``), 4710 GSYM (EVAL ``t2sexp (mVar "ATBL")``), 4711 GSYM (EVAL ``t2sexp (mVar "THMS")``), 4712 GSYM (EVAL ``t2sexp (mVar "AXIOMS")``), 4713 GSYM (EVAL ``logic_func2sexp (mFun "LOGIC.PROVABLEP")``), 4714 GSYM (EVAL ``logic_func2sexp (mFun "LOGIC.APPEALP")``), 4715 GSYM (EVAL ``logic_func2sexp (mFun "LOGIC.CONCLUSION")``), 4716 EVAL ``t2sexp (mApp f [x1])`` |> REWRITE_RULE [GSYM list2sexp_def] |> GSYM, 4717 EVAL ``t2sexp (mApp f [x1;x2])`` |> REWRITE_RULE [GSYM list2sexp_def] |> GSYM, 4718 EVAL ``t2sexp (mApp f [x1;x2;x3])`` |> REWRITE_RULE [GSYM list2sexp_def] |> GSYM, 4719 EVAL ``t2sexp (mApp f [x1;x2;x3;x4])`` |> REWRITE_RULE [GSYM list2sexp_def] |> GSYM] 4720 \\ SIMP_TAC std_ss [CONJUNCT1 (GSYM t2sexp_def),GSYM f2sexp_def] 4721 \\ FS [MEM_MAP] \\ STRIP_TAC \\ FS [thms_inv_def,EVERY_MEM] 4722 \\ RES_TAC \\ POP_ASSUM MP_TAC \\ POP_ASSUM (K ALL_TAC) \\ POP_ASSUM (K ALL_TAC) 4723 \\ STRIP_TAC 4724 \\ IMP_RES_TAC MilawaTrue_IMP_formula_ok 4725 \\ FS [term_ok_def,formula_ok_def,EVERY_DEF,LENGTH,func_arity_def] 4726 \\ `g = mFun name` by 4727 (Cases_on `g` 4728 THEN1 (Cases_on `l` \\ FULL_SIMP_TAC std_ss [func_arity_def,primitive_arity_def]) 4729 \\ SIMP_TAC (srw_ss()) [] \\ CCONTR_TAC 4730 \\ Q.PAT_X_ASSUM `isTrue (logic_function_namep (logic_func2sexp (mFun s)))` MP_TAC 4731 \\ SIMP_TAC std_ss [] 4732 \\ ASM_SIMP_TAC std_ss [logic_func2sexp_def,MEM] 4733 \\ SRW_TAC [] [] 4734 \\ FULL_SIMP_TAC (srw_ss()) [logic_func2sexp_def]) 4735 \\ FULL_SIMP_TAC std_ss [] \\ POP_ASSUM (K ALL_TAC) 4736 \\ FULL_SIMP_TAC std_ss [func_arity_def] 4737 \\ IMP_RES_TAC Milawa_SOUNDESS 4738 \\ FULL_SIMP_TAC std_ss [MilawaValid_def,EvalFormula_def,EvalTerm_def, 4739 EvalApp_def,MAP,LET_DEF] 4740 \\ `?x1 x2 appealp. ctxt ' "LOGIC.APPEALP" = (x1,x2,appealp)` by METIS_TAC [PAIR] 4741 \\ `?y1 y2 f. ctxt ' name = (y1,y2,f)` by METIS_TAC [PAIR] 4742 \\ `?z1 z2 provablep. ctxt ' "LOGIC.PROVABLEP" = (z1,z2,provablep)` by METIS_TAC [PAIR] 4743 \\ `?q1 q2 conclusion. ctxt ' "LOGIC.CONCLUSION" = (q1,q2,conclusion)` by METIS_TAC [PAIR] 4744 \\ FULL_SIMP_TAC std_ss [] 4745 \\ FULL_SIMP_TAC std_ss [formula_ok_def,term_ok_def,func_arity_def,EVERY_DEF,LENGTH] 4746 \\ FULL_SIMP_TAC std_ss [runtime_inv_def] 4747 \\ Q.PAT_X_ASSUM `!name params. bbb` (fn th => MP_TAC th THEN MP_TAC (Q.SPEC `name` th)) 4748 \\ FS [] \\ STRIP_TAC 4749 \\ POP_ASSUM (MP_TAC o Q.SPECL [`[x1;x2;x3;x4]`,`ok`]) 4750 \\ SIMP_TAC std_ss [LENGTH] \\ REPEAT STRIP_TAC 4751 \\ Q.LIST_EXISTS_TAC [`f [x1; x2; x3; x4]`,`ok2`] \\ ASM_SIMP_TAC std_ss [] 4752 \\ CONV_TAC (DEPTH_CONV ETA_CONV) 4753 \\ FULL_SIMP_TAC std_ss [GSYM thms_inv_def,GSYM EVERY_MEM] 4754 \\ CONV_TAC (DEPTH_CONV ETA_CONV) 4755 \\ FULL_SIMP_TAC std_ss [GSYM thms_inv_def] 4756 \\ REVERSE (Cases_on `ok2`) \\ FS [] THEN1 METIS_TAC [MR_IMP_R] 4757 \\ Q.PAT_X_ASSUM `!a:string->SExp.bbb` (MP_TAC o Q.SPEC `("X" =+ x1) (("AXIOMS" =+ x2) 4758 (("THMS" =+ x3) (("ATBL" =+ x4) (\x. ARB))))`) 4759 \\ FS [APPLY_UPDATE_THM] \\ FULL_SIMP_TAC (srw_ss()) [] 4760 \\ REPEAT (Q.PAT_X_ASSUM `T` (K ALL_TAC)) 4761 \\ FULL_SIMP_TAC std_ss [runtime_inv_def] 4762 \\ Q.PAT_X_ASSUM `!name params. bbb` (fn th => MP_TAC th THEN MP_TAC (Q.SPEC `name` th)) 4763 \\ FS [] \\ STRIP_TAC 4764 \\ POP_ASSUM (MP_TAC o Q.SPECL [`[x1;x2;x3;x4]`,`ok`]) 4765 \\ SIMP_TAC std_ss [LENGTH] \\ STRIP_TAC \\ STRIP_TAC 4766 \\ `!w1. appealp [w1] = logic_appealp w1` by 4767 (REPEAT STRIP_TAC \\ POP_ASSUM (MP_TAC o Q.SPEC `"LOGIC.APPEALP"`) \\ FS [] 4768 \\ STRIP_TAC \\ POP_ASSUM (MP_TAC o Q.SPECL [`[w1]`,`T`]) 4769 \\ SIMP_TAC std_ss [LENGTH] \\ STRIP_TAC 4770 \\ IMP_RES_TAC (MR_IMP_R |> CONJUNCTS |> hd |> SPEC_ALL |> Q.INST [`f`|->`Fun (x::xs)`]) 4771 \\ POP_ASSUM (STRIP_ASSUME_TAC o Q.SPEC `io`) 4772 \\ METIS_TAC [R_ap_T_11,R_ev_logic_appealp,PAIR_EQ,MR_IMP_R]) 4773 \\ `!w1. conclusion [w1] = logic_conclusion w1` by 4774 (REPEAT STRIP_TAC 4775 \\ Q.PAT_X_ASSUM `!name params body sem args ok. bbb` (MP_TAC o Q.SPEC `"LOGIC.CONCLUSION"`) \\ FS [] 4776 \\ STRIP_TAC \\ POP_ASSUM (MP_TAC o Q.SPECL [`[w1]`,`T`]) 4777 \\ SIMP_TAC std_ss [LENGTH] \\ STRIP_TAC 4778 \\ IMP_RES_TAC (MR_IMP_R |> CONJUNCTS |> hd |> SPEC_ALL |> Q.INST [`f`|->`Fun (x::xs)`]) 4779 \\ POP_ASSUM (STRIP_ASSUME_TAC o Q.SPEC `io`) 4780 \\ METIS_TAC [R_ap_T_11,R_ev_logic_conclusion,PAIR_EQ,MR_IMP_R, 4781 logic_conclusion_def,SECOND_def]) 4782 \\ FULL_SIMP_TAC std_ss [] \\ SIMP_TAC std_ss [DISJ_EQ_IMP] 4783 \\ SIMP_TAC std_ss [GSYM isTrue_def] 4784 \\ `R_ap (Fun name,[x1; x2; x3; x4],ARB,k,io,ok) 4785 (f [x1; x2; x3; x4],k,io,T)` by METIS_TAC [MR_IMP_R,APPEND_NIL] 4786 \\ ASM_SIMP_TAC std_ss [] 4787 \\ Cases_on `isTrue (f [x1; x2; x3; x4])` \\ FS [] 4788 \\ STRIP_TAC \\ STRIP_TAC 4789 \\ `func_definition_exists ctxt "LOGIC.PROVABLEP" z1 z2 provablep` by 4790 (FULL_SIMP_TAC std_ss [func_definition_exists_def]) 4791 \\ FULL_SIMP_TAC std_ss [axioms_inv_def] 4792 \\ `axioms_aux "LOGIC.PROVABLEP" ctxt axioms ftbl z1 provablep z2` by FS [] 4793 \\ REVERSE (Cases_on `z2`) THEN1 4794 (FULL_SIMP_TAC std_ss [axioms_aux_def,witness_body_def] 4795 \\ IMP_RES_TAC (MATCH_MP lookup_init_lemma lookup_provablep) \\ FS []) 4796 THEN1 4797 (FULL_SIMP_TAC std_ss [axioms_aux_def,witness_body_def] 4798 \\ IMP_RES_TAC (MATCH_MP lookup_init_lemma lookup_provablep) \\ FS []) 4799 \\ FULL_SIMP_TAC std_ss [axioms_aux_def,witness_body_def] 4800 \\ IMP_RES_TAC (MATCH_MP lookup_init_lemma lookup_provablep_thm) \\ FS [] 4801 \\ `term_ok ctxt (term2t (sexp3term lookup_provablep_body))` by 4802 METIS_TAC [context_ok_def,context_inv_def] 4803 \\ `"LOGIC.PROVABLE-WITNESS" IN FDOM ctxt /\ (LENGTH (FST (ctxt ' "LOGIC.PROVABLE-WITNESS")) = 4) /\ 4804 "LOGIC.PROOFP" IN FDOM ctxt /\ (LENGTH (FST (ctxt ' "LOGIC.PROOFP")) = 4)` by 4805 (POP_ASSUM MP_TAC \\ EVAL_TAC \\ SRW_TAC [] []) 4806 \\ `(provablep = EvalFun "LOGIC.PROVABLEP" ctxt)` by 4807 (FULL_SIMP_TAC std_ss [context_inv_def] \\ RES_TAC \\ ASM_REWRITE_TAC []) 4808 \\ Q.PAT_X_ASSUM `isTrue (logic_appealp x1) ==> bbb` MP_TAC 4809 \\ ASM_REWRITE_TAC [] \\ REWRITE_TAC [EvalFun_def,Eval_M_ap_def] 4810 \\ ONCE_REWRITE_TAC [M_ev_cases] \\ ASM_SIMP_TAC (srw_ss()) [] 4811 \\ `?r1 r2 provable_witness. ctxt ' "LOGIC.PROVABLE-WITNESS" = 4812 (r1,r2,provable_witness)` by METIS_TAC [PAIR] 4813 \\ `?v1 v2 proofp. (ctxt ' "LOGIC.PROOFP" = 4814 (v1,v2,proofp))` by METIS_TAC [PAIR] 4815 \\ FULL_SIMP_TAC std_ss [] 4816 \\ `!w1 w2 w3 w4. proofp [w1;w2;w3;w4] = logic_proofp w1 w2 w3 w4` by 4817 (REPEAT STRIP_TAC 4818 \\ Q.PAT_X_ASSUM `!name params body sem args ok. bbb` (MP_TAC o Q.SPEC `"LOGIC.PROOFP"`) \\ FS [] 4819 \\ STRIP_TAC \\ POP_ASSUM (MP_TAC o Q.SPECL [`[w1;w2;w3;w4]`,`T`]) 4820 \\ SIMP_TAC std_ss [LENGTH] \\ STRIP_TAC 4821 \\ IMP_RES_TAC (MR_IMP_R |> CONJUNCTS |> hd |> SPEC_ALL |> Q.INST [`f`|->`Fun (x::xs)`]) 4822 \\ POP_ASSUM (STRIP_ASSUME_TAC o Q.SPEC `io`) 4823 \\ METIS_TAC [R_ap_T_11,R_ev_logic_proofp,PAIR_EQ,MR_IMP_R]) 4824 \\ `?z11 z12 z13 z14. z1 = [z11;z12;z13;z14]` by 4825 (Cases_on `z1` \\ FS [MAP,list2sexp_def] 4826 \\ Cases_on `t` \\ FS [MAP,list2sexp_def] 4827 \\ Cases_on `t'` \\ FS [MAP,list2sexp_def] 4828 \\ Cases_on `t` \\ FS [MAP,list2sexp_def] 4829 \\ Cases_on `t'` \\ FS [MAP,list2sexp_def,CONS_11]) 4830 \\ FS [MAP,FunVarBind_def] 4831 \\ ONCE_REWRITE_TAC [EVAL ``(term2t (sexp3term lookup_provablep_body))``] 4832 \\ NTAC 20 (ONCE_REWRITE_TAC [M_ev_cases] \\ ASM_SIMP_TAC (srw_ss()) 4833 [FunVarBind_def,APPLY_UPDATE_THM]) 4834 \\ SIMP_TAC (srw_ss()) [EVAL_PRIMITIVE_def,LISP_EQUAL_def] 4835 \\ `?prooff. provable_witness [CAR (CDR x1); x2; x3; x4] = prooff` by METIS_TAC [] 4836 \\ FULL_SIMP_TAC std_ss [core_admit_switch_lemma] 4837 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 4838 \\ `isTrue (logic_appealp (a2sexp proof))` by ASM_SIMP_TAC std_ss [appeal_syntax_ok_thm] 4839 \\ FS [] \\ Cases_on `isTrue (logic_appealp prooff)` \\ FS [] 4840 \\ Cases_on `isTrue 4841 (logic_proofp prooff (list2sexp (MAP f2sexp axioms')) 4842 (list2sexp (MAP f2sexp thms')) x4)` \\ FS [] 4843 \\ FULL_SIMP_TAC std_ss [primitive_arity_def] 4844 \\ Q.PAT_X_ASSUM `bbb = prooff` MP_TAC 4845 \\ `func_definition_exists ctxt "LOGIC.PROVABLE-WITNESS" r1 r2 provable_witness` by 4846 (FULL_SIMP_TAC std_ss [func_definition_exists_def]) 4847 \\ FULL_SIMP_TAC std_ss [axioms_inv_def] 4848 \\ `axioms_aux "LOGIC.PROVABLE-WITNESS" ctxt axioms ftbl r1 provable_witness r2` by FS [] 4849 \\ Cases_on `r2` THEN1 4850 (FULL_SIMP_TAC std_ss [axioms_aux_def,witness_body_def] 4851 \\ IMP_RES_TAC (MATCH_MP lookup_init_lemma lookup_provable_witness) \\ FS []) 4852 \\ FULL_SIMP_TAC std_ss [axioms_aux_def,witness_body_def] 4853 \\ IMP_RES_TAC (MATCH_MP lookup_init_lemma lookup_provable_witness_thm) \\ FS [] 4854 \\ FULL_SIMP_TAC (srw_ss()) [lookup_provable_witness_body_def] 4855 \\ POP_ASSUM (K ALL_TAC) \\ POP_ASSUM MP_TAC \\ NTAC 6 (POP_ASSUM (K ALL_TAC)) 4856 \\ Q.PAT_X_ASSUM `ctxt ' "LOGIC.PROVABLE-WITNESS" = bbb` MP_TAC 4857 \\ CONV_TAC (RATOR_CONV (RAND_CONV EVAL)) \\ STRIP_TAC \\ STRIP_TAC 4858 \\ `?r11 r12 r13 r14. r1 = [r11;r12;r13;r14]` by 4859 (Cases_on `r1` \\ FS [MAP,list2sexp_def] 4860 \\ Cases_on `t` \\ FS [MAP,list2sexp_def] 4861 \\ Cases_on `t'` \\ FS [MAP,list2sexp_def] 4862 \\ Cases_on `t` \\ FS [MAP,list2sexp_def] 4863 \\ Cases_on `t'` \\ FS [MAP,list2sexp_def,CONS_11]) 4864 \\ FS [MAP] 4865 \\ Q.PAT_X_ASSUM `ctxt ' "LOGIC.PROVABLE-WITNESS" = bbb` MP_TAC 4866 \\ Q.PAT_ABBREV_TAC `wit = mApp xxx yyy` \\ STRIP_TAC 4867 \\ `(provable_witness = (\args. @v. 4868 isTrue (EvalTerm (FunVarBind ("PROOF"::r1) (v::args),ctxt) wit)))` by 4869 (FULL_SIMP_TAC std_ss [context_inv_def] \\ RES_TAC \\ FULL_SIMP_TAC std_ss []) 4870 \\ FULL_SIMP_TAC std_ss [] \\ Q.UNABBREV_TAC `wit` 4871 \\ POP_ASSUM (K ALL_TAC) \\ POP_ASSUM (K ALL_TAC) 4872 \\ FULL_SIMP_TAC (srw_ss()) [EvalTerm_def,EvalApp_def,MAP,LET_DEF,EVAL_PRIMITIVE_def, 4873 FunVarBind_def,APPLY_UPDATE_THM] 4874 \\ ASM_SIMP_TAC std_ss [LISP_IF_def] \\ IMP_RES_TAC logic_appealp_thm 4875 \\ FS [] \\ METIS_TAC [logic_proofp_thm]); 4876 4877 4878(* admit eval *) 4879 4880val logic_func2sexp_IN_core_initial_atbl = prove( 4881 ``!f. isTrue (lookup (logic_func2sexp f) core_initial_atbl) = 4882 ?p. f = mPrimitiveFun p``, 4883 Cases THEN1 (Cases_on `l` \\ SIMP_TAC (srw_ss()) [] \\ EVAL_TAC) 4884 \\ SIMP_TAC (srw_ss()) [logic_func2sexp_def] 4885 \\ SRW_TAC [] [] \\ EVAL_TAC \\ FULL_SIMP_TAC std_ss []); 4886 4887val core_eval_function_thm = prove( 4888 ``milawa_inv ctxt simple_ctxt k (axioms,thms,atbl,checker,ftbl) /\ 4889 term_syntax_ok (mApp (mFun f) (MAP mConst xs)) /\ 4890 term_ok ctxt (mApp (mFun f) (MAP mConst xs)) ==> 4891 ?res io2 ok2 k2. 4892 core_eval_function_side (t2sexp (mApp (mFun f) (MAP mConst xs))) k io ok /\ 4893 (core_eval_function (t2sexp (mApp (mFun f) (MAP mConst xs))) k io ok = 4894 (res,k2,io2,ok2)) /\ 4895 (ok2 ==> (io2 = io) /\ (k2 = k) /\ 4896 MR_ap (Fun f,xs,ARB,ctxt,k,ok) (EvalApp((mFun f),xs,ctxt),T) /\ 4897 (res = t2sexp (mConst (EvalApp((mFun f),xs,ctxt)))))``, 4898 SIMP_TAC std_ss [core_eval_function_def,core_eval_function_side_def] 4899 \\ FS [t2sexp_def,LET_DEF] 4900 \\ FULL_SIMP_TAC std_ss [LENGTH,term_ok_def,func_arity_def,EVERY_DEF,LENGTH_MAP] 4901 \\ STRIP_TAC \\ FULL_SIMP_TAC (srw_ss()) [func_arity_def] 4902 \\ `?x1 x2 x3. ctxt ' f = (x1,x2,x3)` by METIS_TAC [PAIR] 4903 \\ FULL_SIMP_TAC std_ss [milawa_inv_def,runtime_inv_def] 4904 \\ `LENGTH xs = LENGTH x1` by FS [] 4905 \\ RES_TAC \\ POP_ASSUM (STRIP_ASSUME_TAC o Q.SPEC `ok`) 4906 \\ FS [EvalApp_def,LET_DEF] 4907 \\ IMP_RES_TAC (CONJUNCT1 MR_IMP_R) \\ POP_ASSUM (STRIP_ASSUME_TAC o Q.SPEC `io`) 4908 \\ `(logic_func2sexp (mFun f) = Sym f)` by 4909 (FULL_SIMP_TAC std_ss [logic_func2sexp_def,MEM,term_syntax_ok_def, 4910 func_syntax_ok_def]) \\ FS [] 4911 \\ IMP_RES_TAC Funcall_lemma 4912 \\ `funcall_ok (Sym f::xs) k io ok` by METIS_TAC [funcall_ok_def] 4913 \\ `ok2 ==> (funcall (Sym f::xs) k io ok = (x3 xs,k,STRCAT io io1,ok2))` by 4914 (REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [funcall_def] \\ METIS_TAC [R_ap_T_11]) 4915 \\ FULL_SIMP_TAC std_ss [] 4916 \\ Cases_on `x1` \\ Cases_on `xs` \\ FULL_SIMP_TAC std_ss [LENGTH,ADD1,APPEND_NIL] 4917 THEN1 (STRIP_TAC \\ IMP_RES_TAC SND_SND_SND_funcall_IMP 4918 \\ FULL_SIMP_TAC std_ss [APPEND_NIL] \\ METIS_TAC [APPEND_NIL]) 4919 \\ Cases_on `t` \\ Cases_on `t'` \\ FS [LENGTH,ADD1,APPEND_NIL,list2sexp_def] 4920 THEN1 (STRIP_TAC \\ IMP_RES_TAC SND_SND_SND_funcall_IMP 4921 \\ FULL_SIMP_TAC std_ss [APPEND_NIL] \\ METIS_TAC [APPEND_NIL]) 4922 \\ Cases_on `t` \\ Cases_on `t''` \\ FS [LENGTH,ADD1,APPEND_NIL,list2sexp_def] 4923 THEN1 (STRIP_TAC \\ IMP_RES_TAC SND_SND_SND_funcall_IMP 4924 \\ FULL_SIMP_TAC std_ss [APPEND_NIL] \\ METIS_TAC [APPEND_NIL]) 4925 \\ Cases_on `t'` \\ Cases_on `t` \\ FS [LENGTH,ADD1,APPEND_NIL,list2sexp_def] 4926 THEN1 (STRIP_TAC \\ IMP_RES_TAC SND_SND_SND_funcall_IMP 4927 \\ FULL_SIMP_TAC std_ss [APPEND_NIL] \\ METIS_TAC [APPEND_NIL]) 4928 \\ Cases_on `t''` \\ Cases_on `t'` \\ FS [LENGTH,ADD1,APPEND_NIL,list2sexp_def] 4929 THEN1 (STRIP_TAC \\ IMP_RES_TAC SND_SND_SND_funcall_IMP 4930 \\ FULL_SIMP_TAC std_ss [APPEND_NIL] \\ METIS_TAC [APPEND_NIL]) 4931 \\ Cases_on `t''` \\ Cases_on `t` \\ FS [LENGTH,ADD1,APPEND_NIL,list2sexp_def] 4932 THEN1 (STRIP_TAC \\ IMP_RES_TAC SND_SND_SND_funcall_IMP 4933 \\ FULL_SIMP_TAC std_ss [APPEND_NIL] \\ METIS_TAC [APPEND_NIL]) 4934 \\ SIMP_TAC std_ss [GSYM ADD_ASSOC,DECIDE ``~(n + 6 = 2:num)``, 4935 DECIDE ``~(n + 6 = 3:num)``,DECIDE ``~(n + 6 = 4:num)``, 4936 DECIDE ``~(n + 6 = 5:num)``]); 4937 4938val logic_constant_listp_thm = prove( 4939 ``!l. isTrue (logic_constant_listp (list2sexp (MAP t2sexp l))) ==> 4940 ?ts. l = MAP mConst ts``, 4941 Induct THEN1 (REPEAT STRIP_TAC \\ Q.EXISTS_TAC `[]` \\ EVAL_TAC) 4942 \\ FULL_SIMP_TAC std_ss [MAP,list2sexp_def] \\ FS [] 4943 \\ SIMP_TAC std_ss [Once logic_constant_listp_def] \\ FS [] 4944 \\ REVERSE (Cases_on `h`) \\ FS [t2sexp_def] 4945 \\ REPEAT STRIP_TAC \\ RES_TAC 4946 \\ Q.EXISTS_TAC `S'::ts` \\ EVAL_TAC \\ ASM_SIMP_TAC std_ss []); 4947 4948val core_admit_eval_thm = prove( 4949 ``milawa_inv ctxt simple_ctxt k (axioms,thms,atbl,checker,ftbl) ==> 4950 ?x io2 ok2 k2. 4951 core_admit_eval_side cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok /\ 4952 (core_admit_eval cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok = 4953 (x,k2,io2,ok2)) /\ 4954 (ok2 ==> (io2 = io) /\ (k2 = k) /\ 4955 ?result. (x = milawa_state result) /\ milawa_inv ctxt simple_ctxt k result)``, 4956 SIMP_TAC std_ss [core_admit_eval_def,core_admit_eval_side_def,LET_DEF] \\ FS [] 4957 \\ Q.ABBREV_TAC `lhs = CAR (CDR cmd)` \\ STRIP_TAC 4958 \\ Cases_on `isTrue (logic_termp lhs)` \\ FULL_SIMP_TAC std_ss [] 4959 \\ Cases_on `isTrue (logic_function_namep (CAR lhs))` \\ FULL_SIMP_TAC std_ss [] 4960 \\ Cases_on `isTrue (logic_constant_listp (CDR lhs))` \\ FS [] 4961 \\ Cases_on `isTrue (logic_term_atblp lhs 4962 (CAR (CDR (CDR (milawa_state (axioms,thms,atbl,checker,ftbl))))))` \\ FS [] 4963 \\ Cases_on `isTrue (lookup (CAR lhs) core_initial_atbl)` \\ FS [] 4964 \\ IMP_RES_TAC logic_termp_thm 4965 \\ FULL_SIMP_TAC std_ss [milawa_state_def] \\ FS [core_state_def] 4966 \\ FULL_SIMP_TAC std_ss [milawa_inv_def] 4967 \\ IMP_RES_TAC logic_term_atblp_thm 4968 \\ Cases_on `t` 4969 \\ FS [t2sexp_def,logic_function_namep_def] 4970 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,memberp_thm,MEM] 4971 \\ FS [] \\ Cases_on `l0` THEN1 4972 (CCONTR_TAC 4973 \\ Q.PAT_X_ASSUM `~isTrue 4974 (lookup (logic_func2sexp (mPrimitiveFun l')) 4975 core_initial_atbl)` MP_TAC 4976 \\ Cases_on `l'` \\ EVAL_TAC) 4977 \\ FULL_SIMP_TAC std_ss [EXISTS_PROD,milawa_state_def,core_state_def] 4978 \\ FS [milawa_inv_def,MAP_f2sexp_11] 4979 \\ IMP_RES_TAC logic_constant_listp_thm \\ FULL_SIMP_TAC std_ss [] 4980 \\ MP_TAC (core_eval_function_thm |> Q.INST [`xs`|->`ts`,`f`|->`s`]) 4981 \\ FS [term_ok_def,term_syntax_ok_def,milawa_inv_def,t2sexp_def] 4982 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 4983 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [] 4984 \\ Q.EXISTS_TAC `(Equal (mApp (mFun s) (MAP mConst ts)) 4985 (mConst (EvalApp (mFun s,ts,ctxt))))::thms` 4986 \\ FS [list2sexp_def,MAP,f2sexp_def,t2sexp_def,thms_inv_def,EVERY_DEF] 4987 \\ FS [formula_syntax_ok_def,term_syntax_ok_def] 4988 \\ FS [runtime_inv_def,func_arity_def] 4989 \\ `?x1 x2 x3. ctxt ' s = (x1,x2,x3)` by METIS_TAC [PAIR] 4990 \\ FS [LENGTH_MAP] \\ `LENGTH ts = LENGTH x1` by METIS_TAC [] 4991 \\ RES_TAC \\ FULL_SIMP_TAC std_ss [EvalApp_def,LET_DEF,MilawaTrueFun_def] 4992 \\ POP_ASSUM (MP_TAC o Q.SPEC `ok`) \\ STRIP_TAC 4993 \\ IMP_RES_TAC MR_ev_11_ALL 4994 \\ FULL_SIMP_TAC std_ss []); 4995 4996 4997(* admit print *) 4998 4999val line_ok_def = Define ` 5000 line_ok (ctxt,line) = 5001 (line = "") \/ (line = "NIL") \/ 5002 (?p. context_ok ctxt /\ MilawaValid ctxt p /\ 5003 (line = sexp2string (list2sexp [Sym "PRINT"; list2sexp [Sym "THEOREM"; f2sexp p]]))) \/ 5004 (?n x y. line = sexp2string (list2sexp [Sym "PRINT"; list2sexp [Val n; x; y]]))`; 5005 5006val output_to_string_def = Define ` 5007 (output_to_string [] = "") /\ 5008 (output_to_string (x::xs) = SND x ++ "\n" ++ output_to_string xs)`; 5009 5010(* 5011val milawa_io_inv_def = Define ` 5012 milawa_io_inv io = 5013 ?lines. EVERY output_line_ok lines /\ 5014 (io = FOLDL (\(ctxt,x) y. x ++ y ++ "\n") "" lines)`; 5015*) 5016 5017(* 5018val milawa_io_inv_UNFOLD = prove( 5019 ``milawa_io_inv io /\ output_line_ok line ==> 5020 milawa_io_inv (io ++ line ++ "\n")``, 5021 SIMP_TAC std_ss [milawa_io_inv_def] \\ REPEAT STRIP_TAC 5022 \\ Q.EXISTS_TAC `lines ++ [line]` \\ FULL_SIMP_TAC std_ss [EVERY_DEF,EVERY_APPEND] 5023 \\ FULL_SIMP_TAC std_ss [GSYM SNOC_APPEND,FOLDL_SNOC]); 5024*) 5025 5026val print_thm_def = Define ` 5027 print_thm ctxt cmd = 5028 (ctxt,sexp2string 5029 (list2sexp [Sym "PRINT"; list2sexp [Sym "THEOREM"; CAR (CDR cmd)]]))`; 5030 5031val core_admit_print_thm = prove( 5032 ``milawa_inv ctxt simple_ctxt k (axioms,thms,atbl,checker,ftbl) ==> 5033 ?x io2 ok2. 5034 core_admit_print_side cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok /\ 5035 (core_admit_print cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok = 5036 (x,k,io2,ok2)) /\ 5037 (ok2 ==> (io2 = io ++ SND (print_thm simple_ctxt cmd) ++ "\n") /\ 5038 line_ok (print_thm simple_ctxt cmd) /\ 5039 (x = (milawa_state (axioms,thms,atbl,checker,ftbl))))``, 5040 FS [core_admit_print_def,LET_DEF,milawa_state_def,core_state_def, 5041 SIMP_RULE std_ss [DISJ_EQ_IMP,GSYM AND_IMP_INTRO,LET_DEF] core_admit_print_side_def] 5042 \\ Cases_on `list_exists 2 cmd` \\ FULL_SIMP_TAC std_ss [] 5043 \\ Cases_on `CAR cmd <> Sym "PRINT"` \\ ASM_REWRITE_TAC [] 5044 THEN1 (SIMP_TAC std_ss []) 5045 \\ Cases_on `MEM (CAR (CDR cmd)) (MAP f2sexp axioms)` \\ FS [] 5046 \\ Cases_on `MEM (CAR (CDR cmd)) (MAP f2sexp thms)` \\ FS [] 5047 \\ (REPEAT STRIP_TAC 5048 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,APPEND_ASSOC] 5049 \\ FULL_SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND_11] 5050 \\ SIMP_TAC std_ss [line_ok_def,print_thm_def] 5051 \\ DISJ2_TAC \\ DISJ2_TAC \\ DISJ1_TAC 5052 \\ FULL_SIMP_TAC std_ss [MEM_MAP,milawa_inv_def,thms_inv_def,EVERY_MEM] 5053 \\ RES_TAC \\ `context_syntax_same ctxt simple_ctxt` by 5054 FS [context_syntax_same_def,similar_context_def] 5055 \\ `MilawaTrue simple_ctxt y` by METIS_TAC [MilawaTrue_context_syntax_same] 5056 \\ METIS_TAC [Milawa_SOUNDESS,similar_context_def])); 5057 5058 5059(* step case -- accept command *) 5060 5061val core_accept_command_thm = prove( 5062 ``milawa_inv ctxt simple_ctxt k (axioms,thms,atbl,checker,ftbl) ==> 5063 core_accept_command_side cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok /\ 5064 ?x k2 io2 ok2 result ctxt. 5065 (core_accept_command cmd (milawa_state (axioms,thms,atbl,checker,ftbl)) k io ok = 5066 (x,k2,io2,ok2)) /\ 5067 (ok2 ==> (x = milawa_state result) /\ 5068 milawa_inv ctxt (if CAR cmd = Sym "DEFINE" then defun_ctxt simple_ctxt cmd else 5069 if CAR cmd = Sym "SKOLEM" then witness_ctxt simple_ctxt cmd else 5070 simple_ctxt) k2 result /\ 5071 ((CAR cmd = Sym "PRINT") ==> line_ok (print_thm simple_ctxt cmd)) /\ 5072 (io2 = if CAR cmd = Sym "PRINT" then io ++ SND (print_thm simple_ctxt cmd) ++ "\n" else io))``, 5073 STRIP_TAC \\ STRIP_TAC THEN1 5074 (SIMP_TAC std_ss [core_accept_command_side_def] 5075 \\ IMP_RES_TAC core_admit_eval_thm 5076 \\ IMP_RES_TAC core_admit_switch_thm 5077 \\ IMP_RES_TAC core_admit_defun_thm 5078 \\ IMP_RES_TAC core_admit_witness_thm 5079 \\ IMP_RES_TAC core_admit_theorem_thm 5080 \\ IMP_RES_TAC core_admit_print_thm 5081 \\ METIS_TAC []) 5082 \\ SIMP_TAC std_ss [core_accept_command_def] 5083 \\ Cases_on `CAR cmd = Sym "VERIFY"` \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] 5084 THEN1 (METIS_TAC [core_admit_theorem_thm]) 5085 \\ Cases_on `CAR cmd = Sym "DEFINE"` \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] 5086 THEN1 (METIS_TAC [core_admit_defun_thm]) 5087 \\ Cases_on `CAR cmd = Sym "SKOLEM"` \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] 5088 THEN1 (METIS_TAC [core_admit_witness_thm]) 5089 \\ Cases_on `CAR cmd = Sym "PRINT"` \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] 5090 THEN1 (METIS_TAC [core_admit_print_thm]) 5091 \\ Cases_on `CAR cmd = Sym "SWITCH"` \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] 5092 THEN1 (METIS_TAC [core_admit_switch_thm]) 5093 \\ Cases_on `CAR cmd = Sym "EVAL"` \\ FS [] \\ FULL_SIMP_TAC (srw_ss()) [] 5094 THEN1 (METIS_TAC [core_admit_eval_thm])); 5095 5096 5097(* loop -- accept commands *) 5098 5099val print_event_number_def = Define ` 5100 print_event_number n cmd = 5101 (sexp2string (list2sexp [Sym "PRINT"; 5102 LISP_CONS (Val n) 5103 (LISP_CONS (FIRST cmd) 5104 (LISP_CONS (SECOND cmd) 5105 (Sym "NIL")))]))`; 5106 5107val milawa_command_def = Define ` 5108 milawa_command ctxt cmd = 5109 if CAR cmd = Sym "DEFINE" then (defun_ctxt ctxt cmd,[]) else 5110 if CAR cmd = Sym "SKOLEM" then (witness_ctxt ctxt cmd,[]) else 5111 if CAR cmd = Sym "PRINT" then (ctxt,[print_thm ctxt cmd]) else (ctxt,[])` 5112 5113val milawa_commands_def = tDefine "milawa_commands" ` 5114 milawa_commands ctxt n cmds = 5115 if ~(isDot cmds) then [] else 5116 let cmd = CAR cmds in 5117 let l1 = [(ctxt,print_event_number n cmd)] in 5118 let (new_ctxt,l2) = milawa_command ctxt cmd in 5119 l1 ++ l2 ++ milawa_commands new_ctxt (n+1) (CDR cmds)` 5120 (WF_REL_TAC `measure (LSIZE o SND o SND)` 5121 \\ FULL_SIMP_TAC std_ss [isDot_thm] \\ REPEAT STRIP_TAC 5122 \\ FS [LSIZE_def] \\ DECIDE_TAC) |> SPEC_ALL; 5123 5124val line_ok_print_event_number = prove( 5125 ``line_ok (simple_ctxt,print_event_number n cmds)``, 5126 FS [line_ok_def,print_event_number_def] \\ METIS_TAC []); 5127 5128val isDot_milawa_state = prove( 5129 ``!state. isDot (milawa_state state)``, 5130 FULL_SIMP_TAC std_ss [FORALL_PROD] \\ EVAL_TAC \\ SIMP_TAC std_ss []); 5131 5132val core_accept_commands_thm = prove( 5133 ``!cmds n state k io ok ctxt simple_ctxt. 5134 milawa_inv ctxt simple_ctxt k state /\ ok ==> 5135 core_accept_commands_side cmds (Val n) (milawa_state state) k io ok /\ 5136 ?x k2 io2 ok2 result ctxt. 5137 (core_accept_commands cmds (Val n) (milawa_state state) k io ok = (x,k2,io2,ok2)) /\ 5138 (ok2 ==> isDot x /\ 5139 let output = milawa_commands simple_ctxt n cmds in 5140 EVERY line_ok output /\ (io2 = io ++ output_to_string output))``, 5141 REVERSE (Induct) \\ SIMP_TAC std_ss [] 5142 \\ ONCE_REWRITE_TAC [core_accept_commands_def,core_accept_commands_side_def] 5143 \\ SIMP_TAC std_ss [Once milawa_commands_def] \\ FS [] 5144 THEN1 (FS [LET_DEF,EVERY_DEF,output_to_string_def,MAP,FOLDL,APPEND_NIL,isDot_milawa_state]) 5145 THEN1 (FS [LET_DEF,EVERY_DEF,output_to_string_def,MAP,FOLDL,APPEND_NIL,isDot_milawa_state]) 5146 \\ FS [LET_DEF] \\ NTAC 7 STRIP_TAC 5147 \\ FS [GSYM print_event_number_def |> SR [list2sexp_def,LISP_CONS_def]] 5148 \\ Q.PAT_ABBREV_TAC `io3 = (STRCAT (STRCAT io xx) yy)` 5149 \\ `?result. core_accept_command cmds (milawa_state state) k io3 T = result` by FS [] 5150 \\ `?x1 x2 x3 x4 x5. state = (x1,x2,x3,x4,x5)` by METIS_TAC [PAIR] \\ FS [] 5151 \\ `?y1 y2 y3 y4. result = (y1,y2,y3,y4)` by METIS_TAC [PAIR] \\ FS [] 5152 \\ Q.PAT_X_ASSUM `xxx yyy = (y1,y2,y3,y4)` MP_TAC 5153 \\ IMP_RES_TAC core_accept_command_thm \\ FS [] 5154 \\ POP_ASSUM (STRIP_ASSUME_TAC o Q.SPECL [`T`,`io3`,`cmds`]) \\ FS [] 5155 \\ CONV_TAC (RATOR_CONV (ONCE_REWRITE_CONV [EQ_SYM_EQ])) \\ STRIP_TAC \\ FS [] 5156 \\ REVERSE (Cases_on `ok2`) THEN1 5157 (ONCE_REWRITE_TAC [core_accept_commands_side_def] \\ SIMP_TAC std_ss [] 5158 \\ ONCE_REWRITE_TAC [core_accept_commands_def] \\ SIMP_TAC std_ss []) 5159 \\ FS [] 5160 \\ Q.ABBREV_TAC `new_simple_ctxt = (if CAR cmds = Sym "DEFINE" then 5161 defun_ctxt simple_ctxt cmds 5162 else if CAR cmds = Sym "SKOLEM" then 5163 witness_ctxt simple_ctxt cmds 5164 else 5165 simple_ctxt)` 5166 \\ Q.PAT_X_ASSUM `!x1 x2 x3 x4. bbb` 5167 (MP_TAC o Q.SPECL [`1+n`,`result'`,`k2`,`io2`,`ctxt'`,`new_simple_ctxt`]) 5168 \\ FS [] 5169 \\ Q.PAT_X_ASSUM `io2 = if CAR cmds = Sym "PRINT" then xxx else yyy` (ASSUME_TAC o GSYM) 5170 \\ FS [] \\ REPEAT STRIP_TAC \\ FS [] 5171 \\ STRIP_TAC \\ FS [] 5172 \\ Q.PAT_X_ASSUM `EVERY P xs` MP_TAC 5173 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) 5174 \\ FS [EVERY_APPEND,EVERY_DEF,line_ok_print_event_number] 5175 \\ `(FST (milawa_command simple_ctxt cmds)) = new_simple_ctxt` by (FS [milawa_command_def] \\ Q.UNABBREV_TAC `new_simple_ctxt` \\ SRW_TAC [] []) 5176 \\ FULL_SIMP_TAC std_ss [AC ADD_ASSOC ADD_COMM] 5177 \\ REPEAT STRIP_TAC THEN1 (FS [milawa_command_def] \\ SRW_TAC [] []) 5178 \\ Q.PAT_X_ASSUM `xxx = io2` (ASSUME_TAC o GSYM) \\ FS [] 5179 \\ Q.UNABBREV_TAC `io3` 5180 \\ FULL_SIMP_TAC std_ss [output_to_string_def,APPEND] 5181 \\ `SND (milawa_command simple_ctxt cmds) = 5182 if CAR cmds = Sym "PRINT" then [print_thm simple_ctxt cmds] else []` by (SRW_TAC [] [milawa_command_def] \\ FULL_SIMP_TAC (srw_ss()) []) 5183 \\ Cases_on `CAR cmds = Sym "PRINT"` 5184 \\ FS [APPEND_ASSOC,APPEND,output_to_string_def]); 5185 5186 5187(* initialisation of main loop *) 5188 5189val lookup_safe_lemma1 = SR [] milawa_defsTheory.lookup_safe_def 5190val lookup_safe_lemma2 = lookup_safe_lemma1 |> Q.INST [`x`|->`Sym t`] |> SR [isDot_def] 5191val lookup_safe_lemma2a = lookup_safe_lemma1 |> Q.INST [`x`|->`Val t`] |> SR [isDot_def] 5192val lookup_safe_lemma3 = lookup_safe_lemma1 5193 |> Q.INST [`x`|->`Dot (Dot (Sym s) y) z`,`a`|->`Sym t`] 5194 |> SR [isDot_def,CAR_def,CDR_def,SExp_11] 5195 5196val ftbl_prop_def = Define ` 5197 ftbl_prop ftbl k = 5198 (EVERY 5199 (\x. 5200 isTrue (CDR x) ==> 5201 (let name = getSym (CAR x) in 5202 let formals = MAP getSym (sexp2list (CAR (CDR x))) in 5203 let body = sexp2term (CAR (CDR (CDR x))) 5204 in name IN FDOM k /\ (k ' name = (formals,body)))) 5205 (sexp2list ftbl) /\ EVERY isDot (sexp2list ftbl)) /\ 5206 ALL_DISTINCT (MAP CAR (sexp2list ftbl))`; 5207 5208val define_safe_list = 5209 milawa_initTheory.define_safe_list_def 5210 |> concl |> dest_eq |> fst |> repeat (fst o dest_comb); 5211 5212val define_safe_list_IMP_ok = prove( 5213 ``!defs ftbl k io ok. 5214 (^define_safe_list ftbl defs k io ok = (ftbl2,k2,io2,T)) ==> ok``, 5215 REVERSE Induct 5216 THEN1 (FS [Once milawa_initTheory.define_safe_list_def]) 5217 THEN1 (FS [Once milawa_initTheory.define_safe_list_def]) 5218 \\ ONCE_REWRITE_TAC [milawa_initTheory.define_safe_list_def] 5219 \\ SIMP_TAC std_ss [LET_DEF,EVAL ``isTrue (LISP_CONSP (Dot defs defs'))``] 5220 \\ CONV_TAC (DEPTH_CONV (PairRules.PBETA_CONV)) 5221 \\ SIMP_TAC std_ss [CDR_def,CAR_def] \\ REPEAT STRIP_TAC \\ RES_TAC 5222 \\ POP_ASSUM MP_TAC 5223 \\ SIMP_TAC std_ss [milawa_initTheory.define_safe_def,LET_DEF] 5224 \\ METIS_TAC []); 5225 5226val lookup_safe = 5227 milawa_initTheory.lookup_safe_def 5228 |> concl |> dest_eq |> fst |> repeat (fst o dest_comb); 5229 5230val lookp_safe_EQ_NIL = prove( 5231 ``!y x. (^lookup_safe x y = Sym "NIL") ==> 5232 ~MEM x (MAP CAR (sexp2list y))``, 5233 REVERSE Induct \\ ONCE_REWRITE_TAC [milawa_initTheory.lookup_safe_def] \\ FS [] 5234 \\ FS [sexp2list_def,MAP,MEM] \\ SRW_TAC [] [] 5235 \\ FULL_SIMP_TAC std_ss [isDot_thm] \\ FS []); 5236 5237val ftbl_prop_MAINTAINED = prove( 5238 ``!x y k x2 k2. 5239 (^define_safe_list y x k ARB T = (x2,k2,ARB,T)) /\ ftbl_prop y k ==> 5240 ftbl_prop x2 k2``, 5241 REVERSE Induct 5242 THEN1 (ONCE_REWRITE_TAC [milawa_initTheory.define_safe_list_def] \\ FS []) 5243 THEN1 (ONCE_REWRITE_TAC [milawa_initTheory.define_safe_list_def] \\ FS []) 5244 \\ ONCE_REWRITE_TAC [milawa_initTheory.define_safe_list_def] \\ FS [LET_DEF] 5245 \\ SIMP_TAC std_ss [milawa_initTheory.define_safe_def,LET_DEF] 5246 \\ NTAC 4 STRIP_TAC 5247 \\ Cases_on `isTrue (^lookup_safe (CAR x) y)` \\ FS [] 5248 \\ REPEAT STRIP_TAC 5249 THEN1 (IMP_RES_TAC define_safe_list_IMP_ok \\ FS [] \\ RES_TAC) 5250 \\ IMP_RES_TAC define_safe_list_IMP_ok 5251 \\ Q.PAT_X_ASSUM `!y.bbb` MATCH_MP_TAC 5252 \\ Q.EXISTS_TAC `(Dot 5253 (Dot (CAR x) (Dot (CAR (CDR x)) (Dot (CAR (CDR (CDR x))) (Sym "NIL")))) y)` 5254 \\ Q.EXISTS_TAC `(add_def k 5255 (getSym (CAR x),MAP getSym (sexp2list (CAR (CDR x))), 5256 sexp2term (CAR (CDR (CDR x)))))` \\ FULL_SIMP_TAC std_ss [] 5257 \\ FULL_SIMP_TAC std_ss [ftbl_prop_def,sexp2list_def,MAP,CAR_def, 5258 EVERY_DEF,isDot_def,ALL_DISTINCT,CDR_def] \\ FS [isTrue_def] 5259 \\ FULL_SIMP_TAC std_ss [add_def_def,FUNION_DEF,IN_UNION,LET_DEF, 5260 FDOM_FUPDATE,IN_INSERT,FAPPLY_FUPDATE_THM,FDOM_FEMPTY,NOT_IN_EMPTY] 5261 \\ FULL_SIMP_TAC std_ss [EVERY_MEM,lookp_safe_EQ_NIL]); 5262 5263val init_thm = prove( 5264 ``?result. 5265 (core_state core_initial_axioms (Sym "NIL") core_initial_atbl 5266 (Sym "LOGIC.PROOFP") init_ftbl = milawa_state result) /\ 5267 milawa_inv FEMPTY FEMPTY core_funs result``, 5268 Q.EXISTS_TAC `(MILAWA_AXIOMS,[],core_initial_atbl,Sym "LOGIC.PROOFP",init_ftbl)` 5269 \\ SIMP_TAC std_ss [milawa_state_def,MAP,list2sexp_def] 5270 \\ REPEAT STRIP_TAC THEN1 5271 (FS [core_state_def] 5272 \\ REWRITE_TAC [MILAWA_AXIOMS_def,MAP,f2sexp_def,t2sexp_def,APPEND, 5273 core_initial_axioms_def,SExp_11,GSYM list2sexp_def,app_thm,LISP_CONS_def] 5274 \\ SIMP_TAC std_ss [list2sexp_def,SExp_11,logic_func2sexp_def, 5275 logic_prim2sym_def,MAP,t2sexp_def] 5276 \\ REPEAT STRIP_TAC \\ CONV_TAC (RATOR_CONV EVAL) \\ REWRITE_TAC []) 5277 \\ SIMP_TAC std_ss [milawa_inv_def] \\ REPEAT STRIP_TAC 5278 THEN1 (FULL_SIMP_TAC std_ss [context_ok_def,FDOM_FEMPTY,NOT_IN_EMPTY]) 5279 THEN1 (FULL_SIMP_TAC std_ss [context_inv_def,FDOM_FEMPTY,NOT_IN_EMPTY]) 5280 THEN1 (FS [similar_context_def,FDOM_FEMPTY,NOT_IN_EMPTY,FEVERY_DEF,context_ok_def]) 5281 THEN1 5282 (SIMP_TAC std_ss [atbl_ok_def] \\ REVERSE Cases THEN1 5283 (FULL_SIMP_TAC std_ss [func_syntax_ok_def,MEM,logic_func2sexp_def] 5284 \\ EVAL_TAC \\ FULL_SIMP_TAC std_ss [] \\ EVAL_TAC) 5285 \\ Cases_on `l` \\ EVAL_TAC) 5286 THEN1 EVAL_TAC 5287 THEN1 EVAL_TAC 5288 THEN1 5289 (SIMP_TAC std_ss [thms_inv_def,EVERY_MEM] \\ REPEAT STRIP_TAC 5290 \\ `MilawaTrue FEMPTY e` by (METIS_TAC [MilawaTrue_rules]) 5291 \\ FULL_SIMP_TAC std_ss [MILAWA_AXIOMS_def,MEM] \\ EVAL_TAC) 5292 THEN1 5293 (SIMP_TAC std_ss [core_check_proof_inv_init]) 5294 THEN1 5295 (SIMP_TAC std_ss [ftbl_inv_def] 5296 \\ SIMP_TAC std_ss [CONJ_ASSOC] \\ REVERSE STRIP_TAC 5297 THEN1 (Q.EXISTS_TAC `0` \\ SIMP_TAC std_ss [FUNPOW]) 5298 \\ `EVERY (\s. lookup_safe (Sym s) init_ftbl = list2sexp [Sym s]) 5299 fake_ftbl_entries` by 5300 (SIMP_TAC std_ss [fake_ftbl_entries_def,EVERY_DEF] 5301 \\ REPEAT STRIP_TAC \\ ONCE_REWRITE_TAC [milawa_initTheory.init_ftbl_def] 5302 \\ REWRITE_TAC [lookup_safe_lemma3,CONS_11,NOT_CONS_NIL,NOT_NIL_CONS] 5303 \\ SIMP_TAC (srw_ss()) [list2sexp_def]) 5304 \\ ASM_SIMP_TAC std_ss [] \\ POP_ASSUM (K ALL_TAC) 5305 \\ MP_TAC (Q.INST [`ok`|->`T`,`io`|->`ARB`] milawa_initTheory.milawa_init_evaluated) 5306 \\ SIMP_TAC std_ss [milawa_initTheory.milawa_init_def,GSYM ftbl_prop_def] 5307 \\ Q.PAT_ABBREV_TAC `pat = Dot x y` 5308 \\ `ftbl_prop pat init_fns` by 5309 (Q.UNABBREV_TAC `pat` \\ SIMP_TAC std_ss [ftbl_prop_def] 5310 \\ SIMP_TAC std_ss [sexp2list_def,EVERY_DEF,isDot_def,CDR_def,isTrue_def] 5311 \\ EVAL_TAC) 5312 \\ REPEAT STRIP_TAC \\ IMP_RES_TAC ftbl_prop_MAINTAINED \\ METIS_TAC []) 5313 THEN1 5314 (SIMP_TAC (srw_ss()) [axioms_inv_def] 5315 \\ SIMP_TAC std_ss [func_definition_exists_def,FDOM_FEMPTY,NOT_IN_EMPTY] 5316 \\ REPEAT STRIP_TAC \\ FULL_SIMP_TAC std_ss [logic_func_inv_def,axioms_aux_def] 5317 \\ Q.EXISTS_TAC `raw_body` \\ SIMP_TAC std_ss [] 5318 \\ STRIP_TAC THEN1 5319 (REWRITE_TAC [milawa_initTheory.init_ftbl_def,sexp2list_def,list2sexp_def,MEM] 5320 \\ POP_ASSUM (K ALL_TAC) \\ POP_ASSUM MP_TAC \\ POP_ASSUM MP_TAC 5321 \\ REWRITE_TAC [MEM] \\ STRIP_TAC 5322 \\ ASM_REWRITE_TAC [SExp_11,CONS_11,NOT_CONS_NIL,NOT_NIL_CONS] 5323 \\ SIMP_TAC (srw_ss()) [] 5324 \\ REWRITE_TAC [milawa_initTheory.init_ftbl_def,lookup_safe_lemma3] 5325 \\ ASM_REWRITE_TAC [SExp_11,CONS_11,NOT_CONS_NIL,NOT_NIL_CONS] 5326 \\ SIMP_TAC (srw_ss()) [list2sexp_def]) 5327 \\ POP_ASSUM (K ALL_TAC) \\ POP_ASSUM MP_TAC 5328 \\ FULL_SIMP_TAC std_ss [MEM] 5329 \\ REWRITE_TAC [milawa_initTheory.init_ftbl_def,lookup_safe_lemma3, 5330 NOT_CONS_NIL,NOT_NIL_CONS,CONS_11] 5331 \\ SIMP_TAC (srw_ss()) [] 5332 \\ FS [] \\ SIMP_TAC (srw_ss()) [] 5333 \\ Cases_on `params` 5334 \\ TRY (Cases_on `t`) \\ FS [MAP] 5335 \\ TRY (Cases_on `t`) \\ FS [MAP] 5336 \\ TRY (Cases_on `t'`) \\ FS [MAP] 5337 \\ SIMP_TAC std_ss [def_axiom_def] 5338 \\ REPEAT STRIP_TAC 5339 \\ EVAL_TAC) 5340 THEN1 5341 (SIMP_TAC std_ss [atbl_ftbl_inv_def] 5342 \\ REWRITE_TAC [core_initial_atbl_def,logic_initial_arity_table_def] 5343 \\ FULL_SIMP_TAC std_ss [GSYM list2sexp_def,app_thm,APPEND] 5344 \\ SIMP_TAC std_ss [list2sexp_def,GSYM alist2sexp_def] 5345 \\ SIMP_TAC std_ss [lookup_thm,LOOKUP_DOT_def,SExp_11] 5346 \\ SRW_TAC [] [] 5347 \\ REWRITE_TAC [milawa_initTheory.init_ftbl_def,sexp2list_def,MEM,MAP,CAR_def] 5348 \\ FS []) 5349 THEN1 5350 (SIMP_TAC std_ss [runtime_inv_def,FDOM_FEMPTY,NOT_IN_EMPTY]) 5351 THEN1 5352 (SIMP_TAC std_ss [milawa_initTheory.core_assum_thm])); 5353 5354 5355(* relating the above results to the main routine *) 5356 5357val define_safe_list_side_tm = 5358 milawa_initTheory.define_safe_list_side_def 5359 |> SPEC_ALL |> concl |> dest_eq |> fst |> find_term is_const 5360 5361val define_safe_list_side_thm = prove( 5362 ``!defs ftbl k io ok. 5363 ^define_safe_list_side_tm ftbl defs k io ok = T``, 5364 REVERSE Induct \\ SIMP_TAC std_ss [] 5365 \\ ONCE_REWRITE_TAC [milawa_initTheory.define_safe_list_side_def] \\ FS [] 5366 \\ FULL_SIMP_TAC std_ss [LET_DEF,milawa_initTheory.define_safe_side_def] 5367 \\ CONV_TAC (DEPTH_CONV PairRules.PBETA_CONV) \\ SIMP_TAC std_ss []); 5368 5369val milawa_init_side_thm = prove( 5370 ``milawa_init_side init_fns "NIL\nNIL\nNIL\nNIL\nNIL\n" T``, 5371 SIMP_TAC std_ss [milawa_initTheory.milawa_init_side_def] 5372 \\ SIMP_TAC std_ss [define_safe_list_side_thm]); 5373 5374val compute_output_def = Define ` 5375 compute_output cmds = 5376 [(FEMPTY,"NIL");(FEMPTY,"NIL");(FEMPTY,"NIL");(FEMPTY,"NIL");(FEMPTY,"NIL")] ++ 5377 milawa_commands FEMPTY 1 cmds`; 5378 5379val milawa_main_thm = prove( 5380 ``?ans k io ok. 5381 milawa_main_side cmds init_fns "NIL\nNIL\nNIL\nNIL\nNIL\n" T /\ 5382 (milawa_main cmds init_fns "NIL\nNIL\nNIL\nNIL\nNIL\n" T = (ans,k,io,ok)) /\ 5383 (ok ==> (ans = Sym "SUCCESS") /\ 5384 let output = compute_output cmds in 5385 EVERY line_ok output /\ (io = output_to_string output))``, 5386 SIMP_TAC std_ss [milawa_main_def,milawa_main_side_def,LET_DEF] 5387 \\ SIMP_TAC std_ss [milawa_initTheory.milawa_init_evaluated] 5388 \\ STRIP_ASSUME_TAC init_thm \\ FULL_SIMP_TAC std_ss [] 5389 \\ MP_TAC (core_accept_commands_thm 5390 |> Q.SPECL [`cmds`,`1`,`result`,`core_funs`,`"NIL\nNIL\nNIL\nNIL\nNIL\n"`,`T`,`FEMPTY`,`FEMPTY`]) 5391 \\ FULL_SIMP_TAC std_ss [] 5392 \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [milawa_initTheory.core_assum_thm] 5393 \\ FULL_SIMP_TAC std_ss [milawa_init_side_thm] 5394 \\ STRIP_TAC \\ FULL_SIMP_TAC (srw_ss()) [isDot_thm,isTrue_def] 5395 \\ FULL_SIMP_TAC std_ss [LET_DEF,compute_output_def,EVERY_DEF,EVERY_APPEND] 5396 \\ FS [line_ok_def] \\ FS [APPEND,output_to_string_def]); 5397 5398 5399(* overall soundness theorem *) 5400 5401val milawa_main_soundness = store_thm("milawa_main_soundness", 5402 ``(read_sexps rest = 5403 [Dot (Sym "MILAWA-MAIN") 5404 (Dot (Dot (Sym "QUOTE") (Dot cmds (Sym "NIL"))) (Sym "NIL"))]) ==> 5405 ?io ok. 5406 R_exec (STRCAT MILAWA_CORE_TEXT rest,FEMPTY,"") (io,ok) /\ 5407 (ok ==> let output = compute_output cmds in 5408 EVERY line_ok output /\ 5409 (io = output_to_string output ++ "SUCCESS\n"))``, 5410 REPEAT STRIP_TAC \\ STRIP_ASSUME_TAC milawa_main_thm 5411 \\ IMP_RES_TAC (SIMP_RULE std_ss [milawa_initTheory.init_assum_thm] 5412 (Q.INST [`k`|->`init_fns`] R_ev_milawa_main)) 5413 \\ POP_ASSUM (MP_TAC o Q.SPEC `FEMPTY`) \\ FULL_SIMP_TAC std_ss [] 5414 \\ REPEAT STRIP_TAC 5415 \\ IMP_RES_TAC (milawa_initTheory.milawa_init_expanded 5416 |> Q.INST [`io1`|->`""`] |> SIMP_RULE std_ss [APPEND]) 5417 \\ Q.LIST_EXISTS_TAC [`STRCAT (STRCAT io (sexp2string ans)) "\n"`,`ok`] 5418 \\ FULL_SIMP_TAC std_ss [] \\ STRIP_TAC \\ FULL_SIMP_TAC std_ss [LET_DEF] 5419 \\ SIMP_TAC std_ss [EVAL ``sexp2string (Sym "SUCCESS")``] 5420 \\ SIMP_TAC std_ss [GSYM APPEND_ASSOC,APPEND]); 5421 5422 5423val _ = export_theory(); 5424