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