diff --git a/.github/workflows/build.yaml b/.github/workflows/build.yaml index 6f4ea05e..bb41d87c 100644 --- a/.github/workflows/build.yaml +++ b/.github/workflows/build.yaml @@ -42,3 +42,6 @@ jobs: - name: Export Ott files to HOL4 and run Holmake run: eval "$(opam env)" && export PATH=$PATH:/home/runner/work/HOL4P4/HOL4P4/scripts/HOL/bin && make hol + + - name: Compile metatheory + run: export PATH=$PATH:/home/runner/work/HOL4P4/HOL4P4/scripts/HOL/bin && make metatheory diff --git a/Makefile b/Makefile index 3d3cf131..fb452805 100644 --- a/Makefile +++ b/Makefile @@ -13,6 +13,9 @@ hol/p4_from_json: hol validate: hol/p4_from_json cd hol/p4_from_json && ./validate.sh + +metatheory: hol + Holmake -r -I hol/metatheory concurrency: hol/p4_from_json Holmake -r -I hol/p4_from_json/concurrency_tests diff --git a/hol/metatheory/Holmakefile b/hol/metatheory/Holmakefile new file mode 100644 index 00000000..e6b8b64e --- /dev/null +++ b/hol/metatheory/Holmakefile @@ -0,0 +1,52 @@ +# includes +# ---------------------------------- +DEPENDENCIES = .. + + +# configuration +# ---------------------------------- +HOLHEAP = ../p4-heap +NEWHOLHEAP = p4_metatheory-heap + +HEAPINC_EXTRA = wordsLib + + +# included lines follow +# ---------------------------------- + +# automatic Holmake targets (all theories and non-"Script.sml" .sml files) +# automatic heap inclusion by name pattern +# ---------------------------------- +SMLFILES = $(subst *.sml,, $(patsubst %Script.sml,%Theory.sml,$(wildcard *.sml))) +TARGETS = $(patsubst %.sml,%.uo,$(SMLFILES)) + +HEAPINC = $(subst *Theory,,$(patsubst %Script.sml,%Theory ,$(wildcard *Script.sml))) \ + $(subst *Syntax,,$(patsubst %.sml,% ,$(wildcard *Syntax.sml))) \ + $(subst *Simps,, $(patsubst %.sml,% ,$(wildcard *Simps.sml ))) \ + $(subst *Lib,, $(patsubst %.sml,% ,$(wildcard *Lib.sml ))) \ + $(HEAPINC_EXTRA) + + +# general configs +# ---------------------------------- +all: $(TARGETS) $(if $(NEWHOLHEAP),$(NEWHOLHEAP),) + +INCLUDES = $(DEPENDENCIES) $(if $(HOLHEAP),$(shell dirname $(HOLHEAP)),) + +EXTRA_CLEANS = $(if $(NEWHOLHEAP),$(NEWHOLHEAP) $(NEWHOLHEAP).o,) $(wildcard *.exe) + +OPTIONS = QUIT_ON_FAILURE + +default: all + +.PHONY: all default + + +# holheap part +# ---------------------------------- +ifdef POLY + +$(NEWHOLHEAP): $(TARGETS) $(HOLHEAP) + $(protect $(HOLDIR)/bin/buildheap) $(if $(HOLHEAP),-b $(HOLHEAP),) -o $@ $(HEAPINC) + +endif diff --git a/hol/metatheory/p4_concurrency_testLib.sig b/hol/metatheory/p4_concurrency_testLib.sig new file mode 100644 index 00000000..3ec81437 --- /dev/null +++ b/hol/metatheory/p4_concurrency_testLib.sig @@ -0,0 +1,8 @@ +signature p4_concurrency_testLib = +sig + include Abbrev + +val get_trace_thread_n : string -> term -> term -> int -> int -> thm +val get_trace_thread_next_n : string -> term -> thm -> int -> int -> thm + +end diff --git a/hol/metatheory/p4_concurrency_testLib.sml b/hol/metatheory/p4_concurrency_testLib.sml new file mode 100644 index 00000000..1a7b540a --- /dev/null +++ b/hol/metatheory/p4_concurrency_testLib.sml @@ -0,0 +1,74 @@ +structure p4_concurrency_testLib :> p4_concurrency_testLib = struct + +open HolKernel boolLib liteLib simpLib Parse bossLib; + +open pairSyntax optionSyntax wordsSyntax bitstringSyntax listSyntax numSyntax; + +open p4Syntax p4_concurrentSyntax p4_auxTheory p4_exec_semSyntax testLib evalwrapLib p4_vssTheory p4_ebpfTheory p4_testLib; + +open p4_exec_semTheory; + +open p4_concurrentTheory; + +(* TODO: Move to concurrencySyntax *) +fun arch_state_from_conc_state conc_state tid = + let + val [io, io', n_externs, ext_obj_map, v_map, ctrl, index1, gscope1, arch_frame_list1, status1, index2, gscope2, arch_frame_list2, status2] = strip_pair conc_state + val aenv = list_mk_pair [n_externs, ext_obj_map, v_map, ctrl] + in + if tid = 1 + then list_mk_pair [ + list_mk_pair [index1, io, io', aenv], + gscope1, arch_frame_list1, status1 + ] + else list_mk_pair [ + list_mk_pair [index2, io, io', aenv], + gscope2, arch_frame_list2, status2 + ] + end +; + +(* TODO: Move to concurrencySyntax *) +fun thread_state_from_conc_state conc_state tid = + let + val [io, io', n_externs, ext_obj_map, v_map, ctrl, index1, gscope1, arch_frame_list1, status1, index2, gscope2, arch_frame_list2, status2] = strip_pair conc_state + in + if tid = 1 + then list_mk_pair [index1, gscope1, arch_frame_list1, status1] + else list_mk_pair [index2, gscope2, arch_frame_list2, status2] + end +; + +fun get_trace_thread_n arch_name actx conc_state nsteps tid = + let + val arch_state = arch_state_from_conc_state conc_state tid + val other_thread_state = + if tid = 1 + then thread_state_from_conc_state conc_state 2 + else thread_state_from_conc_state conc_state 1 + + val arch_exec_thm = + eval_step_fuel (ascope_ty_from_arch arch_name) actx arch_state nsteps; + + val trace_path_arch_thm = HO_MATCH_MP arch_exec_trace_n arch_exec_thm; + + val trace_path_conc_thm = + if tid = 1 + then HO_MATCH_MP arch_path_implies_conc_thread1 trace_path_arch_thm + else HO_MATCH_MP arch_path_implies_conc_thread2 trace_path_arch_thm; + in + SPEC other_thread_state trace_path_conc_thm + end +; + +fun get_trace_thread_next_n arch_name actx conc_trace_thm nsteps tid = + let + val conc_state_mid = #4 $ dest_trace_path $ concl conc_trace_thm + + val conc_trace_next_n_thm = get_trace_thread_n arch_name actx conc_state_mid nsteps tid + in + HO_MATCH_MP (HO_MATCH_MP conc_paths_compose_alt conc_trace_thm) conc_trace_next_n_thm + end +; + +end diff --git a/hol/p4_concurrentScript.sml b/hol/metatheory/p4_concurrentScript.sml similarity index 100% rename from hol/p4_concurrentScript.sml rename to hol/metatheory/p4_concurrentScript.sml diff --git a/hol/p4_concurrentSyntax.sig b/hol/metatheory/p4_concurrentSyntax.sig similarity index 100% rename from hol/p4_concurrentSyntax.sig rename to hol/metatheory/p4_concurrentSyntax.sig diff --git a/hol/p4_concurrentSyntax.sml b/hol/metatheory/p4_concurrentSyntax.sml similarity index 100% rename from hol/p4_concurrentSyntax.sml rename to hol/metatheory/p4_concurrentSyntax.sml diff --git a/hol/p4_deterScript.sml b/hol/metatheory/p4_deterScript.sml similarity index 94% rename from hol/p4_deterScript.sml rename to hol/metatheory/p4_deterScript.sml index 21871ef0..ffe74680 100644 --- a/hol/p4_deterScript.sml +++ b/hol/metatheory/p4_deterScript.sml @@ -52,8 +52,8 @@ val det_stmt_def = Define ` (********* SAME FRAME and EXP DEF *************) val same_frame_exp_def = Define ` - same_frame_exp (frame:frame_list) frame' (e:e) e' = -((frame = frame') /\ (e = e')) + same_frame_exp (frame:frame_list, i_opt) (frame', i_opt') (e:e) e' = +((frame = frame') /\ (e = e') /\ (i_opt = i_opt')) `; @@ -62,12 +62,12 @@ val same_frame_exp_def = Define ` wich shows that each exression reduction is determ.*) val det_exp_def = Define ` - det_exp e (ty:'a itself) = ! (c: 'a ctx) scope scopest e' e'' frame frame'. -(e_red (c: 'a ctx) scope scopest e e' frame ) + det_exp e (ty:'a itself) = ! (c: 'a ectx) scope scopest e' e'' frame i_opt frame' i_opt'. +(e_red (c: 'a ectx) scope scopest e e' (frame, i_opt) ) /\ -(e_red (c: 'a ctx) scope scopest e e'' frame' ) +(e_red (c: 'a ectx) scope scopest e e'' (frame', i_opt') ) ==> -(same_frame_exp frame frame' e' e'') +(same_frame_exp (frame, i_opt) (frame', i_opt') e' e'') `; @@ -327,7 +327,7 @@ RW_TAC (srw_ss()) [] >| [ IMP_RES_TAC lemma_MAP3>> REV_FULL_SIMP_TAC (list_ss) [rich_listTheory.MAP_FST_funs, same_frame_exp_def, option_case_def] >> REV_FULL_SIMP_TAC (std_ss++optionSimps.OPTION_ss) [option_case_def] >> -` SOME scope' = SOME scope'' +` SOME (scope',i_opt') = SOME (scope'',i_opt) ` by METIS_TAC [SOME_EL,SOME_11] >> REV_FULL_SIMP_TAC (std_ss++optionSimps.OPTION_ss) [option_case_def] , @@ -385,7 +385,7 @@ SOME (MAP (λ(e_,e'_,x_,d_). (x_,d_)) e_e'_x_d_list') ` by METIS_TAC [SOME_EL,SO (**first show that the d is the same in both lists, thus the i = i'*) REV_FULL_SIMP_TAC (srw_ss()) [] >> IMP_RES_TAC lemma_MAP2 >> -`i = i'` by METIS_TAC [ option_case_def]>> rw[] >> rfs[] >> +`i = i''` by METIS_TAC [ option_case_def]>> rw[] >> rfs[] >> (*Now try to show that the EL i l is deterministic*) REV_FULL_SIMP_TAC (srw_ss()) [det_exp_list_def] >> @@ -542,11 +542,8 @@ NTAC 2 STRIP_TAC >|[ (*first case*) REPEAT STRIP_TAC >> rw [] >> -PAT_ASSUM `` ∀c scope scopest e' e'' frame frame'. - e_red c scope scopest e e' frame ∧ - e_red c scope scopest e e'' frame' ⇒ - same_frame_exp frame frame' e' e''`` -( STRIP_ASSUME_TAC o (Q.SPECL [`c`, `scope`, `scopest`, `e'`, `e''`, `frame`, `frame'`])) >> +PAT_ASSUM `` ∀c scope. _`` +( STRIP_ASSUME_TAC o (Q.SPECL [`c`, `scope`, `scopest`, `e'`, `e''`, `frame`, ‘i_opt’, `frame'`, ‘i_opt'’])) >> FULL_SIMP_TAC list_ss [same_frame_exp_def] , @@ -554,18 +551,14 @@ FULL_SIMP_TAC list_ss [same_frame_exp_def] REPEAT STRIP_TAC >> rw [] >> -PAT_ASSUM `` ∀e. MEM e (SND (UNZIP l2)) ⇒ - ∀c scope scopest e' e'' frame frame'. - e_red c scope scopest e e' frame ∧ - e_red c scope scopest e e'' frame' ⇒ - same_frame_exp frame frame' e' e''`` +PAT_ASSUM `` ∀e. MEM e (SND (UNZIP l2)) ⇒ _`` ( STRIP_ASSUME_TAC o (Q.SPECL [`e`])) >> REV_FULL_SIMP_TAC (srw_ss()) [] >> -PAT_ASSUM `` ∀c scope scopest e' e'' frame frame'. - e_red c scope scopest e e' frame ∧ - e_red c scope scopest e e'' frame' ⇒ - same_frame_exp frame frame' e' e''`` -( STRIP_ASSUME_TAC o (Q.SPECL [`c`, `scope`, `scopest`, `e'`, `e''`, `frame`, `frame'`])) >> +PAT_ASSUM `` ∀c scope scopest e' e'' frame i_opt frame' i_opt'. + e_red c scope scopest e e' (frame,i_opt) ∧ + e_red c scope scopest e e'' (frame',i_opt') ⇒ + same_frame_exp (frame,i_opt) (frame',i_opt') e' e''`` +( STRIP_ASSUME_TAC o (Q.SPECL [`c`, `scope`, `scopest`, `e'`, `e''`, `frame`, ‘i_opt’, `frame'`, ‘i_opt'’])) >> FULL_SIMP_TAC list_ss [same_frame_exp_def] ] @@ -604,7 +597,6 @@ Theorem P4_stmt_det: !stmt ty. det_stmt stmt ty Proof - Induct >|[ (*****************************) @@ -626,7 +618,10 @@ REV_FULL_SIMP_TAC (srw_ss()) [] >> (*first + second + third subgoal*) RW_TAC (srw_ss()) [assign_def, same_state_def]>> IMP_RES_TAC lemma_v_red_forall >> -TRY (`SOME scopes_list' = SOME scopes_list''` by METIS_TAC [CLOSED_PAIR_EQ] >> +TRY (`SOME scope_list' = SOME scope_list''''` by METIS_TAC [CLOSED_PAIR_EQ] >> +fs []) >> +rw[] >> +TRY (`(SOME g_scope_list'³',SOME scope_list'³') = (SOME g_scope_list'',SOME scope_list'')` by METIS_TAC [CLOSED_PAIR_EQ] >> fs []) >> rw[] >> rfs[] >> @@ -670,8 +665,9 @@ NTAC 2 (SIMP_TAC (srw_ss()) [det_stmt_def] >> REPEAT STRIP_TAC >> OPEN_STMT_RED_TAC ``stmt_block l stm`` >> REV_FULL_SIMP_TAC (srw_ss()) []) >> -FULL_SIMP_TAC (srw_ss()) [Once same_state_def] - +FULL_SIMP_TAC (srw_ss()) [Once same_state_def] >> +‘(scope,i_opt) = (scope',i_opt')’ by metis_tac[] >> +gvs[] , (*****************************) @@ -709,24 +705,6 @@ OPEN_STMT_RED_TAC ``stmt_empty`` >> REV_FULL_SIMP_TAC (srw_ss()) [] , -(*****************************) -(* stmt_verify *) -(*****************************) -(*(NTAC 2 (SIMP_TAC (srw_ss()) [det_stmt_def] >> -REPEAT STRIP_TAC >> -OPEN_STMT_RED_TAC ``(stmt_verify e e')`` >> -REV_FULL_SIMP_TAC (srw_ss()) []) >> -FULL_SIMP_TAC (srw_ss()) [Once same_state_def]) >> -IMP_RES_TAC lemma_v_red_forall>> -FULL_SIMP_TAC (srw_ss()) [det_exp_def,lemma_v_red_forall] >> -RES_TAC>> -FULL_SIMP_TAC (srw_ss()) [Once same_frame_exp_def]>> -ASSUME_TAC P4_exp_det >> -fs [det_exp_def] >> -RES_TAC >> -fs [same_frame_exp_def] -,*) - (*****************************) (* stmt_trans *) (*****************************) @@ -767,8 +745,6 @@ ASSUME_TAC P4_exp_det >> fs [det_exp_def] >> RES_TAC >> fs [same_frame_exp_def] - - , (*****************************) @@ -778,13 +754,13 @@ fs [same_frame_exp_def] (NTAC 2 (SIMP_TAC (srw_ss()) [det_stmt_def] >> REPEAT STRIP_TAC >> OPEN_STMT_RED_TAC ``(stmt_ext)`` >> -REV_FULL_SIMP_TAC (srw_ss()) []) >> +REV_FULL_SIMP_TAC (srw_ss()) []) >> FULL_SIMP_TAC (srw_ss()) [Once same_state_def] ) >> rw[] >> Cases_on `lookup_ext_fun f ext_map` >> rw[] >> Cases_on `ext_fun (ascope,g_scope_list,sl)`>> -rw[] +rw[] ] QED @@ -936,11 +912,6 @@ rfs[lemma_v_red_forall] -(* -We can never reach the status error... shall we remove it? -*) - - val not_trans_status = prove(`` ! c g_scope_list g_scope_list' f stmt stmt' ss frame_list v v' ascope. diff --git a/hol/p4_e_progressScript.sml b/hol/metatheory/p4_e_progressScript.sml similarity index 94% rename from hol/p4_e_progressScript.sml rename to hol/metatheory/p4_e_progressScript.sml index bb217b21..d03e49af 100644 --- a/hol/p4_e_progressScript.sml +++ b/hol/metatheory/p4_e_progressScript.sml @@ -42,7 +42,7 @@ val _ = new_theory "p4_e_progress"; val prog_exp_def = Define ` prog_exp (e) (ty:'a itself) = !gscope (scopest:scope list) t_scope_list t_scope_list_g - T_e tau b (c:'a ctx) order delta_g delta_b (delta_t:delta_t) delta_x f Prs_n. + T_e tau b (c:'a ectx) order delta_g delta_b (delta_t:delta_t) delta_x f Prs_n. type_scopes_list gscope t_scope_list_g ∧ type_scopes_list scopest t_scope_list ∧ @@ -50,7 +50,7 @@ val prog_exp_def = Define ` ~(is_const e) ∧ e_typ (t_scope_list_g,t_scope_list) T_e e tau b ∧ (T_e = (order, f, (delta_g, delta_b, delta_x, delta_t))) /\ - WT_c c order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n ==> + WT_ec c order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n ==> ?e' framel. e_red c gscope scopest e e' framel `; @@ -1333,32 +1333,36 @@ gvs[] - val wf_imp_ci_abstract_single = prove ( `` -! e d x ss . -wf_arg d x e (ss) ==> -? scope . copyin_abstract [x] [d] [e] (ss) scope``, - -REPEAT STRIP_TAC >> -Q.EXISTS_TAC `[(varn_name x , THE (one_arg_val_for_newscope (d) (e) ss))]` >> +!e d x ss random_oracle. +wf_arg d x e ss ==> +?scope. copyin_abstract [x] [d] [e] ss scope random_oracle``, +rpt strip_tac >> +Q.EXISTS_TAC `[(varn_name x , (\ (a,b). (FST a, b)) $ THE (one_arg_val_for_newscope d e ss oracle_index random_oracle))]` >> fs[copyin_abstract_def] >> -IMP_RES_TAC wf_imp_val_lval >> -gvs[] +rpt strip_tac >> ( + imp_res_tac wf_imp_val_lval +) >- ( + Q.PAT_X_ASSUM ‘!random_oracle i. _’ (fn thm => assume_tac $ Q.SPECL [‘random_oracle’, ‘oracle_index’] thm) >> + gvs[] +) >> +qexists_tac ‘oracle_index’ >> +Q.PAT_X_ASSUM ‘!random_oracle i. _’ (fn thm => assume_tac $ Q.SPECL [‘random_oracle’, ‘oracle_index’] thm) >> +gs[] ); - val wf_imp_new_vlval_list = prove ( `` -! i dl xl el ss. +! i dl xl el ss oracle_index random_oracle. (LENGTH xl = LENGTH dl) /\ (LENGTH dl = LENGTH el) /\ (i < LENGTH dl ) /\ wf_arg_list (dl) (xl) (el) ss ==> -? vlval . one_arg_val_for_newscope (EL i (dl)) (EL i (el)) ss = SOME vlval``, +? vlval . one_arg_val_for_newscope (EL i (dl)) (EL i (el)) ss oracle_index random_oracle = SOME vlval``, Induct_on `xl` >> Induct_on `dl` >> @@ -1372,7 +1376,7 @@ gvs[] >| [ IMP_RES_TAC wf_arg_normalization >> IMP_RES_TAC wf_imp_val_lval >> - srw_tac [SatisfySimps.SATISFY_ss][] + metis_tac[] , IMP_RES_TAC wf_arg_normalization >> @@ -1401,12 +1405,12 @@ gvs[] >| [ val wf_arg_list_NONE2 = prove (`` -! dl xl el ss . +! dl xl el ss oracle_index random_oracle. (LENGTH xl = LENGTH dl) /\ (LENGTH dl = LENGTH el) /\ wf_arg_list dl xl el ss /\ ALL_DISTINCT xl ==> -~ (all_arg_update_for_newscope xl dl el ss = NONE)``, +~ (all_arg_update_for_newscope xl dl el ss oracle_index random_oracle = NONE)``, REPEAT STRIP_TAC >> fs[all_arg_update_for_newscope_def] >> @@ -1414,7 +1418,7 @@ ASSUME_TAC wf_arg_list_NONE >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ZIP (dl,ZIP (xl,el))`])) >> gvs[] >> -FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ss`])) >> +FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ss`, ‘oracle_index’, ‘random_oracle’])) >> gvs[] >| [ `(MAP (λ(d,x,e). x) (ZIP (dl,ZIP (xl,el)))) = xl` by gvs[GSYM map_distrub] >> @@ -1433,28 +1437,29 @@ gvs[] >| [ -val copyin_eq_rw = prove ( `` -! xl dl el gscope scopest scope. +val copyin_imp_rw = prove ( `` +! xl dl el gscope scopest scope oracle_index random_oracle. (LENGTH xl = LENGTH dl) /\ (LENGTH dl = LENGTH el) /\ (ALL_DISTINCT xl) ∧ (wf_arg_list dl xl el (scopest ⧺ gscope)) ==> -( (SOME scope = copyin xl dl el gscope scopest) -<=> -copyin_abstract xl dl el (scopest ⧺ gscope) scope) +((?i_opt. SOME (scope, i_opt) = copyin xl dl el gscope scopest oracle_index random_oracle) +==> +copyin_abstract xl dl el (scopest ⧺ gscope) scope random_oracle) ``, REPEAT STRIP_TAC >> -ASSUME_TAC copyin_eq >> +ASSUME_TAC copyin_imp >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ZIP (el,ZIP (xl,dl))`, `gscope`, - `scopest`, `scope`])) >> + `scopest`, `scope`, ‘oracle_index’, ‘random_oracle’])) >> gvs[] >> `(MAP (λ(e,x,d). x) (ZIP (el,ZIP (xl,dl)))) = xl` by gvs[GSYM map_distrub] >> `(MAP (λ(e,x,d). d) (ZIP (el,ZIP (xl,dl)))) = dl` by gvs[GSYM map_distrub] >> `(MAP (λ(e,x,d). e) (ZIP (el,ZIP (xl,dl)))) = el` by gvs[GSYM map_distrub] >> -gvs[] +gvs[] >> +metis_tac[] ); @@ -1478,7 +1483,6 @@ Theorem PROG_e: (! (l2: (string#e) list) . prog_strexp_list l2 ty) /\ (! tup. prog_strexp_tup tup ty) Proof - STRIP_TAC >> Induct >| [ @@ -1929,7 +1933,7 @@ gvs[is_const_def, clause_name_def] >> (* the cases should be on if there is an element unreduced yet? *) Cases_on ` (unred_arg_index (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list) - (MAP (λ(e_,tau_,x_,d_,b_). e_) e_tau_x_d_b_list) = NONE) ` >| [ + (MAP (λ(e_,tau_,x_,d_,b_). e_) e_tau_x_d_b_list) = NONE)` >| [ DISJ1_TAC >> @@ -1937,10 +1941,15 @@ Cases_on ` (unred_arg_index (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list) ASSUME_TAC tfunn_imp_sig_body_lookup >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`c0`, `c1`, `c2`, `c3`, `c4`, `c5`, `order`, `t_scope_list_g`, + [`c0`, `c1`, `c2`, `c3`, `c4`, `c5`, + ‘get_oracle_index’, ‘set_oracle_index’, ‘c7’, + `order`, `t_scope_list_g`, `delta_g`, `delta_b`, `delta_x`, `(MAP (λ(e_,tau_,x_,d_,b_).(tau_,x_,d_)) (e_tau_x_d_b_list : (e # tau # string # d # bool) list))`, `tau'`, `f` , ‘delta_t’, ‘Prs_n’ ])) >> gvs[] >> + assume_tac $ Q.SPECL + [`c0`, `c1`, `c2`, `c3`, `c4`, `c5`, ‘get_oracle_index’, ‘set_oracle_index’, ‘c6’, ‘c7’] $ GSYM WT_c_ec >> + gs[] >> Q.EXISTS_TAC `ZIP ((MAP (λ(e_,tau_,x_,d_,b_). e_) e_tau_x_d_b_list), ZIP(MAP FST xdl,MAP SND xdl))` >> @@ -1970,7 +1979,7 @@ Cases_on ` (unred_arg_index (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list) (*show that the copyin_abstract is implied by the wfness of args *) - ASSUME_TAC copyin_eq_rw >> + ASSUME_TAC copyin_imp_rw >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`(MAP FST (xdl : (string # d) list))`, `(MAP (λ(e_,tau_,x_,d_,b_). d_) (e_tau_x_d_b_list : (e # tau # string # d # bool) list))`, @@ -1978,19 +1987,21 @@ Cases_on ` (unred_arg_index (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list) `gscope`, `scopest`, `scope`])) >> gvs[] >> gvs[] >> - - Q.EXISTS_TAC `THE(copyin (MAP FST xdl) (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list) - (MAP (λ(e_,tau_,x_,d_,b_). e_) e_tau_x_d_b_list) gscope scopest)` >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPECL [‘c6’, ‘c7’] thm) >> + Q.EXISTS_TAC `FST $ THE(copyin (MAP FST xdl) (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list) + (MAP (λ(e_,tau_,x_,d_,b_). e_) e_tau_x_d_b_list) gscope scopest c6 c7)` >> gvs[] >> - Cases_on ` copyin (MAP FST xdl) (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list) - (MAP (λ(e_,tau_,x_,d_,b_). e_) e_tau_x_d_b_list) gscope scopest` >| [ + Cases_on `copyin (MAP FST xdl) (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list) + (MAP (λ(e_,tau_,x_,d_,b_). e_) e_tau_x_d_b_list) gscope scopest c6 c7` >| [ IMP_RES_TAC wf_arg_list_NONE2 >> gvs[] >> - fs[copyin_def] + gvs[copyin_def, AllCaseEqs()] , - gvs[] + gvs[] >> + qexists_tac ‘SND x’ >> + gs[] ] , @@ -2002,7 +2013,9 @@ Cases_on ` (unred_arg_index (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list) (* first show that we can indeed find a map for the function f in the context *) ASSUME_TAC tfunn_imp_sig_lookup >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`c0`, `c1`, `c2`, `c3`, `c4`, `c5`, `order`, `t_scope_list_g`, + [`c0`, `c1`, `c2`, `c3`, `c4`, `c5`, + ‘get_oracle_index’, ‘set_oracle_index’, ‘c7’, + `order`, `t_scope_list_g`, `delta_g`, `delta_b`, `delta_x`, `(MAP (λ(e_,tau_,x_,d_,b_).(tau_,x_,d_)) (e_tau_x_d_b_list : (e # tau # string # d # bool) list))`, `tau'`, `f`, ‘delta_t’, ‘Prs_n’])) >> gvs[] >> @@ -2027,11 +2040,14 @@ Cases_on ` (unred_arg_index (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list) [`gscope`, `scopest`, `t_scope_list`, `t_scope_list_g`, `(t_tau (EL i (MAP (λ(e_,tau_,x_,d_,b_). tau_) (e_tau_x_d_b_list : (e # tau # string # d # bool) list))))`, `(EL i (MAP (λ(e_,tau_,x_,d_,b_). b_) (e_tau_x_d_b_list : (e # tau # string # d # bool) list)))`, - `(c0,c1,c2,c3,c4,c5)`, `order`, `delta_g`, `delta_b`, `delta_t`, `delta_x`, `f'`, ‘Prs_n’])) >> gvs[] >> - + `(c0,c1,c2,c3,c4,c5,c6,c7)`, `order`, `delta_g`, `delta_b`, `delta_t`, `delta_x`, `f'`, ‘Prs_n’])) >> gvs[] >> IMP_RES_TAC unred_arg_index_result >| [ (* if d is in/none, then it shouldn't be a constant in order to reduce it *) gvs[] >> + (* TODO: Why doesn't it work to rewrite? *) + assume_tac $ Q.SPECL + [`c0`, `c1`, `c2`, `c3`, `c4`, `c5`, ‘get_oracle_index’, ‘set_oracle_index’, ‘c6’, ‘c7’] $ GSYM WT_c_ec >> + gs[] >> Q.EXISTS_TAC `framel` >> Q.EXISTS_TAC `ZIP ( MAP (λ(e_,tau_,x_,d_,b_). e_) e_tau_x_d_b_list , @@ -2064,6 +2080,10 @@ Cases_on ` (unred_arg_index (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list) IMP_RES_TAC notlval_case >| [ gvs[] >> + (* TODO: Why doesn't it work to rewrite? *) + assume_tac $ Q.SPECL + [`c0`, `c1`, `c2`, `c3`, `c4`, `c5`, ‘get_oracle_index’, ‘set_oracle_index’, ‘c6’, ‘c7’] $ GSYM WT_c_ec >> + gs[] >> Q.EXISTS_TAC `framel` >> Q.EXISTS_TAC `ZIP ( MAP (λ(e_,tau_,x_,d_,b_). e_) e_tau_x_d_b_list , @@ -2155,7 +2175,7 @@ srw_tac [boolSimps.DNF_ss][] >> Cases_on `is_consts (MAP (λ(f_,e_,tau_,b_). (e_)) f_e_tau_b_list)` >| [ (* starting from the left disjuction if all members are constsants then we know that - vl_of_el actually exsists *) + vl_of_el actually exists *) DISJ2_TAC >> @@ -2246,7 +2266,7 @@ srw_tac [boolSimps.DNF_ss][] >> Cases_on `is_consts (MAP (λ(f_,e_,tau_,b_). (e_)) f_e_tau_b_list)` >| [ (* starting from the left disjuction if all members are constsants then we know that - vl_of_el actually exsists *) + vl_of_el actually exists *) DISJ2_TAC >> diff --git a/hol/p4_e_subject_reductionScript.sml b/hol/metatheory/p4_e_subject_reductionScript.sml similarity index 73% rename from hol/p4_e_subject_reductionScript.sml rename to hol/metatheory/p4_e_subject_reductionScript.sml index e3d6dfd6..f0ef0773 100644 --- a/hol/p4_e_subject_reductionScript.sml +++ b/hol/metatheory/p4_e_subject_reductionScript.sml @@ -61,25 +61,42 @@ val t_passed_elem_def = Define ‘ - +Theorem WT_c_ec: +!apply_table_f ext_map func_map b_func_map pars_map tbl_map + get_oracle_index set_oracle_index oracle_index random_oracle + order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n. +WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle) + order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n <=> +WT_ec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + oracle_index, random_oracle) + order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n +Proof +rpt strip_tac >> +gs[WT_c_cases, WT_ec_cases] >> +eq_tac >> ( + rpt strip_tac >> ( + gs[clause_name_def] + ) +) +QED (****** Subject Reduction for expression ******) -(*t_scopes_consistent is with respect to the expression's global, not the passed, because at that point we are comparing with respect to the passed scope that is already exsists in the expression *) +(*t_scopes_consistent is with respect to the expression's global, not the passed, because at that point we are comparing with respect to the passed scope that is already exists in the expression *) val sr_exp_def = Define ` sr_exp (e) (ty:'a itself) = - ! e' gscope (scopest:scope list) framel t_scope_list t_scope_list_g T_e tau b - (c:'a ctx) order delta_g delta_b delta_t delta_x f f_called stmt_called copied_in_scope Prs_n - apply_table_f ext_map func_map b_func_map pars_map tbl_map . + ! e' gscope (scopest:scope list) framel i_opt t_scope_list t_scope_list_g T_e tau b + (ec:'a ectx) order delta_g delta_b delta_t delta_x f f_called stmt_called copied_in_scope Prs_n + apply_table_f ext_map func_map b_func_map pars_map tbl_map oracle_index random_oracle . (type_scopes_list (gscope) (t_scope_list_g) ) /\ (type_scopes_list (scopest) (t_scope_list)) /\ (star_not_in_sl (scopest) ) /\ - (* (parseError_in_gs t_scope_list_g [t_scope_list]) ∧ *) - (c = ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ) ∧ - (WT_c c order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n) /\ - (e_red c gscope scopest e e' framel ) /\ + (ec = ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , oracle_index , random_oracle ) ) ∧ + (WT_ec ec order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n) /\ + (e_red ec gscope scopest e e' (framel, i_opt) ) /\ (e_typ ( t_scope_list_g , t_scope_list ) T_e (e) tau b) /\ (T_e = (order, f, (delta_g, delta_b, delta_x, delta_t))) ==> @@ -136,7 +153,7 @@ val vl_el_conv = prove( `` (l' = el_of_vl l) ``, Induct_on `l` >> Induct_on `l'` >> -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[el_of_vl_def, vl_of_el_def] >> rw[] >> Cases_on `h` >> @@ -160,7 +177,7 @@ val ev_types_v = prove (`` e_typ (t_scope_list_g,t_scope_list) T_e (e_v v) (tau) F ==> v_typ (v) (tau) F ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> OPEN_EXP_TYP_TAC ``e_v v`` >> fs[] ) ; @@ -175,7 +192,7 @@ val e_types_v = prove (`` e_typ (t_scope_list_g,t_scope_list) T_e (e) (tau) F ==> v_typ ( THE (v_of_e e)) (tau) F ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> OPEN_EXP_TYP_TAC ``e`` >> fs[] >> fs[v_of_e_def, is_const_def] @@ -191,7 +208,7 @@ Theorem EL_consts_is_const: !l i. i < LENGTH l /\ is_consts (l) ==> is_const (EL i (l)) Proof -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[is_consts_def] >> fs[is_const_def] >> fs[EVERY_EL] @@ -218,7 +235,7 @@ v_typ (EL i (vl_of_el l)) (t_tau (EL i l')) F ``, Induct_on `l` >> Induct_on `l'` >> fs[] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> (* first we know that each member of the e list is a constant, via: *) ASSUME_TAC EL_consts_is_const >> @@ -321,7 +338,7 @@ Induct_on `l'` >> Induct_on `l''` >> fs[] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> (* we already know that this should hold whever v is an not an lval from evl_types_vl_F so we need to make cases on the bool representation of the lval, and show that if the value is lval, this is incorrect, else use theorem evl_types_vl_F *) @@ -373,7 +390,7 @@ Induct_on `tc` >> RW_TAC list_ss [similar_def] >> rw[ALOOKUP_MEM] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> PairCases_on `h` >> PairCases_on `h'` >> fs[similar_def] >> @@ -406,7 +423,7 @@ RW_TAC list_ss [similar_def] >> rw[ALOOKUP_MEM] >> FULL_SIMP_TAC list_ss [ALOOKUP_def, ALOOKUP_MEM] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> PairCases_on `h` >> PairCases_on `h'` >> fs[similar_def] >> @@ -553,7 +570,7 @@ Theorem R_topmost_map_scopesl: Proof simp [topmost_map_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `find_topmost_map scl x` >> Cases_on `find_topmost_map tcl x` >> @@ -582,7 +599,7 @@ Theorem R_lookup_map_scopesl: Proof fs[lookup_map_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `topmost_map tcl x` >> Cases_on `topmost_map scl x` >> @@ -617,7 +634,7 @@ Theorem type_scopes_list_LENGTH: (LENGTH l1 = LENGTH l2) Proof fs[type_scopes_list_def, similarl_def, similar_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> IMP_RES_TAC LIST_REL_LENGTH QED @@ -628,7 +645,7 @@ Theorem type_scopes_list_APPEND: type_scopes_list (l1++l3) (l2++l4) Proof fs[type_scopes_list_def, similarl_def, similar_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> IMP_RES_TAC LIST_REL_APPEND QED @@ -643,7 +660,7 @@ val varn_is_typed = prove (`` v_typ v (t_tau tau) F ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> IMP_RES_TAC type_scopes_list_LENGTH >> fs[lookup_vexp2_def] >> @@ -682,7 +699,7 @@ val star_MEM = prove ( `` !s f. star_not_in_s (s) ==> ~MEM (varn_star f) (MAP FST s) ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[star_not_in_s_def] >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL @@ -702,7 +719,7 @@ val star_not_in_s_implies_none = prove ( `` ``, Induct >> fs[star_not_in_s_def, INDEX_FIND_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> RES_TAC >> fs[P_NONE_hold] ); @@ -715,7 +732,7 @@ star_not_in_sl sl ==> SOME (v,lvalop) = lookup_map gsl (varn_star f) Proof -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[star_not_in_sl_def] >> fs[lookup_vexp2_def] >> @@ -783,7 +800,7 @@ star_not_in_sl sl ==> SOME v = lookup_vexp2 [] gsl (varn_star f) Proof -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[lookup_vexp2_def] >> Cases_on `lookup_map (sl ⧺ gsl) (varn_star f)` >> @@ -807,7 +824,7 @@ Theorem lookup_map_none_lemma1: (ALOOKUP (EL 1 t_scope_list_g) (varn) = NONE /\ ALOOKUP (EL 0 t_scope_list_g) (varn) = NONE) Proof -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[lookup_map_def] >> fs[topmost_map_def] >> fs[find_topmost_map_def] >> @@ -856,7 +873,7 @@ ALOOKUP b_func_map s = SOME (stmt_called,xdl) /\ ALOOKUP delta_b s = SOME (txdl,tau)) ) ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[lookup_funn_sig_def, lookup_funn_sig_body_def] >> fs[t_lookup_funn_def] >> rfs[] >> rw[] >> @@ -926,7 +943,7 @@ dom_tmap_ei delta_g delta_b ==> ( SOME (txdl',tau') = t_lookup_funn f delta_g delta_b delta_x) /\ (txdl = txdl' /\ tau = tau'))``, -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `f` >> fs[t_lookup_funn_def] >> @@ -945,7 +962,7 @@ dom_tmap_ei delta_g delta_b ==> (? tau' txdl' . ( SOME (txdl',tau') = t_lookup_funn f delta_g delta_b delta_x) /\ (txdl = txdl' /\ tau = tau'))``, -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[t_lookup_funn_def] >> REPEAT (BasicProvers.FULL_CASE_TAC >> gvs[]) >> @@ -969,7 +986,7 @@ SOME (txdl,tau) = t_lookup_funn (f) [] delta_b [] ==> ( SOME (txdl',tau') = t_lookup_funn f delta_g delta_b delta_x) /\ (txdl = txdl' /\ tau = tau')) ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `f` >> fs[t_lookup_funn_def] >> Cases_on `ALOOKUP delta_b s` >> @@ -985,7 +1002,7 @@ SOME (txdl,tau) = t_lookup_funn (f) [] [] delta_x ==> (txdl = txdl' /\ tau = tau')) Proof -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `f` >> fs[t_lookup_funn_def] QED @@ -999,10 +1016,10 @@ QED val WT_c_imp_global_or_local_lookup = prove ( `` ! func_map delta_g func_map delta_b b_func_map s stmt_called -xdl ext_map delta_x order t_scope_list_g pars_map tbl_map stmt apply_table_f delta_t Prs_n. +xdl ext_map delta_x order t_scope_list_g pars_map tbl_map set_oracle_index get_oracle_index random_oracle stmt apply_table_f delta_t Prs_n. SOME (stmt,xdl) = lookup_funn_sig_body (funn_name s) func_map b_func_map ext_map /\ -WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) +WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,set_oracle_index,get_oracle_index,random_oracle) order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n ==> ((ALOOKUP func_map s = SOME (stmt,xdl) /\ @@ -1018,7 +1035,7 @@ ALOOKUP b_func_map s = SOME (stmt,xdl) /\ ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[lookup_funn_sig_def, lookup_funn_sig_body_def] >> fs[t_lookup_funn_def] >> rfs[] >> rw[] >> @@ -1097,11 +1114,11 @@ fs[] >| [ Theorem Fg_star_lemma1: ! t_scope_list_g f func_map delta_g delta_b delta_x order b_func_map gscope (ext_map: 'a ext_map) - stmt xdl apply_table_f pars_map tbl_map delta_t Prs_n. + stmt xdl apply_table_f pars_map tbl_map set_oracle_index get_oracle_index random_oracle delta_t Prs_n. type_scopes_list gscope t_scope_list_g ∧ SOME (stmt,xdl) = lookup_funn_sig_body f func_map b_func_map ext_map /\ - WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) + WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,set_oracle_index,get_oracle_index,random_oracle) order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n ==> ( ? tau txdl. SOME (txdl,tau) = t_lookup_funn f delta_g delta_b delta_x /\ @@ -1109,7 +1126,7 @@ Theorem Fg_star_lemma1: Proof Cases_on `f` >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ (* global and blk functions *) @@ -1185,19 +1202,19 @@ QED Theorem Fg_star_lemma2: ! t_scope_list_g f func_map tau delta_g delta_b delta_x order b_func_map gscope (ext_map: 'a ext_map) tau txdl - stmt xdl apply_table_f pars_map tbl_map delta_t Prs_n. + stmt xdl apply_table_f pars_map tbl_map set_oracle_index get_oracle_index random_oracle delta_t Prs_n. type_scopes_list gscope t_scope_list_g ∧ SOME (stmt,xdl) = lookup_funn_sig_body f func_map b_func_map ext_map /\ - WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) + WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,set_oracle_index,get_oracle_index,random_oracle) order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n /\ SOME (txdl,tau) = t_lookup_funn f delta_g delta_b delta_x ==> (? tau' . SOME tau' = find_star_in_globals t_scope_list_g (varn_star f) /\ tau = tau' ) Proof -REPEAT STRIP_TAC >> +rpt strip_tac >> IMP_RES_TAC Fg_star_lemma1 >> gvs[] >> Cases_on `t_lookup_funn f delta_g delta_b delta_x` >> rfs[] >> @@ -1208,20 +1225,20 @@ QED val e_resulted_frame_is_WT = prove ( `` -! (c:'a ctx) gscope scopest e e' f_called stmt_called copied_in_scope +! (ec:'a ectx) gscope scopest e e' f_called stmt_called copied_in_scope i_opt t_scope_list_g t_scope_list order delta_g delta_b delta_x delta_t f (ty:'a itself) b tau - apply_table_f ext_map func_map b_func_map pars_map tbl_map Prs_n. + apply_table_f ext_map func_map b_func_map pars_map tbl_map oracle_index random_oracle Prs_n. - e_red c gscope scopest e e' [(f_called,[stmt_called],copied_in_scope)] /\ + e_red ec gscope scopest e e' ([(f_called,[stmt_called],copied_in_scope)], i_opt) /\ sr_exp e ty /\ - (c= (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)) /\ + (ec= (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,oracle_index,random_oracle)) /\ type_scopes_list gscope t_scope_list_g /\ type_scopes_list scopest t_scope_list /\ star_not_in_sl scopest /\ (*parseError_in_gs t_scope_list_g [t_scope_list] ∧ *) e_typ (t_scope_list_g,t_scope_list) (order,f,delta_g,delta_b,delta_x,delta_t) e (tau) b /\ - WT_c c order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n + WT_ec ec order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n ==> ∃passed_tslg passed_delta_t passed_delta_b passed_gscope t_scope_list_fr. order (order_elem_f f_called) (order_elem_f f) ∧ @@ -1230,15 +1247,15 @@ val e_resulted_frame_is_WT = prove ( `` t_scopes_consistent (order,f,delta_g,delta_b,delta_x,delta_t) t_scope_list t_scope_list_g t_scope_list_fr ∧ frame_typ (passed_tslg,t_scope_list_fr) (order,f_called,delta_g,passed_delta_b,delta_x,passed_delta_t) Prs_n passed_gscope copied_in_scope [stmt_called] ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> gvs[] >> Q.PAT_X_ASSUM `sr_exp e ty` ((STRIP_ASSUME_TAC o (Q.SPECL - [`e'`, `gscope`, `scopest` , `[(f_called,[stmt_called],copied_in_scope)]`, `t_scope_list`, `t_scope_list_g`, `tau`, `b`, + [`e'`, `gscope`, `scopest` , `[(f_called,[stmt_called],copied_in_scope)]`, ‘i_opt’, `t_scope_list`, `t_scope_list_g`, `tau`, `b`, `order`, `delta_g`, `delta_b`, `delta_t`, `delta_x`, `f`, ‘f_called’, ‘stmt_called’ , ‘copied_in_scope’, ‘Prs_n’, - ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) o SIMP_RULE (srw_ss()) [sr_exp_def]) >> + ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’, ‘oracle_index’, ‘random_oracle’])) o SIMP_RULE (srw_ss()) [sr_exp_def]) >> gvs[] >> srw_tac [SatisfySimps.SATISFY_ss][] @@ -1256,7 +1273,7 @@ dom_x_eq delta_x ext_map ==> lookup_funn_sig_body (f) func_map b_func_map ext_map = NONE) Proof -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[lookup_funn_sig_def, lookup_funn_sig_body_def] >> fs[t_lookup_funn_def] >> rfs[] >> rw[] >> @@ -1362,10 +1379,10 @@ QED Theorem tfunn_imp_sig_body_lookup: -! apply_table_f ext_map func_map b_func_map pars_map tbl_map +! apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle order t_scope_list_g delta_g delta_b delta_x txdl tau f delta_t Prs_n. -WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) - order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n/\ +WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) + order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n /\ SOME (txdl,tau) = t_lookup_funn f delta_g delta_b delta_x ==> ?stmt xdl. SOME (stmt,xdl) = @@ -1378,7 +1395,7 @@ SOME (txdl,tau) = t_lookup_funn f delta_g delta_b delta_x ==> Proof fs[WT_c_cases] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `lookup_funn_sig_body f func_map b_func_map ext_map` >> gvs[] >| [ (* show that this is impossible *) @@ -1502,9 +1519,9 @@ QED Theorem tfunn_imp_sig_lookup: -! apply_table_f ext_map func_map b_func_map pars_map tbl_map +! apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle order t_scope_list_g delta_g delta_b delta_x txdl tau f delta_t Prs_n . - WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) + WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n /\ SOME (txdl,tau) = t_lookup_funn f delta_g delta_b delta_x ==> ? xdl. @@ -1514,7 +1531,7 @@ Theorem tfunn_imp_sig_lookup: ALL_DISTINCT (MAP FST xdl) Proof -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[lookup_funn_sig_def] >> Cases_on `lookup_funn_sig_body f func_map b_func_map ext_map` >> fs[] >| [ @@ -1552,7 +1569,7 @@ fs[EVERY_EL] >> Induct_on `bl` >> Induct_on `dl` >> gvs[] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `n` >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`0`])) >> @@ -1586,7 +1603,7 @@ fs[out_is_lval_def] >> Induct_on `bl` >> Induct_on `dl` >> gvs[] >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ Cases_on `i` >> fs[Once EL_restricted] >> @@ -1613,7 +1630,7 @@ Induct_on `dl` >> Induct_on `el` >> fs[unred_arg_index_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[find_unred_arg_def] >> fs[INDEX_FIND_def] >| [ (* first two subgoals *) @@ -1688,7 +1705,7 @@ QED val unred_arg_index_in_range2 = prove ( “ ∀dl el i. unred_arg_index dl el = SOME i ⇒ i < LENGTH dl ”, - REPEAT STRIP_TAC >> + rpt strip_tac >> fs[unred_arg_index_def] >> fs[find_unred_arg_def] >> Cases_on `INDEX_FIND 0 (λ(d,e). ¬is_arg_red d e) (ZIP (dl,el))` >> @@ -1706,7 +1723,7 @@ Theorem unred_arg_out_is_lval_imp: unred_arg_index dl el = SOME i ∧ out_is_lval dl bl ⇒ EL i bl ∨ EL i dl = d_none ∨ EL i dl = d_in Proof -REPEAT STRIP_TAC >> +rpt strip_tac >> IMP_RES_TAC unred_arg_index_details>> fs[out_is_lval_def] >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`i`])) >> @@ -1721,14 +1738,15 @@ QED val dir_fun_delta_same = prove ( `` ! xdl txdl ftau f func_map b_func_map ext_map delta_g delta_b delta_x -apply_table_f order t_scope_list_g pars_map tbl_map delta_t Prs_n. -WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) +apply_table_f order t_scope_list_g pars_map tbl_map get_oracle_index +set_oracle_index random_oracle delta_t Prs_n. +WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n /\ SOME (xdl) = lookup_funn_sig f func_map b_func_map ext_map /\ SOME (txdl, ftau) = t_lookup_funn f delta_g delta_b delta_x ==> MAP (λ(t,x,d). d) txdl = MAP SND xdl ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> IMP_RES_TAC tfunn_imp_sig_lookup >> gvs[] >> Cases_on `lookup_funn_sig f func_map b_func_map ext_map` >> rfs[] @@ -1746,7 +1764,7 @@ SOME (txdl,tau) = t_lookup_funn (f) delta_g delta_b delta_x /\ SOME (txdl',tau') = t_lookup_funn (f) delta_g delta_b delta_x ==> (tau = tau') /\ (txdl= txdl') ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `t_lookup_funn f delta_g delta_b delta_x` >> gvs[] ); @@ -1760,7 +1778,7 @@ Proof Induct >> -REPEAT STRIP_TAC >~ [`is_e_lval (e_acc e s)`] >- +rpt strip_tac >~ [`is_e_lval (e_acc e s)`] >- ( OPEN_EXP_TYP_TAC ``(e_acc e s)`` >> fs[] >> @@ -1800,288 +1818,6 @@ QED (** context related theorems **) - - - - -(* -if the expression can be typed using only the global functions typing context, -then it should be also typed with any other block, and extern typuying contexts. -*) -(* -val fg_e_typ_def = Define ` - fg_e_typ (e:e) (ty:'a itself) = - (! s tau b order t_scope_list_g t_scope_local delta_g delta_b delta_x delta_t . -dom_tmap_ei delta_g delta_b /\ -e_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,[],delta_x,[]) e tau b -==> -e_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,delta_b,delta_x,delta_t) e tau b ) -`; - - - -val fg_el_typ_def = Define ` - fg_el_typ (el:e list) (ty:'a itself) = - ! e . MEM e el ==> fg_e_typ (e:e) (ty:'a itself) -`; - - -val fg_stel_typ_def = Define ` - fg_stel_typ (stel: (string#e) list ) (ty:'a itself) = - ! e . MEM e (SND (UNZIP stel)) ==> fg_e_typ (e:e) (ty:'a itself) -`; - - - -val fg_stetup_typ_def = Define ` - fg_stetup_typ (stetup: (string#e)) (ty:'a itself) = - fg_e_typ (SND stetup) ty -`; - - - - - -val fg_e_typed_tac = TRY( OPEN_EXP_TYP_TAC ``(e)``) >> - SIMP_TAC list_ss [Once e_typ_cases] >> - gvs[] >> - RES_TAC >> - IMP_RES_TAC t_lookup_funn_lemma >> - srw_tac [SatisfySimps.SATISFY_ss][] >> - METIS_TAC[] - - - -val fg_exp_typed_thm = prove ( `` - ! (ty:'a itself) . ( -(! e . fg_e_typ (e) ty) /\ -(! el . fg_el_typ (el) ty) /\ -(! stel . fg_stel_typ (stel) ty) /\ -(! stetup . fg_stetup_typ (stetup) ty)) -``, - -STRIP_TAC >> -Induct >> -fs[fg_e_typ_def] >> -REPEAT STRIP_TAC >> - - FIRST [ - (* resolves the : f call*) - - OPEN_EXP_TYP_TAC ``(e_call f l)`` >> - SIMP_TAC list_ss [Once e_typ_cases] >> - gvs[] >> - RES_TAC >> - Q.EXISTS_TAC `e_tau_x_d_b_list` >> - gvs[] >> - - CONJ_TAC >| [ - rw[] >> - IMP_RES_TAC t_lookup_funn_lemma >> - srw_tac [SatisfySimps.SATISFY_ss][] >> - gvs[] - , - - REPEAT STRIP_TAC >> - fs[fg_el_typ_def, fg_e_typ_def] >> - RES_TAC >> - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`EL i (MAP (λ(e_,tau_,d_,b_). e_) (e_tau_d_b_list: (e # tau # d # bool) list))`])) >> - fs[MEM_EL] >> - - RES_TAC >> - gvs[ELIM_UNCURRY] - ] - , - - (* resolves the : struct, header*) - - fs[fg_stel_typ_def, fg_e_typ_def] >> - OPEN_EXP_TYP_TAC ``(e_struct stel)`` >> - SIMP_TAC list_ss [Once e_typ_cases] >> - gvs[] >> - RES_TAC >> - Q.EXISTS_TAC `f_e_tau_b_list` >> - gvs[] >> - - REPEAT STRIP_TAC >> - RES_TAC >> - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`EL i (MAP (λ(f_,e_,tau_,b_). e_) (f_e_tau_b_list: (string # e # tau # bool) list))`])) >> - fs[MEM_EL] >> - - subgoal `! l i . EL i (MAP (λx. FST (SND x)) l) = - EL i (SND (UNZIP (MAP (λx. (FST x,FST (SND x))) l)))` >- - (Induct >> - FULL_SIMP_TAC list_ss [MAP_MAP_o, FST,SND] >> - REPEAT STRIP_TAC >> - PairCases_on `h` >> - Cases_on `i'` >> - fs[] ) >> - - RES_TAC >> - SRW_TAC [] [] >> - gvs[ELIM_UNCURRY, UNZIP_rw] - , - - (* resolves the : v, var, e_list, acc e s, unop, binop, concat, slice, select*) - - fg_e_typed_tac - , - - (* resolves the : inductive cases on the properties *) - fs[fg_e_typ_def, fg_el_typ_def, fg_stel_typ_def, fg_stetup_typ_def] >> - REPEAT STRIP_TAC >> - gvs[] -] -); - - - - - - - - -(* -if the expression can be typed using the global, block local, and x functions typing context, -then it should be also typed with tables typing contexts. -*) -val fb_e_typ_def = Define ` - fb_e_typ (e:e) (ty:'a itself) = - (! s tau b order t_scope_list_g t_scope_local delta_g delta_b delta_x delta_t . -dom_tmap_ei delta_g delta_b /\ -e_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,delta_b,delta_x,[]) e tau b -==> -e_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,delta_b,delta_x,delta_t) e tau b ) -`; - - - -val fb_el_typ_def = Define ` - fb_el_typ (el:e list) (ty:'a itself) = - ! e . MEM e el ==> fb_e_typ (e:e) (ty:'a itself) -`; - - -val fb_stel_typ_def = Define ` - fb_stel_typ (stel: (string#e) list ) (ty:'a itself) = - ! e . MEM e (SND (UNZIP stel)) ==> fb_e_typ (e:e) (ty:'a itself) -`; - - - -val fb_stetup_typ_def = Define ` - fb_stetup_typ (stetup: (string#e)) (ty:'a itself) = - fb_e_typ (SND stetup) ty -`; - - - - - -val fb_e_typed_tac = TRY( OPEN_EXP_TYP_TAC ``(e)``) >> - SIMP_TAC list_ss [Once e_typ_cases] >> - gvs[] >> - RES_TAC >> - IMP_RES_TAC t_lookup_funn_lemma >> - srw_tac [SatisfySimps.SATISFY_ss][] >> - METIS_TAC[] - - - -Theorem fb_exp_typed_thm: - ! (ty:'a itself) . ( -(! e . fb_e_typ (e) ty) /\ -(! el . fb_el_typ (el) ty) /\ -(! stel . fb_stel_typ (stel) ty) /\ -(! stetup . fb_stetup_typ (stetup) ty)) -Proof - -STRIP_TAC >> -Induct >> -fs[fb_e_typ_def] >> -REPEAT STRIP_TAC >> - -FIRST [ - - -(* resolves the : f call*) - -OPEN_EXP_TYP_TAC ``(e_call f l)`` >> -SIMP_TAC list_ss [Once e_typ_cases] >> -gvs[] >> -RES_TAC >> -Q.EXISTS_TAC `e_tau_d_b_list` >> -gvs[] >> - - REPEAT STRIP_TAC >> - fs[fb_el_typ_def, fb_e_typ_def] >> - RES_TAC >> - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`EL i (MAP (λ(e_,tau_,d_,b_). e_) (e_tau_d_b_list: (e # tau # d # bool) list ) ) `])) >> - fs[MEM_EL] >> - - RES_TAC >> - gvs[ELIM_UNCURRY] - -, - -(* resolves the : struct, header*) - -fs[fb_stel_typ_def, fb_e_typ_def] >> -OPEN_EXP_TYP_TAC ``(e_struct stel)`` >> -SIMP_TAC list_ss [Once e_typ_cases] >> -gvs[] >> -RES_TAC >> -Q.EXISTS_TAC `f_e_tau_b_list` >> -gvs[] >> - -REPEAT STRIP_TAC >> -RES_TAC >> - -FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL -[`EL i (MAP (λ(f_,e_,tau_,b_). e_) (f_e_tau_b_list: (string # e # tau # bool) list ) ) ` -])) >> -fs[MEM_EL] >> - -subgoal `! l i . EL i (MAP (λx. FST (SND x)) l) = - EL i (SND (UNZIP (MAP (λx. (FST x,FST (SND x))) l)))` >- -(Induct >> -FULL_SIMP_TAC list_ss [MAP_MAP_o, FST,SND] >> -REPEAT STRIP_TAC >> -PairCases_on `h` >> -Cases_on `i'` >> -fs[] ) >> - -RES_TAC >> -SRW_TAC [] [] >> -gvs[ELIM_UNCURRY, UNZIP_rw] -, - -(* resolves the : v, var, e_list, acc e s, unop, binop, concat, slice, select*) - -fb_e_typed_tac - -, - -(* resolves the : inductive cases on the properties *) -fs[fb_e_typ_def, fb_el_typ_def, fb_stel_typ_def, fb_stetup_typ_def] >> -REPEAT STRIP_TAC >> -gvs[] -] -QED - -*) - - val trans_names_imp = prove ( `` ! l Prs_n . literials_in_P_state l ["accept"; "reject"] ==> @@ -2093,171 +1829,6 @@ fs[] ); -(* -val lval_typ_deltas_lemma = prove (“ -! lval tau f order t_scope_list_g t_scope_list_g s delta_g delta_b - delta_x delta_t Prs_n order t_scope_local ty. - dom_tmap_ei delta_g delta_b ∧ -lval_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,[],delta_x,[]) lval (t_tau tau) ⇒ -(lval_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,delta_b,delta_x,delta_t) lval - (t_tau tau)) ”, - -Induct_on ‘lval’>> -REPEAT STRIP_TAC >> - - -gvs[Once lval_typ_cases] >> -TRY(gvs[Once e_typ_cases]) >> -SIMP_TAC list_ss [Once lval_typ_cases] >> -TRY(SIMP_TAC list_ss [Once e_typ_cases]) >> -gvs[] >| [ - gvs[] >> - IMP_RES_TAC t_lookup_funn_lemma >> - srw_tac [SatisfySimps.SATISFY_ss][] - , - - - cheat - , - gvs[] >> RES_TAC >> METIS_TAC [] - , - gvs[] >> RES_TAC >> METIS_TAC [] - ] -); - -*) - - -(* - -val fg_stmt_typ_theorm = prove (`` -! stmt c f' order t_scope_list_g t_scope_list_g s delta_g delta_b - delta_x delta_t Prs_n order t_scope_local ty. - dom_tmap_ei delta_g delta_b ∧ - ALOOKUP delta_x s = NONE ∧ - ALOOKUP delta_b s = NONE ∧ - stmt_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,[],delta_x,[]) [] stmt ⇒ - stmt_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,delta_b,delta_x,delta_t) Prs_n stmt -``, - -Induct >> -REPEAT STRIP_TAC >> - -(* this should resolve most cases *) -OPEN_STMT_TYP_TAC ``stmt`` >> -SIMP_TAC list_ss [Once stmt_typ_cases] >> -fs[] >> -ASSUME_TAC fg_exp_typed_thm >> -fs[fg_e_typ_def] >> -RES_TAC >> -srw_tac [SatisfySimps.SATISFY_ss][] - -(* three cases left which are assign, return and trans *) - >|[ - - IMP_RES_TAC lval_typ_deltas_lemma >> - srw_tac [SatisfySimps.SATISFY_ss][] - , - Q.EXISTS_TAC `tau_d_list` >> - Q.EXISTS_TAC `tau` >> - Q.EXISTS_TAC `b` >> - IMP_RES_TAC t_lookup_funn_lemma >> - srw_tac [SatisfySimps.SATISFY_ss][] >> - gvs[] - , - Q.EXISTS_TAC `x_list` >> - Q.EXISTS_TAC `b` >> - gvs[] >> - srw_tac [SatisfySimps.SATISFY_ss][] >> - gvs[trans_names_imp] - , - gvs[ext_not_defined_def] -] -); - - - - -Theorem lval_typ_deltas_lemma2: -! lval tau f order t_scope_list_g t_scope_list_g s delta_g delta_b - delta_x delta_t Prs_n order t_scope_local ty. - dom_tmap_ei delta_g delta_b ∧ -lval_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,delta_b,delta_x,[]) lval (t_tau tau) ⇒ -(lval_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,delta_b,delta_x,delta_t) lval - (t_tau tau)) -Proof - -Induct_on ‘lval’>> -REPEAT STRIP_TAC >> - - -gvs[Once lval_typ_cases] >> -TRY(gvs[Once e_typ_cases]) >> -SIMP_TAC list_ss [Once lval_typ_cases] >> -TRY(SIMP_TAC list_ss [Once e_typ_cases]) >> -gvs[] >> - -FIRST [ - - gvs[] >> - RES_TAC >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`delta_x`,‘delta_t’])) >> - srw_tac [SatisfySimps.SATISFY_ss][] - , - - rfs[] >> - IMP_RES_TAC t_lookup_funn_lemma >> - LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`delta_x`])) >> - srw_tac [SatisfySimps.SATISFY_ss][] - ] -QED - - - -val fb_stmt_typ_theorm = prove (`` -! stmt c f' order t_scope_list_g t_scope_list_g s delta_g delta_b - delta_x delta_t Prs_n order t_scope_local ty. - dom_tmap_ei delta_g delta_b ∧ - stmt_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,delta_b,delta_x,delta_t) [] stmt ⇒ - stmt_typ (t_scope_list_g,t_scope_local) - (order,funn_name s,delta_g,delta_b,delta_x,delta_t) Prs_n stmt -``, - -Induct >> -REPEAT STRIP_TAC >> - -(* this should resolve most cases *) -OPEN_STMT_TYP_TAC ``stmt`` >> -SIMP_TAC list_ss [Once stmt_typ_cases] >> -fs[] >> -ASSUME_TAC fb_exp_typed_thm >> -fs[fb_e_typ_def] >> -RES_TAC >> -srw_tac [SatisfySimps.SATISFY_ss][] >| [ -(* trans *) - -Q.EXISTS_TAC `x_list` >> -Q.EXISTS_TAC `b` >> -gvs[] >> -srw_tac [SatisfySimps.SATISFY_ss][] >> -gvs[trans_names_imp] -, -Q.EXISTS_TAC `e_tau_b_list` >> -gvs[] -] - -); - -*) - - (*we need to show that the statement that we get is always extern the scope is well typed and it is always well typed*) @@ -2269,7 +1840,7 @@ SOME (stmt,xdl) = lookup_funn_sig_body (f) func_map b_func_map ext_map ==> stmt= stmt_ext ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> gvs[] >> fs[lookup_funn_sig_body_def] >> Cases_on `ALOOKUP ext_map s` >> @@ -2300,7 +1871,7 @@ Theorem dom_eq_imp_NONE: Proof -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ gvs[dom_g_eq_def, dom_eq_def, is_lookup_defined_def]>> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`s`])) >> @@ -2330,7 +1901,7 @@ val func_lookup_cases_eq = prove (“ ALOOKUP b_func_map s = SOME (stmt',xdl') ⇒ ((stmt,xdl) = (stmt',xdl')) )”, -REPEAT STRIP_TAC>> +rpt strip_tac>> gvs[lookup_funn_sig_body_def] ); @@ -2368,7 +1939,7 @@ stmt_typ (passed_tslg, [ZIP (mk_varn (MAP FST xdl), ZIP (MAP FST txdl, MAP (\e. (order,f,delta_g,passed_delta_b,delta_x,passed_delta_t) Prs_n stmt ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `f` >> gvs[t_map_to_pass_def, t_tbl_to_pass_def, t_scopes_to_pass_def, t_lookup_funn_def, scopes_to_pass_def] >> @@ -2459,12 +2030,12 @@ stmt_typ (passed_tslg, [ZIP (mk_varn (MAP FST xdl), ZIP (MAP FST txdl, MAP (\e. ``, fs[WT_c_cases] >> - REPEAT STRIP_TAC >> + rpt strip_tac >> drule all_func_maps_contains_welltyped_body_min >> - REPEAT STRIP_TAC >> - RES_TAC >> + rpt strip_tac >> + RES_TAC >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`gscope`])) >> - srw_tac [SatisfySimps.SATISFY_ss][] + srw_tac [SatisfySimps.SATISFY_ss][] ); @@ -2477,16 +2048,15 @@ stmt_typ (passed_tslg, [ZIP (mk_varn (MAP FST xdl), ZIP (MAP FST txdl, MAP (\e. (** copyin abstraction theorems **) -val copyin_abstract_def = Define ` - copyin_abstract xlist dlist elist (ss:scope list) (scope:scope) = -((! i. ( i < LENGTH xlist)==> -(IS_SOME(one_arg_val_for_newscope (EL i dlist) (EL i elist) ss) /\ -EL i scope = -(varn_name (EL i xlist) , THE (one_arg_val_for_newscope (EL i dlist) (EL i elist) ss) ) -/\ -LENGTH scope = LENGTH xlist)) /\ -((LENGTH xlist = 0) ==> scope = [])) -`; +Definition copyin_abstract_def: + copyin_abstract xlist dlist elist (ss:scope list) (scope:scope) random_oracle = + ((! i. ( i < LENGTH xlist)==> + ((!oracle_index. IS_SOME(one_arg_val_for_newscope (EL i dlist) (EL i elist) ss oracle_index random_oracle)) /\ + ?oracle_index'. + EL i scope = (varn_name (EL i xlist) , (\ ((a,b),c). (a,c)) $ THE (one_arg_val_for_newscope (EL i dlist) (EL i elist) ss oracle_index' random_oracle)) /\ + LENGTH scope = LENGTH xlist)) /\ + ((LENGTH xlist = 0) ==> scope = [])) +End val wf_arg_def = Define ` @@ -2507,28 +2077,35 @@ wf_arg_list dlist (xlist: string list) elist ss = val WF_arg_empty = prove ( `` -!ss d x e. +!ss d x e i random_oracle. wf_arg d x e ss ⇒ - update_arg_for_newscope ss (SOME []) (d,x,e) = - SOME [(varn_name x,THE (one_arg_val_for_newscope d e ss))] + update_arg_for_newscope ss random_oracle (SOME ([], i)) (d,x,e) = + ( + let ( (v,i'), lval_opt) = THE (one_arg_val_for_newscope d e ss i random_oracle) in + SOME ([(varn_name x, (v,lval_opt))], i') + + ) ``, fs[wf_arg_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `d` >> fs[is_d_out_def] >> fs[update_arg_for_newscope_def, one_arg_val_for_newscope_def] >> fs[is_d_out_def, is_d_in_def] >> -fs[AUPDATE_def] +fs[AUPDATE_def, AllCaseEqs()] >> +Cases_on ‘init_out_v random_oracle i v’ >> +qexistsl_tac [‘q’, ‘r’] >> +gs[] ); val update_args_none = prove ( `` -! dxel scope ss. -~ (FOLDL (update_arg_for_newscope ss) NONE (dxel) = SOME scope) +! dxel scope ss random_oracle. +~ (FOLDL (update_arg_for_newscope ss random_oracle) NONE (dxel) = SOME scope) ``, Induct_on `dxel` >> @@ -2547,13 +2124,13 @@ Theorem wf_arg_normalization: wf_arg_list (d::dl) (x::xl) (e::el) ss ==> wf_arg d x e ss /\ wf_arg_list (dl) (xl) (el) ss Proof - -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[wf_arg_list_def] >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`0`])) >> fs[wf_arg_def] , + STRIP_TAC >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`i+1`])) >> @@ -2561,7 +2138,7 @@ fs[wf_arg_list_def] >| [ gvs[] >> fs[EL_CONS] >> fs[PRE_SUB1] - ] +] QED @@ -2578,7 +2155,7 @@ val wf_arg_list_normalization_imp1 = prove ( `` (MAP (λ(d,x,e). e) dxel ⧺ [e]) ss ) ``, SIMP_TAC list_ss [wf_arg_list_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `dxel = []` >| [ gvs[] , @@ -2609,7 +2186,7 @@ Induct_on `dl` >> Induct_on `xl` >> Induct_on `el` >> fs[] >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ fs[wf_arg_list_def] , @@ -2624,7 +2201,7 @@ REPEAT STRIP_TAC >| [ gvs[] >> SIMP_TAC list_ss [wf_arg_list_def] >> - REPEAT STRIP_TAC >> + rpt strip_tac >> SIMP_TAC list_ss [Once EL_compute] >> CASE_TAC >> @@ -2654,134 +2231,112 @@ REPEAT STRIP_TAC >| [ val wf_arg_none_single = prove ( `` -! ss d s e . +! ss d s e random_oracle i. wf_arg d s e ss ==> - ~ (update_arg_for_newscope ss (SOME []) (d,s,e) = NONE ) + ~ (update_arg_for_newscope ss random_oracle (SOME ([], i)) (d,s,e) = NONE ) ``, fs[wf_arg_def, update_arg_for_newscope_def, one_arg_val_for_newscope_def] >> -REPEAT STRIP_TAC >> -Cases_on `is_d_out d` >| [ - fs[] >> - - Cases_on `get_lval_of_e e` >> - fs[] >> rw[] >> - - Cases_on `lookup_lval ss lval` >> - fs[] >> rw[] >> - - Cases_on `is_d_in d` >> - fs[is_d_in_def, is_d_out_def] >> rw[] - , - fs[] >> - - Cases_on `v_of_e e` >> - fs[] >> rw[] - ] +rpt strip_tac >> +Cases_on `is_d_out d` >> ( + gs[AllCaseEqs()] +) ); Theorem wf_imp_val_lval: -! ss d s e . +! ss d s e i random_oracle. wf_arg d s e ss ==> - ? v lval_op . one_arg_val_for_newscope d e ss = SOME (v , lval_op) + ? v i' lval_op . one_arg_val_for_newscope d e ss i random_oracle = SOME ((v,i') , lval_op) Proof - fs[wf_arg_def, one_arg_val_for_newscope_def] >> -REPEAT STRIP_TAC >> -Cases_on `is_d_out d` >| [ -fs[] >> - -Cases_on `get_lval_of_e e` >> -fs[] >> rw[] >> - -Cases_on `lookup_lval ss lval` >> -fs[] >> rw[] >> - +rpt strip_tac >> +Cases_on `is_d_out d` >> (fs[]) >> Cases_on `is_d_in d` >> -fs[is_d_in_def, is_d_out_def] >> rw[] -, -fs[] >> - -Cases_on `v_of_e e` >> -fs[] >> rw[] -] +fs[is_d_in_def, is_d_out_def] >> rw[] >> +Cases_on ‘init_out_v random_oracle i v’ >> +metis_tac[] QED -val EL_domain_ci_same = prove ( `` -! dxel scope ss i. -i - FST (EL i scope) = (varn_name (EL i (MAP (λ(d,x,e). x) dxel)) ) ``, -SIMP_TAC list_ss [copyin_abstract_def] + (MAP (λ(d,x,e). e) dxel) ss scope random_oracle ==> + FST (EL i scope) = (varn_name (EL i (MAP (λ(d,x,e). x) dxel)) )``, +simp[copyin_abstract_def] >> +rpt strip_tac >> +gs[] >> +‘i < LENGTH dxel’ by gs[] >> +res_tac >> +gvs[] ); Theorem wf_arg_list_NONE: - ! dxel x d e ss. + ! dxel x d e ss i random_oracle. ALL_DISTINCT (MAP (λ(d,x,e). x) dxel ) /\ (wf_arg_list (MAP (λ(d,x,e). d) dxel ) (MAP (λ(d,x,e). x) dxel ) (MAP (λ(d,x,e). e) dxel ) ss) ==> - ~ (FOLDL (update_arg_for_newscope ss) (SOME []) dxel = NONE) -Proof - - HO_MATCH_MP_TAC SNOC_INDUCT THEN SRW_TAC [] [FOLDL_SNOC, MAP_SNOC] >> - fs[SNOC_APPEND] >> - PairCases_on `x` >> - fs[] >> - - `ALL_DISTINCT (MAP (λ(d,x,e). x) dxel)` by fs[ALL_DISTINCT_APPEND] >> - IMP_RES_TAC wf_arg_list_normalization_imp2 >> - gvs[] >> - RES_TAC >> - Cases_on `FOLDL (update_arg_for_newscope ss) (SOME []) dxel` >> - fs[] >> - + ~ (FOLDL (update_arg_for_newscope ss random_oracle) (SOME ([], i)) dxel = NONE) +Proof +HO_MATCH_MP_TAC SNOC_INDUCT THEN SRW_TAC [] [FOLDL_SNOC, MAP_SNOC] >> +fs[SNOC_APPEND] >> +PairCases_on `x` >> +fs[] >> +`ALL_DISTINCT (MAP (λ(d,x,e). x) dxel)` by fs[ALL_DISTINCT_APPEND] >> +IMP_RES_TAC wf_arg_list_normalization_imp2 >> +gvs[] >> +RES_TAC >> +Cases_on `FOLDL (update_arg_for_newscope ss random_oracle) (SOME ([], i)) dxel` >- ( SIMP_TAC list_ss [update_arg_for_newscope_def] >> IMP_RES_TAC wf_imp_val_lval >> gvs[] +) >> +SIMP_TAC list_ss [update_arg_for_newscope_def] >> +IMP_RES_TAC wf_imp_val_lval >> +PairCases_on ‘x’ >> +qpat_x_assum ‘!random_oracle. _’ (fn thm => assume_tac $ Q.SPECL [‘random_oracle’, ‘x1'’] thm) >> +gs[] QED -val args_ci_scope_LENGTH = prove ( `` -! dxel ss scope. +val args_ci_scope_LENGTH = prove (`` +! dxel ss scope random_oracle. copyin_abstract (MAP (λ(d,x,e). x) (dxel)) (MAP (λ(d,x,e). d) (dxel)) - (MAP (λ(d,x,e). e) (dxel)) ss scope ==> - (LENGTH scope = LENGTH dxel) ``, + (MAP (λ(d,x,e). e) (dxel)) ss scope random_oracle ==> + (LENGTH scope = LENGTH dxel)``, Induct >> -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[copyin_abstract_def] >> -INST_FST [`0`] >> -fs[] +INST_FST [`0`] ); val args_ci_scope_LENGTH2 = prove ( `` -! xl dl el ss scope. +! xl dl el ss scope random_oracle. LENGTH xl = LENGTH dl /\ LENGTH xl = LENGTH el /\ -copyin_abstract (xl) (dl) (el) ss scope ==> - (LENGTH scope = LENGTH xl) ``, +copyin_abstract (xl) (dl) (el) ss scope random_oracle ==> + (LENGTH scope = LENGTH xl)``, Induct >> -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[copyin_abstract_def] >> -INST_FST [`0`] >> -fs[] +INST_FST [`0`] ); @@ -2799,7 +2354,7 @@ ALOOKUP l x = SOME a ==> ? i . ( i < LENGTH l /\ (EL i l = (x,a))) ``, Induct >- fs[] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `h` >> fs[ALOOKUP_def] >> Cases_on `q=x` >| [ @@ -2824,167 +2379,118 @@ Cases_on `q=x` >| [ -val copyin_abstract_normalize_tmp = prove ( `` -! xl dl el x d e ss scope. +Theorem copyin_abstract_normalize_tmp[local]: +!xl dl el x d e ss scope random_oracle. LENGTH xl = LENGTH dl /\ LENGTH xl = LENGTH el /\ copyin_abstract (x::xl) - (d::dl) (e::el) ss scope -==> -(copyin_abstract [x] [d] [e] ss [HD scope] /\ - copyin_abstract xl dl el ss (TL scope)) ``, - + (d::dl) (e::el) ss scope random_oracle ==> +(copyin_abstract [x] [d] [e] ss [HD scope] random_oracle /\ + copyin_abstract xl dl el ss (TL scope) random_oracle) +Proof Induct_on `xl` >> Induct_on `el` >> Induct_on `dl` >> fs[] >| [ fs[copyin_abstract_def] >> - REPEAT STRIP_TAC >> - Cases_on `scope` >> fs[] - - , - - REPEAT STRIP_TAC >| [ - - fs[copyin_abstract_def] >> - INST_FST [`0`] - , - - gvs[] >> - - IMP_RES_TAC args_ci_scope_LENGTH2 >> fs[] >> gvs[] >> - Cases_on `scope = []` >> - fs[] >> - - SIMP_TAC list_ss [copyin_abstract_def] >> - NTAC 2 STRIP_TAC >> - - fs[Once EL_compute] >> - CASE_TAC >> - fs[EL_CONS] >> - fs[copyin_abstract_def] >| [ - - INST_FST [`1`] >> fs[] >> - - Cases_on `one_arg_val_for_newscope h h' ss` >> fs[] >> - Cases_on `scope` >> fs[] - , - - `i>0` by fs[] >> - INST_FST [`i+1`] >> - - `i + 1 < LENGTH xl +2` by fs[] >> - - fs[EL_CONS] >> - - fs[numeral_pre,PRE_SUB1,PRE_SUC_EQ] >> + rpt strip_tac >> ( + INST_FST [`oracle_index`] >> + Cases_on `scope` >> fs[] >> metis_tac[] + ), + rpt strip_tac >| [ + fs[copyin_abstract_def] >> + rpt strip_tac >> + INST_FST [`0`] >> + metis_tac[], - fs[Once EL_compute] >> - Cases_on `i = 0` >> fs[] >> - Cases_on `i = 1` >> fs[] >> - fs[EL_CONS] >> - Cases_on `scope` >> fs[] >> - - fs[numeral_pre,PRE_SUB1,PRE_SUC_EQ] >> - fs[EL_CONS] >> + gvs[] >> + IMP_RES_TAC args_ci_scope_LENGTH2 >> gvs[] >> + Cases_on `scope = []` >> (fs[]) >> + simp[copyin_abstract_def] >> + NTAC 2 STRIP_TAC >> + + fs[Once EL_compute] >> + CASE_TAC >> ( + fs[EL_CONS, copyin_abstract_def] + ) >| [ + qpat_x_assum ‘!i'. _’ (fn thm => assume_tac $ Q.SPECL [‘1’] thm) >> + rfs[] >> + qexists_tac ‘oracle_index'’ >> + rfs[] >> + Cases_on `scope` >> fs[], - fs[numeral_pre,PRE_SUB1,PRE_SUC_EQ] - ] + `i + 1 < LENGTH xl + 2` by fs[] >> + gs[EL_CONS, PRE_SUB1] >> + Cases_on `scope` >> fs[] >> + Cases_on `i = 1` >> fs[] >- ( + qpat_x_assum ‘!i'. _’ (fn thm => assume_tac $ Q.SPECL [‘2’] thm) >> + gs[] >> + metis_tac[] + ) >> + qpat_x_assum ‘!i'. _’ (fn thm => assume_tac $ Q.SPECL [‘i + 1’] thm) >> + `i + 1 < LENGTH dl + 2` by fs[] >> + gs[EL_CONS, PRE_SUB1] >> + metis_tac[] ] -]); + ] +] +QED -(* simplify it later, it works without the induction*) -val copyin_abstract_normalize = prove ( `` -! dxel x d e ss scope. +(* simplify it later, it works without the induction *) +Theorem copyin_abstract_normalize[local]: +!dxel x d e ss scope random_oracle. copyin_abstract (x::MAP (λ(d,x,e). x) (dxel)) (d::MAP (λ(d,x,e). d) (dxel)) - (e::MAP (λ(d,x,e). e) (dxel)) ss scope ==> - (copyin_abstract [x] [d] [e] ss ([HD scope]) /\ + (e::MAP (λ(d,x,e). e) (dxel)) ss scope random_oracle ==> + (copyin_abstract [x] [d] [e] ss ([HD scope]) random_oracle /\ copyin_abstract (MAP (λ(d,x,e). x) (dxel)) - (MAP (λ(d,x,e). d) (dxel)) (MAP (λ(d,x,e). e) (dxel)) ss (TL scope))``, + (MAP (λ(d,x,e). d) (dxel)) (MAP (λ(d,x,e). e) (dxel)) ss (TL scope) random_oracle) +Proof Induct >> -REPEAT STRIP_TAC >| [ - - fs[copyin_abstract_def] >> - NTAC 2 STRIP_TAC >> - `i=0` by fs[] >> - fs[] >> - INST_FST [`0`] - , - fs[copyin_abstract_def] >> - Cases_on `scope` >> fs[] - , - PairCases_on `h` >> - fs[] >> +rpt strip_tac >| [ + Cases_on `scope` >> (fs[copyin_abstract_def]) >> + metis_tac[], + + Cases_on `scope` >> (fs[copyin_abstract_def]) >> + metis_tac[], + fs[copyin_abstract_def] >> - INST_FST [`0`] - , - PairCases_on `h` >> - fs[] >> + INST_FST [`0`] >> + metis_tac[], - IMP_RES_TAC args_ci_scope_LENGTH2 >> fs[] >> - Cases_on `scope = []` >> - fs[] >> - - SIMP_TAC list_ss [copyin_abstract_def] >> - NTAC 2 STRIP_TAC >> - - fs[Once EL_compute] >> - CASE_TAC >| [ - - fs[EL_CONS] >> - fs[copyin_abstract_def] >> - - INST_FST [`1`] >> - - Cases_on `one_arg_val_for_newscope h0 h2 ss` >> fs[] >> - Cases_on `scope` >> fs[] - , - - fs[EL_CONS] >> - `i>0` by fs[] >> - - fs[copyin_abstract_def] >> - - INST_FST [`i+1`] >> fs[] >> - `i + 1 < LENGTH dxel +2` by fs[] >> - - fs[EL_CONS] >> - fs[numeral_pre,PRE_SUB1,PRE_SUC_EQ] >> - - - fs[Once EL_compute] >> - Cases_on `i = 0` >> fs[] >> - Cases_on `i = 1` >> fs[] >> - fs[EL_CONS] >> - Cases_on `scope` >> fs[] >> - - fs[numeral_pre,PRE_SUB1,PRE_SUC_EQ] >> - fs[EL_CONS] >> - fs[numeral_pre,PRE_SUB1,PRE_SUC_EQ] - ] + fs[copyin_abstract_def] >> + NTAC 2 strip_tac >> + INST_FST [`i+1`] >> + gs[] >> + strip_tac >- ( + strip_tac >> + INST_FST [‘oracle_index’] >> + gs[EL_CONS, PRE_SUB1] + ) >> + qexists_tac ‘oracle_index'’ >> + Cases_on `scope` >> fs[] >> + gs[EL_CONS, PRE_SUB1] ] -); +QED val copyin_abstract_single = prove (`` -! x d e ss scope . -copyin_abstract [x] [d] [e] ss [HD scope] ==> +! x d e ss scope random_oracle. +copyin_abstract [x] [d] [e] ss [HD scope] random_oracle ==> (ALL_DISTINCT (MAP FST [HD scope]) /\ FST (HD scope) = varn_name x) ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> IMP_RES_TAC args_ci_scope_LENGTH2 >> fs[copyin_abstract_def] >> -FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL -[`0`])) >> fs[] +FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘random_oracle’])) >> fs[] ); @@ -3006,22 +2512,21 @@ QED val copyin_abstract_domain = prove ( `` -! dxel ss scope. +!dxel ss scope random_oracle. copyin_abstract (MAP (λ(d,x,e). x) dxel) (MAP (λ(d,x,e). d) dxel) - (MAP (λ(d,x,e). e) dxel) ss scope ==> + (MAP (λ(d,x,e). e) dxel) ss scope random_oracle ==> MAP FST scope = mk_varn (MAP (λ(d,x,e). x) dxel) ``, -Induct >- -fs[copyin_abstract_def, mk_varn_def] >> -REPEAT STRIP_TAC >> +Induct >- ( + fs[copyin_abstract_def, mk_varn_def] +) >> +rpt strip_tac >> PairCases_on `h` >> fs[] >> - IMP_RES_TAC copyin_abstract_normalize >> fs[] >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL -[`ss`, `TL (scope : (varn # v # lval option) list)`])) >> gvs[] >> - + [`ss`, `TL (scope : (varn # v # lval option) list)`, ‘random_oracle’])) >> gvs[] >> IMP_RES_TAC copyin_abstract_single >> fs[mk_varn_lemma2] >> Cases_on `scope` >> fs[mk_varn_def, copyin_abstract_def] @@ -3035,7 +2540,7 @@ ALL_DISTINCT (xl) ==> ALL_DISTINCT (mk_varn (xl)) Proof Induct >- fs[mk_varn_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> gvs[mk_varn_lemma, mk_varn_lemma2] QED @@ -3051,7 +2556,7 @@ Induct_on ‘xl’ >> Induct_on ‘l’ >> gvs[] >| [ fs[mk_varn_def] , - REPEAT STRIP_TAC >> + rpt strip_tac >> gvs[mk_varn_lemma, mk_varn_lemma2] ] QED @@ -3080,13 +2585,13 @@ QED (* if all the domain is distict, then if we find something in there, it should notmbe as the tail of it *) val copyin_abstract_distinct = prove (`` -! dxel ss x. +! dxel ss x random_oracle. ALL_DISTINCT (MAP (λ(d,x,e). x) dxel) /\ copyin_abstract (MAP (λ(d,x,e). x) dxel) (MAP (λ(d,x,e). d) dxel) - (MAP (λ(d,x,e). e) dxel) ss x ==> + (MAP (λ(d,x,e). e) dxel) ss x random_oracle ==> ALL_DISTINCT (MAP FST x) ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> IMP_RES_TAC copyin_abstract_domain >> `ALL_DISTINCT (MAP FST x) = ALL_DISTINCT (mk_varn (MAP (λ(d,x,e). x) dxel))` by fs[] >> @@ -3097,30 +2602,14 @@ gvs[mk_varn_lemma3] -val copyin_deter_single = prove ( `` -! h h' x d e ss . -copyin_abstract [x] [d] [e] ss [h'] /\ -copyin_abstract [x] [d] [e] ss [h] ==> -(h' = h) ``, - -fs[copyin_abstract_def] >> -REPEAT STRIP_TAC >> -INST_FST [`0`] >> -INST_FST [`0`] >> -gvs[] -); - - - - val copyin_abstract_distinct_app = prove (`` -! dxel ss x a. +! dxel ss x a random_oracle. ALL_DISTINCT ((MAP (λ(d,x,e). x) dxel) ++ [a] )/\ copyin_abstract (MAP (λ(d,x,e). x) dxel) (MAP (λ(d,x,e). d) dxel) - (MAP (λ(d,x,e). e) dxel) ss x ==> + (MAP (λ(d,x,e). e) dxel) ss x random_oracle ==> ALL_DISTINCT ((MAP FST x) ++ [varn_name a] ) ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[ALL_DISTINCT_APPEND] >> IMP_RES_TAC copyin_abstract_domain >> `ALL_DISTINCT (MAP FST x) = ALL_DISTINCT (mk_varn (MAP (λ(d,x,e). x) dxel))` by fs[] >> @@ -3140,7 +2629,7 @@ Induct_on `l` >> Induct_on `xl` >> fs[] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> PairCases_on `x'` >> PairCases_on `h'` >> gvs[] >> @@ -3161,7 +2650,7 @@ ALL_DISTINCT (MAP FST l ⧺ [varn_name x]) F ``, Induct_on `l` >> fs[] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> PairCases_on `h` >> Cases_on `h0 = varn_name x` >> fs[] @@ -3172,280 +2661,152 @@ Cases_on `h0 = varn_name x` >> fs[] -val copyin_last_calculate = prove (`` -! dxel x scope ss x0 x1 x2 v lval_op . -copyin_abstract (MAP (λ(d,x,e). x) dxel ⧺ [x1]) - (MAP (λ(d,x,e). d) dxel ⧺ [x0]) - (MAP (λ(d,x,e). e) dxel ⧺ [x2]) ss scope /\ -copyin_abstract (MAP (λ(d,x,e). x) dxel) - (MAP (λ(d,x,e). d) dxel) - (MAP (λ(d,x,e). e) dxel) ss x /\ -one_arg_val_for_newscope x0 x2 ss = SOME (v,lval_op) /\ -LENGTH x = LENGTH dxel -==> -scope = (x ++ [(varn_name x1,v,lval_op)]) ``, - - -Induct >> -REPEAT STRIP_TAC >| [ - - fs[copyin_abstract_def] >> - gvs[] >> - Cases_on `scope` >> fs[] - , - - PairCases_on `h` >> fs[] >> - - IMP_RES_TAC copyin_abstract_normalize >> - IMP_RES_TAC copyin_abstract_normalize_tmp >> fs[] >> - gvs[] >> - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`TL x`, `TL scope` , `ss`, `x0`, `x1`,`x2`])) >> gvs[] >> - - - IMP_RES_TAC copyin_abstract_single >> - IMP_RES_TAC args_ci_scope_LENGTH >> - gvs[] >> - - Cases_on `scope` >> - Cases_on `x` >> gvs[] >> - - IMP_RES_TAC copyin_deter_single >> gvs[] -] -); - - - - -val copyin_abstract_verbose = prove (`` -! dxel ss scope. - (ALL_DISTINCT (MAP (\(d,x,e).x) dxel)) ∧ - ( wf_arg_list - (MAP (\(d,x,e).d) dxel) - (MAP (\(d,x,e).x) dxel) - (MAP (\(d,x,e).e) dxel) ss) ==> - ( (FOLDL (update_arg_for_newscope ss) (SOME []) dxel) = - SOME scope ⇔ - copyin_abstract (MAP (\(d,x,e).x) dxel) (MAP (\(d,x,e).d) dxel) (MAP (\(d,x,e).e) dxel) ss scope) ``, - - - -HO_MATCH_MP_TAC SNOC_INDUCT THEN SRW_TAC [] [FOLDL_SNOC, MAP_SNOC] >- -fs[copyin_abstract_def] >> +Theorem copyin_abstract_verbose[local]: +!dxel ss scope i random_oracle. + (ALL_DISTINCT (MAP (\(d,x,e).x) dxel)) ==> + (wf_arg_list + (MAP (λ(d,x,e). d) dxel) + (MAP (λ(d,x,e). x) dxel) + (MAP (λ(d,x,e). e) dxel) ss) ==> + (?i'. (FOLDL (update_arg_for_newscope ss random_oracle) (SOME ([], i)) dxel) = + SOME (scope, i')) ==> + copyin_abstract (MAP (λ(d,x,e). x) dxel) (MAP (λ(d,x,e). d) dxel) (MAP (λ(d,x,e). e) dxel) ss scope random_oracle +Proof +HO_MATCH_MP_TAC SNOC_INDUCT THEN SRW_TAC [] [FOLDL_SNOC, MAP_SNOC] >- ( + fs[copyin_abstract_def, wf_arg_list_def] +) >> fs[SNOC_APPEND] >> PairCases_on `x` >> -fs[] >> - -SIMP_TAC list_ss [update_arg_for_newscope_def] >> -Cases_on `FOLDL (update_arg_for_newscope ss) (SOME []) dxel` >> -fs[] >| [ - - (* first show that all disttic means that the list and the element is also distict *) - (* case ¬copyin_abstract *) - - `ALL_DISTINCT (MAP (λ(d,x,e). x) dxel)` by fs[ALL_DISTINCT_APPEND] >> - `ALL_DISTINCT [x1]` by fs[ALL_DISTINCT_APPEND] >> - - IMP_RES_TAC wf_arg_list_normalization_imp2 >> +gs[update_arg_for_newscope_def] >> +Cases_on `FOLDL (update_arg_for_newscope ss random_oracle) (SOME ([], i)) dxel` >> (fs[]) >> +PairCases_on ‘x’ >> +gvs[AllCaseEqs()] >> +`ALL_DISTINCT (MAP (λ(d,x,e). x) dxel)` by fs[ALL_DISTINCT_APPEND] >> +`ALL_DISTINCT [x1]` by fs[ALL_DISTINCT_APPEND] >> +IMP_RES_TAC wf_arg_list_normalization_imp2 >> gvs[] >> +RES_TAC >> +IMP_RES_TAC wf_imp_val_lval >> fs[] >> +SIMP_TAC list_ss [copyin_abstract_def] >> +NTAC 2 STRIP_TAC >> +Cases_on `i'' = (LENGTH dxel)` >| [ + (* i'' = LENGTH dxel case *) + rfs[EL_LENGTH_simp] >> gvs[] >> - fs[wf_arg_list_NONE] - , - - `ALL_DISTINCT (MAP (λ(d,x,e). x) dxel)` by fs[ALL_DISTINCT_APPEND] >> - `ALL_DISTINCT [x1]` by fs[ALL_DISTINCT_APPEND] >> - IMP_RES_TAC wf_arg_list_normalization_imp2 >> gvs[] >> - - (*case of copy in abstract as a list *) - - RES_TAC >> - IMP_RES_TAC wf_imp_val_lval >> fs[] >> - EQ_TAC >> - STRIP_TAC >| [ - - (* first side of the implication AUPDATE ==> copyin_abstract *) - SIMP_TAC list_ss [copyin_abstract_def] >> - NTAC 2 STRIP_TAC >> - Cases_on `i = (LENGTH dxel) ` >| [ - - (*i = LENGTH dxel case*) - - rfs[] >> - rfs[EL_LENGTH_simp] >> - gvs[] >> - IMP_RES_TAC args_ci_scope_LENGTH >> - fs[AUPDATE_def] >> - - Cases_on `ALOOKUP x (varn_name x1)` >| [ - - (*Cases lookup is NONE *) - fs[] >> - `EL (LENGTH x) (x ⧺ [(varn_name x1,v,lval_op)]) = - (varn_name x1,v,lval_op) ` by fs[EL_LENGTH_simp] >> - gvs[] - , - fs[] >> - `EL (LENGTH x) (x ⧺ [(varn_name x1,v,lval_op)]) = - (varn_name x1,v,lval_op) ` by fs[EL_LENGTH_simp] >> - gvs[] >> - IMP_RES_TAC copyin_abstract_distinct_app >> - IMP_RES_TAC distinct_not_neg - ] - , - - (* i ≠ LENGTH dxel /\ i < LENGTH dxel case*) + IMP_RES_TAC args_ci_scope_LENGTH >> + fs[AUPDATE_def] >> + strip_tac >- ( + strip_tac >> + qpat_x_assum ‘!random_oracle. _’ (fn thm => assume_tac $ Q.SPECL [‘random_oracle’, ‘oracle_index’] thm) >> + gs[] + ) >> + Cases_on `ALOOKUP x0' (varn_name x1)` >| [ + (*Cases lookup is NONE *) + qexists_tac ‘x1'’ >> + `EL (LENGTH x0') (x0' ⧺ [(varn_name x1,v,lval_opt)]) = + (varn_name x1,v,lval_opt) ` by fs[EL_LENGTH_simp] >> + gs[], + + `EL (LENGTH x0') (x0' ⧺ [(varn_name x1,v,lval_op)]) = + (varn_name x1,v,lval_op) ` by fs[EL_LENGTH_simp] >> + gs[] >> + IMP_RES_TAC copyin_abstract_distinct_app >> + IMP_RES_TAC distinct_not_neg + ], + + (* i'' ≠ LENGTH dxel /\ i'' < LENGTH dxel case*) - (* This should not be true at all, since we start - from a distict xlist we should end up in a distict - scope, which means that we can never find the variable *) - - fs[] >> - `i < LENGTH dxel` by fs[] >> - - (* sould stay here, because we extract the definition - of copyin_abstract in the next step, we cannot infer it later *) - IMP_RES_TAC copyin_abstract_distinct_app >> - - fs[copyin_abstract_def] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`i`])) >> - - - `IS_SOME (one_arg_val_for_newscope (EL i (MAP (λ(d,x,e). d) dxel)) - (EL i (MAP (λ(d,x,e). e) dxel)) ss)` by RES_TAC >> - `EL i x = - (varn_name (EL i (MAP (λ(d,x,e). x) dxel)), - THE - (one_arg_val_for_newscope (EL i (MAP (λ(d,x,e). d) dxel)) - (EL i (MAP (λ(d,x,e). e) dxel)) ss))` by RES_TAC >> - `LENGTH x = LENGTH dxel` by RES_TAC >> - + (* This should not be true at all, since we start + from a distict xlist we should end up in a distict + scope, which means that we can never find the variable *) - (* show that the element is i in the list *) - - `((EL i (MAP (λ(d,x,e). e) dxel) = EL i (MAP (λ(d,x,e). e) dxel ⧺ [x2]))) - ` by FULL_SIMP_TAC list_ss [EL_APPEND1] >> - - `((EL i (MAP (λ(d,x,e). d) dxel) = EL i (MAP (λ(d,x,e). d) dxel ⧺ [x0]))) - ` by FULL_SIMP_TAC list_ss [Once EL_APPEND1] >> + fs[] >> + `i'' < LENGTH dxel` by fs[] >> - `((EL i (MAP (λ(d,x,e). x) dxel) = EL i (MAP (λ(d,x,e). x) dxel ⧺ [x1]))) - ` by FULL_SIMP_TAC list_ss [Once EL_APPEND1] >> + (* sould stay here, because we extract the definition + of copyin_abstract in the next step, we cannot infer it later *) + IMP_RES_TAC copyin_abstract_distinct_app >> + fs[copyin_abstract_def] >> + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL + [‘random_oracle’, `i''`])) >> - Cases_on `one_arg_val_for_newscope (EL i (MAP (λ(d,x,e). d) dxel ⧺ [x0])) - (EL i (MAP (λ(d,x,e). e) dxel ⧺ [x2])) ss` >> fs[] >> - rfs[] >> + qpat_x_assum ‘!i. i < LENGTH dxel ==> _’ (fn thm => imp_res_tac thm) >> - gvs[] >> - fs[AUPDATE_def] >> + (* show that the element is i in the list *) - Cases_on `ALOOKUP x (varn_name x1)` >> - fs[] >|[ + `((EL i'' (MAP (λ(d,x,e). e) dxel) = EL i'' (MAP (λ(d,x,e). e) dxel ⧺ [x2])))` by FULL_SIMP_TAC list_ss [EL_APPEND1] >> - FULL_SIMP_TAC list_ss [] >> + `((EL i'' (MAP (λ(d,x,e). d) dxel) = EL i'' (MAP (λ(d,x,e). d) dxel ⧺ [x0])))` by FULL_SIMP_TAC list_ss [Once EL_APPEND1] >> - subgoal ` (varn_name (EL i (MAP (λ(d,x,e). x) dxel ⧺ [x1])),x') = EL i x` >- - (FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`i`])) >> fs[] >> gvs[]) >> - - (* - trivial now!! - we should show that : - (EL i x eq EL i (x ⧺ [(varn_name x1,v,lval_op)]) - becauce i is less than the length of dxel, and dxel length equals to x - which means we are only accessing the part that is inside x - *) - - subgoal ` - i < LENGTH x ==> - EL i x = EL i ( (x ⧺ [(varn_name x1,v,lval_op)]))` >- - SIMP_TAC list_ss [Once EL_APPEND1,LENGTH_MAP] >> - rw[] - , - IMP_RES_TAC distinct_not_neg_in_bound - ] + `((EL i'' (MAP (λ(d,x,e). x) dxel) = EL i'' (MAP (λ(d,x,e). x) dxel ⧺ [x1])))` by FULL_SIMP_TAC list_ss [Once EL_APPEND1] >> - ] - - , - (* second side of the implication copyin_abstract ==> UPDATE *) - fs[AUPDATE_def] >> - Cases_on `ALOOKUP x (varn_name x1)` >> - fs[] >| [ - - IMP_RES_TAC copyin_abstract_distinct_app >> - IMP_RES_TAC copyin_abstract_distinct >> - IMP_RES_TAC args_ci_scope_LENGTH >> - IMP_RES_TAC copyin_last_calculate >> - fs[] - , - IMP_RES_TAC copyin_abstract_distinct_app >> - IMP_RES_TAC copyin_abstract_distinct >> - IMP_RES_TAC distinct_not_neg_in_bound - ] - ] + Cases_on `one_arg_val_for_newscope (EL i'' (MAP (λ(d,x,e). d) dxel ⧺ [x0])) + (EL i'' (MAP (λ(d,x,e). e) dxel ⧺ [x2])) ss oracle_index' random_oracle` >- ( + INST_FST [‘oracle_index'’] >> + gs[] + ) >> + gs[] >> + qexists_tac ‘oracle_index'’ >> + gvs[] >> + fs[AUPDATE_def] >> + Cases_on `ALOOKUP x0' (varn_name x1)` >> + fs[] >|[ + FULL_SIMP_TAC list_ss [] >> + qpat_x_assum ‘EL i'' x0' = _’ (fn thm => assume_tac $ GSYM thm) >> + gs[] >> + ‘i'' < LENGTH x0'’ suffices_by simp[EL_APPEND1] >> + gs[], + + IMP_RES_TAC distinct_not_neg_in_bound + ] ] -); - - - - -val all_arg_update_eq = prove ( `` -! dxel ss scope. - (ALL_DISTINCT (MAP (\(d,x,e).x) dxel)) ∧ - ( wf_arg_list - (MAP (\(d,x,e).d) dxel) - (MAP (\(d,x,e).x) dxel) - (MAP (\(d,x,e).e) dxel) ss) ==> -((all_arg_update_for_newscope (MAP (\(d,x,e).x) dxel) (MAP (\(d,x,e).d) dxel) (MAP (\(d,x,e).e) dxel) ss = SOME scope) -<=> -copyin_abstract (MAP (\(d,x,e).x) dxel) (MAP (\(d,x,e).d) dxel) (MAP (\(d,x,e).e) dxel) ss scope) -``, - -REPEAT STRIP_TAC >> -IMP_RES_TAC copyin_abstract_verbose >> -gvs[all_arg_update_for_newscope_def] >> -ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:d`` , ``:'b`` |-> ``:string`` , ``:'c`` |-> ``:e``] zipped_list) >> -FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`dxel`])) >> -FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`scope`])) >> -METIS_TAC [] -); +QED +Theorem all_arg_update_imp[local]: +!dxel ss scope i random_oracle. + (ALL_DISTINCT (MAP (\(d,x,e).x) dxel)) ==> + (wf_arg_list + (MAP (\(d,x,e).d) dxel) + (MAP (\(d,x,e).x) dxel) + (MAP (\(d,x,e).e) dxel) ss) ==> + (?i'. (all_arg_update_for_newscope (MAP (\(d,x,e).x) dxel) (MAP (\(d,x,e).d) dxel) (MAP (\(d,x,e).e) dxel) ss i random_oracle = SOME (scope,i'))) +==> +copyin_abstract (MAP (\(d,x,e).x) dxel) (MAP (\(d,x,e).d) dxel) (MAP (\(d,x,e).e) dxel) ss scope random_oracle +Proof +metis_tac[copyin_abstract_verbose, all_arg_update_for_newscope_def, zipped_list] +QED -Theorem copyin_eq: -! e_x_d_list gscope scopest scope. +Theorem copyin_imp: +!e_x_d_list gscope scopest scope i random_oracle. (ALL_DISTINCT (MAP (λ(e,x,d). x) e_x_d_list)) ∧ (wf_arg_list (MAP (λ(e,x,d). d) e_x_d_list) (MAP (λ(e,x,d). x) e_x_d_list) (MAP (λ(e,x,d). e) e_x_d_list) (scopest ⧺ gscope)) ==> ( -(SOME scope = copyin (MAP (λ(e,x,d). x) e_x_d_list) +(?i_opt. SOME (scope, i_opt) = copyin (MAP (λ(e,x,d). x) e_x_d_list) (MAP (λ(e,x,d). d) e_x_d_list) - (MAP (λ(e,x,d). e) e_x_d_list) gscope scopest) -<=> + (MAP (λ(e,x,d). e) e_x_d_list) gscope scopest i random_oracle) +==> copyin_abstract (MAP (λ(e,x,d). x) e_x_d_list) (MAP (λ(e,x,d). d) e_x_d_list) - (MAP (λ(e,x,d). e) e_x_d_list) (scopest ⧺ gscope) scope) + (MAP (λ(e,x,d). e) e_x_d_list) (scopest ⧺ gscope) scope random_oracle) Proof - -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[copyin_def] >> -ASSUME_TAC all_arg_update_eq >> - +assume_tac all_arg_update_imp >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [ `ZIP ((MAP (λ(e,x,d). d) e_x_d_list), ZIP ((MAP (λ(e,x,d). x) e_x_d_list) , (MAP (λ(e,x,d). e) e_x_d_list)))`, `scopest ⧺ gscope`, `scope` ])) >> - -rfs[] >> -rfs[map_distrub] +gvs[map_distrub, AllCaseEqs()] >> ( + metis_tac[] +) QED @@ -3453,7 +2814,6 @@ QED - (**********************************************) (* show implication copyin ==> well formed *) (**********************************************) @@ -3462,23 +2822,20 @@ QED val wf_arg_list_implied = prove (`` -!dxel d (x:string) e ci_scope ss tmp. +!dxel d (x:string) e ci_scope ss random_oracle tmp i'. ALL_DISTINCT (MAP (λ(d,x,e). x) dxel ⧺ [x]) /\ check_args_red (MAP (λ(d,x,e). d) dxel ⧺ [d]) (MAP (λ(d,x,e). e) dxel ⧺ [e]) /\ - SOME ci_scope = update_arg_for_newscope ss (SOME tmp) (d,x,e) ==> + SOME (ci_scope, i') = update_arg_for_newscope ss random_oracle (SOME tmp) (d,x,e) ==> wf_arg_list [d] [x] [e] ss ``, -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[wf_arg_list_def] >> - - fs[wf_arg_def] >> - fs[update_arg_for_newscope_def] >> fs[one_arg_val_for_newscope_def] >> - +PairCases_on ‘tmp’ >> Cases_on `is_d_out d` >> fs[is_d_out_def] >| [ (* is out *) @@ -3502,7 +2859,7 @@ wf_arg_list [d] [x] [e] ss) ==> ``, SIMP_TAC list_ss [wf_arg_list_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `dxel = []` >| [ gvs[] , @@ -3529,7 +2886,7 @@ check_args_red (MAP (λ(d,x,e). d) dxel ⧺ [d]) Induct_on `dxel` >- fs[check_args_red_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> RES_TAC >> PairCases_on `h` >> fs[] >> @@ -3541,39 +2898,32 @@ Cases_on `is_arg_red h0 h2` >> gvs[] val update_new_scope_wf_args = prove ( `` -∀dxel ci_scope ss. +∀dxel ci_scope i' ss random_oracle i. ALL_DISTINCT (MAP (λ(d,x,e). x) dxel) /\ check_args_red (MAP (λ(d,x,e). d) dxel) (MAP (λ(d,x,e). e) dxel) /\ - SOME ci_scope = - FOLDL (update_arg_for_newscope ss) (SOME []) (dxel) + SOME (ci_scope, i') = + FOLDL (update_arg_for_newscope ss random_oracle) (SOME ([], i)) (dxel) ⇒ wf_arg_list (MAP (λ(d,x,e). d) dxel) (MAP (λ(d,x,e). x) dxel) (MAP (λ(d,x,e). e) dxel) (ss) ``, -HO_MATCH_MP_TAC SNOC_INDUCT THEN SRW_TAC [] [FOLDL_SNOC, MAP_SNOC] >> -fs[SNOC_APPEND] >- -fs[wf_arg_list_def] >> - +HO_MATCH_MP_TAC SNOC_INDUCT THEN SRW_TAC [] [FOLDL_SNOC, MAP_SNOC] >> (fs[SNOC_APPEND]) >- ( + fs[wf_arg_list_def] +) >> PairCases_on `x` >> fs[] >> +`ALL_DISTINCT (MAP (λ(d,x,e). x) dxel)` by fs[ALL_DISTINCT_APPEND] >> +`check_args_red (MAP (λ(d,x,e). d) dxel) + (MAP (λ(d,x,e). e) dxel)` by IMP_RES_TAC check_args_red_normalize >> +fs[] >> +Cases_on `FOLDL (update_arg_for_newscope ss random_oracle) (SOME ([], i)) dxel` >| [ + fs[update_arg_for_newscope_def], - `ALL_DISTINCT (MAP (λ(d,x,e). x) dxel)` by fs[ALL_DISTINCT_APPEND] >> - `check_args_red (MAP (λ(d,x,e). d) dxel) - (MAP (λ(d,x,e). e) dxel)` by IMP_RES_TAC check_args_red_normalize >> - fs[] >> - - - Cases_on `FOLDL (update_arg_for_newscope ss) (SOME []) dxel` >| [ - fs[update_arg_for_newscope_def] - , - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`x`, `ss`])) >> - gvs[] >> - IMP_RES_TAC wf_arg_list_implied >> - IMP_RES_TAC wf_arg_list_normalize_imp1 - ] + PairCases_on `x` >> + metis_tac[wf_arg_list_normalize_imp1, wf_arg_list_implied] +] ); @@ -3581,28 +2931,26 @@ fs[] >> val all_update_new_scope_wf_args = prove ( `` -∀e_x_d_list ci_scope ss. +∀e_x_d_list ci_scope i' ss i random_oracle. ALL_DISTINCT (MAP (λ(e_,x_,d_). x_) e_x_d_list) /\ check_args_red (MAP (λ(e_,x_,d_). d_) e_x_d_list) (MAP (λ(e_,x_,d_). e_) e_x_d_list) /\ - SOME ci_scope = + SOME (ci_scope, i') = all_arg_update_for_newscope (MAP (λ(e_,x_,d_). x_) e_x_d_list) (MAP (λ(e_,x_,d_). d_) e_x_d_list) (MAP (λ(e_,x_,d_). e_) e_x_d_list) - (ss) ⇒ + (ss) i random_oracle ⇒ wf_arg_list (MAP (λ(e,x,d). d) e_x_d_list) (MAP (λ(e,x,d). x) e_x_d_list) (MAP (λ(e,x,d). e) e_x_d_list) (ss) ``, -REPEAT STRIP_TAC >> -ASSUME_TAC update_new_scope_wf_args >> +rpt strip_tac >> +assume_tac update_new_scope_wf_args >> fs[all_arg_update_for_newscope_def] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ZIP (MAP (λ(e_,x_,d_). d_) e_x_d_list, ZIP (MAP (λ(e_,x_,d_). x_) e_x_d_list, MAP (λ(e_,x_,d_). e_) e_x_d_list))`, - `ci_scope`, `ss`])) >> -rfs[] >> -rfs[map_distrub] + `ci_scope`, ‘i'’, `ss`, ‘random_oracle’, ‘i’])) >> +rfs[map_distrub] ); @@ -3610,22 +2958,25 @@ rfs[map_distrub] val copyin_imp_wf_args2 = prove ( `` -! e_x_d_list ci_scope gscope scopest . +! e_x_d_list ci_scope gscope scopest i random_oracle. ALL_DISTINCT (MAP (λ(e_,x_,d_). x_) e_x_d_list) /\ check_args_red (MAP (λ(e_,x_,d_). d_) e_x_d_list) (MAP (λ(e_,x_,d_). e_) e_x_d_list) /\ SOME ci_scope = copyin (MAP (λ(e_,x_,d_). x_) e_x_d_list) (MAP (λ(e_,x_,d_). d_) e_x_d_list) - (MAP (λ(e_,x_,d_). e_) e_x_d_list) gscope scopest ==> + (MAP (λ(e_,x_,d_). e_) e_x_d_list) gscope scopest i random_oracle ==> ( wf_arg_list (MAP (\(e,x,d).d) e_x_d_list) (MAP (\(e,x,d).x) e_x_d_list) (MAP (\(e,x,d).e) e_x_d_list) (scopest ++ gscope)) ``, fs[copyin_def] >> -REPEAT STRIP_TAC >> -IMP_RES_TAC all_update_new_scope_wf_args +rpt strip_tac >> +gvs[AllCaseEqs()] >> +irule all_update_new_scope_wf_args >> +gs[] >> +metis_tac[] ); @@ -3644,7 +2995,7 @@ star_not_in_sl [scope] ``, Induct_on `xl` >> Induct_on `scope` >> fs[mk_varn_def, star_not_in_sl_def, star_not_in_s_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> PairCases_on `h` >> fs[] ); @@ -3662,7 +3013,7 @@ check_args_red [d] [e] ) ``, Induct_on `e_x_d_list` >> fs[check_args_red_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> RES_TAC ); @@ -3694,7 +3045,7 @@ val type_of_v_def = TotalDefn.tDefine "type_of_v" ` ` (WF_REL_TAC `measure v_size` >> fs[v_size_def] >> - REPEAT STRIP_TAC >> + rpt strip_tac >> `v_size p_2 < v1_size xvl` suffices_by ( fs[] ) >> @@ -3718,266 +3069,471 @@ vl_typ_eq vl tl (ty:'a itself) = (* this property is applied only on the base type. It does not include the parer names*) val init_out_v_typed_def = Define ` init_out_v_typed (v:v) (ty:'a itself) = -(!tau . v_typ v (t_tau tau) F ==> v_typ (init_out_v v) (t_tau tau) F) + !tau random_oracle i. v_typ v (t_tau tau) F ==> v_typ (FST $ init_out_v random_oracle i v) (t_tau tau) F `; val init_out_svl_typed_def = Define ` init_out_svl_typed (svl: (string # v) list ) (ty:'a itself) = - ! (v:v) . MEM v (SND (UNZIP svl)) ==> init_out_v_typed (v) (ty:'a itself) + !(v:v). MEM v (SND (UNZIP svl)) ==> init_out_v_typed (v) (ty:'a itself) `; val init_out_sv_tup_typed_def = Define ` - init_out_sv_tup_typed (tup : (string#v) ) (ty:'a itself) = - init_out_v_typed ((SND tup)) (ty:'a itself) + init_out_sv_tup_typed (tup : (string#v) ) (ty:'a itself) = + init_out_v_typed ((SND tup)) (ty:'a itself) `; -(* init all varn in a list *) -val init_out_v_list = Define ` -init_out_v_list (vl:v list) = -MAP (\v. init_out_v v ) vl -`; +Theorem FOLDL_init_out_v_SNOC[local]: +!t t' random_oracle h' r. +FST + (FOLDL + (λ(l,i') (x,v,tau). + (λ(v',i''). (v'::l,i'')) + (init_out_v random_oracle i' v)) (SNOC h' t',r) t) = +SNOC h' (FST + (FOLDL + (λ(l,i') (x,v,tau). + (λ(v',i''). (v'::l,i'')) + (init_out_v random_oracle i' v)) (t',r) t)) +Proof +Induct >> ( + rpt strip_tac >> + gs[FOLDL] +) >> +PairCases_on ‘h’ >> +gvs[] >> +Cases_on ‘init_out_v random_oracle r h1’ >> gs[] >> +qpat_assum ‘!random_oracle h'. _’ (fn thm => REWRITE_TAC[GSYM thm]) >> +gs[] +QED +Theorem FOLDL_init_out_v_SNOC_tup[local]: +!t t' random_oracle h' r. +FST + (FOLDL + (λ(l,i') (x,v). + (λ(v',i''). ((x:string,v')::l,i'')) + (init_out_v random_oracle i' v)) (SNOC h' t',r) t) = +SNOC h' (FST + (FOLDL + (λ(l,i') (x,v). + (λ(v',i''). ((x,v')::l,i'')) + (init_out_v random_oracle i' v)) (t',r) t)) +Proof +Induct >> ( + rpt strip_tac >> + gs[FOLDL] +) >> +PairCases_on ‘h’ >> +gvs[] >> +Cases_on ‘init_out_v random_oracle r h1’ >> gs[] >> +qpat_assum ‘!random_oracle h'. _’ (fn thm => REWRITE_TAC[GSYM thm]) >> +gs[] +QED +Theorem FOLDL_init_out_v_SNOC_sing[local]: +!t t' random_oracle h' r. +FST + (FOLDL + (λ(l,i') (x,v). + (λ(v',i''). (v'::l,i'')) + (init_out_v random_oracle i' v)) (SNOC h' t',r) t) = +SNOC h' (FST + (FOLDL + (λ(l,i') (x,v). + (λ(v',i''). (v'::l,i'')) + (init_out_v random_oracle i' v)) (t',r) t)) +Proof +Induct >> ( + rpt strip_tac >> + gs[FOLDL] +) >> +PairCases_on ‘h’ >> +gvs[] >> +Cases_on ‘init_out_v random_oracle r h1’ >> gs[] >> +qpat_assum ‘!random_oracle h'. _’ (fn thm => REWRITE_TAC[GSYM thm]) >> +gs[] +QED -val init_struct = prove (`` -! xl vl b. -LENGTH xl = LENGTH vl ==> -(init_out_v (v_struct (ZIP (xl, vl))) = v_struct (ZIP (xl, MAP init_out_v vl)) /\ - init_out_v (v_header b (ZIP (xl, vl))) = v_header F (ZIP (xl, MAP init_out_v vl))) ``, +Theorem FOLDL_init_out_v_LENGTH[local]: +!t random_oracle q r xl vl r'. + LENGTH $ FST $ FOLDL + (λ(x_v_l,i') (x,v,tau). + (λ(v,i''). (v::x_v_l,i'')) + (init_out_v random_oracle i' v)) ([],r) t = LENGTH t +Proof +Induct >> ( + gs[] +) >> +rpt strip_tac >> +PairCases_on ‘h’ >> +gs[] >> +Cases_on ‘init_out_v random_oracle r h1’ >> +gs[] >> +REWRITE_TAC[GSYM SNOC] >> +REWRITE_TAC[Once FOLDL_init_out_v_SNOC] >> +gs[LENGTH_SNOC] +QED -Induct_on `xl` >> -Induct_on `vl` >> -fs[] >> -fs[init_out_v_def] >> -REPEAT STRIP_TAC >> -RES_TAC >> +Theorem FOLDL_init_out_v_oracle_index[local]: +!t random_oracle i r. + i < LENGTH t ==> + ?j. + EL i + (REVERSE + (FST + (FOLDL + (λ(l,i') (x,v,tau). + (λ(v',i''). (v'::l,i'')) + (init_out_v random_oracle i' v)) ([],r) t))) = + FST (init_out_v random_oracle j (EL i (MAP (FST o SND) t))) +Proof +Induct >> ( + gs[] +) >> +rpt strip_tac >> +PairCases_on ‘h’ >> +gs[] >> +Cases_on ‘init_out_v random_oracle r h1’ >> +gs[] >> +REWRITE_TAC[GSYM SNOC] >> +REWRITE_TAC[Once FOLDL_init_out_v_SNOC] >> +gs[REVERSE_SNOC] >> +Cases_on ‘i’ >- ( + gs[] >> + qexists_tac ‘r’ >> + gs[] +) >> +gs[] +QED -fs[ZIP_MAP] >> -fs[ELIM_UNCURRY] -); +Theorem FOLDL_init_out_v_triple_equiv[local]: +!x_v_tau_list x_list v_list tau_list random_oracle i l'. +LENGTH v_list = LENGTH tau_list ==> +x_v_tau_list = ZIP(x_list, ZIP(v_list, tau_list)) ==> +FST + (FOLDL + (λ(x_v_l',i') (x,v,tau). + (λ(v',i''). (v'::x_v_l',i'')) + (init_out_v random_oracle i' v)) (l',i) x_v_tau_list) = +FST + (FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). (v'::x_v_l',i'')) + (init_out_v random_oracle i' v)) (l',i) (ZIP(x_list,v_list))) +Proof +Induct_on ‘x_list’ >> ( + rpt strip_tac >> + gs[ZIP_def] +) >> +Cases_on ‘v_list’ >> Cases_on ‘tau_list’ >> gs[ZIP_def] >> +res_tac >> +Cases_on ‘init_out_v random_oracle i h'’ >> +gs[] +QED +(* TODO: Rename *) +Theorem FOLDL_init_out_v_MAP_FST_imp[local]: +!x_v_list x_v_list' l random_oracle i i'. + (FOLDL + (λ(x_v_l',i') (x:string,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) (l,i) x_v_list) = (x_v_list', i') ==> + (FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). (v'::x_v_l',i'')) + (init_out_v random_oracle i' v)) (MAP SND l,i) x_v_list) = (MAP SND x_v_list', i') +Proof +Induct >> ( + gs[] +) >> +rpt strip_tac >> +PairCases_on ‘h’ >> +gs[] >> +Cases_on ‘init_out_v random_oracle i h1’ >> +gs[] >> +res_tac >> +FULL_SIMP_TAC (srw_ss()) [] +QED + +Theorem FOLDL_init_out_v_identifiers[local]: +!l i random_oracle l' i'. + FOLDL + (λ(x_v_l',i') (x:string,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + l = + (l',i') ==> +MAP FST l = REVERSE $ MAP FST l' +Proof +Induct >> ( + gs[] +) >> +rpt strip_tac >> +PairCases_on ‘h’ >> +gs[] >> +Cases_on ‘init_out_v random_oracle i h1’ >> +gs[] >> +‘FST $ FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([(h0,q)],r) l = + l'’ by gs[] >> +FULL_SIMP_TAC bool_ss [GSYM SNOC] >> +FULL_SIMP_TAC bool_ss [Once FOLDL_init_out_v_SNOC_tup] >> +Cases_on ‘FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],r) l’ >> +res_tac >> +gvs[] +QED +Theorem MAP_FST_o_SND: +!l1 l2 l3. +LENGTH l1 = LENGTH l2 ==> +LENGTH l2 = LENGTH l3 ==> +MAP (FST ∘ SND) (ZIP (l1,ZIP (l2,l3))) = l2 +Proof +Induct_on ‘l1’ >> ( + gs[] +) >> +rpt strip_tac >> +Cases_on ‘l2’ >> gs[] >> +Cases_on ‘l3’ >> gs[] +QED val init_typed = prove (`` -(! (ty:'a itself) . -(! v . init_out_v_typed v (ty:'a itself) ) /\ -(! (svl). init_out_svl_typed svl ty) /\ -(! (sv) . init_out_sv_tup_typed sv ty)) ``, - - -STRIP_TAC >> -Induct >> -fs[init_out_v_typed_def] >> -REPEAT STRIP_TAC >> -fs[Once v_typ_cases] >> -fs[init_out_v_typed_def, init_out_v_def] >| [ - - (*v_bit*) - REPEAT STRIP_TAC >> - Cases_on `p` >> - srw_tac [SatisfySimps.SATISFY_ss][init_out_v_def] >> - fs[bs_width_def, extend_def] - - , - - (*v_struct*) - fs[clause_name_def] >> - rw[] >> - - Q.EXISTS_TAC ` - ZIP ( (MAP (λ(x_,v_,tau_). x_) x_v_tau_list), - ZIP ( (init_out_v_list ((MAP (λ(x_,v_,tau_). v_) x_v_tau_list) ) ) , - (MAP (λ(x_,v_,tau_). tau_) x_v_tau_list)))` >> - fs[] >> - - fs[map_distrub, map_rw1] >> - - fs[lambda_unzip_tri] >> - fs[lambda_12_unzip_tri] >> - fs[map_tri_zip12] >> - EVAL_TAC >> - fs[GSYM UNZIP_MAP] >> - fs[MAP_ZIP] >> CONJ_TAC >|[ - - ASSUME_TAC init_struct >> - gvs[] - , - - REPEAT STRIP_TAC >> - - fs[UNZIP_MAP] >> - fs[init_out_svl_typed_def] >> - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`(EL i (MAP FST (MAP SND (x_v_tau_list: (string # v # tau) list)))) `])) >> - - - subgoal `! (l: (string # v # tau) list ) .MAP FST (MAP SND l) = - MAP (λ(x_,v_,tau_). v_) l ` >- - (Induct_on `l` >> - REPEAT STRIP_TAC >> - fs[] >> PairCases_on `h` >> - gvs[] ) >> - - - subgoal `MEM (EL i (MAP FST (MAP SND x_v_tau_list))) - (MAP (λ(x_,v_,tau_). v_) x_v_tau_list)` >- - (fs[EL_MEM, MEM_EL] >> - Q.EXISTS_TAC `i` >> - fs[]) >> - - gvs[] >> - fs[init_out_v_typed_def] >> - - LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`EL i (MAP SND (MAP SND (x_v_tau_list:(string # v # tau) list ))) `])) >> - gvs[] >> - - subgoal `! (l: (string # v # tau) list ) .MAP SND (MAP SND l) = - MAP (λ(x_,v_,tau_). tau_) l ` >- - (Induct_on `l` >> - REPEAT STRIP_TAC >> - fs[] >> - PairCases_on `h` >> - gvs[] ) >> - - - - subgoal `MEM (EL i (MAP SND (MAP SND x_v_tau_list))) - (MAP (λ(x_,v_,tau_). tau_) x_v_tau_list)` >- - (fs[EL_MEM, MEM_EL] >> - Q.EXISTS_TAC `i` >> - fs[]) >> - - gvs[] >> - - ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:(v)``, ``:'b`` |-> ``:(v)``] P_on_any_EL) >> - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`(MAP (λ(x_,v_,tau_). v_) (x_v_tau_list : (string # v # tau) list))` - , `i`, ` init_out_v `])) >> - gvs[] - ] - -, - - (*same as above*) - (*v_struct*) - fs[clause_name_def] >> - rw[] >> - - Q.EXISTS_TAC ` - ZIP ( (MAP (λ(x_,v_,tau_). x_) x_v_tau_list), - ZIP ( (init_out_v_list ((MAP (λ(x_,v_,tau_). v_) x_v_tau_list) ) ) , - (MAP (λ(x_,v_,tau_). tau_) x_v_tau_list)))` >> - Q.EXISTS_TAC `F` >> - fs[] >> - - fs[map_distrub, map_rw1] >> - - fs[lambda_unzip_tri] >> - fs[lambda_12_unzip_tri] >> - fs[map_tri_zip12] >> - EVAL_TAC >> - fs[GSYM UNZIP_MAP] >> - fs[MAP_ZIP] >> CONJ_TAC >|[ - - ASSUME_TAC init_struct >> - gvs[] - , - - REPEAT STRIP_TAC >> - - fs[UNZIP_MAP] >> - fs[init_out_svl_typed_def] >> - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`(EL i (MAP FST (MAP SND (x_v_tau_list: (string # v # tau) list)))) `])) >| [ - - fs[Once v_typ_cases] - , - subgoal `! (l: (string # v # tau) list ) .MAP FST (MAP SND l) = - MAP (λ(x_,v_,tau_). v_) l ` >- - (Induct_on `l` >> - REPEAT STRIP_TAC >> - fs[] >> PairCases_on `h` >> - gvs[] ) >> - - - subgoal `MEM (EL i (MAP FST (MAP SND x_v_tau_list))) - (MAP (λ(x_,v_,tau_). v_) x_v_tau_list)` >- - (fs[EL_MEM, MEM_EL] >> - Q.EXISTS_TAC `i` >> - fs[]) >> - - gvs[] >> - fs[init_out_v_typed_def] >> - - LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`EL i (MAP SND (MAP SND (x_v_tau_list:(string # v # tau) list ))) `])) >> - gvs[] >> - - subgoal `! (l: (string # v # tau) list ) .MAP SND (MAP SND l) = - MAP (λ(x_,v_,tau_). tau_) l ` >- - (Induct_on `l` >> - REPEAT STRIP_TAC >> - fs[] >> - PairCases_on `h` >> - gvs[] ) >> - - - - subgoal `MEM (EL i (MAP SND (MAP SND x_v_tau_list))) - (MAP (λ(x_,v_,tau_). tau_) x_v_tau_list)` >- - (fs[EL_MEM, MEM_EL] >> - Q.EXISTS_TAC `i` >> - fs[]) >> - - gvs[] >> - - ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:(v)``, ``:'b`` |-> ``:(v)``] P_on_any_EL) >> - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`(MAP (λ(x_,v_,tau_). v_) (x_v_tau_list : (string # v # tau) list))` - , `i`, ` init_out_v `])) >> - gvs[] - ] - ] - , - fs[Once v_typ_cases, init_out_svl_typed_def] - , - - fs[init_out_svl_typed_def] >> - fs[init_out_sv_tup_typed_def] >> - - REPEAT STRIP_TAC >> - gvs[] - - , - - +(! (ty:'a itself). +(! v . init_out_v_typed v ty) /\ +(! svl. init_out_svl_typed svl ty) /\ +(! sv . init_out_sv_tup_typed sv ty))``, + +strip_tac >> +Induct >> ( + fs[init_out_v_typed_def] >> + rpt strip_tac >> + fs[Once v_typ_cases] >> + fs[init_out_v_typed_def, init_out_v_def] +) >- ( + (* v_bit *) + rpt strip_tac >> + PairCases_on `p` >> + fs[bs_width_def, extend_def, init_out_v_def] +) >- ( + (* v_struct *) + gvs[clause_name_def] >> + qexists_tac ‘ZIP(MAP(λ(x,v,tau). x) (x_v_tau_list:(string#v#tau) list), + ZIP (REVERSE $ FST (FOLDL (λ(l,i') (x:string,v,tau). (λ(v',i''). (v'::l,i'')) + (init_out_v random_oracle i' v)) ([],i) x_v_tau_list) , + MAP (λ(x,v,tau). tau) x_v_tau_list))’ >> + gvs[] >> + ‘?x_list v_list tau_list. x_v_tau_list = ZIP(x_list:string list,(ZIP(v_list,tau_list))) /\ LENGTH x_list = LENGTH v_list /\ LENGTH v_list = LENGTH tau_list’ by ( + qexistsl_tac [‘MAP (λx. FST x) x_v_tau_list’, ‘MAP (λx. FST (SND x)) x_v_tau_list’, ‘MAP (λx. SND (SND x)) x_v_tau_list’] >> + simp[Once $ Q.ISPEC ‘x_v_tau_list:((string#v#tau) list)’ ZIP_tri_id1] + ) >> + ‘LENGTH (FST + (FOLDL + (λ(l,i') (x,v,tau). + (λ(v',i''). (v'::l,i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,ZIP (v_list,tau_list))))) = LENGTH tau_list’ by gs[FOLDL_init_out_v_LENGTH] >> + gvs[map_distrub] >> + ‘?v_list' i'. (FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))) = (ZIP(REVERSE x_list, v_list'), i') /\ LENGTH v_list' = LENGTH x_list’ by ( + qexistsl_tac [‘MAP SND $ FST $ FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))’, ‘SND $ FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))’] >> + Cases_on ‘FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))’ >> gs[] >> + strip_tac >- ( + ‘REVERSE x_list = MAP FST q’ suffices_by ( + strip_tac >> + gvs[ZIP_MAP_FST_SND] + ) >> + imp_res_tac FOLDL_init_out_v_identifiers >> + gs[MAP_ZIP] + ) >> + ‘?x_v_tau_list. x_v_tau_list = ZIP(x_list,(ZIP(v_list,tau_list)))’ by gs[] >> + imp_res_tac FOLDL_init_out_v_triple_equiv >> + gs[] >> + imp_res_tac FOLDL_init_out_v_MAP_FST_imp >> + gvs[] + ) >> + gs[REVERSE_ZIP] >> + strip_tac >- ( + ‘v_list' = FST + (FOLDL + (λ(l,i') (x,v,tau). + (λ(v',i''). (v'::l,i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,ZIP (v_list,tau_list))))’ suffices_by gs[] >> + ‘v_list' = MAP SND $ FST $ FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))’ by gs[MAP_ZIP] >> + gvs[] >> + ‘?x_v_tau_list. x_v_tau_list = ZIP(x_list,(ZIP(v_list,tau_list)))’ by gs[] >> + imp_res_tac FOLDL_init_out_v_triple_equiv >> + gvs[] >> + Cases_on ‘FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))’ >> gs[] >> + imp_res_tac FOLDL_init_out_v_MAP_FST_imp >> + gvs[] + ) >> + rpt strip_tac >> + gvs[init_out_svl_typed_def] >> + subgoal ‘MEM (EL i'' v_list) v_list’ >- gvs[EL_MEM] >> + gvs[init_out_v_typed_def] >> + ‘i'' < LENGTH $ ZIP (x_list,ZIP (v_list,tau_list))’ by gs[] >> + imp_res_tac FOLDL_init_out_v_oracle_index >> + ‘MAP (FST ∘ SND) (ZIP (x_list,ZIP (v_list,tau_list))) = v_list’ by ( + metis_tac[MAP_FST_o_SND] + ) >> + metis_tac[] +) >- ( + (* v_header *) + gvs[clause_name_def] >> + qexistsl_tac [‘ZIP(MAP(λ(x,v,tau). x) (x_v_tau_list:(string#v#tau) list), + ZIP (REVERSE $ FST (FOLDL (λ(l,i') (x:string,v,tau). (λ(v',i''). (v'::l,i'')) + (init_out_v random_oracle i' v)) ([],i) x_v_tau_list) , + MAP (λ(x,v,tau). tau) x_v_tau_list))’, ‘F’] >> + gvs[] >> + ‘?x_list v_list tau_list. x_v_tau_list = ZIP(x_list,(ZIP(v_list,tau_list))) /\ LENGTH x_list = LENGTH v_list /\ LENGTH v_list = LENGTH tau_list’ by ( + qexistsl_tac [‘MAP (λx. FST x) x_v_tau_list’, ‘MAP (λx. FST (SND x)) x_v_tau_list’, ‘MAP (λx. SND (SND x)) x_v_tau_list’] >> + simp[Once $ Q.ISPEC ‘x_v_tau_list:((string#v#tau) list)’ ZIP_tri_id1] + ) >> + ‘LENGTH (FST + (FOLDL + (λ(l,i') (x,v,tau). + (λ(v',i''). (v'::l,i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,ZIP (v_list,tau_list))))) = LENGTH tau_list’ by gs[FOLDL_init_out_v_LENGTH] >> + gvs[map_distrub] >> + ‘?v_list' i'. (FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))) = (ZIP(REVERSE x_list, v_list'), i') /\ LENGTH v_list' = LENGTH x_list’ by ( + qexistsl_tac [‘MAP SND $ FST $ FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))’, ‘SND $ FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))’] >> + Cases_on ‘FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))’ >> gs[] >> + strip_tac >- ( + ‘REVERSE x_list = MAP FST q’ suffices_by ( + strip_tac >> + gvs[ZIP_MAP_FST_SND] + ) >> + imp_res_tac FOLDL_init_out_v_identifiers >> + gs[MAP_ZIP] + ) >> + ‘?x_v_tau_list. x_v_tau_list = ZIP(x_list,(ZIP(v_list,tau_list)))’ by gs[] >> + imp_res_tac FOLDL_init_out_v_triple_equiv >> + gs[] >> + imp_res_tac FOLDL_init_out_v_MAP_FST_imp >> + gvs[] + ) >> + gs[REVERSE_ZIP] >> + strip_tac >- ( + ‘v_list' = FST + (FOLDL + (λ(l,i') (x,v,tau). + (λ(v',i''). (v'::l,i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,ZIP (v_list,tau_list))))’ suffices_by gs[] >> + ‘v_list' = MAP SND $ FST $ FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))’ by gs[MAP_ZIP] >> + gvs[] >> + ‘?x_v_tau_list. x_v_tau_list = ZIP(x_list,(ZIP(v_list,tau_list)))’ by gs[] >> + imp_res_tac FOLDL_init_out_v_triple_equiv >> + gvs[] >> + Cases_on ‘FOLDL + (λ(x_v_l',i') (x,v). + (λ(v',i''). ((x,v')::x_v_l',i'')) + (init_out_v random_oracle i' v)) ([],i) + (ZIP (x_list,v_list))’ >> gs[] >> + imp_res_tac FOLDL_init_out_v_MAP_FST_imp >> + gvs[] + ) >> + rpt strip_tac >- ( + simp[Once v_typ_cases, clause_name_def] + ) >> + gvs[init_out_svl_typed_def] >> + subgoal ‘MEM (EL i'' v_list) v_list’ >- gvs[EL_MEM] >> + gvs[init_out_v_typed_def] >> + ‘i'' < LENGTH $ ZIP (x_list,ZIP (v_list,tau_list))’ by gs[] >> + imp_res_tac FOLDL_init_out_v_oracle_index >> + ‘MAP (FST ∘ SND) (ZIP (x_list,ZIP (v_list,tau_list))) = v_list’ by metis_tac[MAP_FST_o_SND] >> + metis_tac[] +) >- ( + (* empty list *) + gs[init_out_svl_typed_def] +) >- ( + (* list *) + fs[init_out_svl_typed_def, init_out_sv_tup_typed_def] >> + rpt strip_tac >> gvs[] +) >- ( + (* Tuple *) fs[init_out_sv_tup_typed_def] >> fs[init_out_v_typed_def] >> - RW_TAC (srw_ss()) [] >> - - Cases_on `v` >> - fs[clause_name_def] THEN_LT ( - NTH_GOAL ( OPEN_V_TYP_TAC ``v_struct l`` >> - INST_FST [`tau:tau`] >> - METIS_TAC[]) 4 ) - - THEN_LT ( - NTH_GOAL ( OPEN_V_TYP_TAC ``v_struct l`` >> - INST_FST [`tau:tau`] >> - METIS_TAC[]) 4 ) >> - - TRY (PairCases_on `p`) >> + gvs[] >> + Cases_on `v` >- ( + Cases_on `tau` >> fs[Once v_typ_cases] >> + fs[Once v_typ_cases] + ) >- ( + Cases_on `tau` >> fs[Once v_typ_cases] >> + fs[Once v_typ_cases] + ) >- ( + Cases_on `tau` >> fs[Once v_typ_cases] >> + fs[Once v_typ_cases] + ) >- ( + fs[clause_name_def] >> + rpt strip_tac >> + OPEN_V_TYP_TAC ``v_struct l`` >> + metis_tac[] + ) >- ( + fs[clause_name_def] >> + rpt strip_tac >> + OPEN_V_TYP_TAC ``v_struct l`` >> + metis_tac[] + ) >- ( + Cases_on `tau` >> fs[Once v_typ_cases] >> + fs[Once v_typ_cases] + ) >> Cases_on `tau` >> fs[Once v_typ_cases] >> - fs[Once v_typ_cases] -] + fs[Once v_typ_cases] +) ); @@ -3989,7 +3545,7 @@ FIND (λx. FST x = s) xtl = SOME a ==> Proof Induct_on `xtl` >> -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[FIND_def, INDEX_FIND_def] >> Cases_on ` FST h = s` >> gvs[] >> ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:('a#'b)``] P_hold_on_next) >> @@ -4000,79 +3556,6 @@ QED - -val access_struct_init_typed = prove ( `` -! x s v struct_ty x_tau_list tau . -v_typ x (t_tau (tau_xtl struct_ty x_tau_list)) F /\ -acc_f x s = SOME v /\ -correct_field_type x_tau_list s tau ==> -v_typ (init_out_v v) (t_tau tau) F - -``, -REPEAT STRIP_TAC >> -fs[correct_field_type_def, tau_in_rec_def] >> - -Cases_on `FIND (λ(xm,tm). xm = s) x_tau_list` >> fs[] >> rw[] >> -PairCases_on `x'` >> fs[] >> -Cases_on `x'1 = tau` >> fs[] >> -gvs[] >> -OPEN_V_TYP_TAC `x` >> -fs[] >> -gvs[] >> -fs[acc_f_def] >> - -Cases_on `FIND (λ(f',v). f' = s) (MAP (λ(x_,v_,tau_). (x_,v_)) x_v_tau_list)` >> fs[] >> rw[] >> -PairCases_on `x` >> fs[] >> -gvs[] >> -fs[FIND_def] >> -fs[] >> - -REPEAT ( - - PairCases_on `z` >> - PairCases_on `z'` >> - gvs[] >> - - subgoal `z0 = z'0` >- - (IMP_RES_TAC INDEX_FIND_same_list >> - gvs[]) >> - rw[] >> - - `z'0 < LENGTH (MAP (λ(x_,v_,tau_). (x_,tau_)) x_v_tau_list)` by IMP_RES_TAC INDEX_FIND_EQ_SOME_0 >> - `EL z'0 (MAP (λ(x_,v_,tau_). (x_,v_)) x_v_tau_list) = (x0,v)` by IMP_RES_TAC INDEX_FIND_EQ_SOME_0 >> - `EL z'0 (MAP (λ(x_,v_,tau_). (x_,tau_)) x_v_tau_list) = (x'0,tau)` by IMP_RES_TAC INDEX_FIND_EQ_SOME_0 >> - gvs[] >> - - subgoal `v = EL z'0 (MAP (λ(x_,v_,tau_). v_) x_v_tau_list)` >- - (IMP_RES_TAC EL_simp5 >> - METIS_TAC[] ) >> - - subgoal `EL z'0 (MAP (λ(x_,v_,tau_). tau_) x_v_tau_list) = tau ` >- - (IMP_RES_TAC EL_ZIP_simp >> - fs[] >> - METIS_TAC[] ) >> - - subgoal `v_typ v (t_tau tau) F` >- - (INST_FST [`z'0`] >> - RES_TAC >> - gvs[] ) >> - - - ASSUME_TAC init_typed >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`ty`])) >> - - - Q.PAT_X_ASSUM ` ∀v. init_out_v_typed v ty ` - (STRIP_ASSUME_TAC o (Q.SPECL [`v`])) >> - - fs[init_out_v_typed_def] -)); - - - - - Theorem ev_not_typed_T: ! t_g t_sl T_e v tau . ~ e_typ (t_g,t_sl) T_e (e_v v) (t_tau tau) T @@ -4084,13 +3567,13 @@ QED -Theorem lookup_lval_exsists: +Theorem lookup_lval_exists: ! ss v x s . lookup_lval (ss) (lval_field x s) = SOME v ==> ? v' . lookup_lval (ss) x = SOME v' Proof -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[lookup_lval_def] >> Cases_on `lookup_lval ss x` >> fs[] @@ -4106,7 +3589,7 @@ correct_field_type x_tau_list s tau ==> v_typ v (t_tau tau) F Proof -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[correct_field_type_def, tau_in_rec_def] >> Cases_on `FIND (λ(xm,tm). xm = s) x_tau_list` >> fs[] >> @@ -4165,7 +3648,7 @@ v_typ v (t_tau tau) F) fs[wf_arg_def, is_d_out_def] >> Induct >> -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[get_lval_of_e_def] >> gvs[] >| [ @@ -4243,7 +3726,7 @@ gvs[] >| [ `t_sl` , `b`, `d`])) >> gvs[] >> - IMP_RES_TAC lookup_lval_exsists >> + IMP_RES_TAC lookup_lval_exists >> gvs[] >> (* @@ -4293,70 +3776,75 @@ gvs[] >| [ val CI_scope_WT_single = prove ( `` -! e gscope t_g scopest t_sl x d tau T_e scope' b t. +! e gscope t_g scopest t_sl x d tau T_e scope' b t random_oracle. type_scopes_list gscope t_g /\ type_scopes_list scopest t_sl /\ star_not_in_sl scopest /\ ( e_typ (t_g,t_sl) T_e e (t_tau tau) b) /\ wf_arg d x e (scopest ⧺ gscope) /\ -copyin_abstract [x] [d] [e] (scopest ⧺ gscope) scope' ==> +copyin_abstract [x] [d] [e] (scopest ⧺ gscope) scope' random_oracle ==> type_scopes_list [scope'] [ZIP ((mk_varn [x]), ZIP([tau], [get_lval_of_e e] ))] ``, - fs[type_scopes_list_def] >> fs[mk_varn_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on `is_d_out d` >> SIMP_TAC list_ss [similarl_def, similar_def] >> fs[mk_varn_def] >> fs[copyin_abstract_def] >> -fs[] >> - +qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPECL [‘oracle_index'’] thm) >> fs[] >> -Cases_on `one_arg_val_for_newscope d e (scopest ⧺ gscope)` >> -fs[] >> +Cases_on `one_arg_val_for_newscope d e (scopest ⧺ gscope) oracle_index' random_oracle` >> (fs[]) >> PairCases_on `x'` >> -Q.EXISTS_TAC `(varn_name x,x'0,x'1)` >> +qexists_tac `(varn_name x,x'0,x'2)` >> gvs[] >| [ - -(** inout & out directed **) - - subgoal `scope' = [(varn_name x,x'0,x'1)]` >- - (Induct_on `scope'` >> - fs[]) >> - fs[] >> rw[] >> - + (** inout & out directed **) + subgoal `scope' = [(varn_name x,x'0,x'2)]` >- ( + Induct_on `scope'` >> + fs[] + ) >> + fs[] >> rw[] >> ( fs[wf_arg_def, is_d_out_def] >> - fs[one_arg_val_for_newscope_def, is_d_out_def] >> gvs[] >> + Cases_on `is_d_in d` >> fs[] >> gvs[] + ) >- ( + (* inout *) + ASSUME_TAC out_dir_lookup_typed >> + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL + [`e`,`tau`, `lval`, `T_e`, `gscope`, `t_g`, + `scopest`, `t_sl`, `b`, `d`, `x`])) >> + gvs[type_scopes_list_def] >> + fs[wf_arg_def] >> gvs[] >> + metis_tac[] + ) >> + ASSUME_TAC out_dir_lookup_typed >> + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL + [`e`,`tau`, `lval`, `T_e`, `gscope`, `t_g`, + `scopest`, `t_sl`, `b`, `d`, `x`])) >> + gvs[type_scopes_list_def] >> + fs[wf_arg_def] >> gvs[] >> + ‘v_typ v (t_tau tau) F’ by ( + metis_tac[] + ) >> + (* out *) + ASSUME_TAC init_typed >> + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`])) >> + fs[] >> + fs[init_out_v_typed_def] >> + gvs[] >> + res_tac >> + ‘x'0 = FST $ init_out_v random_oracle oracle_index' v’ suffices_by ( + rpt strip_tac >> + FULL_SIMP_TAC bool_ss [] + ) >> + rfs[], - Cases_on `is_d_in d` >> fs[] >> gvs[] >> - - (* inout *) - ASSUME_TAC out_dir_lookup_typed >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`e`,`tau`, `lval`, `T_e`, `gscope`, `t_g`, - `scopest`, `t_sl`, `b`, `d`, `x`])) >> - gvs[type_scopes_list_def] >> - fs[wf_arg_def] >> gvs[] >> - - - (* out *) - ASSUME_TAC init_typed >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`ty`])) >> - fs[] >> - fs[init_out_v_typed_def] >> - - - METIS_TAC[] - , - - subgoal `scope' = [(varn_name x,x'0,x'1)]` >- - (Induct_on `scope'` >> - fs[]) >> + subgoal `scope' = [(varn_name x,x'0,x'2)]` >- ( + Induct_on `scope'` >> + fs[] + ) >> fs[] >> rw[] >> fs[one_arg_val_for_newscope_def] >> @@ -4370,8 +3858,9 @@ gvs[] >| [ Cases_on `b` >> IMP_RES_TAC ev_not_typed_T >> IMP_RES_TAC ev_types_v >> - gvs[get_lval_of_e_def] -]); + gvs[get_lval_of_e_def] +] +); val similar_normalize = prove ( `` @@ -4380,7 +3869,7 @@ val similar_normalize = prove ( `` similar R l (ZIP (vl,tl)) ⇒ similar R (a::l) (ZIP (v::vl,t::tl))``, -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[similar_def] ); @@ -4398,7 +3887,7 @@ fs[similar_def] val CI_scope_list_typed = prove (`` -! e_x_d_list scopest t_sl gscope t_g scope' e_tau_x_d_b_list T_e. +! e_x_d_list scopest t_sl gscope t_g scope' e_tau_x_d_b_list T_e i random_oracle. (LENGTH e_tau_x_d_b_list = LENGTH e_x_d_list) /\ type_scopes_list gscope t_g /\ type_scopes_list scopest t_sl /\ @@ -4414,31 +3903,32 @@ wf_arg_list (MAP (λ(e,x,d). d) e_x_d_list) (scopest ⧺ gscope) /\ copyin_abstract (MAP (λ(e,x,d). x) e_x_d_list) (MAP (λ(e,x,d). d) e_x_d_list) (MAP (λ(e,x,d). e) e_x_d_list) - (scopest ⧺ gscope) scope' ==> + (scopest ⧺ gscope) scope' random_oracle ==> type_scopes_list [scope'] [ZIP (mk_varn (MAP (λ(e_,x_,d_). x_) e_x_d_list), ZIP (MAP (λ(e_,tau_,x_,d_,b_). tau_) e_tau_x_d_b_list, - MAP (λ(e_,x_,d_). get_lval_of_e e_) e_x_d_list))] ``, + MAP (λ(e_,x_,d_). get_lval_of_e e_) e_x_d_list))] ``, + Induct >| [ - REPEAT STRIP_TAC >> fs[] >> + rpt strip_tac >> fs[] >> fs[similar_def, copyin_abstract_def] >> SIMP_TAC list_ss [type_scopes_list_def, mk_varn_def] >> fs[similarl_def, similar_def] , - REPEAT STRIP_TAC >> fs[] >> + rpt strip_tac >> fs[] >> PairCases_on `h` >> fs[] >> (* first show that the head is well typed*) subgoal `type_scopes_list [[HD scope']] [ZIP (mk_varn [h1], ZIP( [HD (MAP (λ(e_,tau_,x_,d_,b_). tau_) e_tau_x_d_b_list)], [ get_lval_of_e h0] ))] ` >- ( `wf_arg h2 h1 h0 (scopest ⧺ gscope)` by IMP_RES_TAC wf_arg_normalization >> - subgoal `copyin_abstract [h1] [h2] [h0] (scopest ⧺ gscope) [HD scope']` >- - (IMP_RES_TAC copyin_abstract_normalize_tmp >> - rfs[] ) >> + subgoal `copyin_abstract [h1] [h2] [h0] (scopest ⧺ gscope) [HD scope'] random_oracle` >- + (IMP_RES_TAC copyin_abstract_normalize_tmp >> + rfs[] ) >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`0`])) >> gvs[] >> @@ -4448,7 +3938,9 @@ Induct >| [ `(HD (MAP (λ(e_,tau_,x_,d_,b_). tau_) (e_tau_x_d_b_list : (α # tau # β # γ # bool) list)))`, `T_e`, `[HD scope']`, `(HD (MAP (λ(e_,tau_,x_,d_,b_). b_) (e_tau_x_d_b_list : (α # tau # β # γ # bool) list)))`])) >> - gvs[] ) >> + gvs[] >> + metis_tac[] + ) >> (* now use the IH to show that the TL of the CI scope is also well type *) @@ -4459,12 +3951,11 @@ Induct >| [ `copyin_abstract (MAP (λ(e,x,d). x) e_x_d_list) (MAP (λ(e,x,d). d) e_x_d_list) (MAP (λ(e,x,d). e) e_x_d_list) - (scopest ⧺ gscope) (TL scope')` by (IMP_RES_TAC copyin_abstract_normalize_tmp >> + (scopest ⧺ gscope) (TL scope') random_oracle` by (IMP_RES_TAC copyin_abstract_normalize_tmp >> rfs[] ) >> - + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`scopest`,`t_sl`, `gscope`,`t_g`, `TL scope'`, `TL e_tau_x_d_b_list`, `T_e` ])) >> - + [`scopest`,`t_sl`, `gscope`,`t_g`, `TL scope'`, `TL e_tau_x_d_b_list`, `T_e`, ‘random_oracle’ ])) >> subgoal `LENGTH (TL e_tau_x_d_b_list) = LENGTH e_x_d_list` >- (Cases_on `e_tau_x_d_b_list` >> Cases_on `e_x_d_list` >> @@ -4477,7 +3968,7 @@ Induct >| [ (EL i (MAP (λ(e_,x_,d_). e_) e_x_d_list)) (t_tau (EL i (MAP (λ(e_,tau_,x_,d_,b_). tau_) (TL e_tau_x_d_b_list)))) (EL i (MAP (λ(e_,tau_,x_,d_,b_). b_) (TL e_tau_x_d_b_list))))` >- - ( REPEAT STRIP_TAC >> + ( rpt strip_tac >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`i + 1` ])) >> gvs[ADD1] >> fs[EL_CONS] >> @@ -4582,218 +4073,8 @@ Induct >| [ ])) >> METIS_TAC[] ] - ); - - - - - -(* - -(* we need to show that the exp when typed, it is independent from the delta_t *) -val e_typ_indep_from_delta_t_def = Define ` - - e_typ_indep_from_delta_t e (ty:'a itself) = - ∀ tau b t_g t_sl order f delta_g delta_b delta_x delta_t. - - e_typ (t_g,t_sl) (order,f,delta_g,delta_b,delta_x,delta_t) (e) (tau) b - ⇔ - e_typ (t_g,t_sl) (order,f,delta_g,delta_b,delta_x,[] ) (e) (tau) b`; - - -val el_typ_indep_from_delta_t_def = Define ` - el_typ_indep_from_delta_t (l : e list) (ty:'a itself) = - !(e : e). MEM e l ==> e_typ_indep_from_delta_t (e) (ty:'a itself) -`; - - -val expstrl_typ_indep_from_delta_t_def = Define ` - expstrl_typ_indep_from_delta_t (l : (string#e) list) (ty:'a itself) - = ! (e:e) . MEM e (SND (UNZIP l)) ==> e_typ_indep_from_delta_t(e) (ty:'a itself) -`; - - -val expstr_tup_typ_indep_from_delta_t_def = Define ` - expstr_tup_typ_indep_from_delta_t (tup : (string#e)) (ty:'a itself) - = e_typ_indep_from_delta_t ((SND tup)) (ty:'a itself) -`; - - - - - - -val e_typ_rel_to_delta_t = prove ( “ -! (ty:'a itself) . -(!e. e_typ_indep_from_delta_t e ty) /\ -(! (l1: e list). el_typ_indep_from_delta_t l1 ty) /\ -(! (l2: (string#e) list) . expstrl_typ_indep_from_delta_t l2 ty) /\ -(! tup. expstr_tup_typ_indep_from_delta_t tup ty)”, - -STRIP_TAC >> -Induct >> -REPEAT STRIP_TAC >> - -(( -fs[e_typ_indep_from_delta_t_def] >> -REPEAT STRIP_TAC >> - - -(* resolves most of the cases *) -EQ_TAC >> -REPEAT STRIP_TAC >> -OPEN_EXP_TYP_TAC ``e`` >> -SIMP_TAC list_ss [Once e_typ_cases] >> -gvs[] >> - -srw_tac [SatisfySimps.SATISFY_ss][] >> - -TRY( - Q.EXISTS_TAC `w1` >> - Q.EXISTS_TAC `w2'` >> - Q.EXISTS_TAC `b'` >> - Q.EXISTS_TAC `b''`) >> - -TRY( - Q.EXISTS_TAC `tau'` >> - Q.EXISTS_TAC `b'` >> - Q.EXISTS_TAC `b''`) >> - -srw_tac [SatisfySimps.SATISFY_ss][] >> FIRST [ - (* fcall *) - - Q.EXISTS_TAC `e_tau_d_b_list` >> - gvs[] >> - REPEAT STRIP_TAC >> - fs[el_typ_indep_from_delta_t_def] >> gvs[] >> - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`EL i (MAP (λ(e_,tau_,d_,b_). e_) (e_tau_d_b_list: (e # tau # d # bool) list))`])) >> - fs[MEM_EL] >> - - RES_TAC >> - gvs[] >> - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`i`])) >> - gvs[] >> - - - - fs[e_typ_indep_from_delta_t_def] >> - RES_TAC >> - gvs[] - - , - (* e struct + header case *) - - Q.EXISTS_TAC `f_e_tau_b_list` >> - gvs[] >> - REPEAT STRIP_TAC >> - fs[expstrl_typ_indep_from_delta_t_def] >> gvs[] >> - - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`EL i (MAP (λ(f_,e_,tau_,b_). e_) (f_e_tau_b_list: (string # e # tau # bool) list))`])) >> - fs[MEM_EL] >> - - subgoal `! l i . EL i (MAP (λx. FST (SND x)) l) = - EL i (SND (UNZIP (MAP (λx. (FST x,FST (SND x))) l)))` >- - (Induct >> - FULL_SIMP_TAC list_ss [MAP_MAP_o, FST,SND] >> - REPEAT STRIP_TAC >> - PairCases_on `h` >> - Cases_on `i'` >> - fs[] ) >> - - RES_TAC >> - SRW_TAC [] [] >> - gvs[ELIM_UNCURRY, UNZIP_rw] >> - - RES_TAC >> - gvs[] >> - - LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`i`])) >> - gvs[] >> - - - - fs[e_typ_indep_from_delta_t_def] >> - RES_TAC >> - gvs[] - - ] - -) ORELSE - (fs[expstrl_typ_indep_from_delta_t_def, - expstr_tup_typ_indep_from_delta_t_def, - el_typ_indep_from_delta_t_def, - e_typ_indep_from_delta_t_def] >> - REPEAT STRIP_TAC >> - gvs[])) -); - - - -val e_typ_rel_to_delta_t_LIST = prove ( “ - -∀ el tl bl t_scope_list_g t_scope_list order f delta_g delta_b delta_x delta_t . - LENGTH el = LENGTH tl ∧ LENGTH bl = LENGTH el ⇒ - - ((∀i. i < LENGTH bl ⇒ - e_typ (t_scope_list_g,t_scope_list) - (order,f,delta_g,delta_b,delta_x,delta_t) - (EL i el) - (t_tau (EL i tl)) - (EL i bl)) ⇔ - - (∀i. i < LENGTH bl ⇒ - e_typ (t_scope_list_g,t_scope_list) - (order,f,delta_g,delta_b,delta_x,[]) - (EL i el) - (t_tau (EL i tl)) - (EL i bl))) ”, - -REPEAT STRIP_TAC >> -gvs[] >> -EQ_TAC >> -REPEAT STRIP_TAC >> - -(fs[Once EL_compute] >> -CASE_TAC >| [ - gvs[] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`0`])) >> - gvs[] >> - - ASSUME_TAC e_typ_rel_to_delta_t >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`])) >> - LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`HD el`])) >> - fs[e_typ_indep_from_delta_t_def] - - , - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`i`])) >> - gvs[] >> - - ASSUME_TAC e_typ_rel_to_delta_t >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`])) >> - LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`EL (PRE i) (TL el)`])) >> - fs[e_typ_indep_from_delta_t_def] - ]) ); - -*) - - - - - - - - - @@ -4828,7 +4109,7 @@ Theorem type_scopes_list_normalize2: Proof Induct >> -REPEAT STRIP_TAC >> +rpt strip_tac >> IMP_RES_TAC type_scopes_list_LENGTH >> gvs[] >> @@ -4852,7 +4133,7 @@ Proof Induct_on ‘gscope’ >> Induct_on ‘tslg’ >> Induct_on ‘i’ >> -REPEAT STRIP_TAC >> +rpt strip_tac >> gvs[] >> IMP_RES_TAC type_scopes_list_LENGTH >> gvs[] >> @@ -4873,7 +4154,7 @@ Theorem scopes_to_pass_typed_lem: type_scopes_list g_scope_passed tslg_passed Proof gvs[scopes_to_pass_def, t_scopes_to_pass_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on ‘funn’ >> gvs[] >> @@ -4900,9 +4181,9 @@ Theorem scopes_to_pass_typed_thm: type_scopes_list g_scope_passed tslg_passed Proof gvs[WT_c_cases] >> - REPEAT STRIP_TAC >> + rpt strip_tac >> drule scopes_to_pass_typed_lem >> - REPEAT STRIP_TAC >> + rpt strip_tac >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘gscope’,‘tslg’,‘funn’, ‘func_map’, ‘delta_g’, ‘g_scope_passed’, ‘tslg_passed’])) >> gvs[] QED @@ -4910,22 +4191,6 @@ QED -(* -Theorem t_scopes_passed_parseError: -∀ tslg tscl passed_tslg f delta_b delta_g. -t_scopes_to_pass f delta_g delta_b tslg = SOME passed_tslg ∧ -parseError_in_gs tslg tscl ⇒ -parseError_in_gs passed_tslg tscl -Proof -REPEAT STRIP_TAC >> -gvs[t_scopes_to_pass_def] >> -REPEAT (BasicProvers.FULL_CASE_TAC >> gvs[]) >> -gvs[parseError_in_gs_def] -QED -*) - - - val lookup_parse_err_in_xdl = prove (“ ∀ xdl tl. EVERY (λ(x,d). x ≠ "parseError") (MAP (λ(x_,d_). (x_,d_)) xdl) ⇒ @@ -4933,7 +4198,7 @@ ALOOKUP (ZIP (mk_varn (MAP (λ(x_,d_). x_) xdl),tl)) (varn_name "parseError") = Induct_on ‘xdl’ >> Induct_on ‘tl’ >> -REPEAT STRIP_TAC >> +rpt strip_tac >> gvs[mk_varn_def, ZIP_def]>> PairCases_on ‘h'’ >> gvs[] @@ -4950,7 +4215,7 @@ lookup_map [ZIP (mk_varn (MAP FST xdl), tl)] (varn_name "parseError") = NONE ” gvs[not_parseError_str_def, lookup_map_def] >> gvs[topmost_map_def, find_topmost_map_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> REPEAT (BasicProvers.FULL_CASE_TAC >> gvs[]) >> gvs[INDEX_FIND_EQ_SOME_0] >> @@ -4967,7 +4232,7 @@ Theorem MAP_FST_3_2: MAP SND (MAP (λ(e_,x_,d_). (x_,d_)) l) = MAP (λ(e_,x_,d_). (d_)) l Proof Induct >> gvs[] >> -REPEAT STRIP_TAC >> PairCases_on ‘h’ >> gvs[] +rpt strip_tac >> PairCases_on ‘h’ >> gvs[] QED @@ -4985,14 +4250,14 @@ MAP FST (MAP (λ(e_,tau_,x_,d_,b_). (tau_,x_,d_)) l) = MAP (λ(e_,tau_,x_,d_,b_). (tau_)) l Proof Induct >> gvs[] >> -REPEAT STRIP_TAC >> PairCases_on ‘h’ >> gvs[] +rpt strip_tac >> PairCases_on ‘h’ >> gvs[] QED Theorem MAP_SND_4_2: ∀ l . MAP (λ(e_,e'_,x_,d_). d_) l = MAP SND (MAP (λ(e_,e'_,x_,d_). (x_,d_)) l) Proof -Induct_on ‘l’ >> gvs[] >> REPEAT STRIP_TAC >> PairCases_on ‘h’ >> gvs[] +Induct_on ‘l’ >> gvs[] >> rpt strip_tac >> PairCases_on ‘h’ >> gvs[] QED @@ -5009,9 +4274,9 @@ out_is_lval (d::dl) (b::bl) <=> Proof gvs[out_is_lval_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> EQ_TAC >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`i+1`])) >> gvs[] >> @@ -5050,7 +4315,7 @@ wf_arg d x e ss ∧ (is_d_out d ⇒ b) ⇒ out_lval_consistent [get_lval_of_e e] [d]”, gvs[out_lval_consistent_def, wf_arg_def ] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on ‘is_d_out d’ >> gvs[] >> Cases_on ‘e’ >> gvs[get_lval_of_e_def, v_of_e_def] @@ -5069,7 +4334,7 @@ out_is_lval (MAP (λ(e_,x_,d_). d_) e_x_d_list) (bl) ⇒ out_lval_consistent (MAP (λ(e_,x_,d_). get_lval_of_e e_) e_x_d_list) (MAP (λ(e_,x_,d_). d_) e_x_d_list) Proof Induct >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ gvs[out_lval_consistent_def] , PairCases_on ‘h’ >> gvs[] >> @@ -5135,7 +4400,7 @@ e_typ (tslg,tsl) T_e e (t_tau tau) b ∧ get_lval_of_e e = SOME lop ⇒ lval_typ (tslg,tsl) T_e lop (t_tau tau) ”, -REPEAT STRIP_TAC >> +rpt strip_tac >> gvs[wf_arg_def] >> Cases_on ‘is_d_out d’ >> gvs[] >> IMP_RES_TAC e_typ_imp_lval_typ>> @@ -5152,7 +4417,7 @@ e_typ (tslg,tsl) T_e e (t_tau tau) b ∧ ALOOKUP [(x,tau,get_lval_of_e e)] a = SOME (t, SOME lop) ⇒ lval_typ (tslg,tsl) T_e lop (t_tau t) ”, -REPEAT STRIP_TAC >> +rpt strip_tac >> Cases_on ‘a=x’ >> gvs[] >> gvs[out_is_lval_def, wf_arg_def] >> Cases_on ‘is_d_out d’ >> gvs[] >> @@ -5185,7 +4450,7 @@ lval_typ (tslg,tsl) T_e lop (t_tau t) ”, Induct >> Cases_on ‘tbl’ >> gvs[] >> -REPEAT STRIP_TAC >- +rpt strip_tac >- gvs[mk_varn_def] >> PairCases_on ‘h'’ >> PairCases_on ‘h’ >> gvs[] >> @@ -5202,7 +4467,7 @@ REPEAT STRIP_TAC >- subgoal ‘(∀i. i < LENGTH t ⇒ e_typ (tslg,tsl) T_e (EL i (MAP (λ(e,x,d). e) exdl)) (t_tau (EL i (MAP (λ(t,b). t) t))) (EL i (MAP (λ(t,b). b) t)))’ >- ( - REPEAT STRIP_TAC >> + rpt strip_tac >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘i+1’])) >> gvs[ADD1, EL_CONS] >> gvs[PRE_SUB1] ) >> gvs[] @@ -5221,7 +4486,7 @@ QED Theorem bv_casting_length2: ∀ n' bitv. n' = bs_width (bitv_cast n' bitv) Proof -REPEAT STRIP_TAC >> Cases_on ‘bitv’ >> +rpt strip_tac >> Cases_on ‘bitv’ >> gvs[bitv_cast_def, bs_width_def, fixwidth_def, DROP] QED @@ -5275,7 +4540,7 @@ QED (****************) Theorem SR_e: -! (ty:'a itself) . +!(ty:'a itself) . (!e. sr_exp e ty) /\ (! (l1: e list). sr_exp_list l1 ty) /\ (! (l2: (string#e) list) . sr_strexp_list l2 ty) /\ @@ -5297,7 +4562,7 @@ FULL_SIMP_TAC list_ss [sr_exp_def, lemma_v_red_forall] (*****************) rfs[sr_exp_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> OPEN_EXP_RED_TAC ``(e_var v)`` >> @@ -5341,7 +4606,7 @@ rw[] >|[ fs[sr_exp_list_def] >> rfs[sr_exp_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> FULL_SIMP_TAC (srw_ss()) [Once e_sem_cases] , @@ -5351,7 +4616,7 @@ FULL_SIMP_TAC (srw_ss()) [Once e_sem_cases] (*****************) SIMP_TAC list_ss [sr_exp_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> OPEN_EXP_RED_TAC ``(e_acc e s)`` >> FULL_SIMP_TAC list_ss [lemma_v_red_forall] >> rw[] >|[ @@ -5451,9 +4716,9 @@ FULL_SIMP_TAC list_ss [lemma_v_red_forall] >> rw[] >|[ (* unary oper *) (*****************) -REPEAT STRIP_TAC >> +rpt strip_tac >> SIMP_TAC std_ss [sr_exp_def] >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ Cases_on `u` >> fs[sr_exp_def] >| [ @@ -5543,9 +4808,9 @@ REPEAT STRIP_TAC >| [ (****************) (* Cast *) (****************) -REPEAT STRIP_TAC >> +rpt strip_tac >> SIMP_TAC (srw_ss()) [sr_exp_def] >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ gvs[Once e_sem_cases] >| [ OPEN_EXP_TYP_TAC ``(e_cast c e)`` >> @@ -5597,9 +4862,9 @@ REPEAT STRIP_TAC >| [ -REPEAT STRIP_TAC >> +rpt strip_tac >> SIMP_TAC (srw_ss()) [sr_exp_def] >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ Cases_on `is_const e` >| [ Cases_on `is_const e'` >| [ @@ -5711,7 +4976,7 @@ REPEAT STRIP_TAC >| [ (****************) SIMP_TAC std_ss [sr_exp_def] >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ OPEN_EXP_RED_TAC ``(e_concat e e')`` >> REV_FULL_SIMP_TAC (srw_ss()) [] >> @@ -5758,7 +5023,7 @@ srw_tac [SatisfySimps.SATISFY_ss][e_resulted_frame_is_WT] (****************) SIMP_TAC std_ss [sr_exp_def] >> -REPEAT STRIP_TAC >|[ +rpt strip_tac >|[ OPEN_EXP_RED_TAC ``(e_slice e e' e'')`` >> REV_FULL_SIMP_TAC (srw_ss()) [] >| [ @@ -5810,7 +5075,7 @@ SIMP_TAC (srw_ss()) [Once e_typ_cases] >> (****************) fs[sr_exp_def] >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ (* the expression typing part *) @@ -5834,9 +5099,13 @@ REPEAT STRIP_TAC >| [ Q.EXISTS_TAC `MAP (λ(e_,tau_,x_,d_,b_). (tau_,x_,d_)) e_tau_x_d_b_list` >> fs[] >> rw[] >> - + ‘WT_c + (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle) order + t_scope_list_g delta_g delta_b delta_x delta_t Prs_n’ by ( + metis_tac[WT_c_ec] + ) >> IMP_RES_TAC Fg_star_lemma2 >> gvs[] - , (* reduction (call f el -> cal f el' ) where all args are reduced *) @@ -5882,12 +5151,13 @@ REPEAT STRIP_TAC >| [ `gscope`, `scopest`, `framel`, + ‘i_opt’, `t_scope_list`, `t_scope_list_g`, `t_tau (EL i (MAP (λ(e_,tau_,x_,d_,b_). tau_) (e_tau_x_d_b_list : (e # tau # x # d # bool) list ) ))`, `(EL i (MAP (λ(e_,tau_,x_,d_,b_). b_) (e_tau_x_d_b_list : (e # tau # x # d # bool) list ) ))`, `order`, `delta_g`, `delta_b`, `delta_t`, `delta_x`, - `f'`, `f_called` , `stmt_called`, `copied_in_scope`,‘Prs_n’ ,‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) o + `f'`, `f_called` , `stmt_called`, `copied_in_scope`,‘Prs_n’ ,‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’, ‘oracle_index’, ‘random_oracle’])) o SIMP_RULE (srw_ss()) [sr_exp_def]) >> gvs[] >> @@ -5919,14 +5189,21 @@ REPEAT STRIP_TAC >| [ (* the direction lists are the same *) subgoal ` (MAP (λ(e_,e'_,x_,d_). d_) e_e'_x_d_list) = - (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list)`>- - (ASSUME_TAC dir_fun_delta_same >> + (MAP (λ(e_,tau_,x_,d_,b_). d_) e_tau_x_d_b_list)` >- + ( + ‘WT_c + (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle) order + t_scope_list_g delta_g delta_b delta_x delta_t Prs_n’ by ( + metis_tac[WT_c_ec] + ) >> + ASSUME_TAC dir_fun_delta_same >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [ `(MAP (λ(e_,e'_,x_,d_). (x_,d_)) (e_e'_x_d_list : (e # e # string # d) list)) `, `(MAP (λ(e_,tau_,x_,d_,b_). (tau_,x_,d_)) (e_tau_x_d_b_list : (e # tau # string # d # bool) list))`, `tau'`, `f`, `func_map`, `b_func_map`, `ext_map`, `delta_g`, `delta_b`, `delta_x`, `apply_table_f`, - `order`, `t_scope_list_g`, `pars_map`, `tbl_map`, ‘delta_t’, ‘Prs_n’])) >> + `order`, `t_scope_list_g`, `pars_map`, `tbl_map`, ‘get_oracle_index’, ‘set_oracle_index’, ‘random_oracle’, ‘delta_t’, ‘Prs_n’])) >> gvs[] >> IMP_RES_TAC map_simp_1 >> gvs[MAP_MAP_txd] >> @@ -5934,7 +5211,6 @@ REPEAT STRIP_TAC >| [ gvs[MAP_SND_4_2] ) >> - (* if the arg is unred, then either out and not lval, or in and not const *) gvs[] >> IMP_RES_TAC unred_arg_index_result >| [ @@ -5973,9 +5249,15 @@ REPEAT STRIP_TAC >| [ (* first thing is showing that the args and parameters are the same the directions of the call in both semantics and function typing are the same also that the parserError string is not a name in teh arguments - also show that the parameters have distinct names *) + also show that the parameters have distinct names *) + ‘WT_c + (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle) order + t_scope_list_g delta_g delta_b delta_x delta_t Prs_n’ by ( + metis_tac[WT_c_ec] + ) >> drule tfunn_imp_sig_body_lookup >> - REPEAT STRIP_TAC >> + rpt strip_tac >> LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`MAP (λ(e_,tau_,x_,d_,b_). (tau_,x_,d_)) (e_tau_x_d_b_list : (e # tau # x # d # bool) list)`, `tau' `, `f`])) >> @@ -5984,7 +5266,7 @@ REPEAT STRIP_TAC >| [ (* we know that stmt_called and stmt are the same, and also same for xdl and the map to x d *) - + Cases_on `lookup_funn_sig_body f func_map b_func_map ext_map` >> gvs[] >> @@ -6028,7 +5310,7 @@ REPEAT STRIP_TAC >| [ gvs[] >> (* then use the abstract definition of copyin *) - IMP_RES_TAC copyin_eq >> + IMP_RES_TAC copyin_imp >> gvs[] >> (* now we know that the domain of the copyin consist only of var names not stars*) @@ -6037,7 +5319,7 @@ REPEAT STRIP_TAC >| [ `ZIP ((MAP (λ(e,x,d). d) e_x_d_list), ZIP ((MAP (λ(e,x,d). x) e_x_d_list) , (MAP (λ(e,x,d). e) e_x_d_list)))`, - `scopest ⧺ gscope`, `scope'`])) >> + `scopest ⧺ gscope`, `scope'`, ‘random_oracle’])) >> rfs[] >> rfs[map_distrub] >> @@ -6054,6 +5336,8 @@ REPEAT STRIP_TAC >| [ `t_scope_list_g`, `scope'`, `e_tau_x_d_b_list`, ` (order,f',delta_g,delta_b,delta_x,delta_t)`])) >> gvs[] >> + INST_FST [‘random_oracle’] >> + gs[] >> IMP_RES_TAC wf_arg_imp_lval_consistent_single >> gvs[LENGTH_MAP] >> @@ -6079,7 +5363,7 @@ REPEAT STRIP_TAC >| [ lfs[] >> drule all_func_maps_contains_welltyped_body >> - REPEAT STRIP_TAC >> + rpt strip_tac >> gvs[] >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [ @@ -6093,18 +5377,16 @@ REPEAT STRIP_TAC >| [ gvs[MAP_MAP_txd] >> gvs[MAP_FST_3_2] >> - + gvs[mk_varn_lemma4] >> gvs[map_simp_3] >> subgoal ‘type_scopes_list passed_gscope passed_tslg’ >- IMP_RES_TAC scopes_to_pass_typed_thm >> gvs[] >> - - - rw[map_distrub] >| [ - (* prove that the called function f' t_scope is consistentent with the caller's typying scope *) - gvs[t_scopes_consistent_def] >> REPEAT STRIP_TAC >> + rw[map_distrub] >| [ + (* prove that the called function f' t_scope is consistent with the caller's typing scope *) + gvs[t_scopes_consistent_def] >> rpt strip_tac >> ASSUME_TAC wf_arg_imp_lval_typ_sinlge_list >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘e_x_d_list’, ‘ZIP (MAP (λ(e_,tau_,x_,d_,b_). (tau_)) (e_tau_x_d_b_list : (e # tau # string # d # bool) list) , @@ -6113,6 +5395,7 @@ REPEAT STRIP_TAC >| [ ‘(scopest ⧺ gscope)’, ‘x’])) >> gvs[] >> gvs[map_rw_doub] , + (* prove that the called function f' t_scope with the sig *) gvs[sig_tscope_consistent_def] >> REPEAT GEN_TAC >> STRIP_TAC >> STRIP_TAC >> @@ -6121,7 +5404,6 @@ REPEAT STRIP_TAC >| [ ‘LENGTH (mk_varn (MAP (λ(e_,x_,d_). x_) e_x_d_list)) = LENGTH (e_x_d_list)’ by gvs[mk_varn_LENGTH, LENGTH_MAP] >> gvs[map_distrub, LENGTH_MAP] >> gvs[MAP_MAP_txd] - , @@ -6131,22 +5413,8 @@ REPEAT STRIP_TAC >| [ , - (* IMP_RES_TAC t_scopes_passed_parseError >> - gvs[parseError_in_gs_def] >> - REPEAT STRIP_TAC >> - `i=0` by fs[] >> - rw[] >> - ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:d`` , ``:'b`` |-> ``:tau # lval option``] lookup_map_parse_err_in_xdl) >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [ ‘(MAP (λ(e_,x_,d_). (x_,d_)) (e_x_d_list : (e # string # d) list))’, - ‘ZIP - (MAP (λ(e_,tau_,x_,d_,b_). tau_) (e_tau_x_d_b_list : (e # tau # string # d # bool) list), - MAP (λ(e_,x_,d_). get_lval_of_e e_) (e_x_d_list : (e # string # d) list))’])) >> - gvs[] >> - gvs[MAP_MAP_txd] >> - gvs[MAP_FST_3_2] - , *) - REPEAT STRIP_TAC >> + rpt strip_tac >> rw[] >> gvs[MAP_MAP_txd] >> @@ -6187,12 +5455,13 @@ REPEAT STRIP_TAC >| [ ASSUME_TAC e_resulted_frame_is_WT >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [ - `(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)`, + `(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,oracle_index,random_oracle)`, `gscope`, `scopest`, `(EL i (MAP (λ(e_,tau_,x_,d_,b_). e_) (e_tau_x_d_b_list : (e # tau # string # d # bool) list ) ) )`, `e''`, `f_called`,`stmt_called`,`copied_in_scope`, + ‘i_opt’, `t_scope_list_g`,`t_scope_list`, `order`, `delta_g`,`delta_b`,`delta_x`,`delta_t`, @@ -6200,10 +5469,7 @@ REPEAT STRIP_TAC >| [ `(EL i (MAP (λ(e_,tau_,x_,d_,b_). b_) (e_tau_x_d_b_list : (e # tau # string # d # bool) list ) ))`, `t_tau (EL i (MAP (λ(e_,tau_,x_,d_,b_). tau_) (e_tau_x_d_b_list : (e # tau # string # d # bool) list ) ))` ])) >> - gvs[] >> - srw_tac [SatisfySimps.SATISFY_ss][e_resulted_frame_is_WT] - - + gvs[] ] ] @@ -6213,9 +5479,9 @@ REPEAT STRIP_TAC >| [ (* select *) (****************) -REPEAT STRIP_TAC >> +rpt strip_tac >> SIMP_TAC list_ss [sr_exp_def] >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ OPEN_EXP_RED_TAC ``(e_select e l s)`` >> REV_FULL_SIMP_TAC (srw_ss()) [] >> fs[] >| [ @@ -6269,11 +5535,11 @@ REPEAT STRIP_TAC >| [ gvs[] >> Q.PAT_X_ASSUM `sr_exp e ty` ((STRIP_ASSUME_TAC o (Q.SPECL - [`e'''`,`gscope`,`scopest`,`framel`,`t_scope_list`,`t_scope_list_g`,`t_tau (tau_xtl struct_ty x'_tau_list)`, + [`e'''`,`gscope`,`scopest`,`framel`,‘i_opt’,`t_scope_list`,`t_scope_list_g`,`t_tau (tau_xtl struct_ty x'_tau_list)`, `b'`,`order`,`delta_g`,`delta_b`,`delta_t`,`delta_x`,`f` ])) o SIMP_RULE (srw_ss()) [sr_exp_def]) >> gvs[] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`f`,`stmt`,`s'`,‘Prs_n’,`apply_table_f`, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) >> + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`f`,`stmt`,`s'`,‘Prs_n’,`apply_table_f`, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’, ‘oracle_index’, ‘random_oracle’])) >> fs[clause_name_def] >> gvs[] >> qexists_tac `s_list_x_s_t_list_list` >> qexists_tac `x'_tau_list` >> @@ -6296,9 +5562,9 @@ REPEAT STRIP_TAC >| [ (* struct *) (****************) -REPEAT STRIP_TAC >> +rpt strip_tac >> SIMP_TAC (srw_ss()) [sr_exp_def] >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ (*e type *) @@ -6337,12 +5603,13 @@ REPEAT STRIP_TAC >| [ `gscope`, `scopest`, `framel`, + ‘i_opt’, `t_scope_list`, `t_scope_list_g`, `t_tau (EL i (MAP (λ(f_,e_,tau_,b_). tau_) (f_e_tau_b_list: (string # e # tau # bool) list ) ))`, `(EL i (MAP (λ(f_,e_,tau_,b_). b_) (f_e_tau_b_list: (string # e # tau # bool) list) ))`, `order`, `delta_g`, `delta_b`, `delta_t`, `delta_x`, - `f`, `f_called` , `stmt_called`, `copied_in_scope` ,‘Prs_n’,‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) o + `f`, `f_called` , `stmt_called`, `copied_in_scope` ,‘Prs_n’,‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’, ‘oracle_index’, ‘random_oracle’])) o SIMP_RULE (srw_ss()) [sr_exp_def]) >> gvs[] >> @@ -6442,25 +5709,7 @@ REPEAT STRIP_TAC >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`i`])) >> - ASSUME_TAC e_resulted_frame_is_WT >> - - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)`, `gscope`, `scopest`, - `(EL i (MAP (λ(f_,e_,tau_,b_). e_) (f_e_tau_b_list : (string # e # tau # bool) list)))`, - `e''`, `f_called` , `stmt_called`, `copied_in_scope`, - ` t_scope_list_g`, `t_scope_list`, - `order`, - `delta_g`, - `delta_b`, - `delta_x`, - `delta_t`, `f`, `ty`, - `(EL i (MAP (λ(f_,e_,tau_,b_). b_) (f_e_tau_b_list : (string # e # tau # bool) list)))`, - `(t_tau (EL i (MAP (λ(f_,e_,tau_,b_). tau_) (f_e_tau_b_list : (string # e # tau # bool) list))))`, - ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’, ‘Prs_n’])) >> - - gvs[] >> - + irule e_resulted_frame_is_WT >> subgoal `(EL i (MAP (λ(f_,e_,e'_). e_) f_e_e'_list)) = (EL i (MAP (λ(f_,e_,tau_,b_). e_) f_e_tau_b_list))` >- (ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:string``, @@ -6472,8 +5721,8 @@ REPEAT STRIP_TAC >| [ [`f_e_e'_list`, `f_e_tau_b_list `])) >> fs[ELIM_UNCURRY] >> gvs[] ) >> - - fsrw_tac [] [] + fsrw_tac [] [] >> + metis_tac[] ] , @@ -6486,9 +5735,9 @@ REPEAT STRIP_TAC >| [ -REPEAT STRIP_TAC >> +rpt strip_tac >> SIMP_TAC (srw_ss()) [sr_exp_def] >> -REPEAT STRIP_TAC >| [ +rpt strip_tac >| [ (*e type *) @@ -6527,12 +5776,13 @@ REPEAT STRIP_TAC >| [ `gscope`, `scopest`, `framel`, + ‘i_opt’, `t_scope_list`, `t_scope_list_g`, `t_tau (EL i (MAP (λ(f_,e_,tau_,b_). tau_) (f_e_tau_b_list: (string # e # tau # bool) list ) ))`, `(EL i (MAP (λ(f_,e_,tau_,b_). b_) (f_e_tau_b_list: (string # e # tau # bool) list) ))`, `order`, `delta_g`, `delta_b`, `delta_t`, `delta_x`, - `f`, `f_called` , `stmt_called`, `copied_in_scope`, ‘Prs_n’,‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) o + `f`, `f_called` , `stmt_called`, `copied_in_scope`, ‘Prs_n’,‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’, ‘oracle_index’, ‘random_oracle’])) o SIMP_RULE (srw_ss()) [sr_exp_def]) >> gvs[] >> @@ -6632,25 +5882,8 @@ REPEAT STRIP_TAC >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`i`])) >> - ASSUME_TAC e_resulted_frame_is_WT >> - - - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)`, `gscope`, `scopest`, - `(EL i (MAP (λ(f_,e_,tau_,b_). e_) (f_e_tau_b_list : (string # e # tau # bool) list)))`, - `e''`, `f_called` , `stmt_called`, `copied_in_scope`, - ` t_scope_list_g`, `t_scope_list`, - `order`, - `delta_g`, - `delta_b`, - `delta_x`, - `delta_t`, `f`, `ty`, - `(EL i (MAP (λ(f_,e_,tau_,b_). b_) (f_e_tau_b_list : (string # e # tau # bool) list)))`, - `(t_tau (EL i (MAP (λ(f_,e_,tau_,b_). tau_) (f_e_tau_b_list : (string # e # tau # bool) list))))`, - ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’, ‘Prs_n’])) >> - - gvs[] >> - + irule e_resulted_frame_is_WT >> + gs[] >> subgoal `(EL i (MAP (λ(f_,e_,e'_). e_) f_e_e'_list)) = (EL i (MAP (λ(f_,e_,tau_,b_). e_) f_e_tau_b_list))` >- (ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:string``, @@ -6662,8 +5895,8 @@ REPEAT STRIP_TAC >| [ [`f_e_e'_list`, `f_e_tau_b_list `])) >> fs[ELIM_UNCURRY] >> gvs[] ) >> - - fsrw_tac [] [] + fsrw_tac [] [] >> + metis_tac[] ] @@ -6683,7 +5916,7 @@ fsrw_tac [] [sr_strexp_list_def] (**********************) fsrw_tac [] [sr_strexp_list_def, sr_strexp_tup_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> PairCases_on `tup` >> fs[] , @@ -6709,7 +5942,7 @@ fsrw_tac [] [sr_exp_list_def] (**********************) fsrw_tac [] [sr_exp_list_def] >> -REPEAT STRIP_TAC >> +rpt strip_tac >> fs[] ] QED diff --git a/hol/p4_exec_sem_arch_soundnessScript.sml b/hol/metatheory/p4_exec_sem_arch_soundnessScript.sml similarity index 70% rename from hol/p4_exec_sem_arch_soundnessScript.sml rename to hol/metatheory/p4_exec_sem_arch_soundnessScript.sml index 947dd2c1..955d7345 100644 --- a/hol/p4_exec_sem_arch_soundnessScript.sml +++ b/hol/metatheory/p4_exec_sem_arch_soundnessScript.sml @@ -18,246 +18,236 @@ Theorem arch_exec_sound_red: !arch_frame_list type. arch_exec_sound arch_frame_list type Proof Cases_on `arch_frame_list` >> ( - fs [arch_exec_sound] >> + fs[arch_exec_sound] >> Cases_on `status` >> ( - fs [arch_exec_def] + fs[arch_exec_def] ) ) >> ( rpt strip_tac >> PairCases_on `actx` >> - rename1 `(ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map)` >> + rename1 `(ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map, get_oracle_index, set_oracle_index, random_oracle)` >> PairCases_on `aenv` >> rename1 `(aenv0, in_out_list, in_out_list', ascope)` >> rename1 `(i, in_out_list, in_out_list', ascope)` ) >| [ Cases_on `EL i ab_list` >| [ (* input *) - fs [arch_exec_def] >> + fs[arch_exec_def] >> Cases_on `input_f (in_out_list,ascope)` >> ( - fs [] + fs[] ) >> PairCases_on `x` >> - fs [] >> + fs[] >> rw [] >> metis_tac [(valOf o find_clause_arch_red) "arch_in", clause_name_def], (* programmable block initialisation *) - fs [arch_exec_def] >> + fs[arch_exec_def] >> Cases_on `ALOOKUP pblock_map s` >> ( - fs [] + fs[] ) >> PairCases_on `x` >> - fs [] >> + fs[] >> rename1 `(x0, x_d_l, b_func_map, t_scope, pars_map, tbl_map)` >> rename1 `(p, x_d_l, b_func_map, t_scope, pars_map, tbl_map)` >> Cases_on `lookup_block_body s b_func_map` >> ( - fs [] + fs[] ) >> rename1 `lookup_block_body s b_func_map = SOME stmt` >> - fs [] >> - Cases_on `copyin_pbl (MAP FST x_d_l,MAP SND x_d_l,l,ascope)` >> ( - fs [] + fs[] >> + Cases_on `copyin_pbl (MAP FST x_d_l,MAP SND x_d_l,l,ascope,random_oracle)` >> ( + fs[] ) >> + PairCases_on ‘x’ >> + gs[] >> Cases_on `oLASTN 1 g_scope_list` >> ( - fs [] + fs[] ) >> - Cases_on `x'` >> ( - fs [] + Cases_on `x` >> ( + fs[] ) >> Cases_on `t` >> ( - fs [] + fs[] ) >> - Cases_on `initialise_var_stars func_map b_func_map ext_map [declare_list_in_scope (t_scope,x); h]` >> ( - fs [] + Cases_on `declare_list_in_scope + (t_scope,x0,x1,get_oracle_index ascope,random_oracle)` >> ( + fs[] + ) >> + Cases_on `initialise_var_stars func_map b_func_map ext_map [q; h]` >> ( + fs[] ) >> rw [] >> irule ((valOf o find_clause_arch_red) "arch_pbl_init") >> - fs [clause_name_def] >> - qexistsl_tac [`ZIP (l, ZIP(MAP FST x_d_l, MAP SND x_d_l))`, `x`] >> - fs [] >> + fs[clause_name_def] >> + qexistsl_tac [`ZIP (l, ZIP(MAP FST x_d_l, MAP SND x_d_l))`, ‘x1’, `x0`, ‘q’] >> + fs[] >> rpt strip_tac >| [ - fs [map_tri_zip12], - gs [listTheory.oEL_EQ_EL] >> metis_tac [oLASTN_imp_LASTN], + + fs[map_tri_zip12], - fs [map_tri_zip12, ZIP_MAP_FST_SND], + fs[map_tri_zip12, ZIP_MAP_FST_SND], - fs [map_tri_zip12, ZIP_MAP_FST_SND] + fs[map_tri_zip12, ZIP_MAP_FST_SND] ], (* fixed-function block *) - fs [arch_exec_def] >> + fs[arch_exec_def] >> Cases_on `ALOOKUP ffblock_map s` >> ( - fs [] + fs[] ) >> Cases_on `x` >> - fs [] >> + fs[] >> Cases_on `f ascope` >> ( - fs [] + fs[] ) >> rw [] >> metis_tac [(valOf o find_clause_arch_red) "arch_ffbl", clause_name_def], (* output *) - fs [arch_exec_def] >> + fs[arch_exec_def] >> Cases_on `output_f (in_out_list',ascope)` >> ( - fs [] + fs[] ) >> PairCases_on `x` >> - fs [] >> + fs[] >> rw [] >> metis_tac [(valOf o find_clause_arch_red) "arch_out", clause_name_def] ], - fs [arch_exec_def], + fs[arch_exec_def], - fs [arch_exec_def], + fs[arch_exec_def], Cases_on `state_fin status_running l` >| [ (* programmable block return *) - fs [state_fin_def] >> + fs[state_fin_def] >> rw [] >> - fs [arch_exec_def] >> + fs[arch_exec_def] >> Cases_on `EL i ab_list` >> ( - fs [] + fs[] ) >> Cases_on `ALOOKUP pblock_map s` >> ( - fs [] + fs[] ) >> PairCases_on `x` >> - fs [state_fin_exec_def] >> + fs[state_fin_exec_def] >> Cases_on `lookup_block_body s x2` >> ( - fs [] + fs[] ) >> rename1 `lookup_block_body s b_func_map = SOME stmt` >> - fs [] >> + fs[] >> Cases_on `copyout_pbl (g_scope_list,ascope,MAP SND x1,MAP FST x1, set_fin_status x0 status_running)` >> ( - fs [] + fs[] ) >> rw [] >> irule ((valOf o find_clause_arch_red) "arch_pbl_ret") >> - fs [clause_name_def, state_fin_def] >> + fs[clause_name_def, state_fin_def] >> qexists_tac `ZIP (l, ZIP (MAP FST x1, MAP SND x1))` >> rpt strip_tac >| [ - fs [map_tri_zip12], + fs[map_tri_zip12], - fs [map_tri_zip12, ZIP_MAP_FST_SND], + fs[map_tri_zip12, ZIP_MAP_FST_SND], - fs [map_tri_zip12, ZIP_MAP_FST_SND] + fs[map_tri_zip12, ZIP_MAP_FST_SND] ], (* programmable block execution *) - fs [GSYM state_fin_exec_equiv, arch_exec_def] >> + fs[GSYM state_fin_exec_equiv, arch_exec_def] >> Cases_on `EL i ab_list` >> ( - fs [] + fs[] ) >> Cases_on `ALOOKUP pblock_map s` >> ( - fs [] + fs[] ) >> PairCases_on `x` >> - fs [state_fin_exec_equiv, state_fin_def] >> - Cases_on `frames_exec (apply_table_f,ext_map,func_map,x2,x4,x5) + fs[state_fin_exec_equiv, state_fin_def] >> + Cases_on `frames_exec (apply_table_f,ext_map,func_map,x2,x4,x5,get_oracle_index, + set_oracle_index,random_oracle) (ascope,g_scope_list,l,status_running)` >> ( - fs [] + fs[] ) >> PairCases_on `x` >> - fs [] >> + fs[] >> rw [] >> irule ((valOf o find_clause_arch_red) "arch_pbl_exec") >> - fs [clause_name_def] >> -(* - qexists_tac `ZIP (l', x1)` >> - rpt strip_tac >| [ - fs [map_tri_zip12], - - fs [map_tri_zip12], -*) - assume_tac frame_list_exec_sound_red >> - fs [frame_list_exec_sound] -(* - ] -*) + fs[clause_name_def] >> + assume_tac frame_list_exec_sound_red >> + fs[frame_list_exec_sound] ], (* programmable block return *) subgoal `state_fin (status_returnv v) l` >- ( - fs [state_fin_def] + fs[state_fin_def] ) >> - fs [arch_exec_def] >> + fs[arch_exec_def] >> Cases_on `EL i ab_list` >> ( - fs [] + fs[] ) >> Cases_on `ALOOKUP pblock_map s` >> ( - fs [] + fs[] ) >> PairCases_on `x` >> - fs [] >> + fs[] >> Cases_on `lookup_block_body s x2` >> ( - fs [] + fs[] ) >> rename1 `lookup_block_body s b_func_map = SOME stmt` >> - fs [] >> + fs[] >> Cases_on `copyout_pbl (g_scope_list, ascope, MAP SND x1, MAP FST x1, set_fin_status x0 (status_returnv v))` >> ( - fs [] + fs[] ) >> rw [] >> irule ((valOf o find_clause_arch_red) "arch_pbl_ret") >> - fs [clause_name_def] >> + fs[clause_name_def] >> qexists_tac `ZIP (l', x1)` >> - fs [map_tri_zip12], + fs[map_tri_zip12], (* programmable block transition *) - fs [arch_exec_def] >> + fs[arch_exec_def] >> Cases_on `EL i ab_list` >> ( - fs [] + fs[] ) >> Cases_on `ALOOKUP pblock_map s'` >> ( - fs [] + fs[] ) >> PairCases_on `x` >> - fs [state_fin_exec_equiv] >> + fs[state_fin_exec_equiv] >> Cases_on `state_fin (status_trans s) l` >> ( - fs [] + fs[] ) >| [ (* programmable block return *) Cases_on `lookup_block_body s' x2` >> ( - fs [] + fs[] ) >> rename1 `lookup_block_body s' b_func_map = SOME stmt` >> - fs [] >> + fs[] >> Cases_on `copyout_pbl (g_scope_list,ascope,MAP SND x1,MAP FST x1, set_fin_status x0 (status_trans s))` >> ( - fs [] + fs[] ) >> rw [] >> irule ((valOf o find_clause_arch_red) "arch_pbl_ret") >> - fs [clause_name_def] >> + fs[clause_name_def] >> qexists_tac `ZIP (l', x1)` >> - fs [map_tri_zip12], + fs[map_tri_zip12], (* parser transition *) Cases_on `x0` >> ( - fs [] + fs[] ) >> Cases_on `ALOOKUP x4 s` >> ( - fs [] + fs[] ) >> rw [] >> irule ((valOf o find_clause_arch_red) "arch_parser_trans") >> - fs [clause_name_def, state_fin_def] (* >> - qexists_tac `ZIP (l', x1)` >> - rpt strip_tac >| [ - fs [map_tri_zip12], - - fs [map_tri_zip12] - ] -*) + fs[clause_name_def, state_fin_def] ] ] QED diff --git a/hol/p4_exec_sem_e_soundnessScript.sml b/hol/metatheory/p4_exec_sem_e_soundnessScript.sml similarity index 84% rename from hol/p4_exec_sem_e_soundnessScript.sml rename to hol/metatheory/p4_exec_sem_e_soundnessScript.sml index 5b6dc44a..970b468b 100644 --- a/hol/p4_exec_sem_e_soundnessScript.sml +++ b/hol/metatheory/p4_exec_sem_e_soundnessScript.sml @@ -7,7 +7,7 @@ open ottTheory listTheory rich_listTheory arithmeticTheory p4_auxTheory p4Theory Definition e_exec_sound: (e_exec_sound (type:('a itself)) e = - !(ctx:'a ctx) g_scope_list scopes_stack e' frame_list. + !(ctx:'a ectx) g_scope_list scopes_stack e' frame_list. e_exec ctx g_scope_list scopes_stack e = SOME (e', frame_list) ==> e_red ctx g_scope_list scopes_stack e e' frame_list) End @@ -62,33 +62,33 @@ Proof rpt strip_tac >> EQ_TAC >| [ Induct_on `l` >> ( - fs [l_sound, l_sound_exec] + fs[l_sound, l_sound_exec] ) >> rpt strip_tac >| [ - PAT_X_ASSUM ``!x e. _`` (fn thm => ASSUME_TAC (SPEC ``0:num`` thm)) >> - fs [oEL_def], + qpat_x_assum `!x e. _` (fn thm => ASSUME_TAC (Q.SPEC `0:num` thm)) >> + fs[oEL_def], `l_sound type (h::l)` suffices_by ( - METIS_TAC [l_sound_cons] + metis_tac[l_sound_cons] ) >> - METIS_TAC [l_sound] + metis_tac[l_sound] ], Induct_on `l` >> ( - fs [l_sound, l_sound_exec] + fs[l_sound, l_sound_exec] ) >> NTAC 3 strip_tac >> Induct_on `x` >> ( - fs [oEL_def] + fs[oEL_def] ) >> `!x e. SOME e = oEL x l ==> e_exec_sound type e` suffices_by ( - METIS_TAC [oEL_cons_PRE] + metis_tac[oEL_cons_PRE] ) >> - fs [] >> + fs[] >> Cases_on `l` >- ( - fs [oEL_def] + fs[oEL_def] ) >> - METIS_TAC [l_sound] + metis_tac[l_sound] ] QED @@ -134,46 +134,42 @@ Cases_on `is_v_bit e1` >> Cases_on `is_v_bit e2` >> ( Cases_on `x` >> ( fs [] ) >> - rw [] >> + rw[] >> irule ((valOf o find_clause_e_red) "e_concat_v") >> fs [clause_name_def], Cases_on `e_exec ctx g_scope_list scopes_stack e2` >> ( fs [e_exec_def] ) >> - Cases_on `x` >> ( - fs [] - ) >> + PairCases_on ‘x’ >> + gvs[] >> Cases_on `e1` >> ( fs [is_v_bit_def] ) >> Cases_on `v` >> ( fs [is_v_bit_def] ) >> - METIS_TAC [((valOf o find_clause_e_red) "e_concat_arg2"), clause_name_def], + metis_tac[((valOf o find_clause_e_red) "e_concat_arg2"), clause_name_def], Cases_on `e_exec ctx g_scope_list scopes_stack e1` >> ( fs [e_exec_def] ) >> - Cases_on `x` >> ( - fs [] - ) >> + PairCases_on ‘x’ >> + gvs[] >> Cases_on `e2` >> ( fs [is_v_bit_def] ) >> Cases_on `v` >> ( fs [is_v_bit_def] ) >> - METIS_TAC [((valOf o find_clause_e_red) "e_concat_arg1"), clause_name_def], - + metis_tac[((valOf o find_clause_e_red) "e_concat_arg1"), clause_name_def], Cases_on `e_exec ctx g_scope_list scopes_stack e1` >> ( fs [e_exec_def] ) >> - Cases_on `x` >> ( - fs [] - ) >> - METIS_TAC [((valOf o find_clause_e_red) "e_concat_arg1"), clause_name_def] + PairCases_on ‘x’ >> + gvs[] >> + metis_tac[((valOf o find_clause_e_red) "e_concat_arg1"), clause_name_def] ] QED @@ -206,16 +202,15 @@ Cases_on `is_v_bit e1` >> ( Cases_on `e_exec ctx g_scope_list scopes_stack e1` >> ( fs [e_exec_def] ) >> - Cases_on `x` >> ( - fs [] - ) >> + PairCases_on ‘x’ >> + gvs[] >> Cases_on `e2` >> Cases_on `e3` >> ( fs [is_v_bit_def] ) >> Cases_on `v` >> Cases_on `v'` >> ( fs [is_v_bit_def] ) >> - METIS_TAC [((valOf o find_clause_e_red) "e_slice_arg1"), clause_name_def] + metis_tac[((valOf o find_clause_e_red) "e_slice_arg1"), clause_name_def] ] QED @@ -224,11 +219,11 @@ Theorem e_acc_exec_sound_red: e_exec_sound type e ==> e_exec_sound type (e_acc e x) Proof -fs [e_exec_sound] >> +fs[e_exec_sound] >> rpt strip_tac >> -fs [e_exec_def] >> +fs[e_exec_def] >> Cases_on `is_v e` >> ( - fs [] + fs[] ) >| [ Cases_on `e_exec_acc (e_acc e x)` >> ( fs [] @@ -260,9 +255,8 @@ Cases_on `is_v e` >> ( Cases_on `e_exec ctx g_scope_list scopes_stack e` >- ( fs [] ) >> - Cases_on `x'` >> - fs [] >> - rw [] >> + PairCases_on ‘x'’ >> + gvs[] >> irule ((valOf o find_clause_e_red) "e_acc_arg1") >> fs [clause_name_def] ] @@ -274,7 +268,7 @@ e_exec_sound type e1 ==> e_exec_sound type e2 ==> e_exec_sound type (e_binop e1 b e2) Proof -fs [e_exec_sound] >> +fs[e_exec_sound] >> rpt strip_tac >> Cases_on `is_v e1` >> Cases_on `is_v e2` >| [ (* Both operands are fully reduced *) @@ -424,7 +418,7 @@ Cases_on `is_v e1` >> Cases_on `is_v e2` >| [ irule ((valOf o find_clause_e_red) "e_or") ] >> ( - fs [clause_name_def] + fs[clause_name_def] ), (* Second operand is not fully reduced *) @@ -457,10 +451,9 @@ Cases_on `is_v e1` >> Cases_on `is_v e2` >| [ Cases_on `e_exec ctx g_scope_list scopes_stack e2` >> ( fs [e_exec_def] ) >> - Cases_on `x` >> ( - fs [is_v_def] - ) >> - METIS_TAC [((valOf o find_clause_e_red) "e_binop_arg2"), clause_name_def], + PairCases_on ‘x’ >> + gvs[] >> + metis_tac[((valOf o find_clause_e_red) "e_binop_arg2"), clause_name_def], (* First operand is not fully reduced *) Cases_on `e_exec ctx g_scope_list scopes_stack e1` >> ( @@ -469,22 +462,22 @@ Cases_on `is_v e1` >> Cases_on `is_v e2` >| [ Cases_on `e1` >> ( fs [is_v_def] ) >> ( - Cases_on `x` >> - fs [] >> - METIS_TAC [((valOf o find_clause_e_red) "e_binop_arg1"), clause_name_def] + PairCases_on ‘x’ >> + gvs[] >> + metis_tac[((valOf o find_clause_e_red) "e_binop_arg1"), clause_name_def] ) ), (* No operand is fully reduced *) Cases_on `e_exec ctx g_scope_list scopes_stack e1` >> ( - fs [e_exec_def] + fs[e_exec_def] ) >> ( Cases_on `e1` >> ( - fs [is_v_def] + fs[is_v_def] ) >> ( - Cases_on `x` >> - fs [] >> - METIS_TAC [((valOf o find_clause_e_red) "e_binop_arg1"), clause_name_def] + PairCases_on ‘x’ >> + gvs[] >> + metis_tac[((valOf o find_clause_e_red) "e_binop_arg1"), clause_name_def] ) ) ] @@ -546,9 +539,9 @@ Cases_on `is_v e` >| [ Cases_on `e_exec ctx g_scope_list scopes_stack e` >> ( fs [e_exec_def] ) >> - Cases_on `x` >> - fs [] >> - METIS_TAC [(valOf o find_clause_e_red) "e_unop_arg", clause_name_def] + PairCases_on ‘x’ >> + gvs[] >> + metis_tac[(valOf o find_clause_e_red) "e_unop_arg", clause_name_def] ] QED @@ -557,7 +550,7 @@ Theorem e_cast_exec_sound_red: e_exec_sound type e ==> e_exec_sound type (e_cast c e) Proof -fs [e_exec_sound] >> +fs[e_exec_sound] >> rpt strip_tac >> Cases_on `is_v e` >| [ Cases_on `e_exec_cast c e` >> ( @@ -585,11 +578,11 @@ Cases_on `is_v e` >| [ ], Cases_on `e_exec ctx g_scope_list scopes_stack e` >> ( - fs [e_exec_def] + fs[e_exec_def] ) >> - Cases_on `x` >> - fs [] >> - METIS_TAC [(valOf o find_clause_e_red) "e_cast_arg", clause_name_def] + PairCases_on ‘x’ >> + gvs[] >> + metis_tac[(valOf o find_clause_e_red) "e_cast_arg", clause_name_def] ] QED @@ -598,54 +591,54 @@ Theorem e_call_exec_sound_red: l_sound type l ==> e_exec_sound type (e_call f l) Proof -fs [e_exec_sound] >> +fs[e_exec_sound] >> rpt strip_tac >> PairCases_on `ctx` >> -rename1 `(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)` >> -fs [e_exec_def] >> +rename1 `(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,oracle_index,random_oracle)` >> +fs[e_exec_def] >> Cases_on `lookup_funn_sig_body f func_map b_func_map ext_map` >> ( - fs [] -) >> -Cases_on `x` >> ( - fs [] + fs[] ) >> -Cases_on `unred_arg_index (MAP SND r) l` >> ( - fs [] +PairCases_on ‘x’ >> +gvs[] >> +Cases_on `unred_arg_index (MAP SND x1) l` >> ( + fs[] ) >| [ (* e_call_newframe *) - Cases_on `copyin (MAP FST r) (MAP SND r) l g_scope_list scopes_stack` >> ( - fs [] + Cases_on `copyin (MAP FST x1) (MAP SND x1) l g_scope_list scopes_stack oracle_index random_oracle` >> ( + fs[] ) >> + PairCases_on ‘x’ >> + gvs[] >> IMP_RES_TAC map_tri_zip12 >> - METIS_TAC [ISPEC ``ZIP (l,r):(e # string # d) list`` ((valOf o find_clause_e_red) "e_call_newframe"), unred_arg_index_NONE, + metis_tac[ISPEC ``ZIP (l,r):(e # string # d) list`` ((valOf o find_clause_e_red) "e_call_newframe"), unred_arg_index_NONE, clause_name_def], (* e_call_args *) - Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) g_scope_list scopes_stack (EL x l)` >> ( + Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,oracle_index,random_oracle) g_scope_list scopes_stack (EL x l)` >> ( fs [] ) >> - Cases_on `x'` >> - fs [] >> - rw [] >> - Q.SUBGOAL_THEN `((MAP (\(a_,b_,c_,d_). a_) (ZIP (l,ZIP (LUPDATE q' x l,r))) = l) /\ - (MAP (\(a_,b_,c_,d_). b_) (ZIP (l,ZIP (LUPDATE q' x l,r))) = LUPDATE q' x l) /\ - (MAP (\(a_,b_,c_,d_). c_) (ZIP (l,ZIP (LUPDATE q' x l,r))) = MAP FST r) /\ - (MAP (\(a_,b_,c_,d_). d_) (ZIP (l,ZIP (LUPDATE q' x l,r))) = MAP SND r) /\ - (MAP (\(a_,b_,c_,d_). (c_,d_)) (ZIP (l,ZIP (LUPDATE q' x l,r))) = r))` ( - fn thm => (irule (SIMP_RULE std_ss [thm] (ISPEC ``ZIP (l:e list, ZIP ((LUPDATE q' x l), r:(string # d) list))`` - ((valOf o find_clause_e_red) "e_call_args")))) + PairCases_on ‘x'’ >> + gvs[] >> + Q.SUBGOAL_THEN `((MAP (\(a_,b_,c_,d_). a_) (ZIP (l,ZIP (LUPDATE x'0 x l,x1))) = l) /\ + (MAP (\(a_,b_,c_,d_). b_) (ZIP (l,ZIP (LUPDATE x'0 x l,x1))) = LUPDATE x'0 x l) /\ + (MAP (\(a_,b_,c_,d_). c_) (ZIP (l,ZIP (LUPDATE x'0 x l,x1))) = MAP FST x1) /\ + (MAP (\(a_,b_,c_,d_). d_) (ZIP (l,ZIP (LUPDATE x'0 x l,x1))) = MAP SND x1) /\ + (MAP (\(a_,b_,c_,d_). (c_,d_)) (ZIP (l,ZIP (LUPDATE x'0 x l,x1))) = x1))` ( + fn thm => (irule (SIMP_RULE (srw_ss()) [thm] (ISPEC ``ZIP (l:e list, ZIP ((LUPDATE x'0 x l), x1:(string # d) list))`` + ((valOf o find_clause_e_red) "e_call_args")) )) ) >- ( - subgoal `LENGTH l = LENGTH (ZIP (LUPDATE q' x l,r))` >- ( - fs [LENGTH_ZIP] + subgoal `LENGTH l = LENGTH (ZIP (LUPDATE x'0 x l,x1))` >- ( + fs[LENGTH_ZIP] ) >> - subgoal `LENGTH (LUPDATE q' x l) = LENGTH r` >- ( - fs [] + subgoal `LENGTH (LUPDATE x'0 x l) = LENGTH x1` >- ( + fs[] ) >> - fs [map_quad_zip112] + fs[map_quad_zip112] ) >> - fs [clause_name_def] >> + fs[clause_name_def] >> rpt strip_tac >| [ - fs [lookup_funn_sig_def], + fs[lookup_funn_sig_def], Cases_on `l` >> ( fs [unred_arg_index_empty] @@ -743,8 +736,8 @@ Theorem e_exec_sound_red: !type e. e_exec_sound type e Proof strip_tac >> -`(!e. e_exec_sound type e) /\ (!l. x_e_l_exec_sound type l) /\ (!p. x_e_exec_sound type p) /\ (!l. l_sound type l)` suffices_by ( - fs [] +‘(!e. e_exec_sound type e) /\ (!l. x_e_l_exec_sound type l) /\ (!p. x_e_exec_sound type p) /\ (!l. l_sound type l)’ suffices_by ( + fs[] ) >> irule e_induction >> rpt strip_tac >| [ @@ -794,28 +787,28 @@ rpt strip_tac >| [ fs [e_exec_sound, e_exec_def], (* x_e list: inductive case *) - Cases_on `p` >> - fs [x_e_l_exec_sound, l_sound, x_e_exec_sound] >> + Cases_on ‘p’ >> + fs[x_e_l_exec_sound, l_sound, x_e_exec_sound] >> rpt strip_tac >> - Cases_on `x` >> ( - fs [oEL_def] + Cases_on ‘x’ >> ( + fs[oEL_def] ) >> - subgoal `MEM e (MAP SND l)` >- ( + subgoal ‘MEM e (MAP SND l)’ >- ( fs [oEL_EQ_EL, EL_MEM] ) >> - metis_tac [l_sound_MEM], + metis_tac[l_sound_MEM], (* Constant value: Irreducible *) - fs [e_exec_sound, e_exec_def], + fs[e_exec_sound, e_exec_def], (* Variable lookup *) - fs [e_exec_sound, e_exec_def] >> + fs[e_exec_sound, e_exec_def] >> rpt strip_tac >> Cases_on `lookup_vexp2 scopes_stack g_scope_list v` >> ( - fs [] + fs[] ) >> - rw [] >> - METIS_TAC [(valOf o find_clause_e_red) "e_lookup", clause_name_def] + rw[] >> + metis_tac[(valOf o find_clause_e_red) "e_lookup", clause_name_def] ] QED diff --git a/hol/p4_exec_sem_frames_soundnessScript.sml b/hol/metatheory/p4_exec_sem_frames_soundnessScript.sml similarity index 66% rename from hol/p4_exec_sem_frames_soundnessScript.sml rename to hol/metatheory/p4_exec_sem_frames_soundnessScript.sml index 423b7207..aa583de2 100644 --- a/hol/p4_exec_sem_frames_soundnessScript.sml +++ b/hol/metatheory/p4_exec_sem_frames_soundnessScript.sml @@ -12,144 +12,145 @@ Definition frame_list_exec_sound: frames_red ctx (ascope, g_scope_list, frame_list, status) state') End - Theorem frame_list_exec_sound_red: !type frame_list. frame_list_exec_sound type frame_list Proof Induct_on `frame_list` >> ( - fs [frame_list_exec_sound] >> + fs[frame_list_exec_sound] >> Cases_on `status` >> ( - fs [frames_exec_def] + fs[frames_exec_def] ) ) >> rpt strip_tac >> pairLib.PairCases_on `ctx` >> -rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> +rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)` >> Cases_on `frame_list` >| [ (* Single frame (comp1) *) pairLib.PairCases_on `h` >> - fs [frames_exec_def] >> + fs[frames_exec_def] >> Cases_on `scopes_to_pass h0 func_map b_func_map g_scope_list` >> ( - fs [] + fs[] ) >> Cases_on `map_to_pass h0 b_func_map` >> ( - fs [] + fs[] ) >> Cases_on `tbl_to_pass h0 b_func_map tbl_map` >> ( - fs [] + fs[] ) >> - Cases_on `stmt_exec (apply_table_f,ext_map,func_map,x',pars_map,x'') + Cases_on `stmt_exec (apply_table_f,ext_map,func_map,x',pars_map,x'', + get_oracle_index,set_oracle_index,random_oracle) (ascope,x,[(h0,h1,h2)],status_running)` >- ( - fs [] + fs[] ) >> pairLib.PairCases_on `x'''` >> - fs [] >> + fs[] >> Cases_on `scopes_to_retrieve h0 func_map b_func_map g_scope_list x'''1` >> ( - fs [] + fs[] ) >> rw [] >> rename1 `(ascope', x'''1, frame_list', status')` >> assume_tac stmt_stack_exec_sound_red >> - fs [stmt_stack_exec_sound] >> + fs[stmt_stack_exec_sound] >> RES_TAC >> - irule (SIMP_RULE list_ss [] (Q.SPECL [`apply_table_f`, `ext_map`, `func_map`, `b_func_map`, `pars_map`, `tbl_map`, `ascope`, `g_scope_list`, `h0`, `h1`, `h2`, `[]`] ((valOf o find_clause_frames_red) "frames_comp1"))) >> - fs [clause_name_def] >> + irule (SIMP_RULE list_ss [] (Q.SPECL [`apply_table_f`, `ext_map`, `func_map`, `b_func_map`, `pars_map`, `tbl_map`, ‘get_oracle_index’, ‘set_oracle_index’, ‘random_oracle’, `ascope`, `g_scope_list`, `h0`, `h1`, `h2`, `[]`] ((valOf o find_clause_frames_red) "frames_comp1"))) >> + fs[clause_name_def] >> qexists_tac `x'''1` >> - fs [], + fs[], (* Multiple frames *) pairLib.PairCases_on `h` >> pairLib.PairCases_on `h'` >> - fs [frames_exec_def] >> + fs[frames_exec_def] >> Cases_on `scopes_to_pass h0 func_map b_func_map g_scope_list` >> ( - fs [] + fs[] ) >> Cases_on `map_to_pass h0 b_func_map` >> ( - fs [] + fs[] ) >> Cases_on `tbl_to_pass h0 b_func_map tbl_map` >> ( - fs [] + fs[] ) >> rename1 `(ascope,g_scope_list',[(h0,h1,h2)],status_running)` >> - Cases_on `stmt_exec (apply_table_f,ext_map,func_map,x',pars_map,x'') + Cases_on `stmt_exec (apply_table_f,ext_map,func_map,x',pars_map,x'', + get_oracle_index,set_oracle_index,random_oracle) (ascope,g_scope_list',[(h0,h1,h2)],status_running)` >> ( - fs [] + fs[] ) >> pairLib.PairCases_on `x` >> rename1 `(ascope', x1, frame_list', status')` >> rename1 `(ascope', g_scope_list'', frame_list', status')` >> - fs [] >> + fs[] >> Cases_on `status'` >> ( - fs [] + fs[] ) >| [ (* comp1 *) Cases_on `scopes_to_retrieve h0 func_map b_func_map g_scope_list g_scope_list''` >> ( - fs [] + fs[] ) >> rw [] >> assume_tac stmt_stack_exec_sound_red >> - fs [stmt_stack_exec_sound] >> + fs[stmt_stack_exec_sound] >> RES_TAC >> - irule (SIMP_RULE list_ss [] (Q.SPECL [`apply_table_f`, `ext_map`, `func_map`, `b_func_map`, `pars_map`, `tbl_map`, `ascope`, `g_scope_list`, `h0`, `h1`, `h2`, `(h'0,h'1,h'2)::t`] ((valOf o find_clause_frames_red) "frames_comp1"))) >> - fs [clause_name_def, notret_def] >> + irule (SIMP_RULE list_ss [] (Q.SPECL [`apply_table_f`, `ext_map`, `func_map`, `b_func_map`, `pars_map`, `tbl_map`, ‘get_oracle_index’, ‘set_oracle_index’, ‘random_oracle’, `ascope`, `g_scope_list`, `h0`, `h1`, `h2`, `(h'0,h'1,h'2)::t`] ((valOf o find_clause_frames_red) "frames_comp1"))) >> + fs[clause_name_def, notret_def] >> qexists_tac `g_scope_list''` >> - fs [], + fs[], (* comp2 *) Cases_on `frame_list'` >> ( - fs [] + fs[] ) >> Cases_on `t'` >> ( - fs [] + fs[] ) >> PairCases_on `h` >> - fs [] >> + fs[] >> Cases_on `assign g_scope_list'' v (lval_varname (varn_star h0'))` >> ( - fs [] + fs[] ) >> Cases_on `scopes_to_retrieve h0' func_map b_func_map g_scope_list x` >> ( - fs [] + fs[] ) >> Cases_on `lookup_funn_sig_body h0' func_map b_func_map ext_map` >> ( - fs [] + fs[] ) >> PairCases_on `x''''` >> - fs [] >> + fs[] >> Cases_on `scopes_to_pass h'0 func_map b_func_map x'''` >> ( - fs [] + fs[] ) >> Cases_on `copyout (MAP FST x''''1) (MAP SND x''''1) x'''' h'2 h2'` >> ( - fs [] + fs[] ) >> PairCases_on `x'''''` >> - fs [] >> + fs[] >> Cases_on `scopes_to_retrieve h'0 func_map b_func_map x''' x'''''0` >> ( - fs [] + fs[] ) >> rw [] >> IMP_RES_TAC stmt_exec_status_returnv_inv >> rw [] >> assume_tac stmt_stack_exec_sound_red >> - fs [stmt_stack_exec_sound] >> + fs[stmt_stack_exec_sound] >> RES_TAC >> - fs [] >> - irule (SIMP_RULE list_ss [] (Q.SPECL [`x''''1`, `apply_table_f`, `ext_map`, `func_map`, `b_func_map`, `pars_map`, `tbl_map`, `ascope`, `g_scope_list`, `h0`, `h1`, `h2`, `h'0`, `h'1`, `h'2`, `t`] ((valOf o find_clause_frames_red) "frames_comp2"))) >> - fs [clause_name_def] >> + fs[] >> + irule (SIMP_RULE list_ss [] (Q.SPECL [`x''''1`, `apply_table_f`, `ext_map`, `func_map`, `b_func_map`, `pars_map`, `tbl_map`, ‘get_oracle_index’, ‘set_oracle_index’, ‘random_oracle’, `ascope`, `g_scope_list`, `h0`, `h1`, `h2`, `h'0`, `h'1`, `h'2`, `t`] ((valOf o find_clause_frames_red) "frames_comp2"))) >> + fs[clause_name_def] >> qexistsl_tac [`g_scope_list''`, `x`, `x'''`, `x''''`, `x'''''0`, `h2'`, `h1'`, `v`] >> - fs [lambda_FST, lambda_SND], + fs[lambda_FST, lambda_SND], (* comp1 *) Cases_on `scopes_to_retrieve h0 func_map b_func_map g_scope_list g_scope_list''` >> ( - fs [] + fs[] ) >> rw [] >> assume_tac stmt_stack_exec_sound_red >> - fs [stmt_stack_exec_sound] >> + fs[stmt_stack_exec_sound] >> RES_TAC >> - irule (SIMP_RULE list_ss [] (Q.SPECL [`apply_table_f`, `ext_map`, `func_map`, `b_func_map`, `pars_map`, `tbl_map`, `ascope`, `g_scope_list`, `h0`, `h1`, `h2`, `(h'0,h'1,h'2)::t`] ((valOf o find_clause_frames_red) "frames_comp1"))) >> - fs [clause_name_def, notret_def] >> + irule (SIMP_RULE list_ss [] (Q.SPECL [`apply_table_f`, `ext_map`, `func_map`, `b_func_map`, `pars_map`, `tbl_map`, ‘get_oracle_index’, ‘set_oracle_index’, ‘random_oracle’, `ascope`, `g_scope_list`, `h0`, `h1`, `h2`, `(h'0,h'1,h'2)::t`] ((valOf o find_clause_frames_red) "frames_comp1"))) >> + fs[clause_name_def, notret_def] >> qexists_tac `g_scope_list''` >> - fs [] + fs[] ] ] QED diff --git a/hol/p4_exec_sem_stmt_soundnessScript.sml b/hol/metatheory/p4_exec_sem_stmt_soundnessScript.sml similarity index 68% rename from hol/p4_exec_sem_stmt_soundnessScript.sml rename to hol/metatheory/p4_exec_sem_stmt_soundnessScript.sml index d9ac09b6..dc186f79 100644 --- a/hol/p4_exec_sem_stmt_soundnessScript.sml +++ b/hol/metatheory/p4_exec_sem_stmt_soundnessScript.sml @@ -23,29 +23,29 @@ End fun specl_stmt_block_exec stmt frame_list' stmt_stack' = - SIMP_RULE list_ss [] (ISPECL [``apply_table_f:'a apply_table_f``, ``ext_map:'a ext_map``, ``func_map:func_map``, ``b_func_map:b_func_map``, ``pars_map:pars_map``, ``tbl_map:tbl_map``, ``ascope:'a``, ``g_scope_list:g_scope_list``, ``funn:funn``, stmt, ``stmt_stack:stmt_stack``, ``scope_list:scope_list``, ``status_running``, ``ascope':'a``, ``g_scope_list':g_scope_list``, frame_list', stmt_stack'] ((valOf o find_clause_stmt_red) "stmt_block_exec")) + SIMP_RULE list_ss [] (ISPECL [``apply_table_f:'a apply_table_f``, ``ext_map:'a ext_map``, ``func_map:func_map``, ``b_func_map:b_func_map``, ``pars_map:pars_map``, ``tbl_map:tbl_map``, “get_oracle_index:'a get_oracle_index”, “set_oracle_index:'a set_oracle_index”, “random_oracle:random_oracle”, ``ascope:'a``, ``g_scope_list:g_scope_list``, ``funn:funn``, stmt, ``stmt_stack:stmt_stack``, ``scope_list:scope_list``, ``status_running``, ``ascope':'a``, ``g_scope_list':g_scope_list``, frame_list', stmt_stack'] ((valOf o find_clause_stmt_red) "stmt_block_exec")) ; Theorem stmt_ext_exec_sound_red: !type. stmt_exec_sound type stmt_ext Proof -fs [stmt_exec_sound] >> +fs[stmt_exec_sound] >> rpt strip_tac >> Cases_on `status` >> ( - fs [stmt_exec_def] + fs[stmt_exec_def] ) >> pairLib.PairCases_on `ctx` >> -rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> +rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)` >> pairLib.PairCases_on `state'` >> rename1 `(state'0,g_scope_list',state'2,state'3)` >> rename1 `(ascope',g_scope_list',frame_list',status')` >> -fs [exec_stmt_ext_SOME_REWRS] >> +fs[exec_stmt_ext_SOME_REWRS] >> Cases_on `stmt_stack` >| [ metis_tac [(valOf o find_clause_stmt_red) "stmt_ext", clause_name_def], irule (specl_stmt_block_exec ``stmt_ext`` ``[]:frame_list`` ``[stmt_empty]``) >> - fs [clause_name_def] >> + fs[clause_name_def] >> metis_tac [(valOf o find_clause_stmt_red) "stmt_ext", clause_name_def] ] QED @@ -55,39 +55,39 @@ Theorem stmt_ret_exec_sound_red: e_exec_sound type e ==> stmt_exec_sound type (stmt_ret e) Proof -fs [stmt_exec_sound, e_exec_sound] >> +fs[stmt_exec_sound, e_exec_sound] >> rpt strip_tac >> Cases_on `status` >> ( - fs [stmt_exec_def] + fs[stmt_exec_def] ) >> pairLib.PairCases_on `ctx` >> -rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> +rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)` >> pairLib.PairCases_on `state'` >> rename1 `(state'0,g_scope_list',state'2,state'3)` >> rename1 `(ascope',g_scope_list',frame_list',status')` >> -fs [exec_stmt_ret_SOME_REWRS] >> +fs[exec_stmt_ret_SOME_REWRS] >> Cases_on `stmt_stack` >> ( Cases_on `get_v e` >> ( - fs [] + fs[] ) ) >| [ - metis_tac [(valOf o find_clause_stmt_red) "stmt_ret_e", clause_name_def], + metis_tac[(valOf o find_clause_stmt_red) "stmt_ret_e", clause_name_def, get_ectx_def], Cases_on `e` >> ( - fs [get_v_def] + fs[get_v_def] ) >> - metis_tac [(valOf o find_clause_stmt_red) "stmt_ret_v", clause_name_def], + metis_tac[(valOf o find_clause_stmt_red) "stmt_ret_v", clause_name_def], irule (specl_stmt_block_exec ``stmt_ret e`` ``frame_list'':frame_list`` ``[stmt_ret e']``) >> - fs [clause_name_def] >> - metis_tac [(valOf o find_clause_stmt_red) "stmt_ret_e", clause_name_def], + fs[clause_name_def] >> + metis_tac[(valOf o find_clause_stmt_red) "stmt_ret_e", clause_name_def, get_ectx_def], Cases_on `e` >> ( - fs [get_v_def] + fs[get_v_def] ) >> irule (specl_stmt_block_exec ``stmt_ret e`` ``[]:frame_list`` ``[stmt_empty]``) >> - fs [clause_name_def] >> - metis_tac [(valOf o find_clause_stmt_red) "stmt_ret_v", clause_name_def] + fs[clause_name_def] >> + metis_tac[(valOf o find_clause_stmt_red) "stmt_ret_v", clause_name_def] ] QED @@ -96,42 +96,42 @@ Theorem stmt_trans_exec_sound_red: e_exec_sound type e ==> stmt_exec_sound type (stmt_trans e) Proof -fs [stmt_exec_sound, e_exec_sound] >> +fs[stmt_exec_sound, e_exec_sound] >> rpt strip_tac >> Cases_on `status` >> ( - fs [stmt_exec_def] + fs[stmt_exec_def] ) >> pairLib.PairCases_on `ctx` >> -rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> +rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)` >> pairLib.PairCases_on `state'` >> rename1 `(state'0,g_scope_list',state'2,state'3)` >> rename1 `(ascope',g_scope_list',frame_list',status')` >> -fs [exec_stmt_trans_SOME_REWRS] >> +fs[exec_stmt_trans_SOME_REWRS] >> Cases_on `is_v e` >> ( - fs [] + fs[] ) >| [ Cases_on `e` >> ( - fs [is_v_def] + fs[is_v_def] ) >> Cases_on `v` >> ( - fs [is_v_str_def] + fs[is_v_str_def] ) >> rw [] >> - fs [stmt_exec_trans_def] >> + fs[stmt_exec_trans_def] >> Cases_on `stmt_stack` >| [ - metis_tac [(valOf o find_clause_stmt_red) "stmt_trans", clause_name_def], + metis_tac[(valOf o find_clause_stmt_red) "stmt_trans", clause_name_def], irule (specl_stmt_block_exec ``stmt_trans (e_v (v_str s))`` ``[]:frame_list`` ``[stmt_empty]``) >> - fs [clause_name_def] >> - metis_tac [(valOf o find_clause_stmt_red) "stmt_trans", clause_name_def] + fs[clause_name_def] >> + metis_tac[(valOf o find_clause_stmt_red) "stmt_trans", clause_name_def] ], Cases_on `stmt_stack` >| [ - metis_tac [(valOf o find_clause_stmt_red) "stmt_trans_e", clause_name_def], + metis_tac[(valOf o find_clause_stmt_red) "stmt_trans_e", clause_name_def, get_ectx_def], irule (specl_stmt_block_exec ``stmt_trans e`` ``frame_list'':frame_list`` ``[stmt_trans e']``) >> - fs [clause_name_def] >> - metis_tac [(valOf o find_clause_stmt_red) "stmt_trans_e", clause_name_def] + fs[clause_name_def] >> + metis_tac[(valOf o find_clause_stmt_red) "stmt_trans_e", clause_name_def, get_ectx_def] ] ] QED @@ -141,20 +141,20 @@ Theorem stmt_app_exec_sound_red: (!e. e_exec_sound type e) ==> stmt_exec_sound type (stmt_app tbl e_l) Proof -fs [stmt_exec_sound] >> +fs[stmt_exec_sound] >> rpt strip_tac >> pairLib.PairCases_on `ctx` >> -rename1 `(ctx0, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> -rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> +rename1 `(ctx0, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)` >> +rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)` >> Cases_on `status` >> ( - fs [stmt_exec_def] + fs[stmt_exec_def] ) >> pairLib.PairCases_on `state'` >> rename1 `(state'0,g_scope_list',state'2,state'3)` >> rename1 `(ascope',g_scope_list',frame_list',status')` >> -fs [exec_stmt_app_SOME_REWRS] >> +fs[exec_stmt_app_SOME_REWRS] >> Cases_on `index_not_const e_l` >> ( - fs [] + fs[] ) >| [ rw [] >> IMP_RES_TAC index_not_const_NONE >> @@ -162,7 +162,7 @@ Cases_on `index_not_const e_l` >> ( ALL_TAC, irule (specl_stmt_block_exec ``stmt_app tbl e_l`` ``[]:frame_list`` ``[stmt_ass lval_null (e_call (funn_name f) f_args)]``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( subgoal `?v_l. f_args = MAP e_v v_l` >- ( qexists_tac `vl_of_el f_args` >> @@ -173,10 +173,10 @@ Cases_on `index_not_const e_l` >> ( (MAP ( \ v_. e_v v_) v_l = f_args)` (fn thm => (irule (SIMP_RULE std_ss [thm] (ISPECL [``default_f_args:e list``, ``ZIP (e_l:e list, mk_l: mk list)``, ``v_l:v list``] ((valOf o find_clause_stmt_red) "stmt_apply_table_v"))))) >- ( - fs [lambda_FST, lambda_SND, MAP_ZIP, UNZIP_ZIP] >> - metis_tac [] + fs[lambda_FST, lambda_SND, MAP_ZIP, UNZIP_ZIP] >> + metis_tac[] ) >> - fs [clause_name_def, lambda_SND, MAP_ZIP] + fs[clause_name_def, lambda_SND, MAP_ZIP] ), rw [] >> @@ -184,16 +184,16 @@ Cases_on `index_not_const e_l` >> ( ALL_TAC, irule (specl_stmt_block_exec ``stmt_app tbl e_l`` ``frame_list'':frame_list`` ``[stmt_app tbl (LUPDATE e' x e_l)]``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( Q.SUBGOAL_THEN `(MAP ( \ (e_,e'_). e_) (ZIP ((e_l:e list), (LUPDATE e' x e_l):e list)) = e_l) /\ (MAP ( \ (e_,e'_). e'_) (ZIP ((e_l:e list), (LUPDATE e' x e_l):e list)) = (LUPDATE e' x e_l))` (fn thm => (irule (SIMP_RULE std_ss [thm] (ISPEC ``ZIP ((e_l:e list), (LUPDATE e' x e_l):e list)`` ((valOf o find_clause_stmt_red) "stmt_apply_table_e"))))) >- ( - fs [lambda_FST, lambda_SND, MAP_ZIP] + fs[lambda_FST, lambda_SND, MAP_ZIP] ) >> - fs [clause_name_def] >> - metis_tac [e_exec_sound] + fs[clause_name_def, get_ectx_def] >> + metis_tac[e_exec_sound] ) ] QED @@ -203,42 +203,42 @@ Theorem stmt_ass_exec_sound_red: e_exec_sound type e ==> stmt_exec_sound type (stmt_ass lval e) Proof -fs [stmt_exec_sound, e_exec_sound] >> +fs[stmt_exec_sound, e_exec_sound] >> rpt strip_tac >> pairLib.PairCases_on `ctx` >> -rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> +rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)` >> pairLib.PairCases_on `state'` >> rename1 `(state'0,g_scope_list',state'2,state'3)` >> rename1 `(ascope',g_scope_list',frame_list',status')` >> Cases_on `status` >> ( - fs [stmt_exec_def] + fs[stmt_exec_def] ) >> -fs [exec_stmt_ass_SOME_REWRS] >> +fs[exec_stmt_ass_SOME_REWRS] >> Cases_on `is_v e` >> ( - fs [] + fs[] ) >| [ Cases_on `e` >> ( - fs [is_v_def] + fs[is_v_def] ) >> rw [] >> - fs [stmt_exec_ass_def] >> + fs[stmt_exec_ass_def] >> Cases_on `stmt_stack` >| [ ALL_TAC, irule (specl_stmt_block_exec ``stmt_ass lval (e_v v)`` ``[]:frame_list`` ``[stmt_empty]``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( irule ((valOf o find_clause_stmt_red) "stmt_ass_v") >> - fs [clause_name_def] + fs[clause_name_def] ), Cases_on `stmt_stack` >| [ ALL_TAC, irule (specl_stmt_block_exec ``stmt_ass lval e`` ``frame_list'':frame_list`` ``[stmt_ass lval e']``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( - metis_tac [((valOf o find_clause_stmt_red) "stmt_ass_e"), clause_name_def] + metis_tac[((valOf o find_clause_stmt_red) "stmt_ass_e"), clause_name_def, get_ectx_def] ) ] QED @@ -249,74 +249,74 @@ stmt_exec_sound type s1 ==> stmt_exec_sound type s2 ==> stmt_exec_sound type (stmt_seq s1 s2) Proof -fs [stmt_exec_sound] >> +fs[stmt_exec_sound] >> rpt strip_tac >> Cases_on `status` >> ( - fs [stmt_exec_def] + fs[stmt_exec_def] ) >> pairLib.PairCases_on `ctx` >> -rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> +rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)` >> pairLib.PairCases_on `state'` >> rename1 `(state'0,g_scope_list',state'2,state'3)` >> rename1 `(ascope',g_scope_list',frame_list',status')` >> -fs [exec_stmt_seq_SOME_REWRS] >> +fs[exec_stmt_seq_SOME_REWRS] >> Cases_on `is_empty s1` >> ( - fs [] + fs[] ) >| [ Cases_on `s1` >> ( - fs [is_empty_def] + fs[is_empty_def] ) >> Cases_on `stmt_stack` >| [ ALL_TAC, irule (specl_stmt_block_exec ``stmt_seq stmt_empty s2`` ``[]:frame_list`` ``[s2]:stmt list``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( - metis_tac [((valOf o find_clause_stmt_red) "stmt_seq2"), clause_name_def] + metis_tac[((valOf o find_clause_stmt_red) "stmt_seq2"), clause_name_def] ), Cases_on `status' = status_running` >> ( - fs [] + fs[] ) >| [ Cases_on `stmt_stack` >| [ ALL_TAC, irule (specl_stmt_block_exec ``stmt_seq s1 s2`` ``[]:frame_list`` ``[stmt_seq stmt1' s2]:stmt list``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( - metis_tac [SIMP_RULE list_ss [] (Q.SPECL [`ctx`, `ascope`, `g_scope_list`, `funn`, `s1`, `s2`, `scope_list`, `ascope'`, `g_scope_list'`, `[]`, `[]`] ((valOf o find_clause_stmt_red) "stmt_seq1")), clause_name_def] + metis_tac[SIMP_RULE list_ss [] (Q.SPECL [`ctx`, `ascope`, `g_scope_list`, `funn`, `s1`, `s2`, `scope_list`, `ascope'`, `g_scope_list'`, `[]`, `[]`] ((valOf o find_clause_stmt_red) "stmt_seq1")), clause_name_def] ), Cases_on `stmt_stack` >| [ ALL_TAC, irule (specl_stmt_block_exec ``stmt_seq s1 s2`` ``[]:frame_list`` ``[stmt1']:stmt list``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( - metis_tac [(valOf o find_clause_stmt_red) "stmt_seq3", clause_name_def] + metis_tac[(valOf o find_clause_stmt_red) "stmt_seq3", clause_name_def] ) ], (* stmt added to stmt stack (block entered) *) - fs [] >> + fs[] >> Cases_on `stmt_stack` >| [ ALL_TAC, irule (specl_stmt_block_exec ``stmt_seq s1 s2`` ``[]:frame_list`` ``stmt1''::[stmt_seq stmt1' s2]:stmt list``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( - metis_tac [SIMP_RULE list_ss [] (Q.SPECL [`ctx`, `ascope`, `g_scope_list`, `funn`, `s1`, `s2`, `scope_list`, `ascope'`, `g_scope_list'`, `[]`, `[stmt1'']`] ((valOf o find_clause_stmt_red) "stmt_seq1")), clause_name_def] + metis_tac[SIMP_RULE list_ss [] (Q.SPECL [`ctx`, `ascope`, `g_scope_list`, `funn`, `s1`, `s2`, `scope_list`, `ascope'`, `g_scope_list'`, `[]`, `[stmt1'']`] ((valOf o find_clause_stmt_red) "stmt_seq1")), clause_name_def] ), (* frame added (function called) *) - fs [] >> + fs[] >> Cases_on `stmt_stack` >| [ ALL_TAC, irule (specl_stmt_block_exec ``stmt_seq s1 s2`` ``[(funn',[stmt'],[scope'])]:frame_list`` ``[stmt_seq stmt1' s2]:stmt list``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( - metis_tac [SIMP_RULE list_ss [] (Q.SPECL [`ctx`, `ascope`, `g_scope_list`, `funn`, `s1`, `s2`, `scope_list`, `ascope'`, `g_scope_list'`, `[frame]`, `[]`] ((valOf o find_clause_stmt_red) "stmt_seq1")), clause_name_def] + metis_tac[SIMP_RULE list_ss [] (Q.SPECL [`ctx`, `ascope`, `g_scope_list`, `funn`, `s1`, `s2`, `scope_list`, `ascope'`, `g_scope_list'`, `[frame]`, `[]`] ((valOf o find_clause_stmt_red) "stmt_seq1")), clause_name_def] ) ] QED @@ -328,49 +328,49 @@ stmt_exec_sound type s1 ==> stmt_exec_sound type s2 ==> stmt_exec_sound type (stmt_cond e s1 s2) Proof -fs [stmt_exec_sound, e_exec_sound] >> +fs[stmt_exec_sound, e_exec_sound] >> rpt strip_tac >> Cases_on `status` >> ( - fs [stmt_exec_def] + fs[stmt_exec_def] ) >> pairLib.PairCases_on `ctx` >> -rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> +rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)` >> pairLib.PairCases_on `state'` >> rename1 `(state'0,g_scope_list',state'2,state'3)` >> rename1 `(ascope',g_scope_list',frame_list',status')` >> -fs [exec_stmt_cond_SOME_REWRS] >> +fs[exec_stmt_cond_SOME_REWRS] >> Cases_on `is_v_bool e` >> ( - fs [] + fs[] ) >| [ Cases_on `e` >> ( - fs [is_v_bool_def] + fs[is_v_bool_def] ) >> Cases_on `v` >> ( - fs [is_v_bool_def] + fs[is_v_bool_def] ) >> Cases_on `b` >> ( - fs [] + fs[] ) >> ( Cases_on `b'` >> ( - fs [stmt_exec_cond_def] + fs[stmt_exec_cond_def] ) ) >| [ Cases_on `stmt_stack` >| [ ALL_TAC, irule (specl_stmt_block_exec ``stmt_cond (e_v (v_bool T)) s1 s2`` ``[]:frame_list`` ``[s1]:stmt list``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( - metis_tac [(valOf o find_clause_stmt_red) "stmt_cond2", clause_name_def] + metis_tac[(valOf o find_clause_stmt_red) "stmt_cond2", clause_name_def] ), Cases_on `stmt_stack` >| [ ALL_TAC, irule (specl_stmt_block_exec ``stmt_cond (e_v (v_bool F)) s1 s2`` ``[]:frame_list`` ``[s2]:stmt list``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( - metis_tac [(valOf o find_clause_stmt_red) "stmt_cond3", clause_name_def] + metis_tac[(valOf o find_clause_stmt_red) "stmt_cond3", clause_name_def] ) ], @@ -378,9 +378,9 @@ Cases_on `is_v_bool e` >> ( ALL_TAC, irule (specl_stmt_block_exec ``stmt_cond e s1 s2`` ``frame_list'':frame_list`` ``[stmt_cond e' s1 s2]``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( - metis_tac [(valOf o find_clause_stmt_red) "stmt_cond_e", clause_name_def] + metis_tac[(valOf o find_clause_stmt_red) "stmt_cond_e", clause_name_def, get_ectx_def] ) ] QED @@ -390,25 +390,25 @@ Theorem stmt_block_exec_sound_red: stmt_exec_sound type s ==> stmt_exec_sound type (stmt_block decl_list s) Proof -fs [stmt_exec_sound] >> +fs[stmt_exec_sound] >> rpt strip_tac >> Cases_on `status` >> ( - fs [stmt_exec_def] + fs[stmt_exec_def] ) >> pairLib.PairCases_on `ctx` >> -rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> +rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)` >> pairLib.PairCases_on `state'` >> rename1 `(state'0,g_scope_list',state'2,state'3)` >> rename1 `(ascope',g_scope_list',frame_list',status')` >> -fs [exec_stmt_block_SOME_REWRS] >> +fs[exec_stmt_block_SOME_REWRS] >> Cases_on `stmt_stack` >| [ ALL_TAC, irule (specl_stmt_block_exec ``stmt_block decl_list s`` ``[]:frame_list`` ``s::[stmt_empty]``) >> - fs [clause_name_def] + fs[clause_name_def] ] >> ( irule ((valOf o find_clause_stmt_red) "stmt_block_enter") >> - fs [clause_name_def] + fs[clause_name_def] ) QED @@ -420,38 +420,38 @@ strip_tac >> irule stmt_induction >> rpt strip_tac >| [ (* Empty statement *) - fs [stmt_exec_sound] >> + fs[stmt_exec_sound] >> rpt strip_tac >> Cases_on `status` >> Cases_on `scope_list` >> Cases_on `stmt_stack` >> ( - fs [stmt_exec_def] + fs[stmt_exec_def] ) >> rw [] >> irule ((valOf o find_clause_stmt_red) "stmt_block_exit") >> - fs [clause_name_def], + fs[clause_name_def], (* Extern *) - fs [stmt_ext_exec_sound_red], + fs[stmt_ext_exec_sound_red], (* Return statement *) - fs [stmt_ret_exec_sound_red], + fs[stmt_ret_exec_sound_red], (* Transition statement *) - fs [stmt_trans_exec_sound_red], + fs[stmt_trans_exec_sound_red], (* Apply statement *) - fs [stmt_app_exec_sound_red], + fs[stmt_app_exec_sound_red], (* Assign statement *) - fs [stmt_ass_exec_sound_red], + fs[stmt_ass_exec_sound_red], (* Sequence of statements *) - fs [stmt_seq_exec_sound_red], + fs[stmt_seq_exec_sound_red], (* Conditional statement *) - fs [stmt_cond_exec_sound_red], + fs[stmt_cond_exec_sound_red], (* Block entry *) - fs [stmt_block_exec_sound_red] + fs[stmt_block_exec_sound_red] ] QED @@ -459,17 +459,17 @@ Theorem stmt_stack_exec_sound_red: !type stmt_stack. stmt_stack_exec_sound type stmt_stack Proof Cases_on `stmt_stack` >> ( - fs [stmt_stack_exec_sound] >> + fs[stmt_stack_exec_sound] >> rpt strip_tac >> Cases_on `status` >> ( - fs [stmt_exec_def] + fs[stmt_exec_def] ) >> Cases_on `scope_list` >> ( - fs [stmt_exec_def] + fs[stmt_exec_def] ) ) >> assume_tac (SPECL [``type:'a itself``, ``h:stmt``] stmt_exec_sound_red) >> -fs [stmt_exec_sound] +fs[stmt_exec_sound] QED val _ = export_theory (); diff --git a/hol/p4_frames_progressScript.sml b/hol/metatheory/p4_frames_progressScript.sml similarity index 97% rename from hol/p4_frames_progressScript.sml rename to hol/metatheory/p4_frames_progressScript.sml index 2371444e..cfd81eb3 100644 --- a/hol/p4_frames_progressScript.sml +++ b/hol/metatheory/p4_frames_progressScript.sml @@ -230,10 +230,10 @@ that is an extension of the current one (because it is scopes to pass ) *) val WT_state_imp_frame_typ_single = prove ( “ ∀ ascope gscope f stmtl locale status Prs_n order tslg tsll delta_g delta_b - delta_x delta_t apply_table_f ext_map func_map b_func_map pars_map + delta_x delta_t apply_table_f ext_map func_map b_func_map pars_map get_oracle_index set_oracle_index random_oracle tbl_map. - WT_state ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) + WT_state ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) (ascope,gscope,[(f,stmtl,locale)],status) Prs_n order tslg tsll (delta_g,delta_b,delta_x,delta_t) ⇒ @@ -249,7 +249,7 @@ val WT_state_imp_frame_typ_single = prove ( tbl_to_pass f b_func_map tbl_map = SOME passed_tbl_map ∧ t_tbl_to_pass f delta_b delta_t = SOME passed_delta_t ∧ -WT_c ( apply_table_f , ext_map , func_map , passed_b_func_map , pars_map , passed_tbl_map ) order passed_tslg delta_g passed_delta_b delta_x passed_delta_t Prs_n ∧ +WT_c ( apply_table_f , ext_map , func_map , passed_b_func_map , pars_map , passed_tbl_map , get_oracle_index , set_oracle_index , random_oracle ) order passed_tslg delta_g passed_delta_b delta_x passed_delta_t Prs_n ∧ type_scopes_list passed_gscope passed_tslg ∧ (frame_typ ( passed_tslg , (HD tsll) ) (order, f, (delta_g, passed_delta_b, delta_x, passed_delta_t)) Prs_n passed_gscope locale stmtl ) ”, @@ -300,10 +300,10 @@ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘tau_x_d_list’, ‘tau’])) >> val WT_state_imp_t_funn_lookup_HD = prove ( “ -∀ f apply_table_f ext_map func_map b_func_map pars_map tbl_map ascope gscope stmtl locale t status Prs_n order tslg +∀ f apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ascope gscope stmtl locale t status Prs_n order tslg delta_g delta_b delta_x delta_t tsll. - WT_state (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) + WT_state (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) (ascope,gscope,(f,stmtl,locale)::t,status) Prs_n order tslg tsll (delta_g,delta_b,delta_x,delta_t) ⇒ ∃ txdl t . @@ -683,7 +683,7 @@ Cases_on ‘is_d_none_in h1’ >> gvs[] >| [ IMP_RES_TAC v_types_ev >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘pre_passed_tslg’, ‘pre_tsl’, ‘T_e’])) >> - (* since the lval is typed, and also the value is typed, then there exsists a scope such that assign lval = v *) + (* since the lval is typed, and also the value is typed, then there exists a scope such that assign lval = v *) ASSUME_TAC assignment_scope_exists >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘pre_local’,‘pre_gscope_passed’,‘pre_tsl’,‘pre_passed_tslg’,‘t’,‘F’,‘lval’,‘v’,‘T_e’])) >> gvs[] >> @@ -1003,7 +1003,7 @@ gvs[prog_state_def] >> REPEAT STRIP_TAC >> Cases_on ‘framel’ >> gvs[] >> PairCases_on ‘c’ >> -rename1 ‘( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map )’ >> +rename1 ‘( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle )’ >> PairCases_on ‘h’ >> rename1 ‘(f,stmtl,locale)::t’ >> @@ -1017,7 +1017,7 @@ ASSUME_TAC PROG_stmtl >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`,‘stmtl’])) >> gvs[prog_stmtl_def] >> -FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ascope`,‘passed_gscope’,‘locale’, ‘HD tsll’, ‘passed_tslg’, ‘(apply_table_f,ext_map,func_map,passed_b_func_map,pars_map,passed_tbl_map)’, ‘order’,‘delta_g’, ‘passed_delta_b’, ‘passed_delta_t’, ‘delta_x’, ‘f’,‘Prs_n’])) >> gvs[] >> +FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ascope`,‘passed_gscope’,‘locale’, ‘HD tsll’, ‘passed_tslg’, ‘(apply_table_f,ext_map,func_map,passed_b_func_map,pars_map,passed_tbl_map,get_oracle_index,set_oracle_index,random_oracle)’, ‘order’,‘delta_g’, ‘passed_delta_b’, ‘passed_delta_t’, ‘delta_x’, ‘f’,‘Prs_n’])) >> gvs[] >> (* now the difference between comp1 and comp2 is the status after the transition being return or not*) @@ -1089,7 +1089,7 @@ Cases_on ‘notret status'’ >| [ gvs[frame_typ_cases] >> IMP_RES_TAC WT_state_imp_t_funn_lookup_HD >> - ‘WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) + ‘WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) order tslg delta_g delta_b delta_x delta_t Prs_n’ by gvs[WT_state_cases] >> drule tfunn_imp_sig_body_lookup >> REPEAT STRIP_TAC >> METIS_TAC [] @@ -1115,7 +1115,7 @@ Cases_on ‘notret status'’ >| [ ASSUME_TAC Fg_star_lemma1 >> LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘passed_tslg’,‘f’, ‘func_map’, ‘delta_g’, ‘passed_delta_b’, ‘delta_x’, ‘order’, ‘passed_b_func_map’, - ‘passed_gscope’,‘ext_map’,‘stmt’,‘xdl’,‘apply_table_f’,‘pars_map’,‘passed_tbl_map’,‘passed_delta_t’, ‘Prs_n’])) >> gvs[] >> + ‘passed_gscope’,‘ext_map’,‘stmt’,‘xdl’,‘apply_table_f’,‘pars_map’,‘passed_tbl_map’,‘get_oracle_index’,‘set_oracle_index’,‘random_oracle’,‘passed_delta_t’, ‘Prs_n’])) >> gvs[] >> IMP_RES_TAC passed_b_same_lookup_sig_body >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘func_map’, ‘ext_map’])) >> gvs[] >> @@ -1128,14 +1128,14 @@ Cases_on ‘notret status'’ >| [ IMP_RES_TAC return_imp_same_g >> lfs[] >> gvs[] >> - ‘∃ v'. lookup_lval gscope' (lval_varname (varn_star f)) = SOME v'’ by (IMP_RES_TAC lval_of_star_in_gscope >> srw_tac [SatisfySimps.SATISFY_ss][])>> + ‘∃ v'. lookup_lval gscope' (lval_varname (varn_star f)) = SOME v'’ by (IMP_RES_TAC lval_of_star_in_gscope >> metis_tac[])>> IMP_RES_TAC lval_assign_exists >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘v’])) >> gvs[] >> CONV_TAC $ SWAP_EXISTS_CONV >> Q.EXISTS_TAC ‘scopest'’ >> gvs[] >> - (* now we show that scopes to retrieve exsists & it's length is 2 *) + (* now we show that scopes to retrieve exists & it's length is 2 *) subgoal ‘LENGTH gscope' = 2 ’ >- ( IMP_RES_TAC type_scopes_list_LENGTH >> gvs[WT_c_cases] ) >> IMP_RES_TAC assign_star_length_2 >> @@ -1149,7 +1149,7 @@ Cases_on ‘notret status'’ >| [ ASSUME_TAC status_ret_in_stmtl_typed_verbose >> LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘stmtl’,‘stmtl'’, ‘ascope’, ‘ascope'’, ‘gscope'’, ‘gscope'’, ‘locale’, ‘scopest'’, ‘[]’, ‘HD tsll’, ‘passed_tslg’, ‘order’, ‘delta_g’, ‘passed_delta_b’, ‘passed_delta_t’, ‘delta_x’, - ‘f’, ‘Prs_n’, ‘(apply_table_f,ext_map,func_map,passed_b_func_map,pars_map, passed_tbl_map)’, + ‘f’, ‘Prs_n’, ‘(apply_table_f,ext_map,func_map,passed_b_func_map,pars_map, passed_tbl_map, get_oracle_index, set_oracle_index, random_oracle)’, ‘tau’, ‘tau_x_d_list’, ‘v’])) >> gvs[] >> gvs[Once frame_typ_cases, clause_name_def, type_frame_tsl_def] ) >> @@ -1226,7 +1226,7 @@ Cases_on ‘notret status'’ >| [ `stmtl'`,‘ascope’,‘ascope'’, ‘gscope'’,‘gscope'’, ‘locale’,‘scopest'’, ‘[]’,‘status_running’,‘status_returnv v’, ‘HD tsll’,‘passed_tslg’, ‘order’, ‘delta_g’, ‘passed_delta_b’, ‘passed_delta_t’, ‘delta_x’, ‘f’, - ‘Prs_n’, ‘0’, ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘passed_b_func_map’, ‘pars_map’, ‘passed_tbl_map’])) >> gvs[] >> + ‘Prs_n’, ‘0’, ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘passed_b_func_map’, ‘pars_map’, ‘passed_tbl_map’, ‘get_oracle_index’, ‘set_oracle_index’, ‘random_oracle’])) >> gvs[] >> gvs[clause_name_def, type_frame_tsl_def] >> gvs[Once stmtl_typ_cases] >> Cases_on ‘stmtl'’ >> gvs[] ) >> diff --git a/hol/p4_frames_subject_reductionScript.sml b/hol/metatheory/p4_frames_subject_reductionScript.sml similarity index 97% rename from hol/p4_frames_subject_reductionScript.sml rename to hol/metatheory/p4_frames_subject_reductionScript.sml index e91da14a..13e7eea6 100644 --- a/hol/p4_frames_subject_reductionScript.sml +++ b/hol/metatheory/p4_frames_subject_reductionScript.sml @@ -373,7 +373,7 @@ QED Theorem WT_c_empty_db: ∀ f delta_b delta_g delta_x delta_t passed_delta_b passed_delta_t - apply_table_f (ext_map: 'a ext_map) func_map b_func_map tbl_map pars_map order tau + apply_table_f (ext_map: 'a ext_map) func_map b_func_map tbl_map pars_map get_oracle_index set_oracle_index random_oracle order tau txdl gscope g_scope_passed tslg passed_tslg Prs_n. t_lookup_funn f delta_g passed_delta_b delta_x = SOME (txdl, tau)∧ @@ -382,14 +382,14 @@ t_map_to_pass f delta_b = SOME passed_delta_b ∧ t_scopes_to_pass f delta_g delta_b tslg = SOME passed_tslg ∧ scopes_to_pass f func_map b_func_map gscope = SOME g_scope_passed ∧ -WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) +WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) order tslg delta_g delta_b delta_x delta_t Prs_n ⇒ ∃passed_b_func_map passed_tbl_map. map_to_pass f b_func_map = SOME passed_b_func_map ∧ tbl_to_pass f b_func_map tbl_map = SOME passed_tbl_map ∧ WT_c (apply_table_f,ext_map,func_map,passed_b_func_map,pars_map, - passed_tbl_map) order passed_tslg delta_g passed_delta_b delta_x + passed_tbl_map,get_oracle_index,set_oracle_index,random_oracle) order passed_tslg delta_g passed_delta_b delta_x passed_delta_t Prs_n Proof REPEAT STRIP_TAC >> @@ -467,9 +467,9 @@ QED Theorem WT_state_HD_of_list: ∀ ascope gscope f stmtl locale status Prs_n order tslg tsll delta_g delta_b delta_x delta_t apply_table_f ext_map func_map b_func_map pars_map - tbl_map t. + tbl_map get_oracle_index set_oracle_index random_oracle t. - WT_state ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) + WT_state ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) (ascope,gscope,(f,stmtl,locale)::t,status) Prs_n order tslg tsll (delta_g,delta_b,delta_x,delta_t) ⇒ @@ -481,7 +481,7 @@ Theorem WT_state_HD_of_list: tbl_to_pass f b_func_map tbl_map = SOME passed_tbl_map ∧ t_tbl_to_pass f delta_b delta_t = SOME passed_delta_t ∧ -WT_c ( apply_table_f , ext_map , func_map , passed_b_func_map , pars_map , passed_tbl_map ) order passed_tslg delta_g passed_delta_b delta_x passed_delta_t Prs_n ∧ +WT_c ( apply_table_f , ext_map , func_map , passed_b_func_map , pars_map , passed_tbl_map , get_oracle_index , set_oracle_index , random_oracle ) order passed_tslg delta_g passed_delta_b delta_x passed_delta_t Prs_n ∧ type_scopes_list passed_gscope passed_tslg ∧ (frame_typ ( passed_tslg , (HD tsll) ) (order, f, (delta_g, passed_delta_b, delta_x, passed_delta_t)) Prs_n passed_gscope locale stmtl ) Proof @@ -1090,12 +1090,12 @@ gvs[type_frame_tsl_def] val WT_state_of_largest_possible_frame = prove (“ -∀ apply_table_f ext_map func_map b_func_map pars_map tbl_map passed_b_func_map passed_tbl_map +∀ apply_table_f ext_map func_map b_func_map pars_map tbl_map passed_b_func_map passed_tbl_map get_oracle_index set_oracle_index random_oracle ascope gscope f stmt_stack scope_list t status Prs_n order tslg tsll delta_g delta_b delta_x delta_t passed_gscope passed_tslg passed passed_b_func_map passed_delta_b passed_tbl_map passed_delta_t f_called stmt_called copied_in_scope t_scope_list' t_scope_list'' gscope' scope_list' stmtl' scope_list'. -WT_state (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) +WT_state (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) (ascope,gscope,(f,stmt_stack,scope_list)::t,status) Prs_n order tslg tsll (delta_g,delta_b,delta_x,delta_t) ∧ @@ -1116,8 +1116,8 @@ res_frame_typ (order,f,delta_g,passed_delta_b,delta_x,passed_delta_t) Prs_n passed_tslg t_scope_list' passed_gscope [(f_called,[stmt_called],copied_in_scope)] func_map passed_b_func_map (HD tsll)∧ -WT_c (apply_table_f,ext_map,func_map,b_func_map ,pars_map ,tbl_map) order tslg delta_g delta_b delta_x delta_t Prs_n ∧ -WT_c (apply_table_f,ext_map,func_map,passed_b_func_map,pars_map,passed_tbl_map) order passed_tslg delta_g passed_delta_b delta_x passed_delta_t Prs_n ⇒ +WT_c (apply_table_f,ext_map,func_map,b_func_map ,pars_map ,tbl_map,get_oracle_index,set_oracle_index,random_oracle) order tslg delta_g delta_b delta_x delta_t Prs_n ∧ +WT_c (apply_table_f,ext_map,func_map,passed_b_func_map,pars_map,passed_tbl_map,get_oracle_index,set_oracle_index,random_oracle) order passed_tslg delta_g passed_delta_b delta_x passed_delta_t Prs_n ⇒ type_frames gscope' ((f_called,[stmt_called],copied_in_scope):: (f,stmtl',scope_list')::t) Prs_n order tslg (t_scope_list'::(t_scope_list'' ⧺ HD tsll)::TL tsll) delta_g delta_b delta_x delta_t func_map b_func_map”, @@ -1296,13 +1296,13 @@ gvs[type_scopes_list_def, similarl_def, similar_def] >> gvs[] val WT_state_of_frame_and_tl = prove ( “ -∀ apply_table_f ext_map func_map b_func_map pars_map tbl_map ascope gscope +∀ apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ascope gscope f stmt_stack scope_list t status Prs_n order tslg tsll delta_g delta_b delta_x delta_t passed_tslg passed_b_func_map passed_delta_b passed_tbl_map passed_delta_t t_scope_list'' gscope' stmtl' scope_list' g_scope_list' g_scope_list''. -WT_state (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) +WT_state (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) (ascope,gscope,(f,stmt_stack,scope_list)::t,status) Prs_n order tslg tsll (delta_g,delta_b,delta_x,delta_t) ∧ @@ -1319,8 +1319,8 @@ frame_typ (passed_tslg,t_scope_list'' ⧺ HD tsll) (order,f,delta_g,passed_delta_b,delta_x,passed_delta_t) Prs_n g_scope_list'' scope_list' stmtl' ∧ - WT_c (apply_table_f,ext_map,func_map,passed_b_func_map,pars_map,passed_tbl_map) order passed_tslg delta_g passed_delta_b delta_x passed_delta_t Prs_n ∧ - WT_c (apply_table_f,ext_map,func_map, b_func_map,pars_map, tbl_map) order tslg delta_g delta_b delta_x delta_t Prs_n ⇒ + WT_c (apply_table_f,ext_map,func_map,passed_b_func_map,pars_map,passed_tbl_map,get_oracle_index,set_oracle_index,random_oracle) order passed_tslg delta_g passed_delta_b delta_x passed_delta_t Prs_n ∧ + WT_c (apply_table_f,ext_map,func_map, b_func_map,pars_map, tbl_map,get_oracle_index,set_oracle_index,random_oracle) order tslg delta_g delta_b delta_x delta_t Prs_n ⇒ type_frames gscope' ((f,stmtl',scope_list')::t) Prs_n order tslg ((t_scope_list'' ⧺ HD tsll)::TL tsll) delta_g delta_b delta_x @@ -1394,12 +1394,12 @@ CASE_TAC >| [ val WT_state_of_blk_exit_and_tl = prove (“ -∀ f apply_table_f ext_map func_map b_func_map pars_map tbl_map ascope gscope +∀ f apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ascope gscope stmt_stack scope_list t status Prs_n order tslg tsll delta_g delta_b delta_x delta_t passed_b_func_map passed_tslg passed_delta_b passed_tbl_map passed_delta_t gscope' stmtl' scope_list' g_scope_list' . -WT_state (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) +WT_state (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) (ascope,gscope,(f,stmt_stack,scope_list)::t,status) Prs_n order tslg tsll (delta_g,delta_b,delta_x,delta_t) ∧ @@ -1417,10 +1417,10 @@ frame_typ (passed_tslg,DROP 1 (HD tsll)) (order,f,delta_g,passed_delta_b,delta_x,passed_delta_t) Prs_n g_scope_list' scope_list' stmtl' ∧ -WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) +WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) order tslg delta_g delta_b delta_x delta_t Prs_n ∧ -WT_c (apply_table_f,ext_map,func_map,passed_b_func_map,pars_map,passed_tbl_map) +WT_c (apply_table_f,ext_map,func_map,passed_b_func_map,pars_map,passed_tbl_map,get_oracle_index,set_oracle_index,random_oracle) order passed_tslg delta_g passed_delta_b delta_x passed_delta_t Prs_n ⇒ @@ -1497,15 +1497,15 @@ CASE_TAC >| [ val WT_state_of_copyout = prove ( “ -∀ funn funn' frame_list h stmt_stack' scope_list'' apply_table_f ext_map func_map b_func_map pars_map tbl_map gscope +∀ funn funn' frame_list h stmt_stack' scope_list'' apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle gscope stmt_stack scope_list t Prs_n order tslg delta_g delta_b delta_x b_func_map' delta_t passed_tslg passed_delta_b passed_tbl_map passed_delta_t gscope' scope_list'. WT_c - (apply_table_f,ext_map,func_map,b_func_map',pars_map,passed_tbl_map) + (apply_table_f,ext_map,func_map,b_func_map',pars_map,passed_tbl_map,get_oracle_index,set_oracle_index,random_oracle) order passed_tslg delta_g passed_delta_b delta_x passed_delta_t Prs_n ∧ - WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) order + WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) order tslg delta_g delta_b delta_x delta_t Prs_n ∧ type_frame_tsl scope_list'' (HD t) ∧ type_scopes_list gscope tslg ∧ @@ -1747,8 +1747,8 @@ val stmt_case_ret_stat_typed = prove (“ val stmt_case_ext_stat_typed = prove (“ ∀ascope ascope' gscope scopest scopest' t_scope_list t_scope_list_g order delta_g delta_b delta_t delta_x f Prs_n v tau txdl apply_table_f - ext_map func_map b_func_map pars_map tbl_map ext_fun. - WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) order + ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ext_fun. + WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n ∧ frame_typ (t_scope_list_g,t_scope_list) (order,f,delta_g,delta_b,delta_x,delta_t) Prs_n gscope scopest @@ -1851,7 +1851,6 @@ QED Theorem status_ret_in_stmtl_typed_verbose: - ∀stmtl stmtl' ascope ascope' gscope gscope' scopest scopest' framel t_scope_list t_scope_list_g order delta_g delta_b delta_t delta_x f Prs_n c tau txdl v. @@ -1898,7 +1897,7 @@ fs[Once stmt_sem_cases] >| [ ASSUME_TAC status_ret_in_stmt_typed_verbose >> LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘h’,‘stmt_stack'’, ‘ascope’, ‘ascope'’, ‘gscope’, ‘gscope'’, ‘scopest’, ‘scopest'’, ‘framel’, ‘status_running’, ‘t_scope_list’, ‘t_scope_list_g’, ‘order’, ‘delta_g’, ‘delta_b’, ‘delta_t’, ‘delta_x’, ‘f’, ‘Prs_n’, - ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)’,‘ v’,‘tau’, ‘txdl’])) >> gvs[] >> + ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle)’,‘ v’,‘tau’, ‘txdl’])) >> gvs[] >> subgoal ‘frame_typ (t_scope_list_g,t_scope_list) (order,f,delta_g,delta_b,delta_x,delta_t) Prs_n gscope scopest @@ -2994,13 +2993,13 @@ gvs[Once frames_sem_cases] >| [ `stmtl'`,‘ascope’,‘ascope'’, ‘g_scope_list'’,‘g_scope_list''’, ‘scope_list’,‘scope_list'’, ‘new_frame’,‘status’,‘status'’, ‘HD tsll’,‘passed_tslg’, ‘order’, ‘delta_g’, ‘passed_delta_b’, ‘passed_delta_t’, ‘delta_x’, ‘funn’, - ‘Prs_n’, ‘1’, ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map'’, ‘pars_map’, ‘passed_tbl_map’])) >> gvs[] >> + ‘Prs_n’, ‘1’, ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map'’, ‘pars_map’, ‘passed_tbl_map’, ‘get_oracle_index’, ‘set_oracle_index’, ‘random_oracle’])) >> gvs[] >> gvs[] >> SIMP_TAC list_ss [WT_state_cases] >> gvs[] >> - ‘WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) + ‘WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) order tslg delta_g delta_b delta_x delta_t Prs_n’ by gvs[Once WT_state_cases] >> gvs[] >> @@ -3291,7 +3290,7 @@ gvs[Once frames_sem_cases] >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘stmt_stack’, ‘stmt_stack''’, ‘ascope’, ‘ascope'’, ‘g_scope_list'’, ‘g_scope_list'’, ‘scope_list’, ‘scope_list''’, ‘[]’, ‘status_returnv v’, ‘h’, ‘passed_tslg’, ‘order’, ‘delta_g’, ‘passed_delta_b’, ‘passed_delta_t’, ‘delta_x’, ‘funn’, ‘Prs_n’, - ‘(apply_table_f,ext_map,func_map,b_func_map',pars_map,passed_tbl_map)’])) >> + ‘(apply_table_f,ext_map,func_map,b_func_map',pars_map,passed_tbl_map,get_oracle_index,set_oracle_index,random_oracle)’])) >> gvs[ret_status_typed_def] >> gvs[frame_typ_cases] >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘tau’, ‘tau_x_d_list’])) >> gvs[] >> @@ -3341,7 +3340,7 @@ gvs[Once frames_sem_cases] >| [ `stmt_stack''`,‘ascope’,‘ascope'’, ‘g_scope_list'’,‘g_scope_list'’, ‘scope_list’,‘scope_list''’, ‘[]’,‘status_running’,‘status_returnv v’, ‘h’,‘passed_tslg’, ‘order’, ‘delta_g’, ‘passed_delta_b’, ‘passed_delta_t’, ‘delta_x’, ‘funn’, - ‘Prs_n’, ‘0’, ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map'’, ‘pars_map’, ‘passed_tbl_map’])) >> gvs[] >> + ‘Prs_n’, ‘0’, ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map'’, ‘pars_map’, ‘passed_tbl_map’,‘get_oracle_index’,‘set_oracle_index’,‘random_oracle’])) >> gvs[] >> gvs[] >> diff --git a/hol/p4_stmt_progressScript.sml b/hol/metatheory/p4_stmt_progressScript.sml similarity index 88% rename from hol/p4_stmt_progressScript.sml rename to hol/metatheory/p4_stmt_progressScript.sml index 0f9c2da2..0ad79f2d 100644 --- a/hol/p4_stmt_progressScript.sml +++ b/hol/metatheory/p4_stmt_progressScript.sml @@ -432,7 +432,6 @@ gvs[Once stmt_typ_cases] Theorem PROG_stmt: ∀ ty stmt. prog_stmt stmt ty Proof - STRIP_TAC >> Induct >> REPEAT STRIP_TAC >> @@ -445,9 +444,9 @@ REPEAT STRIP_TAC >| [ SIMP_TAC list_ss [Once stmt_sem_cases] >> gvs[] >> Cases_on `is_const e` >| [ - + gvs[is_const_val_exsist, clause_name_def, lemma_v_red_forall] >> - + gvs[Once frame_typ_cases] >> gvs[Once stmtl_typ_cases] >> gvs[type_ith_stmt_def] >> @@ -480,11 +479,17 @@ REPEAT STRIP_TAC >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`]))) >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`e`])) >> gvs[prog_exp_def] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`gscope`, ‘scopest’, ‘t_scope_list’, ‘t_scope_list_g’, - ‘t_tau tau'’, ‘b’, ‘c’, ‘order’,‘delta_g’, ‘delta_b’, ‘delta_t’, - ‘delta_x’, ‘f’, ‘Prs_n’])) >> - gvs[is_const_val_exsist] >> - srw_tac [SatisfySimps.SATISFY_ss][] + PairCases_on ‘c’ >> gvs[] >> + rename1 ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle)’ >> + gvs[is_const_val_exsist, get_ectx_def] >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + ‘∃e' framel. + e_red (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index ascope,random_oracle) gscope scopest e e' framel’ by metis_tac[] >> + PairCases_on ‘framel’ >> + metis_tac[] ] , @@ -507,22 +512,29 @@ REPEAT STRIP_TAC >| [ ‘∀e. prog_exp e ty’ by ( ASSUME_TAC PROG_e >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`]))) >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`e`])) >> + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`e`])) >> gvs[prog_exp_def] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`gscope`, ‘scopest’, ‘t_scope_list’, ‘t_scope_list_g’, - ‘t_tau tau_bool’, ‘b’, ‘c’, ‘order’,‘delta_g’, ‘delta_b’, ‘delta_t’, - ‘delta_x’, ‘f’, ‘Prs_n’])) >> - gvs[is_const_val_exsist] >> - srw_tac [SatisfySimps.SATISFY_ss][] - + PairCases_on ‘c’ >> gvs[] >> + rename1 ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle)’ >> + gvs[is_const_val_exsist, get_ectx_def] >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + ‘∃e' framel. + e_red (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index ascope,random_oracle) gscope scopest e e' framel’ by metis_tac[] >> + PairCases_on ‘framel’ >> + metis_tac[] ] , (*****************************) (* stmt_block *) (*****************************) - SIMP_TAC list_ss [Once stmt_sem_cases] >> gvs[clause_name_def] - + SIMP_TAC list_ss [Once stmt_sem_cases] >> gvs[clause_name_def] >> + PairCases_on ‘c’ >> gs[] >> + Cases_on ‘declare_list_in_fresh_scope (l,c6 ascope,c8)’ >> + gs[] , (*****************************) @@ -542,11 +554,17 @@ REPEAT STRIP_TAC >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`]))) >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`e`])) >> gvs[prog_exp_def] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`gscope`, ‘scopest’, ‘t_scope_list’, ‘t_scope_list_g’, - ‘t_tau tau'’, ‘b’, ‘c’, ‘order’,‘delta_g’, ‘delta_b’, ‘delta_t’, - ‘delta_x’, ‘f’, ‘Prs_n’])) >> - gvs[is_const_val_exsist] >> - srw_tac [SatisfySimps.SATISFY_ss][] + PairCases_on ‘c’ >> gvs[] >> + rename1 ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle)’ >> + gvs[is_const_val_exsist, get_ectx_def] >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + ‘∃e' framel. + e_red (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index ascope,random_oracle) gscope scopest e e' framel’ by metis_tac[] >> + PairCases_on ‘framel’ >> + metis_tac[] ] , @@ -559,7 +577,7 @@ REPEAT STRIP_TAC >| [ (* seq2 *) gvs[Once stmt_sem_cases, clause_name_def] >> frame_typ_into_stmt_typ_tac >> - gvs[Once stmt_sem_cases, clause_name_def] + gvs[Once stmt_sem_cases] , srw_tac [boolSimps.DNF_ss][] >> @@ -606,12 +624,12 @@ REPEAT STRIP_TAC >| [ , (* seq3 *) - DISJ2_TAC >> + DISJ2_TAC >> gvs[Once stmt_sem_cases] >> IMP_RES_TAC stmtl_len_from_in_frame_theorem >> gvs[] >> SIMP_TAC list_ss [Once stmt_sem_cases] >> gvs[] >> srw_tac [boolSimps.DNF_ss][] >> - srw_tac [SatisfySimps.SATISFY_ss][clause_name_def] + srw_tac [SatisfySimps.SATISFY_ss][clause_name_def] ] ] , @@ -637,11 +655,18 @@ REPEAT STRIP_TAC >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`]))) >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`e`])) >> gvs[prog_exp_def] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`gscope`, ‘scopest’, ‘t_scope_list’, ‘t_scope_list_g’, - ‘t_string_names_a x_list’, ‘b’, ‘c’, ‘order’,‘delta_g’, ‘delta_b’, ‘delta_t’, - ‘delta_x’, ‘f’, ‘Prs_n’])) >> - gvs[is_const_val_exsist] >> - srw_tac [SatisfySimps.SATISFY_ss][] + + PairCases_on ‘c’ >> gvs[] >> + rename1 ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle)’ >> + gvs[is_const_val_exsist, get_ectx_def] >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + ‘∃e' framel. + e_red (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index ascope,random_oracle) gscope scopest e e' framel’ by metis_tac[] >> + PairCases_on ‘framel’ >> + metis_tac[] ] , @@ -658,7 +683,8 @@ REPEAT STRIP_TAC >| [ gvs[clause_name_def] >> PairCases_on ‘c’ >> gvs[] >> - rename1 ‘(apply_table_f,c1,c2,c3,c4,tbl_map)’ >> + rename1 ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle)’ >> subgoal ‘∃ y . ALOOKUP tbl_map s = SOME y’ >- ( ‘dom_t_eq delta_t tbl_map’ by gvs[Once WT_c_cases] >> @@ -707,22 +733,29 @@ REPEAT STRIP_TAC >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`])) >> LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`(EL x (MAP (λ(e_,tau_,b_). e_) (e_tau_b_list:(e # tau # bool) list)))`])) >> fs[prog_exp_def] >> - + PairCases_on ‘c’ >> gvs[get_ectx_def] >> + rename1 ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle)’ >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`gscope`, ‘scopest’, ‘t_scope_list’, ‘t_scope_list_g’, ‘t_tau (EL x (MAP (λ(e_,tau_,b_). tau_) (e_tau_b_list : (e # tau # bool) list)))’, - ‘EL x (MAP (λ(e_,tau_,b_). b_) (e_tau_b_list : (e # tau # bool) list))’, ‘c’, + ‘EL x (MAP (λ(e_,tau_,b_). b_) (e_tau_b_list : (e # tau # bool) list))’, ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index (ascope:'a),random_oracle)’, ‘order’,‘delta_g’, ‘delta_b’, ‘delta_t’, ‘delta_x’, ‘f’, ‘Prs_n’])) >> IMP_RES_TAC index_not_const_EL >> gvs[] >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + gvs[get_ectx_def] >> - - Q.EXISTS_TAC ‘framel’ >> + Q.EXISTS_TAC ‘FST framel’ >> Q.EXISTS_TAC ‘ZIP (MAP (λ(e_,tau_,b_). e_) e_tau_b_list , LUPDATE e' x (MAP (λ(e_,tau_,b_). e_) e_tau_b_list) )’ >> + gvs[] >> + qexists_tac ‘SND framel’ >> Q.EXISTS_TAC ‘x’ >> Q.EXISTS_TAC ‘e'’ >> - srw_tac [][map_rw_doub, LENGTH_MAP, vl_of_el_ev] + srw_tac [][map_rw_doub, LENGTH_MAP, vl_of_el_ev] ] , @@ -734,7 +767,8 @@ REPEAT STRIP_TAC >| [ srw_tac [boolSimps.DNF_ss][clause_name_def] >> PairCases_on ‘c’ >> gvs[] >> - rename1 ‘(c0,ext_map,c2,c3,c4,c5)’ >> + rename1 ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle)’ >> frame_typ_into_stmt_typ_tac >> gvs[clause_name_def] >> diff --git a/hol/p4_stmt_subject_reductionScript.sml b/hol/metatheory/p4_stmt_subject_reductionScript.sml similarity index 77% rename from hol/p4_stmt_subject_reductionScript.sml rename to hol/metatheory/p4_stmt_subject_reductionScript.sml index 3956bc63..772826a0 100644 --- a/hol/p4_stmt_subject_reductionScript.sml +++ b/hol/metatheory/p4_stmt_subject_reductionScript.sml @@ -80,9 +80,9 @@ val _ = new_theory "p4_stmt_subject_reduction"; (* here in t_scopes_consistent we need the same T_e as the caller, in the state's typing it should be the passed version *) -val res_frame_typ_def = Define ‘ -res_frame_typ (order, f, (delta_g, delta_b, delta_x, delta_t)) Prs_n t_scope_list_g t_scope_list gscope framel func_map b_func_map t_scope_list_pre = -∀i. 0 <= i ∧ i < LENGTH framel ⇒ +Definition res_frame_typ_def: + res_frame_typ (order, f, (delta_g, delta_b, delta_x, delta_t)) Prs_n t_scope_list_g t_scope_list gscope framel func_map b_func_map t_scope_list_pre = + ∀i. 0 <= i ∧ i < LENGTH framel ⇒ ∃stmt_stack f_name local_scope_list passed_gscope passed_delta_b passed_delta_t passed_tslg. EL i framel = (f_name,stmt_stack,local_scope_list) ∧ order (order_elem_f f_name) (order_elem_f f) ∧ @@ -91,17 +91,18 @@ res_frame_typ (order, f, (delta_g, delta_b, delta_x, delta_t)) Prs_n t_scope_lis t_scopes_consistent (order, f, (delta_g, delta_b, delta_x, delta_t)) (t_scope_list_pre) (t_scope_list_g) (t_scope_list) ∧ frame_typ (passed_tslg,t_scope_list) (order, f_name, (delta_g, passed_delta_b, delta_x, passed_delta_t)) Prs_n passed_gscope local_scope_list stmt_stack -’; +End -val sr_stmt_def = Define ` +Definition sr_stmt_def: sr_stmt (stmt) (ty:'a itself) = -∀ stmtl ascope ascope' gscope gscope' (scopest:scope list) scopest' framel status status' t_scope_list t_scope_list_g T_e (c:'a ctx) order delta_g delta_b delta_t delta_x f Prs_n -apply_table_f ext_map func_map b_func_map pars_map tbl_map. + ∀ stmtl ascope ascope' gscope gscope' (scopest:scope list) scopest' framel status status' + t_scope_list t_scope_list_g T_e (c:'a ctx) order delta_g delta_b delta_t delta_x f Prs_n + apply_table_f ext_map func_map b_func_map pars_map tbl_map. (c = ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ) ∧ @@ -118,44 +119,46 @@ apply_table_f ext_map func_map b_func_map pars_map tbl_map. (∃ t_scope_list'' . LENGTH t_scope_list'' = (LENGTH stmtl - LENGTH [stmt]) ∧ frame_typ ( t_scope_list_g , t_scope_list''++t_scope_list ) T_e Prs_n gscope' scopest' stmtl) -`; +End -val fr_len_exp_def = Define ` -fr_len_exp (e) (ty:'a itself) = - ∀ e' gscope (scopest:scope list) framel (c:'a ctx). - e_red c gscope scopest e e' framel ⇒ - ((LENGTH framel = 1 ∧ ∃f_called stmt_called copied_in_scope. framel = [(f_called,[stmt_called],copied_in_scope)]) ∨ - (LENGTH framel = 0)) -`; +Definition fr_len_exp_def: + fr_len_exp e (ty:'a itself) = + ∀e' gscope (scopest:scope list) framel i_opt (c:'a ectx). + e_red c gscope scopest e e' (framel, i_opt) ⇒ + ((LENGTH framel = 1 ∧ ∃f_called stmt_called copied_in_scope. framel = [(f_called,[stmt_called],copied_in_scope)]) ∨ + (LENGTH framel = 0)) +End -val fr_len_exp_list_def = Define ` +Definition fr_len_exp_list_def: fr_len_exp_list (l : e list) (ty:'a itself) = - ∀(e : e). MEM e l ==> fr_len_exp (e) (ty:'a itself) -`; + ∀(e : e). MEM e l ==> fr_len_exp (e) (ty:'a itself) +End -val fr_len_strexp_list_def = Define ` - fr_len_strexp_list (l : (string#e) list) (ty:'a itself) = - ∀ (e:e) . MEM e (SND (UNZIP l)) ==> fr_len_exp(e) (ty:'a itself) -`; +Definition fr_len_strexp_list_def: + fr_len_strexp_list (l : (string#e) list) (ty:'a itself) = + ∀ (e:e) . MEM e (SND (UNZIP l)) ==> fr_len_exp(e) (ty:'a itself) +End -val fr_len_strexp_tup_def = Define ` - fr_len_strexp_tup (tup : (string#e)) (ty:'a itself) = - fr_len_exp ((SND tup)) (ty:'a itself) -`; +Definition fr_len_strexp_tup_def: + fr_len_strexp_tup (tup : (string#e)) (ty:'a itself) = + fr_len_exp ((SND tup)) (ty:'a itself) +End -fun FR_LEN_IND_CASE exp = OPEN_EXP_RED_TAC (exp) >> - gvs[] >> - METIS_TAC[] +fun FR_LEN_IND_CASE exp = + OPEN_EXP_RED_TAC (exp) >> + gvs[] >> + metis_tac[] +; (* The expression reduction can create a frame of length 1 or nothing [] *) Theorem fr_len_from_e_theorem: @@ -259,13 +262,15 @@ REPEAT STRIP_TAC >| [ QED -fun FR_LEN_STMT_IND_CASE stm = OPEN_STMT_RED_TAC stm >> - gvs[] >> - ASSUME_TAC fr_len_from_e_theorem >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`])) >> - LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`e`])) >> - fs[fr_len_exp_def] >> gvs[] >> - RES_TAC >> gvs[] +fun FR_LEN_STMT_IND_CASE stm = + OPEN_STMT_RED_TAC stm >> + gvs[] >> + ASSUME_TAC fr_len_from_e_theorem >> + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`])) >> + LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`e`])) >> + fs[fr_len_exp_def] >> gvs[] >> + RES_TAC >> gvs[] +; (* the statement reduction can create a framel of length 1 or 0 *) Theorem fr_len_from_a_frame_theorem: @@ -292,13 +297,6 @@ STRIP_TAC >| [ RES_TAC >> gvs[] , - (*FR_LEN_STMT_IND_CASE “stmt_verify e e0” >> - gvs[] >> - ASSUME_TAC fr_len_from_e_theorem >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`])) >> - fs[fr_len_exp_def] >> gvs[] >> - RES_TAC >> gvs[] - ,*) FR_LEN_STMT_IND_CASE “stmt_trans e” , OPEN_STMT_RED_TAC “stmt_app s l” >> @@ -395,12 +393,14 @@ fun ASSUME_SR_EXP_FOR e = ASSUME_TAC SR_e >> PAT_ASSUM ``∀e. sr_exp e ty`` ( STRIP_ASSUME_TAC o (Q.SPECL [e])) >> fs[sr_exp_def] - +(* +(‘e''’,‘(t_tau tau')’,‘b’) +*) fun INST_SR_EXP_FOR (e', tau, b) = FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [e', ‘gscope’, ‘scopest’, - ‘[(f_called,[stmt_called],copied_in_scope)]’, ‘t_scope_list’, ‘t_scope_list_g’, + ‘[(f_called,[stmt_called],copied_in_scope)]’, ‘i_opt’, ‘t_scope_list’, ‘t_scope_list_g’, tau,b, ‘order’,‘delta_g’,‘delta_b’, ‘delta_t’,‘delta_x’,‘f’,‘f_called’, ‘stmt_called’,‘copied_in_scope’, ‘Prs_n’ ,‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, - ‘pars_map’, ‘tbl_map’])) >> + ‘pars_map’, ‘tbl_map'’, ‘get_oracle_index ascope’, ‘random_oracle’])) >> gvs[] @@ -427,22 +427,24 @@ REPEAT STRIP_TAC >| [ , (** assignment case **) (* we know that the length of the frame framel is either 0 or one from :*) - IMP_RES_TAC fr_len_from_a_frame_theorem >|[ + IMP_RES_TAC fr_len_from_a_frame_theorem >| [ (* if 1, then we also know that e made a reduction*) OPEN_ANY_STMT_RED_TAC >> - gvs[] >> + gvs[get_ectx_def] >> (* we also know that e is well typed from frame typ *) - EXP_IS_WT_IN_FRAME_TAC “[stmt_ass l e]” >> + EXP_IS_WT_IN_FRAME_TAC “[stmt_ass l e]” >> (* from sr we know that this frame is well typed, we need to know the typing scope for the body *) ASSUME_SR_EXP_FOR ‘e’ >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> INST_SR_EXP_FOR (‘e''’,‘(t_tau tau')’,‘b’) >> gvs[type_frame_tsl_def] >> qexistsl_tac [‘t_scope_list_fr’] >> - drule frame_typ_imp_res_frame_single >> gvs[] + drule frame_typ_imp_res_frame_single >> gvs[] , fs[res_frame_typ_def] ] @@ -457,7 +459,9 @@ REPEAT STRIP_TAC >| [ ASSUME_SR_EXP_FOR ‘e’ >> INST_SR_EXP_FOR (‘e''’,‘(t_tau tau_bool)’,‘b’) >> - gvs[type_frame_tsl_def] >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + gvs[type_frame_tsl_def, get_ectx_def] >> qexistsl_tac [‘t_scope_list_fr’] >> drule frame_typ_imp_res_frame_single >> gvs[] @@ -478,7 +482,9 @@ REPEAT STRIP_TAC >| [ ASSUME_SR_EXP_FOR ‘e’ >> INST_SR_EXP_FOR (‘e''’,‘(t_tau tau')’,‘b’) >> - gvs[type_frame_tsl_def] >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + gvs[type_frame_tsl_def, get_ectx_def] >> qexistsl_tac [‘t_scope_list_fr’] >> drule frame_typ_imp_res_frame_single >> gvs[] @@ -491,14 +497,6 @@ REPEAT STRIP_TAC >| [ IMP_RES_TAC fr_len_from_a_frame_theorem >| [ OPEN_ANY_STMT_RED_TAC >> gvs[] >> - - (* use IH *) - LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘stmt_stack' ⧺ [stmt1']’, ‘ascope’, ‘ascope'’, ‘gscope’, ‘gscope'’, - ‘scopest’, ‘scopest'’,‘[(f_called,[stmt_called],copied_in_scope)]’,‘status_running’, - ‘status_running’,‘t_scope_list’,‘t_scope_list_g’, ‘order’,‘delta_g’,‘delta_b’, - ‘delta_t’,‘delta_x’,‘f’,‘Prs_n’])) >> gvs[] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) >> gvs[] >> - (* we know that [stmt] is well typed from frame_typ*) subgoal ‘frame_typ (t_scope_list_g,t_scope_list) @@ -517,9 +515,10 @@ REPEAT STRIP_TAC >| [ REPEAT STRIP_TAC >> ‘i=0’ by fs[] >> fs[Once EL] ) >> - + + qpat_x_assum ‘!stmtl'. _’ (fn thm => irule thm) >> gvs[] >> - srw_tac [SatisfySimps.SATISFY_ss][] + metis_tac[] , fs[res_frame_typ_def] ] @@ -528,21 +527,23 @@ REPEAT STRIP_TAC >| [ (** statement trans **) IMP_RES_TAC fr_len_from_a_frame_theorem >| [ OPEN_ANY_STMT_RED_TAC >> gvs[] >> - EXP_IS_WT_IN_FRAME_TAC “[stmt_trans e]” >> + EXP_IS_WT_IN_FRAME_TAC “[stmt_trans e]” >> ASSUME_SR_EXP_FOR ‘e’ >> INST_SR_EXP_FOR (‘e''’,‘t_string_names_a x_list’,‘b’) >> - gvs[type_frame_tsl_def] >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + gvs[type_frame_tsl_def, get_ectx_def] >> qexistsl_tac [‘t_scope_list_fr’] >> - drule frame_typ_imp_res_frame_single >> gvs[] + drule frame_typ_imp_res_frame_single >> gvs[] , - fs[res_frame_typ_def] + fs[res_frame_typ_def] ] , (* statement apply s l *) IMP_RES_TAC fr_len_from_a_frame_theorem >| [ OPEN_ANY_STMT_RED_TAC >> gvs[] >> - EXP_IS_WT_IN_FRAME_TAC “[stmt_app s l]” >> + EXP_IS_WT_IN_FRAME_TAC “[stmt_app s l]” >> (* we know that i is indeed less than the list *) subgoal ‘i < LENGTH e_tau_b_list’ >- ( @@ -555,14 +556,16 @@ REPEAT STRIP_TAC >| [ ASSUME_SR_EXP_FOR ‘(EL i (MAP (λ(e_,e'_). e_) (e_e'_list : (e # e) list)))’ >> INST_SR_EXP_FOR (‘e'’,‘(t_tau (EL i (MAP (λ(e_,tau_,b_). tau_) (e_tau_b_list: (e # tau # bool) list))))’, ‘(EL i (MAP (λ(e_,tau_,b_). b_) (e_tau_b_list : (e # tau # bool) list)))’) >> - gvs[type_frame_tsl_def] >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + gvs[type_frame_tsl_def, get_ectx_def] >> qexistsl_tac [‘t_scope_list_fr’] >> - drule frame_typ_imp_res_frame_single >> gvs[] + drule frame_typ_imp_res_frame_single >> gvs[] , fs[res_frame_typ_def] ] , -(* statement extern would never create a frame *) + (* statement extern would never create a frame *) OPEN_ANY_STMT_RED_TAC >> gvs[] >> fs[res_frame_typ_def] @@ -572,16 +575,9 @@ REPEAT STRIP_TAC >| [ -(* -EVAL “declare_list_in_fresh_scope [(varn_name "x",tau_bot)]” -EVAL “ type_scopes_list [[(varn_name "x",v_bot,NONE)]] [[(varn_name "x",tau_bot)]] ” -*) - - - -val tsl_singletone_exsists = prove (“ +val tsl_singletone_exists = prove (“ ∀ scopest ts . type_scopes_list scopest [ts] ⇒ (LENGTH scopest = 1 ∧ ∃ sc . scopest = [sc] ∧ @@ -780,11 +776,11 @@ gvs[mk_varn_def] val typ_scope_list_ext_out_scope_lemma = prove ( - “ ∀ f apply_table_f ext_map func_map b_func_map pars_map tbl_map + “ ∀ f apply_table_f ext_map func_map b_func_map pars_map tbl_map set_oracle_index get_oracle_index random_oracle order tslg delta_g delta_b delta_x ascope ascope' gscope scopest scopest' v ext_fun tsl tau txdl delta_t Prs_n. -WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) +WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,get_oracle_index,set_oracle_index,random_oracle) order tslg delta_g delta_b delta_x delta_t Prs_n ∧ SOME (txdl,tau) = t_lookup_funn f delta_g delta_b delta_x ∧ args_t_same (MAP FST txdl) tsl ∧ @@ -822,51 +818,8 @@ STRIP_TAC >| [ Cases_on ‘ext_fun (ascope,gscope,scopest)’ >> gvs[] >> (* the output scope sc is only of length 1*) - IMP_RES_TAC tsl_singletone_exsists >> - gvs[] - -(* - (* show that txdl and txdl ' are the same *) - IMP_RES_TAC t_lookup_funn_ext_lemma >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`delta_g`, `delta_b`])) >> - gvs[] >> - Cases_on ‘t_lookup_funn (funn_inst s) delta_g delta_b delta_x’ >> gvs[] >> - - (* we know that the scopest (initial one) must be of size 1 *) - IMP_RES_TAC ext_sc_same_as_input_LENGTH >> - (*‘LENGTH scopest = 1’ by gvs[] >> - ‘∃ outsc. scopest = [outsc]’ by fs[quantHeuristicsTheory.LIST_LENGTH_1] >> - - (* same for the typing scope*) - ‘LENGTH tsl = 1’ by (IMP_RES_TAC type_scopes_list_LENGTH >> gvs[]) >> - ‘∃ tsc. tsl = [tsc]’ by fs[quantHeuristicsTheory.LIST_LENGTH_1] >> - gvs[] >> - *) - - fs[args_t_same_def, same_dir_x_def] >> - gvs[mk_tscope_def] >> - srw_tac [] [] >> - - (* we know that ts contains the same types as the input*) - subgoal ‘ [tsc] = [ZIP (MAP FST tsc ,ZIP(MAP (λ(t,x,d). t) txdl, MAP (λtxd. lol) txdl ))]’ >- - ( gvs[ELIM_UNCURRY, map_fst_EQ ] >> - - ASSUME_TAC LOL_ext_sc_same_as_input >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘sc’, ‘outsc’, - ‘ZIP (mk_varn (MAP (λx. FST (SND x)) (txdl : (tau # string # d) list)), - ZIP (MAP FST (txdl : (tau # string # d) list), - MAP (λtxd. lol) txdl ))’, - ‘tsc’, ‘MAP (λtxd. lol) (txdl : (tau # string # d) list)’])) >> - gvs[] >> - METIS_TAC [ZIP_tri_id1, map_lemma_local_tmp ] - ) >> - - IMP_RES_TAC typ_ext_out_scope_lemma >> - rfs[] >> - - LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`MAP FST (tsc : (varn # tau) list)`])) >> - srw_tac [][] >> - METIS_TAC [] *) + IMP_RES_TAC tsl_singletone_exists >> + gvs[] , (*ext methods *) @@ -885,51 +838,7 @@ STRIP_TAC >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ascope`, `gscope`, ‘scopest’])) >> gvs[] >> - Cases_on ‘ext_fun (ascope,gscope,scopest)’ >> gvs[] -(* - IMP_RES_TAC tsl_singletone_exsists >> - gvs[] >> - - IMP_RES_TAC t_lookup_funn_ext_lemma >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`delta_g`, `delta_b`])) >> - gvs[] >> - Cases_on ‘t_lookup_funn (funn_ext s s0) delta_g delta_b delta_x’ >> gvs[] >> - - (* we know that the scopest (initial one) must be of size 1 *) - IMP_RES_TAC ext_sc_same_as_input_LENGTH >> - ‘LENGTH scopest = 1’ by gvs[] >> - ‘∃ outsc. scopest = [outsc]’ by fs[quantHeuristicsTheory.LIST_LENGTH_1] >> - - (* same for the typing scope*) - ‘LENGTH tsl = 1’ by (IMP_RES_TAC type_scopes_list_LENGTH >> gvs[]) >> - ‘∃ tsc. tsl = [tsc]’ by fs[quantHeuristicsTheory.LIST_LENGTH_1] >> - gvs[] >> - - - fs[args_t_same_def, same_dir_x_def] >> - gvs[mk_tscope_def] >> - srw_tac [] [] >> - - (* we know that ts contains the same types as the input*) - subgoal ‘ [tsc] = [ZIP (MAP FST tsc ,ZIP(MAP (λ(t,x,d). t) txdl, MAP (λtxd. lol) txdl ))]’ >- - ( gvs[ELIM_UNCURRY, map_fst_EQ ] >> - - ASSUME_TAC LOL_ext_sc_same_as_input >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘sc’, ‘outsc’, - ‘ZIP (mk_varn (MAP (λx. FST (SND x)) (txdl : (tau # string # d) list)), - ZIP (MAP FST (txdl : (tau # string # d) list), - MAP (λtxd. lol) txdl))’, - ‘tsc’, ‘MAP (λtxd. lol) (txdl : (tau # string # d) list)’])) >> - gvs[] >> - METIS_TAC [ZIP_tri_id1, map_lemma_local_tmp ] - ) >> - - IMP_RES_TAC typ_ext_out_scope_lemma >> - rfs[] >> - - LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`MAP FST (tsc : (varn # tau) list)`])) >> - srw_tac [][] >> - METIS_TAC [] *) + Cases_on ‘ext_fun (ascope,gscope,scopest)’ >> gvs[] ] ); @@ -2917,10 +2826,13 @@ RES_TAC -fun INST_SR2_EXP_FOR (e', tau, b, frl) = PairCases_on ‘c’ >> rename1 ‘WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)’ >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [e', ‘gscope’, ‘scopest’, frl, ‘tsl’, ‘tslg’, tau, b, +fun INST_SR2_EXP_FOR (e', tau, b, frl) = +(* +PairCases_on ‘c’ >> rename1 ‘WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)’ >> +*) + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [e', ‘gscope’, ‘scopest’, frl, ‘i_opt’, ‘tsl’, ‘tslg’, tau, b, ‘order’,‘delta_g’,‘delta_b’, ‘delta_t’,‘delta_x’,‘f’,‘f_called’,‘stmt_called’,‘copied_in_scope’])) >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘Prs_n’, ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) >> gvs[] + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘Prs_n’, ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’, ‘get_oracle_index ascope’, ‘random_oracle’])) >> gvs[] val stmt_to_stmt_single = prove (“ @@ -2932,7 +2844,6 @@ val stmt_to_stmt_single = prove (“ type_scopes_list scopest tsl ∧ type_scopes_list gscope tslg ∧ star_not_in_sl scopest ∧ - (*parseError_in_gs tslg [tsl] ∧*) SOME (txdl,tau) = t_lookup_funn f delta_g delta_b delta_x ∧ args_t_same (MAP FST txdl) tsl ∧ @@ -2988,9 +2899,11 @@ STRIP_TAC >| [ (* SR_e case*) SIMP_TAC list_ss [Once stmt_typ_cases] >> - gvs[Once stmt_typ_cases, clause_name_def] >> + gvs[Once stmt_typ_cases, clause_name_def, get_ectx_def] >> rfs[type_frame_tsl_def] >> ASSUME_SR_EXP_FOR ‘e’ >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> INST_SR2_EXP_FOR (‘e''’, ‘t_tau tau'’, ‘b’, ‘framel’) >> srw_tac [SatisfySimps.SATISFY_ss][] ] @@ -3001,7 +2914,7 @@ STRIP_TAC >| [ (* stmt_cond *) (*****************************) -(* remove the induction hypothesis *) +(* remove the induction hypotheses *) schneiderUtils.POP_NO_TAC 9 >> schneiderUtils.POP_NO_TAC 8 >> @@ -3022,10 +2935,12 @@ STRIP_TAC >| [ , SIMP_TAC list_ss [Once stmt_typ_cases] >> gvs[Once stmt_typ_cases, clause_name_def] >> - rfs[type_frame_tsl_def] >> + rfs[type_frame_tsl_def, get_ectx_def] >> ASSUME_SR_EXP_FOR ‘e’ >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> INST_SR2_EXP_FOR (‘e''’, ‘t_tau tau_bool’, ‘b’, ‘framel’) >> - srw_tac [SatisfySimps.SATISFY_ss][] + srw_tac [SatisfySimps.SATISFY_ss][] ] , @@ -3050,14 +2965,16 @@ STRIP_TAC >| [ fs[clause_name_def] >> OPEN_STMT_RED_TAC “stmt_ret e” >> - gvs[] >> + gvs[get_ectx_def] >> (* when a single block return e , then use the SR_e *) SIMP_TAC list_ss [Once stmt_typ_cases] >> gvs[clause_name_def] >> ASSUME_SR_EXP_FOR ‘e’ >> - INST_SR2_EXP_FOR (‘e''’, ‘t_tau tau'’, ‘b’, ‘[(f_called,[stmt_called],copied_in_scope)]’) >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + INST_SR2_EXP_FOR (‘e''’, ‘t_tau tau'’, ‘b’, ‘[(f_called,[stmt_called],copied_in_scope)]’) >> gvs[type_frame_tsl_def] >> srw_tac [SatisfySimps.SATISFY_ss][] , @@ -3069,7 +2986,7 @@ STRIP_TAC >| [ fs[clause_name_def] >> OPEN_STMT_RED_TAC “stmt_ret e” >> - gvs[] >> + gvs[get_ectx_def] >> SIMP_TAC list_ss [Once stmt_typ_cases] >> gvs[clause_name_def] >> @@ -3077,6 +2994,8 @@ STRIP_TAC >| [ (* for just a reduction from e to e'' *) ASSUME_SR_EXP_FOR ‘e’ >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> INST_SR2_EXP_FOR (‘e''’, ‘t_tau tau'’, ‘b’, ‘[]’) >> gvs[type_frame_tsl_def] >> @@ -3126,13 +3045,15 @@ STRIP_TAC >| [ fs[clause_name_def] >> OPEN_STMT_RED_TAC “stmt_trans e” >> - gvs[] >> + gvs[get_ectx_def] >> SIMP_TAC list_ss [Once stmt_typ_cases] >> gvs[clause_name_def] >> fs[type_frame_tsl_def] >> ASSUME_SR_EXP_FOR ‘e’ >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> INST_SR2_EXP_FOR (‘e''’, ‘t_string_names_a x_list’, ‘b’, ‘[(f_called,[stmt_called],copied_in_scope)]’) >> gvs[] >> srw_tac [SatisfySimps.SATISFY_ss][] @@ -3142,7 +3063,7 @@ STRIP_TAC >| [ fs[clause_name_def] >> OPEN_STMT_RED_TAC “stmt_trans e” >> - gvs[] >> + gvs[get_ectx_def] >> SIMP_TAC list_ss [Once stmt_typ_cases] >> @@ -3150,6 +3071,8 @@ STRIP_TAC >| [ fs[type_frame_tsl_def] >> ASSUME_SR_EXP_FOR ‘e’ >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> INST_SR2_EXP_FOR (‘e''’, ‘t_string_names_a x_list’, ‘b’, ‘[]’) >> gvs[] >> srw_tac [SatisfySimps.SATISFY_ss][] @@ -3160,13 +3083,12 @@ STRIP_TAC >| [ (* stmt_app *) (*****************************) - IMP_RES_TAC fr_len_from_a_frame_theorem >| [ OPEN_STMT_TYP_TAC “stmt_app s l” >> fs[clause_name_def] >> OPEN_STMT_RED_TAC “stmt_app s l” >> - gvs[] >> + gvs[get_ectx_def] >> (*when all the args are not fully reduced, there might be a chance to create a framel *) @@ -3174,17 +3096,16 @@ STRIP_TAC >| [ gvs[clause_name_def] >> fs[type_frame_tsl_def] >> IMP_RES_TAC index_not_const_in_range >> - - - PairCases_on ‘c’ >> rename1 ‘WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)’ >> - + (* now we need to know what e has been updated, in order to ensure that it is well typed. *) - ASSUME_SR_EXP_FOR ‘(EL i (MAP (λ(e_,e'_). e_) (e_e'_list : (e # e) list)))’ >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`e'`, ‘gscope’, ‘scopest’, ‘[(f_called,[stmt_called],copied_in_scope)]’, ‘tsl’, + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + ASSUME_SR_EXP_FOR ‘(EL i (MAP (λ(e_,e'_). e_) (e_e'_list : (e # e) list)))’ >> + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`e'`, ‘gscope’, ‘scopest’, ‘[(f_called,[stmt_called],copied_in_scope)]’, ‘i_opt’, ‘tsl’, ‘tslg’, ‘ (t_tau (EL i (MAP (λ(e_,tau_,b_). tau_) (e_tau_b_list: (e # tau # bool) list))))’, ‘(EL i (MAP (λ(e_,tau_,b_). b_) (e_tau_b_list : (e # tau # bool) list)))’,‘order’,‘delta_g’,‘delta_b’, ‘delta_t’, ‘delta_x’,‘f’,‘f_called’,‘stmt_called’,‘copied_in_scope’])) >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘Prs_n’ ,‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) >> gvs[] >> + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘Prs_n’ ,‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’, ‘get_oracle_index ascope’, ‘random_oracle’])) >> gvs[] >> gvs[] >> @@ -3221,7 +3142,7 @@ STRIP_TAC >| [ fs[clause_name_def] >> OPEN_STMT_RED_TAC “stmt_app s l” >> - gvs[] >| [ + gvs[get_ectx_def] >| [ SIMP_TAC list_ss [Once stmt_typ_cases] >> gvs[clause_name_def] >> @@ -3285,7 +3206,6 @@ STRIP_TAC >| [ gvs[clause_name_def] >> fs[type_frame_tsl_def] >> - PairCases_on ‘c’ >> rename1 ‘WT_c (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)’ >> subgoal ‘ e_typ (tslg,tsl) (order,f,delta_g,delta_b,delta_x,delta_t) (EL i (MAP (λ(e_,e'_). e_) e_e'_list)) (t_tau (EL i (MAP (λ(e_,tau_,b_). tau_) e_tau_b_list))) @@ -3309,11 +3229,13 @@ STRIP_TAC >| [ LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`(EL i (MAP (λ(e_,tau_,b_). e_) (e_tau_b_list:(e # tau # bool) list)))`])) >> fs[sr_exp_def] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`e'`, ‘gscope’, ‘scopest’, ‘[]’, ‘tsl’, ‘tslg’, + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`e'`, ‘gscope’, ‘scopest’, ‘[]’, ‘i_opt’, ‘tsl’, ‘tslg’, ‘ (t_tau (EL i (MAP (λ(e_,tau_,b_). tau_) (e_tau_b_list: (e # tau # bool) list))))’, ‘(EL i (MAP (λ(e_,tau_,b_). b_) (e_tau_b_list : (e # tau # bool) list)))’, ‘order’,‘delta_g’,‘delta_b’, ‘delta_t’,‘delta_x’,‘f’,‘f_called’,‘stmt_called’,‘copied_in_scope’])) >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘Prs_n’, ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) >> gvs[] >> + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘Prs_n’, ‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’, ‘get_oracle_index ascope’, ‘random_oracle’])) >> gvs[] >> + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> gvs[] >> gvs[] >> @@ -3337,16 +3259,22 @@ STRIP_TAC >| [ (*****************************) (* stmt_ext *) (*****************************) - + PairCases_on ‘c’ >> + rename1 ‘WT_c + (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle) order tslg + delta_g delta_b delta_x delta_t Prs_n’ >> fs[Once stmt_sem_cases] >> SIMP_TAC list_ss [Once stmt_typ_cases] >> gvs[clause_name_def, type_frame_tsl_def] >> fs[Once stmt_typ_cases] >> ASSUME_TAC typ_scope_list_ext_out_scope_lemma >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL - [`f`, `apply_table_f`, ‘ext_map’,‘func_map’,‘b_func_map’,‘pars_map’,‘tbl_map’,‘order’,‘tslg’,‘delta_g’,‘delta_b’,‘delta_x’, + [`f`, `apply_table_f`, ‘ext_map’,‘func_map’,‘b_func_map’,‘pars_map’,‘tbl_map’,‘set_oracle_index’,‘get_oracle_index’, ‘random_oracle’, ‘order’,‘tslg’,‘delta_g’,‘delta_b’,‘delta_x’, ‘ascope’,‘ascope'’,‘gscope’,‘scopest’,‘scopest'’,‘status'’,‘ext_fun’,‘tsl’,‘tau’,‘txdl’, ‘delta_t’, ‘Prs_n’])) >> - gvs[] + imp_res_tac $ GEN_ALL $ fst $ EQ_IMP_RULE $ SPEC_ALL WT_c_ec >> + qpat_x_assum ‘!oracle_index. _’ (fn thm => assume_tac $ Q.SPEC ‘get_oracle_index ascope’ thm) >> + gvs[] ] ); @@ -3355,7 +3283,7 @@ STRIP_TAC >| [ - + Theorem stmtl_len_from_in_frame_theorem: ∀ stmt stmtl ascope ascope' gscope gscope' scopest scopest' f c status status' framel. (stmt_red c ( ascope , gscope , [ (f, [stmt], scopest )] , status) @@ -3402,154 +3330,645 @@ REPEAT STRIP_TAC >| [ -val arb_from_tau_typed_def = Define ` - arb_from_tau_typed (t) (ty:'a itself) = - v_typ (arb_from_tau t) (t_tau t) F -`; - +Definition init_from_tau_typed_def: + init_from_tau_typed t (ty:'a itself) = + !random_oracle i. + v_typ (FST $ init_from_tau random_oracle i t) (t_tau t) F +End -val arb_stl_from_tau_typed_def = Define ` - arb_stl_from_tau_typed l (ty:'a itself) = - !(st : (string# tau)). MEM st l ==> arb_from_tau_typed (SND st) (ty:'a itself) -`; - - - -val arb_st_tup_from_tau_typed_def = Define ` - arb_st_tup_from_tau_typed st_tup (ty:'a itself) = - arb_from_tau_typed (SND st_tup) (ty:'a itself) -`; +Definition init_stl_from_tau_typed_def: + init_stl_from_tau_typed l (ty:'a itself) = + !st:(string#tau). MEM st l ==> init_from_tau_typed (SND st) (ty:'a itself) +End + +Definition init_st_tup_from_tau_typed_def: + init_st_tup_from_tau_typed st_tup (ty:'a itself) = + init_from_tau_typed (SND st_tup) (ty:'a itself) +End - -val arb_EL_lemma = prove (“ -∀ i l . -i < LENGTH l ⇒ - ( arb_from_tau (SND (EL i l)) = EL i (MAP (λ(x,tau). arb_from_tau tau) l)) ∧ - (t_tau (SND (EL i l)) = t_tau (EL i (MAP SND l))) ”, + +Theorem init_EL_lemma[local]: +!i l random_oracle i'. +i < LENGTH l ==> + ( FST $ init_from_tau random_oracle i' (SND (EL i l)) = EL i (MAP (λ(x,tau). FST $ init_from_tau random_oracle i' tau) l)) /\ + (t_tau (SND (EL i l)) = t_tau (EL i (MAP SND l))) +Proof Induct_on ‘l’ >> Induct_on ‘i’ >> gvs[] >| [ - STRIP_TAC >> PairCases_on ‘h’ >> gvs[] + rpt strip_tac >> PairCases_on ‘h’ >> gvs[] , - STRIP_TAC >> gvs[EL_MAP] + strip_tac >> gvs[EL_MAP] ] -); +QED + +Theorem FOLDL_init_from_tau_SNOC[local]: +!t t' random_oracle h' r. +FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) (SNOC h' t',r) t) = +SNOC h' (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) (t',r) t)) +Proof +Induct >> ( + rpt strip_tac >> + gs[FOLDL] +) >> +PairCases_on ‘h’ >> +gvs[] >> +Cases_on ‘init_from_tau random_oracle r h1’ >> gs[] >> +qpat_assum ‘!random_oracle h'. _’ (fn thm => REWRITE_TAC[GSYM thm]) >> +gs[] +QED +Theorem FOLDL_init_from_tau_SNOC_tup[local]: +!t t' random_oracle h' r. +FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). ((x,v)::l,i'')) + (init_from_tau random_oracle i' tau)) (SNOC h' t',r) t) = +SNOC h' (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). ((x,v)::l,i'')) + (init_from_tau random_oracle i' tau)) (t',r) t)) +Proof +Induct >> ( + rpt strip_tac >> + gs[FOLDL] +) >> +PairCases_on ‘h’ >> +gvs[] >> +Cases_on ‘init_from_tau random_oracle r h1’ >> gs[] >> +qpat_assum ‘!random_oracle h'. _’ (fn thm => REWRITE_TAC[GSYM thm]) >> +gs[] +QED +(* TODO: Generalise *) +Theorem FOLDL_init_from_tau_APPEND[local]: +!t random_oracle q r. +FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([q],r) t) = +FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([],r) t) ++ [q] +Proof +Induct >> ( + rpt strip_tac >> + gs[FOLDL] +) >> +PairCases_on ‘h’ >> +gvs[] >> +Cases_on ‘init_from_tau random_oracle r h1’ >> gs[] >> +‘!l. l ++ [q'; q] = (SNOC q' l) ++ [q]’ by gs[] >> +ASM_REWRITE_TAC[] >> +REWRITE_TAC[GSYM FOLDL_init_from_tau_SNOC] >> +REWRITE_TAC[SNOC] >> +‘!l. l ++ [q] = (SNOC q l)’ by gs[] >> +qpat_assum ‘!l. l ++ [q] = (SNOC q l)’ (fn thm => REWRITE_TAC[thm]) >> +REWRITE_TAC[GSYM FOLDL_init_from_tau_SNOC] >> +REWRITE_TAC[SNOC] +QED +(* L-folding using init_from_tau preserves LENGTH *) +(* TODO: Generalise *) +Theorem FOLDL_init_from_tau_LENGTH[local]: +!t random_oracle q r xl vl r'. + LENGTH $ FST $ FOLDL + (λ(x_v_l,i') (x,tau). + (λ(v,i''). (v::x_v_l,i'')) + (init_from_tau random_oracle i' tau)) ([q],r) t = SUC $ LENGTH t +Proof +Induct >> ( + gs[] +) >> +rpt strip_tac >> +PairCases_on ‘h’ >> +gs[] >> +Cases_on ‘init_from_tau random_oracle r h1’ >> +gs[] >> +REWRITE_TAC[GSYM SNOC] >> +REWRITE_TAC[Once FOLDL_init_from_tau_SNOC] >> +gs[LENGTH_SNOC] +QED +(* Every entry of the list of initial values is a value + * initialised by init_from_tau, for some oracle index *) +Theorem FOLDL_init_from_tau_oracle_index[local]: +!t random_oracle i r. + i < LENGTH t ==> + ?j. + EL i + (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([],r) t))) = + FST (init_from_tau random_oracle j (EL i (MAP SND t))) +Proof +Induct >> ( + gs[] +) >> +rpt strip_tac >> +PairCases_on ‘h’ >> +gs[] >> +Cases_on ‘init_from_tau random_oracle r h1’ >> +gs[] >> +REWRITE_TAC[GSYM SNOC] >> +REWRITE_TAC[Once FOLDL_init_from_tau_SNOC] >> +gs[REVERSE_SNOC] >> +Cases_on ‘i’ >- ( + gs[] >> + qexists_tac ‘r’ >> + gs[] +) >> +gs[] +QED +Theorem FOLDL_init_from_tau_MAP_SND[local]: +!t random_oracle q h0 r xl vl r'. +FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) (init_from_tau random_oracle i' tau)) + ([q],r) t) = + MAP SND + (FST + (FOLDL + (λ(x_v_l,i') (x,tau). + (λ(v,i''). ((x,v)::x_v_l,i'')) + (init_from_tau random_oracle i' tau)) ([(h0,q)],r) t)) +Proof +Induct >> ( + gs[] +) >> +rpt strip_tac >> +PairCases_on ‘h’ >> +gs[] >> +Cases_on ‘init_from_tau random_oracle r h1’ >> +gs[] >> +REWRITE_TAC[GSYM SNOC] >> +REWRITE_TAC[Once FOLDL_init_from_tau_SNOC_tup] >> +gs[SNOC] >> +qpat_assum ‘!random_oracle q. _’ (fn thm => REWRITE_TAC[GSYM thm]) >> +REWRITE_TAC[GSYM SNOC_APPEND] >> +REWRITE_TAC[GSYM FOLDL_init_from_tau_SNOC] >> +gs[] +QED - -Theorem arb_from_tau_is_typed: -! (ty:'a itself) . - ( ∀ t . arb_from_tau_typed t ty ) ∧ - ( ∀ l. arb_stl_from_tau_typed l ty) ∧ - ( ∀ (st: (string#tau)) . arb_st_tup_from_tau_typed st ty) +(* TODO: Move *) +Theorem ZIP_FRONT: +∀l1 l2. +l1 ≠ [] ∧ l2 ≠ [] ⇒ +FRONT (ZIP (l1,l2)) = + ZIP (FRONT l1,FRONT l2) Proof +Induct_on ‘l1’ >> Induct_on ‘l2’ >> gs[] >> +rpt strip_tac >> +Cases_on ‘l2’ >> gs[ZIP_def] >> +Cases_on ‘l1’ >> gs[ZIP_def] >> +qpat_x_assum ‘!l2. _’ (fn thm => assume_tac $ Q.SPECL [‘h''::t’] thm) >> +gs[] +QED -STRIP_TAC >> -Induct >~ [‘∀s. arb_from_tau_typed (tau_xtl s l) ty’] >- ( - STRIP_TAC >> - gvs[arb_from_tau_typed_def] >> +(* TODO: Move *) +Theorem ZIP_LAST: +∀l a b l1 l2. +LENGTH l1 = LENGTH l2 ⇒ +l ++ [(a,b)] = ZIP(l1,l2) ⇒ LAST l1 = a +Proof +Induct >> ( + rpt strip_tac >> + gs[] >> + Cases_on ‘l1’ >> Cases_on ‘l2’ >> gvs[ZIP_def, LAST_DEF] +) >- ( + Cases_on ‘t’ >> Cases_on ‘t'’ >> gs[ZIP_def] +) >> +res_tac >> +gs[] >> +Cases_on ‘t’ >> gs[ZIP_def] +QED + +(* L-folding using init_from_tau preserves the IDs as the first + * list elements *) +(* TODO: Generalise *) +Theorem FOLDL_init_from_tau_identifiers[local]: +!t random_oracle h0 q r xl vl r'. + LENGTH xl = LENGTH vl ==> + FOLDL + (λ(x_v_l,i') (x,tau). + (λ(v,i''). ((x,v)::x_v_l,i'')) + (init_from_tau random_oracle i' tau)) ([(h0,q)],r) t = + (ZIP (xl,vl),r') ==> +xl = REVERSE (h0::MAP FST t) +Proof +Induct >> ( + gs[] >> + rpt strip_tac +) >- ( + Cases_on ‘xl’ >> Cases_on ‘vl’ >> gs[ZIP_EQ_NIL] +) >> +PairCases_on ‘h’ >> +gs[] >> +Cases_on ‘init_from_tau random_oracle r h1’ >> +gs[] >> +‘xl = [] ⇔ vl = []’ by (Cases_on ‘xl’ >> Cases_on ‘vl’ >> gs[]) >> +FULL_SIMP_TAC bool_ss [GSYM SNOC] >> +‘FST $ FOLDL + (λ(x_v_l,i') (x,tau). + (λ(v,i''). ((x,v)::x_v_l,i'')) + (init_from_tau random_oracle i' tau)) + (SNOC (h0,q) (SNOC (h0',q') []),r'') t = ZIP (xl,vl)’ by gs[] >> +FULL_SIMP_TAC bool_ss [Once FOLDL_init_from_tau_SNOC_tup] >> +‘LAST xl = h0 /\ FRONT xl = REVERSE (MAP FST t) ⧺ [h0']’ suffices_by ( + rpt strip_tac >> + ‘xl = (FRONT xl) ++ [LAST xl]’ by ( + Cases_on ‘xl’ >> Cases_on ‘vl’ >> gs[] >> + ‘h::t' = SNOC (LAST (h::t')) (FRONT (h::t'))’ by gs[GSYM SNOC_LAST_FRONT] >> + gs[] + ) >> + gs[] +) >> +strip_tac >- ( + imp_res_tac ZIP_LAST >> + LAST_ASSUM irule >> + qexistsl_tac [‘q’, ‘FST + (FOLDL + (λ(x_v_l,i') (x,tau). + (λ(v,i''). ((x,v)::x_v_l,i'')) + (init_from_tau random_oracle i' tau)) ([(h0',q')],r'') t)’] >> + gs[] +) >> +gs[] >> +qpat_x_assum ‘!random_oracle. _’ irule >> +Cases_on ‘FOLDL + (λ(x_v_l,i') (x,tau). + (λ(v,i''). ((x,v)::x_v_l,i'')) + (init_from_tau random_oracle i' tau)) ([(h0',q')],r'') t’ >> +qexistsl_tac [‘q'’, ‘r''’, ‘r'''’, ‘random_oracle’, ‘FRONT vl’] >> +gs[] >> +Cases_on ‘xl’ >> Cases_on ‘vl’ >> gs[] >> +‘FRONT (q'' ⧺ [(h0,q)]) = FRONT ((h,h')::ZIP (t',t''))’ by gs[] >> +FULL_SIMP_TAC bool_ss [GSYM SNOC_APPEND, FRONT_SNOC] >> +gs[FRONT_CONS] >> +REWRITE_TAC[GSYM ZIP_def] >> +gs[ZIP_FRONT] +QED + +(* TODO: Move *) +Theorem MAP_SND_EL: +∀l i. +i < LENGTH l ⇒ +SND (EL i l) = EL i (MAP SND l) +Proof +Induct >- ( + gs[] +) >> +rpt strip_tac >> +Cases_on ‘i’ >> ( + gs[] +) +QED + +Theorem init_from_tau_is_typed: +!(ty:'a itself). + (∀t. init_from_tau_typed t ty ) ∧ + (∀l. init_stl_from_tau_typed l ty) ∧ + (∀(st:(string#tau)). init_st_tup_from_tau_typed st ty) +Proof +strip_tac >> +Induct >~ [‘∀s. init_from_tau_typed (tau_xtl s l) ty’] >- ( + strip_tac >> + gvs[init_from_tau_typed_def] >> + rpt strip_tac >> Cases_on ‘s’ >> Cases_on ‘l’ >> - gvs[arb_from_tau_def, Once v_typ_cases, clause_name_def] >| [ - (* struct case *) + gvs[init_from_tau_def, Once v_typ_cases, clause_name_def] >| [ + (* struct case *) + + (* Step 1: The witness is the original list of IDs, zipped with the values from init_from_tau, + * and the original taus. - Q.EXISTS_TAC ‘ZIP(MAP(\(x,tau). x) (h::t), - ZIP ((MAP (\ (x,tau). arb_from_tau tau) (h::t)) , - MAP (\ (x,tau). tau) (h::t)))’ >> + First subgoal is exact agreement of init function applied to struct, with FOLDR'd init function on struct content. This needs to take into account the i's. + + Second subgoal should just be lambda and tuple technicalities. + + Third subgoal states well-typedness of all the individual elements. This needs to make use of the IH. + * *) + + qexists_tac ‘ZIP(MAP(λ(x,tau). x) (h::t), + ZIP (REVERSE $ FST (FOLDL (λ(l,i') (x:string,tau). (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([],i) (h::t)) , + MAP (λ(x,tau). tau) (h::t)))’ >> gvs[] >> PairCases_on ‘h’ >> gvs[] >> - gvs[map_distrub] >> rw[] >| [ - gvs[arb_from_tau_def] >> - - subgoal ‘∀ (l:(string#tau)list) . MAP (λ(x,t). (x,arb_from_tau t)) l = - ZIP (MAP (λ(x,tau). x) l,MAP (λ(x,tau). arb_from_tau tau) l) ’ >- - (Induct >> gvs[] >> REPEAT STRIP_TAC >> PairCases_on ‘h’ >> gvs[]) >> + Cases_on ‘init_from_tau random_oracle i h1’ >> gs[] >> + + Cases_on ‘(FOLDL + (λ(x_v_l,i') (x,tau). + (λ(v,i''). ((x,v)::x_v_l,i'')) + (init_from_tau random_oracle i' tau)) ([(h0,q)],r) t)’ >> + + rw[] >> + (* Preconditions of map_distrub *) + ‘LENGTH (h0::MAP (λ(x,tau). x) t) = LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([q],r) + t)))’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + ‘LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([q],r) + t))) = LENGTH (h1::MAP (λ(x,tau). tau) t)’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + gs[map_distrub] >> + + ‘(FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([q],r) t)) = + MAP SND $ FST $ + FOLDL + (λ(x_v_l,i') (x,tau). + (λ(v,i''). ((x,v)::x_v_l,i'')) + (init_from_tau random_oracle i' tau)) ([(h0,q)],r) t’ by gs[FOLDL_init_from_tau_MAP_SND] >> + gs[lambda_FST] >> + ‘?xl vl. q' = ZIP(xl,vl) /\ LENGTH xl = LENGTH vl’ by ( + qexistsl_tac [‘MAP FST q'’, ‘MAP SND q'’] >> + gs[ZIP_MAP_FST_SND] + ) >> + (* A bit clumsy, make better? *) + imp_res_tac FOLDL_init_from_tau_identifiers >> + gs[MAP_ZIP, REVERSE_ZIP] >> + ‘REVERSE xl = h0::MAP FST t’ suffices_by gs[] >> + res_tac >> gvs[] , - SIMP_TAC list_ss [lambda_FST, lambda_SND] >> - fs[ZIP_MAP_FST_SND] + gs[lambda_FST, lambda_SND] >> + Cases_on ‘init_from_tau random_oracle i h1’ >> gs[] >> + (* Preconditions of map_distrub *) + ‘LENGTH (h0::MAP FST t) = LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) + ((λ(v,i''). ([v],i'')) + (init_from_tau random_oracle i h1)) t)))’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + ‘LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) + ((λ(v,i''). ([v],i'')) + (init_from_tau random_oracle i h1)) t))) = LENGTH (h1::MAP SND t)’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + gs[map_distrub] >> + fs[ZIP_MAP_FST_SND] , - gvs[arb_stl_from_tau_typed_def] >> - fs[Once EL_compute] >> Cases_on ‘i=0’ >> gvs[EL_CONS] >| [ + + gvs[init_stl_from_tau_typed_def] >> + Cases_on ‘init_from_tau random_oracle i h1’ >> gvs[] >> + (* The special case of i'=0 is a bit easier *) + fs[Once EL_compute] >> Cases_on ‘i'=0’ >> gvs[EL_CONS] >| [ FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`(h0,h1)`])) >> - gvs[arb_from_tau_typed_def] + gvs[init_from_tau_typed_def] >> + gs[lambda_FST, lambda_SND] >> + (* use map_distrub, then grab the heads *) + ‘LENGTH (h0::MAP FST t) = LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) + ((λ(v,i''). ([v],i'')) + (init_from_tau random_oracle i h1)) t)))’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + ‘LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) + ((λ(v,i''). ([v],i'')) + (init_from_tau random_oracle i h1)) t))) = LENGTH (h1::MAP SND t)’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + gs[map_distrub] >> + gs[FOLDL_init_from_tau_APPEND, REVERSE_APPEND] >> + qpat_x_assum ‘!random_oracle. _’ (fn thm => assume_tac $ Q.SPECL [‘random_oracle’, ‘i’] thm) >> + gs[] , - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`EL (PRE i) t`])) >> - subgoal ‘PRE i < LENGTH t’ >- rfs[] >> - subgoal ‘MEM (EL (PRE i) t) t’ >- gvs[EL_MEM] >> - gvs[] >> - gvs[arb_from_tau_typed_def] >> - gvs[lambda_SND] >> - - ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:(string)``] arb_EL_lemma) >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`PRE i`,`t`])) >> - gvs[] + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`EL (PRE i') t`])) >> + subgoal ‘PRE i' < LENGTH t’ >- rfs[] >> + subgoal ‘MEM (EL (PRE i') t) t’ >- gvs[EL_MEM] >> + gvs[init_from_tau_typed_def] >> + Cases_on ‘init_from_tau random_oracle i h1’ >> gs[] >> + (* First, obtain that q is the first element, then grab the tail of the resulting + * list. Then, obtain that the i'-1th value must be init_from_tau random_oracle i (SND (EL (PRE i') t)) for some i. Specialise the assumption with this i, and you're done. *) + ‘LENGTH (h0::MAP FST t) = LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) + ((λ(v,i''). ([v],i'')) + (init_from_tau random_oracle i h1)) t)))’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + gs[map_distrub] >> + gs[FOLDL_init_from_tau_APPEND, REVERSE_APPEND] >> + gvs[lambda_SND, EL_CONS] >> + ‘(SND (EL (PRE i') t)) = (EL (PRE i') (MAP SND t))’ by gs[MAP_SND_EL] >> + gs[] >> + ‘?i''. FST (init_from_tau random_oracle i'' (EL (PRE i') (MAP SND t))) = EL (PRE i') + (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([],r) t)))’ suffices_by ( + rpt strip_tac >> + qpat_x_assum ‘!random_oracle. _’ (fn thm => assume_tac $ Q.SPECL [‘random_oracle’, ‘i''’] thm) >> + gs[] + ) >> + metis_tac[FOLDL_init_from_tau_oracle_index] ] ] , - (* header's bool*) + (* validity bit *) gvs[Once v_typ_cases, clause_name_def] , + (* headers case *) - Q.EXISTS_TAC ‘ZIP(MAP(\(x,tau). x) (h::t), - ZIP ((MAP (\ (x,tau). arb_from_tau tau) (h::t)) , - MAP (\ (x,tau). tau) (h::t)))’ >> - Q.EXISTS_TAC ‘ARB’ >> + qexists_tac ‘ZIP(MAP(λ(x,tau). x) (h::t), + ZIP (REVERSE $ FST (FOLDL (λ(l,i') (x:string,tau). (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([],i) (h::t)) , + MAP (λ(x,tau). tau) (h::t)))’ >> + qexists_tac ‘F’ >> gvs[] >> PairCases_on ‘h’ >> gvs[] >> - gvs[map_distrub] >> rw[] >| [ - gvs[arb_from_tau_def] >> - - subgoal ‘∀ (l:(string#tau)list) . MAP (λ(x,t). (x,arb_from_tau t)) l = - ZIP (MAP (λ(x,tau). x) l,MAP (λ(x,tau). arb_from_tau tau) l) ’ >- - (Induct >> gvs[] >> REPEAT STRIP_TAC >> PairCases_on ‘h’ >> gvs[]) >> + Cases_on ‘init_from_tau random_oracle i h1’ >> gs[] >> + Cases_on ‘(FOLDL + (λ(x_v_l,i') (x,tau). + (λ(v,i''). ((x,v)::x_v_l,i'')) + (init_from_tau random_oracle i' tau)) ([(h0,q)],r) t)’ >> + rw[] >> + (* Preconditions of map_distrub *) + ‘LENGTH (h0::MAP (λ(x,tau). x) t) = LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([q],r) + t)))’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + ‘LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([q],r) + t))) = LENGTH (h1::MAP (λ(x,tau). tau) t)’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + gs[map_distrub] >> + ‘(FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([q],r) t)) = + MAP SND $ FST $ + FOLDL + (λ(x_v_l,i') (x,tau). + (λ(v,i''). ((x,v)::x_v_l,i'')) + (init_from_tau random_oracle i' tau)) ([(h0,q)],r) t’ by gs[FOLDL_init_from_tau_MAP_SND] >> + gs[lambda_FST] >> + ‘?xl vl. q' = ZIP(xl,vl) /\ LENGTH xl = LENGTH vl’ by ( + qexistsl_tac [‘MAP FST q'’, ‘MAP SND q'’] >> + gs[ZIP_MAP_FST_SND] + ) >> + (* A bit clumsy, make better? *) + imp_res_tac FOLDL_init_from_tau_identifiers >> + gs[MAP_ZIP, REVERSE_ZIP] >> + ‘REVERSE xl = h0::MAP FST t’ suffices_by gs[] >> + res_tac >> gvs[] - , - SIMP_TAC list_ss [lambda_FST, lambda_SND] >> - fs[ZIP_MAP_FST_SND] , + + gs[lambda_FST, lambda_SND] >> + Cases_on ‘init_from_tau random_oracle i h1’ >> gs[] >> + (* Preconditions of map_distrub *) + ‘LENGTH (h0::MAP FST t) = LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) + ((λ(v,i''). ([v],i'')) + (init_from_tau random_oracle i h1)) t)))’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + ‘LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) + ((λ(v,i''). ([v],i'')) + (init_from_tau random_oracle i h1)) t))) = LENGTH (h1::MAP SND t)’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + gs[map_distrub] >> + fs[ZIP_MAP_FST_SND] + , + gvs[Once v_typ_cases, clause_name_def] - , - gvs[arb_stl_from_tau_typed_def] >> - fs[Once EL_compute] >> Cases_on ‘i=0’ >> gvs[EL_CONS] >| [ - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`(h0,h1)`])) >> - gvs[arb_from_tau_typed_def] - , + , + + gvs[init_stl_from_tau_typed_def] >> + Cases_on ‘init_from_tau random_oracle i h1’ >> gvs[] >> + fs[Once EL_compute] >> Cases_on ‘i'=0’ >> gvs[EL_CONS] >| [ + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`(h0,h1)`])) >> + gvs[init_from_tau_typed_def, lambda_FST, lambda_SND] >> + (* use map_distrub, then grab the heads *) + ‘LENGTH (h0::MAP FST t) = LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) + ((λ(v,i''). ([v],i'')) + (init_from_tau random_oracle i h1)) t)))’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + ‘LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) + ((λ(v,i''). ([v],i'')) + (init_from_tau random_oracle i h1)) t))) = LENGTH (h1::MAP SND t)’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + gs[map_distrub, FOLDL_init_from_tau_APPEND, REVERSE_APPEND] >> + qpat_x_assum ‘!random_oracle. _’ (fn thm => assume_tac $ Q.SPECL [‘random_oracle’, ‘i’] thm) >> + gs[] + , - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`EL (PRE i) t`])) >> - subgoal ‘PRE i < LENGTH t’ >- rfs[] >> - subgoal ‘MEM (EL (PRE i) t) t’ >- gvs[EL_MEM] >> - gvs[] >> - gvs[arb_from_tau_typed_def] >> - gvs[lambda_SND] >> - - ASSUME_TAC (INST_TYPE [``:'a`` |-> ``:(string)``] arb_EL_lemma) >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`PRE i`,`t`])) >> - gvs[] + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`EL (PRE i') t`])) >> + subgoal ‘PRE i' < LENGTH t’ >- rfs[] >> + subgoal ‘MEM (EL (PRE i') t) t’ >- gvs[EL_MEM] >> + gvs[init_from_tau_typed_def] >> + Cases_on ‘init_from_tau random_oracle i h1’ >> gs[] >> + (* First, obtain that q is the first element, then grab the tail of the resulting + * list. Then, obtain that the i'-1th value must be init_from_tau random_oracle i (SND (EL (PRE i') t)) for some i. Specialise the assumption with this i, and you're done. *) + ‘LENGTH (h0::MAP FST t) = LENGTH (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) + ((λ(v,i''). ([v],i'')) + (init_from_tau random_oracle i h1)) t)))’ by gs[LENGTH_REVERSE, FOLDL_init_from_tau_LENGTH] >> + gs[map_distrub] >> + gs[FOLDL_init_from_tau_APPEND, REVERSE_APPEND] >> + gvs[lambda_SND, EL_CONS] >> + ‘(SND (EL (PRE i') t)) = (EL (PRE i') (MAP SND t))’ by gs[MAP_SND_EL] >> + gs[] >> + ‘?i''. FST (init_from_tau random_oracle i'' (EL (PRE i') (MAP SND t))) = EL (PRE i') + (REVERSE + (FST + (FOLDL + (λ(l,i') (x,tau). + (λ(v,i''). (v::l,i'')) + (init_from_tau random_oracle i' tau)) ([],r) t)))’ suffices_by ( + rpt strip_tac >> + qpat_x_assum ‘!random_oracle. _’ (fn thm => assume_tac $ Q.SPECL [‘random_oracle’, ‘i''’] thm) >> + gs[] + ) >> + metis_tac[FOLDL_init_from_tau_oracle_index] ] ] ] ) >> ( - TRY ( - gvs[arb_stl_from_tau_typed_def, arb_st_tup_from_tau_typed_def] >> + gvs[init_stl_from_tau_typed_def, init_st_tup_from_tau_typed_def] >> REPEAT STRIP_TAC >> gvs[] ) >> - gvs[arb_from_tau_typed_def] >> - gvs[arb_from_tau_def, Once v_typ_cases, clause_name_def] >> + gvs[init_from_tau_typed_def] >> + gvs[init_from_tau_def, Once v_typ_cases, clause_name_def] >> gvs[bs_width_def] >> gvs[Once v_typ_cases, clause_name_def] ) @@ -3559,19 +3978,31 @@ QED Theorem declare_similar: - ∀l. lvalop_not_none l ⇒ - similar (λ(v,lop1) (t,lop2). v_typ v (t_tau t) F ∧ lop1 = lop2) (declare_list_in_fresh_scope l) l + ∀l i random_oracle. lvalop_not_none l ⇒ + similar (λ(v,lop1) (t,lop2). v_typ v (t_tau t) F ∧ lop1 = lop2) (FST $ declare_list_in_fresh_scope (l, i, random_oracle)) l Proof -Induct >> -gvs[declare_list_in_fresh_scope_def, similar_def] >> -REPEAT STRIP_TAC >> +Induct >> ( + REPEAT STRIP_TAC >> + gvs[declare_list_in_fresh_scope_def, declare_list_in_scope_def, similar_def] +) >> +qpat_x_assum ‘!i. _’ (assume_tac o Q.SPECL [‘i’, ‘random_oracle’]) >> +gvs[lvalop_not_none_def] >> PairCases_on ‘h’ >> gvs[] >> - -ASSUME_TAC arb_from_tau_is_typed >> +assume_tac init_from_tau_is_typed >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty` ])) >> LAST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`h1` ])) >> -fs[arb_from_tau_typed_def] >> -gvs[lvalop_not_none_def] +fs[init_from_tau_typed_def] >> +Cases_on ‘(FOLDR + (λ(x,t,lvalop) (f,i'). + (λ(v',i''). ((x,v',NONE:lval option)::f,i'')) + (init_from_tau random_oracle i' t)) ([],i) l)’ >> +gs[] >> +qexists_tac ‘(h0,(FST (init_from_tau random_oracle r h1), NONE))’ >> +gvs[FOLDR] >> +qexists_tac ‘q’ >> +gs[] >> +Cases_on ‘init_from_tau random_oracle r h1’ >> +gs[] QED @@ -3579,34 +4010,88 @@ QED Theorem declare_typed: - ∀ l . lvalop_not_none l ⇒ - type_scopes_list [declare_list_in_fresh_scope l] [l] + ∀ l i random_oracle. lvalop_not_none l ⇒ + type_scopes_list [FST $ declare_list_in_fresh_scope (l, i, random_oracle)] [l] Proof gvs[type_scopes_list_def] >> gvs[similarl_def] >> gvs[declare_similar] QED +Theorem ALOOKUP_keys_identical: + !k l1 l2. + MAP FST l1 = MAP FST l2 ==> + ALOOKUP l1 k = NONE ==> + ALOOKUP l2 k = NONE +Proof +rpt strip_tac >> +gs[ALOOKUP_NONE] +QED + +Theorem ALOOKUP_AUPDATE: +!l k1 k2 v2. +ALOOKUP l k1 = NONE ==> +k1 <> k2 ==> +ALOOKUP (AUPDATE l (k2,v2)) k1 = NONE +Proof +Induct >> ( + gs[AUPDATE_def] +) >> +rpt strip_tac >> +PairCases_on ‘h’ >> +gs[ALOOKUP_def] >> +res_tac >> +Cases_on ‘h0 = k2’ >> gs[ALOOKUP_def, AFUPDKEY_def] >> +res_tac >> +Cases_on ‘ALOOKUP l k2’ >> gs[] +QED val v_decl_lookup_lemma = prove (“ -∀ l varn . -ALOOKUP l varn = NONE ⇒ -ALOOKUP (MAP (λ(x,t,lvalop). (x,arb_from_tau t,NONE)) l) varn = NONE ”, +!l i random_oracle varn:varn. +ALOOKUP l varn = NONE ==> +ALOOKUP + (FST + (FOLDR + (λ(x,t,lvalop:lval option) (f,i'). + (λ(v',i''). (x,v',NONE:lval option)::f,i'') + (init_from_tau random_oracle i' t)) ([],i) l)) varn = NONE”, + Induct >> gvs[] >> REPEAT STRIP_TAC >> PairCases_on ‘h’ >> gvs[] >> -Cases_on ‘h0 = varn ’ >> gvs[] +res_tac >> +qpat_x_assum ‘!random_oracle i. _’ (assume_tac o Q.SPECL [‘random_oracle’, ‘i’]) >> +Cases_on ‘(FOLDR + (λ(x,t,lvalop) (f,i'). + (λ(v',i''). (x,v',NONE:lval option)::f,i'') + (init_from_tau random_oracle i' t)) ([],i) l)’ >> +gs[] >> +‘ALOOKUP + (FST + ((AUPDATE q (h0,FST $ init_from_tau random_oracle r h1,NONE),i'')) +) varn = + NONE’ suffices_by ( + strip_tac >> + Cases_on ‘init_from_tau random_oracle r h1’ >> + gs[] +) >> +gs[ALOOKUP_AUPDATE] ); - Theorem star_not_in_decl_ts: -∀ l . +∀ l i random_oracle. star_not_in_ts l ⇒ -star_not_in_sl [declare_list_in_fresh_scope l] +star_not_in_sl [FST $ declare_list_in_fresh_scope (l, i, random_oracle)] Proof -gvs[star_not_in_ts_def, star_not_in_sl_def, star_not_in_s_def, declare_list_in_fresh_scope_def] >> +gvs[star_not_in_ts_def, star_not_in_sl_def, star_not_in_s_def, declare_list_in_fresh_scope_def, declare_list_in_scope_def] >> REPEAT STRIP_TAC >> -FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘f’])) >> +qpat_x_assum ‘!f ._’ (assume_tac o Q.SPECL [‘f’]) >> +imp_res_tac v_decl_lookup_lemma >> +qpat_x_assum ‘!random_oracle ._’ (assume_tac o Q.SPECL [‘random_oracle’, ‘i’]) >> +Cases_on ‘(FOLDR + ( \ (x,t,lvalop) (f,i'). + ( \ (v',i''). ((x,v',NONE:lval option)::f,i'')) + (init_from_tau random_oracle i' t)) ([],i) l)’ >> gvs[v_decl_lookup_lemma] QED @@ -3773,21 +4258,22 @@ gvs[] >| [ fs[type_frame_tsl_def] >> rw[] >| [ IMP_RES_TAC sig_tsc_consist_LAST1 >> - METIS_TAC [] + METIS_TAC [] , - Cases_on ‘t_scope_list’ >> gvs[] + Cases_on ‘t_scope_list’ >> gvs[] , SIMP_TAC list_ss [Once star_not_in_sl_normalization] >> - gvs[star_Err_not_in_ts_def, star_not_in_decl_ts] + gvs[star_Err_not_in_ts_def] >> + metis_tac[FST, star_not_in_decl_ts] , SIMP_TAC list_ss [Once type_scopes_list_normalize] >> - gvs[declare_typed] + metis_tac[FST, declare_typed] , SIMP_TAC list_ss [Once star_not_in_sl_normalization] >> - gvs[star_Err_not_in_ts_def, star_not_in_decl_ts] + metis_tac[FST, star_Err_not_in_ts_def, star_not_in_decl_ts] , ‘i=0 ∨ i=1’ by fs[] >> - gvs[] >> SIMP_TAC list_ss [Once stmt_typ_cases] >> gvs[clause_name_def] + gvs[] >> SIMP_TAC list_ss [Once stmt_typ_cases] >> gvs[clause_name_def] ] , @@ -3903,7 +4389,7 @@ gvs[] >| [ gvs[] , STMT_STMT_SR_TAC ‘stmt_app s l’ - ] + ] , (*****************************) @@ -3927,9 +4413,9 @@ gvs[] >| [ val sr_stmtl_def = Define ` sr_stmtl (stmtl) (ty:'a itself) = -∀ stmtl' ascope ascope' gscope gscope' (scopest:scope list) scopest' framel status status' t_scope_list t_scope_list_g T_e (c:'a ctx) order delta_g delta_b delta_t delta_x f Prs_n n apply_table_f ext_map func_map b_func_map pars_map tbl_map. +∀ stmtl' ascope ascope' gscope gscope' (scopest:scope list) scopest' framel status status' t_scope_list t_scope_list_g T_e (c:'a ctx) order delta_g delta_b delta_t delta_x f Prs_n n apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle. - (c = ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ) ∧ + (c = ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ) ∧ (WT_c c order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n ) ∧ (T_e = (order, f, (delta_g, delta_b, delta_x, delta_t))) ∧ @@ -4199,9 +4685,9 @@ srw_tac [boolSimps.DNF_ss][] >| [ (* here we know that also the frame we create and trying to type, the is empty*) val SR_stmtl_newframe = prove (“ -∀ stmtl stmtl' ascope ascope' gscope gscope' (scopest:scope list) scopest' framel status status' t_scope_list t_scope_list_g T_e (c:'a ctx) order delta_g delta_b delta_t delta_x f Prs_n apply_table_f ext_map func_map b_func_map pars_map tbl_map. +∀ stmtl stmtl' ascope ascope' gscope gscope' (scopest:scope list) scopest' framel status status' t_scope_list t_scope_list_g T_e (c:'a ctx) order delta_g delta_b delta_t delta_x f Prs_n apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle. - (c = ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ) ∧ + (c = ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ) ∧ (WT_c c order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n) ∧ (T_e = (order, f, (delta_g, delta_b, delta_x, delta_t))) ∧ (frame_typ ( t_scope_list_g , t_scope_list ) T_e Prs_n gscope scopest (stmtl) ) ∧ @@ -4221,27 +4707,15 @@ Cases_on ‘stmtl’ >| [ REPEAT GEN_TAC >> STRIP_TAC >> Cases_on ‘t’ >> gvs[] >| [ - + ASSUME_TAC SR_stmt_newframe >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [ - ‘h’, `stmtl'`,‘ascope’,‘ascope'’, ‘gscope’,‘gscope'’, ‘scopest’,‘scopest'’,‘framel’,‘status’,‘status'’, - ‘t_scope_list’, ‘t_scope_list_g’, ‘(order,f,delta_g,delta_b,delta_x,delta_t)’, - ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)’,‘order’, ‘delta_g’, - ‘delta_b’, ‘delta_t’, ‘delta_x’,‘f’, ‘Prs_n’])) >> gvs[] >> - srw_tac [SatisfySimps.SATISFY_ss][] + metis_tac[] , gvs[Once stmt_sem_cases] >| [ - ASSUME_TAC SR_stmt_newframe >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [ - ‘h’, `stmt_stack'`,‘ascope’,‘ascope'’, ‘gscope’,‘gscope'’, ‘scopest’,‘scopest'’,‘framel’,‘status’,‘status'’, - ‘t_scope_list’,‘t_scope_list_g’, ‘(order,f,delta_g,delta_b,delta_x,delta_t)’, - ‘(apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map)’, - ‘order’, ‘delta_g’, ‘delta_b’, ‘delta_t’, ‘delta_x’, ‘f’, ‘Prs_n’])) >> gvs[] >> - - + ASSUME_TAC SR_stmt_newframe >> IMP_RES_TAC frame_typ_head_of_stmtl >> gvs[] >> - srw_tac [SatisfySimps.SATISFY_ss][] + metis_tac[] , gvs[Once res_frame_typ_def] ] @@ -4272,9 +4746,9 @@ Cases_on ‘stmtl’ >| [ gvs[sr_stmtl_def] >> REPEAT GEN_TAC >> STRIP_TAC >> - CONJ_TAC >| [ + CONJ_TAC >| [ (* first show that the resulted frames are WT*) - srw_tac [SatisfySimps.SATISFY_ss][SR_stmtl_newframe] + srw_tac [SatisfySimps.SATISFY_ss][SR_stmtl_newframe] , CONJ_TAC >| [ @@ -4287,13 +4761,7 @@ Cases_on ‘stmtl’ >| [ ASSUME_TAC SR_single_block >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`,‘h’])) >> fs[sr_stmt_def] >> gvs[] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [ - `stmtl'`,‘ascope’,‘ascope'’, ‘gscope’,‘gscope'’, ‘scopest’,‘scopest'’,‘framel’,‘status’,‘status'’, - ‘t_scope_list’,‘t_scope_list_g’,‘order’, ‘delta_g’, ‘delta_b’, ‘delta_t’, ‘delta_x’, ‘f’, ‘Prs_n’])) >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) >> gvs[] >> - - gvs[] >> - srw_tac [SatisfySimps.SATISFY_ss][] + metis_tac[] , gvs[Once stmt_sem_cases] >> @@ -4302,12 +4770,13 @@ Cases_on ‘stmtl’ >| [ ASSUME_TAC SR_single_block >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`,‘h’])) >> + (* TODO: Clean up below, fix tbl_map in sr_stmt_def *) fs[sr_stmt_def] >> gvs[] >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [ `stmt_stack'`,‘ascope’,‘ascope'’, ‘gscope’,‘gscope'’, ‘scopest’,‘scopest'’,‘framel’,‘status’,‘status'’, ‘t_scope_list’,‘t_scope_list_g’,‘order’, ‘delta_g’, ‘delta_b’, ‘delta_t’, ‘delta_x’, ‘f’, ‘Prs_n’])) >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) >> gvs[] >> + FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘(tbl_map,get_oracle_index,set_oracle_index,random_oracle)’])) >> gvs[] >> gvs[] >> @@ -4340,13 +4809,6 @@ Cases_on ‘stmtl’ >| [ ASSUME_TAC SR_single_block >> FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [`ty`,‘h’])) >> fs[sr_stmt_def] >> gvs[] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [ - `stmt_stack'`,‘ascope’,‘ascope'’, ‘gscope’,‘gscope'’, ‘scopest’,‘scopest'’,‘framel’,‘status’,‘status'’, - ‘t_scope_list’,‘t_scope_list_g’,‘order’, - ‘delta_g’, ‘delta_b’, ‘delta_t’, ‘delta_x’, ‘f’, ‘Prs_n’])) >> gvs[] >> - FIRST_X_ASSUM (STRIP_ASSUME_TAC o (Q.SPECL [‘apply_table_f’, ‘ext_map’, ‘func_map’, ‘b_func_map’, ‘pars_map’, ‘tbl_map’])) >> gvs[] >> - - IMP_RES_TAC frame_typ_head_of_stmtl >> gvs[] >> IMP_RES_TAC stmtl_len_from_in_frame_theorem >> gvs[] >> fs[] @@ -4358,14 +4820,4 @@ Cases_on ‘stmtl’ >| [ ]] QED - - - - - - - - val _ = export_theory (); - - diff --git a/hol/p4Script.sml b/hol/p4Script.sml index 891004cc..51666183 100644 --- a/hol/p4Script.sml +++ b/hol/p4Script.sml @@ -1,4 +1,4 @@ -(* generated by Ott 0.33 from: ../ott/p4_types.ott ../ott/p4_sem.ott ../ott/p4.ott *) +(* generated by Ott 0.34 from: ../ott/p4_types.ott ../ott/p4_sem.ott ../ott/p4.ott *) (* to compile: Holmake p4Theory.uo *) (* for interactive use: app load ["pred_setTheory","finite_mapTheory","stringTheory","containerTheory","ottLib"]; @@ -21,12 +21,12 @@ Type bl = ``:bool list`` (* bit-string *) Type i = ``:num`` (* natural number *) Type m = ``:num`` (* indices *) +Type num_exp = ``:num`` + Type bitv = ``:(bl # num)`` Type boolv = ``:bool`` -Type num_exp = ``:num`` - val _ = Hol_datatype ` funn = @@ -145,6 +145,8 @@ lval = Type e_list = ``:(e list)`` +Type i_opt = ``:(num option)`` + Type scope = ``:((varn, (v # lval option)) alist)`` @@ -158,6 +160,13 @@ struct_ty = | struct_ty_header `; val _ = Hol_datatype ` +d = (* parameter direction *) + d_in + | d_out + | d_inout + | d_none +`; +val _ = Hol_datatype ` tau = (* type *) tau_bool (* boolean *) | tau_bit of num_exp (* bit-string *) @@ -165,13 +174,6 @@ tau = (* type *) | tau_xtl of struct_ty => (x#tau) list (* struct *) | tau_ext (* extern *) `; -val _ = Hol_datatype ` -d = (* parameter direction *) - d_in - | d_out - | d_inout - | d_none -`; Type Ftau = ``:( ( tau # x # d ) list # tau)`` @@ -223,18 +225,18 @@ stmt = (* statement *) -Type b_func_map = ``:((string, (stmt # (string # d) list)) alist)`` - Type func_map = ``:((string, (stmt # (string # d) list)) alist)`` -Type ext_fun_map = ``:((string, ((string # d) list # 'a ext_fun)) alist)`` +Type b_func_map = ``:((string, (stmt # (string # d) list)) alist)`` +Type ext_fun_map = ``:((string, ((string # d) list # 'a ext_fun)) alist)`` -Type pars_map = ``:((string, stmt) alist)`` Type ext_map = ``:((string, ((((string # d) list # 'a ext_fun) option) # 'a ext_fun_map)) alist)`` +Type pars_map = ``:((string, stmt) alist)`` + Type tbl_map = ``:((string, ((mk list) # (x # e_list))) alist)`` val _ = Hol_datatype ` pbl_type = (* programmable block type *) @@ -260,6 +262,8 @@ Type pblock_map = ``:((string, pblock) alist)`` Type in_out_list = ``:(in_out list)`` +Type random_oracle = ``:(num -> bool)`` + Type pblock_list = ``:(pblock list)`` val _ = Hol_datatype ` arch_block = (* architectural block *) @@ -271,23 +275,29 @@ arch_block = (* architectural block *) -Type apply_table_f = ``:((x # e_list # mk_list # (x # e_list) # 'a) -> (x # e_list) option)`` +Type get_oracle_index = ``:('a -> num)`` -Type copyout_pbl = ``:((g_scope list # 'a # d list # x list # status) -> 'a option)`` +Type set_oracle_index = ``:(num option -> 'a -> 'a)`` -Type copyin_pbl = ``:((x list # d list # e list # 'a) -> scope option)`` +Type input_f = ``:((in_out_list # 'a) -> (in_out_list # 'a) option)`` Type output_f = ``:((in_out_list # 'a) -> (in_out_list # 'a) option)`` -Type input_f = ``:((in_out_list # 'a) -> (in_out_list # 'a) option)`` +Type copyin_pbl = ``:((x list # d list # e list # 'a # random_oracle) -> (scope # num option) option)`` + +Type copyout_pbl = ``:((g_scope list # 'a # d list # x list # status) -> 'a option)`` + +Type apply_table_f = ``:((x # e_list # mk_list # (x # e_list) # 'a) -> (x # e_list) option)`` Type ab_list = ``:(arch_block list)`` -Type ctx = ``:('a apply_table_f # 'a ext_map # func_map # b_func_map # pars_map # tbl_map)`` +Type ctx = ``:('a apply_table_f # 'a ext_map # func_map # b_func_map # pars_map # tbl_map # 'a get_oracle_index # 'a set_oracle_index # random_oracle)`` + +Type ectx = ``:('a apply_table_f # 'a ext_map # func_map # b_func_map # pars_map # tbl_map # i # random_oracle)`` -Type actx = ``:(ab_list # pblock_map # 'a ffblock_map # 'a input_f # 'a output_f # 'a copyin_pbl # 'a copyout_pbl # 'a apply_table_f # 'a ext_map # func_map)`` +Type actx = ``:(ab_list # pblock_map # 'a ffblock_map # 'a input_f # 'a output_f # 'a copyin_pbl # 'a copyout_pbl # 'a apply_table_f # 'a ext_map # func_map # 'a get_oracle_index # 'a set_oracle_index # random_oracle)`` Type stmt_stack = ``:(stmt list)`` @@ -308,9 +318,11 @@ arch_frame_list = (* architecture-level frame list *) | arch_frame_list_regular of frame_list (* regular frame list *) `; +Type cstate = ``:((in_out_list # in_out_list # 'a) # ((num # g_scope_list # arch_frame_list # status) # (num # g_scope_list # arch_frame_list # status)))`` + Type astate = ``:('a aenv # g_scope_list # arch_frame_list # status)`` -Type cstate = ``:((in_out_list # in_out_list # 'a) # ((num # g_scope_list # arch_frame_list # status) # (num # g_scope_list # arch_frame_list # status)))`` +Type e_red_res = ``:(frame_list # (num option))`` val is_const_def = Define ` (is_const (e_v _) = T) /\ (is_const _ = F) @@ -1552,28 +1564,35 @@ Proof fs [listTheory.MEM_SPLIT, v1_size_append, v_size_def] QED -val init_out_v_def = TotalDefn.tDefine "init_out_v" ` - (init_out_v (v_bool boolv) = v_bool ARB) /\ - (init_out_v (v_bit (bl, n)) = v_bit (extend ARB n [], n)) /\ - (init_out_v (v_str x) = v_str ARB) /\ - (init_out_v (v_struct ((x,v)::t)) = v_struct (((x, init_out_v v))::(MAP (\(x',v'). (x', init_out_v v')) t))) /\ - (init_out_v (v_struct []) = v_struct []) /\ - (init_out_v (v_header boolv ((x,v)::t)) = - v_header F (( (x, init_out_v v) )::(MAP (\(x',v'). (x', init_out_v v')) t))) /\ - (init_out_v (v_header boolv []) = v_header F []) /\ - (init_out_v (v_ext_ref i) = v_ext_ref i) /\ - (init_out_v v_bot = v_bot) -` -(WF_REL_TAC `measure v_size` >> - fs [v_size_def] >> - REPEAT STRIP_TAC >> - `v_size v' < v1_size t` suffices_by ( - fs [] - ) >> - METIS_TAC [v1_size_mem] -); - +Definition get_oracle_calls_def: + (get_oracle_calls 0 i f = []) /\ + (get_oracle_calls (SUC n) i f = + (f i)::(get_oracle_calls n (i+1) f) + ) +End +Definition init_out_v_def: + (init_out_v random_oracle i (v_bool boolv) = (v_bool $ random_oracle i, i+1)) /\ + (init_out_v random_oracle i (v_bit (bl, n)) = (v_bit (get_oracle_calls n i random_oracle, n), i+n)) /\ + (* Note you can't have string variables in P4 (but you can pass string literals to externs) *) + (init_out_v random_oracle i (v_str x) = (v_str "", i)) /\ + (init_out_v random_oracle i (v_struct x_v_l) = + let + (x_v_l'', i''') = FOLDL ( \ (x_v_l', i') (x, v). let (v', i'') = init_out_v random_oracle i' v in ((x, v')::x_v_l', i'')) ([], i) x_v_l + in + (v_struct $ REVERSE x_v_l'', i''') + ) /\ + (init_out_v random_oracle i (v_header boolv x_v_l) = + let + (x_v_l'', i''') = FOLDL ( \ (x_v_l', i') (x, v). let (v', i'') = init_out_v random_oracle i' v in ((x, v')::x_v_l', i'')) ([], i) x_v_l + in + (v_header F (REVERSE x_v_l''), i''') + ) /\ + (init_out_v random_oracle i (v_ext_ref i') = (v_ext_ref i', i)) /\ + (init_out_v random_oracle i v_bot = (v_bot, i)) +Termination +WF_REL_TAC ‘measure ( \ (a,b,c). v_size c)’ +End val tau_size_def = DB.fetch "p4" "tau_size_def"; @@ -1592,34 +1611,51 @@ Proof fs [listTheory.MEM_SPLIT, tau1_size_append, tau_size_def] QED -(* generate an undetermined value for a given type *) -val arb_from_tau_def = TotalDefn.tDefine "arb_from_tau" ` - (arb_from_tau tau_bool = (v_bool ARB)) /\ - (arb_from_tau (tau_bit w) = (v_bit ( (GENLIST (\x.ARB) w ) , w))) /\ - (arb_from_tau tau_bot = v_bot) /\ - (arb_from_tau tau_ext = (v_ext_ref ARB)) /\ - (arb_from_tau (tau_xtl struct_ty_struct [] ) = v_struct [] ) /\ - (arb_from_tau (tau_xtl struct_ty_struct ((x0,t0)::xtl) ) = - v_struct ((x0,arb_from_tau t0)::(MAP (λ(x,t). (x,arb_from_tau t)) xtl))) /\ - (arb_from_tau (tau_xtl struct_ty_header [] ) = v_header ARB [] ) /\ - (arb_from_tau (tau_xtl struct_ty_header ((x0,t0)::xtl)) = - v_header ARB ((x0,arb_from_tau t0)::(MAP (λ(x,t). (x,arb_from_tau t)) xtl))) - ` - (WF_REL_TAC `measure tau_size` >> - REPEAT STRIP_TAC >> - FULL_SIMP_TAC std_ss [] >> - fs [tau_size_def] >> - `tau_size t < tau1_size xtl` suffices_by ( - fs [] ) >> - IMP_RES_TAC tau1_size_mem); +Theorem tau1_size_eq: +!tau_l. tau1_size tau_l = list_size (pair_size (list_size char_size) tau_size) tau_l +Proof +Induct >- ( + gs[tau_size_def] +) >> +rpt strip_tac >> +Cases_on ‘h’ >> +gs[tau_size_def] +QED +(* Initialise values for a given type *) +Definition init_from_tau_def: + (init_from_tau random_oracle i tau_bool = (v_bool $ random_oracle i, i+1)) /\ + (init_from_tau random_oracle i (tau_bit w) = (v_bit (get_oracle_calls w i random_oracle, w), i+w)) /\ + (init_from_tau random_oracle i tau_bot = (v_bot, i)) /\ + (* NOTE: Extern objects can't be declared in blocks. + * They can be block-local, but will then always be instantiated, so this value doesn't matter *) + (init_from_tau random_oracle i tau_ext = (v_ext_ref 0, i)) /\ + (init_from_tau random_oracle i (tau_xtl struct_ty_struct xtl) = + let + (x_v_l', i''') = FOLDL ( \ (x_v_l, i') (x, tau). let (v, i'') = init_from_tau random_oracle i' tau in ((x, v)::x_v_l, i'')) ([], i) xtl + in + (v_struct $ REVERSE x_v_l', i''') + ) /\ + (init_from_tau random_oracle i (tau_xtl struct_ty_header xtl) = + let + (x_v_l', i''') = FOLDL ( \ (x_v_l, i') (x, tau). let (v, i'') = init_from_tau random_oracle i' tau in ((x, v)::x_v_l, i'')) ([], i) xtl + in + (v_header F (REVERSE x_v_l'), i''') + ) +Termination +WF_REL_TAC ‘measure ( \ (a,b,c). tau_size c)’ >> +rpt strip_tac >> ( + imp_res_tac tau1_size_mem >> + gs[tau1_size_eq] +) +End (* Given a direction, an expression (should be a lval), and a scope stack, * creates the proper tuple to be be assigned in the fresh scope created by a function call *) val one_arg_val_for_newscope_def = Define ` - one_arg_val_for_newscope d e ss = + one_arg_val_for_newscope d e ss i random_oracle = if is_d_out d then (case get_lval_of_e e of @@ -1627,13 +1663,13 @@ val one_arg_val_for_newscope_def = Define ` (case lookup_lval ss lval of | SOME v => if is_d_in d - then SOME (v, SOME lval) - else SOME (init_out_v v, SOME lval) + then SOME ((v, i), SOME lval) + else SOME (init_out_v random_oracle i v, SOME lval) | NONE => NONE) | NONE => NONE) else (case v_of_e e of - | SOME v => SOME (v, NONE) + | SOME v => SOME ((v, i), NONE) | NONE => NONE) `; @@ -1649,11 +1685,11 @@ Definition AUPDATE_LIST_def: End val update_arg_for_newscope_def = Define ` - update_arg_for_newscope ss f_opt (d, x, e) = - case f_opt of - | SOME f => - (case one_arg_val_for_newscope d e ss of - | SOME (v, lval_opt) => SOME (AUPDATE f (varn_name x, (v, lval_opt))) + update_arg_for_newscope ss random_oracle f_i_opt (d, x, e) = + case f_i_opt of + | SOME (f,i) => + (case one_arg_val_for_newscope d e ss i random_oracle of + | SOME ((v, i'), lval_opt) => SOME (AUPDATE f (varn_name x, (v, lval_opt)), i') | NONE => NONE) | NONE => NONE `; @@ -1661,15 +1697,18 @@ val update_arg_for_newscope_def = Define ` (* Fills a fresh scope with the values of the arguments of a called function. * Note: used in e_call_newframe *) val all_arg_update_for_newscope_def = Define ` - all_arg_update_for_newscope xlist dlist elist ss = - FOLDL (update_arg_for_newscope ss) (SOME []) (ZIP (dlist, ZIP(xlist, elist))) + all_arg_update_for_newscope xlist dlist elist ss i random_oracle = + FOLDL (update_arg_for_newscope ss random_oracle) (SOME ([], i)) (ZIP (dlist, ZIP(xlist, elist))) `; (* full copyin definition *) val copyin_def = Define ` - copyin xlist dlist elist gsl ss_curr = - all_arg_update_for_newscope xlist dlist elist (ss_curr++gsl) + copyin xlist dlist elist gsl ss_curr i random_oracle = + case all_arg_update_for_newscope xlist dlist elist (ss_curr++gsl) i random_oracle of + | SOME (scope', i') => + SOME (scope', if i = i' then NONE else SOME i') + | NONE => NONE `; (* in bl' slice from v2 to v1 and in that section add bl in those positions @@ -1680,7 +1719,9 @@ val relpace_bits_def = Define ` (SEG ((v'-v1)-1) 0 bl') ++ bl ++ (SEG v2 (v'-v2) bl') `; - +Definition get_ectx_def: + get_ectx ((apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle):'a ctx) (ascope:'a) = (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) +End (* assign to slice returns that value being replaces in a slicing assignment. i.e. assign the value bit vb to vb' where vb should replace only the positions from ev2 to ev1 in vb' *) @@ -1753,23 +1794,6 @@ val oDROP_def = Define ` (oDROP (SUC n) (h::t) = oDROP n t) `; -(* Declares a new variable and initialises it to ARB, returns the new scope stack *) -(* TODO: Behaviour when variable already exists? *) -(* Note that this will declare variables in the block-global scope when scope stack is empty *) -(* TODO: REMOVE IT *) -(* -val declare_def = Define ` - (declare g_scope_list (ss:scope_list) x t = - case ss of - | [] => (LUPDATE (AUPDATE (EL 1 g_scope_list) (varn_name x, (arb_from_tau t, NONE))) 1 g_scope_list, []) - | _ => - let i = LENGTH ss - 1 in - let scope = EL i ss in - (g_scope_list, LUPDATE (AUPDATE scope (varn_name x, (arb_from_tau t, NONE))) i ss) - ) -`; -*) - (* Initialises a new variable in the topmost scope. *) val initialise_def = Define ` (initialise (ss:scope_list) varn v = @@ -1818,15 +1842,18 @@ val initialise_var_stars_def = Define ` (* Takes a list of declaration tuples (x, t) and a scope, and returns a scope * where the declarations have been made *) val declare_list_in_scope_def = Define ` - declare_list_in_scope (t_scope:t_scope, scope:scope) = - FOLDR (\(x,(t,lvalop) ) f. AUPDATE f (x , (arb_from_tau t, NONE))) (scope:scope) t_scope + declare_list_in_scope (t_scope:t_scope, scope:scope, i_opt, i, random_oracle) = + let + (scope', i''') = FOLDR (\(x, (t,lvalop)) (f, i'). let (v', i'') = init_from_tau random_oracle i' t in ((x , (v', NONE))::f, i'')) (scope:scope, case i_opt of NONE => i | SOME i_upd => i_upd) t_scope + in + (scope', if i = i''' then NONE else SOME i''') `; (* Same as the above, but with the empty scope NOTE: the lvalop here is always none when entering a new block *) val declare_list_in_fresh_scope_def = Define ` - declare_list_in_fresh_scope (t_scope:t_scope) = - (MAP (\(x,(t,lvalop)). (x , (arb_from_tau t, NONE))) t_scope) + declare_list_in_fresh_scope (t_scope:t_scope, i, random_oracle) = + declare_list_in_scope (t_scope:t_scope, [], NONE, i, random_oracle) `; (* Looks up the function signature and body for an abstract function name. *) @@ -2157,334 +2184,334 @@ val tbl_to_pass_def = Define ` Inductive e_sem: (* defn e_red *) -[e_lookup:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (varn:varn) (v:v) . +[e_lookup:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (varn:varn) (v:v) . (clause_name "e_lookup") /\ (( SOME v = lookup_vexp2 scope_list g_scope_list varn )) ==> -( ( e_red ctx g_scope_list scope_list (e_var varn) (e_v v) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_var varn) (e_v v) ([], (NONE:num option)) ))) -[e_call_newframe:] (! (e_x_d_list:(e#x#d) list) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (g_scope_list:g_scope_list) (scope_list:scope_list) (funn:funn) (stmt:stmt) (scope':scope) . +[e_call_newframe:] (! (e_x_d_list:(e#x#d) list) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (i:i) (random_oracle:random_oracle) (g_scope_list:g_scope_list) (scope_list:scope_list) (funn:funn) (stmt:stmt) (scope':scope) (i_opt:i_opt) . (clause_name "e_call_newframe") /\ (( (SOME ( stmt , ((MAP (\(e_,x_,d_) . (x_,d_)) e_x_d_list)) ) = lookup_funn_sig_body funn func_map b_func_map ext_map ) ) /\ ( (check_args_red ( ((MAP (\(e_,x_,d_) . d_) e_x_d_list)) ) ( ((MAP (\(e_,x_,d_) . e_) e_x_d_list)) ) ) ) /\ -( (SOME scope' = copyin ((MAP (\(e_,x_,d_) . x_) e_x_d_list)) ( ((MAP (\(e_,x_,d_) . d_) e_x_d_list)) ) ( ((MAP (\(e_,x_,d_) . e_) e_x_d_list)) ) g_scope_list scope_list ) )) +( (SOME ( scope' , i_opt ) = copyin ((MAP (\(e_,x_,d_) . x_) e_x_d_list)) ( ((MAP (\(e_,x_,d_) . d_) e_x_d_list)) ) ( ((MAP (\(e_,x_,d_) . e_) e_x_d_list)) ) g_scope_list scope_list i random_oracle ) )) ==> -( ( e_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) g_scope_list scope_list (e_call funn ((MAP (\(e_,x_,d_) . e_) e_x_d_list))) (e_var (varn_star funn)) ([ ( funn , ( ([(stmt)]) ) , ( ([(scope')]) ) ) ]) ))) +( ( e_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , i , random_oracle ) g_scope_list scope_list (e_call funn ((MAP (\(e_,x_,d_) . e_) e_x_d_list))) (e_var (varn_star funn)) ( ([ ( funn , ( ([(stmt)]) ) , ( ([(scope')]) ) ) ]) , i_opt ) ))) -[e_call_args:] (! (e_e'_x_d_list:(e#e#x#d) list) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (g_scope_list:g_scope_list) (scope_list:scope_list) (funn:funn) (frame_list:frame_list) (i:i) (e:e) (e':e) . +[e_call_args:] (! (e_e'_x_d_list:(e#e#x#d) list) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (i':i) (random_oracle:random_oracle) (g_scope_list:g_scope_list) (scope_list:scope_list) (funn:funn) (e_red_res:e_red_res) (i:i) (e:e) (e':e) . (clause_name "e_call_args") /\ (( (SOME ((MAP (\(e_,e'_,x_,d_) . (x_,d_)) e_e'_x_d_list)) = lookup_funn_sig funn func_map b_func_map ext_map ) ) /\ ( (unred_arg_index ( ((MAP (\(e_,e'_,x_,d_) . d_) e_e'_x_d_list)) ) ( ((MAP (\(e_,e'_,x_,d_) . e_) e_e'_x_d_list)) ) = SOME i ) ) /\ ( ( e = EL i ( ((MAP (\(e_,e'_,x_,d_) . e_) e_e'_x_d_list)) ) ) ) /\ -( ( e_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) g_scope_list scope_list e e' frame_list )) /\ +( ( e_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , i' , random_oracle ) g_scope_list scope_list e e' e_red_res )) /\ ( ( ( ((MAP (\(e_,e'_,x_,d_) . e'_) e_e'_x_d_list)) ) = (LUPDATE e' i ( ((MAP (\(e_,e'_,x_,d_) . e_) e_e'_x_d_list)) ) ) ) )) ==> -( ( e_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) g_scope_list scope_list (e_call funn ((MAP (\(e_,e'_,x_,d_) . e_) e_e'_x_d_list))) (e_call funn ((MAP (\(e_,e'_,x_,d_) . e'_) e_e'_x_d_list))) frame_list ))) +( ( e_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , i' , random_oracle ) g_scope_list scope_list (e_call funn ((MAP (\(e_,e'_,x_,d_) . e_) e_e'_x_d_list))) (e_call funn ((MAP (\(e_,e'_,x_,d_) . e'_) e_e'_x_d_list))) e_red_res ))) -[e_eStruct:] (! (f_e_e'_list:(x#e#e) list) (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (frame_list:frame_list) (i:i) (e:e) (e':e) . +[e_eStruct:] (! (f_e_e'_list:(x#e#e) list) (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e_red_res:e_red_res) (i:i) (e:e) (e':e) . (clause_name "e_eStruct") /\ (( (unred_mem_index ( ((MAP (\(f_,e_,e'_) . e_) f_e_e'_list)) ) = SOME i ) ) /\ ( ( e = EL i ( ((MAP (\(f_,e_,e'_) . e_) f_e_e'_list)) ) ) ) /\ -( ( e_red ctx g_scope_list scope_list e e' frame_list )) /\ +( ( e_red ectx g_scope_list scope_list e e' e_red_res )) /\ ( ( ( ((MAP (\(f_,e_,e'_) . e'_) f_e_e'_list)) ) = (LUPDATE e' i ( ((MAP (\(f_,e_,e'_) . e_) f_e_e'_list)) ) ) ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_struct ((MAP (\(f_,e_,e'_) . (f_,e_)) f_e_e'_list))) (e_struct ((MAP (\(f_,e_,e'_) . (f_,e'_)) f_e_e'_list))) frame_list ))) +( ( e_red ectx g_scope_list scope_list (e_struct ((MAP (\(f_,e_,e'_) . (f_,e_)) f_e_e'_list))) (e_struct ((MAP (\(f_,e_,e'_) . (f_,e'_)) f_e_e'_list))) e_red_res ))) -[e_eStruct_to_v:] (! (f_e_v_list:(x#e#v) list) (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) . +[e_eStruct_to_v:] (! (f_e_v_list:(x#e#v) list) (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) . (clause_name "e_eStruct_to_v") /\ (( (is_consts ( ((MAP (\(f_,e_,v_) . e_) f_e_v_list)) ) ) ) /\ ( ( ( ((MAP (\(f_,e_,v_) . v_) f_e_v_list)) ) = vl_of_el ( ((MAP (\(f_,e_,v_) . e_) f_e_v_list)) ) ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_struct ((MAP (\(f_,e_,v_) . (f_,e_)) f_e_v_list))) (e_v (v_struct ((MAP (\(f_,e_,v_) . (f_,v_)) f_e_v_list)))) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_struct ((MAP (\(f_,e_,v_) . (f_,e_)) f_e_v_list))) (e_v (v_struct ((MAP (\(f_,e_,v_) . (f_,v_)) f_e_v_list)))) ([], (NONE:num option)) ))) -[e_s_acc:] (! (f_v_list:(x#v) list) (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (f:x) (v:v) . +[e_s_acc:] (! (f_v_list:(x#v) list) (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (f:x) (v:v) . (clause_name "e_s_acc") /\ (( (FIND (\(k, v). k = f ) (f_v_list) = SOME ( f , v )) )) ==> -( ( e_red ctx g_scope_list scope_list (e_acc (e_v (v_struct (f_v_list))) f) (e_v v) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_acc (e_v (v_struct (f_v_list))) f) (e_v v) ([], (NONE:num option)) ))) -[e_acc_arg1:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) (f:x) (e':e) (frame_list:frame_list) . +[e_acc_arg1:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) (f:x) (e':e) (e_red_res:e_red_res) . (clause_name "e_acc_arg1") /\ -(( ( e_red ctx g_scope_list scope_list e e' frame_list ))) +(( ( e_red ectx g_scope_list scope_list e e' e_red_res ))) ==> -( ( e_red ctx g_scope_list scope_list (e_acc e f) (e_acc e' f) frame_list ))) +( ( e_red ectx g_scope_list scope_list (e_acc e f) (e_acc e' f) e_red_res ))) -[e_eHeader:] (! (f_e_e'_list:(x#e#e) list) (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (boolv:boolv) (frame_list:frame_list) (i:i) (e:e) (e':e) . +[e_eHeader:] (! (f_e_e'_list:(x#e#e) list) (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (boolv:boolv) (e_red_res:e_red_res) (i:i) (e:e) (e':e) . (clause_name "e_eHeader") /\ (( (unred_mem_index ( ((MAP (\(f_,e_,e'_) . e_) f_e_e'_list)) ) = SOME i ) ) /\ ( ( e = EL i ( ((MAP (\(f_,e_,e'_) . e_) f_e_e'_list)) ) ) ) /\ -( ( e_red ctx g_scope_list scope_list e e' frame_list )) /\ +( ( e_red ectx g_scope_list scope_list e e' e_red_res )) /\ ( ( ( ((MAP (\(f_,e_,e'_) . e'_) f_e_e'_list)) ) = (LUPDATE e' i ( ((MAP (\(f_,e_,e'_) . e_) f_e_e'_list)) ) ) ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_header boolv ((MAP (\(f_,e_,e'_) . (f_,e_)) f_e_e'_list))) (e_header boolv ((MAP (\(f_,e_,e'_) . (f_,e'_)) f_e_e'_list))) frame_list ))) +( ( e_red ectx g_scope_list scope_list (e_header boolv ((MAP (\(f_,e_,e'_) . (f_,e_)) f_e_e'_list))) (e_header boolv ((MAP (\(f_,e_,e'_) . (f_,e'_)) f_e_e'_list))) e_red_res ))) -[e_eHeader_to_v:] (! (f_e_v_list:(x#e#v) list) (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (boolv:boolv) . +[e_eHeader_to_v:] (! (f_e_v_list:(x#e#v) list) (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (boolv:boolv) . (clause_name "e_eHeader_to_v") /\ (( (is_consts ( ((MAP (\(f_,e_,v_) . e_) f_e_v_list)) ) ) ) /\ ( ( ( ((MAP (\(f_,e_,v_) . v_) f_e_v_list)) ) = vl_of_el ( ((MAP (\(f_,e_,v_) . e_) f_e_v_list)) ) ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_header boolv ((MAP (\(f_,e_,v_) . (f_,e_)) f_e_v_list))) (e_v (v_header boolv ((MAP (\(f_,e_,v_) . (f_,v_)) f_e_v_list)))) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_header boolv ((MAP (\(f_,e_,v_) . (f_,e_)) f_e_v_list))) (e_v (v_header boolv ((MAP (\(f_,e_,v_) . (f_,v_)) f_e_v_list)))) ([], (NONE:num option)) ))) -[e_h_acc:] (! (f_v_list:(x#v) list) (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (boolv:boolv) (f:x) (v:v) . +[e_h_acc:] (! (f_v_list:(x#v) list) (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (boolv:boolv) (f:x) (v:v) . (clause_name "e_h_acc") /\ (( (FIND (\(k, v). k = f ) (f_v_list) = SOME ( f , v )) )) ==> -( ( e_red ctx g_scope_list scope_list (e_acc (e_v (v_header boolv (f_v_list))) f) (e_v v) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_acc (e_v (v_header boolv (f_v_list))) f) (e_v v) ([], (NONE:num option)) ))) -[e_sel_acc:] (! (s_list_x_list:(s_list#x) list) (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (v:v) (x:x) (x':x) . +[e_sel_acc:] (! (s_list_x_list:(s_list#x) list) (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (v:v) (x:x) (x':x) . (clause_name "e_sel_acc") /\ (( x' = sel v (s_list_x_list) x )) ==> -( ( e_red ctx g_scope_list scope_list (e_select (e_v v) (s_list_x_list) x) (e_v (v_str x')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_select (e_v v) (s_list_x_list) x) (e_v (v_str x')) ([], (NONE:num option)) ))) -[e_concat_arg1:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) (e':e) (e'':e) (frame_list:frame_list) . +[e_concat_arg1:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) (e':e) (e'':e) (e_red_res:e_red_res) . (clause_name "e_concat_arg1") /\ -(( ( e_red ctx g_scope_list scope_list e e'' frame_list ))) +(( ( e_red ectx g_scope_list scope_list e e'' e_red_res ))) ==> -( ( e_red ctx g_scope_list scope_list (e_concat e e') (e_concat e'' e') frame_list ))) +( ( e_red ectx g_scope_list scope_list (e_concat e e') (e_concat e'' e') e_red_res ))) -[e_concat_arg2:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (e:e) (e':e) (frame_list:frame_list) . +[e_concat_arg2:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (e:e) (e':e) (e_red_res:e_red_res) . (clause_name "e_concat_arg2") /\ -(( ( e_red ctx g_scope_list scope_list e e' frame_list ))) +(( ( e_red ectx g_scope_list scope_list e e' e_red_res ))) ==> -( ( e_red ctx g_scope_list scope_list (e_concat (e_v (v_bit bitv)) e) (e_concat (e_v (v_bit bitv)) e') frame_list ))) +( ( e_red ectx g_scope_list scope_list (e_concat (e_v (v_bit bitv)) e) (e_concat (e_v (v_bit bitv)) e') e_red_res ))) -[e_concat_v:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_concat_v:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_concat_v") /\ (( ( bitv'' = bitv_concat bitv bitv' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_concat (e_v (v_bit bitv)) (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_concat (e_v (v_bit bitv)) (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_slice_arg1:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) (bitv:bitv) (bitv':bitv) (e':e) (frame_list:frame_list) . +[e_slice_arg1:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) (bitv:bitv) (bitv':bitv) (e':e) (e_red_res:e_red_res) . (clause_name "e_slice_arg1") /\ -(( ( e_red ctx g_scope_list scope_list e e' frame_list ))) +(( ( e_red ectx g_scope_list scope_list e e' e_red_res ))) ==> -( ( e_red ctx g_scope_list scope_list (e_slice e (e_v (v_bit bitv)) (e_v (v_bit bitv'))) (e_slice e' (e_v (v_bit bitv)) (e_v (v_bit bitv'))) frame_list ))) +( ( e_red ectx g_scope_list scope_list (e_slice e (e_v (v_bit bitv)) (e_v (v_bit bitv'))) (e_slice e' (e_v (v_bit bitv)) (e_v (v_bit bitv'))) e_red_res ))) -[e_slice_v:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) (bitv''':bitv) . +[e_slice_v:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) (bitv''':bitv) . (clause_name "e_slice_v") /\ (( bitv''' = slice bitv bitv' bitv'' )) ==> -( ( e_red ctx g_scope_list scope_list (e_slice (e_v (v_bit bitv)) (e_v (v_bit bitv')) (e_v (v_bit bitv''))) (e_v (v_bit bitv''')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_slice (e_v (v_bit bitv)) (e_v (v_bit bitv')) (e_v (v_bit bitv''))) (e_v (v_bit bitv''')) ([], (NONE:num option)) ))) -[e_sel_arg:] (! (s_list_x_list:(s_list#x) list) (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) (x:x) (e':e) (frame_list:frame_list) . +[e_sel_arg:] (! (s_list_x_list:(s_list#x) list) (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) (x:x) (e':e) (e_red_res:e_red_res) . (clause_name "e_sel_arg") /\ -(( ( e_red ctx g_scope_list scope_list e e' frame_list ))) +(( ( e_red ectx g_scope_list scope_list e e' e_red_res ))) ==> -( ( e_red ctx g_scope_list scope_list (e_select e (s_list_x_list) x) (e_select e' (s_list_x_list) x) frame_list ))) +( ( e_red ectx g_scope_list scope_list (e_select e (s_list_x_list) x) (e_select e' (s_list_x_list) x) e_red_res ))) -[e_unop_arg:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (unop:unop) (e:e) (e':e) (frame_list:frame_list) . +[e_unop_arg:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (unop:unop) (e:e) (e':e) (e_red_res:e_red_res) . (clause_name "e_unop_arg") /\ -(( ( e_red ctx g_scope_list scope_list e e' frame_list ))) +(( ( e_red ectx g_scope_list scope_list e e' e_red_res ))) ==> -( ( e_red ctx g_scope_list scope_list (e_unop unop e) (e_unop unop e') frame_list ))) +( ( e_red ectx g_scope_list scope_list (e_unop unop e) (e_unop unop e') e_red_res ))) -[e_cast_arg:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (cast:cast) (e:e) (e':e) (frame_list:frame_list) . +[e_cast_arg:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (cast:cast) (e:e) (e':e) (e_red_res:e_red_res) . (clause_name "e_cast_arg") /\ -(( ( e_red ctx g_scope_list scope_list e e' frame_list ))) +(( ( e_red ectx g_scope_list scope_list e e' e_red_res ))) ==> -( ( e_red ctx g_scope_list scope_list (e_cast cast e) (e_cast cast e') frame_list ))) +( ( e_red ectx g_scope_list scope_list (e_cast cast e) (e_cast cast e') e_red_res ))) -[e_binop_arg1:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) (binop:binop) (e':e) (e'':e) (frame_list:frame_list) . +[e_binop_arg1:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) (binop:binop) (e':e) (e'':e) (e_red_res:e_red_res) . (clause_name "e_binop_arg1") /\ -(( ( e_red ctx g_scope_list scope_list e e'' frame_list ))) +(( ( e_red ectx g_scope_list scope_list e e'' e_red_res ))) ==> -( ( e_red ctx g_scope_list scope_list (e_binop e binop e') (e_binop e'' binop e') frame_list ))) +( ( e_red ectx g_scope_list scope_list (e_binop e binop e') (e_binop e'' binop e') e_red_res ))) -[e_binop_arg2:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (v:v) (binop:binop) (e:e) (e':e) (frame_list:frame_list) . +[e_binop_arg2:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (v:v) (binop:binop) (e:e) (e':e) (e_red_res:e_red_res) . (clause_name "e_binop_arg2") /\ (( (~is_short_circuitable binop ) ) /\ -( ( e_red ctx g_scope_list scope_list e e' frame_list ))) +( ( e_red ectx g_scope_list scope_list e e' e_red_res ))) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v v) binop e) (e_binop (e_v v) binop e') frame_list ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v v) binop e) (e_binop (e_v v) binop e') e_red_res ))) -[e_neg_bool:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (b:b) (b':b) . +[e_neg_bool:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (b:b) (b':b) . (clause_name "e_neg_bool") /\ (( (~ b = b' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_unop unop_neg (e_v (v_bool b ))) (e_v (v_bool b' )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_unop unop_neg (e_v (v_bool b ))) (e_v (v_bool b' )) ([], (NONE:num option)) ))) -[e_compl:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) . +[e_compl:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) . (clause_name "e_compl") /\ (( (bitv_bl_unop bnot bitv = bitv' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_unop unop_compl (e_v (v_bit bitv))) (e_v (v_bit bitv')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_unop unop_compl (e_v (v_bit bitv))) (e_v (v_bit bitv')) ([], (NONE:num option)) ))) -[e_neg_signed:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) . +[e_neg_signed:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) . (clause_name "e_neg_signed") /\ (( (bitv_unop unop_neg_signed bitv = bitv' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_unop unop_neg_signed (e_v (v_bit bitv))) (e_v (v_bit bitv')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_unop unop_neg_signed (e_v (v_bit bitv))) (e_v (v_bit bitv')) ([], (NONE:num option)) ))) -[e_un_plus:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) . +[e_un_plus:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) . (clause_name "e_un_plus") /\ (( ( bitv = bitv' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_unop unop_un_plus (e_v (v_bit bitv))) (e_v (v_bit bitv')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_unop unop_un_plus (e_v (v_bit bitv))) (e_v (v_bit bitv')) ([], (NONE:num option)) ))) -[e_cast_bitv:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (n:m) (bitv:bitv) (bitv':bitv) . +[e_cast_bitv:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (n:m) (bitv:bitv) (bitv':bitv) . (clause_name "e_cast_bitv") /\ (( (bitv_cast n bitv = bitv' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_cast (cast_unsigned n) (e_v (v_bit bitv))) (e_v (v_bit bitv')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_cast (cast_unsigned n) (e_v (v_bit bitv))) (e_v (v_bit bitv')) ([], (NONE:num option)) ))) -[e_cast_bool:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (n:m) (b:b) (bitv:bitv) . +[e_cast_bool:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (n:m) (b:b) (bitv:bitv) . (clause_name "e_cast_bool") /\ (( (bool_cast n b = bitv ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_cast (cast_unsigned n) (e_v (v_bool b ))) (e_v (v_bit bitv)) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_cast (cast_unsigned n) (e_v (v_bool b ))) (e_v (v_bit bitv)) ([], (NONE:num option)) ))) -[e_cast_to_bool:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (b:b) . +[e_cast_to_bool:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (b:b) . (clause_name "e_cast_to_bool") /\ (( (to_bool_cast bitv = b ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_cast cast_bool (e_v (v_bit bitv))) (e_v (v_bool b )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_cast cast_bool (e_v (v_bit bitv))) (e_v (v_bool b )) ([], (NONE:num option)) ))) -[e_cast_id_bool:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (b:b) (b':b) . +[e_cast_id_bool:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (b:b) (b':b) . (clause_name "e_cast_id_bool") /\ (( (id_bool_cast b = b' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_cast cast_bool (e_v (v_bool b ))) (e_v (v_bool b' )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_cast cast_bool (e_v (v_bool b ))) (e_v (v_bool b' )) ([], (NONE:num option)) ))) -[e_mul:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_mul:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_mul") /\ (( (bitv_binop binop_mul bitv bitv' = SOME bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_mul (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_mul (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_div:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_div:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_div") /\ (( (bitv_binop binop_div bitv bitv' = SOME bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_div (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_div (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_mod:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_mod:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_mod") /\ (( (bitv_binop binop_mod bitv bitv' = SOME bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_mod (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_mod (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_add:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_add:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_add") /\ (( (bitv_binop binop_add bitv bitv' = SOME bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_add (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_add (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_sat_add:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_sat_add:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_sat_add") /\ (( (bitv_binop binop_sat_add bitv bitv' = SOME bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_sat_add (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_sat_add (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_sub:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_sub:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_sub") /\ (( (bitv_binop binop_sub bitv bitv' = SOME bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_sub (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_sub (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_sat_sub:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_sat_sub:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_sat_sub") /\ (( (bitv_binop binop_sat_sub bitv bitv' = SOME bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_sat_sub (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_sat_sub (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_shl:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_shl:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_shl") /\ (( (bitv_bl_binop shiftl bitv ((\(bl, n). (v2n bl, n)) bitv' ) = bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_shl (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_shl (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_shr:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_shr:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_shr") /\ (( (bitv_bl_binop shiftr bitv ((\(bl, n). (v2n bl, n)) bitv' ) = bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_shr (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_shr (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_le:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . +[e_le:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . (clause_name "e_le") /\ (( ((bitv_binpred binop_le bitv bitv' ) = SOME b ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_le (e_v (v_bit bitv'))) (e_v (v_bool b )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_le (e_v (v_bit bitv'))) (e_v (v_bool b )) ([], (NONE:num option)) ))) -[e_ge:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . +[e_ge:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . (clause_name "e_ge") /\ (( ((bitv_binpred binop_ge bitv bitv' ) = SOME b ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_ge (e_v (v_bit bitv'))) (e_v (v_bool b )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_ge (e_v (v_bit bitv'))) (e_v (v_bool b )) ([], (NONE:num option)) ))) -[e_lt:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . +[e_lt:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . (clause_name "e_lt") /\ (( ((bitv_binpred binop_lt bitv bitv' ) = SOME b ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_lt (e_v (v_bit bitv'))) (e_v (v_bool b )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_lt (e_v (v_bit bitv'))) (e_v (v_bool b )) ([], (NONE:num option)) ))) -[e_gt:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . +[e_gt:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . (clause_name "e_gt") /\ (( ((bitv_binpred binop_gt bitv bitv' ) = SOME b ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_gt (e_v (v_bit bitv'))) (e_v (v_bool b )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_gt (e_v (v_bit bitv'))) (e_v (v_bool b )) ([], (NONE:num option)) ))) -[e_neq:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . +[e_neq:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . (clause_name "e_neq") /\ (( (( bitv <> bitv' ) <=> b ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_neq (e_v (v_bit bitv'))) (e_v (v_bool b )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_neq (e_v (v_bit bitv'))) (e_v (v_bool b )) ([], (NONE:num option)) ))) -[e_neq_bool:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (b:b) (b':b) (b'':b) . +[e_neq_bool:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (b:b) (b':b) (b'':b) . (clause_name "e_neq_bool") /\ (( (( b <> b' ) <=> b'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bool b )) binop_neq (e_v (v_bool b' ))) (e_v (v_bool b'' )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bool b )) binop_neq (e_v (v_bool b' ))) (e_v (v_bool b'' )) ([], (NONE:num option)) ))) -[e_eq:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . +[e_eq:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (b:b) . (clause_name "e_eq") /\ (( (( bitv = bitv' ) <=> b ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_eq (e_v (v_bit bitv'))) (e_v (v_bool b )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_eq (e_v (v_bit bitv'))) (e_v (v_bool b )) ([], (NONE:num option)) ))) -[e_eq_bool:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (b:b) (b':b) (b'':b) . +[e_eq_bool:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (b:b) (b':b) (b'':b) . (clause_name "e_eq_bool") /\ (( ( b = b' <=> b'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bool b )) binop_eq (e_v (v_bool b' ))) (e_v (v_bool b'' )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bool b )) binop_eq (e_v (v_bool b' ))) (e_v (v_bool b'' )) ([], (NONE:num option)) ))) -[e_and:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_and:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_and") /\ (( (bitv_bl_binop band bitv bitv' = bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_and (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_and (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_xor:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_xor:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_xor") /\ (( (bitv_bl_binop bxor bitv bitv' = bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_xor (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_xor (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_or:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . +[e_or:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (bitv:bitv) (bitv':bitv) (bitv'':bitv) . (clause_name "e_or") /\ (( (bitv_bl_binop bor bitv bitv' = bitv'' ) )) ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_or (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bit bitv)) binop_or (e_v (v_bit bitv'))) (e_v (v_bit bitv'')) ([], (NONE:num option)) ))) -[e_bin_and1:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) . +[e_bin_and1:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) . (clause_name "e_bin_and1") ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bool F )) binop_bin_and e) (e_v (v_bool F )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bool F )) binop_bin_and e) (e_v (v_bool F )) ([], (NONE:num option)) ))) -[e_bin_and2:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) . +[e_bin_and2:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) . (clause_name "e_bin_and2") ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bool T )) binop_bin_and e) e ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bool T )) binop_bin_and e) e ([], (NONE:num option)) ))) -[e_bin_or1:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) . +[e_bin_or1:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) . (clause_name "e_bin_or1") ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bool T )) binop_bin_or e) (e_v (v_bool T )) ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bool T )) binop_bin_or e) (e_v (v_bool T )) ([], (NONE:num option)) ))) -[e_bin_or2:] (! (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) . +[e_bin_or2:] (! (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e:e) . (clause_name "e_bin_or2") ==> -( ( e_red ctx g_scope_list scope_list (e_binop (e_v (v_bool F )) binop_bin_or e) e ([]:frame list) ))) +( ( e_red ectx g_scope_list scope_list (e_binop (e_v (v_bool F )) binop_bin_or e) e ([], (NONE:num option)) ))) End (** definitions *) @@ -2527,20 +2554,20 @@ Inductive stmt_sem: ==> ( ( stmt_red ctx ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_cond (e_v (v_bool F )) stmt1 stmt2))]) ) , scope_list ) ]) , status_running ) ( ascope , g_scope_list , ([ ( funn , ( ([(stmt2)]) ) , scope_list ) ]) , status_running ) ))) -[stmt_block_enter:] (! (ctx:'a ctx) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (t_scope:t_scope) (stmt:stmt) (scope_list:scope_list) (scope_list':scope_list) (scope:scope) . +[stmt_block_enter:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (t_scope:t_scope) (stmt:stmt) (scope_list:scope_list) (i_opt:i_opt) (scope_list':scope_list) (scope:scope) . (clause_name "stmt_block_enter") /\ -(( ( scope ) = declare_list_in_fresh_scope ( t_scope ) ) /\ +(( ( scope , i_opt ) = declare_list_in_fresh_scope ( t_scope , get_oracle_index ascope , random_oracle ) ) /\ ( ( scope_list' = ( ( ([(scope)]) ) ++ scope_list ) ) )) ==> -( ( stmt_red ctx ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_block t_scope stmt))]) ) , scope_list ) ]) , status_running ) ( ascope , g_scope_list , ([ ( funn , ( stmt :: ( ([(stmt_empty)]) ) ) , scope_list' ) ]) , status_running ) ))) +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_block t_scope stmt))]) ) , scope_list ) ]) , status_running ) (set_oracle_index i_opt ascope , g_scope_list , ([ ( funn , ( stmt :: ( ([(stmt_empty)]) ) ) , scope_list' ) ]) , status_running ) ))) -[stmt_block_exec:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (stmt:stmt) (stmt_stack:stmt_stack) (scope_list:scope_list) (status:status) (ascope':'a) (g_scope_list':g_scope_list) (frame_list':frame_list) (stmt_stack':stmt_stack) (scope_list':scope_list) (status':status) . +[stmt_block_exec:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (stmt:stmt) (stmt_stack:stmt_stack) (scope_list:scope_list) (status:status) (ascope':'a) (g_scope_list':g_scope_list) (frame_list':frame_list) (stmt_stack':stmt_stack) (scope_list':scope_list) (status':status) . (clause_name "stmt_block_exec") /\ (( ( stmt <> stmt_empty) ) /\ ( ( stmt_stack <> []) ) /\ -( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , ([ ( funn , ( ([(stmt)]) ) , scope_list ) ]) , status ) ( ascope' , g_scope_list' , ( frame_list' ++ ([ ( funn , stmt_stack' , scope_list' ) ]) ) , status' ) ))) +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ([ ( funn , ( ([(stmt)]) ) , scope_list ) ]) , status ) ( ascope' , g_scope_list' , ( frame_list' ++ ([ ( funn , stmt_stack' , scope_list' ) ]) ) , status' ) ))) ==> -( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , ([ ( funn , ( stmt :: stmt_stack ) , scope_list ) ]) , status ) ( ascope' , g_scope_list' , ( frame_list' ++ ([ ( funn , ( stmt_stack' ++ stmt_stack ) , scope_list' ) ]) ) , status' ) ))) +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ([ ( funn , ( stmt :: stmt_stack ) , scope_list ) ]) , status ) ( ascope' , g_scope_list' , ( frame_list' ++ ([ ( funn , ( stmt_stack' ++ stmt_stack ) , scope_list' ) ]) ) , status' ) ))) [stmt_block_exit:] (! (ctx:'a ctx) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (stmt_stack:stmt_stack) (scope_list:scope_list) (status:status) (scope_list':scope_list) . (clause_name "stmt_block_exit") /\ @@ -2554,58 +2581,63 @@ Inductive stmt_sem: ==> ( ( stmt_red ctx ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_trans (e_v (v_str x))))]) ) , scope_list ) ]) , status_running ) ( ascope , g_scope_list , ([ ( funn , ( ([(stmt_empty)]) ) , scope_list ) ]) , (status_trans x) ) ))) -[stmt_apply_table_v:] (! (e'_list:e list) (e_mk_list:(e#mk) list) (v_list:v list) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (tbl:x) (scope_list:scope_list) (f:x) (f':x) . +[stmt_apply_table_v:] (! (e'_list:e list) (e_mk_list:(e#mk) list) (v_list:v list) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (tbl:x) (scope_list:scope_list) (f:x) (f':x) . (clause_name "stmt_apply_table_v") /\ (( (is_consts ( ((MAP (\(e_,mk_) . e_) e_mk_list)) ) ) ) /\ ( ( ALOOKUP tbl_map tbl = SOME ( ( ((MAP (\(e_,mk_) . mk_) e_mk_list)) ) , ( f' , ( (e'_list) ) ) ) ) ) /\ ( ( apply_table_f ( tbl , ( ( ((MAP (\(e_,mk_) . e_) e_mk_list)) ) ) , ( ( ((MAP (\(e_,mk_) . mk_) e_mk_list)) ) ) , ( f' , ( (e'_list) ) ), ascope ) = SOME ( f , ( ( ((MAP (\v_ . (e_v v_)) v_list)) ) ) ) ) )) ==> -( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_app tbl ((MAP (\(e_,mk_) . e_) e_mk_list))))]) ) , scope_list ) ]) , status_running ) ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_ass lval_null ( (e_call (funn_name f) ((MAP (\v_ . (e_v v_)) v_list))) ) ))]) ) , scope_list ) ]) , status_running ) ))) +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_app tbl ((MAP (\(e_,mk_) . e_) e_mk_list))))]) ) , scope_list ) ]) , status_running ) ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_ass lval_null ( (e_call (funn_name f) ((MAP (\v_ . (e_v v_)) v_list))) ) ))]) ) , scope_list ) ]) , status_running ) ))) [stmt_ret_v:] (! (ctx:'a ctx) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (v:v) (scope_list:scope_list) . (clause_name "stmt_ret_v") ==> ( ( stmt_red ctx ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_ret (e_v v)))]) ) , scope_list ) ]) , status_running ) ( ascope , g_scope_list , ([ ( funn , ( ([(stmt_empty)]) ) , scope_list ) ]) , (status_returnv v) ) ))) -[stmt_ext:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (scope_list:scope_list) (ascope':'a) (scope_list':scope_list) (status:status) (ext_fun:'a ext_fun) . +[stmt_ext:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (scope_list:scope_list) (ascope':'a) (scope_list':scope_list) (status:status) (ext_fun:'a ext_fun) . (clause_name "stmt_ext") /\ (( (SOME ext_fun = lookup_ext_fun funn ext_map ) ) /\ ( (SOME ( ascope' , scope_list' , status ) = ext_fun ( ascope , g_scope_list , scope_list )) )) ==> -( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , ([ ( funn , ( ([(stmt_ext)]) ) , scope_list ) ]) , status_running ) ( ascope' , g_scope_list , ([ ( funn , ( ([(stmt_empty)]) ) , scope_list' ) ]) , status ) ))) +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ([ ( funn , ( ([(stmt_ext)]) ) , scope_list ) ]) , status_running ) ( ascope' , g_scope_list , ([ ( funn , ( ([(stmt_empty)]) ) , scope_list' ) ]) , status ) ))) -[stmt_ret_e:] (! (ctx:'a ctx) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (e:e) (scope_list:scope_list) (frame_list:frame_list) (e':e) . +[stmt_ret_e:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (e:e) (scope_list:scope_list) (i_opt:i_opt) (frame_list:frame_list) (e':e) (ectx:'a ectx) . (clause_name "stmt_ret_e") /\ -(( ( e_red ctx g_scope_list scope_list e e' frame_list ))) +(( ( ectx = get_ectx ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ascope ) ) /\ +( ( e_red ectx g_scope_list scope_list e e' ( frame_list , i_opt ) ))) ==> -( ( stmt_red ctx ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_ret e))]) ) , scope_list ) ]) , status_running ) ( ascope , g_scope_list , ( frame_list ++ ([ ( funn , ( ([((stmt_ret e'))]) ) , scope_list ) ]) ) , status_running ) ))) +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_ret e))]) ) , scope_list ) ]) , status_running ) (set_oracle_index i_opt ascope , g_scope_list , ( frame_list ++ ([ ( funn , ( ([((stmt_ret e'))]) ) , scope_list ) ]) ) , status_running ) ))) -[stmt_ass_e:] (! (ctx:'a ctx) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (lval:lval) (e:e) (scope_list:scope_list) (frame_list:frame_list) (e':e) . +[stmt_ass_e:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (lval:lval) (e:e) (scope_list:scope_list) (i_opt:i_opt) (frame_list:frame_list) (e':e) (ectx:'a ectx) . (clause_name "stmt_ass_e") /\ -(( ( e_red ctx g_scope_list scope_list e e' frame_list ))) +(( ( ectx = get_ectx ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ascope ) ) /\ +( ( e_red ectx g_scope_list scope_list e e' ( frame_list , i_opt ) ))) ==> -( ( stmt_red ctx ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_ass lval e))]) ) , scope_list ) ]) , status_running ) ( ascope , g_scope_list , ( frame_list ++ ([ ( funn , ( ([((stmt_ass lval e'))]) ) , scope_list ) ]) ) , status_running ) ))) +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_ass lval e))]) ) , scope_list ) ]) , status_running ) (set_oracle_index i_opt ascope , g_scope_list , ( frame_list ++ ([ ( funn , ( ([((stmt_ass lval e'))]) ) , scope_list ) ]) ) , status_running ) ))) -[stmt_cond_e:] (! (ctx:'a ctx) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (e:e) (stmt1:stmt) (stmt2:stmt) (scope_list:scope_list) (frame_list:frame_list) (e':e) . +[stmt_cond_e:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (e:e) (stmt1:stmt) (stmt2:stmt) (scope_list:scope_list) (i_opt:i_opt) (frame_list:frame_list) (e':e) (ectx:'a ectx) . (clause_name "stmt_cond_e") /\ -(( ( e_red ctx g_scope_list scope_list e e' frame_list ))) +(( ( ectx = get_ectx ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ascope ) ) /\ +( ( e_red ectx g_scope_list scope_list e e' ( frame_list , i_opt ) ))) ==> -( ( stmt_red ctx ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_cond e stmt1 stmt2))]) ) , scope_list ) ]) , status_running ) ( ascope , g_scope_list , ( frame_list ++ ([ ( funn , ( ([((stmt_cond e' stmt1 stmt2))]) ) , scope_list ) ]) ) , status_running ) ))) +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_cond e stmt1 stmt2))]) ) , scope_list ) ]) , status_running ) (set_oracle_index i_opt ascope , g_scope_list , ( frame_list ++ ([ ( funn , ( ([((stmt_cond e' stmt1 stmt2))]) ) , scope_list ) ]) ) , status_running ) ))) -[stmt_trans_e:] (! (ctx:'a ctx) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (e:e) (scope_list:scope_list) (frame_list:frame_list) (e':e) . +[stmt_trans_e:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (e:e) (scope_list:scope_list) (i_opt:i_opt) (frame_list:frame_list) (e':e) (ectx:'a ectx) . (clause_name "stmt_trans_e") /\ -(( ( e_red ctx g_scope_list scope_list e e' frame_list ))) +(( ( ectx = get_ectx ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ascope ) ) /\ +( ( e_red ectx g_scope_list scope_list e e' ( frame_list , i_opt ) ))) ==> -( ( stmt_red ctx ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_trans e))]) ) , scope_list ) ]) , status_running ) ( ascope , g_scope_list , ( frame_list ++ ([ ( funn , ( ([((stmt_trans e'))]) ) , scope_list ) ]) ) , status_running ) ))) +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_trans e))]) ) , scope_list ) ]) , status_running ) (set_oracle_index i_opt ascope , g_scope_list , ( frame_list ++ ([ ( funn , ( ([((stmt_trans e'))]) ) , scope_list ) ]) ) , status_running ) ))) -[stmt_apply_table_e:] (! (e_e'_list:(e#e) list) (ctx:'a ctx) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (tbl:x) (scope_list:scope_list) (frame_list:frame_list) (i:i) (e:e) (e':e) . +[stmt_apply_table_e:] (! (e_e'_list:(e#e) list) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (tbl:x) (scope_list:scope_list) (i_opt:i_opt) (frame_list:frame_list) (i:i) (e:e) (ectx:'a ectx) (e':e) . (clause_name "stmt_apply_table_e") /\ (( (index_not_const ( ((MAP (\(e_,e'_) . e_) e_e'_list)) ) = SOME i ) ) /\ ( ( e = EL i ( ((MAP (\(e_,e'_) . e_) e_e'_list)) ) ) ) /\ -( ( e_red ctx g_scope_list scope_list e e' frame_list )) /\ +( ( ectx = get_ectx ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ascope ) ) /\ +( ( e_red ectx g_scope_list scope_list e e' ( frame_list , i_opt ) )) /\ ( ( ( ((MAP (\(e_,e'_) . e'_) e_e'_list)) ) = (LUPDATE e' i ( ((MAP (\(e_,e'_) . e_) e_e'_list)) ) ) ) )) ==> -( ( stmt_red ctx ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_app tbl ((MAP (\(e_,e'_) . e_) e_e'_list))))]) ) , scope_list ) ]) , status_running ) ( ascope , g_scope_list , ( frame_list ++ ([ ( funn , ( ([((stmt_app tbl ((MAP (\(e_,e'_) . e'_) e_e'_list))))]) ) , scope_list ) ]) ) , status_running ) ))) +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ([ ( funn , ( ([((stmt_app tbl ((MAP (\(e_,e'_) . e_) e_e'_list))))]) ) , scope_list ) ]) , status_running ) (set_oracle_index i_opt ascope , g_scope_list , ( frame_list ++ ([ ( funn , ( ([((stmt_app tbl ((MAP (\(e_,e'_) . e'_) e_e'_list))))]) ) , scope_list ) ]) ) , status_running ) ))) End (** definitions *) @@ -2613,23 +2645,23 @@ End Inductive frames_sem: (* defn frames_red *) -[frames_comp1:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (stmt_stack:stmt_stack) (scope_list:scope_list) (frame_list'':frame_list) (status:status) (ascope':'a) (g_scope_list''':g_scope_list) (frame_list':frame_list) (status':status) (g_scope_list':g_scope_list) (b_func_map':b_func_map) (tbl_map':tbl_map) (g_scope_list'':g_scope_list) . +[frames_comp1:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (stmt_stack:stmt_stack) (scope_list:scope_list) (frame_list'':frame_list) (status:status) (ascope':'a) (g_scope_list''':g_scope_list) (frame_list':frame_list) (status':status) (g_scope_list':g_scope_list) (b_func_map':b_func_map) (tbl_map':tbl_map) (g_scope_list'':g_scope_list) . (clause_name "frames_comp1") /\ (( (SOME g_scope_list' = scopes_to_pass funn func_map b_func_map g_scope_list ) ) /\ ( SOME b_func_map' = map_to_pass funn b_func_map ) /\ ( SOME tbl_map' = tbl_to_pass funn b_func_map tbl_map ) /\ -( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map' , pars_map , tbl_map' ) ( ascope , g_scope_list' , ([ ( funn , stmt_stack , scope_list ) ]) , status ) ( ascope' , g_scope_list'' , frame_list' , status' ) )) /\ +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map' , pars_map , tbl_map' , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list' , ([ ( funn , stmt_stack , scope_list ) ]) , status ) ( ascope' , g_scope_list'' , frame_list' , status' ) )) /\ ( ( ( frame_list'' <> []) ==> notret status' ) ) /\ ( (SOME g_scope_list''' = scopes_to_retrieve funn func_map b_func_map g_scope_list g_scope_list'' ) )) ==> -( ( frames_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , ( ([ ( funn , stmt_stack , scope_list ) ]) ++ frame_list'' ) , status ) ( ascope' , g_scope_list''' , ( frame_list' ++ frame_list'' ) , status' ) ))) +( ( frames_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ( ([ ( funn , stmt_stack , scope_list ) ]) ++ frame_list'' ) , status ) ( ascope' , g_scope_list''' , ( frame_list' ++ frame_list'' ) , status' ) ))) -[frames_comp2:] (! (x_d_list:(x#d) list) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (stmt_stack:stmt_stack) (scope_list:scope_list) (funn':funn) (stmt_stack':stmt_stack) (scope_list':scope_list) (frame_list:frame_list) (ascope':'a) (g_scope_list''''''':g_scope_list) (scope_list''':scope_list) (g_scope_list':g_scope_list) (b_func_map':b_func_map) (tbl_map':tbl_map) (g_scope_list'':g_scope_list) (stmt_stack'':stmt_stack) (scope_list'':scope_list) (v:v) (stmt''':stmt) (g_scope_list''':g_scope_list) (g_scope_list'''':g_scope_list) (g_scope_list''''':g_scope_list) (g_scope_list'''''':g_scope_list) . +[frames_comp2:] (! (x_d_list:(x#d) list) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (funn:funn) (stmt_stack:stmt_stack) (scope_list:scope_list) (funn':funn) (stmt_stack':stmt_stack) (scope_list':scope_list) (frame_list:frame_list) (ascope':'a) (g_scope_list''''''':g_scope_list) (scope_list''':scope_list) (g_scope_list':g_scope_list) (b_func_map':b_func_map) (tbl_map':tbl_map) (g_scope_list'':g_scope_list) (stmt_stack'':stmt_stack) (scope_list'':scope_list) (v:v) (stmt''':stmt) (g_scope_list''':g_scope_list) (g_scope_list'''':g_scope_list) (g_scope_list''''':g_scope_list) (g_scope_list'''''':g_scope_list) . (clause_name "frames_comp2") /\ (( (SOME g_scope_list' = scopes_to_pass funn func_map b_func_map g_scope_list ) ) /\ ( SOME b_func_map' = map_to_pass funn b_func_map ) /\ ( SOME tbl_map' = tbl_to_pass funn b_func_map tbl_map ) /\ -( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map' , pars_map , tbl_map' ) ( ascope , g_scope_list' , ([ ( funn , stmt_stack , scope_list ) ]) , status_running ) ( ascope' , g_scope_list'' , ([ ( funn , stmt_stack'' , scope_list'' ) ]) , (status_returnv v) ) )) /\ +( ( stmt_red ( apply_table_f , ext_map , func_map , b_func_map' , pars_map , tbl_map' , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list' , ([ ( funn , stmt_stack , scope_list ) ]) , status_running ) ( ascope' , g_scope_list'' , ([ ( funn , stmt_stack'' , scope_list'' ) ]) , (status_returnv v) ) )) /\ ( (SOME ( stmt''' , (x_d_list) ) = lookup_funn_sig_body funn func_map b_func_map ext_map ) ) /\ ( (SOME ( g_scope_list''' ) = assign ( ( g_scope_list'' ) ) v (lval_varname (varn_star funn)) ) ) /\ ( (SOME g_scope_list'''' = scopes_to_retrieve funn func_map b_func_map g_scope_list g_scope_list''' ) ) /\ @@ -2637,7 +2669,7 @@ Inductive frames_sem: ( ( SOME ( g_scope_list'''''' , scope_list''' ) = copyout ((MAP (\(x_,d_) . x_) x_d_list)) ( ((MAP (\(x_,d_) . d_) x_d_list)) ) g_scope_list''''' scope_list' scope_list'' ) ) /\ ( (SOME g_scope_list''''''' = scopes_to_retrieve funn' func_map b_func_map g_scope_list'''' g_scope_list'''''' ) )) ==> -( ( frames_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , ( ([ ( funn , stmt_stack , scope_list ) ]) ++ ( ( ([ ( funn' , stmt_stack' , scope_list' ) ]) ++ frame_list ) ) ) , status_running ) ( ascope' , g_scope_list''''''' , ( ([ ( funn' , stmt_stack' , scope_list''' ) ]) ++ frame_list ) , status_running ) ))) +( ( frames_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ( ([ ( funn , stmt_stack , scope_list ) ]) ++ ( ( ([ ( funn' , stmt_stack' , scope_list' ) ]) ++ frame_list ) ) ) , status_running ) ( ascope' , g_scope_list''''''' , ( ([ ( funn' , stmt_stack' , scope_list''' ) ]) ++ frame_list ) , status_running ) ))) End (** definitions *) @@ -2645,59 +2677,59 @@ End Inductive arch_sem: (* defn arch_red *) -[arch_in:] (! (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (in_out_list'':in_out_list) (ascope':'a) . +[arch_in:] (! (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (in_out_list'':in_out_list) (ascope':'a) . (clause_name "arch_in") /\ (( ( arch_block_inp = EL i ab_list ) ) /\ ( ( SOME ( in_out_list'' , ascope' ) = input_f ( in_out_list , ascope ) ) )) ==> -( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , status_running ) ( ( ( i + 1 ) , in_out_list'' , in_out_list' , ascope' ) , g_scope_list , arch_frame_list_empty , status_running ) ))) +( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , status_running ) ( ( ( i + 1 ) , in_out_list'' , in_out_list' , ascope' ) , g_scope_list , arch_frame_list_empty , status_running ) ))) -[arch_pbl_init:] (! (e_x_d_list:(e#x#d) list) (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (g_scope_list''':g_scope_list) (f:x) (stmt:stmt) (pbl_type:pbl_type) (b_func_map:b_func_map) (t_scope:t_scope) (pars_map:pars_map) (tbl_map:tbl_map) (scope':scope) (scope'':scope) (g_scope_list':g_scope_list) (g_scope_list'':g_scope_list) . +[arch_pbl_init:] (! (e_x_d_list:(e#x#d) list) (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (i_opt':i_opt) (g_scope_list''':g_scope_list) (f:x) (stmt:stmt) (pbl_type:pbl_type) (b_func_map:b_func_map) (t_scope:t_scope) (pars_map:pars_map) (tbl_map:tbl_map) (scope':scope) (i_opt:i_opt) (scope'':scope) (g_scope_list':g_scope_list) (g_scope_list'':g_scope_list) . (clause_name "arch_pbl_init") /\ (( ( (arch_block_pbl f ((MAP (\(e_,x_,d_) . e_) e_x_d_list))) = EL i ab_list ) ) /\ ( (ALOOKUP pblock_map f = SOME ( pbl_type , ((MAP (\(e_,x_,d_) . (x_,d_)) e_x_d_list)) , b_func_map , t_scope , pars_map , tbl_map )) ) /\ ( (SOME stmt = lookup_block_body f b_func_map ) ) /\ -( (SOME scope' = copyin_pbl ( ((MAP (\(e_,x_,d_) . x_) e_x_d_list)) , ( ((MAP (\(e_,x_,d_) . d_) e_x_d_list)) ) , ( ((MAP (\(e_,x_,d_) . e_) e_x_d_list)) ) , ascope )) ) /\ -( scope'' = declare_list_in_scope ( t_scope , scope' ) ) /\ +( (SOME ( scope' , i_opt ) = copyin_pbl ( ((MAP (\(e_,x_,d_) . x_) e_x_d_list)) , ( ((MAP (\(e_,x_,d_) . d_) e_x_d_list)) ) , ( ((MAP (\(e_,x_,d_) . e_) e_x_d_list)) ) , ascope , random_oracle )) ) /\ +( ( scope'' , i_opt' ) = declare_list_in_scope ( t_scope , scope' , i_opt , get_oracle_index ascope , random_oracle ) ) /\ ( ( ( g_scope_list' ) = ( (LASTN 1 g_scope_list ) ) ) ) /\ ( ( ( g_scope_list'' ) = ( ( ([(scope'')]) ) ++ ( g_scope_list' ) ) ) ) /\ ( (SOME g_scope_list''' = initialise_var_stars func_map b_func_map ext_map g_scope_list'' ) )) ==> -( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , status_running ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list''' , (arch_frame_list_regular ([ ( (funn_name f) , ( ([(stmt)]) ) , ( ([( [] )]) ) ) ]) ) , status_running ) ))) +( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , status_running ) ( ( i , in_out_list , in_out_list' , set_oracle_index i_opt' ascope ) , g_scope_list''' , (arch_frame_list_regular ([ ( (funn_name f) , ( ([(stmt)]) ) , ( ([( [] )]) ) ) ]) ) , status_running ) ))) -[arch_ffbl:] (! (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (ascope':'a) (x:x) (ff:'a ff) . +[arch_ffbl:] (! (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (ascope':'a) (x:x) (ff:'a ff) . (clause_name "arch_ffbl") /\ (( ( (arch_block_ffbl x) = EL i ab_list ) ) /\ ( (ALOOKUP ffblock_map x = SOME (ffblock_ff ff) ) ) /\ ( (SOME ascope' = ff ( ascope ) ) )) ==> -( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , status_running ) ( ( ( i + 1 ) , in_out_list , in_out_list' , ascope' ) , g_scope_list , arch_frame_list_empty , status_running ) ))) +( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , status_running ) ( ( ( i + 1 ) , in_out_list , in_out_list' , ascope' ) , g_scope_list , arch_frame_list_empty , status_running ) ))) -[arch_out:] (! (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (in_out_list'':in_out_list) (ascope':'a) . +[arch_out:] (! (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (in_out_list'':in_out_list) (ascope':'a) . (clause_name "arch_out") /\ (( ( arch_block_out = EL i ab_list ) ) /\ ( ( SOME ( in_out_list'' , ascope' ) = output_f ( in_out_list' , ascope ) ) )) ==> -( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , status_running ) ( ( 0 , in_out_list , in_out_list'' , ascope' ) , g_scope_list , arch_frame_list_empty , status_running ) ))) +( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , status_running ) ( ( 0 , in_out_list , in_out_list'' , ascope' ) , g_scope_list , arch_frame_list_empty , status_running ) ))) -[arch_parser_trans:] (! (x_d_list:(x#d) list) (e_list:e list) (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (frame_list:frame_list) (x':x) (g_scope_list':g_scope_list) (stmt':stmt) (x:x) (b_func_map:b_func_map) (t_scope:t_scope) (pars_map:pars_map) (tbl_map:tbl_map) . +[arch_parser_trans:] (! (x_d_list:(x#d) list) (e_list:e list) (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (frame_list:frame_list) (x':x) (g_scope_list':g_scope_list) (stmt':stmt) (x:x) (b_func_map:b_func_map) (t_scope:t_scope) (pars_map:pars_map) (tbl_map:tbl_map) . (clause_name "arch_parser_trans") /\ (( ( (arch_block_pbl x (e_list)) = EL i ab_list ) ) /\ ( (ALOOKUP pblock_map x = SOME ( pbl_type_parser , (x_d_list) , b_func_map , t_scope , pars_map , tbl_map )) ) /\ ( (( x' <> "accept") /\ ( x' <> "reject")) ) /\ ( (ALOOKUP pars_map x' = SOME ( stmt' )) )) ==> -( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , (arch_frame_list_regular frame_list) , (status_trans x') ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list' , (arch_frame_list_regular ([ ( (funn_name x') , ( ([(stmt')]) ) , ( ([( [] )]) ) ) ]) ) , status_running ) ))) +( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , (arch_frame_list_regular frame_list) , (status_trans x') ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list' , (arch_frame_list_regular ([ ( (funn_name x') , ( ([(stmt')]) ) , ( ([( [] )]) ) ) ]) ) , status_running ) ))) -[arch_pbl_exec:] (! (x_d_list:(x#d) list) (e_list:e list) (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (frame_list:frame_list) (ascope':'a) (g_scope_list':g_scope_list) (frame_list':frame_list) (status':status) (x:x) (pbl_type:pbl_type) (b_func_map:b_func_map) (t_scope:t_scope) (pars_map:pars_map) (tbl_map:tbl_map) . +[arch_pbl_exec:] (! (x_d_list:(x#d) list) (e_list:e list) (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (frame_list:frame_list) (ascope':'a) (g_scope_list':g_scope_list) (frame_list':frame_list) (status':status) (x:x) (pbl_type:pbl_type) (b_func_map:b_func_map) (t_scope:t_scope) (pars_map:pars_map) (tbl_map:tbl_map) . (clause_name "arch_pbl_exec") /\ (( ( (arch_block_pbl x (e_list)) = EL i ab_list ) ) /\ ( (ALOOKUP pblock_map x = SOME ( pbl_type , (x_d_list) , b_func_map , t_scope , pars_map , tbl_map )) ) /\ -( ( frames_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , frame_list , status_running ) ( ascope' , g_scope_list' , frame_list' , status' ) ))) +( ( frames_red ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , frame_list , status_running ) ( ascope' , g_scope_list' , frame_list' , status' ) ))) ==> -( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , (arch_frame_list_regular frame_list) , status_running ) ( ( i , in_out_list , in_out_list' , ascope' ) , g_scope_list' , (arch_frame_list_regular frame_list') , status' ) ))) +( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , (arch_frame_list_regular frame_list) , status_running ) ( ( i , in_out_list , in_out_list' , ascope' ) , g_scope_list' , (arch_frame_list_regular frame_list') , status' ) ))) -[arch_pbl_ret:] (! (e_x_d_list:(e#x#d) list) (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (frame_list:frame_list) (status:status) (ascope':'a) (f:x) (pbl_type:pbl_type) (b_func_map:b_func_map) (t_scope:t_scope) (pars_map:pars_map) (tbl_map:tbl_map) (stmt:stmt) (status':status) . +[arch_pbl_ret:] (! (e_x_d_list:(e#x#d) list) (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (i:i) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (g_scope_list:g_scope_list) (frame_list:frame_list) (status:status) (ascope':'a) (f:x) (pbl_type:pbl_type) (b_func_map:b_func_map) (t_scope:t_scope) (pars_map:pars_map) (tbl_map:tbl_map) (stmt:stmt) (status':status) . (clause_name "arch_pbl_ret") /\ (( ( (arch_block_pbl f ((MAP (\(e_,x_,d_) . e_) e_x_d_list))) = EL i ab_list ) ) /\ ( (ALOOKUP pblock_map f = SOME ( pbl_type , ((MAP (\(e_,x_,d_) . (x_,d_)) e_x_d_list)) , b_func_map , t_scope , pars_map , tbl_map )) ) /\ @@ -2706,7 +2738,7 @@ Inductive arch_sem: ( ( status' = set_fin_status pbl_type status ) ) /\ ( (SOME ascope' = copyout_pbl ( ( g_scope_list ) , ascope , ( ((MAP (\(e_,x_,d_) . d_) e_x_d_list)) ) , ((MAP (\(e_,x_,d_) . x_) e_x_d_list)) , status' )) )) ==> -( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , (arch_frame_list_regular frame_list) , status ) ( ( ( i + 1 ) , in_out_list , in_out_list' , ascope' ) , (LASTN 1 g_scope_list ) , arch_frame_list_empty , status_running ) ))) +( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , (arch_frame_list_regular frame_list) , status ) ( ( ( i + 1 ) , in_out_list , in_out_list' , ascope' ) , (LASTN 1 g_scope_list ) , arch_frame_list_empty , status_running ) ))) End (** definitions *) @@ -2714,17 +2746,17 @@ End Inductive conc_sem: (* defn conc_red *) -[conc_conc1:] (! (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (i:i) (g_scope_list:g_scope_list) (arch_frame_list:arch_frame_list) (status:status) (i':i) (g_scope_list':g_scope_list) (arch_frame_list':arch_frame_list) (status':status) (in_out_list'':in_out_list) (in_out_list''':in_out_list) (ascope':'a) (i'':i) (g_scope_list'':g_scope_list) (arch_frame_list'':arch_frame_list) (status'':status) . +[conc_conc1:] (! (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (i:i) (g_scope_list:g_scope_list) (arch_frame_list:arch_frame_list) (status:status) (i':i) (g_scope_list':g_scope_list) (arch_frame_list':arch_frame_list) (status':status) (in_out_list'':in_out_list) (in_out_list''':in_out_list) (ascope':'a) (i'':i) (g_scope_list'':g_scope_list) (arch_frame_list'':arch_frame_list) (status'':status) . (clause_name "conc_conc1") /\ -(( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list , status ) ( ( i'' , in_out_list'' , in_out_list''' , ascope' ) , g_scope_list'' , arch_frame_list'' , status'' ) ))) +(( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list , status ) ( ( i'' , in_out_list'' , in_out_list''' , ascope' ) , g_scope_list'' , arch_frame_list'' , status'' ) ))) ==> -( ( conc_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) (( in_out_list , in_out_list' , ascope ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i' , g_scope_list' , arch_frame_list' , status' ) )) (( in_out_list'' , in_out_list''' , ascope' ) , ( ( i'' , g_scope_list'' , arch_frame_list'' , status'' ) , ( i' , g_scope_list' , arch_frame_list' , status' ) )) ))) +( ( conc_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) (( in_out_list , in_out_list' , ascope ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i' , g_scope_list' , arch_frame_list' , status' ) )) (( in_out_list'' , in_out_list''' , ascope' ) , ( ( i'' , g_scope_list'' , arch_frame_list'' , status'' ) , ( i' , g_scope_list' , arch_frame_list' , status' ) )) ))) -[conc_conc2:] (! (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (i:i) (g_scope_list:g_scope_list) (arch_frame_list:arch_frame_list) (status:status) (i':i) (g_scope_list':g_scope_list) (arch_frame_list':arch_frame_list) (status':status) (in_out_list'':in_out_list) (in_out_list''':in_out_list) (ascope':'a) (i'':i) (g_scope_list'':g_scope_list) (arch_frame_list'':arch_frame_list) (status'':status) . +[conc_conc2:] (! (ab_list:ab_list) (pblock_map:pblock_map) (ffblock_map:'a ffblock_map) (input_f:'a input_f) (output_f:'a output_f) (copyin_pbl:'a copyin_pbl) (copyout_pbl:'a copyout_pbl) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (in_out_list:in_out_list) (in_out_list':in_out_list) (ascope:'a) (i:i) (g_scope_list:g_scope_list) (arch_frame_list:arch_frame_list) (status:status) (i':i) (g_scope_list':g_scope_list) (arch_frame_list':arch_frame_list) (status':status) (in_out_list'':in_out_list) (in_out_list''':in_out_list) (ascope':'a) (i'':i) (g_scope_list'':g_scope_list) (arch_frame_list'':arch_frame_list) (status'':status) . (clause_name "conc_conc2") /\ -(( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i' , in_out_list , in_out_list' , ascope ) , g_scope_list' , arch_frame_list' , status' ) ( ( i'' , in_out_list'' , in_out_list''' , ascope' ) , g_scope_list'' , arch_frame_list'' , status'' ) ))) +(( ( arch_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i' , in_out_list , in_out_list' , ascope ) , g_scope_list' , arch_frame_list' , status' ) ( ( i'' , in_out_list'' , in_out_list''' , ascope' ) , g_scope_list'' , arch_frame_list'' , status'' ) ))) ==> -( ( conc_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) (( in_out_list , in_out_list' , ascope ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i' , g_scope_list' , arch_frame_list' , status' ) )) (( in_out_list'' , in_out_list''' , ascope' ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i'' , g_scope_list'' , arch_frame_list'' , status'' ) )) ))) +( ( conc_red ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) (( in_out_list , in_out_list' , ascope ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i' , g_scope_list' , arch_frame_list' , status' ) )) (( in_out_list'' , in_out_list''' , ascope' ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i'' , g_scope_list'' , arch_frame_list'' , status'' ) )) ))) End open bitstringTheory; open wordsTheory; @@ -2735,10 +2767,10 @@ Type t_scope_list_g = ``:(t_scope list)`` Type t_scope_list = ``:(t_scope list)`` -Type t_scopes_tup = ``:(t_scope_list_g # t_scope_list)`` - Type t_scopes_frames = ``:(t_scope_list list)`` +Type t_scopes_tup = ``:(t_scope_list_g # t_scope_list)`` + val _ = Hol_datatype ` order_elem = (* the individual elements of the order in the state are fun name or tables names *) order_elem_f of funn @@ -2760,10 +2792,10 @@ Type funn_list = ``:( funn list )`` Type order = ``:(order_elem -> order_elem -> bool )`` -Type T_e = ``:( order # funn # delta )`` - Type Prs_n = ``:(string list)`` +Type T_e = ``:( order # funn # delta )`` + (*************************************************) (****** Typing Rules Related definitions *********) @@ -3939,11 +3971,42 @@ Inductive WTX: End (** definitions *) +(* defns WT_ec *) +Inductive WT_ec: +(* defn WT_ec *) + +[WT_ec_c:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (i:i) (random_oracle:random_oracle) (order:order) (t_scope_list_g:t_scope_list_g) (delta_g:delta_g) (delta_b:delta_b) (delta_x:delta_x) (delta_t:delta_t) (Prs_n:Prs_n) . +(clause_name "WT_ec_c") /\ +(( ( WF_o order ) ) /\ +( ( 2 = LENGTH t_scope_list_g ) ) /\ +( (LENGTH delta_b = LENGTH b_func_map ) ) /\ +( (LENGTH delta_t = LENGTH tbl_map ) ) /\ +( ( dom_map_ei func_map b_func_map ) ) /\ +( ( dom_tmap_ei delta_g delta_b ) ) /\ +( ( typying_domains_ei delta_g delta_b delta_x ) ) /\ +( ( dom_g_eq delta_g func_map ) ) /\ +( ( dom_b_eq delta_b b_func_map ) ) /\ +( ( dom_x_eq delta_x ext_map ) ) /\ +( ( dom_t_eq delta_t tbl_map ) ) /\ +( ( Fg_star_defined func_map t_scope_list_g ) ) /\ +( ( Fb_star_defined b_func_map t_scope_list_g ) ) /\ +( ( X_star_defined ext_map t_scope_list_g ) ) /\ +( (X_star_not_defined t_scope_list_g ) ) /\ +( ( WTFg func_map order t_scope_list_g delta_g delta_b delta_x Prs_n )) /\ +( ( WTFb b_func_map order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n )) /\ +( ( WTX ext_map order t_scope_list_g delta_g delta_b delta_x )) /\ +( ( table_map_typed tbl_map apply_table_f delta_g delta_b order ) ) /\ +( ( f_in_apply_tbl tbl_map apply_table_f ) )) + ==> +( ( WT_ec ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , i , random_oracle ) order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n ))) +End +(** definitions *) + (* defns WT_c *) Inductive WT_c: (* defn WT_c *) -[WT_c_c:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (order:order) (t_scope_list_g:t_scope_list_g) (delta_g:delta_g) (delta_b:delta_b) (delta_x:delta_x) (delta_t:delta_t) (Prs_n:Prs_n) . +[WT_c_c:] (! (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (order:order) (t_scope_list_g:t_scope_list_g) (delta_g:delta_g) (delta_b:delta_b) (delta_x:delta_x) (delta_t:delta_t) (Prs_n:Prs_n) . (clause_name "WT_c_c") /\ (( ( WF_o order ) ) /\ ( ( 2 = LENGTH t_scope_list_g ) ) /\ @@ -3966,7 +4029,7 @@ Inductive WT_c: ( ( table_map_typed tbl_map apply_table_f delta_g delta_b order ) ) /\ ( ( f_in_apply_tbl tbl_map apply_table_f ) )) ==> -( ( WT_c ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n ))) +( ( WT_c ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n ))) End @@ -4082,7 +4145,7 @@ End Inductive WT_state: (* defn WT_state *) -[WT_state_state:] (! (funn_stmt_stack_scope_list_t_scope_list_list:(funn#stmt_stack#scope_list#t_scope_list) list) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (ascope:'a) (g_scope_list:g_scope_list) (status:status) (Prs_n:Prs_n) (order:order) (t_scope_list_g:t_scope_list_g) (delta_g:delta_g) (delta_b:delta_b) (delta_x:delta_x) (delta_t:delta_t) (ctx:'a ctx) . +[WT_state_state:] (! (funn_stmt_stack_scope_list_t_scope_list_list:(funn#stmt_stack#scope_list#t_scope_list) list) (apply_table_f:'a apply_table_f) (ext_map:'a ext_map) (func_map:func_map) (b_func_map:b_func_map) (pars_map:pars_map) (tbl_map:tbl_map) (get_oracle_index:'a get_oracle_index) (set_oracle_index:'a set_oracle_index) (random_oracle:random_oracle) (ascope:'a) (g_scope_list:g_scope_list) (status:status) (Prs_n:Prs_n) (order:order) (t_scope_list_g:t_scope_list_g) (delta_g:delta_g) (delta_b:delta_b) (delta_x:delta_x) (delta_t:delta_t) (ctx:'a ctx) . (clause_name "WT_state_state") /\ (( ( WF_ft_order (funn_list_fl ((MAP (\(funn_,stmt_stack_,scope_list_,t_scope_list_) . funn_) funn_stmt_stack_scope_list_t_scope_list_list))) delta_g delta_b delta_x order )) /\ ( ( type_state_tsll ((MAP (\(funn_,stmt_stack_,scope_list_,t_scope_list_) . scope_list_) funn_stmt_stack_scope_list_t_scope_list_list)) ((MAP (\(funn_,stmt_stack_,scope_list_,t_scope_list_) . t_scope_list_) funn_stmt_stack_scope_list_t_scope_list_list)) ) ) /\ @@ -4090,7 +4153,7 @@ Inductive WT_state: ( ( WT_c ctx order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n )) /\ ( ( type_frames g_scope_list ( ((MAP (\(funn_,stmt_stack_,scope_list_,t_scope_list_) . (funn_,stmt_stack_,scope_list_)) funn_stmt_stack_scope_list_t_scope_list_list)) ) Prs_n order t_scope_list_g ((MAP (\(funn_,stmt_stack_,scope_list_,t_scope_list_) . t_scope_list_) funn_stmt_stack_scope_list_t_scope_list_list)) delta_g delta_b delta_x delta_t func_map b_func_map ) )) ==> -( ( WT_state ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , ( ((MAP (\(funn_,stmt_stack_,scope_list_,t_scope_list_) . (funn_,stmt_stack_,scope_list_)) funn_stmt_stack_scope_list_t_scope_list_list)) ) , status ) Prs_n order t_scope_list_g ( ((MAP (\(funn_,stmt_stack_,scope_list_,t_scope_list_) . t_scope_list_) funn_stmt_stack_scope_list_t_scope_list_list)) ) ( delta_g , delta_b , delta_x , delta_t ) ))) +( ( WT_state ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , ( ((MAP (\(funn_,stmt_stack_,scope_list_,t_scope_list_) . (funn_,stmt_stack_,scope_list_)) funn_stmt_stack_scope_list_t_scope_list_list)) ) , status ) Prs_n order t_scope_list_g ( ((MAP (\(funn_,stmt_stack_,scope_list_,t_scope_list_) . t_scope_list_) funn_stmt_stack_scope_list_t_scope_list_list)) ) ( delta_g , delta_b , delta_x , delta_t ) ))) End val _ = export_theory (); diff --git a/hol/p4Syntax.sig b/hol/p4Syntax.sig index 2cadc383..d42723c6 100644 --- a/hol/p4Syntax.sig +++ b/hol/p4Syntax.sig @@ -298,7 +298,7 @@ val mk_arch_frame_list_regular : term -> term val dest_actx : term -> - term * term * term * term * term * term * term * term * term * term + term * term * term * term * term * term * term * term * term * term * term * term * term val dest_astate : term -> term * term * term * term val mk_astate : term * term * term * term -> term val dest_aenv : term -> term * term * term * term diff --git a/hol/p4Syntax.sml b/hol/p4Syntax.sml index 98b8b143..ee55e120 100644 --- a/hol/p4Syntax.sml +++ b/hol/p4Syntax.sml @@ -377,7 +377,7 @@ val (arch_frame_list_regular_tm, mk_arch_frame_list_regular, dest_arch_frame_li fun dest_actx actx = case spine_pair actx of - [ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_fun_map, func_map] => (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_fun_map, func_map) + [ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_fun_map, func_map, get_oracle_index, set_oracle_index, random_oracle] => (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_fun_map, func_map, get_oracle_index, set_oracle_index, random_oracle) | _ => raise (ERR "dest_actx" ("Unsupported actx shape: "^(term_to_string actx))) ; fun dest_astate astate = diff --git a/hol/p4_auxScript.sml b/hol/p4_auxScript.sml index ef9c7bc1..6bab6298 100644 --- a/hol/p4_auxScript.sml +++ b/hol/p4_auxScript.sml @@ -2424,6 +2424,19 @@ Cases_on ‘v’ >> ( ) QED +Definition zero_val_from_tau_def: + (zero_val_from_tau tau_bool = v_bool F) /\ + (zero_val_from_tau (tau_bit w) = v_bit ( (GENLIST (\x. F) w ) , w)) /\ + (zero_val_from_tau tau_bot = v_bot) /\ + (zero_val_from_tau tau_ext = v_ext_ref 0) /\ + (zero_val_from_tau (tau_xtl struct_ty_struct []) = v_struct []) /\ + (zero_val_from_tau (tau_xtl struct_ty_struct ((x0,t0)::xtl)) = + v_struct ((x0, zero_val_from_tau t0)::(MAP (λ(x,t). (x, zero_val_from_tau t)) xtl))) /\ + (zero_val_from_tau (tau_xtl struct_ty_header []) = v_header F []) /\ + (zero_val_from_tau (tau_xtl struct_ty_header ((x0,t0)::xtl)) = + v_header F ((x0,zero_val_from_tau t0)::(MAP (λ(x,t). (x, zero_val_from_tau t)) xtl))) +End + Theorem bits_LENGTH: !bits n. LENGTH bits = n ==> diff --git a/hol/p4_coreScript.sml b/hol/p4_coreScript.sml index 93972aa3..60719944 100644 --- a/hol/p4_coreScript.sml +++ b/hol/p4_coreScript.sml @@ -1,9 +1,10 @@ -open HolKernel boolLib Parse bossLib ottLib; - -open p4Theory p4_auxTheory; +open HolKernel boolLib Parse bossLib; val _ = new_theory "p4_core"; +open ottLib; +open p4Theory p4_auxTheory; + (*****************) (* core ext type *) (*****************) diff --git a/hol/p4_ebpfLib.sml b/hol/p4_ebpfLib.sml index 210bc779..c5609c7e 100644 --- a/hol/p4_ebpfLib.sml +++ b/hol/p4_ebpfLib.sml @@ -69,33 +69,12 @@ val ebpf_init_counter = term_of_int 2; val ebpf_init_ext_obj_map = ``[(0, INL (core_v_ext_packet [])); (1, INL (core_v_ext_packet []))]:(num, ebpf_sum_v_ext) alist``; -(* -val ipv4_header_uninit = - mk_v_header_list F - [(``"version"``, mk_v_biti_arb 4), - (``"ihl"``, mk_v_biti_arb 4), - (``"diffserv"``, mk_v_biti_arb 8), - (``"totalLen"``, mk_v_biti_arb 16), - (``"identification"``, mk_v_biti_arb 16), - (``"flags"``, mk_v_biti_arb 3), - (``"fragOffset"``, mk_v_biti_arb 13), - (``"ttl"``, mk_v_biti_arb 8), - (``"protocol"``, mk_v_biti_arb 8), - (``"hdrChecksum"``, mk_v_biti_arb 16), - (``"srcAddr"``, mk_v_biti_arb 32), - (``"dstAddr"``, mk_v_biti_arb 32)]; -val ethernet_header_uninit = - mk_v_header_list F - [(``"dstAddr"``, mk_v_biti_arb 48), - (``"srcAddr"``, mk_v_biti_arb 48), - (``"etherType"``, mk_v_biti_arb 16)]; -val ebpf_parsed_packet_struct_uninit = - mk_v_struct_list [(``"ethernet"``, ethernet_header_uninit), (``"ipv4"``, ipv4_header_uninit)]; -*) - val ebpf_init_v_map = ``^core_init_v_map ++ [("packet", v_ext_ref 0); ("packet_copy", v_ext_ref 1); - ("accept", v_bool ARB)]:(string, v) alist``; + (* accept is an out-directed parameter of the final block, only + * read after it is finished. + * This can be concretized initially without ambiguity. *) + ("accept", v_bool F)]:(string, v) alist``; end diff --git a/hol/p4_ebpfScript.sml b/hol/p4_ebpfScript.sml index df9fdde9..4ba21300 100644 --- a/hol/p4_ebpfScript.sml +++ b/hol/p4_ebpfScript.sml @@ -1,9 +1,10 @@ -open HolKernel boolLib Parse bossLib ottLib; - -open p4Theory p4_auxTheory p4_coreTheory; +open HolKernel boolLib Parse bossLib; val _ = new_theory "p4_ebpf"; +open ottLib; +open p4Theory p4_auxTheory p4_coreTheory; + (* TODO: Put all the stuff that's shared between this and VSS in coreTheory *) (* TODO: Make actual representations of these extern objects *) @@ -19,7 +20,7 @@ val _ = type_abbrev("ebpf_sum_v_ext", ``:(core_v_ext, ebpf_v_ext) sum``); val _ = type_abbrev("ebpf_ctrl", ``:(string, (((e_list -> bool) # num), string # e_list) alist) alist``); (* The architectural state type of the eBPF architecture model *) -val _ = type_abbrev("ebpf_ascope", ``:(num # ((num, ebpf_sum_v_ext) alist) # ((string, v) alist) # ebpf_ctrl)``); +val _ = type_abbrev("ebpf_ascope", ``:(num # ((num, ebpf_sum_v_ext) alist) # ((string, v) alist) # ebpf_ctrl # num)``); (**********************************************************) (* SPECIALISED CORE METHODS *) @@ -32,13 +33,13 @@ Definition ebpf_ascope_lookup_def: End Definition ebpf_ascope_update_def: - ebpf_ascope_update ((counter, ext_obj_map, v_map, ctrl):ebpf_ascope) ext_ref v_ext = - (counter, AUPDATE ext_obj_map (ext_ref, v_ext), v_map, ctrl) + ebpf_ascope_update ((counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope) ext_ref v_ext = + (counter, AUPDATE ext_obj_map (ext_ref, v_ext), v_map, ctrl, oracle_index) End Definition ebpf_ascope_update_v_map_def: - ebpf_ascope_update_v_map ((counter, ext_obj_map, v_map, ctrl):ebpf_ascope) str v = - (counter, ext_obj_map, AUPDATE v_map (str, v), ctrl) + ebpf_ascope_update_v_map ((counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope) str v = + (counter, ext_obj_map, AUPDATE v_map (str, v), ctrl, oracle_index) End Definition ebpf_packet_in_extract: @@ -77,14 +78,14 @@ End (* Note that the "sparse" flag of the constructor is irrelevant for our representation, so this isn't used here. *) Definition CounterArray_construct: - (CounterArray_construct ((counter, ext_obj_map, v_map, ctrl):ebpf_ascope, g_scope_list:g_scope_list, scope_list) = + (CounterArray_construct ((counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "max_index")) of | SOME (v_bit (bl,n)) => let bitstring_list = REPLICATE (v2n bl) ((n2w 0):word32) in let ext_obj_map' = AUPDATE ext_obj_map (counter, INR (ebpf_v_ext_counterArray bitstring_list)) in (case assign scope_list (v_ext_ref counter) (lval_varname (varn_name "this")) of | SOME scope_list' => - SOME ((counter + 1, ext_obj_map', v_map, ctrl), scope_list', status_returnv v_bot) + SOME ((counter + 1, ext_obj_map', v_map, ctrl, oracle_index), scope_list', status_returnv v_bot) | NONE => NONE) | _ => NONE ) @@ -101,7 +102,7 @@ Definition update_index_def: End Definition CounterArray_increment: - (CounterArray_increment ((counter, ext_obj_map, v_map, ctrl):ebpf_ascope, g_scope_list:g_scope_list, scope_list) = + (CounterArray_increment ((counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "this")) of | SOME (v_ext_ref i) => (case ALOOKUP ext_obj_map i of @@ -109,7 +110,7 @@ Definition CounterArray_increment: (case lookup_lval scope_list (lval_varname (varn_name "index")) of | SOME (v_bit (bl,n)) => let bitstring_list' = update_index ($word_add (1w:word32)) (v2n bl) bitstring_list in - SOME ((counter, AUPDATE ext_obj_map (i, INR (ebpf_v_ext_counterArray bitstring_list')), v_map, ctrl), scope_list, status_returnv v_bot) + SOME ((counter, AUPDATE ext_obj_map (i, INR (ebpf_v_ext_counterArray bitstring_list')), v_map, ctrl, oracle_index), scope_list, status_returnv v_bot) | _ => NONE) | _ => NONE) | _ => NONE @@ -120,7 +121,7 @@ End (* add *) Definition CounterArray_add: - (CounterArray_add ((counter, ext_obj_map, v_map, ctrl):ebpf_ascope, g_scope_list:g_scope_list, scope_list) = + (CounterArray_add ((counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "this")) of | SOME (v_ext_ref i) => (case ALOOKUP ext_obj_map i of @@ -130,7 +131,7 @@ Definition CounterArray_add: (case lookup_lval scope_list (lval_varname (varn_name "value")) of | SOME (v_bit (bl',n')) => let bitstring_list' = update_index ($word_add ((v2w bl'):word32)) (v2n bl) bitstring_list in - SOME ((counter, AUPDATE ext_obj_map (i, INR (ebpf_v_ext_counterArray bitstring_list')), v_map, ctrl), scope_list, status_returnv v_bot) + SOME ((counter, AUPDATE ext_obj_map (i, INR (ebpf_v_ext_counterArray bitstring_list')), v_map, ctrl, oracle_index), scope_list, status_returnv v_bot) | _ => NONE) | _ => NONE) | _ => NONE) @@ -152,7 +153,7 @@ End (* NOTE: "b" renamed to "b_in" *) (* TODO: Note that this also resets parseError to 0 *) Definition ebpf_input_f_def: - (ebpf_input_f (io_list:in_out_list, (counter, ext_obj_map, v_map, ctrl):ebpf_ascope) = + (ebpf_input_f (io_list:in_out_list, (counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope) = case io_list of | [] => NONE | ((bl,p)::t) => @@ -168,7 +169,7 @@ Definition ebpf_input_f_def: (case ALOOKUP v_map'' "packet_copy" of | SOME (v_ext_ref i') => let ext_obj_map'' = AUPDATE ext_obj_map' (i', INL (core_v_ext_packet bl)) in - SOME (t, (counter, ext_obj_map'', v_map'', ctrl):ebpf_ascope) + SOME (t, (counter, ext_obj_map'', v_map'', ctrl, oracle_index):ebpf_ascope) | _ => NONE) | _ => NONE)) End @@ -183,51 +184,33 @@ Definition ebpf_reduce_nonout_def: | (e_var (varn_name x)) => (case ALOOKUP v_map x of | SOME v => - if is_d_in d - then oCONS (e_v v, ebpf_reduce_nonout (dlist, elist, v_map)) - else oCONS (e_v (init_out_v v), ebpf_reduce_nonout (dlist, elist, v_map)) + (* NOTE: Only externs can be passed as directionless arguments here *) + oCONS (e_v v, ebpf_reduce_nonout (dlist, elist, v_map)) | _ => NONE) | _ => NONE)) /\ (ebpf_reduce_nonout (_, _, v_map) = NONE) End -(* TODO: Remove these and keep "v_map" as just a regular scope? *) -Definition v_map_to_scope_def: - (v_map_to_scope [] = []) /\ - (v_map_to_scope (((k, v)::t):(string, v) alist) = - ((varn_name k, (v, NONE:lval option))::v_map_to_scope t) - ) -End - -Definition scope_to_vmap_def: - (scope_to_vmap [] = SOME []) /\ - (scope_to_vmap ((vn, (v:v, lval_opt:lval option))::t) = - case vn of - | (varn_name k) => oCONS ((k, v), scope_to_vmap t) - | _ => NONE - ) -End - (* TODO: Since the same thing should be initialised * for all known architectures, maybe it should be made a * architecture-generic (core) function? *) (* TODO: Don't reduce all arguments at once? *) Definition ebpf_copyin_pbl_def: - ebpf_copyin_pbl (xlist, dlist, elist, (counter, ext_obj_map, v_map, ctrl):ebpf_ascope) = + ebpf_copyin_pbl (xlist, dlist, elist, (counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope, random_oracle) = case ebpf_reduce_nonout (dlist, elist, v_map) of | SOME elist' => - copyin xlist dlist elist' [v_map_to_scope v_map] [ [] ] + copyin xlist dlist elist' [v_map_to_scope v_map] [ [] ] oracle_index random_oracle | NONE => NONE End (* TODO: Does anything need to be looked up for this function? *) (* Note that this re-uses the copyout function intended for P4 functions *) Definition ebpf_copyout_pbl_def: - ebpf_copyout_pbl (g_scope_list, (counter, ext_obj_map, v_map, ctrl):ebpf_ascope, dlist, xlist, (status:status)) = + ebpf_copyout_pbl (g_scope_list, (counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope, dlist, xlist, (status:status)) = case copyout_pbl_gen xlist dlist g_scope_list v_map of | SOME [v_map_scope] => (case scope_to_vmap v_map_scope of - | SOME v_map' => SOME ((counter, ext_obj_map, v_map', ctrl):ebpf_ascope) + | SOME v_map' => SOME ((counter, ext_obj_map, v_map', ctrl, oracle_index):ebpf_ascope) | NONE => NONE) | _ => NONE End @@ -252,9 +235,9 @@ Definition ebpf_inputPort_to_num_def: End (* TODO: Outsource obtaining the output port to an external function? *) -(* This will also look up the value of "pass" and only output a packet if it is true *) +(* This will also look up the value of "accept" and only output a packet if it is true *) Definition ebpf_output_f_def: - ebpf_output_f (in_out_list:in_out_list, (counter, ext_obj_map, v_map, ctrl):ebpf_ascope) = + ebpf_output_f (in_out_list:in_out_list, (counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope) = case ALOOKUP v_map "accept" of | SOME (v_bool T) => (case ebpf_lookup_obj ext_obj_map v_map "packet_copy" of @@ -263,16 +246,16 @@ Definition ebpf_output_f_def: | SOME (v_struct fields) => (case ebpf_inputPort_to_num fields of | SOME port => - SOME (in_out_list++[(bl, port)], (counter, ext_obj_map, v_map, ctrl)) + SOME (in_out_list++[(bl, port)], (counter, ext_obj_map, v_map, ctrl, oracle_index)) | NONE => NONE) | _ => NONE) | _ => NONE) - | SOME (v_bool F) => SOME (in_out_list, (counter, ext_obj_map, v_map, ctrl)) - | NONE => NONE + | SOME (v_bool F) => SOME (in_out_list, (counter, ext_obj_map, v_map, ctrl, oracle_index)) + | _ => NONE End Definition ebpf_apply_table_f_def: - ebpf_apply_table_f (x, e_l, mk_list:mk_list, (x', e_l'), (counter, ext_obj_map, v_map, ctrl):ebpf_ascope) = + ebpf_apply_table_f (x, e_l, mk_list:mk_list, (x', e_l'), (counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope) = (* TODO: Note that this function could do other stuff here depending on table name. * Ideally, one could make a general, not hard-coded, solution for this *) case ALOOKUP ctrl x of @@ -282,4 +265,16 @@ Definition ebpf_apply_table_f_def: | NONE => NONE End +(* TODO: Generalise the below as needed *) + +Definition ebpf_get_oracle_index_def: + ebpf_get_oracle_index ((counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope) = + oracle_index +End + +Definition ebpf_set_oracle_index_def: + ebpf_set_oracle_index i_opt ((counter, ext_obj_map, v_map, ctrl, oracle_index):ebpf_ascope) = + (counter, ext_obj_map, v_map, ctrl, case i_opt of NONE => oracle_index | SOME i => i):ebpf_ascope +End + val _ = export_theory (); diff --git a/hol/p4_exec_semScript.sml b/hol/p4_exec_semScript.sml index a7e45e84..198520ff 100644 --- a/hol/p4_exec_semScript.sml +++ b/hol/p4_exec_semScript.sml @@ -275,7 +275,7 @@ Definition stmt_exec_cond_def: End Definition e_state_size_def: - (e_state_size ((ctx:'a ctx), (g_scope_list:g_scope_list), (scope_list:scope_list), (e:e)) = e_size e) + (e_state_size ((ectx:'a ectx), (g_scope_list:g_scope_list), (scope_list:scope_list), (e:e)) = e_size e) End (* TODO: Write explicit NONE-reducing clauses for operands of wrong types? @@ -285,180 +285,180 @@ End Definition e_exec_def: (********************) (* Variable look-up *) - (e_exec (ctx:'a ctx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e_var x) = + (e_exec (ectx:'a ectx) (g_scope_list:g_scope_list) (scope_list:scope_list) (e_var x) = case lookup_vexp2 scope_list g_scope_list x of - | SOME v => SOME (e_v v, []) + | SOME v => SOME (e_v v, ([], NONE)) | NONE => NONE) /\ (******************************) (* Struct/header field access *) - (e_exec ctx g_scope_list scope_list (e_acc e_v_struct x) = + (e_exec ectx g_scope_list scope_list (e_acc e_v_struct x) = if is_v e_v_struct then (case e_exec_acc (e_acc e_v_struct x) of - | SOME v => SOME (v, []) + | SOME v => SOME (v, ([], NONE)) | NONE => NONE) else - (case e_exec ctx g_scope_list scope_list e_v_struct of - | SOME (e_v_struct', frame_list) => - SOME (e_acc e_v_struct' x, frame_list) + (case e_exec ectx g_scope_list scope_list e_v_struct of + | SOME (e_v_struct', (frame_list, i_opt)) => + SOME (e_acc e_v_struct' x, (frame_list, i_opt)) | NONE => NONE)) /\ (*********************************) (* Struct/header field reduction *) - (e_exec ctx g_scope_list scope_list (e_struct x_e_l) = + (e_exec ectx g_scope_list scope_list (e_struct x_e_l) = case unred_mem_index (MAP SND x_e_l) of | SOME i => - (case e_exec ctx g_scope_list scope_list (EL i (MAP SND x_e_l)) of - | SOME (e', frame_list) => SOME (e_struct (ZIP (MAP FST x_e_l, (LUPDATE e' i (MAP SND x_e_l)))), frame_list) + (case e_exec ectx g_scope_list scope_list (EL i (MAP SND x_e_l)) of + | SOME (e', (frame_list, i_opt)) => SOME (e_struct (ZIP (MAP FST x_e_l, (LUPDATE e' i (MAP SND x_e_l)))), (frame_list, i_opt)) | NONE => NONE) - | NONE => SOME (e_v (v_struct (ZIP (MAP FST x_e_l, vl_of_el (MAP SND x_e_l)))), [])) + | NONE => SOME (e_v (v_struct (ZIP (MAP FST x_e_l, vl_of_el (MAP SND x_e_l)))), ([], NONE))) /\ (************************) (* Function/extern call *) - (e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map) g_scope_list scope_list (e_call funn e_l) = + (e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, oracle_index, random_oracle) g_scope_list scope_list (e_call funn e_l) = (case lookup_funn_sig_body funn func_map b_func_map ext_map of | SOME (stmt, x_d_l) => if LENGTH x_d_l = LENGTH e_l then (case unred_arg_index (MAP SND x_d_l) e_l of | SOME i => - (case e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map) g_scope_list scope_list (EL i e_l) of - | SOME (e', frame_list) => SOME (e_call funn (LUPDATE e' i e_l), frame_list) + (case e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, oracle_index, random_oracle) g_scope_list scope_list (EL i e_l) of + | SOME (e', (frame_list, i_opt)) => SOME (e_call funn (LUPDATE e' i e_l), (frame_list, i_opt)) | NONE => NONE) | NONE => - (case copyin (MAP FST x_d_l) (MAP SND x_d_l) e_l g_scope_list scope_list of - | SOME scope => - SOME (e_var (varn_star funn), [(funn, [stmt], [scope])]) + (case copyin (MAP FST x_d_l) (MAP SND x_d_l) e_l g_scope_list scope_list oracle_index random_oracle of + | SOME (scope, i_opt) => + SOME (e_var (varn_star funn), ([(funn, [stmt], [scope])], i_opt)) | NONE => NONE)) else NONE | NONE => NONE)) /\ (********) (* Cast *) - (e_exec ctx g_scope_list scope_list (e_cast cast e) = + (e_exec ectx g_scope_list scope_list (e_cast cast e) = if is_v e then (case e_exec_cast cast e of - | SOME v => SOME (e_v v, []) + | SOME v => SOME (e_v v, ([], NONE)) | NONE => NONE) else - (case e_exec ctx g_scope_list scope_list e of - | SOME (e', frame_list) => SOME (e_cast cast e', frame_list) + (case e_exec ectx g_scope_list scope_list e of + | SOME (e', (frame_list, i_opt)) => SOME (e_cast cast e', (frame_list, i_opt)) | NONE => NONE)) /\ (********************) (* Unary arithmetic *) - (e_exec ctx g_scope_list scope_list (e_unop unop e) = + (e_exec ectx g_scope_list scope_list (e_unop unop e) = if is_v e then (case e_exec_unop unop e of - | SOME v => SOME (e_v v, []) + | SOME v => SOME (e_v v, ([], NONE)) | NONE => NONE) else - (case e_exec ctx g_scope_list scope_list e of - | SOME (e', frame_list) => SOME (e_unop unop e', frame_list) + (case e_exec ectx g_scope_list scope_list e of + | SOME (e', (frame_list, i_opt)) => SOME (e_unop unop e', (frame_list, i_opt)) | NONE => NONE)) /\ (*********************) (* Binary arithmetic *) - (e_exec ctx g_scope_list scope_list (e_binop e1 binop e2) = + (e_exec ectx g_scope_list scope_list (e_binop e1 binop e2) = (case e1 of | (e_v v) => if is_short_circuitable binop then (case e_exec_short_circuit v binop e2 of - | SOME e' => SOME (e', []) + | SOME e' => SOME (e', ([], NONE)) | NONE => NONE) else if is_v e2 then (case e_exec_binop e1 binop e2 of - | SOME v' => SOME (e_v v', []) + | SOME v' => SOME (e_v v', ([], NONE)) | NONE => NONE) else - (case e_exec ctx g_scope_list scope_list e2 of - | SOME (e2', frame_list) => SOME (e_binop e1 binop e2', frame_list) + (case e_exec ectx g_scope_list scope_list e2 of + | SOME (e2', (frame_list, i_opt)) => SOME (e_binop e1 binop e2', (frame_list, i_opt)) | NONE => NONE) | _ => - (case e_exec ctx g_scope_list scope_list e1 of - | SOME (e1', frame_list) => SOME (e_binop e1' binop e2, frame_list) + (case e_exec ectx g_scope_list scope_list e1 of + | SOME (e1', (frame_list, i_opt)) => SOME (e_binop e1' binop e2, (frame_list, i_opt)) | NONE => NONE))) /\ (**********) (* Select *) - (e_exec ctx g_scope_list scope_list (e_select e s_l_x_l x) = + (e_exec ectx g_scope_list scope_list (e_select e s_l_x_l x) = if is_v e then (case e_exec_select e s_l_x_l x of - | SOME x' => SOME (e_v (v_str x'), []) + | SOME x' => SOME (e_v (v_str x'), ([], NONE)) | NONE => NONE) else - (case e_exec ctx g_scope_list scope_list e of - | SOME (e', frame_list) => SOME (e_select e' s_l_x_l x, frame_list) + (case e_exec ectx g_scope_list scope_list e of + | SOME (e', (frame_list, i_opt)) => SOME (e_select e' s_l_x_l x, (frame_list, i_opt)) | NONE => NONE)) /\ (*****************) (* Concatenation *) - (e_exec ctx g_scope_list scope_list (e_concat e1 e2) = + (e_exec ectx g_scope_list scope_list (e_concat e1 e2) = if is_v_bit e1 - then + then (if is_v_bit e2 - then + then (case e_exec_concat e1 e2 of - | SOME v => SOME (e_v v, []) + | SOME v => SOME (e_v v, ([], NONE)) | NONE => NONE) else - (case e_exec ctx g_scope_list scope_list e2 of - | SOME (e2', frame_list) => SOME (e_concat e1 e2', frame_list) + (case e_exec ectx g_scope_list scope_list e2 of + | SOME (e2', (frame_list, i_opt)) => SOME (e_concat e1 e2', (frame_list, i_opt)) | NONE => NONE)) else - (case e_exec ctx g_scope_list scope_list e1 of - | SOME (e1', frame_list) => SOME (e_concat e1' e2, frame_list) + (case e_exec ectx g_scope_list scope_list e1 of + | SOME (e1', (frame_list, i_opt)) => SOME (e_concat e1' e2, (frame_list, i_opt)) | NONE => NONE)) /\ (***********) (* Slicing *) - (e_exec ctx g_scope_list scope_list (e_slice e1 e2 e3) = + (e_exec ectx g_scope_list scope_list (e_slice e1 e2 e3) = if (is_v_bit e2 /\ is_v_bit e3) then (if is_v_bit e1 - then + then (case e_exec_slice e1 e2 e3 of - | SOME v => SOME (e_v v, []) + | SOME v => SOME (e_v v, ([], NONE)) | NONE => NONE) else - (case e_exec ctx g_scope_list scope_list e1 of - | SOME (e1', frame_list) => SOME (e_slice e1' e2 e3, frame_list) + (case e_exec ectx g_scope_list scope_list e1 of + | SOME (e1', (frame_list, i_opt)) => SOME (e_slice e1' e2 e3, (frame_list, i_opt)) | NONE => NONE)) else NONE) /\ (e_exec _ _ _ _ = NONE) Termination -WF_REL_TAC `measure e_state_size` >> -fs [e_state_size_def, e_size_def] >> -REPEAT STRIP_TAC >| [ - IMP_RES_TAC unred_arg_index_in_range >> - IMP_RES_TAC rich_listTheory.EL_MEM >> - IMP_RES_TAC e3_size_mem >> - fs [], - - IMP_RES_TAC unred_mem_index_in_range >> - IMP_RES_TAC rich_listTheory.EL_MEM >> - `e_size (EL i (MAP SND x_e_l)) < e1_size x_e_l` suffices_by ( - fs [] - ) >> - `e2_size (EL i (MAP FST x_e_l), EL i (MAP SND x_e_l)) < e1_size x_e_l` suffices_by ( - rpt strip_tac >> - irule arithmeticTheory.LESS_TRANS >> - qexists_tac `e2_size (EL i (MAP FST x_e_l),EL i (MAP SND x_e_l))` >> - fs [e_e2_size_less] - ) >> - subgoal `MEM (EL i x_e_l) x_e_l` >- ( - irule rich_listTheory.EL_MEM >> - fs [listTheory.LENGTH_MAP] - ) >> - imp_res_tac e1_size_mem >> - metis_tac [EL_pair_list, listTheory.LENGTH_MAP] +WF_REL_TAC ‘measure e_state_size’ >> +fs[e_state_size_def, e_size_def] >> +rpt strip_tac >| [ + IMP_RES_TAC unred_arg_index_in_range >> + IMP_RES_TAC rich_listTheory.EL_MEM >> + IMP_RES_TAC e3_size_mem >> + fs[], + + IMP_RES_TAC unred_mem_index_in_range >> + IMP_RES_TAC rich_listTheory.EL_MEM >> + ‘e_size (EL i (MAP SND x_e_l)) < e1_size x_e_l’ suffices_by ( + fs[] + ) >> + ‘e2_size (EL i (MAP FST x_e_l), EL i (MAP SND x_e_l)) < e1_size x_e_l’ suffices_by ( + rpt strip_tac >> + irule arithmeticTheory.LESS_TRANS >> + qexists_tac ‘e2_size (EL i (MAP FST x_e_l),EL i (MAP SND x_e_l))’ >> + fs[e_e2_size_less] + ) >> + subgoal ‘MEM (EL i x_e_l) x_e_l’ >- ( + irule rich_listTheory.EL_MEM >> + fs[listTheory.LENGTH_MAP] + ) >> + imp_res_tac e1_size_mem >> + metis_tac[EL_pair_list, listTheory.LENGTH_MAP] ] End (* @@ -515,7 +515,7 @@ Definition stmt_exec_def: /\ (**************) (* Assignment *) - (stmt_exec ctx (ascope, g_scope_list, [(funn, [stmt_ass lval e], scope_list)], status_running) = + (stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, [stmt_ass lval e], scope_list)], status_running) = if is_v e then (case stmt_exec_ass lval e (scope_list++g_scope_list) of @@ -526,14 +526,14 @@ Definition stmt_exec_def: | _ => NONE) | NONE => NONE) else - (case e_exec ctx g_scope_list scope_list e of - | SOME (e', frame_list) => - SOME (ascope, g_scope_list, frame_list++[(funn, [stmt_ass lval e'], scope_list)], status_running) + (case e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) g_scope_list scope_list e of + | SOME (e', (frame_list, i_opt)) => + SOME (set_oracle_index i_opt ascope, g_scope_list, frame_list++[(funn, [stmt_ass lval e'], scope_list)], status_running) | _ => NONE)) /\ (**************) (* Transition *) - (stmt_exec ctx (ascope, g_scope_list, [(funn, [stmt_trans e], scope_list)], status_running) = + (stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, [stmt_trans e], scope_list)], status_running) = if is_v e then if is_v_str e @@ -543,14 +543,14 @@ Definition stmt_exec_def: | NONE => NONE) else NONE else - (case e_exec ctx g_scope_list scope_list e of - | SOME (e', frame_list) => - SOME (ascope, g_scope_list, frame_list++[(funn, [stmt_trans e'], scope_list)], status_running) + (case e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) g_scope_list scope_list e of + | SOME (e', (frame_list, i_opt)) => + SOME (set_oracle_index i_opt ascope, g_scope_list, frame_list++[(funn, [stmt_trans e'], scope_list)], status_running) | NONE => NONE)) /\ (***************) (* Conditional *) - (stmt_exec ctx (ascope, g_scope_list, [(funn, [stmt_cond e stmt1 stmt2], scope_list)], status_running) = + (stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, [stmt_cond e stmt1 stmt2], scope_list)], status_running) = (* TODO: Make this more efficient by using a single get_v_bool e *) if is_v_bool e then @@ -559,19 +559,19 @@ Definition stmt_exec_def: | SOME F => SOME (ascope, g_scope_list, [(funn, [stmt2], scope_list)], status_running) | NONE => NONE) else - (case e_exec ctx g_scope_list scope_list e of - | SOME (e', frame_list) => - SOME (ascope, g_scope_list, frame_list++[(funn, [stmt_cond e' stmt1 stmt2], scope_list)], status_running) + (case e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) g_scope_list scope_list e of + | SOME (e', (frame_list, i_opt)) => + SOME (set_oracle_index i_opt ascope, g_scope_list, frame_list++[(funn, [stmt_cond e' stmt1 stmt2], scope_list)], status_running) | NONE => NONE)) /\ (*********************) (* Table application *) - (stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map) (ascope, g_scope_list, [(funn, [stmt_app t_name e_l], scope_list)], status_running) = + (stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, [stmt_app t_name e_l], scope_list)], status_running) = (case index_not_const e_l of | SOME i => - (case e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map) g_scope_list scope_list (EL i e_l) of - | SOME (e', frame_list) => - SOME (ascope, g_scope_list, frame_list++[(funn, [stmt_app t_name (LUPDATE e' i e_l)], scope_list)], status_running) + (case e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) g_scope_list scope_list (EL i e_l) of + | SOME (e', (frame_list, i_opt)) => + SOME (set_oracle_index i_opt ascope, g_scope_list, frame_list++[(funn, [stmt_app t_name (LUPDATE e' i e_l)], scope_list)], status_running) | NONE => NONE) | NONE => (case ALOOKUP tbl_map t_name of @@ -590,18 +590,18 @@ Definition stmt_exec_def: /\ (**********) (* Return *) - (stmt_exec ctx (ascope, g_scope_list, [(funn, [stmt_ret e], scope_list)], status_running) = + (stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, [stmt_ret e], scope_list)], status_running) = (case get_v e of | SOME v => SOME (ascope, g_scope_list, [(funn, [stmt_empty], scope_list)], status_returnv v) | NONE => - (case e_exec ctx g_scope_list scope_list e of - | SOME (e', frame_list) => - SOME (ascope, g_scope_list, frame_list++[(funn, [stmt_ret e'], scope_list)], status_running) + (case e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) g_scope_list scope_list e of + | SOME (e', (frame_list, i_opt)) => + SOME (set_oracle_index i_opt ascope, g_scope_list, frame_list++[(funn, [stmt_ret e'], scope_list)], status_running) | NONE => NONE))) /\ (**********) (* Extern *) - (stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map) (ascope, g_scope_list, [(funn, [stmt_ext], scope_list)], status_running) = + (stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, [stmt_ext], scope_list)], status_running) = (case lookup_ext_fun funn ext_map of | SOME ext_fun => (case ext_fun (ascope, g_scope_list, scope_list) of @@ -612,8 +612,11 @@ Definition stmt_exec_def: /\ (*********) (* Block *) - (stmt_exec ctx (ascope, g_scope_list, [(funn, [stmt_block decl_list stmt], scope_list)], status_running) = - SOME (ascope, g_scope_list, [(funn, [stmt]++[stmt_empty], ((declare_list_in_fresh_scope decl_list)::scope_list))], status_running)) + (stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, [stmt_block decl_list stmt], scope_list)], status_running) = + let + (scope, i_opt) = declare_list_in_fresh_scope (decl_list, get_oracle_index ascope, random_oracle) + in + SOME (set_oracle_index i_opt ascope, g_scope_list, [(funn, [stmt]++[stmt_empty], (scope::scope_list))], status_running)) /\ (************) (* Sequence *) @@ -687,462 +690,158 @@ Cases_on `stmt` >> ( QED Theorem e_exec_new_frame: -!ctx g_scope_list scope_list e e' frame_list'. -e_exec ctx g_scope_list scope_list e = SOME (e',frame_list') ==> +!ectx g_scope_list scope_list e e' frame_list' i_opt. +e_exec ectx g_scope_list scope_list e = SOME (e', (frame_list', i_opt)) ==> (frame_list' = [] \/ ?funn stmt scope. frame_list' = [(funn, [stmt], [scope])]) Proof -`!ctx g_scope_list scope_list e. - (\ctx' g_scope_list' scope_list' e'. - !e'' frame_list''. - e_exec ctx' g_scope_list' scope_list' e' = SOME (e'', frame_list'') ==> +‘!ectx g_scope_list scope_list e. + (\ectx' g_scope_list' scope_list' e'. + !e'' frame_list'' i_opt'. + e_exec ectx' g_scope_list' scope_list' e' = SOME (e'', (frame_list'', i_opt')) ==> (frame_list'' = [] \/ ?funn'' stmt'' scope''. frame_list'' = [(funn'', [stmt''], [scope''])]) - ) ctx g_scope_list scope_list e` suffices_by ( - metis_tac [] + ) ectx g_scope_list scope_list e’ suffices_by ( + metis_tac[] ) >> irule e_exec_ind >> -fs [e_exec_def] >> +gs[e_exec_def] >> rpt strip_tac >| [ - Cases_on `lookup_funn_sig_body funn func_map b_func_map ext_map` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] >> - Cases_on `unred_arg_index (MAP SND x1) e_l` >> ( - fs [] - ) >| [ - Cases_on `copyin (MAP FST x1) (MAP SND x1) e_l g_scope_list scope_list` >> ( - fs [] - ) >> - metis_tac [], - - Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) g_scope_list - scope_list (EL x e_l)` >> ( - fs [] - ) >> - PairCases_on `x'` >> - fs [] - ], + gvs[AllCaseEqs()], - (* Unop *) - Cases_on `is_v e` >> ( - fs [] - ) >| [ - Cases_on `e_exec_cast cast e` >> ( - fs [] - ), - - Cases_on `e_exec ctx g_scope_list scope_list e` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] - ], + (* Cast *) + gvs[AllCaseEqs()], (* TODO: Weird blob goal... *) - Cases_on `e1` >> ( - fs [e_exec_def] + Cases_on ‘e1’ >> ( + gs[e_exec_def] ) >| [ - Cases_on `is_short_circuitable binop` >> ( - fs [] - ) >| [ - Cases_on `e_exec_short_circuit v binop e2` >> ( - fs [] - ), + gvs[AllCaseEqs()], - Cases_on `is_v e2` >> ( - fs [] - ) >| [ - Cases_on `e_exec_binop (e_v v) binop e2` >> ( - fs [] - ), + gvs[AllCaseEqs()], - Cases_on `e_exec ctx g_scope_list scope_list e2` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] - ] - ], + gvs[AllCaseEqs()], - Cases_on `lookup_vexp2 scope_list g_scope_list v` >> ( - fs [] - ), - - Cases_on `is_v e` >> ( - fs [] - ) >- ( - Cases_on `e_exec_acc (e_acc e s)` >> ( - fs [] - ) - ) >> - Cases_on `e_exec ctx g_scope_list scope_list e` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [], - - Cases_on `is_v e` >> ( - fs [] - ) >| [ - Cases_on `e_exec_unop u e` >> ( - fs [] - ), - - Cases_on `e_exec ctx g_scope_list scope_list e` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] - ], + gvs[AllCaseEqs()], (* Cast *) - Cases_on `is_v e` >> ( - fs [] - ) >| [ - Cases_on `e_exec_cast c e` >> ( - fs [] - ), - - Cases_on `e_exec ctx g_scope_list scope_list e` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] - ], + gvs[AllCaseEqs()], (* TODO: Interesting... *) - Cases_on `case e of - e_v v => - if is_short_circuitable b then - case e_exec_short_circuit v b e0 of - NONE => NONE - | SOME e' => SOME (e',[]) - else if is_v e0 then - case e_exec_binop e b e0 of - NONE => NONE - | SOME v' => SOME (e_v v',[]) - else - (case e_exec ctx g_scope_list scope_list e0 of - NONE => NONE - | SOME (e2',frame_list) => - SOME (e_binop e b e2',frame_list)) - | e_var v25 => - (case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)) - | e_list v26 => - (case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)) - | e_acc v27 v28 => - (case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)) - | e_unop v29 v30 => - (case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)) - | e_cast v29 v30 => - (case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)) - | e_binop v31 v32 v33 => - (case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)) - | e_concat v34 v35 => - (case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)) - | e_slice v36 v37 v38 => - (case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)) - | e_call v39 v40 => - (case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)) - | e_select v41 v42 v43 => - (case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)) - | e_struct v44 => - (case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)) - | e_header v45 v46 => - case e_exec ctx g_scope_list scope_list e of - NONE => NONE - | SOME (e1',frame_list) => SOME (e_binop e1' b e0,frame_list)` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [], + gvs[AllCaseEqs()] >> + gvs[AllCaseEqs()], (* Concatenation *) - Cases_on `is_v_bit e` >> Cases_on `is_v_bit e0` >> ( - fs [] - ) >| [ - Cases_on `e_exec_concat e e0` >> ( - fs [] - ), - - Cases_on `e_exec ctx g_scope_list scope_list e0` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [], - - Cases_on `e_exec ctx g_scope_list scope_list e` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [], - - Cases_on `e_exec ctx g_scope_list scope_list e` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] - ], + gvs[AllCaseEqs()], (* Slicing *) - Cases_on `is_v_bit e0` >> Cases_on `is_v_bit e1'` >> ( - fs [] - ) >> - Cases_on `is_v_bit e` >> ( - fs [] - ) >| [ - Cases_on `e_exec_slice e e0 e1'` >> ( - fs [] - ), - - Cases_on `e_exec ctx g_scope_list scope_list e` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] - ], + gvs[AllCaseEqs()], (* Function call *) - Cases_on `e_exec ctx g_scope_list scope_list (e_call f l)` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [], + gvs[AllCaseEqs()], (* Select *) - Cases_on `is_v e` >> ( - fs [] - ) >| [ - Cases_on `e_exec_select e l s` >> ( - fs [] - ), - - Cases_on `e_exec ctx g_scope_list scope_list e` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] - ], + gvs[AllCaseEqs()], (* Struct *) - Cases_on `unred_mem_index (MAP SND l)` >> ( - fs [] - ) >> - Cases_on `e_exec ctx g_scope_list scope_list (EL x (MAP SND l))` >> ( - fs [] - ) >> - PairCases_on `x'` >> - fs [] + gvs[AllCaseEqs()] ], (* Slicing *) - Cases_on `is_v_bit e1` >> ( - fs [] - ) >| [ - Cases_on `e_exec_slice e1 e2 e3` >> ( - fs [] - ), - - Cases_on `e_exec ctx g_scope_list scope_list e1` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] - ], + gvs[AllCaseEqs()], (* Concatenation *) - Cases_on `is_v_bit e1` >> Cases_on `is_v_bit e2` >> ( - fs [] - ) >| [ - Cases_on `e_exec_concat e1 e2` >> ( - fs [] - ), - - Cases_on `e_exec ctx g_scope_list scope_list e2` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [], - - Cases_on `e_exec ctx g_scope_list scope_list e1` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [], - - Cases_on `e_exec ctx g_scope_list scope_list e1` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] - ], + gvs[AllCaseEqs()], (* Access *) - Cases_on `is_v e_v_struct` >> ( - fs [] - ) >| [ - Cases_on `e_exec_acc (e_acc e_v_struct x)` >> ( - fs [] - ), - - Cases_on `e_exec ctx g_scope_list scope_list e_v_struct` >> ( - fs [] - ) >> - PairCases_on `x'` >> - fs [] - ], + gvs[AllCaseEqs()], (* Select *) - Cases_on `is_v e` >> ( - fs [] - ) >| [ - Cases_on `e_exec_select e s_l_x_l x` >> ( - fs [] - ), + gvs[AllCaseEqs()], - Cases_on `e_exec ctx g_scope_list scope_list e` >> ( - fs [] - ) >> - PairCases_on `x'` >> - fs [] - ], - - (* Struct? *) - Cases_on `unred_mem_index (MAP SND x_e_l)` >> ( - fs [] - ) >> - Cases_on `e_exec ctx g_scope_list scope_list (EL x (MAP SND x_e_l))` >> ( - fs [] - ) >> - PairCases_on `x'` >> - fs [], + (* Struct *) + gvs[AllCaseEqs()], (* Unop *) - Cases_on `is_v e` >> ( - fs [] - ) >| [ - Cases_on `e_exec_unop unop e` >> ( - fs [] - ), - - Cases_on `e_exec ctx g_scope_list scope_list e` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] - ], + gvs[AllCaseEqs()], (* Variable lookup *) - Cases_on `lookup_vexp2 scope_list g_scope_list x` >> ( - fs [] - ) + gvs[AllCaseEqs()] ] QED Theorem exec_stmt_ass_SOME_REWRS: -!ctx ascope ascope' g_scope_list g_scope_list' funn lval e stmt_stack frame_list' scope_list status'. -stmt_exec ctx (ascope, g_scope_list, [(funn, (stmt_ass lval e)::stmt_stack, scope_list)], status_running) = +!apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ascope ascope' g_scope_list g_scope_list' funn lval e stmt_stack frame_list' scope_list status'. +stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, (stmt_ass lval e)::stmt_stack, scope_list)], status_running) = SOME (ascope', g_scope_list', frame_list', status') <=> (is_v e ==> ?scope_list'' scope_list'. (stmt_exec_ass lval e (scope_list++g_scope_list) = SOME scope_list'') /\ (separate scope_list'' = (SOME g_scope_list', SOME scope_list')) /\ - (frame_list' = [(funn, (stmt_empty)::stmt_stack, scope_list')])) /\ + (frame_list' = [(funn, (stmt_empty)::stmt_stack, scope_list')]) /\ + ascope' = ascope) /\ (~is_v e ==> - ?e' frame_list''. - (e_exec ctx g_scope_list scope_list e = SOME (e', frame_list'')) /\ + ?e' frame_list'' i_opt. + (e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) g_scope_list scope_list e = SOME (e', frame_list'', i_opt)) /\ (g_scope_list' = g_scope_list) /\ - (frame_list' = (frame_list''++[(funn, (stmt_ass lval e')::stmt_stack, scope_list)]))) /\ + (frame_list' = (frame_list''++[(funn, (stmt_ass lval e')::stmt_stack, scope_list)])) /\ + ascope' = set_oracle_index i_opt ascope) /\ scope_list <> [] /\ - ascope' = ascope /\ status' = status_running Proof rpt strip_tac >> Cases_on `scope_list` >> Cases_on `stmt_stack` >> ( - fs [stmt_exec_def] + gs[stmt_exec_def] ) >> Cases_on `is_v e` >> ( - fs [] + fs[] ) >| [ - Cases_on `stmt_exec_ass lval e ((h::t) ++ g_scope_list)` >> ( - fs [] - ) >> - Cases_on `separate x` >> Cases_on `q` >> Cases_on `r` >> ( - fs [] - ) >> - metis_tac [], + gvs[AllCaseEqs()] >> + metis_tac[], - Cases_on `e_exec ctx g_scope_list (h::t) e` >> ( - fs [] - ) >> - PairCases_on `x` >> - fs [] >> - metis_tac [], + gvs[AllCaseEqs()] >> + metis_tac[], Cases_on `stmt_exec_ass lval e ((h::t) ++ g_scope_list)` >> ( fs [] ) >> Cases_on `separate x` >> Cases_on `q` >> Cases_on `r` >> ( - fs [] + fs[] ) >> - metis_tac [], + metis_tac[], - Cases_on `e_exec ctx g_scope_list (h::t) e` >> ( - fs [] + Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index ascope,random_oracle) g_scope_list (h::t) e` >> ( + fs[] ) >> PairCases_on `x` >> fs [] >> IMP_RES_TAC e_exec_new_frame >> ( fs [] - ) >| [ - metis_tac [], - - metis_tac [] - ] + ) >> ( + metis_tac [] + ) ] QED Theorem exec_stmt_trans_SOME_REWRS: -!ctx ascope ascope' g_scope_list g_scope_list' funn e stmt_stack frame_list' scope_list status'. -stmt_exec ctx (ascope, g_scope_list, [(funn, (stmt_trans e)::stmt_stack, scope_list)], status_running) = +!apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ascope ascope' g_scope_list g_scope_list' funn e stmt_stack frame_list' scope_list status'. +stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, (stmt_trans e)::stmt_stack, scope_list)], status_running) = SOME (ascope', g_scope_list', frame_list', status') <=> (is_v e ==> is_v_str e /\ ?status''. stmt_exec_trans e = SOME status'' /\ - frame_list' = [(funn,stmt_empty::stmt_stack,scope_list)] /\ status' = status'') /\ + frame_list' = [(funn,stmt_empty::stmt_stack,scope_list)] /\ status' = status'' /\ + ascope' = ascope) /\ (~is_v e ==> - ?e' frame_list''. - e_exec ctx g_scope_list scope_list e = SOME (e', frame_list'') /\ + ?e' frame_list'' i_opt. + e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) g_scope_list scope_list e = SOME (e', (frame_list'', i_opt)) /\ frame_list' = frame_list'' ++ [(funn,(stmt_trans e')::stmt_stack,scope_list)] /\ - status' = status_running) /\ + status' = status_running /\ + ascope' = set_oracle_index i_opt ascope) /\ g_scope_list' = g_scope_list /\ - scope_list <> [] /\ - ascope' = ascope + scope_list <> [] Proof rpt strip_tac >> Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `is_v e` >> ( @@ -1150,20 +849,21 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `is_v e` >> ( ) >| [ (* TODO: Not needed? *) Cases_on `is_v_str e` >> ( - fs [] + fs[] ) >> Cases_on `stmt_exec_trans e` >> ( - fs [] + fs[] ) >> - metis_tac [], + metis_tac[], - Cases_on `e_exec ctx g_scope_list (h::t) e` >> ( - fs [] + Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index ascope,random_oracle) g_scope_list (h::t) e` >> ( + fs[] ) >> PairCases_on `x` >> ( - fs [] + fs[] ) >> - metis_tac [], + metis_tac[], Cases_on `is_v_str e` >> ( fs [] @@ -1173,7 +873,8 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `is_v e` >> ( ) >> metis_tac [], - Cases_on `e_exec ctx g_scope_list (h::t) e` >> ( + Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index ascope,random_oracle) g_scope_list (h::t) e` >> ( fs [] ) >> PairCases_on `x` >> @@ -1189,21 +890,22 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `is_v e` >> ( QED Theorem exec_stmt_cond_SOME_REWRS: -!ctx ascope ascope' g_scope_list g_scope_list' funn e stmt1 stmt2 stmt_stack frame_list' scope_list status'. -stmt_exec ctx (ascope, g_scope_list, [(funn, (stmt_cond e stmt1 stmt2)::stmt_stack, scope_list)], status_running) = +!apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ascope ascope' g_scope_list g_scope_list' funn e stmt1 stmt2 stmt_stack frame_list' scope_list status'. +stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, (stmt_cond e stmt1 stmt2)::stmt_stack, scope_list)], status_running) = SOME (ascope', g_scope_list', frame_list', status') <=> (is_v_bool e ==> ?b. stmt_exec_cond e = SOME b /\ (b = T ==> frame_list' = [(funn, stmt1::stmt_stack, scope_list)]) /\ - (b = F ==> frame_list' = [(funn, stmt2::stmt_stack, scope_list)])) /\ + (b = F ==> frame_list' = [(funn, stmt2::stmt_stack, scope_list)]) /\ + ascope' = ascope) /\ (~is_v_bool e ==> - ?e' frame_list''. - e_exec ctx g_scope_list scope_list e = SOME (e', frame_list'') /\ - frame_list' = frame_list'' ++ [(funn, (stmt_cond e' stmt1 stmt2)::stmt_stack, scope_list)]) /\ + ?e' frame_list'' i_opt. + e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) g_scope_list scope_list e = SOME (e', frame_list'', i_opt) /\ + frame_list' = frame_list'' ++ [(funn, (stmt_cond e' stmt1 stmt2)::stmt_stack, scope_list)] /\ + ascope' = set_oracle_index i_opt ascope) /\ g_scope_list' = g_scope_list /\ scope_list <> [] /\ - ascope' = ascope /\ status' = status_running Proof rpt strip_tac >> @@ -1221,10 +923,11 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `is_v_bool e` >> ( metis_tac [] ], - Cases_on `e_exec ctx g_scope_list (h::t) e` >> ( + Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index ascope,random_oracle) g_scope_list (h::t) e` >> ( fs [] ) >> - Cases_on `x` >> ( + PairCases_on `x` >> ( fs [] ) >> metis_tac [], @@ -1240,7 +943,8 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `is_v_bool e` >> ( metis_tac [] ], - Cases_on `e_exec ctx g_scope_list (h::t) e` >> ( + Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index ascope,random_oracle) g_scope_list (h::t) e` >> ( fs [] ) >> PairCases_on `x` >> @@ -1256,20 +960,21 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `is_v_bool e` >> ( QED Theorem exec_stmt_app_SOME_REWRS: -!apply_table_f ext_map func_map b_func_map pars_map tbl_map ascope ascope' g_scope_list g_scope_list' funn t_name e_l stmt_stack frame_list' scope_list status'. -stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map) (ascope, g_scope_list, [(funn, (stmt_app t_name e_l)::stmt_stack, scope_list)], status_running) = +!apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ascope ascope' g_scope_list g_scope_list' funn t_name e_l stmt_stack frame_list' scope_list status'. +stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, (stmt_app t_name e_l)::stmt_stack, scope_list)], status_running) = SOME (ascope', g_scope_list', frame_list', status') <=> (index_not_const e_l = NONE ==> ?mk_l f f_args default_f default_f_args. ALOOKUP tbl_map t_name = SOME (mk_l, (default_f, default_f_args)) /\ apply_table_f (t_name, e_l, mk_l, (default_f, default_f_args), ascope) = SOME (f, f_args) /\ is_consts_exec f_args /\ LENGTH mk_l = LENGTH e_l /\ - frame_list' = [(funn, (stmt_ass lval_null (e_call (funn_name f) f_args))::stmt_stack, scope_list)]) /\ + frame_list' = [(funn, (stmt_ass lval_null (e_call (funn_name f) f_args))::stmt_stack, scope_list)] /\ + ascope' = ascope) /\ (!i. index_not_const e_l = SOME i ==> - ?e' frame_list''. e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map) g_scope_list scope_list (EL i e_l) = SOME (e', frame_list'') /\ - frame_list' = frame_list'' ++ [(funn, (stmt_app t_name (LUPDATE e' i e_l))::stmt_stack, scope_list)]) /\ + ?e' frame_list'' i_opt. e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) g_scope_list scope_list (EL i e_l) = SOME (e', frame_list'', i_opt) /\ + frame_list' = frame_list'' ++ [(funn, (stmt_app t_name (LUPDATE e' i e_l))::stmt_stack, scope_list)] /\ + ascope' = set_oracle_index i_opt ascope) /\ g_scope_list' = g_scope_list /\ scope_list <> [] /\ - ascope' = ascope /\ status' = status_running Proof rpt strip_tac >> @@ -1289,7 +994,7 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `index_not_const e_l` ) >> metis_tac [], - Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) g_scope_list (h::t) (EL x e_l)` >> ( + Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, get_oracle_index ascope, random_oracle) g_scope_list (h::t) (EL x e_l)` >> ( fs [] ) >> PairCases_on `x'` >> @@ -1314,7 +1019,7 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `index_not_const e_l` ) >> metis_tac [], - Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) g_scope_list (h::t) (EL x e_l)` >> ( + Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, get_oracle_index ascope, random_oracle) g_scope_list (h::t) (EL x e_l)` >> ( fs [] ) >> PairCases_on `x'` >> @@ -1330,26 +1035,28 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `index_not_const e_l` QED Theorem exec_stmt_ret_SOME_REWRS: -!ctx ascope ascope' g_scope_list g_scope_list' funn e stmt_stack frame_list' scope_list status'. -stmt_exec ctx (ascope, g_scope_list, [(funn, (stmt_ret e)::stmt_stack, scope_list)], status_running) = +!apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ascope ascope' g_scope_list g_scope_list' funn e stmt_stack frame_list' scope_list status'. +stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, (stmt_ret e)::stmt_stack, scope_list)], status_running) = SOME (ascope', g_scope_list', frame_list', status') <=> (!v. get_v e = SOME v ==> frame_list' = [(funn,stmt_empty::stmt_stack,scope_list)] /\ - status' = status_returnv v) /\ + status' = status_returnv v /\ + ascope' = ascope) /\ (get_v e = NONE ==> - ?e' frame_list''. - e_exec ctx g_scope_list scope_list e = SOME (e', frame_list'') /\ + ?e' frame_list'' i_opt. + e_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) g_scope_list scope_list e = SOME (e', frame_list'', i_opt) /\ frame_list' = frame_list'' ++ [(funn,(stmt_ret e')::stmt_stack,scope_list)] /\ - status' = status_running) /\ + status' = status_running /\ + ascope' = set_oracle_index i_opt ascope) /\ g_scope_list' = g_scope_list /\ - scope_list <> [] /\ - ascope' = ascope + scope_list <> [] Proof rpt strip_tac >> Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `get_v e` >> ( fs [stmt_exec_def] ) >| [ - Cases_on `e_exec ctx g_scope_list (h::t) e` >> ( + Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index ascope,random_oracle) g_scope_list (h::t) e` >> ( fs [] ) >> PairCases_on `x` >> @@ -1358,7 +1065,8 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `get_v e` >> ( metis_tac [], - Cases_on `e_exec ctx g_scope_list (h::t) e` >> ( + Cases_on `e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index ascope,random_oracle) g_scope_list (h::t) e` >> ( fs [] ) >> PairCases_on `x` >> @@ -1376,8 +1084,8 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> Cases_on `get_v e` >> ( QED Theorem exec_stmt_ext_SOME_REWRS: -!apply_table_f ext_map func_map b_func_map pars_map tbl_map ascope ascope' g_scope_list g_scope_list' funn stmt_stack frame_list' scope_list status'. -stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map) (ascope, g_scope_list, [(funn, stmt_ext::stmt_stack, scope_list)], status_running) = +!apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ascope ascope' g_scope_list g_scope_list' funn stmt_stack frame_list' scope_list status'. +stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, stmt_ext::stmt_stack, scope_list)], status_running) = SOME (ascope', g_scope_list', frame_list', status') <=> (?ext_fun. lookup_ext_fun funn ext_map = SOME ext_fun /\ @@ -1416,21 +1124,26 @@ Cases_on `scope_list` >> Cases_on `stmt_stack` >> ( QED Theorem exec_stmt_block_SOME_REWRS: -!ctx ascope ascope' g_scope_list g_scope_list' funn decl_list stmt stmt_stack frame_list' scope_list status'. -stmt_exec ctx (ascope, g_scope_list, [(funn, (stmt_block decl_list stmt)::stmt_stack, scope_list)], status_running) = +!apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ascope ascope' g_scope_list g_scope_list' funn decl_list stmt stmt_stack frame_list' scope_list status'. +stmt_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, (stmt_block decl_list stmt)::stmt_stack, scope_list)], status_running) = SOME (ascope', g_scope_list', frame_list', status') <=> scope_list <> [] /\ g_scope_list' = g_scope_list /\ - frame_list' = [(funn, stmt::(stmt_empty::stmt_stack), ((declare_list_in_fresh_scope decl_list)::(scope_list)))] /\ - ascope' = ascope /\ + ?scope i_opt. + declare_list_in_fresh_scope (decl_list, get_oracle_index ascope, random_oracle) = (scope, i_opt) /\ + frame_list' = [(funn, stmt::(stmt_empty::stmt_stack), (scope::(scope_list)))] /\ + ascope' = (set_oracle_index i_opt ascope) /\ status' = status_running Proof rpt strip_tac >> Cases_on `scope_list` >> Cases_on `stmt_stack` >> ( - fs [stmt_exec_def] -) >> ( - metis_tac [] -) + gvs[stmt_exec_def] +) >> +Cases_on ‘declare_list_in_fresh_scope + (decl_list,get_oracle_index ascope,random_oracle)’ >> ( + gs[] +) >> +metis_tac [] QED Theorem stmt_exec_block: @@ -1447,7 +1160,8 @@ stmt_exec ctx (ascope',g_scope_list',frame'++[(funn',stmt_stack'',scope_list')],status') Proof rpt strip_tac >> -Cases_on `stmt` >> ( +Cases_on `stmt` >> PairCases_on ‘ctx’ >> ( + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [] ) >| [ (* Assign *) @@ -1457,7 +1171,7 @@ Cases_on `stmt` >> ( ), (* Conditional *) - fs [exec_stmt_cond_SOME_REWRS] >> + fs[exec_stmt_cond_SOME_REWRS] >> Cases_on `is_v_bool e` >> ( fs [] ) >> @@ -1482,7 +1196,8 @@ Cases_on `stmt` >> ( Cases_on `is_empty s` >> ( fs [] ) >> - Cases_on `stmt_exec ctx + Cases_on `stmt_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle) (ascope,g_scope_list,[(funn,[s],h_scope::scope_list)],status_running)` >> ( fs [] ) >> @@ -1564,14 +1279,12 @@ Cases_on `stmt` >> ( ), (* Apply *) - PairCases_on `ctx` >> fs [exec_stmt_app_SOME_REWRS] >> Cases_on `index_not_const l` >> ( fs [] ), (* Extern *) - PairCases_on `ctx` >> fs [exec_stmt_ext_SOME_REWRS] ] QED @@ -1621,9 +1334,32 @@ Proof metis_tac [] ) >> rpt strip_tac >> +(* +PairCases_on ‘ctx’ >> +rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> +*) irule stmt_exec_ind >> rpt strip_tac >| [ + (* Return *) + fs [exec_stmt_ret_SOME_REWRS] >> + rpt strip_tac >> ( + Cases_on `get_v e` >> ( + fs [] + ) + ) >> + metis_tac [e_exec_new_frame], + + (* Trans *) + fs [exec_stmt_trans_SOME_REWRS] >> + metis_tac [e_exec_new_frame], + + (* Cond *) + fs [exec_stmt_cond_SOME_REWRS] >> + metis_tac [e_exec_new_frame], + (* Apply *) + gs[] >> + rpt strip_tac >> fs [exec_stmt_app_SOME_REWRS] >> rpt strip_tac >> ( Cases_on `index_not_const e_l` >> ( @@ -1632,6 +1368,12 @@ rpt strip_tac >| [ ) >> metis_tac [e_exec_new_frame], + (* Block entry *) + fs [exec_stmt_block_SOME_REWRS] >> + rpt strip_tac >> ( + gs[] + ), + (* Extern *) rename1 `[(funn,[stmt_ext],scope::scope_list)]` >> fs [stmt_exec_def] >> @@ -1645,36 +1387,32 @@ rpt strip_tac >| [ fs [] ), - (* Return *) - fs [exec_stmt_ret_SOME_REWRS] >> - rpt strip_tac >> ( - Cases_on `get_v e` >> ( - fs [] - ) - ) >> + (* Assign *) + fs [exec_stmt_ass_SOME_REWRS] >> metis_tac [e_exec_new_frame], - (* Trans *) - fs [exec_stmt_trans_SOME_REWRS] >> - metis_tac [e_exec_new_frame], (* Return (stack case) *) + PairCases_on ‘ctx’ >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [exec_stmt_ret_SOME_REWRS] >> metis_tac [], (* Trans (stack case) *) + PairCases_on ‘ctx’ >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [exec_stmt_trans_SOME_REWRS] >> metis_tac [], - (* Cond *) - fs [exec_stmt_cond_SOME_REWRS] >> - metis_tac [e_exec_new_frame], - (* Cond (stack case) *) + PairCases_on ‘ctx’ >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [exec_stmt_cond_SOME_REWRS] >> metis_tac [], (* Apply (stack case) *) + PairCases_on ‘ctx’ >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> rename1 `stmt_app t_name e_l` >> fs [] >> rpt strip_tac >> ( @@ -1682,14 +1420,24 @@ rpt strip_tac >| [ fs [] ) >> IMP_RES_TAC stmt_exec_block >> - fs [exec_stmt_app_SOME_REWRS] + fs [exec_stmt_app_SOME_REWRS] >> + metis_tac [] ), - fs [stmt_exec_def], +(* + (* Return (stack case) *) + fs [exec_stmt_ret_SOME_REWRS] >> + metis_tac [], +*) - (* Block entry *) - fs [exec_stmt_block_SOME_REWRS], + (* Block *) + PairCases_on ‘ctx’ >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> + Cases_on ‘declare_list_in_fresh_scope + (v112,get_oracle_index ascope,random_oracle)’ >> + fs [stmt_exec_def], + (* [] *) fs [stmt_exec_def], (* Block exit *) @@ -1698,13 +1446,12 @@ rpt strip_tac >| [ fs [] ), + (* ? *) fs [stmt_exec_def], - (* Assign *) - fs [exec_stmt_ass_SOME_REWRS] >> - metis_tac [e_exec_new_frame], - (* Assign (stack case) *) + PairCases_on ‘ctx’ >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [exec_stmt_ass_SOME_REWRS] >> metis_tac [], @@ -1717,6 +1464,12 @@ rpt strip_tac >| [ IMP_RES_TAC stmt_exec_block >> fs [exec_stmt_ext_SOME_REWRS], +(* + (* Assign (stack case) *) + fs [exec_stmt_ass_SOME_REWRS] >> + metis_tac [], +*) + (* Seq *) fs [stmt_exec_def] >> Cases_on `is_empty stmt1` >> ( @@ -2028,12 +1781,14 @@ val exec_stmt_REWRS = (* Reduction of a single statement is invariant over the addition of a lower statement stack. *) (* Converse to stmt_exec_block *) Theorem stmt_exec_lemma: -!ctx ascope g_scope1 g_scope2 g_scope1' g_scope2' funn stmt stmt' stmts scope_list scope_list'. -stmt_exec (ctx:'a ctx) +!apply_table_f ext_map func_map b_func_map pars_map tbl_map get_oracle_index set_oracle_index random_oracle ascope g_scope1 g_scope2 g_scope1' g_scope2' funn stmt stmt' stmts scope_list scope_list'. +stmt_exec ((apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle):'a ctx) (ascope,[g_scope1; g_scope2],[(funn,[stmt],scope_list)], status_running) = SOME (ascope,[g_scope1'; g_scope2'],[(funn,[stmt'],scope_list')],status_running) ==> -stmt_exec (ctx:'a ctx) +stmt_exec ((apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map, + get_oracle_index,set_oracle_index,random_oracle):'a ctx) (ascope,[g_scope1; g_scope2],[(funn,stmt::stmts,scope_list)], status_running) = SOME (ascope,[g_scope1'; g_scope2'],[(funn,stmt'::stmts,scope_list')],status_running) @@ -2057,11 +1812,9 @@ Induct_on ‘stmt’ >- ( fs[exec_stmt_trans_SOME_REWRS] ) >- ( rpt strip_tac >> - PairCases_on ‘ctx’ >> fs[exec_stmt_app_SOME_REWRS] ) >- ( rpt strip_tac >> - PairCases_on ‘ctx’ >> fs[exec_stmt_ext_SOME_REWRS] ) QED @@ -2071,9 +1824,6 @@ Theorem stmt_exec_status_returnv_inv: !ctx ascope ascope' g_scope_list g_scope_list' funn stmt_stack scope_list frame_list' v. stmt_exec ctx (ascope, g_scope_list, [(funn, stmt_stack, scope_list)], status_running) = SOME (ascope', g_scope_list', frame_list', status_returnv v) ==> -(* TODO: No longer holds when extern can change status to Return... *) -(* ascope' = ascope /\ - g_scope_list' = g_scope_list /\ *) ?stmt_stack' scope_list'. frame_list' = [(funn, stmt_stack', scope_list')] Proof `!ctx ascope g_scope_list funn stmt_stack scope_list. @@ -2089,13 +1839,6 @@ Proof rpt strip_tac >> irule stmt_exec_ind >> rpt strip_tac >| [ - fs [exec_stmt_app_SOME_REWRS], - - fs [exec_stmt_ext_SOME_REWRS] >> - rpt strip_tac >> - qexistsl_tac [`[stmt_empty]`, `scope_list''`] >> - fs [], - fs [exec_stmt_ret_SOME_REWRS] >> rpt strip_tac >> Cases_on `get_v e` >> ( @@ -2104,6 +1847,21 @@ rpt strip_tac >| [ fs [exec_stmt_trans_SOME_REWRS], + fs [exec_stmt_cond_SOME_REWRS], + + fs [exec_stmt_app_SOME_REWRS], + + fs [exec_stmt_block_SOME_REWRS], + + fs [exec_stmt_ext_SOME_REWRS] >> + rpt strip_tac >> + qexistsl_tac [`[stmt_empty]`, `scope_list''`] >> + fs [], + + fs [exec_stmt_ass_SOME_REWRS], + + pairLib.PairCases_on `ctx` >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [exec_stmt_ret_SOME_REWRS] >> rpt strip_tac >> rename1 `get_v e` >> @@ -2111,21 +1869,24 @@ rpt strip_tac >| [ fs [] ), + pairLib.PairCases_on `ctx` >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [exec_stmt_trans_SOME_REWRS], - fs [exec_stmt_cond_SOME_REWRS], - + pairLib.PairCases_on `ctx` >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [exec_stmt_cond_SOME_REWRS], pairLib.PairCases_on `ctx` >> - rename1 `(ctx0, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> - rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [exec_stmt_app_SOME_REWRS], - fs [stmt_exec_def], - + pairLib.PairCases_on `ctx` >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [exec_stmt_block_SOME_REWRS], + fs [stmt_exec_def], + fs [stmt_exec_def] >> Cases_on `stmt_stack` >> ( fs [] @@ -2136,20 +1897,15 @@ rpt strip_tac >| [ fs [] ), - fs [stmt_exec_def], - - fs [exec_stmt_ass_SOME_REWRS], - + pairLib.PairCases_on `ctx` >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [exec_stmt_ass_SOME_REWRS], pairLib.PairCases_on `ctx` >> - rename1 `(ctx0, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> - rename1 `(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map)` >> + rename1 ‘(apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle)’ >> fs [exec_stmt_ext_SOME_REWRS] >> rpt strip_tac >> - rename1 `stmt_empty::v218::v219` >> - qexistsl_tac [`stmt_empty::v218::v219`, `scope_list''`] >> - fs [], + metis_tac[], (* TODO: Written to avoid time-consuming simplification *) FULL_SIMP_TAC bool_ss [] >> @@ -2181,7 +1937,7 @@ rpt strip_tac >| [ rw [] >> gs [] ), - + fs [stmt_exec_def], fs [stmt_exec_def], @@ -2221,14 +1977,14 @@ Definition frames_exec_def: /\ (*********) (* Comp2 + Comp1 case of multiple frames *) - (frames_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map) (ascope, g_scope_list, ((funn, stmt_stack, scope_list)::((funn', stmt_stack', scope_list')::frame_list'')), status_running) = + (frames_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, ((funn, stmt_stack, scope_list)::((funn', stmt_stack', scope_list')::frame_list'')), status_running) = (case scopes_to_pass funn func_map b_func_map g_scope_list of | SOME g_scope_list' => (case map_to_pass funn b_func_map of | SOME b_func_map' => (case tbl_to_pass funn b_func_map tbl_map of | SOME tbl_map' => - (case stmt_exec (apply_table_f, ext_map, func_map, b_func_map', pars_map, tbl_map') (ascope, g_scope_list', [(funn, stmt_stack, scope_list)], status_running) of + (case stmt_exec (apply_table_f, ext_map, func_map, b_func_map', pars_map, tbl_map', get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list', [(funn, stmt_stack, scope_list)], status_running) of | SOME (ascope', g_scope_list'', frame_list', status') => (case status' of | status_returnv v => @@ -2268,14 +2024,14 @@ Definition frames_exec_def: /\ (*********) (* Comp1, remaining cases *) - (frames_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map) (ascope, g_scope_list, [(funn, stmt_stack, scope_list)], status_running) = + (frames_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list, [(funn, stmt_stack, scope_list)], status_running) = (case scopes_to_pass funn func_map b_func_map g_scope_list of | SOME g_scope_list' => (case map_to_pass funn b_func_map of | SOME b_func_map' => (case tbl_to_pass funn b_func_map tbl_map of | SOME tbl_map' => - (case stmt_exec (apply_table_f, ext_map, func_map, b_func_map', pars_map, tbl_map') (ascope, g_scope_list', [(funn, stmt_stack, scope_list)], status_running) of + (case stmt_exec (apply_table_f, ext_map, func_map, b_func_map', pars_map, tbl_map', get_oracle_index, set_oracle_index, random_oracle) (ascope, g_scope_list', [(funn, stmt_stack, scope_list)], status_running) of | SOME (ascope', g_scope_list'', frame_list', status') => (case scopes_to_retrieve funn func_map b_func_map g_scope_list g_scope_list'' of | SOME g_scope_list''' => @@ -2317,53 +2073,54 @@ Theorem state_fin_exec_equiv: !status frame_list:frame_list. state_fin_exec status frame_list <=> state_fin status frame_list Proof -fs [state_fin_def, state_fin_exec_def] >> +rpt strip_tac >> +gs[state_fin_def, state_fin_exec_def] >> Cases_on `frame_list` >> ( - fs [] + gs[] ) >- ( Cases_on `status` >> ( - fs [] + gs[] ) ) >> Cases_on `t` >> ( - fs [] + fs[] ) >- ( PairCases_on `h` >> - fs [] >> + fs[] >> Cases_on `h1` >> ( - fs [] + fs[] ) >- ( Cases_on `status` >> ( - fs [] + fs[] ) ) >> Cases_on `h` >> ( - fs [] + fs[] ) >- ( Cases_on `t` >> ( - fs [] + fs[] ) >> ( Cases_on `status` >> ( - fs [] + fs[] ) ) >- ( - metis_tac [] + metis_tac[] ) ) >> ( Cases_on `status` >> ( - fs [] + fs[] ) ) ) >> Cases_on `status` >> ( - fs [] + fs[] ) QED (* TODO: Outsource the stuff that causes too many case splits to other functions * i.e. exec_arch_e, exec_arch_update_return_frame, exec_arch_assign, ... *) Definition arch_exec_def: - (arch_exec ((ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map):'a actx) + (arch_exec ((ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map, get_oracle_index, set_oracle_index, random_oracle):'a actx) (((i, in_out_list, in_out_list', scope):'a aenv), g_scope_list:g_scope_list, arch_frame_list_regular frame_list, status:status) = (case EL i ab_list of | (arch_block_pbl x el) => @@ -2398,7 +2155,7 @@ Definition arch_exec_def: | _ => NONE) | status_running => (* pbl_exec *) - (case frames_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map) (scope, g_scope_list, frame_list, status) of + (case frames_exec (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle) (scope, g_scope_list, frame_list, status) of | SOME (scope', g_scope_list', frame_list', status') => SOME ((i, in_out_list, in_out_list', scope'), g_scope_list', (arch_frame_list_regular frame_list'), status') | _ => NONE) @@ -2407,7 +2164,7 @@ Definition arch_exec_def: | _ => NONE) ) /\ - (arch_exec (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map) + (arch_exec (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map, get_oracle_index, set_oracle_index, random_oracle) ((i, in_out_list, in_out_list', scope), g_scope_list, arch_frame_list_empty, status_running) = (case EL i ab_list of @@ -2427,14 +2184,15 @@ Definition arch_exec_def: (* TODO: The below LENGTH check is only used for proofs (e.g. soundness proof) *) (if LENGTH el = LENGTH x_d_list then - (case copyin_pbl ((MAP FST x_d_list), (MAP SND x_d_list), el, scope) of - | SOME scope' => + (case copyin_pbl ((MAP FST x_d_list), (MAP SND x_d_list), el, scope, random_oracle) of + | SOME (scope', i_opt) => (case oLASTN 1 g_scope_list of | SOME [g_scope] => - let g_scope_list' = ([declare_list_in_scope (decl_list, scope')]++[g_scope]) in + let (scope''', i_opt') = declare_list_in_scope (decl_list, scope', i_opt, get_oracle_index scope, random_oracle) in + let g_scope_list' = ([scope''']++[g_scope]) in (case initialise_var_stars func_map b_func_map ext_map g_scope_list' of | SOME g_scope_list'' => - SOME ((i, in_out_list, in_out_list', scope), g_scope_list'', + SOME ((i, in_out_list, in_out_list', set_oracle_index i_opt' scope), g_scope_list'', arch_frame_list_regular [(funn_name x, [stmt], [ [] ])], status_running) | NONE => NONE) | _ => NONE) @@ -2499,15 +2257,15 @@ arch_multi_exec actx (aenv, g_scope_list, arch_frame_list, status) (m+n) = | NONE => NONE Proof Induct_on `n` >- ( - fs [arch_multi_exec_def] + fs[arch_multi_exec_def] ) >> rpt strip_tac >> fs [arch_multi_exec_def, arithmeticTheory.ADD_CLAUSES] >> Cases_on `arch_exec actx (aenv,g_scope_list,arch_frame_list,status)` >> ( - fs [] + fs[] ) >> PairCases_on `x` >> -fs [] +fs[] QED (* TODO: What to call this? Compose? Combine? *) @@ -2522,7 +2280,7 @@ arch_multi_exec actx (aenv, g_scope_list, arch_frame_list, status) (1+m) = Proof rpt strip_tac >> FULL_SIMP_TAC pure_ss [Once arithmeticTheory.ADD_COMM] >> -fs [arch_multi_exec_add] +fs[arch_multi_exec_add] QED Theorem arch_multi_exec_split_1_tl: @@ -2537,13 +2295,13 @@ arch_multi_exec actx (aenv, g_scope_list, arch_frame_list, status) (m+1) = Proof rpt strip_tac >> FULL_SIMP_TAC pure_ss [Once arithmeticTheory.ADD_COMM] >> -fs [arch_multi_exec_add] >> +fs[arch_multi_exec_add] >> Cases_on `arch_multi_exec actx (aenv,g_scope_list,arch_frame_list,status) m` >> ( - fs [] + fs[] ) >> PairCases_on `x` >> qexistsl_tac [`(x0,x1,x2,x3)`, `x4`, `x5`, `x6`] >> -fs [] +fs[] QED Theorem arch_multi_exec_comp_n_tl: @@ -2557,7 +2315,7 @@ arch_multi_exec actx (aenv, g_scope_list, arch_frame_list, status) (n+m) = Proof rpt strip_tac >> gs[] >> -fs [arch_multi_exec_add] +fs[arch_multi_exec_add] QED (* TODO: use only this shape... *) @@ -2575,7 +2333,7 @@ gs[] >> PairCases_on ‘s’ >> PairCases_on ‘s'’ >> PairCases_on ‘s''’ >> -fs [arch_multi_exec_add] +fs[arch_multi_exec_add] QED Theorem arch_multi_exec_comp_1_tl_assl: @@ -2600,8 +2358,8 @@ Theorem arch_multi_exec_comp_n_tl_assl: SOME (aenv'', g_scope_list'', arch_frame_list'', status'')) Proof rpt strip_tac >> -gs [] >> -fs [arch_multi_exec_add] +gs[] >> +fs[arch_multi_exec_add] QED Theorem arch_multi_exec_comp_n_tl_assl_conj: @@ -2630,9 +2388,9 @@ QED Theorem arch_multi_exec_arch_frame_list_regular: !ab_list pblock_map ffblock_map input_f output_f copyin_pbl - copyout_pbl apply_table_f ext_map func_map aenv g_scope_list g_scope_list' arch_frame_list frame_list' n i io_list io_list' ascope. + copyout_pbl apply_table_f ext_map func_map get_oracle_index set_oracle_index random_oracle aenv g_scope_list g_scope_list' arch_frame_list frame_list' n i io_list io_list' ascope. arch_multi_exec (ab_list,pblock_map,ffblock_map,input_f,output_f,copyin_pbl, - copyout_pbl,apply_table_f,ext_map,func_map) + copyout_pbl,apply_table_f,ext_map,func_map,get_oracle_index,set_oracle_index,random_oracle) (aenv,g_scope_list,arch_frame_list, status_running) (SUC n) = SOME @@ -2649,7 +2407,8 @@ FULL_SIMP_TAC pure_ss [Once arithmeticTheory.ADD_SYM] >> fs[arch_multi_exec_add] >> Cases_on ‘arch_multi_exec (ab_list,pblock_map,ffblock_map,input_f,output_f,copyin_pbl, - copyout_pbl,apply_table_f,ext_map,func_map) + copyout_pbl,apply_table_f,ext_map,func_map,get_oracle_index, + set_oracle_index,random_oracle) (aenv,g_scope_list,arch_frame_list, status_running) n’ >> ( fs[] @@ -2665,98 +2424,20 @@ Cases_on ‘x5’ >- ( Cases_on ‘EL x0 ab_list’ >> ( fs[] ) >| [ - Cases_on ‘input_f (x1,x3)’ >> ( - fs[] - ) >> - PairCases_on ‘x’ >> - fs[], + gvs[AllCaseEqs()], - Cases_on ‘ALOOKUP pblock_map s’ >> ( - fs[] - ) >> - PairCases_on ‘x’ >> - fs[] >> - Cases_on ‘lookup_block_body s x2'’ >> ( - fs[] - ) >> - Cases_on ‘LENGTH l = LENGTH x1'’ >> ( - fs[] - ) >> - Cases_on ‘copyin_pbl (MAP FST x1',MAP SND x1',l,x3)’ >> ( - fs[] - ) >> - Cases_on ‘oLASTN 1 x4’ >> ( - fs[] - ) >> - Cases_on ‘x''’ >> ( - fs[] - ) >> - Cases_on ‘t’ >> ( - fs[] - ) >> - Cases_on ‘initialise_var_stars func_map x2' ext_map - [declare_list_in_scope (x3',x'); h]’ >> ( - fs[] - ) >> - gvs[], + gvs[AllCaseEqs()] >> + Cases_on ‘declare_list_in_scope (v21,scope',i_opt,get_oracle_index x3,random_oracle)’ >> + gvs[AllCaseEqs()] >> + PairCases_on ‘v22’ >> + metis_tac[], - Cases_on ‘ALOOKUP ffblock_map s’ >> ( - fs[] - ) >> - Cases_on ‘x’ >> - fs[] >> - Cases_on ‘f x3’ >> ( - fs[] - ), + gvs[AllCaseEqs()], - Cases_on ‘output_f (x2,x3)’ >> ( - fs[] - ) >> - PairCases_on ‘x’ >> - fs[] + gvs[AllCaseEqs()] ] ) >> -fs[arch_exec_def] >> -Cases_on ‘EL x0 ab_list’ >> ( - fs[] -) >> -Cases_on ‘ALOOKUP pblock_map s’ >> ( - fs[] -) >> -PairCases_on ‘x’ >> -fs[] >> -Cases_on ‘state_fin_exec x6 l’ >> ( - fs[] -) >- ( - Cases_on ‘lookup_block_body s x2'’ >> ( - fs[] - ) >> - Cases_on ‘LENGTH l' = LENGTH x1'’ >> ( - fs[] - ) >> - Cases_on ‘copyout_pbl - (x4,x3,MAP SND x1',MAP FST x1',set_fin_status x0' x6)’ >> ( - fs[] - ) -) >> -Cases_on ‘x6’ >> ( - fs[] -) >- ( - Cases_on ‘frames_exec (apply_table_f,ext_map,func_map,x2',x4',x5) - (x3,x4,l,status_running)’ >> ( - fs[] - ) >> - PairCases_on ‘x’ >> - fs[] >> - gvs[] -) >> -Cases_on ‘x0'’ >> ( - fs[] -) >> -Cases_on ‘ALOOKUP x4' s'’ >> ( - fs[] -) >> -gvs[] +gvs[arch_exec_def, AllCaseEqs()] QED diff --git a/hol/p4_from_json/p4_arch_auxScript.sml b/hol/p4_from_json/p4_arch_auxScript.sml index f0b87ed4..4c897ccb 100644 --- a/hol/p4_from_json/p4_arch_auxScript.sml +++ b/hol/p4_from_json/p4_arch_auxScript.sml @@ -1,9 +1,9 @@ open HolKernel boolLib liteLib simpLib Parse bossLib; -open p4Theory; - val _ = new_theory "p4_arch_aux"; +open p4Theory; + (* This file contains all architecture-specific definitions that are used for importing to HOL4P4. * None of these should be found in imported Script files or used by the semantics *) @@ -11,10 +11,10 @@ val _ = new_theory "p4_arch_aux"; (* Adding entries to tables *) Definition add_ctrl_gen_def: - add_ctrl_gen (((i, in_out_list, in_out_list', (counter:num, ext_obj_map:(num, (core_v_ext, 'a) sum) alist, v_map:(string, v) alist, ctrl:(string, (((e_list -> bool) # num), string # e_list) alist) alist)), g_scope_list, scope_list, status)) table_name keys action_name args = + add_ctrl_gen (((i, in_out_list, in_out_list', (counter:num, ext_obj_map:(num, (core_v_ext, 'a) sum) alist, v_map:(string, v) alist, ctrl:(string, (((e_list -> bool) # num), string # e_list) alist) alist, oracle_index:num)), g_scope_list:scope list, scope_list:arch_frame_list, status:status)) table_name keys action_name args = case ALOOKUP ctrl table_name of (* TODO: Note that this does not have any capability of removing old keys, only supersede them *) - | SOME table => SOME ((i, in_out_list, in_out_list', (counter, ext_obj_map, v_map, AUPDATE ctrl (table_name, ((keys, (action_name, args))::table)))), g_scope_list, scope_list, status) + | SOME table => SOME ((i, in_out_list, in_out_list', (counter, ext_obj_map, v_map, AUPDATE ctrl (table_name, ((keys, (action_name, args))::table)), oracle_index)), g_scope_list, scope_list, status) | NONE => NONE End diff --git a/hol/p4_from_json/petr4_to_hol4p4.sml b/hol/p4_from_json/petr4_to_hol4p4.sml index 27933811..ddb7273d 100644 --- a/hol/p4_from_json/petr4_to_hol4p4.sml +++ b/hol/p4_from_json/petr4_to_hol4p4.sml @@ -124,6 +124,7 @@ datatype stf_iotype = packet | expect; (* hex_to_bin "DEFEC8" *) (* hex_to_bin "C*DE" *) +(* NOTE: This is later treated by process_arbs_list *) fun hex_to_bin s = let fun hex_digit_to_bin c = @@ -641,7 +642,7 @@ fun v1model_add_ffblocks_to_ab_list ab_list_tm = fun vss_add_param_vars_to_v_map init_v_map tau = let - val uninit_H_val_tm = eval_rhs “arb_from_tau ^tau” + val uninit_H_val_tm = eval_rhs “zero_val_from_tau ^tau” in eval_rhs “AUPDATE_LIST ^init_v_map [("parsedHeaders", ^uninit_H_val_tm); ("headers", ^uninit_H_val_tm); @@ -651,13 +652,13 @@ fun vss_add_param_vars_to_v_map init_v_map tau = fun ebpf_add_param_vars_to_v_map init_v_map tau = let - val uninit_H_val_tm = eval_rhs “arb_from_tau ^tau” + val uninit_H_val_tm = eval_rhs “zero_val_from_tau ^tau” in eval_rhs “AUPDATE_LIST ^init_v_map [("headers", ^uninit_H_val_tm)]” end ; -fun output_hol4p4_vals outstream output_extra_maps valname stfname_opt (ftymap, blftymap) fmap pblock_map tbl_updates_tm arch_opt_tm ab_list_tm ttymap_tm pblock_action_names_map_tm = +fun output_hol4p4_vals outstream output_extra_maps valname stfname_opt (ftymap, blftymap) fmap pblock_map tbl_updates_tm arch_opt_tm ab_list_tm ttymap_tm pblock_action_names_map_tm oracle_index = let val extra_terms = if output_extra_maps @@ -666,9 +667,16 @@ fun output_hol4p4_vals outstream output_extra_maps valname stfname_opt (ftymap, ("pblock_action_names_map", pblock_action_names_map_tm, SOME "((string, ((string, string) alist)) alist)")] else [] - val gscope_init_vars = “[(varn_name "gen_apply_result", (v_struct [("hit", v_bool ARB); - ("miss", v_bool ARB); - ("action_run", v_bit (REPLICATE 32 ARB, 32))], NONE:lval option))]” + (* NOTE: gen_apply_result is a hard-coded "ghost variable" that can't be used in an + * imported program. This is not accessed before assignment, and so can be concretized + * without ambiguity *) + val gscope_init_vars = “[(varn_name "gen_apply_result", (v_struct [("hit", v_bool F); + ("miss", v_bool T); + ("action_run", v_bit (REPLICATE 32 F, 32))], NONE:lval option))]” + + (* TODO: Note this is a free variable *) + val random_oracle_tm = “random_oracle” + (* TODO: Eliminate code duplication here... *) val actx_astate_opt = if (is_arch_vss $ dest_some arch_opt_tm) then @@ -680,7 +688,9 @@ fun output_hol4p4_vals outstream output_extra_maps valname stfname_opt (ftymap, list_mk_pair [vss_add_ffblocks_to_ab_list ab_list_tm, pblock_map, vss_ffblock_map, vss_input_f, vss_output_f, vss_copyin_pbl, vss_copyout_pbl, vss_apply_table_f, - vss_ext_map, fmap'] + vss_ext_map, fmap', + “vss_get_oracle_index”, “vss_set_oracle_index”, + random_oracle_tm] val init_ctrl_opt = eval_rhs ``vss_init_ctrl ^pblock_map ^tbl_updates_tm`` (* val _ = print ("pblock_map :"^((term_to_string pblock_map)^"\n")) @@ -696,7 +706,8 @@ fun output_hol4p4_vals outstream output_extra_maps valname stfname_opt (ftymap, val ascope = list_mk_pair [term_of_int 3, vss_init_ext_obj_map, vss_init_v_map', - init_ctrl] + init_ctrl, + oracle_index] (* ab index, input list, output list, ascope *) (* Note: Input is added later elsewhere *) val aenv = list_mk_pair [term_of_int 0, @@ -720,7 +731,9 @@ fun output_hol4p4_vals outstream output_extra_maps valname stfname_opt (ftymap, list_mk_pair [ebpf_add_ffblocks_to_ab_list ab_list_tm, pblock_map, ebpf_ffblock_map, ebpf_input_f, ebpf_output_f, ebpf_copyin_pbl, ebpf_copyout_pbl, ebpf_apply_table_f, - ebpf_ext_map, fmap'] + ebpf_ext_map, fmap', + “ebpf_get_oracle_index”, “ebpf_set_oracle_index”, + random_oracle_tm] val init_ctrl_opt = eval_rhs ``ebpf_init_ctrl ^pblock_map ^tbl_updates_tm``; (* val _ = print ("pblock_map :"^((term_to_string pblock_map)^"\n")) @@ -736,7 +749,8 @@ fun output_hol4p4_vals outstream output_extra_maps valname stfname_opt (ftymap, val ascope = list_mk_pair [ebpf_init_counter, ebpf_init_ext_obj_map, ebpf_init_v_map', - init_ctrl] + init_ctrl, + oracle_index] (* ab index, input list, output list, ascope *) (* Note: Input is added later elsewhere *) val aenv = list_mk_pair [term_of_int 0, @@ -755,14 +769,16 @@ fun output_hol4p4_vals outstream output_extra_maps valname stfname_opt (ftymap, else if (is_arch_v1model $ dest_some arch_opt_tm) then let val fmap' = eval_rhs ``AUPDATE_LIST ^v1model_func_map ^fmap`` - val tparams = eval_rhs “(\ (tau1, tau2). (arb_from_tau tau1, arb_from_tau tau2)) ^(mk_pair (dest_v1model_pkg_V1Switch $ dest_some $ dest_arch_v1model $ dest_some arch_opt_tm))” + val tparams = eval_rhs “(\ (tau1, tau2). (zero_val_from_tau tau1, zero_val_from_tau tau2)) ^(mk_pair (dest_v1model_pkg_V1Switch $ dest_some $ dest_arch_v1model $ dest_some arch_opt_tm))” val v1model_input_f = “v1model_input_f ^tparams” val actx = rhs $ concl $ SIMP_CONV list_ss [] $ list_mk_pair [v1model_add_ffblocks_to_ab_list ab_list_tm, pblock_map, v1model_ffblock_map, v1model_input_f, v1model_output_f, v1model_copyin_pbl, v1model_copyout_pbl, v1model_apply_table_f, - v1model_ext_map, fmap'] + v1model_ext_map, fmap', + “v1model_get_oracle_index”, “v1model_set_oracle_index”, + random_oracle_tm] val init_ctrl_opt = eval_rhs ``v1model_init_ctrl ^pblock_map ^tbl_updates_tm``; (* val _ = print ("pblock_map :"^((term_to_string pblock_map)^"\n")) @@ -778,7 +794,8 @@ fun output_hol4p4_vals outstream output_extra_maps valname stfname_opt (ftymap, val ascope = list_mk_pair [v1model_init_counter, v1model_init_ext_obj_map, v1model_init_v_map, - init_ctrl] + init_ctrl, + oracle_index] (* ab index, input list, output list, ascope *) (* Note: Input is added later elsewhere *) val aenv = list_mk_pair [term_of_int 0, @@ -908,8 +925,9 @@ val arch_opt_tm = (el 12 res_list) val ab_list_tm = (el 13 res_list) val ttymap_tm = (el 14 res_list) val pblock_action_names_map_tm = (el 15 res_list) +val oracle_index_tm = (el 16 res_list) *) - val _ = output_hol4p4_vals outstream output_extra_maps valname stfname_opt (el 4 res_list, el 5 res_list) (el 6 res_list) (el 10 res_list) (el 11 res_list) (el 12 res_list) (el 13 res_list) (el 14 res_list) (el 15 res_list); + val _ = output_hol4p4_vals outstream output_extra_maps valname stfname_opt (el 4 res_list, el 5 res_list) (el 6 res_list) (el 10 res_list) (el 11 res_list) (el 12 res_list) (el 13 res_list) (el 14 res_list) (el 15 res_list) “0:num”; val _ = output_hol4p4_explicit outstream; val _ = TextIO.closeOut outstream; in diff --git a/hol/p4_from_json/petr4_to_hol4p4Script.sml b/hol/p4_from_json/petr4_to_hol4p4Script.sml index c00c2ac5..60dd955f 100644 --- a/hol/p4_from_json/petr4_to_hol4p4Script.sml +++ b/hol/p4_from_json/petr4_to_hol4p4Script.sml @@ -852,7 +852,7 @@ Definition get_typeinf_dummy_args_def: case args_opt of | SOME args => petr4_parse_type tyenv tyarg >>= - \type. SOME (args++[(e_v $ arb_from_tau type)]) + \type. SOME (args++[(e_v $ zero_val_from_tau type)]) | NONE => NONE) (SOME []) tyargs of | SOME dummy_args => SOME_msg dummy_args | NONE => get_error_msg "could not transform extern function's type arguments to dummy arguments: " (Array tyargs) @@ -1479,6 +1479,7 @@ Definition p4_prefix_tbl_def: End (* Here, prefixing of copyin-copyout parts happen *) +(* TODO: Why does this use zero_val_from_tau? This should use the random oracle instead... *) Definition petr4_inline_block_def: (petr4_inline_block gscope prefix body t_scope copyin copyout [] = SOME_msg (t_scope, p4_seq_append_stmt copyin (stmt_seq body copyout))) /\ (petr4_inline_block gscope prefix body t_scope copyin copyout (((param_name, param_dir), arg, param_type)::t) = @@ -1490,7 +1491,7 @@ Definition petr4_inline_block_def: let copyin' = if (param_dir <> d_out) then (p4_seq_append_stmt copyin (stmt_ass (lval_varname (p4_prefix_vars_in_varn gscope prefix (varn_name param_name))) arg)) - else (p4_seq_append_stmt copyin (stmt_ass (lval_varname (p4_prefix_vars_in_varn gscope prefix (varn_name param_name))) (e_v $ arb_from_tau param_type))) + else (p4_seq_append_stmt copyin (stmt_ass (lval_varname (p4_prefix_vars_in_varn gscope prefix (varn_name param_name))) (e_v $ zero_val_from_tau param_type))) in let copyout' = if is_d_out param_dir @@ -1690,8 +1691,8 @@ Definition petr4_parse_method_call_def: let add_args = case funn of | funn_name fname => - (* For action, insert extra arguments with from_table F and hit bit as ARB *) - if MEM fname action_list then [e_v $ v_bool F; e_v $ v_bool ARB] else [] + (* For action, insert extra arguments with from_table F and hit bit as F (placeholder value) *) + if MEM fname action_list then [e_v $ v_bool F; e_v $ v_bool F] else [] | _ => [] in let len_args = LENGTH args in (* Omit looking up types for methods with no args: quick fix for case of method with single optional arg. @@ -3493,9 +3494,12 @@ Definition check_taboos_def: let decl_list' = (MAP FST decl_list) in let ctrl_params' = (MAP (varn_name o FST) ctrl_params) in let gscope' = (MAP FST gscope) in - if (EVERY (\ el. ~(MEM el decl_list')) taboo_list) + (* We also check for the apply result placeholder variable name among + * declarations and among parameters *) + let taboo_list' = ((^apply_result_placeholder_varn)::taboo_list) in + if (EVERY (\ el. ~(MEM el decl_list')) taboo_list') then - (if (EVERY (\ el. ~(MEM el ctrl_params')) taboo_list) + (if (EVERY (\ el. ~(MEM el ctrl_params')) taboo_list') then (if (EVERY (\ el. ~(MEM el gscope')) taboo_list) then f diff --git a/hol/p4_testLib.sig b/hol/p4_testLib.sig index 33a04a2d..65e33002 100644 --- a/hol/p4_testLib.sig +++ b/hol/p4_testLib.sig @@ -12,6 +12,7 @@ val mk_eth_frame_ok : term -> term val mk_symb_packet_prefix : string -> int -> term val mk_symb_packet : int -> term +val ascope_ty_from_arch : string -> hol_type val get_actx : thm -> term val simple_arith_ss : simpLib.simpset val the_final_state_imp : thm -> term @@ -22,23 +23,23 @@ val eval_and_print_rest : string -> term -> term -> int -> term val eval_under_assum : hol_type -> term -> term -> term list -> term list -> thm -> int -> thm val eval_under_assum_break : term -> term -> term list -> thm -> int list -> thm -val dest_ascope : term -> term * term * term * term +val dest_ascope : term -> term * term * term * term * term val dest_actx : term -> - term * term * term * term * term * term * term * term * term * term + term * term * term * term * term * term * term * term * term * term * term * term * term val debug_arch_from_step : string -> term -> term -> int -> - (term * term * term * term * term * term * term * term * term * term) + (term * term * term * term * term * term * term * term * term * term * term * term * term) * ((term * term * term * term) * term * term * term) val debug_frames_from_step : string -> term -> term -> int -> - (term * term * term * term * term * term) * + (term * term * term * term * term * term * term * term * term) * (term * term * term * term) val the_final_state : thm -> term val the_final_state_hyp_imp : thm -> term * term @@ -50,7 +51,4 @@ val eval_step : hol_type -> term -> term -> thm val replace_ext_impl : term -> string -> string -> term -> term -val get_trace_thread_n : string -> term -> term -> int -> int -> thm -val get_trace_thread_next_n : string -> term -> thm -> int -> int -> thm - end diff --git a/hol/p4_testLib.sml b/hol/p4_testLib.sml index d6e16813..14c4c997 100644 --- a/hol/p4_testLib.sml +++ b/hol/p4_testLib.sml @@ -2,14 +2,12 @@ structure p4_testLib :> p4_testLib = struct open HolKernel boolLib liteLib simpLib Parse bossLib; -open pairSyntax optionSyntax wordsSyntax bitstringSyntax listSyntax numSyntax; +open pairSyntax optionSyntax wordsSyntax bitstringSyntax listSyntax numSyntax stringLib; -open p4Syntax p4_concurrentSyntax p4_auxTheory p4_exec_semSyntax testLib evalwrapLib p4_vssTheory p4_ebpfTheory; +open p4Syntax p4_auxTheory p4_exec_semSyntax testLib evalwrapLib p4_vssTheory p4_ebpfTheory; open p4_exec_semTheory; -open p4_concurrentTheory; - (* This file contains functions that are useful when creating P4 tests *) (* NOTE: Hack for obtaining a bitstring from an integer. There's @@ -378,9 +376,10 @@ fun dest_ascope ascope = let val (counter, ascope') = dest_pair ascope val (ext_obj_map, ascope'') = dest_pair ascope' - val (v_map, ctrl) = dest_pair ascope'' + val (v_map, ascope''') = dest_pair ascope'' + val (ctrl, oracle_index) = dest_pair ascope''' in - (counter, ext_obj_map, v_map, ctrl) + (counter, ext_obj_map, v_map, ctrl, oracle_index) end ; @@ -396,9 +395,12 @@ fun dest_actx actx = val (copyin_pbl, actx'''''') = dest_pair actx''''' val (copyout_pbl, actx''''''') = dest_pair actx'''''' val (apply_table_f, actx'''''''') = dest_pair actx''''''' - val (ext_map, func_map) = dest_pair actx'''''''' + val (ext_map, actx''''''''') = dest_pair actx'''''''' + val (func_map, actx'''''''''') = dest_pair actx''''''''' + val (get_oracle_index, actx''''''''''') = dest_pair actx'''''''''' + val (set_oracle_index, random_oracle) = dest_pair actx''''''''''' in - (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map) + (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map, get_oracle_index, set_oracle_index, random_oracle) end ; @@ -437,7 +439,7 @@ fun debug_arch_from_step arch actx astate nsteps = val (aenv, g_scope_list, arch_frame_list, status) = dest_astate astate' (* Use the below to debug, e.g. using the executable semantics in p4_exec_semScript.sml: *) (* val (i, in_out_list, in_out_list', scope) = dest_aenv aenv *) -(* val (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map) = dest_actx actx *) +(* val (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map, get_oracle_index, set_oracle_index, random_oracle) = dest_actx actx *) in (dest_actx actx, (dest_aenv aenv, g_scope_list, arch_frame_list, status)) end @@ -450,7 +452,7 @@ fun debug_arch_from_step_alt arch actx astate nsteps = val (aenv, g_scope_list, arch_frame_list, status) = dest_astate astate' (* Use the below to debug, e.g. using the executable semantics in p4_exec_semScript.sml: *) (* val (i, in_out_list, in_out_list', scope) = dest_aenv aenv *) -(* val (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map) = dest_actx actx *) +(* val (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map, get_oracle_index, set_oracle_index, random_oracle) = dest_actx actx *) in (actx, list_mk_pair [aenv, g_scope_list, arch_frame_list, status]) end @@ -463,12 +465,12 @@ fun debug_frames_from_step arch actx astate nsteps = val astate' = eval_and_print_result arch actx astate nsteps val (aenv, g_scope_list, arch_frame_list, status) = dest_astate astate' val (i, in_out_list, in_out_list', scope) = dest_aenv aenv - val (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map) = dest_actx actx + val (ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map, get_oracle_index, set_oracle_index, random_oracle) = dest_actx actx val (pbl_x, pbl_el) = dest_arch_block_pbl $ rhs $ concl $ EVAL ``EL (^i) (^ab_list)`` val (pbl_type, params, b_func_map, decl_list, pars_map, tbl_map) = dest_pblock $ optionSyntax.dest_some $ rhs $ concl $ EVAL ``ALOOKUP (^pblock_map) (^pbl_x)`` val frame_list = dest_arch_frame_list_regular arch_frame_list in - ((apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map), (scope, g_scope_list, frame_list, status)) + ((apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle), (scope, g_scope_list, frame_list, status)) end ; @@ -514,76 +516,12 @@ fun replace_ext_impl ctx_tm ext_name method_name method_tm = else raise (mk_HOL_ERR "p4_testLib" "replace_ext_impl" ("extern name "^ext_name^" and/or method name "^method_name^" could not be found in ext_map")) end; - val actx_list_10 = List.last actx_list; - val actx_list' = (actx_list_8first@[ext_map'])@[actx_list_10]; + val actx_list_rest = List.drop (actx_list, 9); + val actx_list' = (actx_list_8first@[ext_map'])@actx_list_rest; val actx' = list_mk_pair actx_list'; in actx' end ; -(***********************) -(* Concurrency-related *) - -(* TODO: Move to concurrencySyntax *) -fun arch_state_from_conc_state conc_state tid = - let - val [io, io', n_externs, ext_obj_map, v_map, ctrl, index1, gscope1, arch_frame_list1, status1, index2, gscope2, arch_frame_list2, status2] = strip_pair conc_state - val aenv = list_mk_pair [n_externs, ext_obj_map, v_map, ctrl] - in - if tid = 1 - then list_mk_pair [ - list_mk_pair [index1, io, io', aenv], - gscope1, arch_frame_list1, status1 - ] - else list_mk_pair [ - list_mk_pair [index2, io, io', aenv], - gscope2, arch_frame_list2, status2 - ] - end -; - -(* TODO: Move to concurrencySyntax *) -fun thread_state_from_conc_state conc_state tid = - let - val [io, io', n_externs, ext_obj_map, v_map, ctrl, index1, gscope1, arch_frame_list1, status1, index2, gscope2, arch_frame_list2, status2] = strip_pair conc_state - in - if tid = 1 - then list_mk_pair [index1, gscope1, arch_frame_list1, status1] - else list_mk_pair [index2, gscope2, arch_frame_list2, status2] - end -; - -fun get_trace_thread_n arch_name actx conc_state nsteps tid = - let - val arch_state = arch_state_from_conc_state conc_state tid - val other_thread_state = - if tid = 1 - then thread_state_from_conc_state conc_state 2 - else thread_state_from_conc_state conc_state 1 - - val arch_exec_thm = - eval_step_fuel (ascope_ty_from_arch arch_name) actx arch_state nsteps; - - val trace_path_arch_thm = HO_MATCH_MP arch_exec_trace_n arch_exec_thm; - - val trace_path_conc_thm = - if tid = 1 - then HO_MATCH_MP arch_path_implies_conc_thread1 trace_path_arch_thm - else HO_MATCH_MP arch_path_implies_conc_thread2 trace_path_arch_thm; - in - SPEC other_thread_state trace_path_conc_thm - end -; - -fun get_trace_thread_next_n arch_name actx conc_trace_thm nsteps tid = - let - val conc_state_mid = #4 $ dest_trace_path $ concl conc_trace_thm - - val conc_trace_next_n_thm = get_trace_thread_n arch_name actx conc_state_mid nsteps tid - in - HO_MATCH_MP (HO_MATCH_MP conc_paths_compose_alt conc_trace_thm) conc_trace_next_n_thm - end -; - end diff --git a/hol/p4_test_vss_ttlScript.sml b/hol/p4_test_vss_ttlScript.sml index 47cbb017..1d76fb65 100644 --- a/hol/p4_test_vss_ttlScript.sml +++ b/hol/p4_test_vss_ttlScript.sml @@ -105,7 +105,7 @@ val init_ctrl = ``[("ipv4_match", )]``; (* TODO: Make syntax functions *) -val init_ascope = ``((^init_counter), (^init_ext_obj_map), (^init_v_map), ^init_ctrl):vss_ascope``; +val init_ascope = ``((^init_counter), (^init_ext_obj_map), (^init_v_map), ^init_ctrl, 0):vss_ascope``; (* TODO: Make syntax functions *) val init_aenv = ``(^(list_mk_pair [``0:num``, init_inlist_ok, init_outlist_ok, ``(^init_ascope)``])):vss_ascope aenv``; @@ -122,7 +122,7 @@ val init_astate = (* Data non-interference theorems *) (***************************************) -val ctx = ``p4_vss_actx``; +val ctx = ``p4_vss_actx r``; val stop_consts_rewr = [``compute_checksum16``]; Definition vss_updated_checksum16_def: vss_updated_checksum16 (w16_list:bool list) = @@ -199,11 +199,18 @@ Definition Checksum16_get': ) End +(* +val ctx_tm = (rhs $ concl p4_vss_actx_def) +val ext_name = "Checksum16" +val method_name = "get" +val method_tm = “Checksum16_get'” +*) + (* Re-definition of p4_vss_actx' *) Definition p4_vss_actx'_def: - p4_vss_actx' = ^(replace_ext_impl (rhs $ concl p4_vss_actx_def) "Checksum16" "get" “Checksum16_get'”) + p4_vss_actx' r = ^(replace_ext_impl (rhs $ snd $ strip_forall $ concl p4_vss_actx_def) "Checksum16" "get" “Checksum16_get'”) End -val ctx' = ``p4_vss_actx'``; +val ctx' = ``p4_vss_actx' r``; (* EVAL-uate until packet is output (happens to be step 180) *) (* Theorem on line below proves data non-interference using proof approach 2 *) diff --git a/hol/p4_v1modelLib.sig b/hol/p4_v1modelLib.sig index 4b82005b..c7631a2e 100644 --- a/hol/p4_v1modelLib.sig +++ b/hol/p4_v1modelLib.sig @@ -25,16 +25,16 @@ val v1model_ffblock_map : term val v1model_ext_map : term val v1model_func_map : term -val dest_v1model_ascope : term -> term * term * term * term +val dest_v1model_ascope : term -> term * term * term * term * term -val dest_v1model_register_construct_inner : term -> term * term +val dest_v1model_register_construct_inner : term -> term * term * term * term val is_v1model_register_construct_inner : term -> bool -val mk_v1model_register_construct_inner : term * term -> term +val mk_v1model_register_construct_inner : term * term * term * term -> term val v1model_register_construct_inner_tm : term -val dest_v1model_register_read_inner : term -> term * term * term +val dest_v1model_register_read_inner : term -> term * term * term * term * term val is_v1model_register_read_inner : term -> bool -val mk_v1model_register_read_inner : term * term * term -> term +val mk_v1model_register_read_inner : term * term * term * term * term -> term val v1model_register_read_inner_tm : term val dest_v1model_register_write_inner : term -> term * term * term diff --git a/hol/p4_v1modelLib.sml b/hol/p4_v1modelLib.sml index 3e0c434b..18dd4710 100644 --- a/hol/p4_v1modelLib.sml +++ b/hol/p4_v1modelLib.sml @@ -8,6 +8,15 @@ open p4Syntax p4_coreLib; open p4Theory p4_coreTheory p4_v1modelTheory; +fun dest_quinop c e tm = + case with_exn strip_comb tm e of + (t, [t1, t2, t3, t4, t5]) => + if same_const t c then (t1, t2, t3, t4, t5) else raise e + | _ => raise e; +fun list_of_quintuple (a, b, c, d, e) = [a, b, c, d, e]; +fun mk_quinop tm = HolKernel.list_mk_icomb tm o list_of_quintuple; +val syntax_fns5 = HolKernel.syntax_fns {n = 5, dest = dest_quinop, make = mk_quinop}; + val v1model_arch_ty = ``:v1model_ascope``; (* Architectural constants *) @@ -60,14 +69,14 @@ val v1model_apply_table_f = ``v1model_apply_table_f``; val v1model_ffblock_map = ``[("postparser", ffblock_ff v1model_postparser)]``; val v1model_register_map = - ``[("read", ([("this", d_in); ("result", d_out); ("index", d_in)], register_read)); + ``[("read", ([("this", d_in); ("result", d_out); ("index", d_in)], register_read random_oracle)); ("write", ([("this", d_in); ("index", d_in); ("value", d_in)], register_write))]``; val v1model_ipsec_crypt_map = - ``[("decrypt_aes_ctr", ([("this", d_in); ("ipv4", d_inout); ("esp", d_inout); ("standard_metadata", d_inout); ("key", d_in); ("key_hmac", d_in)], ipsec_crypt_decrypt_aes_ctr)); - ("encrypt_aes_ctr", ([("this", d_in); ("ipv4", d_inout); ("esp", d_inout); ("key", d_in); ("key_hmac", d_in)], ipsec_crypt_encrypt_aes_ctr)); - ("encrypt_null", ([("this", d_in); ("ipv4", d_inout); ("esp", d_inout)], ipsec_crypt_encrypt_null)); - ("decrypt_null", ([("this", d_in); ("ipv4", d_inout); ("esp", d_inout); ("standard_metadata", d_inout)], ipsec_crypt_decrypt_null))]``; + ``[("decrypt_aes_ctr", ([("this", d_in); ("ipv4", d_inout); ("esp", d_inout); ("standard_metadata", d_inout); ("key", d_in); ("key_hmac", d_in)], ipsec_crypt_decrypt_aes_ctr random_oracle)); + ("encrypt_aes_ctr", ([("this", d_in); ("ipv4", d_inout); ("esp", d_inout); ("key", d_in); ("key_hmac", d_in)], ipsec_crypt_encrypt_aes_ctr random_oracle)); + ("encrypt_null", ([("this", d_in); ("ipv4", d_inout); ("esp", d_inout)], ipsec_crypt_encrypt_null random_oracle)); + ("decrypt_null", ([("this", d_in); ("ipv4", d_inout); ("esp", d_inout); ("standard_metadata", d_inout)], ipsec_crypt_decrypt_null random_oracle))]``; (* Extern (object) function map *) val v1model_ext_map = @@ -75,7 +84,7 @@ val v1model_ext_map = ++ [("", (NONE, (^v1model_objectless_map))); ("packet_in", (NONE, (^v1model_packet_in_map))); ("packet_out", (NONE, (^v1model_packet_out_map))); - ("register", SOME ([("this", d_out); ("size", d_none); ("targ1", d_in)], register_construct), (^v1model_register_map)); + ("register", SOME ([("this", d_out); ("size", d_none); ("targ1", d_in)], register_construct random_oracle), (^v1model_register_map)); ("ipsec_crypt", SOME ([("this", d_out)], ipsec_crypt_construct), (^v1model_ipsec_crypt_map))])``; (* Function map *) @@ -88,17 +97,18 @@ fun dest_v1model_ascope v1model_ascope = let val (ext_counter, v1model_ascope') = dest_pair v1model_ascope val (ext_obj_map, v1model_ascope'') = dest_pair v1model_ascope' - val (v_map, ctrl) = dest_pair v1model_ascope'' + val (v_map, v1model_ascope''') = dest_pair v1model_ascope'' + val (ctrl, oracle_index) = dest_pair v1model_ascope''' in - (ext_counter, ext_obj_map, v_map, ctrl) + (ext_counter, ext_obj_map, v_map, ctrl, oracle_index) end ; val (v1model_register_construct_inner_tm, mk_v1model_register_construct_inner, dest_v1model_register_construct_inner, is_v1model_register_construct_inner) = - syntax_fns2 "p4_v1model" "v1model_register_construct_inner"; + syntax_fns4 "p4_v1model" "v1model_register_construct_inner"; val (v1model_register_read_inner_tm, mk_v1model_register_read_inner, dest_v1model_register_read_inner, is_v1model_register_read_inner) = - syntax_fns3 "p4_v1model" "v1model_register_read_inner"; + syntax_fns5 "p4_v1model" "v1model_register_read_inner"; val (v1model_register_write_inner_tm, mk_v1model_register_write_inner, dest_v1model_register_write_inner, is_v1model_register_write_inner) = syntax_fns3 "p4_v1model" "v1model_register_write_inner"; diff --git a/hol/p4_v1modelScript.sml b/hol/p4_v1modelScript.sml index 5914897e..7451a05b 100644 --- a/hol/p4_v1modelScript.sml +++ b/hol/p4_v1modelScript.sml @@ -1,9 +1,10 @@ -open HolKernel boolLib Parse bossLib ottLib; - -open p4Theory p4Syntax p4_auxTheory p4_coreTheory p4_coreLib; +open HolKernel boolLib Parse bossLib; val _ = new_theory "p4_v1model"; +open ottLib; +open p4Theory p4Syntax p4_auxTheory p4_coreTheory p4_coreLib; + (* Useful documentation and reference links: https://github.com/p4lang/behavioral-model/blob/main/docs/simple_switch.md https://github.com/p4lang/behavioral-model/blob/main/targets/simple_switch/simple_switch.cpp @@ -48,12 +49,14 @@ val _ = type_abbrev("v1model_sum_v_ext", ``:(core_v_ext, v1model_v_ext) sum``); val _ = type_abbrev("v1model_ctrl", ``:(string, (((e_list -> bool) # num), string # e_list) alist) alist``); (* The architectural state type of the V1Model architecture model *) -val _ = type_abbrev("v1model_ascope", ``:(num # ((num, v1model_sum_v_ext) alist) # ((string, v) alist) # v1model_ctrl)``); +val _ = type_abbrev("v1model_ascope", ``:(num # ((num, v1model_sum_v_ext) alist) # ((string, v) alist) # v1model_ctrl # num)``); (**********************************************************) (* SPECIALISED CORE METHODS *) (**********************************************************) +(* TODO: Remove unused arguments from these? *) + Definition v1model_ascope_lookup_def: v1model_ascope_lookup (ascope:v1model_ascope) ext_ref = let ext_obj_map = FST $ SND ascope in @@ -61,13 +64,13 @@ Definition v1model_ascope_lookup_def: End Definition v1model_ascope_update_def: - v1model_ascope_update ((counter, ext_obj_map, v_map, ctrl):v1model_ascope) ext_ref v_ext = - (counter, AUPDATE ext_obj_map (ext_ref, v_ext), v_map, ctrl) + v1model_ascope_update ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope) ext_ref v_ext = + (counter, AUPDATE ext_obj_map (ext_ref, v_ext), v_map, ctrl, oracle_index) End Definition v1model_ascope_update_v_map_def: - v1model_ascope_update_v_map ((counter, ext_obj_map, v_map, ctrl):v1model_ascope) str v = - (counter, ext_obj_map, AUPDATE v_map (str, v), ctrl) + v1model_ascope_update_v_map ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope) str v = + (counter, ext_obj_map, AUPDATE v_map (str, v), ctrl, oracle_index) End Definition v1model_packet_in_extract_def: @@ -96,7 +99,7 @@ End (**********************************************) Definition v1model_ascope_read_ext_obj_def: - v1model_ascope_read_ext_obj ((counter, ext_obj_map, v_map, ctrl):v1model_ascope) vname = + v1model_ascope_read_ext_obj ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope) vname = case ALOOKUP v_map vname of | SOME (v_ext_ref n) => ALOOKUP ext_obj_map n @@ -198,7 +201,7 @@ End (* verify_checksum *) Definition v1model_verify_checksum_def: - (v1model_verify_checksum ((counter, ext_obj_map, v_map, ctrl):v1model_ascope, g_scope_list:g_scope_list, scope_list) = + (v1model_verify_checksum ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, g_scope_list:g_scope_list, scope_list) = (case lookup_lval scope_list (lval_varname (varn_name "condition")) of | SOME $ v_bool b => if b @@ -210,31 +213,28 @@ Definition v1model_verify_checksum_def: (case get_checksum_incr scope_list (lval_varname (varn_name "data")) of | SOME checksum_incr => (case lookup_lval scope_list (lval_varname (varn_name "checksum")) of - | SOME $ v_bit (bl', n') => - if n' = 16 - then - (if (v_bit (bl', n')) = (v_bit $ w16 $ compute_checksum16 checksum_incr) - then SOME ((counter, ext_obj_map, v_map, ctrl), scope_list, status_returnv v_bot) - else - (case assign [v_map_to_scope v_map] (v_bit ([T], 1)) (lval_field (lval_varname (varn_name "standard_metadata")) "checksum_error") of - | SOME [v_map_scope] => - (case scope_to_vmap v_map_scope of - | SOME v_map' => - SOME ((counter, ext_obj_map, v_map', ctrl), scope_list, status_returnv v_bot) - | NONE => NONE) - | _ => NONE)) - else NONE + | SOME $ v_bit (bl', 16) => + (if (v_bit (bl', 16)) = (v_bit $ w16 $ compute_checksum16 checksum_incr) + then SOME ((counter, ext_obj_map, v_map, ctrl, oracle_index), scope_list, status_returnv v_bot) + else + (case assign [v_map_to_scope v_map] (v_bit ([T], 1)) (lval_field (lval_varname (varn_name "standard_metadata")) "checksum_error") of + | SOME [v_map_scope] => + (case scope_to_vmap v_map_scope of + | SOME v_map' => + SOME ((counter, ext_obj_map, v_map', ctrl, oracle_index), scope_list, status_returnv v_bot) + | NONE => NONE) + | _ => NONE)) | _ => NONE) | NONE => NONE) (* TODO: Others not implemented yet *) else NONE | _ => NONE) - else SOME ((counter, ext_obj_map, v_map, ctrl), scope_list, status_returnv v_bot) + else SOME ((counter, ext_obj_map, v_map, ctrl, oracle_index), scope_list, status_returnv v_bot) | _ => NONE) ) End -(*************************) +(*******************) (* update_checksum *) Definition v1model_update_checksum_inner_def: @@ -243,7 +243,7 @@ Definition v1model_update_checksum_inner_def: End Definition v1model_update_checksum_def: - (v1model_update_checksum ((counter, ext_obj_map, v_map, ctrl):v1model_ascope, g_scope_list:g_scope_list, scope_list) = + (v1model_update_checksum ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, g_scope_list:g_scope_list, scope_list) = (case lookup_lval scope_list (lval_varname (varn_name "condition")) of | SOME $ v_bool b => if b @@ -261,14 +261,15 @@ Definition v1model_update_checksum_def: (* TODO: This can be made total, since we just looked up the checksum *) (case assign scope_list (v1model_update_checksum_inner checksum_incr) (lval_varname (varn_name "checksum")) of | SOME scope_list' => - SOME ((counter, ext_obj_map, v_map, ctrl), scope_list', status_returnv v_bot) | NONE => NONE) + SOME ((counter, ext_obj_map, v_map, ctrl, oracle_index), scope_list', status_returnv v_bot) + | NONE => NONE) else NONE | _ => NONE) | NONE => NONE) (* TODO: Others not implemented yet *) else NONE | _ => NONE) - else SOME ((counter, ext_obj_map, v_map, ctrl), scope_list, status_returnv v_bot) + else SOME ((counter, ext_obj_map, v_map, ctrl, oracle_index), scope_list, status_returnv v_bot) | _ => NONE) ) End @@ -276,28 +277,37 @@ End (**************) (* Register *) (**************) - +(* Definition replicate_arb_def: replicate_arb length width = REPLICATE length ((REPLICATE width (ARB:bool)), width) End -Definition v1model_register_construct_inner_def: - (v1model_register_construct_inner length_bl width = - replicate_arb (v2n length_bl) width - ) + +*) +Definition get_oracle_calls_array_def: + (get_oracle_calls_array width oracle_index random_oracle 0 = []) /\ + (get_oracle_calls_array width oracle_index random_oracle (SUC amount) = + (get_oracle_calls width oracle_index random_oracle, width)::(get_oracle_calls_array width oracle_index random_oracle amount)) End +Definition v1model_register_construct_inner_def: + v1model_register_construct_inner size width oracle_index random_oracle = + get_oracle_calls_array width oracle_index random_oracle size +End + Definition register_construct_def: - (register_construct ((counter, ext_obj_map, v_map, ctrl):v1model_ascope, g_scope_list:g_scope_list, scope_list) = + (register_construct random_oracle ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "size")) of | SOME (v_bit (bl, n)) => (case lookup_lval scope_list (lval_varname (varn_name "targ1")) of | SOME (v_bit (bl', n')) => - let ext_obj_map' = AUPDATE ext_obj_map (counter, INR (v1model_v_ext_register (v1model_register_construct_inner bl n'))) in + let size = v2n bl in + let width = n' in + let ext_obj_map' = AUPDATE ext_obj_map (counter, INR (v1model_v_ext_register (v1model_register_construct_inner size width oracle_index random_oracle))) in (case assign scope_list (v_ext_ref counter) (lval_varname (varn_name "this")) of | SOME scope_list' => - SOME ((counter + 1, ext_obj_map', v_map, ctrl), scope_list', status_returnv v_bot) + SOME ((counter + 1, ext_obj_map', v_map, ctrl, oracle_index + (size*width)), scope_list', status_returnv v_bot) | NONE => NONE) | _ => NONE) | _ => NONE @@ -329,16 +339,16 @@ End (* Simply replaces the oEL of a v2n index *) Definition v1model_register_read_inner_def: - (v1model_register_read_inner n'' array_index_v array = + (v1model_register_read_inner n'' array_index_v array oracle_index random_oracle = case oEL (v2n array_index_v) array of | SOME res => res - | NONE => (REPLICATE n'' (ARB:bool), n'') + | NONE => (get_oracle_calls n'' oracle_index random_oracle, n'') ) End (* Note that register_read always has a result, according to v1model.p4. *) Definition register_read_def: - (register_read ((counter, ext_obj_map, v_map, ctrl):v1model_ascope, g_scope_list:g_scope_list, scope_list) = + (register_read random_oracle ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "index")) of | SOME (v_bit (bl, n)) => (case lookup_lval scope_list (lval_varname (varn_name "this")) of @@ -347,11 +357,11 @@ Definition register_read_def: | SOME (INR (v1model_v_ext_register array)) => (* TODO: HACK, looking up the result variable to get the result width. *) (case lookup_lval scope_list (lval_varname (varn_name "result")) of - | SOME (v_bit (bl'', n'')) => - let (bl', n') = v1model_register_read_inner n'' bl array in + | SOME (v_bit (bl'', n'')) => + let (bl', n') = v1model_register_read_inner n'' bl array oracle_index random_oracle in (case assign scope_list (v_bit (bl', n')) (lval_varname (varn_name "result")) of | SOME scope_list' => - SOME ((counter, ext_obj_map, v_map, ctrl), scope_list', status_returnv v_bot) + SOME ((counter, ext_obj_map, v_map, ctrl, oracle_index), scope_list', status_returnv v_bot) | NONE => NONE) | _ => NONE) | _ => NONE) @@ -359,15 +369,15 @@ Definition register_read_def: | _ => NONE ) End - + Definition v1model_register_write_inner_def: (v1model_register_write_inner update array_index_v (array:(bool list # num) list) = LUPDATE update (v2n array_index_v) array ) End - + Definition register_write_def: - (register_write ((counter, ext_obj_map, v_map, ctrl):v1model_ascope, g_scope_list:g_scope_list, scope_list) = + (register_write ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "index")) of | SOME (v_bit (bl, n)) => (case lookup_lval scope_list (lval_varname (varn_name "value")) of @@ -378,7 +388,7 @@ Definition register_write_def: | SOME (INR (v1model_v_ext_register array)) => let array' = v1model_register_write_inner (bl', n') bl array in let ext_obj_map' = AUPDATE ext_obj_map (i, INR (v1model_v_ext_register array')) in - SOME ((counter, ext_obj_map', v_map, ctrl), scope_list, status_returnv v_bot) + SOME ((counter, ext_obj_map', v_map, ctrl, oracle_index), scope_list, status_returnv v_bot) | _ => NONE) | _ => NONE) | _ => NONE) @@ -392,11 +402,11 @@ End (* TODO: Initialises nothing, for now... *) Definition ipsec_crypt_construct_def: - (ipsec_crypt_construct ((counter, ext_obj_map, v_map, ctrl):v1model_ascope, g_scope_list:g_scope_list, scope_list) = + (ipsec_crypt_construct ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, g_scope_list:g_scope_list, scope_list) = let ext_obj_map' = AUPDATE ext_obj_map (counter, INR (v1model_v_ext_ipsec_crypt)) in (case assign scope_list (v_ext_ref counter) (lval_varname (varn_name "this")) of | SOME scope_list' => - SOME ((counter + 1, ext_obj_map', v_map, ctrl), scope_list', status_returnv v_bot) + SOME ((counter + 1, ext_obj_map', v_map, ctrl, oracle_index), scope_list', status_returnv v_bot) | NONE => NONE) ) End @@ -419,20 +429,23 @@ Termination End Definition ipsec_crypt_decrypt_aes_ctr_def: - (ipsec_crypt_decrypt_aes_ctr ((counter, ext_obj_map, v_map, ctrl):v1model_ascope, g_scope_list:g_scope_list, scope_list) = + (ipsec_crypt_decrypt_aes_ctr random_oracle ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "ipv4")) of | SOME ipv4_header => (case lookup_lval scope_list (lval_varname (varn_name "esp")) of | SOME esp_header => (case lookup_lval scope_list (lval_varname (varn_name "standard_metadata")) of | SOME standard_metadata => - (case assign scope_list (set_validity T $ init_out_v ipv4_header) (lval_varname (varn_name "ipv4")) of + let (v1, oracle_index') = init_out_v random_oracle oracle_index ipv4_header in + (case assign scope_list (set_validity T v1) (lval_varname (varn_name "ipv4")) of | SOME scope_list' => - (case assign scope_list' (set_validity T $ init_out_v esp_header) (lval_varname (varn_name "esp")) of + let (v2, oracle_index'') = init_out_v random_oracle oracle_index esp_header in + (case assign scope_list' (set_validity T v2) (lval_varname (varn_name "esp")) of | SOME scope_list'' => - (case assign scope_list'' (set_validity T $ init_out_v standard_metadata) (lval_varname (varn_name "standard_metadata")) of + let (v3, oracle_index''') = init_out_v random_oracle oracle_index standard_metadata in + (case assign scope_list'' (set_validity T v3) (lval_varname (varn_name "standard_metadata")) of | SOME scope_list''' => - SOME ((counter, ext_obj_map, v_map, ctrl), scope_list''', status_returnv v_bot) + SOME ((counter, ext_obj_map, v_map, ctrl, oracle_index'''), scope_list''', status_returnv v_bot) | _ => NONE) | _ => NONE) | _ => NONE) @@ -443,16 +456,18 @@ Definition ipsec_crypt_decrypt_aes_ctr_def: End Definition ipsec_crypt_encrypt_aes_ctr_def: - (ipsec_crypt_encrypt_aes_ctr ((counter, ext_obj_map, v_map, ctrl):v1model_ascope, g_scope_list:g_scope_list, scope_list) = + (ipsec_crypt_encrypt_aes_ctr random_oracle ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "ipv4")) of | SOME ipv4_header => (case lookup_lval scope_list (lval_varname (varn_name "esp")) of | SOME esp_header => - (case assign scope_list (set_validity T $ init_out_v ipv4_header) (lval_varname (varn_name "ipv4")) of + let (v1, oracle_index') = init_out_v random_oracle oracle_index ipv4_header in + (case assign scope_list (set_validity T v1) (lval_varname (varn_name "ipv4")) of | SOME scope_list' => - (case assign scope_list' (set_validity T $ init_out_v esp_header) (lval_varname (varn_name "esp")) of + let (v2, oracle_index'') = init_out_v random_oracle oracle_index esp_header in + (case assign scope_list' (set_validity T v2) (lval_varname (varn_name "esp")) of | SOME scope_list'' => - SOME ((counter, ext_obj_map, v_map, ctrl), scope_list'', status_returnv v_bot) + SOME ((counter, ext_obj_map, v_map, ctrl, oracle_index), scope_list'', status_returnv v_bot) | _ => NONE) | _ => NONE) | _ => NONE) @@ -461,16 +476,18 @@ Definition ipsec_crypt_encrypt_aes_ctr_def: End Definition ipsec_crypt_encrypt_null_def: - (ipsec_crypt_encrypt_null ((counter, ext_obj_map, v_map, ctrl):v1model_ascope, g_scope_list:g_scope_list, scope_list) = + (ipsec_crypt_encrypt_null random_oracle ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "ipv4")) of | SOME ipv4_header => (case lookup_lval scope_list (lval_varname (varn_name "esp")) of | SOME esp_header => - (case assign scope_list (set_validity T $ init_out_v ipv4_header) (lval_varname (varn_name "ipv4")) of + let (v1, oracle_index') = init_out_v random_oracle oracle_index ipv4_header in + (case assign scope_list (set_validity T v1) (lval_varname (varn_name "ipv4")) of | SOME scope_list' => - (case assign scope_list' (set_validity T $ init_out_v esp_header) (lval_varname (varn_name "esp")) of + let (v2, oracle_index'') = init_out_v random_oracle oracle_index esp_header in + (case assign scope_list' (set_validity T v2) (lval_varname (varn_name "esp")) of | SOME scope_list'' => - SOME ((counter, ext_obj_map, v_map, ctrl), scope_list'', status_returnv v_bot) + SOME ((counter, ext_obj_map, v_map, ctrl, oracle_index''), scope_list'', status_returnv v_bot) | _ => NONE) | _ => NONE) | _ => NONE) @@ -479,20 +496,23 @@ Definition ipsec_crypt_encrypt_null_def: End Definition ipsec_crypt_decrypt_null_def: - (ipsec_crypt_decrypt_null ((counter, ext_obj_map, v_map, ctrl):v1model_ascope, g_scope_list:g_scope_list, scope_list) = + (ipsec_crypt_decrypt_null random_oracle ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "ipv4")) of | SOME ipv4_header => (case lookup_lval scope_list (lval_varname (varn_name "esp")) of | SOME esp_header => (case lookup_lval scope_list (lval_varname (varn_name "standard_metadata")) of | SOME standard_metadata => - (case assign scope_list (set_validity T $ init_out_v ipv4_header) (lval_varname (varn_name "ipv4")) of + let (v1, oracle_index') = init_out_v random_oracle oracle_index ipv4_header in + (case assign scope_list (set_validity T v1) (lval_varname (varn_name "ipv4")) of | SOME scope_list' => - (case assign scope_list' (set_validity T $ init_out_v esp_header) (lval_varname (varn_name "esp")) of + let (v2, oracle_index'') = init_out_v random_oracle oracle_index esp_header in + (case assign scope_list' (set_validity T v2) (lval_varname (varn_name "esp")) of | SOME scope_list'' => - (case assign scope_list'' (set_validity T $ init_out_v standard_metadata) (lval_varname (varn_name "standard_metadata")) of + let (v3, oracle_index''') = init_out_v random_oracle oracle_index standard_metadata in + (case assign scope_list'' (set_validity T v3) (lval_varname (varn_name "standard_metadata")) of | SOME scope_list''' => - SOME ((counter, ext_obj_map, v_map, ctrl), scope_list''', status_returnv v_bot) + SOME ((counter, ext_obj_map, v_map, ctrl, oracle_index'''), scope_list''', status_returnv v_bot) | _ => NONE) | _ => NONE) | _ => NONE) @@ -599,55 +619,32 @@ Definition v1model_reduce_nonout_def: | (e_var (varn_name x)) => (case ALOOKUP v_map x of | SOME v => - if is_d_in d - then oCONS (e_v v, v1model_reduce_nonout (dlist, elist, v_map)) - else oCONS (e_v (init_out_v v), v1model_reduce_nonout (dlist, elist, v_map)) + (* NOTE: Only externs can be passed as directionless arguments here *) + oCONS (e_v v, v1model_reduce_nonout (dlist, elist, v_map)) | _ => NONE) | _ => NONE)) /\ (v1model_reduce_nonout (_, _, v_map) = NONE) End -(* TODO: Generalise and move to core? Duplicated in all three architectures... *) -(* TODO: Remove these and keep "v_map" as just a regular scope? *) -Definition v_map_to_scope_def: - (v_map_to_scope [] = []) /\ - (v_map_to_scope (((k, v)::t):(string, v) alist) = - ((varn_name k, (v, NONE:lval option))::v_map_to_scope t) - ) -End - -(* TODO: Generalise and move to core? Duplicated in all three architectures... *) -Definition scope_to_vmap_def: - (scope_to_vmap [] = SOME []) /\ - (scope_to_vmap ((vn, (v:v, lval_opt:lval option))::t) = - case vn of - | (varn_name k) => oCONS ((k, v), scope_to_vmap t) - | _ => NONE - ) -End - (* TODO: Since the same thing should be initialised * for all known architectures, maybe it should be made a * architecture-generic (core) function? *) (* TODO: Don't reduce all arguments at once? *) Definition v1model_copyin_pbl_def: - v1model_copyin_pbl (xlist, dlist, elist, (counter, ext_obj_map, v_map, ctrl):v1model_ascope) = + v1model_copyin_pbl (xlist, dlist, elist, (counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, random_oracle) = case v1model_reduce_nonout (dlist, elist, v_map) of | SOME elist' => - (case copyin xlist dlist elist' [v_map_to_scope v_map] [ [] ] of - | SOME scope => - SOME scope - | NONE => NONE) + copyin xlist dlist elist' [v_map_to_scope v_map] [ [] ] oracle_index random_oracle | NONE => NONE End (* Note that this re-uses the copyout function intended for P4 functions *) Definition v1model_copyout_pbl_def: - v1model_copyout_pbl (g_scope_list, (counter, ext_obj_map, v_map, ctrl):v1model_ascope, dlist, xlist, (status:status)) = + v1model_copyout_pbl (g_scope_list, (counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope, dlist, xlist, (status:status)) = case copyout_pbl_gen xlist dlist g_scope_list v_map of | SOME [v_map_scope] => (case scope_to_vmap v_map_scope of - | SOME v_map' => SOME ((counter, ext_obj_map, v_map', ctrl):v1model_ascope) + | SOME v_map' => SOME ((counter, ext_obj_map, v_map', ctrl, oracle_index):v1model_ascope) | NONE => NONE) | _ => NONE End @@ -665,7 +662,7 @@ End * then resets the shared packet "b" (TODO: Fix that hack) and saves its content in "b_temp" *) (* TODO: Note that this also resets parseError to 0 *) Definition v1model_postparser_def: - v1model_postparser ((counter, ext_obj_map, v_map, ctrl):v1model_ascope) = + v1model_postparser ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope) = (case ALOOKUP v_map "b" of | SOME (v_ext_ref i) => (case ALOOKUP ext_obj_map i of @@ -682,8 +679,8 @@ Definition v1model_postparser_def: (case scope_to_vmap v_map_scope of | SOME v_map'' => let v_map''' = AUPDATE v_map'' ("parseError", v_bit (fixwidth 32 (n2v 0), 32)) in - let (counter', ext_obj_map', v_map'''', ctrl') = (v1model_ascope_update (counter, ext_obj_map, v_map''', ctrl) i' (INL (core_v_ext_packet bl))) in - SOME (v1model_ascope_update (counter', ext_obj_map', v_map'''', ctrl') i (INL (core_v_ext_packet []))) + let (counter', ext_obj_map', v_map'''', ctrl', oracle_index') = (v1model_ascope_update (counter, ext_obj_map, v_map''', ctrl, oracle_index) i' (INL (core_v_ext_packet bl))) in + SOME (v1model_ascope_update (counter', ext_obj_map', v_map'''', ctrl', oracle_index') i (INL (core_v_ext_packet []))) | NONE => NONE) | _ => NONE) | NONE => NONE) @@ -709,7 +706,7 @@ End (* NOTE: "b" renamed to "b_out" *) (* A little clumsy with the double v2n, but that makes things easier *) Definition v1model_output_f_def: - v1model_output_f (in_out_list:in_out_list, (counter, ext_obj_map, v_map, ctrl):v1model_ascope) = + v1model_output_f (in_out_list:in_out_list, (counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope) = (case v1model_lookup_obj ext_obj_map v_map "b" of | SOME (INL (core_v_ext_packet bl)) => (case v1model_lookup_obj ext_obj_map v_map "b_temp" of @@ -718,12 +715,12 @@ Definition v1model_output_f_def: | SOME (v_struct struct) => (case ALOOKUP struct "egress_spec" of | SOME (v_bit (port_bl, n)) => - SOME (in_out_list++(if v1model_is_drop_port port_bl then [] else [(bl++bl', v2n port_bl)]), (counter, ext_obj_map, v_map, ctrl)) + SOME (in_out_list++(if v1model_is_drop_port port_bl then [] else [(bl++bl', v2n port_bl)]), (counter, ext_obj_map, v_map, ctrl, oracle_index)) | _ => NONE) | _ => NONE) | _ => NONE) | _ => NONE) -End +End (* This assumes that tables contains at most one LPM key, * with other keys being exact if one LPM key is present. @@ -732,7 +729,7 @@ End val v1model_apply_table_f_def = if CONTROL_PLANE_API = 0 then xDefine "v1model_apply_table_f" - ‘v1model_apply_table_f (x, e_l, mk_list:mk_list, (x', e_l'), (counter, ext_obj_map, v_map, ctrl):v1model_ascope) = + ‘v1model_apply_table_f (x, e_l, mk_list:mk_list, (x', e_l'), (counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope) = (* TODO: Note that this function could do other stuff here depending on table name. * Ideally, one could make a general, not hard-coded, solution for this *) case ALOOKUP ctrl x of @@ -747,7 +744,7 @@ val v1model_apply_table_f_def = SOME (FST $ FOLDL_MATCH_alt e_l ((x', e_l'), NONE) (1:num) table) | NONE => NONE’ else xDefine "v1model_apply_table_f" - ‘v1model_apply_table_f (x, e_l, mk_list:mk_list, (x', e_l'), (counter, ext_obj_map, v_map, ctrl):v1model_ascope) = + ‘v1model_apply_table_f (x, e_l, mk_list:mk_list, (x', e_l'), (counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope) = (* TODO: Note that this function could do other stuff here depending on table name. * Ideally, one could make a general, not hard-coded, solution for this *) case ALOOKUP ctrl x of @@ -756,4 +753,16 @@ val v1model_apply_table_f_def = SOME (FST $ FOLDL_MATCH e_l ((x', e_l'), NONE) table) | NONE => NONE’; +(* TODO: Generalise the below as needed *) + +Definition v1model_get_oracle_index_def: + v1model_get_oracle_index ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope) = + oracle_index +End + +Definition v1model_set_oracle_index_def: + v1model_set_oracle_index i_opt ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope) = + (counter, ext_obj_map, v_map, ctrl, case i_opt of NONE => oracle_index | SOME i => i):v1model_ascope +End + val _ = export_theory (); diff --git a/hol/p4_vssLib.sig b/hol/p4_vssLib.sig index b25f0940..0e509144 100644 --- a/hol/p4_vssLib.sig +++ b/hol/p4_vssLib.sig @@ -24,6 +24,9 @@ val vss_output_f : term val vss_apply_table_f : term +val vss_get_oracle_index : term +val vss_set_oracle_index : term + val vss_copyin_pbl : term val vss_copyout_pbl : term diff --git a/hol/p4_vssLib.sml b/hol/p4_vssLib.sml index 6e231e73..960124da 100644 --- a/hol/p4_vssLib.sml +++ b/hol/p4_vssLib.sml @@ -61,6 +61,12 @@ val vss_copyout_pbl = ``vss_copyout_pbl``; (* Programmable block output function term *) val vss_apply_table_f = ``vss_apply_table_f``; +(* Oracle index getter *) +val vss_get_oracle_index = ``vss_get_oracle_index``; + +(* Oracle index setter *) +val vss_set_oracle_index = ``vss_set_oracle_index``; + (* Fixed-function block map *) val vss_ffblock_map = ``[("parser_runtime", ffblock_ff vss_parser_runtime); ("pre_deparser", ffblock_ff vss_pre_deparser)]:vss_ascope ffblock_map``; @@ -87,32 +93,12 @@ val vss_init_counter = term_of_int 3; val vss_init_ext_obj_map = ``[(0, INL (core_v_ext_packet [])); (1, INL (core_v_ext_packet [])); (2, INL (core_v_ext_packet []))]:(num, vss_sum_v_ext) alist``; -(* -val ipv4_header_uninit = - mk_v_header_list F - [(``"version"``, mk_v_biti_arb 4), - (``"ihl"``, mk_v_biti_arb 4), - (``"diffserv"``, mk_v_biti_arb 8), - (``"totalLen"``, mk_v_biti_arb 16), - (``"identification"``, mk_v_biti_arb 16), - (``"flags"``, mk_v_biti_arb 3), - (``"fragOffset"``, mk_v_biti_arb 13), - (``"ttl"``, mk_v_biti_arb 8), - (``"protocol"``, mk_v_biti_arb 8), - (``"hdrChecksum"``, mk_v_biti_arb 16), - (``"srcAddr"``, mk_v_biti_arb 32), - (``"dstAddr"``, mk_v_biti_arb 32)]; -val ethernet_header_uninit = - mk_v_header_list F - [(``"dstAddr"``, mk_v_biti_arb 48), - (``"srcAddr"``, mk_v_biti_arb 48), - (``"etherType"``, mk_v_biti_arb 16)]; -val vss_parsed_packet_struct_uninit = - mk_v_struct_list [(``"ethernet"``, ethernet_header_uninit), (``"ip"``, ipv4_header_uninit)]; -*) + val vss_init_v_map = ``^core_init_v_map ++ - [("inCtrl", v_struct [("inputPort", ^(mk_v_biti_arb 4))]); - ("outCtrl", v_struct [("outputPort", ^(mk_v_biti_arb 4))]); + (* Both input port and output port can be concretized initially + * without ambiguity. *) + [("inCtrl", v_struct [("inputPort", ^(mk_v_bitii (0,4)))]); + ("outCtrl", v_struct [("outputPort", ^(mk_v_bitii (0,4)))]); ("b_in", v_ext_ref 0); ("b_out", v_ext_ref 1); ("data_crc", v_ext_ref 2)]:(string, v) alist``; diff --git a/hol/p4_vssScript.sml b/hol/p4_vssScript.sml index df6d62d1..0f1bb60c 100644 --- a/hol/p4_vssScript.sml +++ b/hol/p4_vssScript.sml @@ -1,9 +1,10 @@ -open HolKernel boolLib Parse bossLib ottLib; - -open p4Theory p4_auxTheory p4_coreTheory; +open HolKernel boolLib Parse bossLib; val _ = new_theory "p4_vss"; +open ottLib; +open p4Theory p4_auxTheory p4_coreTheory; + Datatype: vss_v_ext = vss_v_ext_ipv4_checksum (word16 list) @@ -13,7 +14,7 @@ val _ = type_abbrev("vss_sum_v_ext", ``:(core_v_ext, vss_v_ext) sum``); val _ = type_abbrev("vss_ctrl", ``:(string, (((e_list -> bool) # num), string # e_list) alist) alist``); (* The architectural state type of the VSS architecture model *) -val _ = type_abbrev("vss_ascope", ``:(num # ((num, vss_sum_v_ext) alist) # ((string, v) alist) # vss_ctrl)``); +val _ = type_abbrev("vss_ascope", ``:(num # ((num, vss_sum_v_ext) alist) # ((string, v) alist) # vss_ctrl # num)``); (**********************************************************) (* SPECIALISED CORE METHODS *) @@ -26,13 +27,13 @@ Definition vss_ascope_lookup_def: End Definition vss_ascope_update_def: - vss_ascope_update ((counter, ext_obj_map, v_map, ctrl):vss_ascope) ext_ref v_ext = - (counter, AUPDATE ext_obj_map (ext_ref, v_ext), v_map, ctrl) + vss_ascope_update ((counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope) ext_ref v_ext = + (counter, AUPDATE ext_obj_map (ext_ref, v_ext), v_map, ctrl, oracle_index) End Definition vss_ascope_update_v_map_def: - vss_ascope_update_v_map ((counter, ext_obj_map, v_map, ctrl):vss_ascope) str v = - (counter, ext_obj_map, AUPDATE v_map (str, v), ctrl) + vss_ascope_update_v_map ((counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope) str v = + (counter, ext_obj_map, AUPDATE v_map (str, v), ctrl, oracle_index) End Definition vss_packet_in_extract: @@ -69,11 +70,11 @@ End (* construct *) Definition Checksum16_construct: - (Checksum16_construct ((counter, ext_obj_map, v_map, ctrl):vss_ascope, g_scope_list:g_scope_list, scope_list) = + (Checksum16_construct ((counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope, g_scope_list:g_scope_list, scope_list) = let ext_obj_map' = AUPDATE ext_obj_map (counter, INR (vss_v_ext_ipv4_checksum ([]:word16 list))) in (case assign scope_list (v_ext_ref counter) (lval_varname (varn_name "this")) of | SOME scope_list' => - SOME ((counter + 1, ext_obj_map', v_map, ctrl), scope_list', status_returnv v_bot) + SOME ((counter + 1, ext_obj_map', v_map, ctrl, oracle_index), scope_list', status_returnv v_bot) | NONE => NONE) ) End @@ -83,10 +84,10 @@ End (* clear *) Definition Checksum16_clear: - (Checksum16_clear ((counter, ext_obj_map, v_map, ctrl):vss_ascope, g_scope_list:g_scope_list, scope_list) = + (Checksum16_clear ((counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "this")) of | SOME (v_ext_ref i) => - SOME ((counter, AUPDATE ext_obj_map (i, INR (vss_v_ext_ipv4_checksum ([]:word16 list))), v_map, ctrl), scope_list, status_returnv v_bot) + SOME ((counter, AUPDATE ext_obj_map (i, INR (vss_v_ext_ipv4_checksum ([]:word16 list))), v_map, ctrl, oracle_index), scope_list, status_returnv v_bot) | _ => NONE ) End @@ -97,14 +98,14 @@ End (* Note that this assumes the order of fields in the header is correct *) Definition Checksum16_update: - (Checksum16_update ((counter, ext_obj_map, v_map, ctrl):vss_ascope, g_scope_list:g_scope_list, scope_list) = + (Checksum16_update ((counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "this")) of | SOME (v_ext_ref i) => (case ALOOKUP ext_obj_map i of | SOME (INR (vss_v_ext_ipv4_checksum ipv4_checksum)) => (case get_checksum_incr scope_list (lval_varname (varn_name "data")) of | SOME checksum_incr => - SOME ((counter, AUPDATE ext_obj_map (i, INR (vss_v_ext_ipv4_checksum (ipv4_checksum ++ checksum_incr))), v_map, ctrl), scope_list, status_returnv v_bot) + SOME ((counter, AUPDATE ext_obj_map (i, INR (vss_v_ext_ipv4_checksum (ipv4_checksum ++ checksum_incr))), v_map, ctrl, oracle_index), scope_list, status_returnv v_bot) | NONE => NONE) | _ => NONE) | _ => NONE @@ -116,12 +117,12 @@ End (* get *) Definition Checksum16_get: - (Checksum16_get ((counter, ext_obj_map, v_map, ctrl):vss_ascope, g_scope_list:g_scope_list, scope_list) = + (Checksum16_get ((counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope, g_scope_list:g_scope_list, scope_list) = case lookup_lval scope_list (lval_varname (varn_name "this")) of | SOME (v_ext_ref i) => (case ALOOKUP ext_obj_map i of | SOME (INR (vss_v_ext_ipv4_checksum ipv4_checksum)) => - SOME ((counter, ext_obj_map, v_map, ctrl):vss_ascope, scope_list, status_returnv (v_bit (w16 (compute_checksum16 ipv4_checksum)))) + SOME ((counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope, scope_list, status_returnv (v_bit (w16 (compute_checksum16 ipv4_checksum)))) | _ => NONE) | _ => NONE ) @@ -150,7 +151,7 @@ End (* NOTE: "b" renamed to "b_in" *) (* TODO: Note that this also resets parseError to 0 *) Definition vss_input_f_def: - (vss_input_f (io_list:in_out_list, (counter, ext_obj_map, v_map, ctrl):vss_ascope) = + (vss_input_f (io_list:in_out_list, (counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope) = case io_list of | [] => NONE | ((bl,p)::t) => @@ -170,7 +171,7 @@ Definition vss_input_f_def: * function for vss_ascope. *) let v_map' = AUPDATE v_map ("inCtrl", v_struct [("inputPort", v_bit (w4 (n2w p)))]) in let v_map'' = AUPDATE v_map' ("parseError", v_bit (fixwidth 32 (n2v 0), 32)) in - SOME (t, (counter, ext_obj_map'', v_map'', ctrl):vss_ascope) + SOME (t, (counter, ext_obj_map'', v_map'', ctrl, oracle_index):vss_ascope) | _ => NONE) | _ => NONE) | NONE => NONE) @@ -178,6 +179,8 @@ Definition vss_input_f_def: | _ => NONE) End +(* The point of this function is to look up in-directed variables in v_map before passing the result + * to copyin *) Definition vss_reduce_nonout_def: (vss_reduce_nonout ([], elist, v_map) = SOME [] @@ -190,9 +193,8 @@ Definition vss_reduce_nonout_def: | (e_var (varn_name x)) => (case ALOOKUP v_map x of | SOME v => - if is_d_in d - then oCONS (e_v v, vss_reduce_nonout (dlist, elist, v_map)) - else oCONS (e_v (init_out_v v), vss_reduce_nonout (dlist, elist, v_map)) + (* NOTE: Only externs can be passed as directionless arguments here *) + oCONS (e_v v, vss_reduce_nonout (dlist, elist, v_map)) | _ => NONE) | _ => NONE)) /\ (vss_reduce_nonout (_, _, v_map) = NONE) @@ -203,39 +205,39 @@ End * architecture-generic (core) function? *) (* TODO: Don't reduce all arguments at once? *) Definition vss_copyin_pbl_def: - vss_copyin_pbl (xlist, dlist, elist, (counter, ext_obj_map, v_map, ctrl):vss_ascope) = + vss_copyin_pbl (xlist, dlist, elist, (counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope, random_oracle) = case vss_reduce_nonout (dlist, elist, v_map) of | SOME elist' => - copyin xlist dlist elist' [v_map_to_scope v_map] [ [] ] + copyin xlist dlist elist' [v_map_to_scope v_map] [ [] ] oracle_index random_oracle | NONE => NONE End (* TODO: Does anything need to be looked up for this function? *) Definition vss_copyout_pbl_def: - vss_copyout_pbl (g_scope_list, (counter, ext_obj_map, v_map, ctrl):vss_ascope, dlist, xlist, (status:status)) = + vss_copyout_pbl (g_scope_list, (counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope, dlist, xlist, (status:status)) = case copyout_pbl_gen xlist dlist g_scope_list v_map of | SOME [v_map_scope] => (case scope_to_vmap v_map_scope of - | SOME v_map' => SOME ((counter, ext_obj_map, v_map', ctrl):vss_ascope) + | SOME v_map' => SOME ((counter, ext_obj_map, v_map', ctrl, oracle_index):vss_ascope) | NONE => NONE) | _ => NONE End Definition vss_parser_runtime_def: - vss_parser_runtime ((counter, ext_obj_map, v_map, ctrl):vss_ascope) = + vss_parser_runtime ((counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope) = (case ALOOKUP v_map "parsedHeaders" of | SOME (v_struct hdrs) => let v_map' = AUPDATE v_map ("headers", v_struct hdrs) in - SOME (counter, ext_obj_map, v_map', ctrl) + SOME (counter, ext_obj_map, v_map', ctrl, oracle_index) | _ => NONE) End Definition vss_pre_deparser_def: - vss_pre_deparser ((counter, ext_obj_map, v_map, ctrl):vss_ascope) = + vss_pre_deparser ((counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope) = (case ALOOKUP v_map "headers" of | SOME (v_struct hdrs) => let v_map' = AUPDATE v_map ("outputHeaders", v_struct hdrs) in - SOME (counter, ext_obj_map, v_map', ctrl) + SOME (counter, ext_obj_map, v_map', ctrl, oracle_index) | _ => NONE) End @@ -252,7 +254,7 @@ End (* TODO: Outsource obtaining the output port to an external function? *) (* NOTE: "b" renamed to "b_out" *) Definition vss_output_f_def: - vss_output_f (in_out_list:in_out_list, (counter, ext_obj_map, v_map, ctrl):vss_ascope) = + vss_output_f (in_out_list:in_out_list, (counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope) = (case vss_lookup_obj ext_obj_map v_map "b_out" of | SOME (INL (core_v_ext_packet headers)) => (case vss_lookup_obj ext_obj_map v_map "data_crc" of @@ -264,9 +266,9 @@ Definition vss_output_f_def: in if port_out = 15 then - SOME (in_out_list, (counter, ext_obj_map, v_map, ctrl)) + SOME (in_out_list, (counter, ext_obj_map, v_map, ctrl, oracle_index)) else - SOME (in_out_list++[(headers++data_crc, port_out)], (counter, ext_obj_map, v_map, ctrl)) + SOME (in_out_list++[(headers++data_crc, port_out)], (counter, ext_obj_map, v_map, ctrl, oracle_index)) | _ => NONE) | _ => NONE) | _ => NONE) @@ -290,7 +292,7 @@ Definition ctrl_check_ttl: End Definition vss_apply_table_f_def: - vss_apply_table_f (x, e_l, mk_list:mk_list, (x', e_l'), (counter, ext_obj_map, v_map, ctrl):vss_ascope) = + vss_apply_table_f (x, e_l, mk_list:mk_list, (x', e_l'), (counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope) = (* TODO: Note that this function could do other stuff here depending on table name. * Ideally, one could make a general, not hard-coded, solution for this *) if x = "check_ttl" @@ -304,4 +306,16 @@ Definition vss_apply_table_f_def: | NONE => NONE) End +(* TODO: Generalise the below as needed *) + +Definition vss_get_oracle_index_def: + vss_get_oracle_index ((counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope) = + oracle_index +End + +Definition vss_set_oracle_index_def: + vss_set_oracle_index i_opt ((counter, ext_obj_map, v_map, ctrl, oracle_index):vss_ascope) = + (counter, ext_obj_map, v_map, ctrl, case i_opt of NONE => oracle_index | SOME i => i):vss_ascope +End + val _ = export_theory (); diff --git a/hol/p4_vss_exampleScript.sml b/hol/p4_vss_exampleScript.sml index 6d15780c..834d4ae3 100644 --- a/hol/p4_vss_exampleScript.sml +++ b/hol/p4_vss_exampleScript.sml @@ -1,12 +1,12 @@ open HolKernel boolLib Parse bossLib; +val _ = new_theory "p4_vss_example"; + open p4Theory p4_vssTheory; open pairSyntax listSyntax p4Syntax; open p4_vssLib; -val _ = new_theory "p4_vss_example"; - (* This file contains the VSS example program. Specifically, it saves a theorem * that contains the architectural context of the program. *) @@ -218,6 +218,7 @@ val vss_pblock_map = ``[("parser", (^vss_parser_pbl)); ("deparser", (^vss_deparser_pbl))]``; (* TODO: Make syntax functions *) +(* val vss_actx = ``(^(list_mk_pair [``(^vss_ab_list):ab_list``, ``(^vss_pblock_map):pblock_map``, @@ -228,10 +229,35 @@ val vss_actx = ``(^vss_copyout_pbl):vss_ascope copyout_pbl``, ``(^vss_apply_table_f):vss_ascope apply_table_f``, ``(^vss_ext_map):vss_ascope ext_map``, - ``(^vss_func_map):func_map``])):vss_ascope actx``; + ``(^vss_func_map):func_map``, + ``(^vss_get_oracle_index):vss_ascope get_oracle_index``, + ``(^vss_set_oracle_index):vss_ascope set_oracle_index``, + ``(\n. F):random_oracle``])):vss_ascope actx``; +(* The default vss actx *) Definition p4_vss_actx_def: p4_vss_actx = ^vss_actx End +*) + +val vss_actx = + ``(^(list_mk_pair [``(^vss_ab_list):ab_list``, + ``(^vss_pblock_map):pblock_map``, + ``(^vss_ffblock_map):vss_ascope ffblock_map``, + ``(^vss_input_f):vss_ascope input_f``, + ``(^vss_output_f):vss_ascope output_f``, + ``(^vss_copyin_pbl):vss_ascope copyin_pbl``, + ``(^vss_copyout_pbl):vss_ascope copyout_pbl``, + ``(^vss_apply_table_f):vss_ascope apply_table_f``, + ``(^vss_ext_map):vss_ascope ext_map``, + ``(^vss_func_map):func_map``, + ``(^vss_get_oracle_index):vss_ascope get_oracle_index``, + ``(^vss_set_oracle_index):vss_ascope set_oracle_index``, + ``r:random_oracle``])):vss_ascope actx``; + +(* The default vss actx *) +Definition p4_vss_actx_def: + p4_vss_actx r = ^vss_actx +End val _ = export_theory (); diff --git a/hol/polymorphise_p4Script.py b/hol/polymorphise_p4Script.py index 0c0d10e1..c40e0fb8 100644 --- a/hol/polymorphise_p4Script.py +++ b/hol/polymorphise_p4Script.py @@ -13,18 +13,21 @@ "val _ = Hol_datatype ` \nffblock = (* fixed-function block *)\n ffblock_ff of 'a ff\n`;"), ("Type ffblock_map = ``:((string, ffblock) alist)``", "Type ffblock_map = ``:((string, 'a ffblock) alist)``"), - ("Type actx = ``:(ab_list # pblock_map # ffblock_map # input_f # output_f # copyin_pbl # copyout_pbl # ext_map # func_map)``", - "Type actx = ``:(ab_list # pblock_map # 'a ffblock_map # 'a input_f # 'a output_f # 'a copyin_pbl # 'a copyout_pbl # ext_map # func_map)``"), + #TODO: Handled below? + ("Type actx = ``:(ab_list # pblock_map # ffblock_map # input_f # output_f # copyin_pbl # copyout_pbl # apply_table_f # ext_map # func_map # get_oracle_index # set_oracle_index # random_oracle)``", + "Type actx = ``:(ab_list # pblock_map # 'a ffblock_map # 'a input_f # 'a output_f # 'a copyin_pbl # 'a copyout_pbl # 'a apply_table_f # 'a ext_map # func_map # 'a get_oracle_index # 'a set_oracle_index # random_oracle)``"), ("Type astate = ``:(aenv # g_scope_list # arch_frame_list # status)``", "Type astate = ``:('a aenv # g_scope_list # arch_frame_list # status)``"), ("Type ext_fun_map = ``:((string, ((string # d) list # ext_fun)) alist)``", "Type ext_fun_map = ``:((string, ((string # d) list # 'a ext_fun)) alist)``"), ("Type ext_map = ``:((string, ((((string # d) list # ext_fun) option) # ext_fun_map)) alist)``", "Type ext_map = ``:((string, ((((string # d) list # 'a ext_fun) option) # 'a ext_fun_map)) alist)``"), - ("Type ctx = ``:(apply_table_f # ext_map # func_map # b_func_map # pars_map # tbl_map)``", - "Type ctx = ``:('a apply_table_f # 'a ext_map # func_map # b_func_map # pars_map # tbl_map)``"), - ("Type actx = ``:(ab_list # pblock_map # ffblock_map # input_f # output_f # copyin_pbl # copyout_pbl # apply_table_f # ext_map # func_map)``", - "Type actx = ``:(ab_list # pblock_map # 'a ffblock_map # 'a input_f # 'a output_f # 'a copyin_pbl # 'a copyout_pbl # 'a apply_table_f # 'a ext_map # func_map)``") + ("Type ctx = ``:(apply_table_f # ext_map # func_map # b_func_map # pars_map # tbl_map # get_oracle_index # set_oracle_index # random_oracle)``", + "Type ctx = ``:('a apply_table_f # 'a ext_map # func_map # b_func_map # pars_map # tbl_map # 'a get_oracle_index # 'a set_oracle_index # random_oracle)``"), + ("Type ectx = ``:(apply_table_f # ext_map # func_map # b_func_map # pars_map # tbl_map # i # random_oracle)``", + "Type ectx = ``:('a apply_table_f # 'a ext_map # func_map # b_func_map # pars_map # tbl_map # i # random_oracle)``"), + ("Type actx = ``:(ab_list # pblock_map # ffblock_map # input_f # output_f # copyin_pbl # copyout_pbl # apply_table_f # ext_map # func_map # 'a get_oracle_index # 'a set_oracle_index # random_oracle)``", + "Type actx = ``:(ab_list # pblock_map # 'a ffblock_map # 'a input_f # 'a output_f # 'a copyin_pbl # 'a copyout_pbl # 'a apply_table_f # 'a ext_map # func_map # 'a get_oracle_index # 'a set_oracle_index # random_oracle)``") ]) #Assign the polymorphic types (found in semantics definitions, et.c.) a proper 'a @@ -37,9 +40,12 @@ (":copyin_pbl", ":'a copyin_pbl"), (":copyout_pbl", ":'a copyout_pbl"), (":ff", ":'a ff"), + (":ectx", ":'a ectx"), (":ctx", ":'a ctx"), (":ext_map", ":'a ext_map"), (":ext_fun", ":'a ext_fun"), + (":get_oracle_index", ":'a get_oracle_index"), + (":set_oracle_index", ":'a set_oracle_index"), (":apply_table_f", ":'a apply_table_f")]) all_replaces = OrderedDict(list(od_hacks.items()) + list(od.items())) diff --git a/hol/symb_exec/p4_bigstepScript.sml b/hol/symb_exec/bigstep_backup/p4_bigstepScript.sml similarity index 97% rename from hol/symb_exec/p4_bigstepScript.sml rename to hol/symb_exec/bigstep_backup/p4_bigstepScript.sml index 5c37a076..cdd9c770 100644 --- a/hol/symb_exec/p4_bigstepScript.sml +++ b/hol/symb_exec/bigstep_backup/p4_bigstepScript.sml @@ -388,7 +388,7 @@ Definition bigstep_arch_exec_def: | (stmt::t') => let func_maps_opt = (case ctx_b_func_map_opt of | NONE => NONE - | SOME (((ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map):'a actx), b_func_map) => SOME (func_map, b_func_map, ext_map)) in + | SOME (((ab_list, pblock_map, ffblock_map, input_f, output_f, copyin_pbl, copyout_pbl, apply_table_f, ext_map, func_map, get_oracle_index, set_oracle_index, random_oracle):'a actx), b_func_map) => SOME (func_map, b_func_map, ext_map)) in (case bigstep_exec func_maps_opt ([g_scope1; g_scope2], scope_list) stmt of | SOME (stmt', g_scope_list', scope_list', n) => SOME (g_scope_list', arch_frame_list_regular ((funn, (stmt'::t'), scope_list')::t), n) @@ -1178,18 +1178,18 @@ gs[listTheory.INDEX_FIND_add] QED Theorem bigstep_e_exec_sound: -!t scope_list g_scope_list' t' e e_l apply_table_f (ext_map:'a ext_map) func_map b_func_map pars_map tbl_map. +!t scope_list g_scope_list' t' e e_l apply_table_f (ext_map:'a ext_map) func_map b_func_map pars_map tbl_map oracle_index random_oracle. bigstep_e_exec (scope_list ++ g_scope_list') t 0 = SOME (t', 1) ==> (t = (INL e) ==> -(?e'. (t' = (INL e')) /\ - e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) - g_scope_list' scope_list e = SOME (e', []))) /\ +(?e' oracle_index'. (t' = (INL e')) /\ + e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,oracle_index,random_oracle) + g_scope_list' scope_list e = SOME (e', ([], oracle_index')))) /\ (t = INR e_l ==> ((e_l = []) \/ ?i. unred_mem_index e_l = SOME i /\ - (?e'. - e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map) - g_scope_list' scope_list (EL i e_l) = SOME (e', []) /\ + (?e' oracle_index'. + e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,oracle_index,random_oracle) + g_scope_list' scope_list (EL i e_l) = SOME (e', ([], oracle_index')) /\ t' = INR (LUPDATE e' i e_l)))) Proof measureInduct_on ‘( \ t. case t of @@ -1249,7 +1249,8 @@ Induct_on ‘t’ >- ( ) >- ( Cases_on ‘x’ >> ( fs[is_v_def, bigstep_e_exec_def, AllCaseEqs()] - ) + ) >> + gvs[AllCaseEqs()] ) >> imp_res_tac bigstep_e_exec_unchanged >> gs[] @@ -1261,10 +1262,12 @@ Induct_on ‘t’ >- ( fs[] >> Cases_on ‘is_v x’ >> ( gs[] + ) >- ( + Cases_on ‘x’ >> ( + gs[is_v_def, bigstep_e_exec_def] + ) ) >> - Cases_on ‘x’ >> ( - gs[is_v_def, bigstep_e_exec_def] - ), + gvs[AllCaseEqs()], (* cast *) gvs[bigstep_e_exec_cast_REWR] >> ( @@ -1287,10 +1290,12 @@ Induct_on ‘t’ >- ( fs[] >> Cases_on ‘is_v x’ >> ( gs[] + ) >- ( + Cases_on ‘x’ >> ( + gs[is_v_def, bigstep_e_exec_def] + ) ) >> - Cases_on ‘x’ >> ( - gs[is_v_def, bigstep_e_exec_def] - ), + gvs[AllCaseEqs()], (* binop *) gvs[bigstep_e_exec_binop_REWR] >> ( @@ -1314,22 +1319,21 @@ Induct_on ‘t’ >- ( ) >- ( Cases_on ‘x’ >> ( gvs[is_v_def] + ) >> + Cases_on ‘is_v x'’ >> ( + gs[] ) >- ( - Cases_on ‘is_v x'’ >> ( - gs[] - ) >- ( - Cases_on ‘x'’ >> ( - gvs[is_v_def] - ) >> - gs[bigstep_e_exec_def] + Cases_on ‘x'’ >> ( + gvs[is_v_def] ) >> - gs[bigstep_e_exec_def] >> - gvs[] >> - PAT_X_ASSUM “!y. _” (fn thm => assume_tac (Q.SPECL [‘(INL x')’] thm)) >> - gs[e_size_def] >> - res_tac >> - fs[] - ) + gs[bigstep_e_exec_def] + ) >> + gs[bigstep_e_exec_def] >> + gvs[AllCaseEqs()] >> + PAT_X_ASSUM “!y. _” (fn thm => assume_tac (Q.SPECL [‘(INL x')’] thm)) >> + gs[e_size_def] >> + res_tac >> + fs[] ) >> imp_res_tac bigstep_e_exec_incr >> subgoal ‘n' = 1’ >- ( @@ -1350,7 +1354,7 @@ Induct_on ‘t’ >- ( res_tac >> fs[] >> imp_res_tac bigstep_e_exec_unchanged >> - gs[] + gvs[AllCaseEqs()] ) ) >- ( gs[] >> @@ -1359,7 +1363,7 @@ Induct_on ‘t’ >- ( res_tac >> fs[] >> Cases_on ‘x’ >> ( - gs[bigstep_e_exec_def] + gvs[bigstep_e_exec_def, AllCaseEqs()] ) ), @@ -1399,7 +1403,7 @@ Induct_on ‘t’ >- ( res_tac >> fs[] >> imp_res_tac bigstep_e_exec_unchanged >> - gs[] + gvs[AllCaseEqs()] ) >> imp_res_tac bigstep_e_exec_incr >> subgoal ‘n' = 1’ >- ( @@ -1417,7 +1421,7 @@ Induct_on ‘t’ >- ( res_tac >> fs[] >> imp_res_tac bigstep_e_exec_unchanged >> - gs[] + gvs[AllCaseEqs()] ) >- ( gs[] >> PAT_X_ASSUM “!y. _” (fn thm => assume_tac (Q.SPECL [‘(INL x)’] thm)) >> @@ -1428,7 +1432,7 @@ Induct_on ‘t’ >- ( gs[] ) >> Cases_on ‘x’ >> ( - gvs[is_v_bit_def] + gvs[is_v_bit_def, AllCaseEqs()] ) >> gs[bigstep_e_exec_def] ), @@ -1456,7 +1460,7 @@ Induct_on ‘t’ >- ( gs[] ) >> Cases_on ‘x’ >> ( - gs[is_v_bit_def, bigstep_e_exec_def] + gs[is_v_bit_def, bigstep_e_exec_def, AllCaseEqs()] ), (* call *) @@ -1476,7 +1480,8 @@ Induct_on ‘t’ >- ( PAT_X_ASSUM “!y. _” (fn thm => assume_tac (Q.SPECL [‘(INL x)’] thm)) >> gs[e_size_def] >> res_tac >> - fs[], + fs[] >> + gvs[AllCaseEqs()], (* struct *) rw[] >> @@ -1498,7 +1503,7 @@ Induct_on ‘t’ >- ( PAT_X_ASSUM “!y. _” (fn thm => ASSUME_TAC (Q.SPECL [‘(INR (MAP SND (l:(string # e) list)))’] thm)) >> gs[e_size_def, e3_e1_size, e3_size_list] >> res_tac >> - PAT_X_ASSUM “!tbl_map pars_map func_map ext_map b_func_map apply_table_f. _” (fn thm => ASSUME_TAC (Q.SPECL [‘tbl_map’, ‘pars_map’, ‘func_map’, ‘ext_map’, ‘b_func_map’, ‘apply_table_f’] thm)) >> + PAT_X_ASSUM “!tbl_map random_oracle pars_map oracle_index func_map ext_map b_func_map apply_table_f. _” (fn thm => ASSUME_TAC (Q.SPECL [‘tbl_map’, ‘random_oracle’, ‘pars_map’, ‘oracle_index’, ‘func_map’, ‘ext_map’, ‘b_func_map’, ‘apply_table_f’] thm)) >> Cases_on ‘l’ >- ( gs[bigstep_e_exec_def, e_exec_def] ) >> @@ -1528,7 +1533,7 @@ Induct_on ‘y’ >> ( ) >> fs[] >> res_tac >> - PAT_X_ASSUM “!tbl_map pars_map func_map ext_map b_func_map apply_table_f. _” (fn thm => ASSUME_TAC (Q.SPECL [‘tbl_map’, ‘pars_map’, ‘func_map’, ‘ext_map’, ‘b_func_map’, ‘apply_table_f’] thm)) >> + PAT_X_ASSUM “!tbl_map random_oracle pars_map oracle_index func_map ext_map b_func_map apply_table_f. _” (fn thm => ASSUME_TAC (Q.SPECL [‘tbl_map’, ‘random_oracle’, ‘pars_map’, ‘oracle_index’, ‘func_map’, ‘ext_map’, ‘b_func_map’, ‘apply_table_f’] thm)) >> fs[] >> gvs[] >- ( gs[bigstep_e_exec_def] @@ -1592,74 +1597,90 @@ QED (* TODO: rename "fuel" to "nsteps" or something else, since it has to do with a * compelled number of reductions *) +(* New type for mutli-step expression exec sem *) +Type emctx = “:('a apply_table_f # 'a ext_map # func_map # b_func_map # pars_map # tbl_map # random_oracle)”; + +Definition add_oracle_index_def: + add_oracle_index ((apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,random_oracle):'a emctx) i = + ((apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,i,random_oracle):'a ectx) +End + (* This will just yield NONE for new frames *) +(* Ugh, this looks ugly with random oracle index... *) Definition e_multi_exec_def: - (e_multi_exec _ _ _ e 0 = SOME e) + (e_multi_exec ((apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,random_oracle):'a emctx) _ _ (e,i) 0 = SOME (e, i)) /\ - (e_multi_exec (ctx:'a ctx) g_scope_list scope_list e (SUC fuel) = - case e_exec ctx g_scope_list scope_list e of - | SOME (e', []) => e_multi_exec ctx g_scope_list scope_list e' fuel + (e_multi_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,random_oracle) g_scope_list scope_list (e,i) (SUC fuel) = + case e_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,i,random_oracle) g_scope_list scope_list e of + | SOME (e', ([], SOME i')) => e_multi_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,random_oracle) g_scope_list scope_list (e',i') fuel + | SOME (e', ([], NONE)) => e_multi_exec (apply_table_f,ext_map,func_map,b_func_map,pars_map,tbl_map,random_oracle) g_scope_list scope_list (e',i) fuel | _ => NONE) End Definition e_multi_exec'_def: - (e_multi_exec' _ _ _ e 0 = SOME e) + (e_multi_exec' _ _ _ (e,i) 0 = SOME (e,i)) /\ - (e_multi_exec' (ctx:'a ctx) g_scope_list scope_list e (SUC fuel) = - case e_multi_exec' ctx g_scope_list scope_list e fuel of - | SOME e' => - (case e_exec ctx g_scope_list scope_list e' of - | SOME (e'', []) => SOME e'' + (e_multi_exec' (emctx:'a emctx) g_scope_list scope_list (e,i) (SUC fuel) = + case e_multi_exec' emctx g_scope_list scope_list (e,i) fuel of + | SOME (e',i') => + (case e_exec (add_oracle_index emctx i') g_scope_list scope_list e' of + | SOME (e'', ([], NONE)) => SOME (e'',i') + | SOME (e'', ([], SOME i'')) => SOME (e'',i'') | _ => NONE) | _ => NONE) End (* Version for use with e_multi_exec'_list *) Definition e_multi_exec'_count_def: - (e_multi_exec'_count _ _ _ e 0 = SOME (e, 0:num)) + (e_multi_exec'_count _ _ _ (e,i) 0 = SOME ((e,i), 0:num)) /\ - (e_multi_exec'_count (ctx:'a ctx) g_scope_list scope_list e (SUC fuel) = - case e_multi_exec'_count ctx g_scope_list scope_list e fuel of - | SOME (e', n) => - (case e_exec ctx g_scope_list scope_list e' of - | SOME (e'', []) => SOME (e'', n+1) + (e_multi_exec'_count (emctx:'a emctx) g_scope_list scope_list (e,i) (SUC fuel) = + case e_multi_exec'_count emctx g_scope_list scope_list (e,i) fuel of + | SOME ((e',i'), n) => + (case e_exec (add_oracle_index emctx i') g_scope_list scope_list e' of + | SOME (e'', ([], NONE)) => SOME ((e'',i'), n+1) + | SOME (e'', ([], SOME i'')) => SOME ((e'',i''), n+1) | _ => NONE) | _ => NONE) End Definition e_multi_exec'_list_def: - (e_multi_exec'_list _ _ _ e_l (0:num) = SOME e_l) + (e_multi_exec'_list _ _ _ (e_l, i) (0:num) = SOME (e_l,i)) /\ - (e_multi_exec'_list _ _ _ [] _ = SOME []) + (e_multi_exec'_list _ _ _ ([],i) _ = SOME ([],i)) /\ - (e_multi_exec'_list (ctx:'a ctx) g_scope_list scope_list (h::t) (SUC fuel) = + (e_multi_exec'_list (emctx:'a emctx) g_scope_list scope_list ((h::t),i) (SUC fuel) = if is_v h then - (case e_multi_exec'_list ctx g_scope_list scope_list t (SUC fuel) of - | SOME t' => SOME (h::t') + (case e_multi_exec'_list emctx g_scope_list scope_list (t,i) (SUC fuel) of + | SOME (t',i') => SOME ((h::t'), i') | NONE => NONE) else - (case e_multi_exec'_count ctx g_scope_list scope_list h (SUC fuel) of - | SOME (h', fuel_spent) => - (case e_multi_exec'_list ctx g_scope_list scope_list t ((SUC fuel)-fuel_spent) of - | SOME t' => SOME (h'::t') + (case e_multi_exec'_count emctx g_scope_list scope_list (h,i) (SUC fuel) of + | SOME ((h', i'), fuel_spent) => + (case e_multi_exec'_list emctx g_scope_list scope_list (t,i') ((SUC fuel)-fuel_spent) of + | SOME (t',i'') => SOME ((h'::t'), i'') | NONE => NONE) | _ => NONE)) +Termination +cheat End (* For the purposes of bigstep_stmt_app_exec_sound_n, it would be useful if * e_multi_exec'_list would find the first instance of a non-v expression in the expression * list and start reducing it stepwise using e_exec *) Definition e_multi_exec'_list'_def: - (e_multi_exec'_list' _ _ _ e_l 0 = SOME e_l) + (e_multi_exec'_list' _ _ _ (e_l,i) 0 = SOME (e_l,i)) /\ - (e_multi_exec'_list' (ctx:'a ctx) g_scope_list scope_list e_l (SUC fuel) = - case e_multi_exec'_list' ctx g_scope_list scope_list e_l fuel of - | SOME e_l' => + (e_multi_exec'_list' (emctx:'a emctx) g_scope_list scope_list (e_l,i) (SUC fuel) = + case e_multi_exec'_list' emctx g_scope_list scope_list (e_l,i) fuel of + | SOME (e_l',i') => (case unred_mem_index e_l' of - | SOME i => - (case e_exec ctx g_scope_list scope_list (EL i e_l') of - | SOME (e', []) => - SOME (LUPDATE e' i e_l') + | SOME j => + (case e_exec (add_oracle_index emctx i') g_scope_list scope_list (EL j e_l') of + | SOME (e', ([],NONE)) => + SOME ((LUPDATE e' j e_l'), i') + | SOME (e', ([],SOME i'')) => + SOME ((LUPDATE e' j e_l'), i'') | _ => NONE) | NONE => NONE) | NONE => NONE) @@ -1667,8 +1688,8 @@ End (* TODO: Move *) Theorem e_exec_not_v: -!ctx g_scope_list scope_list e e'. -e_exec ctx g_scope_list scope_list e = SOME (e',[]) ==> +!ctx g_scope_list scope_list e i e'. +e_exec ctx g_scope_list scope_list e = SOME (e',([],i)) ==> ~is_v e Proof rpt strip_tac >> @@ -1682,21 +1703,22 @@ Cases_on ‘e'’ >> ( QED Theorem bigstep_e_acc_exec_sound_n_not_v: -!ctx g_scope_list' scope_list e e' n f. +!emctx g_scope_list' scope_list e i e' i' n f. ~is_v e' ==> -e_multi_exec' (ctx:'a ctx) g_scope_list' scope_list e n = SOME e' ==> -e_multi_exec' ctx g_scope_list' scope_list (e_acc e f) n = SOME (e_acc e' f) +e_multi_exec' (emctx:'a emctx) g_scope_list' scope_list (e,i) n = SOME (e',i') ==> +e_multi_exec' emctx g_scope_list' scope_list ((e_acc e f),i) n = SOME ((e_acc e' f),i') Proof Induct_on ‘n’ >- ( gs[e_multi_exec'_def] ) >> rpt strip_tac >> -gs[e_multi_exec'_def, AllCaseEqs()] >> -subgoal ‘~is_v e''’ >- ( - metis_tac[e_exec_not_v] -) >> -res_tac >> -fs[e_exec_def] +gvs[e_multi_exec'_def, AllCaseEqs()] >> ( + subgoal ‘~is_v e''’ >- ( + metis_tac[e_exec_not_v] + ) >> + res_tac >> + fs[e_exec_def] +) QED Theorem bigstep_e_acc_exec_sound_n_v: diff --git a/hol/symb_exec/p4_bigstepSyntax.sig b/hol/symb_exec/bigstep_backup/p4_bigstepSyntax.sig similarity index 100% rename from hol/symb_exec/p4_bigstepSyntax.sig rename to hol/symb_exec/bigstep_backup/p4_bigstepSyntax.sig diff --git a/hol/symb_exec/p4_bigstepSyntax.sml b/hol/symb_exec/bigstep_backup/p4_bigstepSyntax.sml similarity index 100% rename from hol/symb_exec/p4_bigstepSyntax.sml rename to hol/symb_exec/bigstep_backup/p4_bigstepSyntax.sml diff --git a/hol/symb_exec/example_ipsec/basicScript.sml b/hol/symb_exec/example_ipsec/basicScript.sml index 58293548..1a368234 100644 --- a/hol/symb_exec/example_ipsec/basicScript.sml +++ b/hol/symb_exec/example_ipsec/basicScript.sml @@ -256,10 +256,10 @@ val basic_actx = ``([arch_block_inp; F; F; F; T],32)); e_v (v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB], + ([F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F], 32))]))) (stmt_ass (lval_varname (varn_name "notify_soft")) (e_v (v_bool F)))) @@ -336,7 +336,7 @@ val basic_actx = ``([arch_block_inp; (stmt_seq (stmt_ass lval_null (e_call (funn_name "send_to_controller") - [e_v (v_bool F); e_v (v_bool ARB); + [e_v (v_bool F); e_v (v_bool F); e_v (v_bit ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; @@ -346,7 +346,7 @@ val basic_actx = ``([arch_block_inp; (stmt_seq (stmt_ass lval_null (e_call (funn_name "send_to_controller") - [e_v (v_bool F); e_v (v_bool ARB); + [e_v (v_bool F); e_v (v_bool F); e_v (v_bit ([F; F; F; F; F; F; F; F; F; F; F; F; F; @@ -1117,116 +1117,116 @@ val basic_actx = ``([arch_block_inp; v1model_input_f (v_struct [("cpu_header", - v_header ARB + v_header F [("zeros", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],64)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],64)); ("reason", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16)); ("port", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16)); ("timestamp", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB], + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F], 48))]); ("ethernet", - v_header ARB + v_header F [("dstAddr", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB], + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F], 48)); ("srcAddr", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB], + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F], 48)); ("etherType", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16))]); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16))]); ("ipv4", - v_header ARB - [("version",v_bit ([ARB; ARB; ARB; ARB],4)); - ("ihl",v_bit ([ARB; ARB; ARB; ARB],4)); - ("diffserv",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + v_header F + [("version",v_bit ([F; F; F; F],4)); + ("ihl",v_bit ([F; F; F; F],4)); + ("diffserv",v_bit ([F; F; F; F; F; F; F; F],8)); ("totalLen", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16)); ("identification", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16)); - ("flags",v_bit ([ARB; ARB; ARB],3)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16)); + ("flags",v_bit ([F; F; F],3)); ("fragOffset", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB],13)); - ("ttl",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("protocol",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F],13)); + ("ttl",v_bit ([F; F; F; F; F; F; F; F],8)); + ("protocol",v_bit ([F; F; F; F; F; F; F; F],8)); ("hdrChecksum", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16)); ("srcAddr", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],32)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F],32)); ("dstAddr", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],32))]); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F],32))]); ("esp", - v_header ARB + v_header F [("spi", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],32)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F],32)); ("sequenceNumber", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],32))])], + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F],32))])], v_struct [("intrinsic_metadata", v_struct [("ingress_global_timestamp", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB], + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F], 48))]); ("user_metadata", v_struct - [("spd_mark",v_bit ([ARB; ARB; ARB; ARB],4)); - ("bypass",v_bool ARB)]); + [("spd_mark",v_bit ([F; F; F; F],4)); + ("bypass",v_bool F)]); ("esp_meta", v_struct [("payloadLength", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16))])]),v1model_output_f, + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16))])]),v1model_output_f, v1model_copyin_pbl,v1model_copyout_pbl,v1model_apply_table_f, [("header",NONE, [("isValid",[("this",d_in)],header_is_valid); @@ -1250,21 +1250,21 @@ val basic_actx = ``([arch_block_inp; [("emit",[("this",d_in); ("data",d_in)],v1model_packet_out_emit)]); ("register", SOME - ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct), - [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read); + ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct random_oracle), + [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read random_oracle); ("write",[("this",d_in); ("index",d_in); ("value",d_in)],register_write)]); ("ipsec_crypt",SOME ([("this",d_out)],ipsec_crypt_construct), [("decrypt_aes_ctr", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); ("standard_metadata",d_inout); - ("key",d_in); ("key_hmac",d_in)],ipsec_crypt_decrypt_aes_ctr); + ("key",d_in); ("key_hmac",d_in)],ipsec_crypt_decrypt_aes_ctr random_oracle); ("encrypt_aes_ctr", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); ("key",d_in); ("key_hmac",d_in)], - ipsec_crypt_encrypt_aes_ctr); + ipsec_crypt_encrypt_aes_ctr random_oracle); ("encrypt_null",[("this",d_in); ("ipv4",d_inout); ("esp",d_inout)], - ipsec_crypt_encrypt_null); + ipsec_crypt_encrypt_null random_oracle); ("decrypt_null", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); ("standard_metadata",d_inout)], - ipsec_crypt_decrypt_null)])], + ipsec_crypt_decrypt_null random_oracle)])], [("NoAction", stmt_seq (stmt_cond (e_var (varn_name "from_table")) @@ -1278,14 +1278,15 @@ val basic_actx = ``([arch_block_inp; ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F],32)))])) stmt_empty) (stmt_seq stmt_empty (stmt_ret (e_v v_bot))), - [("from_table",d_in); ("hit",d_in)])]):v1model_ascope actx``; + [("from_table",d_in); ("hit",d_in)])],v1model_get_oracle_index, + v1model_set_oracle_index,random_oracle):v1model_ascope actx``; val basic_astate = ``((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))], - [("spd",spd_tbl); ("forward",forward_tbl); ("sad_decrypt",sad_decrypt_tbl); ("sad_encrypt",sad_encrypt_tbl)]), + [("spd",spd_tbl); ("forward",forward_tbl); ("sad_decrypt",sad_decrypt_tbl); ("sad_encrypt",sad_encrypt_tbl)], 0), [[(varn_name "gen_apply_result", v_struct - [("hit",v_bool ARB); ("miss",v_bool ARB); - ("action_run",v_bit (REPLICATE 32 ARB,32))],NONE)]], + [("hit",v_bool F); ("miss",v_bool T); + ("action_run",v_bit (REPLICATE 32 F,32))],NONE)]], arch_frame_list_empty,status_running):v1model_ascope astate``; (********************) @@ -1300,7 +1301,10 @@ val input = rhs $ concl $ EVAL “^eth_input ++ (^ipv4_input ++ ^esp_input)”; val basic_astate_symb = rhs $ concl $ EVAL “p4_append_input_list [(^input,0)] ^basic_astate”; val ctx = basic_actx; -val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn "basic_ctx" (mk_eq(mk_var("basic_ctx", type_of ctx), ctx)); +val ctx_name = "basic_ctx" +val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_comb (mk_var (ctx_name, mk_fun_ty “:random_oracle” (type_of ctx)), “random_oracle:random_oracle”), ctx)) +val ctx_data = def_thm ctx_def + (* Additional parts of the context relevant only to symbolic execution *) @@ -1371,6 +1375,9 @@ val postcond = val postcond_rewr_thms = [p4_symb_execTheory.packet_has_port_def, p4_symb_execTheory.get_packet_def, p4_symb_execTheory.packet_dropped_def, p4_v1modelTheory.v1model_is_drop_port_def]; +(* TODO: ??? *) +val postcond_simpset = pure_ss + val time_start = Time.now(); (* Commit 7463b72: @@ -1382,7 +1389,7 @@ Single thread yields Finished rewriting step theorems to contract format in 0s, trying to unify contracts... Finished unification of all contracts in 170s." (19m, 11s) *) -val contract_thm = p4_symb_exec_prove_contract debug_flag arch_ty (def_term ctx) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never thms_to_add path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms; +val contract_thm = p4_symb_exec_prove_contract debug_flag arch_ty ctx_data (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never thms_to_add path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; val _ = print (String.concat ["Total time consumption: ", (LargeInt.toString $ Time.toMilliseconds ((Time.now()) - time_start)), " ms\n"]); diff --git a/hol/symb_exec/example_ipsec/basic_altScript.sml b/hol/symb_exec/example_ipsec/basic_altScript.sml index 8c2a07ba..a6be2d33 100644 --- a/hol/symb_exec/example_ipsec/basic_altScript.sml +++ b/hol/symb_exec/example_ipsec/basic_altScript.sml @@ -270,10 +270,10 @@ val basic_alt_actx = ``([arch_block_inp; F; F; F; F],32)); e_v (v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB], + ([F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F], 32))]))) (stmt_ass (lval_varname (varn_name "notify_soft")) (e_v (v_bool F)))) @@ -350,7 +350,7 @@ val basic_alt_actx = ``([arch_block_inp; (stmt_seq (stmt_ass lval_null (e_call (funn_name "send_to_controller") - [e_v (v_bool F); e_v (v_bool ARB); + [e_v (v_bool F); e_v (v_bool F); e_v (v_bit ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; @@ -360,7 +360,7 @@ val basic_alt_actx = ``([arch_block_inp; (stmt_seq (stmt_ass lval_null (e_call (funn_name "send_to_controller") - [e_v (v_bool F); e_v (v_bool ARB); + [e_v (v_bool F); e_v (v_bool F); e_v (v_bit ([F; F; F; F; F; F; F; F; F; F; F; F; F; @@ -1146,116 +1146,116 @@ val basic_alt_actx = ``([arch_block_inp; v1model_input_f (v_struct [("cpu_header", - v_header ARB + v_header F [("zeros", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],64)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],64)); ("reason", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16)); ("port", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16)); ("timestamp", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB], + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F], 48))]); ("ethernet", - v_header ARB + v_header F [("dstAddr", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB], + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F], 48)); ("srcAddr", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB], + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F], 48)); ("etherType", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16))]); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16))]); ("ipv4", - v_header ARB - [("version",v_bit ([ARB; ARB; ARB; ARB],4)); - ("ihl",v_bit ([ARB; ARB; ARB; ARB],4)); - ("diffserv",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + v_header F + [("version",v_bit ([F; F; F; F],4)); + ("ihl",v_bit ([F; F; F; F],4)); + ("diffserv",v_bit ([F; F; F; F; F; F; F; F],8)); ("totalLen", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16)); ("identification", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16)); - ("flags",v_bit ([ARB; ARB; ARB],3)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16)); + ("flags",v_bit ([F; F; F],3)); ("fragOffset", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB],13)); - ("ttl",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("protocol",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F],13)); + ("ttl",v_bit ([F; F; F; F; F; F; F; F],8)); + ("protocol",v_bit ([F; F; F; F; F; F; F; F],8)); ("hdrChecksum", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16)); ("srcAddr", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],32)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F],32)); ("dstAddr", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],32))]); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F],32))]); ("esp", - v_header ARB + v_header F [("spi", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],32)); + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F],32)); ("sequenceNumber", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],32))])], + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F],32))])], v_struct [("intrinsic_metadata", v_struct [("ingress_global_timestamp", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB], + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; F], 48))]); ("user_metadata", v_struct - [("spd_mark",v_bit ([ARB; ARB; ARB; ARB],4)); - ("bypass",v_bool ARB)]); + [("spd_mark",v_bit ([F; F; F; F],4)); + ("bypass",v_bool F)]); ("esp_meta", v_struct [("payloadLength", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB],16))])]),v1model_output_f, + ([F; F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F],16))])]),v1model_output_f, v1model_copyin_pbl,v1model_copyout_pbl,v1model_apply_table_f, [("header",NONE, [("isValid",[("this",d_in)],header_is_valid); @@ -1279,22 +1279,22 @@ val basic_alt_actx = ``([arch_block_inp; [("emit",[("this",d_in); ("data",d_in)],v1model_packet_out_emit)]); ("register", SOME - ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct), - [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read); + ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct random_oracle), + [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read random_oracle); ("write",[("this",d_in); ("index",d_in); ("value",d_in)],register_write)]); ("ipsec_crypt",SOME ([("this",d_out)],ipsec_crypt_construct), [("decrypt_aes_ctr", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); ("standard_metadata",d_inout); ("key",d_in); ("key_hmac",d_in)], - ipsec_crypt_decrypt_aes_ctr); + ipsec_crypt_decrypt_aes_ctr random_oracle); ("encrypt_aes_ctr", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); ("key",d_in); - ("key_hmac",d_in)],ipsec_crypt_encrypt_aes_ctr); + ("key_hmac",d_in)],ipsec_crypt_encrypt_aes_ctr random_oracle); ("encrypt_null",[("this",d_in); ("ipv4",d_inout); ("esp",d_inout)], - ipsec_crypt_encrypt_null); + ipsec_crypt_encrypt_null random_oracle); ("decrypt_null", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); - ("standard_metadata",d_inout)],ipsec_crypt_decrypt_null)])], + ("standard_metadata",d_inout)],ipsec_crypt_decrypt_null random_oracle)])], [("NoAction", stmt_seq (stmt_cond (e_var (varn_name "from_table")) @@ -1308,14 +1308,15 @@ val basic_alt_actx = ``([arch_block_inp; ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F],32)))])) stmt_empty) (stmt_seq stmt_empty (stmt_ret (e_v v_bot))), - [("from_table",d_in); ("hit",d_in)])]):v1model_ascope actx``; + [("from_table",d_in); ("hit",d_in)])],v1model_get_oracle_index, + v1model_set_oracle_index,random_oracle):v1model_ascope actx``; val basic_alt_astate = ``((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))], - [("spd",spd_tbl); ("forward",forward_tbl); ("sad_decrypt",sad_decrypt_tbl); ("sad_encrypt",sad_encrypt_tbl)]), + [("spd",spd_tbl); ("forward",forward_tbl); ("sad_decrypt",sad_decrypt_tbl); ("sad_encrypt",sad_encrypt_tbl)],0), [[(varn_name "gen_apply_result", v_struct - [("hit",v_bool ARB); ("miss",v_bool ARB); - ("action_run",v_bit (REPLICATE 32 ARB,32))],NONE)]], + [("hit",v_bool F); ("miss",v_bool T); + ("action_run",v_bit (REPLICATE 32 F,32))],NONE)]], arch_frame_list_empty,status_running):v1model_ascope astate``; @@ -1331,7 +1332,9 @@ val input = rhs $ concl $ EVAL “^eth_input ++ (^ipv4_input ++ ^esp_input)”; val basic_alt_astate_symb = rhs $ concl $ EVAL “p4_append_input_list [(^input,0)] ^basic_alt_astate”; val ctx = basic_alt_actx; -val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn "basic_alt_ctx" (mk_eq(mk_var("basic_alt_ctx", type_of ctx), ctx)); +val ctx_name = "basic_alt_ctx" +val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_comb (mk_var (ctx_name, mk_fun_ty “:random_oracle” (type_of ctx)), “random_oracle:random_oracle”), ctx)) +val ctx_data = def_thm ctx_def (* Additional parts of the context relevant only to symbolic execution *) val fty_map' = optionSyntax.dest_some $ rhs $ concl $ EVAL “deparameterise_ftymap_entries ^basic_alt_ftymap” diff --git a/hol/symb_exec/p4_convLib.sml b/hol/symb_exec/p4_convLib.sml index 5bd700ba..64d78ad3 100644 --- a/hol/symb_exec/p4_convLib.sml +++ b/hol/symb_exec/p4_convLib.sml @@ -74,7 +74,10 @@ fun same_const_disj_list [] tm = K false tm (* Customized CBV_CONV for HOL4P4 evaluation *) local +(* TODO: Add back in when including p4_bigstep again val list_of_thys = ["p4_aux", "p4_core", "p4_v1model", "p4_ebpf", "p4_vss", "p4_bigstep"] +*) + val list_of_thys = ["p4_aux", "p4_core", "p4_v1model", "p4_ebpf", "p4_vss"] fun filtered_thm_names name = (not $ String.isSuffix "_aux" name) andalso diff --git a/hol/symb_exec/p4_symb_execLib.sml b/hol/symb_exec/p4_symb_execLib.sml index 5f07fa37..1048be99 100644 --- a/hol/symb_exec/p4_symb_execLib.sml +++ b/hol/symb_exec/p4_symb_execLib.sml @@ -7,10 +7,10 @@ open pairSyntax listSyntax numSyntax optionSyntax stringSyntax computeLib marker open listTheory p4_auxTheory optionTheory pairTheory; open p4Theory p4_exec_semTheory; -open symb_execTheory p4_symb_execTheory p4_bigstepTheory; +open symb_execTheory p4_symb_execTheory; (* p4_bigstepTheory; *) open p4Syntax p4_exec_semSyntax evalwrapLib p4_testLib symb_execSyntax; -open auxLib symb_execLib p4_bigstepSyntax; +open auxLib symb_execLib; (* p4_bigstepSyntax; *) open p4_convLib p4_symb_exec_v1modelLib; @@ -139,13 +139,13 @@ fun astate_get_branch_data astate = * V1Model in HOL4P4 *) let val ascope = #1 $ dest_astate astate - val (i, _, _, ascope) = dest_ascope ascope + val (i, _, _, ascope, _) = dest_ascope ascope in if (int_of_term $ i) = 8 andalso (type_of ascope = p4_v1modelLib.v1model_arch_ty) then let - val (_, _, v_map, _) = p4_v1modelLib.dest_v1model_ascope ascope + val (_, _, v_map, _, _) = p4_v1modelLib.dest_v1model_ascope ascope (* TODO: Hack, do in SML *) val port_v_bit = dest_some $ rhs $ concl $ EVAL “(case ALOOKUP ^v_map "standard_metadata" of @@ -166,7 +166,7 @@ val b_func_map_entry_ty = “:(string # stmt # (string # d) list)”; (* TODO: OPTIMIZE: This should be done once in pre-processing, not at every step *) fun get_f_maps (astate, actx) = let - val (ab_list, pblock_map, _, _, _, _, _, _, ext_fun_map, func_map) = dest_actx actx + val (ab_list, pblock_map, _, _, _, _, _, _, ext_fun_map, func_map, _, _, _) = dest_actx actx val (aenv, _, _, _) = dest_astate astate val (i, _, _, _) = dest_aenv aenv val b_func_map_opt = get_b_func_map i ab_list pblock_map @@ -729,26 +729,6 @@ fun p4_should_branch (fty_map, b_fty_map, pblock_action_names_map) const_actions (* val apply (tbl_name, e) = apply (“"t2"”, “[e_v (v_bit ([e1; e2; e3; e4; e5; e6; e7; T],8))]”); -basic: -val apply (tbl_name, e) = apply - (“"spd"”, - “[e_v - (v_bit - ([ip128; ip129; ip130; ip131; ip132; ip133; ip134; ip135; ip136; - ip137; ip138; ip139; ip140; ip141; ip142; ip143; ip144; ip145; - ip146; ip147; ip148; ip149; ip150; ip151; ip152; ip153; ip154; - ip155; ip156; ip157; ip158; ip159],32)); - e_v (v_bit ([ip72; ip73; ip74; ip75; ip76; ip77; ip78; ip79],8))]”); - -ARBs: -val apply (tbl_name, e) = apply - (“"forward"”, - “[e_v - (v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],32))]”); - *) if (hurdUtils.forall is_e_v) (fst $ dest_list e) andalso (* Perform a symbolic branch if the apply expression (list) contains @@ -805,7 +785,7 @@ basic: *) val i = #1 $ dest_aenv $ #1 $ dest_astate astate (* TODO: Unify with the syntactic function obtaining the state above? *) - val (ab_list, pblock_map, _, _, _, _, _, _, _, _) = dest_actx $ rhs $ concl ctx_def + val (ab_list, pblock_map, _, _, _, _, _, _, _, _, _, _, _) = dest_actx $ rhs $ snd $ strip_forall $ concl ctx_def val (curr_block, _) = dest_arch_block_pbl $ rhs $ concl $ HOL4P4_CONV $ mk_el (i, ab_list) (* TODO: All of the information extracted from the ctx below could be @@ -1013,6 +993,7 @@ val (fty_map, b_fty_map) = preprocess_ftymaps (basic_ftymap, basic_blftymap) val (aenv, _, arch_frame_list, _) = dest_astate astate val top_frame = hd $ fst $ dest_list $ dest_arch_frame_list_regular $ arch_frame_list val (funn, stmt_stack, scope_list) = dest_frame top_frame + val ascope = #4 $ dest_aenv aenv in if is_funn_inst funn then @@ -1021,7 +1002,7 @@ val (fty_map, b_fty_map) = preprocess_ftymaps (basic_ftymap, basic_blftymap) val ext_obj = stringSyntax.fromHOLstring ext_obj_tm in if (ext_obj = "register") - then approx_v1model_register_construct p4_symb_arg_prefix fv_index scope_list + then approx_v1model_register_construct p4_symb_arg_prefix fv_index scope_list ascope (* let (* Array size *) @@ -1084,7 +1065,6 @@ val array = “[([ARB:bool; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; AR val (ext_obj_tm, ext_method_tm) = dest_funn_ext funn val ext_obj = stringSyntax.fromHOLstring ext_obj_tm val ext_method = stringSyntax.fromHOLstring ext_method_tm - val ascope = #4 $ dest_aenv aenv in if (ext_obj = "register") andalso (ext_method = "read") then approx_v1model_register_read p4_symb_arg_prefix fv_index scope_list ascope @@ -1975,6 +1955,7 @@ SUBST_MATCH (GSYM (ASSUME eq_tm)) test_thm (* TODO: If use_eval_in_ctxt, this should never shortcut apply or select statements, which * need to use assumptions in the middle of execution. Fix this when you enable shortcutting * these *) +(* TODO: Re-enable shortcutting if ((shortcut_result_eq shortcut res_shortcut) orelse (shortcut_result_eq shortcut res_f_args_shortcut)) then (* Take regular shortcut *) @@ -2041,6 +2022,7 @@ SUBST_MATCH (GSYM (ASSUME eq_tm)) test_thm res end else +*) (* OLD regular step *) let val step_thm2 = @@ -2183,8 +2165,10 @@ fun preprocess_ftymaps (fty_map, b_fty_map) = end ; +(* TODO: Re-enable shortcutting val (small_big_exec_tm, mk_small_big_exec, dest_small_big_exec, is_small_big_exec) = syntax_fns2 "p4_bigstep" "small_big_exec"; +*) (* The main symbolic execution. * Here, the static ctxt and the dynamic path condition have been merged. *) @@ -2840,7 +2824,7 @@ fun p4_prove_wellformed_state astate wf_def = val (concrete_state, abstract_state) = dest_eq eqn val (aenv, g_scope_list, _, _) = dest_astate concrete_state val (block_index, io_list, io_list', ascope) = dest_aenv aenv - val (ext_obj_index, ext_obj_map, v_map, ctrl) = p4_v1modelLib.dest_v1model_ascope ascope + val (ext_obj_index, ext_obj_map, v_map, ctrl, oracle_index) = p4_v1modelLib.dest_v1model_ascope ascope (* TODO: Fix this *) (* 1. Variables from ext_obj_map @@ -2943,7 +2927,7 @@ fun p4_symb_exec_prove_contract_gen p4_symb_exec_fun debug_flag arch_ty ctx_data (ctx_tm, hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_var(ctx_name, type_of ctx_tm), ctx_tm))) end | def_thm ctx_def => - (rhs $ concl ctx_def, ctx_def) + (rhs $ snd $ strip_forall $ concl ctx_def, ctx_def) (* Perform symbolic execution until all branches are finished *) (* DEBUG *) @@ -2984,7 +2968,7 @@ fun p4_symb_exec_prove_contract_gen p4_symb_exec_fun debug_flag arch_ty ctx_data (* Unify all contracts *) val unified_ct_thm = p4_unify_path_tree id_ctthm_list path_tree; (* Fix contract format *) - val ctx_lhs = lhs $ concl ctx_def + val ctx_lhs = lhs $ snd $ strip_forall $ concl ctx_def val unified_ct_thm' = prove_contract' unified_ct_thm (path_cond, init_astate, ctx_lhs, postcond); (* DEBUG *) @@ -3023,7 +3007,7 @@ fun p4_debug_symb_exec arch_ty ctx_data (fty_map, b_fty_map, pblock_action_names (ctx_tm, hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_var(ctx_name, type_of ctx_tm), ctx_tm))) end | def_thm ctx_def => - (rhs $ concl ctx_def, ctx_def) + (snd $ strip_forall $ rhs $ concl ctx_def, ctx_def) val (path_tree, state_list) = p4_symb_exec 1 true arch_ty (ctx_def, ctx) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never thms_to_add path_cond NONE fuel val state_list_tms = map (fn (path_id, path_cond, step_thm) => (path_id, path_cond, dest_step_thm step_thm)) state_list @@ -3199,13 +3183,13 @@ val v1model_standard_metadata_name_ty = fun get_v1model_wellformed_defs actx init_astate block_index_stop = let (* Obtain the function maps for generating star variables *) - val (_, _, _, input_f, _, _, _, _, ext_fun_map, func_map) = dest_actx actx + val (_, _, _, input_f, _, _, _, _, ext_fun_map, func_map, _, _, _) = dest_actx actx (* Obtain the control plane configuration from the initial state - this is used directly * for the intermediate state *) val aenv = #1 $ dest_astate init_astate val ascope = #4 $ dest_aenv aenv - val ctrl = #4 $ p4_v1modelLib.dest_v1model_ascope ascope + val (_, _, _, ctrl, oracle_index) = p4_v1modelLib.dest_v1model_ascope ascope (* TODO: V1Model hack *) val (tau1_v, tau2_v) = dest_pair $ snd $ dest_comb input_f @@ -3231,6 +3215,7 @@ fun get_v1model_wellformed_defs actx init_astate block_index_stop = val var_stars = rhs $ concl $ EVAL “(var_star_updates_of_func_map ^func_map)++(var_star_updates_of_ext_map ^ext_fun_map)” (* Note: Apply result desugaring variable is hard-coded into the architecture models *) + val oracle_index_var = mk_var("oracle_index", num) val hit_var = mk_var("hit", bool) val miss_var = mk_var("miss", bool) val (ar_free_vars, ar_v) = mk_v_bit_freevars ("r", 32) @@ -3246,14 +3231,14 @@ fun get_v1model_wellformed_defs actx init_astate block_index_stop = (* OLD val def_free_vars = [“packet_tail:bool list”]@(fst $ dest_list $ fixedwidth_freevars (fv_prefix, fv_index'''))@[hit_var, miss_var]@ar_free_vars *) - val def_free_vars = (fst $ dest_list $ fixedwidth_freevars (fv_prefix, fv_index'''))@[hit_var, miss_var]@ar_free_vars + val def_free_vars = (fst $ dest_list $ fixedwidth_freevars (fv_prefix, fv_index'''))@[oracle_index_var, hit_var, miss_var]@ar_free_vars in (* TODO: Adjust block index for the block in question, adjust extern map? *) Defn.mk_defn "p4_v1model_parser_wellformed" “p4_v1model_parser_wellformed astate <=> ^(list_mk_exists(def_free_vars, “(astate:v1model_ascope astate) = - ((^block_index_stop, [], [], (2, [(0,INL (core_v_ext_packet [])); (1,INL (core_v_ext_packet []))], ^v_map', ^ctrl)), ^g_scope_list', arch_frame_list_empty, status_running)”))” + ((^block_index_stop, [], [], (2, [(0,INL (core_v_ext_packet [])); (1,INL (core_v_ext_packet []))], ^v_map', ^ctrl, ^oracle_index_var)), ^g_scope_list', arch_frame_list_empty, status_running)”))” end ; @@ -3340,7 +3325,16 @@ fun p4_combine_contracts contract1 contract2 wellformed_def = (* Introduce the second contract *) qpat_assum ‘arch_multi_exec _ _ _ = _’ (fn thm => assume_tac $ SPECL (free_vars_lr $ rhs $ concl thm) gen_contract2) >> - FULL_SIMP_TAC std_ss [p4_contract'_alt_shape] + FULL_SIMP_TAC std_ss [p4_contract'_alt_shape] >> + + (* Specialise the random oracle *) + qpat_x_assum ‘!random_oracle. _’ (fn thm => + let + val oracle_var = el 1 $ fst $ strip_forall $ concl thm + in + assume_tac $ SPECL [oracle_var] thm + end) >> + FULL_SIMP_TAC std_ss [] end) >> ( (* Combine the two executions *) qexistsl_tac [‘n + n'’, ‘s'’] >> diff --git a/hol/symb_exec/p4_symb_execScript.sml b/hol/symb_exec/p4_symb_execScript.sml index 4ddbd65e..398523f0 100644 --- a/hol/symb_exec/p4_symb_execScript.sml +++ b/hol/symb_exec/p4_symb_execScript.sml @@ -29,14 +29,14 @@ End *) Definition get_packet_def: - get_packet ((i, io_list, io_list', ((counter, ext_obj_map, v_map, ctrl):v1model_ascope)), g_scope_list, arch_frame_list, status) = + get_packet ((i, io_list, io_list', ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope)), g_scope_list, arch_frame_list, status) = case io_list' of | [(packet, port)] => SOME packet | _ => NONE End Definition packet_dropped_def: - packet_dropped ((i, io_list, io_list', ((counter, ext_obj_map, v_map, ctrl):v1model_ascope)), g_scope_list, arch_frame_list, status) = + packet_dropped ((i, io_list, io_list', ((counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope)), g_scope_list, arch_frame_list, status) = case io_list' of | [] => (case ALOOKUP v_map "standard_metadata" of @@ -248,8 +248,8 @@ Definition v1model_ctrl_is_well_formed_def: !e_l. (* TODO: Keep the requirement that LENGTH e_l = LENGTH mk_l here? *) LENGTH e_l = LENGTH mk_l ==> - !counter ext_obj_map v_map. ?f f_args. - v1model_apply_table_f (tbl, e_l, mk_l, (default_f, default_f_args), (counter, ext_obj_map, v_map, ctrl):v1model_ascope) = SOME (f, f_args) /\ + !counter ext_obj_map v_map oracle_index. ?f f_args. + v1model_apply_table_f (tbl, e_l, mk_l, (default_f, default_f_args), (counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope) = SOME (f, f_args) /\ (* f is in the list of actions for the table *) MEM f actions /\ (* first argument is the Boolean T, signifying that the function call resulted from table application *) @@ -314,8 +314,8 @@ Definition v1model_tbl_is_well_formed_def: (* TODO: Keep the requirement that LENGTH e_l = LENGTH mk_l here? *) LENGTH e_l = LENGTH mk_l ==> !ctrl. ALOOKUP ctrl tbl_name = SOME tbl_entries ==> - !counter ext_obj_map v_map. ?f f_args. - v1model_apply_table_f (tbl_name, e_l, mk_l, (default_f, default_f_args), (counter, ext_obj_map, v_map, ctrl):v1model_ascope) = SOME (f, f_args) /\ + !counter ext_obj_map v_map oracle_index. ?f f_args. + v1model_apply_table_f (tbl_name, e_l, mk_l, (default_f, default_f_args), (counter, ext_obj_map, v_map, ctrl, oracle_index):v1model_ascope) = SOME (f, f_args) /\ (* f is in the list of actions for the table *) MEM f actions /\ (* first argument is the Boolean T, signifying that the function call resulted from table application *) @@ -384,13 +384,14 @@ fs[listTheory.oEL_EQ_EL] >> qpat_x_assum ‘(bl,n) = EL i array’ (fn thm => fs [GSYM thm]) QED +(* Theorem wellformed_register_array_replicate_arb: !m n. wellformed_register_array n (replicate_arb m n) Proof gs[wellformed_register_array_EVERY, replicate_arb_def] QED - +*) (* (* Use this to easily identify abbreviations: a tuple is is used @@ -423,7 +424,7 @@ Proof gs[symb_exec_abbrevs_def] QED *) - + Definition symb_exec_abbrevs_def: (symb_exec_abbrevs P = P:bool) End diff --git a/hol/symb_exec/p4_symb_exec_v1modelLib.sig b/hol/symb_exec/p4_symb_exec_v1modelLib.sig index 1abf6875..66e31080 100644 --- a/hol/symb_exec/p4_symb_exec_v1modelLib.sig +++ b/hol/symb_exec/p4_symb_exec_v1modelLib.sig @@ -3,7 +3,7 @@ sig include Abbrev val approx_v1model_register_construct : - string -> int -> term -> (thm * int list) option + string -> int -> term -> term -> (thm * int list) option val approx_v1model_register_read : string -> int -> term -> term -> (thm * int list) option val approx_v1model_update_checksum : diff --git a/hol/symb_exec/p4_symb_exec_v1modelLib.sml b/hol/symb_exec/p4_symb_exec_v1modelLib.sml index 6ec30386..17a735e5 100644 --- a/hol/symb_exec/p4_symb_exec_v1modelLib.sml +++ b/hol/symb_exec/p4_symb_exec_v1modelLib.sml @@ -14,6 +14,9 @@ open auxLib symb_execSyntax p4_convLib; val (wellformed_register_array_tm, mk_wellformed_register_array, dest_wellformed_register_array, is_wellformed_register_array) = syntax_fns2 "p4_symb_exec" "wellformed_register_array"; +(* TODO: Move up *) +val random_oracle_tm = “random_oracle:random_oracle” + (***********************************************) (* Approximation functions for v1model externs *) @@ -29,17 +32,18 @@ fun lookup_var varname scope_list = end ; -fun approx_v1model_register_construct p4_symb_arg_prefix fv_index scope_list = +fun approx_v1model_register_construct p4_symb_arg_prefix fv_index scope_list ascope = let (* Array size *) val array_size = fst $ dest_pair $ dest_v_bit $ lookup_var "size" scope_list val targ1_width = snd $ dest_pair $ dest_v_bit $ lookup_var "targ1" scope_list - - val tm1 = mk_v1model_register_construct_inner (array_size, targ1_width) + val oracle_index = #5 $ dest_v1model_ascope ascope (* TODO: HOL4P4_CONV? *) val array_size_num = rhs $ concl $ EVAL (mk_v2n array_size) + val tm1 = mk_v1model_register_construct_inner (array_size_num, targ1_width, oracle_index, random_oracle_tm) + (* TODO: Hacky... *) val rhs_tm = hd $ fst $ dest_list $ fixedwidth_freevars_fromindex_ty (p4_symb_arg_prefix, fv_index, 1, mk_list_type $ mk_prod (mk_list_type bool, num)) val goal_tm = mk_disj_list [boolSyntax.mk_exists (rhs_tm, mk_conj (mk_eq (tm1, rhs_tm), (mk_wellformed_register_array (targ1_width, rhs_tm))))] @@ -47,7 +51,12 @@ fun approx_v1model_register_construct p4_symb_arg_prefix fv_index scope_list = val approx_thm = (* “^goal_tm” *) prove(goal_tm, - SIMP_TAC std_ss [disj_list_def, v1model_register_construct_inner_def, wellformed_register_array_replicate_arb] +(* + SIMP_TAC std_ss [disj_list_def, v1model_register_construct_inner_def, get_oracle_calls_array_def] >> +*) + (* TODO: Why doesn't just the above work? Make more efficient solution... *) + SIMP_TAC bool_ss [disj_list_def] >> + EVAL_TAC ); in SOME (approx_thm, [fv_index+1]) @@ -61,11 +70,11 @@ fun approx_v1model_register_read p4_symb_arg_prefix fv_index scope_list ascope = val ext_ref = dest_v_ext_ref $ lookup_var "this" scope_list val entry_width = snd $ dest_pair $ dest_v_bit $ lookup_var "result" scope_list - val ext_obj_map = #2 $ p4_v1modelLib.dest_v1model_ascope ascope + val (_, ext_obj_map, _, _, oracle_index) = dest_v1model_ascope ascope val array = snd $ dest_comb $ fst $ sumSyntax.dest_inr $ dest_some $ rhs $ concl $ HOL4P4_CONV (mk_alookup (ext_obj_map, ext_ref)) (* 2. Prove approximation theorem *) - val tm1 = mk_v1model_register_read_inner (entry_width, array_index, array) + val tm1 = mk_v1model_register_read_inner (entry_width, array_index, array, oracle_index, random_oracle_tm) (* TODO: Hack, make function that returns list *) val approx_vars = fixedwidth_freevars_fromindex (p4_symb_arg_prefix, fv_index, int_of_term entry_width) val rhs_tm = mk_pair (approx_vars, entry_width) @@ -79,8 +88,23 @@ fun approx_v1model_register_read p4_symb_arg_prefix fv_index scope_list ascope = rpt (goal_term (fn tm => tmCases_on (fst $ dest_eq $ snd $ strip_exists tm) []) >> FULL_SIMP_TAC list_ss []) ); + val oracle_index_int = int_of_term oracle_index + val w = (int_of_term entry_width)-1 + + (* TODO: Move? *) + fun provide_oracle_witnesses oracle_index_int 0 = + exists_tac (mk_comb (random_oracle_tm, term_of_int oracle_index_int)) + | provide_oracle_witnesses oracle_index_int w = + let + val curr_index = oracle_index_int + w + in + provide_oracle_witnesses oracle_index_int (w-1) >> + exists_tac (mk_comb (random_oracle_tm, term_of_int curr_index)) + end + ; + val approx_thm = - (* “^goal_tm” *) + (* “^(mk_imp (mk_wellformed_register_array (entry_width, array), goal_tm))” *) prove(mk_imp (mk_wellformed_register_array (entry_width, array), goal_tm), (* As soon as possible, hide the array, which may be big *) markerLib.ABBREV_TAC (mk_eq (mk_var("array", mk_list_type (mk_prod (mk_list_type bool, num))) ,array)) >> @@ -90,7 +114,10 @@ fun approx_v1model_register_read p4_symb_arg_prefix fv_index scope_list ascope = CASE_TAC >- ( (* TODO: HOL4P4_TAC or other solution? *) EVAL_TAC >> +(* ntac (int_of_term entry_width) (exists_tac (mk_arb bool)) >> +*) + provide_oracle_witnesses oracle_index_int w >> REWRITE_TAC [] ) >> Cases_on ‘x’ >> diff --git a/hol/symb_exec/symb_execLib.sml b/hol/symb_exec/symb_execLib.sml index 024da609..4507ff9b 100644 --- a/hol/symb_exec/symb_execLib.sml +++ b/hol/symb_exec/symb_execLib.sml @@ -507,6 +507,15 @@ fun prove_postcond rewr_thms restr_tms simpset postcond step_thm = val postcond_thm = EQT_ELIM $ (computeLib.EVAL_CONV THENC (SIMP_CONV ((srw_ss())++bitstringLib.BITSTRING_GROUND_ss++boolSimps.LET_ss) rewr_thms)) $ mk_imp (hypo, mk_comb (postcond, res_state_tm)) val postcond_thm = EQT_ELIM $ (SIMP_CONV bool_ss rewr_thms THENC SIMP_CONV simpset [] THENC computeLib.RESTR_EVAL_CONV restr_tms THENC (SIMP_CONV ((srw_ss())++bitstringLib.BITSTRING_GROUND_ss++boolSimps.LET_ss) rewr_thms)) $ mk_imp (hypo, mk_comb (postcond, res_state_tm)) + +SIMP_CONV bool_ss rewr_thms $ mk_imp (hypo, mk_comb (postcond, res_state_tm)) +val test_thm = (SIMP_CONV bool_ss rewr_thms THENC SIMP_CONV simpset [] THENC computeLib.RESTR_EVAL_CONV restr_tms THENC (SIMP_CONV ((srw_ss())++bitstringLib.BITSTRING_GROUND_ss++boolSimps.LET_ss) rewr_thms)) $ mk_imp (hypo, mk_comb (postcond, res_state_tm)) + +val rhs_fin = snd $ dest_eq $ concl test_thm + +(SIMP_CONV bool_ss rewr_thms THENC SIMP_CONV simpset [] THENC computeLib.RESTR_EVAL_CONV restr_tms THENC (SIMP_CONV ((srw_ss())++bitstringLib.BITSTRING_GROUND_ss++boolSimps.LET_ss) rewr_thms)) $ mk_imp (hypo, rhs_fin) + +val hypo_thm = (SIMP_CONV bool_ss rewr_thms THENC SIMP_CONV simpset [] THENC computeLib.RESTR_EVAL_CONV restr_tms THENC (SIMP_CONV ((srw_ss())++bitstringLib.BITSTRING_GROUND_ss++boolSimps.LET_ss) rewr_thms)) $ hypo *) val postcond_thm = EQT_ELIM $ (SIMP_CONV bool_ss rewr_thms THENC SIMP_CONV simpset [] THENC computeLib.RESTR_EVAL_CONV restr_tms THENC (SIMP_CONV ((srw_ss())++bitstringLib.BITSTRING_GROUND_ss++boolSimps.LET_ss) rewr_thms)) $ mk_imp (hypo, mk_comb (postcond, res_state_tm)) in @@ -516,7 +525,7 @@ fun prove_postcond rewr_thms restr_tms simpset postcond step_thm = (* DEBUG val step_thms = map #3 path_cond_step_list; -val step_thm = el 5 step_thms +val step_thm = el 1 step_thms (* basic: Index 24, 32, 52, 67 are interesting *) val h = el 24 step_thms @@ -525,6 +534,15 @@ val h = el 52 step_thms val h = el 67 step_thms val rewr_thms = postcond_rewr_thms +val restr_tms = stop_consts_rewr +val simpset = postcond_simpset + +val rewr_thms = postcond_rewr_thms@[match_all_def, match_def] + +SIMP_CONV (srw_ss()) [match_all_def, match_def] “match_all + [(v_bit ([e1; e2; e3; e4; e5; e6; e7; e8],8), + s_sing (v_bit ([F; F; F; F; F; F; F; T],8)))]” + *) fun prove_postconds_debug' rewr_thms restr_tms _ postcond [] _ = [] | prove_postconds_debug' rewr_thms restr_tms simpset postcond (h::t) n = diff --git a/hol/symb_exec/tests/conditionalScript.sml b/hol/symb_exec/tests/conditionalScript.sml index 0a6d2d67..f5231c7d 100644 --- a/hol/symb_exec/tests/conditionalScript.sml +++ b/hol/symb_exec/tests/conditionalScript.sml @@ -73,17 +73,17 @@ val symb_exec1_actx = ``([arch_block_inp; v1model_input_f (v_struct [("h", - v_header ARB + v_header F [("row", v_struct - [("e",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + [("e",v_bit ([F; F; F; F; F; F; F; F],8)); ("t", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB],16)); - ("l",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("r",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("v",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8))])])], + ([F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F],16)); + ("l",v_bit ([F; F; F; F; F; F; F; F],8)); + ("r",v_bit ([F; F; F; F; F; F; F; F],8)); + ("v",v_bit ([F; F; F; F; F; F; F; F],8))])])], v_struct []),v1model_output_f,v1model_copyin_pbl,v1model_copyout_pbl, v1model_apply_table_f, [("header",NONE, @@ -108,8 +108,8 @@ val symb_exec1_actx = ``([arch_block_inp; [("emit",[("this",d_in); ("data",d_in)],v1model_packet_out_emit)]); ("register", SOME - ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct), - [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read); + ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct random_oracle), + [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read random_oracle); ("write",[("this",d_in); ("index",d_in); ("value",d_in)],register_write)])], [("NoAction", stmt_seq @@ -124,14 +124,15 @@ val symb_exec1_actx = ``([arch_block_inp; ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F],32)))])) stmt_empty) (stmt_seq stmt_empty (stmt_ret (e_v v_bot))), - [("from_table",d_in); ("hit",d_in)])]):v1model_ascope actx``; + [("from_table",d_in); ("hit",d_in)])],v1model_get_oracle_index, + v1model_set_oracle_index,random_oracle):v1model_ascope actx``; val symb_exec1_astate_symb = rhs $ concl $ EVAL “p4_append_input_list [([e1; e2; e3; e4; e5; e6; e7; e8; F; F; F; T; F; F; F; T; F; F; F; T; F; F; F; T; F; - F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; T; F; T; T; F; F; F; F],0)] ((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))],[]), + F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; T; F; T; T; F; F; F; F],0)] ((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))],[],0), [[(varn_name "gen_apply_result", v_struct - [("hit",v_bool ARB); ("miss",v_bool ARB); - ("action_run",v_bit (REPLICATE 32 ARB,32))],NONE)]], + [("hit",v_bool F); ("miss",v_bool T); + ("action_run",v_bit (REPLICATE 32 F,32))],NONE)]], arch_frame_list_empty,status_running):v1model_ascope astate”; @@ -139,6 +140,9 @@ val symb_exec1_astate_symb = rhs $ concl $ EVAL “p4_append_input_list [([e1; e val debug_flag = false; val arch_ty = p4_v1modelLib.v1model_arch_ty val ctx = symb_exec1_actx +val ctx_name = "ctx" +val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_comb (mk_var (ctx_name, mk_fun_ty “:random_oracle” (type_of ctx)), “random_oracle:random_oracle”), ctx)) +val ctx_data = def_thm ctx_def val (fty_map, b_fty_map, pblock_action_names_map) = (symb_exec1_ftymap, symb_exec1_blftymap, symb_exec1_pblock_action_names_map) val const_actions_tables = [] val path_cond_defs = [] @@ -186,6 +190,6 @@ val (res_id1, res_cond1, res_thm1) = res_elem1 (* Finishes at 45 steps (one step of which is a symbolic branch) * (higher numbers as arguments will work, but do no extra computations) *) -val contract_thm = p4_symb_exec_prove_contract debug_flag arch_ty (def_term ctx) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; +val contract_thm = p4_symb_exec_prove_contract debug_flag arch_ty ctx_data (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; val _ = export_theory (); diff --git a/hol/symb_exec/tests/conditional_thenScript.sml b/hol/symb_exec/tests/conditional_thenScript.sml index 59d1575b..7bab9c68 100644 --- a/hol/symb_exec/tests/conditional_thenScript.sml +++ b/hol/symb_exec/tests/conditional_thenScript.sml @@ -74,17 +74,17 @@ val symb_exec2_actx = ``([arch_block_inp; v1model_input_f (v_struct [("h", - v_header ARB + v_header F [("row", v_struct - [("e",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + [("e",v_bit ([F; F; F; F; F; F; F; F],8)); ("t", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB],16)); - ("l",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("r",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("v",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8))])])], + ([F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F],16)); + ("l",v_bit ([F; F; F; F; F; F; F; F],8)); + ("r",v_bit ([F; F; F; F; F; F; F; F],8)); + ("v",v_bit ([F; F; F; F; F; F; F; F],8))])])], v_struct []),v1model_output_f,v1model_copyin_pbl,v1model_copyout_pbl, v1model_apply_table_f, [("header",NONE, @@ -109,8 +109,8 @@ val symb_exec2_actx = ``([arch_block_inp; [("emit",[("this",d_in); ("data",d_in)],v1model_packet_out_emit)]); ("register", SOME - ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct), - [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read); + ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct random_oracle), + [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read random_oracle); ("write",[("this",d_in); ("index",d_in); ("value",d_in)],register_write)])], [("NoAction", stmt_seq @@ -125,14 +125,15 @@ val symb_exec2_actx = ``([arch_block_inp; ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F],32)))])) stmt_empty) (stmt_seq stmt_empty (stmt_ret (e_v v_bot))), - [("from_table",d_in); ("hit",d_in)])]):v1model_ascope actx``; + [("from_table",d_in); ("hit",d_in)])],v1model_get_oracle_index, + v1model_set_oracle_index,random_oracle):v1model_ascope actx``; val symb_exec2_astate_symb = rhs $ concl $ EVAL “p4_append_input_list [([e1; e2; e3; e4; e5; e6; e7; e8; F; F; F; T; F; F; F; T; F; F; F; T; F; F; F; T; F; - F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; T; F; T; T; F; F; F; F],0)] ((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))],[]), + F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; T; F; T; T; F; F; F; F],0)] ((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))],[],0), [[(varn_name "gen_apply_result", v_struct - [("hit",v_bool ARB); ("miss",v_bool ARB); - ("action_run",v_bit (REPLICATE 32 ARB,32))],NONE)]], + [("hit",v_bool F); ("miss",v_bool T); + ("action_run",v_bit (REPLICATE 32 F,32))],NONE)]], arch_frame_list_empty,status_running):v1model_ascope astate”; @@ -140,6 +141,9 @@ val symb_exec2_astate_symb = rhs $ concl $ EVAL “p4_append_input_list [([e1; e val debug_flag = false val arch_ty = p4_v1modelLib.v1model_arch_ty val ctx = symb_exec2_actx +val ctx_name = "ctx" +val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_comb (mk_var (ctx_name, mk_fun_ty “:random_oracle” (type_of ctx)), “random_oracle:random_oracle”), ctx)) +val ctx_data = def_thm ctx_def val (fty_map, b_fty_map, pblock_action_names_map) = (symb_exec2_ftymap, symb_exec2_blftymap, symb_exec2_pblock_action_names_map) val const_actions_tables = [] val path_cond_defs = [] @@ -172,6 +176,6 @@ val (path_tree, [(id, path_cond_res, step_thm)]) = p4_symb_exec 1 debug_flag arc (* Finishes at 45 steps (one step of which is a symbolic branch) * (higher numbers as arguments will work, but do no extra computations) *) -val contract_thm = p4_symb_exec_prove_contract_conc debug_flag arch_ty (def_term ctx) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never thms_to_add path_cond NONE n_max postcond postcond_rewr_thms postcond_simpset; +val contract_thm = p4_symb_exec_prove_contract_conc debug_flag arch_ty ctx_data (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never thms_to_add path_cond NONE n_max postcond postcond_rewr_thms postcond_simpset; val _ = export_theory (); diff --git a/hol/symb_exec/tests/decomposeScript.sml b/hol/symb_exec/tests/decomposeScript.sml index 2d8ecdf9..db6b312a 100644 --- a/hol/symb_exec/tests/decomposeScript.sml +++ b/hol/symb_exec/tests/decomposeScript.sml @@ -74,17 +74,17 @@ val symb_exec1_actx = ``([arch_block_inp; v1model_input_f (v_struct [("h", - v_header ARB + v_header F [("row", v_struct - [("e",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + [("e",v_bit ([F; F; F; F; F; F; F; F],8)); ("t", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB],16)); - ("l",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("r",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("v",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8))])])], + ([F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F],16)); + ("l",v_bit ([F; F; F; F; F; F; F; F],8)); + ("r",v_bit ([F; F; F; F; F; F; F; F],8)); + ("v",v_bit ([F; F; F; F; F; F; F; F],8))])])], v_struct []),v1model_output_f,v1model_copyin_pbl,v1model_copyout_pbl, v1model_apply_table_f, [("header",NONE, @@ -109,8 +109,8 @@ val symb_exec1_actx = ``([arch_block_inp; [("emit",[("this",d_in); ("data",d_in)],v1model_packet_out_emit)]); ("register", SOME - ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct), - [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read); + ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct random_oracle), + [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read random_oracle); ("write",[("this",d_in); ("index",d_in); ("value",d_in)],register_write)])], [("NoAction", stmt_seq @@ -125,14 +125,15 @@ val symb_exec1_actx = ``([arch_block_inp; ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F],32)))])) stmt_empty) (stmt_seq stmt_empty (stmt_ret (e_v v_bot))), - [("from_table",d_in); ("hit",d_in)])]):v1model_ascope actx``; + [("from_table",d_in); ("hit",d_in)])],v1model_get_oracle_index, + v1model_set_oracle_index,random_oracle):v1model_ascope actx``; val symb_exec1_astate_symb = rhs $ concl $ EVAL “p4_append_input_list [([e1; e2; e3; e4; e5; e6; e7; e8; F; F; F; T; F; F; F; T; F; F; F; T; F; F; F; T; F; - F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; T; F; T; T; F; F; F; F],0)] ((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))],[]), + F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; T; F; T; T; F; F; F; F],0)] ((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))],[],0), [[(varn_name "gen_apply_result", v_struct - [("hit",v_bool ARB); ("miss",v_bool ARB); - ("action_run",v_bit (REPLICATE 32 ARB,32))],NONE)]], + [("hit",v_bool F); ("miss",v_bool T); + ("action_run",v_bit (REPLICATE 32 F,32))],NONE)]], arch_frame_list_empty,status_running):v1model_ascope astate”; @@ -140,6 +141,9 @@ val symb_exec1_astate_symb = rhs $ concl $ EVAL “p4_append_input_list [([e1; e val debug_flag = false; val arch_ty = p4_v1modelLib.v1model_arch_ty val ctx = symb_exec1_actx +val ctx_name = "ctx" +val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_comb (mk_var (ctx_name, mk_fun_ty “:random_oracle” (type_of ctx)), “random_oracle:random_oracle”), ctx)) +val ctx_data = def_thm ctx_def val (fty_map, b_fty_map, pblock_action_names_map) = (symb_exec1_ftymap, symb_exec1_blftymap, symb_exec1_pblock_action_names_map) val const_actions_tables = [] val path_cond_defs = [] @@ -149,7 +153,7 @@ val stop_consts_never = [] val thms_to_add = [] val path_cond = (ASSUME T) val p4_is_finished_alt_opt = NONE -val n_max = 50; +val n_max = 100; val postcond = “(\s. packet_has_port s 1 \/ packet_has_port s 2):v1model_ascope astate -> bool”; val postcond_rewr_thms = [p4_symb_execTheory.packet_has_port_def] @@ -163,11 +167,6 @@ val p4_is_finished_alt_opt1 = SOME (fn step_thm => Teq $ rhs $ concl $ EVAL “p val p4_v1model_parser_wellformed_def = (fn defn => let val _ = Defn.save_defn defn in Defn.fetch_eqns defn end) $ get_v1model_wellformed_defs ctx init_astate block_index_stop; val postcond_simpset = (pure_ss++(p4_wellformed_ss p4_v1model_parser_wellformed_def)) - -(* Define ctx outside p4_symb_execLib, to avoid re-definitions *) -val ctx_name = "ctx" -val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_var(ctx_name, type_of ctx), ctx)) - (* Get intermediate state *) val (path_tree1, res_list1) = p4_symb_exec 1 debug_flag arch_ty (ctx_def, ctx) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt1 50; @@ -188,7 +187,7 @@ val postcond1 = “(\s. p4_v1model_parser_wellformed s /\ p4_v1model_lookup_avar_validity (lval_field (lval_varname (varn_name "parsedHdr")) "h") s = SOME T /\ p4_v1model_lookup_avar_validity (lval_field (lval_varname (varn_name "hdr")) "h") s = SOME T):v1model_ascope astate -> bool”; *) -val postcond_rewr_thms1 = [p4_v1model_parser_wellformed_def, p4_v1model_lookup_avar_def, p4_v1model_lookup_avar_validity_def, lookup_lval_def, p4_v1modelTheory.v_map_to_scope_def] +val postcond_rewr_thms1 = [p4_v1model_parser_wellformed_def, p4_v1model_lookup_avar_def, p4_v1model_lookup_avar_validity_def, lookup_lval_def, p4_coreTheory.v_map_to_scope_def] (* DEBUG val p4_is_finished_alt_opt = p4_is_finished_alt_opt1 @@ -196,7 +195,7 @@ val postcond = postcond1 val postcond_rewr_thms = postcond_rewr_thms1 *) -val contract_thm1 = p4_symb_exec_prove_contract debug_flag arch_ty (def_thm ctx_def) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt1 n_max postcond1 postcond_rewr_thms1 postcond_simpset; +val contract_thm1 = p4_symb_exec_prove_contract debug_flag arch_ty ctx_data (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt1 n_max postcond1 postcond_rewr_thms1 postcond_simpset; (* 2. Introduce a new initial state from the fact that p4_v1model_parser_wellformed holds. * The weakest possible state that satisfies WF: this is the state where all @@ -205,7 +204,7 @@ val contract_thm1 = p4_symb_exec_prove_contract debug_flag arch_ty (def_thm ctx_ val init_astate2 = get_intermediate_state postcond1 p4_v1model_parser_wellformed_def; (* 3. Prove a contract from the intermediate to final state *) -val contract_thm2 = p4_symb_exec_prove_contract debug_flag arch_ty (def_thm ctx_def) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate2 stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; +val contract_thm2 = p4_symb_exec_prove_contract debug_flag arch_ty ctx_data (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate2 stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; (* 4. Combine the contracts *) (* DEBUG diff --git a/hol/symb_exec/tests/register_readScript.sml b/hol/symb_exec/tests/register_readScript.sml index 986e9f95..36baf195 100644 --- a/hol/symb_exec/tests/register_readScript.sml +++ b/hol/symb_exec/tests/register_readScript.sml @@ -138,9 +138,9 @@ val symb_exec7_actx = ``([arch_block_inp; F; F; T; F; F; F; F; F; F; F; F; F; F],32)); e_v (v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],32))])) + ([F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F],32))])) (stmt_block [(varn_name "tmp",tau_bit 32,NONE)] (stmt_seq (stmt_ass lval_null @@ -160,17 +160,17 @@ val symb_exec7_actx = ``([arch_block_inp; v1model_input_f (v_struct [("h", - v_header ARB + v_header F [("row", v_struct - [("e",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + [("e",v_bit ([F; F; F; F; F; F; F; F],8)); ("t", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB],16)); - ("l",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("r",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("v",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8))])])], + ([F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F],16)); + ("l",v_bit ([F; F; F; F; F; F; F; F],8)); + ("r",v_bit ([F; F; F; F; F; F; F; F],8)); + ("v",v_bit ([F; F; F; F; F; F; F; F],8))])])], v_struct []),v1model_output_f,v1model_copyin_pbl,v1model_copyout_pbl, v1model_apply_table_f, [("header",NONE, @@ -195,22 +195,22 @@ val symb_exec7_actx = ``([arch_block_inp; [("emit",[("this",d_in); ("data",d_in)],v1model_packet_out_emit)]); ("register", SOME - ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct), - [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read); + ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct random_oracle), + [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read random_oracle); ("write",[("this",d_in); ("index",d_in); ("value",d_in)],register_write)]); ("ipsec_crypt",SOME ([("this",d_out)],ipsec_crypt_construct), [("decrypt_aes_ctr", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); ("standard_metadata",d_inout); ("key",d_in); ("key_hmac",d_in)], - ipsec_crypt_decrypt_aes_ctr); + ipsec_crypt_decrypt_aes_ctr random_oracle); ("encrypt_aes_ctr", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); ("key",d_in); - ("key_hmac",d_in)],ipsec_crypt_encrypt_aes_ctr); + ("key_hmac",d_in)],ipsec_crypt_encrypt_aes_ctr random_oracle); ("encrypt_null",[("this",d_in); ("ipv4",d_inout); ("esp",d_inout)], - ipsec_crypt_encrypt_null); + ipsec_crypt_encrypt_null random_oracle); ("decrypt_null", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); - ("standard_metadata",d_inout)],ipsec_crypt_decrypt_null)])], + ("standard_metadata",d_inout)],ipsec_crypt_decrypt_null random_oracle)])], [("NoAction", stmt_seq (stmt_cond (e_var (varn_name "from_table")) @@ -224,7 +224,8 @@ val symb_exec7_actx = ``([arch_block_inp; ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F],32)))])) stmt_empty) (stmt_seq stmt_empty (stmt_ret (e_v v_bot))), - [("from_table",d_in); ("hit",d_in)])]):v1model_ascope actx``; + [("from_table",d_in); ("hit",d_in)])],v1model_get_oracle_index, + v1model_set_oracle_index,random_oracle):v1model_ascope actx``; val symb_exec7_astate_symb = rhs $ concl $ EVAL ``p4_append_input_list [([e1; e2; e3; e4; e5; e6; e7; e8; @@ -257,14 +258,14 @@ val symb_exec7_astate_symb = [s_sing (v_bit ([F; F; F; F; F; F; T; T],8))]))),0), "set_out_port", [e_v (v_bool T); e_v (v_bool T); - e_v (v_bit ([F; F; F; F; F; T; T; F; T],9))])])]), + e_v (v_bit ([F; F; F; F; F; T; T; F; T],9))])])],0), [[(varn_name "gen_apply_result", v_struct - [("hit",v_bool ARB); ("miss",v_bool ARB); - ("action_run",v_bit (REPLICATE 32 ARB,32))],NONE)]], + [("hit",v_bool F); ("miss",v_bool T); + ("action_run",v_bit (REPLICATE 32 F,32))],NONE)]], arch_frame_list_empty,status_running):v1model_ascope astate``; - val fty_map' = optionSyntax.dest_some $ rhs $ concl $ EVAL “deparameterise_ftymap_entries ^symb_exec7_ftymap” +val fty_map' = optionSyntax.dest_some $ rhs $ concl $ EVAL “deparameterise_ftymap_entries ^symb_exec7_ftymap” val b_fty_map' = optionSyntax.dest_some $ rhs $ concl $ EVAL “deparameterise_b_ftymap_entries ^symb_exec7_blftymap” val symb_exec7_ctx_tm = “(^fty_map', ^b_fty_map', ^symb_exec7_pblock_action_names_map)” @@ -278,6 +279,9 @@ val symb_exec_pblock_map_def = hd $ Defn.eqns_of $ Defn.mk_defn "pblock_map" (mk val debug_flag = false; val arch_ty = p4_v1modelLib.v1model_arch_ty val ctx = symb_exec7_actx +val ctx_name = "ctx" +val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_comb (mk_var (ctx_name, mk_fun_ty “:random_oracle” (type_of ctx)), “random_oracle:random_oracle”), ctx)) +val ctx_data = def_thm ctx_def val (fty_map, b_fty_map, pblock_action_names_map) = (symb_exec7_ftymap, symb_exec7_blftymap, symb_exec7_pblock_action_names_map) val const_actions_tables = [] val path_cond_defs = [symb_exec_ctx_def, symb_exec_pblock_map_def] @@ -293,11 +297,17 @@ val fuel = 1; val postcond_rewr_thms = [] val postcond_simpset = pure_ss +(* +#3 $ el 1 $ snd $ p4_symb_exec 1 debug_flag arch_ty (ctx_def, ctx) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never thms_to_add path_cond p4_is_finished_alt_opt 20; + +#3 $ el 1 $ snd $ p4_symb_exec 1 debug_flag arch_ty (ctx_def, ctx) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never thms_to_add path_cond p4_is_finished_alt_opt 21; +*) + val time_start = Time.now(); (* val p4_symb_exec_fun = (p4_symb_exec 1) *) -val contract_thm = p4_symb_exec_prove_contract debug_flag arch_ty (def_term ctx) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; +val contract_thm = p4_symb_exec_prove_contract debug_flag arch_ty ctx_data (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; val _ = print (String.concat ["Total time consumption: ", (LargeInt.toString $ Time.toMilliseconds ((Time.now()) - time_start)), diff --git a/hol/symb_exec/tests/register_read_writeScript.sml b/hol/symb_exec/tests/register_read_writeScript.sml index fe37d652..57914260 100644 --- a/hol/symb_exec/tests/register_read_writeScript.sml +++ b/hol/symb_exec/tests/register_read_writeScript.sml @@ -140,9 +140,9 @@ val symb_exec8_actx = ``([arch_block_inp; F; F; T; F; F; F; F; F; F; F; F; F; F],32)); e_v (v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],32))])) + ([F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F; F; F; F; F; F],32))])) (stmt_block [(varn_name "tmp",tau_bit 32,NONE)] (stmt_seq (stmt_ass lval_null @@ -177,17 +177,17 @@ val symb_exec8_actx = ``([arch_block_inp; v1model_input_f (v_struct [("h", - v_header ARB + v_header F [("row", v_struct - [("e",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + [("e",v_bit ([F; F; F; F; F; F; F; F],8)); ("t", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB],16)); - ("l",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("r",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("v",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8))])])], + ([F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F],16)); + ("l",v_bit ([F; F; F; F; F; F; F; F],8)); + ("r",v_bit ([F; F; F; F; F; F; F; F],8)); + ("v",v_bit ([F; F; F; F; F; F; F; F],8))])])], v_struct []),v1model_output_f,v1model_copyin_pbl,v1model_copyout_pbl, v1model_apply_table_f, [("header",NONE, @@ -212,22 +212,22 @@ val symb_exec8_actx = ``([arch_block_inp; [("emit",[("this",d_in); ("data",d_in)],v1model_packet_out_emit)]); ("register", SOME - ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct), - [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read); + ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct random_oracle), + [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read random_oracle); ("write",[("this",d_in); ("index",d_in); ("value",d_in)],register_write)]); ("ipsec_crypt",SOME ([("this",d_out)],ipsec_crypt_construct), [("decrypt_aes_ctr", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); ("standard_metadata",d_inout); ("key",d_in); ("key_hmac",d_in)], - ipsec_crypt_decrypt_aes_ctr); + ipsec_crypt_decrypt_aes_ctr random_oracle); ("encrypt_aes_ctr", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); ("key",d_in); - ("key_hmac",d_in)],ipsec_crypt_encrypt_aes_ctr); + ("key_hmac",d_in)],ipsec_crypt_encrypt_aes_ctr random_oracle); ("encrypt_null",[("this",d_in); ("ipv4",d_inout); ("esp",d_inout)], - ipsec_crypt_encrypt_null); + ipsec_crypt_encrypt_null random_oracle); ("decrypt_null", [("this",d_in); ("ipv4",d_inout); ("esp",d_inout); - ("standard_metadata",d_inout)],ipsec_crypt_decrypt_null)])], + ("standard_metadata",d_inout)],ipsec_crypt_decrypt_null random_oracle)])], [("NoAction", stmt_seq (stmt_cond (e_var (varn_name "from_table")) @@ -241,7 +241,8 @@ val symb_exec8_actx = ``([arch_block_inp; ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F],32)))])) stmt_empty) (stmt_seq stmt_empty (stmt_ret (e_v v_bot))), - [("from_table",d_in); ("hit",d_in)])]):v1model_ascope actx``; + [("from_table",d_in); ("hit",d_in)])],v1model_get_oracle_index, + v1model_set_oracle_index,random_oracle):v1model_ascope actx``; val symb_exec8_astate_symb = @@ -275,11 +276,11 @@ val symb_exec8_astate_symb = [s_sing (v_bit ([F; F; F; F; F; F; T; T],8))]))),0), "set_out_port", [e_v (v_bool T); e_v (v_bool T); - e_v (v_bit ([F; F; F; F; F; T; T; F; T],9))])])]), + e_v (v_bit ([F; F; F; F; F; T; T; F; T],9))])])],0), [[(varn_name "gen_apply_result", v_struct - [("hit",v_bool ARB); ("miss",v_bool ARB); - ("action_run",v_bit (REPLICATE 32 ARB,32))],NONE)]], + [("hit",v_bool F); ("miss",v_bool T); + ("action_run",v_bit (REPLICATE 32 F,32))],NONE)]], arch_frame_list_empty,status_running):v1model_ascope astate``; @@ -297,6 +298,9 @@ val symb_exec_pblock_map_def = hd $ Defn.eqns_of $ Defn.mk_defn "pblock_map" (mk val debug_flag = true; val arch_ty = p4_v1modelLib.v1model_arch_ty val ctx = symb_exec8_actx +val ctx_name = "ctx" +val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_comb (mk_var (ctx_name, mk_fun_ty “:random_oracle” (type_of ctx)), “random_oracle:random_oracle”), ctx)) +val ctx_data = def_thm ctx_def val (fty_map, b_fty_map, pblock_action_names_map) = (symb_exec8_ftymap, symb_exec8_blftymap, symb_exec8_pblock_action_names_map) val const_actions_tables = [] val path_cond_defs = [symb_exec_ctx_def, symb_exec_pblock_map_def] @@ -316,7 +320,7 @@ val time_start = Time.now(); (* val p4_symb_exec_fun = (p4_symb_exec 1) *) -val contract_thm = p4_symb_exec_prove_contract debug_flag arch_ty (def_term ctx) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; +val contract_thm = p4_symb_exec_prove_contract debug_flag arch_ty ctx_data (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; val _ = print (String.concat ["Total time consumption: ", (LargeInt.toString $ Time.toMilliseconds ((Time.now()) - time_start)), diff --git a/hol/symb_exec/tests/selectScript.sml b/hol/symb_exec/tests/selectScript.sml index 8f4d6137..13a09276 100644 --- a/hol/symb_exec/tests/selectScript.sml +++ b/hol/symb_exec/tests/selectScript.sml @@ -82,17 +82,17 @@ val symb_exec3_actx = ``([arch_block_inp; v1model_input_f (v_struct [("h", - v_header ARB + v_header F [("row", v_struct - [("e",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + [("e",v_bit ([F; F; F; F; F; F; F; F],8)); ("t", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB],16)); - ("l",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("r",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("v",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8))])])], + ([F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F],16)); + ("l",v_bit ([F; F; F; F; F; F; F; F],8)); + ("r",v_bit ([F; F; F; F; F; F; F; F],8)); + ("v",v_bit ([F; F; F; F; F; F; F; F],8))])])], v_struct []),v1model_output_f,v1model_copyin_pbl,v1model_copyout_pbl, v1model_apply_table_f, [("header",NONE, @@ -117,8 +117,8 @@ val symb_exec3_actx = ``([arch_block_inp; [("emit",[("this",d_in); ("data",d_in)],v1model_packet_out_emit)]); ("register", SOME - ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct), - [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read); + ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct random_oracle), + [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read random_oracle); ("write",[("this",d_in); ("index",d_in); ("value",d_in)],register_write)])], [("NoAction", stmt_seq @@ -133,14 +133,15 @@ val symb_exec3_actx = ``([arch_block_inp; ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F],32)))])) stmt_empty) (stmt_seq stmt_empty (stmt_ret (e_v v_bot))), - [("from_table",d_in); ("hit",d_in)])]):v1model_ascope actx``; + [("from_table",d_in); ("hit",d_in)])],v1model_get_oracle_index, + v1model_set_oracle_index,random_oracle):v1model_ascope actx``; val symb_exec3_astate_symb = rhs $ concl $ EVAL “p4_append_input_list [([e1; e2; e3; e4; e5; e6; e7; e8; F; F; F; T; F; F; F; T; F; F; F; T; F; F; F; T; F; - F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; T; F; T; T; F; F; F; F],0)] ((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))],[]), + F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; T; F; T; T; F; F; F; F],0)] ((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))],[],0), [[(varn_name "gen_apply_result", v_struct - [("hit",v_bool ARB); ("miss",v_bool ARB); - ("action_run",v_bit (REPLICATE 32 ARB,32))],NONE)]], + [("hit",v_bool F); ("miss",v_bool T); + ("action_run",v_bit (REPLICATE 32 F,32))],NONE)]], arch_frame_list_empty,status_running):v1model_ascope astate”; @@ -148,6 +149,9 @@ val symb_exec3_astate_symb = rhs $ concl $ EVAL “p4_append_input_list [([e1; e val debug_flag = false val arch_ty = p4_v1modelLib.v1model_arch_ty val ctx = symb_exec3_actx +val ctx_name = "ctx" +val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_comb (mk_var (ctx_name, mk_fun_ty “:random_oracle” (type_of ctx)), “random_oracle:random_oracle”), ctx)) +val ctx_data = def_thm ctx_def val (fty_map, b_fty_map, pblock_action_names_map) = (symb_exec3_ftymap, symb_exec3_blftymap, symb_exec3_pblock_action_names_map) val const_actions_tables = [] val path_cond_defs = [] @@ -177,6 +181,6 @@ val [(path_cond_res, step_thm), (path_cond2_res, step_thm2)] = (* Finishes at 45 steps (one step of which is a symbolic branch) * (higher numbers as arguments will work, but do no extra computations) *) -val contract_thm = p4_symb_exec_prove_contract_conc debug_flag arch_ty (def_term ctx) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; +val contract_thm = p4_symb_exec_prove_contract_conc debug_flag arch_ty ctx_data (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; val _ = export_theory (); diff --git a/hol/symb_exec/tests/table_knownScript.sml b/hol/symb_exec/tests/table_knownScript.sml index 1cae5786..86a57633 100644 --- a/hol/symb_exec/tests/table_knownScript.sml +++ b/hol/symb_exec/tests/table_knownScript.sml @@ -104,17 +104,17 @@ val symb_exec4_actx = ``([arch_block_inp; v1model_input_f (v_struct [("h", - v_header ARB + v_header F [("row", v_struct - [("e",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + [("e",v_bit ([F; F; F; F; F; F; F; F],8)); ("t", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB],16)); - ("l",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("r",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("v",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8))])])], + ([F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F],16)); + ("l",v_bit ([F; F; F; F; F; F; F; F],8)); + ("r",v_bit ([F; F; F; F; F; F; F; F],8)); + ("v",v_bit ([F; F; F; F; F; F; F; F],8))])])], v_struct []),v1model_output_f,v1model_copyin_pbl,v1model_copyout_pbl, v1model_apply_table_f, [("header",NONE, @@ -139,8 +139,8 @@ val symb_exec4_actx = ``([arch_block_inp; [("emit",[("this",d_in); ("data",d_in)],v1model_packet_out_emit)]); ("register", SOME - ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct), - [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read); + ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct random_oracle), + [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read random_oracle); ("write",[("this",d_in); ("index",d_in); ("value",d_in)],register_write)])], [("NoAction", stmt_seq @@ -155,7 +155,8 @@ val symb_exec4_actx = ``([arch_block_inp; ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F],32)))])) stmt_empty) (stmt_seq stmt_empty (stmt_ret (e_v v_bot))), - [("from_table",d_in); ("hit",d_in)])]):v1model_ascope actx``; + [("from_table",d_in); ("hit",d_in)])],v1model_get_oracle_index, + v1model_set_oracle_index,random_oracle):v1model_ascope actx``; val symb_exec4_astate_symb = rhs $ concl $ EVAL ``p4_append_input_list [([e1; e2; e3; e4; e5; e6; e7; e8; F; F; F; T; F; F; F; T; F; F; F; T; F; F; F; T; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; T; F; T; T; F; F; F; F],0)] ((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))], @@ -167,23 +168,31 @@ val symb_exec4_astate_symb = rhs $ concl $ EVAL ``p4_append_input_list [([e1; e2 [s_sing (v_bit ([F; F; F; F; F; F; F; T],8))]))),0), "set_out_port", [e_v (v_bool T); e_v (v_bool T); - e_v (v_bit ([F; F; F; T; F; T; F; T; F],9))])])]), + e_v (v_bit ([F; F; F; T; F; T; F; T; F],9))])])],0), [[(varn_name "gen_apply_result", v_struct - [("hit",v_bool ARB); ("miss",v_bool ARB); - ("action_run",v_bit (REPLICATE 32 ARB,32))],NONE)]], + [("hit",v_bool F); ("miss",v_bool T); + ("action_run",v_bit (REPLICATE 32 F,32))],NONE)]], arch_frame_list_empty,status_running):v1model_ascope astate``; (* Parameter assignment for debugging: *) +val debug_flag = true; val arch_ty = p4_v1modelLib.v1model_arch_ty val ctx = symb_exec4_actx +val ctx_name = "ctx" +val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_comb (mk_var (ctx_name, mk_fun_ty “:random_oracle” (type_of ctx)), “random_oracle:random_oracle”), ctx)) +val ctx_data = def_thm ctx_def +val (fty_map, b_fty_map, pblock_action_names_map) = (symb_exec4_ftymap, symb_exec4_blftymap, symb_exec4_pblock_action_names_map) +val const_actions_tables = ["t"] val path_cond_defs = [] val init_astate = symb_exec4_astate_symb val stop_consts_rewr = [] val stop_consts_never = [] +val thms_to_add = [] val path_cond = ASSUME T -val n_max = 50; +val p4_is_finished_alt_opt = NONE +val n_max = 60; val postcond = “(\s. packet_has_port s 42 \/ packet_has_port s 101):v1model_ascope astate -> bool”; val postcond_rewr_thms = [p4_symb_execTheory.packet_has_port_def] val postcond_simpset = pure_ss @@ -216,6 +225,6 @@ val (path_tree, [(n, path_cond_res, step_thm), (n2, path_cond2_res, step_thm2)]) *) -val contract_thm = p4_symb_exec_prove_contract_conc false arch_ty (def_term ctx) (symb_exec4_ftymap, symb_exec4_blftymap, symb_exec4_pblock_action_names_map) ["t"] path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond NONE n_max postcond postcond_rewr_thms postcond_simpset; +val contract_thm = p4_symb_exec_prove_contract_conc debug_flag arch_ty ctx_data (symb_exec4_ftymap, symb_exec4_blftymap, symb_exec4_pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never thms_to_add path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; val _ = export_theory (); diff --git a/hol/symb_exec/tests/table_known_fourScript.sml b/hol/symb_exec/tests/table_known_fourScript.sml index 9266a171..29f51652 100644 --- a/hol/symb_exec/tests/table_known_fourScript.sml +++ b/hol/symb_exec/tests/table_known_fourScript.sml @@ -104,17 +104,17 @@ val symb_exec5_actx = ``([arch_block_inp; v1model_input_f (v_struct [("h", - v_header ARB + v_header F [("row", v_struct - [("e",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + [("e",v_bit ([F; F; F; F; F; F; F; F],8)); ("t", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB],16)); - ("l",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("r",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("v",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8))])])], + ([F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F],16)); + ("l",v_bit ([F; F; F; F; F; F; F; F],8)); + ("r",v_bit ([F; F; F; F; F; F; F; F],8)); + ("v",v_bit ([F; F; F; F; F; F; F; F],8))])])], v_struct []),v1model_output_f,v1model_copyin_pbl,v1model_copyout_pbl, v1model_apply_table_f, [("header",NONE, @@ -139,8 +139,8 @@ val symb_exec5_actx = ``([arch_block_inp; [("emit",[("this",d_in); ("data",d_in)],v1model_packet_out_emit)]); ("register", SOME - ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct), - [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read); + ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct random_oracle), + [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read random_oracle); ("write",[("this",d_in); ("index",d_in); ("value",d_in)],register_write)])], [("NoAction", stmt_seq @@ -155,7 +155,8 @@ val symb_exec5_actx = ``([arch_block_inp; ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F],32)))])) stmt_empty) (stmt_seq stmt_empty (stmt_ret (e_v v_bot))), - [("from_table",d_in); ("hit",d_in)])]):v1model_ascope actx``; + [("from_table",d_in); ("hit",d_in)])],v1model_get_oracle_index, + v1model_set_oracle_index,random_oracle):v1model_ascope actx``; val symb_exec5_astate_symb = rhs $ concl $ EVAL ``p4_append_input_list [([e1; e2; e3; e4; e5; e6; e7; e8; F; F; F; T; F; F; F; T; F; F; F; T; F; F; F; T; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; T; F; T; T; F; F; F; F],0)] ((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))], @@ -183,11 +184,11 @@ val symb_exec5_astate_symb = rhs $ concl $ EVAL ``p4_append_input_list [([e1; e2 [s_sing (v_bit ([F; F; F; F; F; F; T; T],8))]))),0), "set_out_port", [e_v (v_bool T); e_v (v_bool T); - e_v (v_bit ([F; F; F; F; F; T; T; F; T],9))])])]), + e_v (v_bit ([F; F; F; F; F; T; T; F; T],9))])])],0), [[(varn_name "gen_apply_result", v_struct - [("hit",v_bool ARB); ("miss",v_bool ARB); - ("action_run",v_bit (REPLICATE 32 ARB,32))],NONE)]], + [("hit",v_bool F); ("miss",v_bool T); + ("action_run",v_bit (REPLICATE 32 F,32))],NONE)]], arch_frame_list_empty,status_running):v1model_ascope astate``; @@ -195,12 +196,15 @@ val symb_exec5_astate_symb = rhs $ concl $ EVAL ``p4_append_input_list [([e1; e2 val debug_flag = false val arch_ty = p4_v1modelLib.v1model_arch_ty val ctx = symb_exec5_actx +val ctx_name = "ctx" +val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_comb (mk_var (ctx_name, mk_fun_ty “:random_oracle” (type_of ctx)), “random_oracle:random_oracle”), ctx)) +val ctx_data = def_thm ctx_def val path_cond_defs = [] val init_astate = symb_exec5_astate_symb val stop_consts_rewr = [] val stop_consts_never = [] val path_cond = ASSUME T -val n_max = 50; +val n_max = 60; val postcond = “(\s. packet_has_port s 42 \/ packet_has_port s 47 \/ packet_has_port s 13 \/ @@ -238,6 +242,6 @@ val step_thm = step_thm2; *) -val contract_thm = p4_symb_exec_prove_contract_conc debug_flag arch_ty (def_term ctx) (symb_exec5_ftymap, symb_exec5_blftymap, symb_exec5_pblock_action_names_map) ["t"] path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond NONE n_max postcond postcond_rewr_thms postcond_simpset; +val contract_thm = p4_symb_exec_prove_contract_conc debug_flag arch_ty ctx_data (symb_exec5_ftymap, symb_exec5_blftymap, symb_exec5_pblock_action_names_map) ["t"] path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond NONE n_max postcond postcond_rewr_thms postcond_simpset; val _ = export_theory (); diff --git a/hol/symb_exec/tests/table_unknownScript.sml b/hol/symb_exec/tests/table_unknownScript.sml index 4f97c191..c43f45bc 100644 --- a/hol/symb_exec/tests/table_unknownScript.sml +++ b/hol/symb_exec/tests/table_unknownScript.sml @@ -135,17 +135,17 @@ val symb_exec6_actx = ``([arch_block_inp; v1model_input_f (v_struct [("h", - v_header ARB + v_header F [("row", v_struct - [("e",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); + [("e",v_bit ([F; F; F; F; F; F; F; F],8)); ("t", v_bit - ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB; - ARB; ARB; ARB; ARB; ARB],16)); - ("l",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("r",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8)); - ("v",v_bit ([ARB; ARB; ARB; ARB; ARB; ARB; ARB; ARB],8))])])], + ([F; F; F; F; F; F; F; F; F; F; F; + F; F; F; F; F],16)); + ("l",v_bit ([F; F; F; F; F; F; F; F],8)); + ("r",v_bit ([F; F; F; F; F; F; F; F],8)); + ("v",v_bit ([F; F; F; F; F; F; F; F],8))])])], v_struct []),v1model_output_f,v1model_copyin_pbl,v1model_copyout_pbl, v1model_apply_table_f, [("header",NONE, @@ -170,21 +170,21 @@ val symb_exec6_actx = ``([arch_block_inp; [("emit",[("this",d_in); ("data",d_in)],v1model_packet_out_emit)]); ("register", SOME - ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct), - [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read); + ([("this",d_out); ("size",d_none); ("targ1",d_in)],register_construct random_oracle), + [("read",[("this",d_in); ("result",d_out); ("index",d_in)],register_read random_oracle); ("write",[("this",d_in); ("index",d_in); ("value",d_in)],register_write)]); ("ipsec_crypt",SOME ([("this",d_out)],ipsec_crypt_construct), [("decrypt_aes_ctr", [("ipv4",d_inout); ("esp",d_inout); ("standard_metadata",d_inout); - ("key",d_in); ("key_hmac",d_in)],ipsec_crypt_decrypt_aes_ctr); + ("key",d_in); ("key_hmac",d_in)],ipsec_crypt_decrypt_aes_ctr random_oracle); ("encrypt_aes_ctr", [("ipv4",d_inout); ("esp",d_inout); ("key",d_in); ("key_hmac",d_in)], - ipsec_crypt_encrypt_aes_ctr); + ipsec_crypt_encrypt_aes_ctr random_oracle); ("encrypt_null",[("ipv4",d_inout); ("esp",d_inout)], - ipsec_crypt_encrypt_null); + ipsec_crypt_encrypt_null random_oracle); ("decrypt_null", [("ipv4",d_inout); ("esp",d_inout); ("standard_metadata",d_inout)], - ipsec_crypt_decrypt_null)])], + ipsec_crypt_decrypt_null random_oracle)])], [("NoAction", stmt_seq (stmt_cond (e_var (varn_name "from_table")) @@ -198,7 +198,8 @@ val symb_exec6_actx = ``([arch_block_inp; ([F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F],32)))])) stmt_empty) (stmt_seq stmt_empty (stmt_ret (e_v v_bot))), - [("from_table",d_in); ("hit",d_in)])]):v1model_ascope actx``; + [("from_table",d_in); ("hit",d_in)])],v1model_get_oracle_index, + v1model_set_oracle_index,random_oracle):v1model_ascope actx``; val symb_exec6_astate_symb = rhs $ concl $ EVAL ``p4_append_input_list [([e1; e2; e3; e4; e5; e6; e7; e8; F; F; F; T; F; F; F; T; F; F; F; T; F; F; F; T; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; F; T; F; T; T; F; F; F; F],0)] ((0,[],[],0,[],[("parseError",v_bit (fixwidth 32 (n2v 0),32))], @@ -227,11 +228,11 @@ val symb_exec6_astate_symb = rhs $ concl $ EVAL ``p4_append_input_list [([e1; e2 [s_sing (v_bit ([F; F; F; F; F; F; T; T],8))]))),0), "set_out_port", [e_v (v_bool T); e_v (v_bool T); - e_v (v_bit ([F; F; F; F; F; T; T; F; T],9))])])]), + e_v (v_bit ([F; F; F; F; F; T; T; F; T],9))])])],0), [[(varn_name "gen_apply_result", v_struct - [("hit",v_bool ARB); ("miss",v_bool ARB); - ("action_run",v_bit (REPLICATE 32 ARB,32))],NONE)]], + [("hit",v_bool F); ("miss",v_bool T); + ("action_run",v_bit (REPLICATE 32 F,32))],NONE)]], arch_frame_list_empty,status_running):v1model_ascope astate``; (* Additional parts of the context relevant only to symbolic execution *) @@ -252,6 +253,9 @@ val symb_exec6_wf_tbl_tm = “v1model_tbl_is_well_formed ^(lhs $ concl symb_exec val debug_flag = false; val arch_ty = p4_v1modelLib.v1model_arch_ty val ctx = symb_exec6_actx +val ctx_name = "ctx" +val ctx_def = hd $ Defn.eqns_of $ Defn.mk_defn ctx_name (mk_eq(mk_comb (mk_var (ctx_name, mk_fun_ty “:random_oracle” (type_of ctx)), “random_oracle:random_oracle”), ctx)) +val ctx_data = def_thm ctx_def val (fty_map, b_fty_map, pblock_action_names_map) = (symb_exec6_ftymap, symb_exec6_blftymap, symb_exec6_pblock_action_names_map) val const_actions_tables = ["t1"] val path_cond_defs = [symb_exec_ctx_def, symb_exec_pblock_map_def] @@ -310,7 +314,7 @@ val time_start = Time.now(); (* val p4_symb_exec_fun = (p4_symb_exec 1) *) -val contract_thm = p4_symb_exec_prove_contract debug_flag arch_ty (def_term ctx) (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; +val contract_thm = p4_symb_exec_prove_contract debug_flag arch_ty ctx_data (fty_map, b_fty_map, pblock_action_names_map) const_actions_tables path_cond_defs init_astate stop_consts_rewr stop_consts_never [] path_cond p4_is_finished_alt_opt n_max postcond postcond_rewr_thms postcond_simpset; val _ = print (String.concat ["Total time consumption: ", (LargeInt.toString $ Time.toMilliseconds ((Time.now()) - time_start)), diff --git a/ott/p4.ott b/ott/p4.ott index 15d8bccd..77e49354 100644 --- a/ott/p4.ott +++ b/ott/p4.ott @@ -420,6 +420,13 @@ lval :: lval_ ::= | ( lval ) :: X :: paren {{ hol ([[lval]]) }} +i_opt :: i_opt_ ::= +{{ hol (num option) }} +| none :: M :: none + {{ hol (NONE:num option) }} +| i :: M :: some + {{ hol (SOME [[i]]) }} + embed {{ hol @@ -796,6 +803,12 @@ in_out_list {{ tex \overline{ \mathit{io} } }} :: in_out_list_ ::= {{ com list of input and output }} {{ hol (in_out list) }} +%This function takes an index and returns a Boolean +%Effectively, each call with a new index yields a new random bit +random_oracle {{ tex { \mathit{set\_oracle\_index} } }} :: random_oracle_ ::= +{{ com random oracle }} +{{ hol (num -> bool) }} + %Fence between in_out_list and input_f embed {{ hol @@ -821,7 +834,7 @@ output_f {{ tex { \mathit{out}_A } }} :: output_f_ ::= %This function is used to copy things from the architecture when a programmable block begins copyin_pbl {{ tex { \mathit{in}_p } }} :: copyin_pbl_ ::= {{ com copy-in to programmable blocks function }} -{{ hol ((x list # d list # e list # ascope_ty) -> scope option) }} +{{ hol ((x list # d list # e list # ascope_ty # random_oracle) -> (scope # num option) option) }} %This function is used to copy out things to the architecture after a programmable block is finished copyout_pbl {{ tex { \mathit{out}_p } }} :: copyout_pbl_ ::= @@ -833,6 +846,16 @@ apply_table_f {{ tex { \mathit{apply\_table} } }} :: apply_table_f_ ::= {{ com apply table function }} {{ hol ((x # e_list # mk_list # (x # e_list) # ascope_ty) -> (x # e_list) option) }} +%This function takes an ascope and returns an oracle index +get_oracle_index {{ tex { \mathit{get\_oracle\_index} } }} :: get_oracle_index_ ::= +{{ com oracle index getter }} +{{ hol (ascope_ty -> num) }} + +%This function takes an ascope and sets the oracle index +set_oracle_index {{ tex { \mathit{set\_oracle\_index} } }} :: set_oracle_index_ ::= +{{ com oracle index setter }} +{{ hol (num option -> ascope_ty -> ascope_ty) }} + %Fence between ab_list and actx embed {{ hol @@ -843,15 +866,23 @@ grammar %The architectural context stores everything that's needed for, but stays invariant over, architecture-level reductions actx {{ tex { \mathit{ctx}_A } }} :: actx_ ::= {{ com architectural context }} -{{ hol (ab_list # pblock_map # ffblock_map # input_f # output_f # copyin_pbl # copyout_pbl # apply_table_f # ext_map # func_map) }} -| ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) :: M :: tup +{{ hol (ab_list # pblock_map # ffblock_map # input_f # output_f # copyin_pbl # copyout_pbl # apply_table_f # ext_map # func_map # get_oracle_index # set_oracle_index # random_oracle) }} +| ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) :: M :: tup {{ com tuple }} - {{ hol ([[ab_list]], [[pblock_map]], [[ffblock_map]], [[input_f]], [[output_f]], [[copyin_pbl]], [[copyout_pbl]], [[apply_table_f]], [[ext_map]], [[func_map]]) }} + {{ hol ([[ab_list]], [[pblock_map]], [[ffblock_map]], [[input_f]], [[output_f]], [[copyin_pbl]], [[copyout_pbl]], [[apply_table_f]], [[ext_map]], [[func_map]], [[get_oracle_index]] , [[set_oracle_index]] , [[random_oracle]]) }} %The context stores everything that's needed for, but stays invariant over, statement reductions ctx {{ tex \mathit{ctx} }} :: ctx_ ::= {{ com context }} -{{ hol (apply_table_f # ext_map # func_map # b_func_map # pars_map # tbl_map) }} -| ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) :: M :: tup +{{ hol (apply_table_f # ext_map # func_map # b_func_map # pars_map # tbl_map # get_oracle_index # set_oracle_index # random_oracle) }} +| ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) :: M :: tup + {{ com tuple }} + {{ hol ([[apply_table_f]], [[ext_map]], [[func_map]], [[b_func_map]] , [[pars_map]], [[tbl_map]], [[get_oracle_index]] , [[set_oracle_index]] , [[random_oracle]]) }} + +%The expression context may become smaller than ctx, but is for now kept the same with an additional oracle index +ectx {{ tex \mathit{ectx} }} :: ectx_ ::= +{{ com expression context }} +{{ hol (apply_table_f # ext_map # func_map # b_func_map # pars_map # tbl_map # i # random_oracle) }} +| ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , i , random_oracle ) :: M :: tup {{ com tuple }} - {{ hol ([[apply_table_f]], [[ext_map]], [[func_map]], [[b_func_map]] , [[pars_map]], [[tbl_map]]) }} \ No newline at end of file + {{ hol ([[apply_table_f]], [[ext_map]], [[func_map]], [[b_func_map]] , [[pars_map]], [[tbl_map]], [[i]], [[random_oracle]]) }} \ No newline at end of file diff --git a/ott/p4_sem.ott b/ott/p4_sem.ott index 70b2a8ae..bd304927 100644 --- a/ott/p4_sem.ott +++ b/ott/p4_sem.ott @@ -33,7 +33,7 @@ frame {{ tex \Phi }} :: frame_ ::= | ( funn , stmt_stack , scope_list ) :: M :: tup {{ hol ([[funn]] , [[stmt_stack]] , [[scope_list]]) }} {{ tex ( {[[stmt_stack]])}_{[[scope_list]]}^{[[funn]]} }} - + embed {{ hol @@ -69,6 +69,9 @@ state {{ tex s }} :: state_ ::= {{ com execution state }} | ( ascope , g_scope_list , frame_list , status ) :: M :: tup {{ hol ([[ascope]], [[g_scope_list]], [[frame_list]], [[status]]) }} +%TODO: Allow set_oracle index here or in ascope definition? +| ( set_oracle_index i_opt ascope , g_scope_list , frame_list , status ) :: M :: set_oracle_index +{{ hol (set_oracle_index [[i_opt]] [[ascope]], [[g_scope_list]], [[frame_list]], [[status]]) }} aenv {{ tex { \mathit{env}_\mathit{A} } }} :: aenv_ ::= {{ com architectural environment }} @@ -79,6 +82,10 @@ aenv {{ tex { \mathit{env}_\mathit{A} } }} :: aenv_ ::= | ( num_exp , in_out_list , in_out_list' , ascope ) :: M :: tup {{ com tuple }} {{ hol ([[num_exp]], [[in_out_list]], [[in_out_list']], [[ascope]]) }} +%TODO: Allow set_oracle index here or in ascope definition? +| ( num_exp , in_out_list , in_out_list' , set_oracle_index i_opt ascope ) :: M :: set_oracle_index + {{ com tuple }} + {{ hol ([[num_exp]], [[in_out_list]], [[in_out_list']], [[set_oracle_index]] [[i_opt]] [[ascope]]) }} %Fence so that ott does not re-order aenv and astate embed @@ -87,6 +94,15 @@ embed }} grammar +e_red_res :: e_red_res_ ::= +{{ hol (frame_list # (num option)) }} +| empty :: M :: empty + {{ hol ([], (NONE:num option)) }} +| ( frame_list , i ) :: M :: some + {{ hol ([[frame_list]] , SOME [[i]]) }} +| ( frame_list , i_opt ) :: M :: option + {{ hol ([[frame_list]] , [[i_opt]]) }} + arch_frame_list :: arch_frame_list_ ::= {{ com architecture-level frame list }} | arch_frame_list_empty :: :: empty @@ -400,17 +416,13 @@ formula :: formula_ ::= {{ hol ([[x]] = "start") }} {{ tex [[x]] = ``\mathit{start}" }} %Dummy to keep syntax highlighting from freaking out: " -| scope' = copyin_pbl ( ( x1 , .. , xn ) , d_list , e_list , ascope ) :: M :: copyin_pbl +| ( scope' , i_opt ) = copyin_pbl ( ( x1 , .. , xn ) , d_list , e_list , ascope , random_oracle ) :: M :: copyin_pbl {{ com copy in to programmable blocks }} - {{ hol (SOME [[scope']] = [[copyin_pbl]] ([[x1 .. xn]], [[d_list]], [[e_list]], [[ascope]])) }} -| scope' = copyin ( ( x1 , .. , xn ) , d_list , e_list , g_scope_list , scope_list ) :: M :: copyin + {{ hol (SOME ([[scope']], [[i_opt]]) = [[copyin_pbl]] ([[x1 .. xn]], [[d_list]], [[e_list]], [[ascope]], [[random_oracle]])) }} +| ( scope' , i_opt ) = copyin ( ( x1 , .. , xn ) , d_list , e_list , g_scope_list , scope_list , i , random_oracle ) :: M :: copyin {{ com build new scope and copyin }} - {{ tex [[scope']] = \mathrm{copyin} ([x_1 , \; .. \; , x_n] , [e_1 , \; .. \; , e_n] , [d_1 , \; .. \; , d_n] , [[g_scope_list]] , \overrightarrow{\gamma}) }} - {{ hol (SOME [[scope']] = copyin [[x1 .. xn]] [[d_list]] [[e_list]] [[g_scope_list]] [[scope_list]]) }} -| v = arb_from_tau tau :: M :: make_arb - {{ com create new varaible in declaration }} - {{ hol ([[v]] = arb_from_tau [[tau]]) }} - {{ tex [[v]] = \mathrm{arb\_from\_t} \, [[tau]] }} + {{ tex ( [[scope']] , [[i_opt]]) = \mathrm{copyin} ([x_1 , \; .. \; , x_n] , [e_1 , \; .. \; , e_n] , [d_1 , \; .. \; , d_n] , [[g_scope_list]] , \overrightarrow{\gamma}, [[i]], [[random_oracle]]) }} + {{ hol (SOME ([[scope']], [[i_opt]]) = copyin [[x1 .. xn]] [[d_list]] [[e_list]] [[g_scope_list]] [[scope_list]] [[i]] [[random_oracle]]) }} | scope_list' = assign ( scope_list , v , lval ) :: M :: assign {{ com assign v to lval in the frame }} {{ hol (SOME [[scope_list']] = assign [[scope_list]] [[v]] [[lval]]) }} @@ -432,7 +444,12 @@ formula :: formula_ ::= | not_empty stmt_stack :: M :: not_empty_stmt_stack {{ com check so that statement stack is not the empty statement stack }} {{ tex \mathrm{not\_empty} \; [[stmt_stack]] }} - {{ hol ([[stmt_stack]] <> []) }} + {{ hol ([[stmt_stack]] <> []) }} +%TODO: Instead, obtain the ectx mainly by pattern matching? +| ectx = get_ectx ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ascope :: M :: get_ectx + {{ com obtain the ectx from the ctx }} + {{ tex [[ectx]] = \mathrm{get\_ectx} ([[apply_table_f]], [[ext_map]], [[func_map]], [[b_func_map]], [[pars_map]], [[tbl_map]], [[get_oracle_index]], [[set_oracle_index]], [[random_oracle]]) [[ascope]] }} + {{ hol ([[ectx]] = get_ectx ([[apply_table_f]], [[ext_map]], [[func_map]], [[b_func_map]], [[pars_map]], [[tbl_map]], [[get_oracle_index]], [[set_oracle_index]], [[random_oracle]]) [[ascope]]) }} %Architecture-level semantics-related formulae | pbl_type [ ( x1 , d1 ) , .. , ( xn , dn ) ] b_func_map t_scope pars_map tbl_map = pblock_map ( f ) :: M :: lookup_pb @@ -505,14 +522,14 @@ formula :: formula_ ::= | tbl_map' = tbl_to_pass funn b_func_map tbl_map :: :: tbl_to_pass {{ hol SOME [[tbl_map']] = tbl_to_pass [[funn]] [[b_func_map]] [[tbl_map]]}} {{ tex [[tbl_map']] = \mathrm{tbl\_to\_pass} ([[funn]], [[b_func_map]] , [[tbl_map]]) }} -| scope' = declare_list_in_scope ( t_scope , scope ) :: M :: decl_in_scope +| ( scope' , i_opt' ) = declare_list_in_scope ( t_scope , scope , i_opt , get_oracle_index ascope , random_oracle ) :: M :: decl_in_scope {{ com update a scope with a list of declarations }} - {{ hol [[scope']] = declare_list_in_scope ([[t_scope]], [[scope]]) }} - {{ tex [[scope']] = \mathrm{replicate} ([[t_scope]], [[scope]]) }} -| scope = declare_list_in_fresh_scope ( t_scope ) :: M :: decl_in_fresh_scope + {{ hol ([[scope']], [[i_opt']]) = declare_list_in_scope ([[t_scope]], [[scope]], [[i_opt]] , [[get_oracle_index]] [[ascope]] , [[random_oracle]]) }} + {{ tex ([[scope']], [[i_opt']]) = \mathrm{replicate} ([[t_scope]], [[scope]], [[i_opt]] , [[get_oracle_index]] [[ascope]] , [[random_oracle]]) }} +| ( scope , i_opt ) = declare_list_in_fresh_scope ( t_scope , get_oracle_index ascope , random_oracle ) :: M :: decl_in_fresh_scope {{ com create a scope from the list of declarations }} - {{ hol [[scope]] = declare_list_in_fresh_scope ([[t_scope]]) }} - {{ tex [[scope]] = \mathrm{replicate} ([[t_scope]]) }} + {{ hol ([[scope]], [[i_opt]]) = declare_list_in_fresh_scope ([[t_scope]], [[get_oracle_index]] [[ascope]] , [[random_oracle]]) }} + {{ tex ([[scope]], [[i_opt]]) = \mathrm{replicate} ([[t_scope]], [[get_oracle_index]] [[ascope]] , [[random_oracle]]) }} | ( g_scope_list' , scope_list'' ) = copyout ( ( x1 , .. , xn ) , d_list , g_scope_list , scope_list , scope_list' ) :: M :: copyout %scope_list is the callee stack, whereas scope_list' is the caller stack @@ -1981,28 +1998,35 @@ Proof fs [listTheory.MEM_SPLIT, v1_size_append, v_size_def] QED -val init_out_v_def = TotalDefn.tDefine "init_out_v" ` - (init_out_v (v_bool boolv) = v_bool ARB) /\ - (init_out_v (v_bit (bl, n)) = v_bit (extend ARB n [], n)) /\ - (init_out_v (v_str x) = v_str ARB) /\ - (init_out_v (v_struct ((x,v)::t)) = v_struct (((x, init_out_v v))::(MAP (\(x',v'). (x', init_out_v v')) t))) /\ - (init_out_v (v_struct []) = v_struct []) /\ - (init_out_v (v_header boolv ((x,v)::t)) = - v_header F (( (x, init_out_v v) )::(MAP (\(x',v'). (x', init_out_v v')) t))) /\ - (init_out_v (v_header boolv []) = v_header F []) /\ - (init_out_v (v_ext_ref i) = v_ext_ref i) /\ - (init_out_v v_bot = v_bot) -` -(WF_REL_TAC `measure v_size` >> - fs [v_size_def] >> - REPEAT STRIP_TAC >> - `v_size v' < v1_size t` suffices_by ( - fs [] - ) >> - METIS_TAC [v1_size_mem] -); - +Definition get_oracle_calls_def: + (get_oracle_calls 0 i f = []) /\ + (get_oracle_calls (SUC n) i f = + (f i)::(get_oracle_calls n (i+1) f) + ) +End +Definition init_out_v_def: + (init_out_v random_oracle i (v_bool boolv) = (v_bool $ random_oracle i, i+1)) /\ + (init_out_v random_oracle i (v_bit (bl, n)) = (v_bit (get_oracle_calls n i random_oracle, n), i+n)) /\ + (* Note you can't have string variables in P4 (but you can pass string literals to externs) *) + (init_out_v random_oracle i (v_str x) = (v_str "", i)) /\ + (init_out_v random_oracle i (v_struct x_v_l) = + let + (x_v_l'', i''') = FOLDL ( \ (x_v_l', i') (x, v). let (v', i'') = init_out_v random_oracle i' v in ((x, v')::x_v_l', i'')) ([], i) x_v_l + in + (v_struct $ REVERSE x_v_l'', i''') + ) /\ + (init_out_v random_oracle i (v_header boolv x_v_l) = + let + (x_v_l'', i''') = FOLDL ( \ (x_v_l', i') (x, v). let (v', i'') = init_out_v random_oracle i' v in ((x, v')::x_v_l', i'')) ([], i) x_v_l + in + (v_header F (REVERSE x_v_l''), i''') + ) /\ + (init_out_v random_oracle i (v_ext_ref i') = (v_ext_ref i', i)) /\ + (init_out_v random_oracle i v_bot = (v_bot, i)) +Termination +WF_REL_TAC ‘measure ( \ (a,b,c). v_size c)’ +End val tau_size_def = DB.fetch "p4" "tau_size_def"; @@ -2021,34 +2045,51 @@ Proof fs [listTheory.MEM_SPLIT, tau1_size_append, tau_size_def] QED -(* generate an undetermined value for a given type *) -val arb_from_tau_def = TotalDefn.tDefine "arb_from_tau" ` - (arb_from_tau tau_bool = (v_bool ARB)) /\ - (arb_from_tau (tau_bit w) = (v_bit ( (GENLIST (\x.ARB) w ) , w))) /\ - (arb_from_tau tau_bot = v_bot) /\ - (arb_from_tau tau_ext = (v_ext_ref ARB)) /\ - (arb_from_tau (tau_xtl struct_ty_struct [] ) = v_struct [] ) /\ - (arb_from_tau (tau_xtl struct_ty_struct ((x0,t0)::xtl) ) = - v_struct ((x0,arb_from_tau t0)::(MAP (λ(x,t). (x,arb_from_tau t)) xtl))) /\ - (arb_from_tau (tau_xtl struct_ty_header [] ) = v_header ARB [] ) /\ - (arb_from_tau (tau_xtl struct_ty_header ((x0,t0)::xtl)) = - v_header ARB ((x0,arb_from_tau t0)::(MAP (λ(x,t). (x,arb_from_tau t)) xtl))) - ` - (WF_REL_TAC `measure tau_size` >> - REPEAT STRIP_TAC >> - FULL_SIMP_TAC std_ss [] >> - fs [tau_size_def] >> - `tau_size t < tau1_size xtl` suffices_by ( - fs [] ) >> - IMP_RES_TAC tau1_size_mem); +Theorem tau1_size_eq: +!tau_l. tau1_size tau_l = list_size (pair_size (list_size char_size) tau_size) tau_l +Proof +Induct >- ( + gs[tau_size_def] +) >> +rpt strip_tac >> +Cases_on ‘h’ >> +gs[tau_size_def] +QED +(* Initialise values for a given type *) +Definition init_from_tau_def: + (init_from_tau random_oracle i tau_bool = (v_bool $ random_oracle i, i+1)) /\ + (init_from_tau random_oracle i (tau_bit w) = (v_bit (get_oracle_calls w i random_oracle, w), i+w)) /\ + (init_from_tau random_oracle i tau_bot = (v_bot, i)) /\ + (* NOTE: Extern objects can't be declared in blocks. + * They can be block-local, but will then always be instantiated, so this value doesn't matter *) + (init_from_tau random_oracle i tau_ext = (v_ext_ref 0, i)) /\ + (init_from_tau random_oracle i (tau_xtl struct_ty_struct xtl) = + let + (x_v_l', i''') = FOLDL ( \ (x_v_l, i') (x, tau). let (v, i'') = init_from_tau random_oracle i' tau in ((x, v)::x_v_l, i'')) ([], i) xtl + in + (v_struct $ REVERSE x_v_l', i''') + ) /\ + (init_from_tau random_oracle i (tau_xtl struct_ty_header xtl) = + let + (x_v_l', i''') = FOLDL ( \ (x_v_l, i') (x, tau). let (v, i'') = init_from_tau random_oracle i' tau in ((x, v)::x_v_l, i'')) ([], i) xtl + in + (v_header F (REVERSE x_v_l'), i''') + ) +Termination +WF_REL_TAC ‘measure ( \ (a,b,c). tau_size c)’ >> +rpt strip_tac >> ( + imp_res_tac tau1_size_mem >> + gs[tau1_size_eq] +) +End (* Given a direction, an expression (should be a lval), and a scope stack, * creates the proper tuple to be be assigned in the fresh scope created by a function call *) val one_arg_val_for_newscope_def = Define ` - one_arg_val_for_newscope d e ss = + one_arg_val_for_newscope d e ss i random_oracle = if is_d_out d then (case get_lval_of_e e of @@ -2056,13 +2097,13 @@ val one_arg_val_for_newscope_def = Define ` (case lookup_lval ss lval of | SOME v => if is_d_in d - then SOME (v, SOME lval) - else SOME (init_out_v v, SOME lval) + then SOME ((v, i), SOME lval) + else SOME (init_out_v random_oracle i v, SOME lval) | NONE => NONE) | NONE => NONE) else (case v_of_e e of - | SOME v => SOME (v, NONE) + | SOME v => SOME ((v, i), NONE) | NONE => NONE) `; @@ -2078,11 +2119,11 @@ Definition AUPDATE_LIST_def: End val update_arg_for_newscope_def = Define ` - update_arg_for_newscope ss f_opt (d, x, e) = - case f_opt of - | SOME f => - (case one_arg_val_for_newscope d e ss of - | SOME (v, lval_opt) => SOME (AUPDATE f (varn_name x, (v, lval_opt))) + update_arg_for_newscope ss random_oracle f_i_opt (d, x, e) = + case f_i_opt of + | SOME (f,i) => + (case one_arg_val_for_newscope d e ss i random_oracle of + | SOME ((v, i'), lval_opt) => SOME (AUPDATE f (varn_name x, (v, lval_opt)), i') | NONE => NONE) | NONE => NONE `; @@ -2090,15 +2131,18 @@ val update_arg_for_newscope_def = Define ` (* Fills a fresh scope with the values of the arguments of a called function. * Note: used in e_call_newframe *) val all_arg_update_for_newscope_def = Define ` - all_arg_update_for_newscope xlist dlist elist ss = - FOLDL (update_arg_for_newscope ss) (SOME []) (ZIP (dlist, ZIP(xlist, elist))) + all_arg_update_for_newscope xlist dlist elist ss i random_oracle = + FOLDL (update_arg_for_newscope ss random_oracle) (SOME ([], i)) (ZIP (dlist, ZIP(xlist, elist))) `; (* full copyin definition *) val copyin_def = Define ` - copyin xlist dlist elist gsl ss_curr = - all_arg_update_for_newscope xlist dlist elist (ss_curr++gsl) + copyin xlist dlist elist gsl ss_curr i random_oracle = + case all_arg_update_for_newscope xlist dlist elist (ss_curr++gsl) i random_oracle of + | SOME (scope', i') => + SOME (scope', if i = i' then NONE else SOME i') + | NONE => NONE `; (* in bl' slice from v2 to v1 and in that section add bl in those positions @@ -2109,7 +2153,9 @@ val relpace_bits_def = Define ` (SEG ((v'-v1)-1) 0 bl') ++ bl ++ (SEG v2 (v'-v2) bl') `; - +Definition get_ectx_def: + get_ectx ((apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index, set_oracle_index, random_oracle):'a ctx) (ascope:'a) = (apply_table_f, ext_map, func_map, b_func_map, pars_map, tbl_map, get_oracle_index ascope, random_oracle) +End (* assign to slice returns that value being replaces in a slicing assignment. i.e. assign the value bit vb to vb' where vb should replace only the positions from ev2 to ev1 in vb' *) @@ -2182,23 +2228,6 @@ val oDROP_def = Define ` (oDROP (SUC n) (h::t) = oDROP n t) `; -(* Declares a new variable and initialises it to ARB, returns the new scope stack *) -(* TODO: Behaviour when variable already exists? *) -(* Note that this will declare variables in the block-global scope when scope stack is empty *) -(* TODO: REMOVE IT *) -(* -val declare_def = Define ` - (declare g_scope_list (ss:scope_list) x t = - case ss of - | [] => (LUPDATE (AUPDATE (EL 1 g_scope_list) (varn_name x, (arb_from_tau t, NONE))) 1 g_scope_list, []) - | _ => - let i = LENGTH ss - 1 in - let scope = EL i ss in - (g_scope_list, LUPDATE (AUPDATE scope (varn_name x, (arb_from_tau t, NONE))) i ss) - ) -`; -*) - (* Initialises a new variable in the topmost scope. *) val initialise_def = Define ` (initialise (ss:scope_list) varn v = @@ -2247,15 +2276,18 @@ val initialise_var_stars_def = Define ` (* Takes a list of declaration tuples (x, t) and a scope, and returns a scope * where the declarations have been made *) val declare_list_in_scope_def = Define ` - declare_list_in_scope (t_scope:t_scope, scope:scope) = - FOLDR (\(x,(t,lvalop) ) f. AUPDATE f (x , (arb_from_tau t, NONE))) (scope:scope) t_scope + declare_list_in_scope (t_scope:t_scope, scope:scope, i_opt, i, random_oracle) = + let + (scope', i''') = FOLDR (\(x, (t,lvalop)) (f, i'). let (v', i'') = init_from_tau random_oracle i' t in ((x , (v', NONE))::f, i'')) (scope:scope, case i_opt of NONE => i | SOME i_upd => i_upd) t_scope + in + (scope', if i = i''' then NONE else SOME i''') `; (* Same as the above, but with the empty scope NOTE: the lvalop here is always none when entering a new block *) val declare_list_in_fresh_scope_def = Define ` - declare_list_in_fresh_scope (t_scope:t_scope) = - (MAP (\(x,(t,lvalop)). (x , (arb_from_tau t, NONE))) t_scope) + declare_list_in_fresh_scope (t_scope:t_scope, i, random_oracle) = + declare_list_in_scope (t_scope:t_scope, [], NONE, i, random_oracle) `; (* Looks up the function signature and body for an abstract function name. *) @@ -2585,9 +2617,9 @@ grammar defns e_sem :: '' ::= defn -ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) :: :: e_red :: e_ +ectx g_scope_list scope_list ( e ) ~> ( e' , e_red_res ) :: :: e_red :: e_ {{ com expression semantics }} -{{ tex [[ctx]] \, [[g_scope_list]] \, [[scope_list]] \vdash ( [[e]] ) \rightsquigarrow ( [[e']] , [[frame_list]] ) }} +{{ tex [[ectx]] \, [[g_scope_list]] \, [[scope_list]] \vdash ( [[e]] ) \rightsquigarrow ( [[e']] , [[e_red_res]] ) }} by %%%%%%%%%%%%%%%%% @@ -2595,7 +2627,7 @@ by v = lookup_vexp2 ( scope_list , g_scope_list , varn ) ----------------------------------- :: lookup -ctx g_scope_list scope_list ( var varn ) ~> ( v , empty ) +ectx g_scope_list scope_list ( var varn ) ~> ( v , empty ) %%%%%%%%%%%%%% %Function/method call @@ -2603,18 +2635,18 @@ ctx g_scope_list scope_list ( var varn ) ~> ( v , empty ) %Function call construction of new frame ( stmt , [ ( x1 , d1 ) , .. , ( xn , dn ) ] ) = lookup_funn_sig_body ( funn , func_map , b_func_map , ext_map ) check_args_red [ d1 , .. , dn ] [ e1 , .. , en ] -scope' = copyin ( ( x1 , .. , xn ) , [ d1 , .. , dn ] , [ e1 , .. , en ] , g_scope_list , scope_list ) +( scope' , i_opt ) = copyin ( ( x1 , .. , xn ) , [ d1 , .. , dn ] , [ e1 , .. , en ] , g_scope_list , scope_list , i , random_oracle ) ----------------------------------- :: call_newframe -( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) g_scope_list scope_list ( call funn ( e1 , .. , en ) ) ~> ( var ( star , funn ) , [ ( funn , [ stmt ] , [ scope' ] ) ] ) +( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , i , random_oracle ) g_scope_list scope_list ( call funn ( e1 , .. , en ) ) ~> ( var ( star , funn ) , ( [ ( funn , [ stmt ] , [ scope' ] ) ] , i_opt ) ) %Function call reduction of arguments [ ( x1 , d1 ) , .. , ( xn , dn ) ] = lookup_funn_sig ( funn , func_map , b_func_map , ext_map ) unred_arg_index [ d1 , .. , dn ] [ e1 , .. , en ] = i e = [ e1 , .. , en ] [ i ] -( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) g_scope_list scope_list ( e ) ~> ( e' , frame_list ) +( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , i' , random_oracle ) g_scope_list scope_list ( e ) ~> ( e' , e_red_res ) [ e'1 , .. , e'n ] =' update ( e' , i , [ e1 , .. , en ] ) ----------------------------------- :: call_args -( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) g_scope_list scope_list ( call funn ( e1 , .. , en ) ) ~> ( call funn ( e'1 , .. , e'n ) , frame_list ) +( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , i' , random_oracle ) g_scope_list scope_list ( call funn ( e1 , .. , en ) ) ~> ( call funn ( e'1 , .. , e'n ) , e_red_res ) %%%%%% structs operations @@ -2622,112 +2654,111 @@ e = [ e1 , .. , en ] [ i ] %eStruct as expression reduction: reduce one step per expression in the list unred_mem_index [ e1 , ... , en ] = i e = [ e1 , ... , en ] [ i ] -ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) +ectx g_scope_list scope_list ( e ) ~> ( e' , e_red_res ) [ e'1 , ... , e'n ] =' update ( e' , i , [ e1 , ... , en ] ) ----------------------------------- :: eStruct -ctx g_scope_list scope_list ( eStruct { f1 = e1 ; ... ; fn = en } ) ~> ( eStruct { f1 = e'1 ; ... ; fn = e'n } , frame_list ) +ectx g_scope_list scope_list ( eStruct { f1 = e1 ; ... ; fn = en } ) ~> ( eStruct { f1 = e'1 ; ... ; fn = e'n } , e_red_res ) %eStruct coversion to value struct is_consts ( e1 , ... , en ) ( v1 , ... , vn ) = vl_of_el ( e1 , ... , en ) ----------------------------------- :: eStruct_to_v -ctx g_scope_list scope_list ( eStruct { f1 = e1 ; ... ; fn = en } ) ~> ( struct { f1 = v1 ; ... ; fn = vn } , empty ) +ectx g_scope_list scope_list ( eStruct { f1 = e1 ; ... ; fn = en } ) ~> ( struct { f1 = v1 ; ... ; fn = vn } , empty ) %access a value struct field v = struct { f1 = v1 ; ... ; fn = vn } ( f ) ----------------------------------- :: s_acc -ctx g_scope_list scope_list ( struct { f1 = v1 ; ... ; fn = vn } . f ) ~> ( v , empty ) +ectx g_scope_list scope_list ( struct { f1 = v1 ; ... ; fn = vn } . f ) ~> ( v , empty ) %expression reduction for access fields -ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) +ectx g_scope_list scope_list ( e ) ~> ( e' , e_red_res ) ----------------------------------- :: acc_arg1 -ctx g_scope_list scope_list ( e . f ) ~> ( e' . f , frame_list ) +ectx g_scope_list scope_list ( e . f ) ~> ( e' . f , e_red_res ) %%%%%% headers operations %eHeader as expression reduction: reduce one step per expression in the list unred_mem_index [ e1 , ... , en ] = i e = [ e1 , ... , en ] [ i ] -ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) +ectx g_scope_list scope_list ( e ) ~> ( e' , e_red_res ) [ e'1 , ... , e'n ] =' update ( e' , i , [ e1 , ... , en ] ) ----------------------------------- :: eHeader -ctx g_scope_list scope_list ( eHeader boolv { f1 = e1 ; ... ; fn = en } ) ~> ( eHeader boolv { f1 = e'1 ; ... ; fn = e'n } , frame_list ) +ectx g_scope_list scope_list ( eHeader boolv { f1 = e1 ; ... ; fn = en } ) ~> ( eHeader boolv { f1 = e'1 ; ... ; fn = e'n } , e_red_res ) %eHeader coversion to value struct is_consts ( e1 , ... , en ) ( v1 , ... , vn ) = vl_of_el ( e1 , ... , en ) ----------------------------------- :: eHeader_to_v -ctx g_scope_list scope_list ( eHeader boolv { f1 = e1 ; ... ; fn = en } ) ~> ( header boolv { f1 = v1 ; ... ; fn = vn } , empty ) +ectx g_scope_list scope_list ( eHeader boolv { f1 = e1 ; ... ; fn = en } ) ~> ( header boolv { f1 = v1 ; ... ; fn = vn } , empty ) %Header field access v = header boolv { f1 = v1 ; ... ; fn = vn } ( f ) ----------------------------------- :: h_acc -ctx g_scope_list scope_list ( header boolv { f1 = v1 ; ... ; fn = vn } . f ) ~> ( v , empty ) +ectx g_scope_list scope_list ( header boolv { f1 = v1 ; ... ; fn = vn } . f ) ~> ( v , empty ) %Case select lookup x' = { s_list1 : x1 ; ... ; s_listn : xn } x v ----------------------------------- :: sel_acc -ctx g_scope_list scope_list ( select v { s_list1 : x1 ; ... ; s_listn : xn } x ) ~> ( x' , empty ) +ectx g_scope_list scope_list ( select v { s_list1 : x1 ; ... ; s_listn : xn } x ) ~> ( x' , empty ) %concatenation of two bitstrings -ctx g_scope_list scope_list ( e ) ~> ( e'' , frame_list ) +ectx g_scope_list scope_list ( e ) ~> ( e'' , e_red_res ) ----------------------------------- :: concat_arg1 -ctx g_scope_list scope_list ( concat e e' ) ~> ( concat e'' e' , frame_list ) +ectx g_scope_list scope_list ( concat e e' ) ~> ( concat e'' e' , e_red_res ) -ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) +ectx g_scope_list scope_list ( e ) ~> ( e' , e_red_res ) ----------------------------------- :: concat_arg2 -ctx g_scope_list scope_list ( concat bitv e ) ~> ( concat bitv e' , frame_list ) +ectx g_scope_list scope_list ( concat bitv e ) ~> ( concat bitv e' , e_red_res ) bitv'' = concat bitv bitv' ----------------------------------- :: concat_v -ctx g_scope_list scope_list ( concat bitv bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( concat bitv bitv' ) ~> ( bitv'' , empty ) %bit slicing operation -ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) +ectx g_scope_list scope_list ( e ) ~> ( e' , e_red_res ) ----------------------------------- :: slice_arg1 -ctx g_scope_list scope_list ( e [ bitv : bitv' ] ) ~> ( e' [ bitv : bitv' ] , frame_list ) +ectx g_scope_list scope_list ( e [ bitv : bitv' ] ) ~> ( e' [ bitv : bitv' ] , e_red_res ) %compile time known values from p4 spec. bitv''' = bitv [ bitv' : bitv'' ] ----------------------------------- :: slice_v -ctx g_scope_list scope_list ( bitv [ bitv' : bitv'' ] ) ~> ( bitv''' , empty ) +ectx g_scope_list scope_list ( bitv [ bitv' : bitv'' ] ) ~> ( bitv''' , empty ) %Select -ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) +ectx g_scope_list scope_list ( e ) ~> ( e' , e_red_res ) ----------------------------------- :: sel_arg -ctx g_scope_list scope_list ( select e { s_list1 : x1 ; ... ; s_listn : xn } x ) ~> ( select e' { s_list1 : x1 ; ... ; s_listn : xn } x , frame_list ) +ectx g_scope_list scope_list ( select e { s_list1 : x1 ; ... ; s_listn : xn } x ) ~> ( select e' { s_list1 : x1 ; ... ; s_listn : xn } x , e_red_res ) %Unary operations -ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) +ectx g_scope_list scope_list ( e ) ~> ( e' , e_red_res ) ----------------------------------- :: unop_arg -ctx g_scope_list scope_list ( unop e ) ~> ( unop e' , frame_list ) +ectx g_scope_list scope_list ( unop e ) ~> ( unop e' , e_red_res ) %Casts -ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) +ectx g_scope_list scope_list ( e ) ~> ( e' , e_red_res ) ----------------------------------- :: cast_arg -ctx g_scope_list scope_list ( cast e ) ~> ( cast e' , frame_list ) +ectx g_scope_list scope_list ( cast e ) ~> ( cast e' , e_red_res ) %Binary operations -ctx g_scope_list scope_list ( e ) ~> ( e'' , frame_list ) +ectx g_scope_list scope_list ( e ) ~> ( e'' , e_red_res ) ----------------------------------- :: binop_arg1 -ctx g_scope_list scope_list ( e binop e' ) ~> ( e'' binop e' , frame_list ) +ectx g_scope_list scope_list ( e binop e' ) ~> ( e'' binop e' , e_red_res ) -%TODO: Enforce short-circuit evaluation for AND, OR on Booleans? ~is_short_circuit ( binop ) -ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) +ectx g_scope_list scope_list ( e ) ~> ( e' , e_red_res ) ----------------------------------- :: binop_arg2 -ctx g_scope_list scope_list ( v binop e ) ~> ( v binop e' , frame_list ) +ectx g_scope_list scope_list ( v binop e ) ~> ( v binop e' , e_red_res ) %%%%%%%%%%%%%%%%%%% @@ -2739,21 +2770,21 @@ ctx g_scope_list scope_list ( v binop e ) ~> ( v binop e' , frame_list ) ! b = b' ----------------------------------- :: neg_bool -ctx g_scope_list scope_list ( ! b ) ~> ( b' , empty ) +ectx g_scope_list scope_list ( ! b ) ~> ( b' , empty ) %%%%%%%%%%%%%%%%%%% %Bitwise complement ~ bitv = bitv' ----------------------------------- :: compl -ctx g_scope_list scope_list ( ~ bitv ) ~> ( bitv' , empty ) +ectx g_scope_list scope_list ( ~ bitv ) ~> ( bitv' , empty ) %%%%%%%%%%%%%%%% %Signed negation - bitv = bitv' ----------------------------------- :: neg_signed -ctx g_scope_list scope_list ( - bitv ) ~> ( bitv' , empty ) +ectx g_scope_list scope_list ( - bitv ) ~> ( bitv' , empty ) %%%%%%%%%%% @@ -2761,7 +2792,7 @@ ctx g_scope_list scope_list ( - bitv ) ~> ( bitv' , empty ) + bitv = bitv' ----------------------------------- :: un_plus -ctx g_scope_list scope_list ( + bitv ) ~> ( bitv' , empty ) +ectx g_scope_list scope_list ( + bitv ) ~> ( bitv' , empty ) %%%%%%% %Casts% @@ -2769,21 +2800,21 @@ ctx g_scope_list scope_list ( + bitv ) ~> ( bitv' , empty ) ( unsigned n ) bitv = bitv' ----------------------------------- :: cast_bitv -ctx g_scope_list scope_list ( ( unsigned n ) bitv ) ~> ( bitv' , empty ) +ectx g_scope_list scope_list ( ( unsigned n ) bitv ) ~> ( bitv' , empty ) % TODO: fix this cast to take only 1 unsigned not n ( unsigned n ) b = bitv ----------------------------------- :: cast_bool -ctx g_scope_list scope_list ( ( unsigned n ) b ) ~> ( bitv , empty ) +ectx g_scope_list scope_list ( ( unsigned n ) b ) ~> ( bitv , empty ) ( bool ) bitv = b ----------------------------------- :: cast_to_bool -ctx g_scope_list scope_list ( ( bool ) bitv ) ~> ( b , empty ) +ectx g_scope_list scope_list ( ( bool ) bitv ) ~> ( b , empty ) ( bool ) b = b' ----------------------------------- :: cast_id_bool -ctx g_scope_list scope_list ( ( bool ) b ) ~> ( b' , empty ) +ectx g_scope_list scope_list ( ( bool ) b ) ~> ( b' , empty ) %%%%%%%%%%%%%%%%%%%% @@ -2795,7 +2826,7 @@ ctx g_scope_list scope_list ( ( bool ) b ) ~> ( b' , empty ) bitv * bitv' = bitv'' ----------------------------------- :: mul -ctx g_scope_list scope_list ( bitv * bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv * bitv' ) ~> ( bitv'' , empty ) %%%%%%%%%%%%%%% @@ -2803,35 +2834,35 @@ ctx g_scope_list scope_list ( bitv * bitv' ) ~> ( bitv'' , empty ) bitv / bitv' = bitv'' ----------------------------------- :: div -ctx g_scope_list scope_list ( bitv / bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv / bitv' ) ~> ( bitv'' , empty ) %%%%%%%%%%%%%%% %Modulo bitv mod bitv' = bitv'' ----------------------------------- :: mod -ctx g_scope_list scope_list ( bitv mod bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv mod bitv' ) ~> ( bitv'' , empty ) %%%%%%%%%%%% %Addition bitv + bitv' = bitv'' ----------------------------------- :: add -ctx g_scope_list scope_list ( bitv + bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv + bitv' ) ~> ( bitv'' , empty ) bitv sat_add bitv' = bitv'' ----------------------------------- :: sat_add -ctx g_scope_list scope_list ( bitv sat_add bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv sat_add bitv' ) ~> ( bitv'' , empty ) %%%%%%%%%%%% %Subtraction bitv - bitv' = bitv'' ----------------------------------- :: sub -ctx g_scope_list scope_list ( bitv - bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv - bitv' ) ~> ( bitv'' , empty ) bitv sat_sub bitv' = bitv'' ----------------------------------- :: sat_sub -ctx g_scope_list scope_list ( bitv sat_sub bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv sat_sub bitv' ) ~> ( bitv'' , empty ) %%%%%%%%%%%% @@ -2839,52 +2870,52 @@ ctx g_scope_list scope_list ( bitv sat_sub bitv' ) ~> ( bitv'' , empty ) bitv SHL bitv' = bitv'' ----------------------------------- :: shl -ctx g_scope_list scope_list ( bitv SHL bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv SHL bitv' ) ~> ( bitv'' , empty ) %%%%%%%%%%%% %Right shift bitv SHR bitv' = bitv'' ----------------------------------- :: shr -ctx g_scope_list scope_list ( bitv SHR bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv SHR bitv' ) ~> ( bitv'' , empty ) %%%%%%%%%%%%%%%%%%% %Less than or equal bitv LE bitv' = b ----------------------------------- :: le -ctx g_scope_list scope_list ( bitv LE bitv' ) ~> ( b , empty ) +ectx g_scope_list scope_list ( bitv LE bitv' ) ~> ( b , empty ) %%%%%%%%%%%%%%%%%%%%%% %Greater than or equal bitv GE bitv' = b ----------------------------------- :: ge -ctx g_scope_list scope_list ( bitv GE bitv' ) ~> ( b , empty ) +ectx g_scope_list scope_list ( bitv GE bitv' ) ~> ( b , empty ) %%%%%%%%%% %Less than bitv < bitv' = b ----------------------------------- :: lt -ctx g_scope_list scope_list ( bitv < bitv' ) ~> ( b , empty ) +ectx g_scope_list scope_list ( bitv < bitv' ) ~> ( b , empty ) %%%%%%%%%%%%% %Greater than bitv > bitv' = b ----------------------------------- :: gt -ctx g_scope_list scope_list ( bitv > bitv' ) ~> ( b , empty ) +ectx g_scope_list scope_list ( bitv > bitv' ) ~> ( b , empty ) %%%%%%%%%%%%% %Not equal bitv NE bitv' = b ----------------------------------- :: neq -ctx g_scope_list scope_list ( bitv NE bitv' ) ~> ( b , empty ) +ectx g_scope_list scope_list ( bitv NE bitv' ) ~> ( b , empty ) b NE b' = b'' ----------------------------------- :: neq_bool -ctx g_scope_list scope_list ( b NE b' ) ~> ( b'' , empty ) +ectx g_scope_list scope_list ( b NE b' ) ~> ( b'' , empty ) %%%%%%%%%%%%% @@ -2892,11 +2923,11 @@ ctx g_scope_list scope_list ( b NE b' ) ~> ( b'' , empty ) bitv EQ bitv' = b ----------------------------------- :: eq -ctx g_scope_list scope_list ( bitv EQ bitv' ) ~> ( b , empty ) +ectx g_scope_list scope_list ( bitv EQ bitv' ) ~> ( b , empty ) b EQ b' = b'' ----------------------------------- :: eq_bool -ctx g_scope_list scope_list ( b EQ b' ) ~> ( b'' , empty ) +ectx g_scope_list scope_list ( b EQ b' ) ~> ( b'' , empty ) %%%%%%%%%%%%% @@ -2904,7 +2935,7 @@ ctx g_scope_list scope_list ( b EQ b' ) ~> ( b'' , empty ) bitv & bitv' = bitv'' ----------------------------------- :: and -ctx g_scope_list scope_list ( bitv & bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv & bitv' ) ~> ( bitv'' , empty ) %%%%%%%%%%%%% @@ -2912,7 +2943,7 @@ ctx g_scope_list scope_list ( bitv & bitv' ) ~> ( bitv'' , empty ) bitv ^ bitv' = bitv'' ----------------------------------- :: xor -ctx g_scope_list scope_list ( bitv ^ bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv ^ bitv' ) ~> ( bitv'' , empty ) @@ -2921,7 +2952,7 @@ ctx g_scope_list scope_list ( bitv ^ bitv' ) ~> ( bitv'' , empty ) bitv | bitv' = bitv'' ----------------------------------- :: or -ctx g_scope_list scope_list ( bitv | bitv' ) ~> ( bitv'' , empty ) +ectx g_scope_list scope_list ( bitv | bitv' ) ~> ( bitv'' , empty ) %%%%%%%%%%%%% @@ -2929,20 +2960,20 @@ ctx g_scope_list scope_list ( bitv | bitv' ) ~> ( bitv'' , empty ) %Note: This uses short-circuit evaluation ----------------------------------- :: bin_and1 -ctx g_scope_list scope_list ( false AND e ) ~> ( false , empty ) +ectx g_scope_list scope_list ( false AND e ) ~> ( false , empty ) ----------------------------------- :: bin_and2 -ctx g_scope_list scope_list ( true AND e ) ~> ( e , empty ) +ectx g_scope_list scope_list ( true AND e ) ~> ( e , empty ) %%%%%%%%%%%%% %Binary or %Note: This uses short-circuit evaluation ----------------------------------- :: bin_or1 -ctx g_scope_list scope_list ( true OR e ) ~> ( true , empty ) +ectx g_scope_list scope_list ( true OR e ) ~> ( true , empty ) ----------------------------------- :: bin_or2 -ctx g_scope_list scope_list ( false OR e ) ~> ( e , empty ) +ectx g_scope_list scope_list ( false OR e ) ~> ( e , empty ) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Statement semantics ( single frame )% @@ -2951,7 +2982,6 @@ ctx g_scope_list scope_list ( false OR e ) ~> ( e , empty ) %TODO: Should this now be called statement stack semantics and use the prefix "stmt_stack"? %TODO: Exit -%TODO: Switch defns stmt_sem :: '' ::= @@ -2999,16 +3029,16 @@ by %Block - ( scope ) = declare_list_in_fresh_scope ( t_scope ) + ( scope , i_opt ) = declare_list_in_fresh_scope ( t_scope , get_oracle_index ascope , random_oracle ) scope_list' = [ scope ] ++ scope_list ----------------------------------- :: block_enter - ctx ( ascope , g_scope_list , [ ( funn , [ begin t_scope stmt end ] , scope_list ) ] , Running ) -> ( ascope , g_scope_list , [ ( funn , stmt :: [ empty_stmt ] , scope_list' ) ] , Running ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , [ begin t_scope stmt end ] , scope_list ) ] , Running ) -> ( set_oracle_index i_opt ascope , g_scope_list , [ ( funn , stmt :: [ empty_stmt ] , scope_list' ) ] , Running ) not_empty stmt not_empty stmt_stack - ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , [ ( funn , [ stmt ] , scope_list ) ] , status ) -> ( ascope' , g_scope_list' , frame_list' ++ [ ( funn , stmt_stack' , scope_list' ) ] , status' ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , [ stmt ] , scope_list ) ] , status ) -> ( ascope' , g_scope_list' , frame_list' ++ [ ( funn , stmt_stack' , scope_list' ) ] , status' ) ----------------------------------- :: block_exec - ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , [ ( funn , stmt :: stmt_stack , scope_list ) ] , status ) -> ( ascope' , g_scope_list' , frame_list' ++ [ ( funn , stmt_stack' ++ stmt_stack , scope_list' ) ] , status' ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , stmt :: stmt_stack , scope_list ) ] , status ) -> ( ascope' , g_scope_list' , frame_list' ++ [ ( funn , stmt_stack' ++ stmt_stack , scope_list' ) ] , status' ) not_empty stmt_stack scope_list' = tl scope_list @@ -3029,7 +3059,7 @@ by tbl_map ( tbl ) = ( [ mk1 , .. , mkn ] , ( f' , [ e'1 , .. , e'o ] ) ) apply_table_f ( tbl , ( e1 , .. , en ) , ( [ mk1 , .. , mkn ] ) , ( f' , [ e'1 , .. , e'o ] ) , ascope ) = ( f , ( v1 , .. , vm ) ) ----------------------------------- :: apply_table_v - ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , [ ( funn , [ apply tbl ( e1 , .. , en ) ] , scope_list ) ] , Running ) -> ( ascope , g_scope_list , [ ( funn , [ assign null ( call f ( v1 , .. , vm ) ) ] , scope_list ) ] , Running ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , [ apply tbl ( e1 , .. , en ) ] , scope_list ) ] , Running ) -> ( ascope , g_scope_list , [ ( funn , [ assign null ( call f ( v1 , .. , vm ) ) ] , scope_list ) ] , Running ) %%%%%%%%%%%%%% @@ -3043,7 +3073,7 @@ by ext_fun = lookup_ext_fun ( funn , ext_map ) ( ascope' , scope_list' , status ) = ext_fun ( ascope , g_scope_list , scope_list ) ----------------------------------- :: ext - ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , [ ( funn , [ ext ] , scope_list ) ] , Running ) -> ( ascope' , g_scope_list , [ ( funn , [ empty_stmt ] , scope_list' ) ] , status ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , [ ext ] , scope_list ) ] , Running ) -> ( ascope' , g_scope_list , [ ( funn , [ empty_stmt ] , scope_list' ) ] , status ) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3052,36 +3082,42 @@ by %Reduction step of return expression - ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) +%TODO: Write "get_ectx ctx ascope" in place of ectx directly instead? This would require adding this to the ectx definition + ectx = get_ectx ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ascope + ectx g_scope_list scope_list ( e ) ~> ( e' , ( frame_list , i_opt ) ) ----------------------------------- :: ret_e - ctx ( ascope , g_scope_list , [ ( funn , [ return e ] , scope_list ) ] , Running ) -> ( ascope , g_scope_list , frame_list ++ [ ( funn , [ return e' ] , scope_list ) ] , Running ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , [ return e ] , scope_list ) ] , Running ) -> ( set_oracle_index i_opt ascope , g_scope_list , frame_list ++ [ ( funn , [ return e' ] , scope_list ) ] , Running ) %Reduction step of assign expression - ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) + ectx = get_ectx ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ascope + ectx g_scope_list scope_list ( e ) ~> ( e' , ( frame_list , i_opt ) ) ----------------------------------- :: ass_e - ctx ( ascope , g_scope_list , [ ( funn , [ assign lval e ] , scope_list ) ] , Running ) -> ( ascope , g_scope_list , frame_list ++ [ ( funn , [ assign lval e' ] , scope_list ) ] , Running ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , [ assign lval e ] , scope_list ) ] , Running ) -> ( set_oracle_index i_opt ascope , g_scope_list , frame_list ++ [ ( funn , [ assign lval e' ] , scope_list ) ] , Running ) %Reduction step of condition - ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) + ectx = get_ectx ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ascope + ectx g_scope_list scope_list ( e ) ~> ( e' , ( frame_list , i_opt ) ) ----------------------------------- :: cond_e - ctx ( ascope , g_scope_list , [ ( funn , [ if e then stmt1 else stmt2 ] , scope_list ) ] , Running ) -> ( ascope , g_scope_list , frame_list ++ [ ( funn , [ if e' then stmt1 else stmt2 ] , scope_list ) ] , Running ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , [ if e then stmt1 else stmt2 ] , scope_list ) ] , Running ) -> ( set_oracle_index i_opt ascope , g_scope_list , frame_list ++ [ ( funn , [ if e' then stmt1 else stmt2 ] , scope_list ) ] , Running ) %Reduction step of transition - ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) + ectx = get_ectx ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ascope + ectx g_scope_list scope_list ( e ) ~> ( e' , ( frame_list , i_opt ) ) ------------------------------------------------- :: trans_e - ctx ( ascope , g_scope_list , [ ( funn , [ transition e ] , scope_list ) ] , Running ) -> ( ascope , g_scope_list , frame_list ++ [ ( funn , [ transition e' ] , scope_list ) ] , Running ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , [ transition e ] , scope_list ) ] , Running ) -> ( set_oracle_index i_opt ascope , g_scope_list , frame_list ++ [ ( funn , [ transition e' ] , scope_list ) ] , Running ) %Reduction step of match-action expression index_not_const [ e1 , .. , en ] = i e = [ e1 , .. , en ] [ i ] - ctx g_scope_list scope_list ( e ) ~> ( e' , frame_list ) + ectx = get_ectx ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ascope + ectx g_scope_list scope_list ( e ) ~> ( e' , ( frame_list , i_opt ) ) [ e'1 , .. , e'n ] =' update ( e' , i , [ e1 , .. , en ] ) ----------------------------------- :: apply_table_e - ctx ( ascope , g_scope_list , [ ( funn , [ apply tbl ( e1 , .. , en ) ] , scope_list ) ] , Running ) -> ( ascope , g_scope_list , frame_list ++ [ ( funn , [ apply tbl ( e'1 , .. , e'n ) ] , scope_list ) ] , Running ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , [ apply tbl ( e1 , .. , en ) ] , scope_list ) ] , Running ) -> ( set_oracle_index i_opt ascope , g_scope_list , frame_list ++ [ ( funn , [ apply tbl ( e'1 , .. , e'n ) ] , scope_list ) ] , Running ) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3100,11 +3136,11 @@ by g_scope_list' = scopes_to_pass ( funn , func_map , b_func_map , g_scope_list ) b_func_map' = map_to_pass funn b_func_map tbl_map' = tbl_to_pass funn b_func_map tbl_map - ( apply_table_f , ext_map , func_map , b_func_map' , pars_map , tbl_map' ) ( ascope , g_scope_list' , [ ( funn , stmt_stack , scope_list ) ] , status ) -> ( ascope' , g_scope_list'' , frame_list' , status' ) + ( apply_table_f , ext_map , func_map , b_func_map' , pars_map , tbl_map' , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list' , [ ( funn , stmt_stack , scope_list ) ] , status ) -> ( ascope' , g_scope_list'' , frame_list' , status' ) notret( status' , frame_list'' ) g_scope_list''' = scopes_to_retrieve ( funn , func_map , b_func_map , g_scope_list , g_scope_list'' ) ----------------------------------- :: comp1 - ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , [ ( funn , stmt_stack , scope_list ) ] ++ frame_list'' , status ) -f-> ( ascope' , g_scope_list''' , frame_list' ++ frame_list'' , status' ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , stmt_stack , scope_list ) ] ++ frame_list'' , status ) -f-> ( ascope' , g_scope_list''' , frame_list' ++ frame_list'' , status' ) %Note that global scope does not matter for the below statement reduction step (write global scope empty?), so no "scopes_to_pass" needed @@ -3112,7 +3148,7 @@ by g_scope_list' = scopes_to_pass ( funn , func_map , b_func_map , g_scope_list ) b_func_map' = map_to_pass funn b_func_map tbl_map' = tbl_to_pass funn b_func_map tbl_map - ( apply_table_f , ext_map , func_map , b_func_map' , pars_map , tbl_map' ) ( ascope , g_scope_list' , [ ( funn , stmt_stack , scope_list ) ] , Running ) -> ( ascope' , g_scope_list'' , [ ( funn , stmt_stack'' , scope_list'' ) ] , Ret v ) + ( apply_table_f , ext_map , func_map , b_func_map' , pars_map , tbl_map' , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list' , [ ( funn , stmt_stack , scope_list ) ] , Running ) -> ( ascope' , g_scope_list'' , [ ( funn , stmt_stack'' , scope_list'' ) ] , Ret v ) ( stmt''' , [ ( x1 , d1 ) , .. , ( xn , dn ) ] ) = lookup_funn_sig_body ( funn , func_map , b_func_map , ext_map ) g_scope_list''' = assign ( ( g_scope_list'' ) , v , ( star , funn ) ) g_scope_list'''' = scopes_to_retrieve ( funn , func_map , b_func_map , g_scope_list , g_scope_list''' ) @@ -3120,7 +3156,7 @@ by ( g_scope_list'''''' , scope_list''' ) = copyout ( ( x1 , .. , xn ) , [ d1 , .. , dn ] , g_scope_list''''' , scope_list' , scope_list'' ) g_scope_list''''''' = scopes_to_retrieve ( funn' , func_map , b_func_map , g_scope_list'''' , g_scope_list'''''' ) ----------------------------------- :: comp2 - ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , [ ( funn , stmt_stack , scope_list ) ] ++ ( [ ( funn' , stmt_stack' , scope_list' ) ] ++ frame_list ) , Running ) -f-> ( ascope' , g_scope_list''''''' , [ ( funn' , stmt_stack' , scope_list''' ) ] ++ frame_list , Running ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ ( funn , stmt_stack , scope_list ) ] ++ ( [ ( funn' , stmt_stack' , scope_list' ) ] ++ frame_list ) , Running ) -f-> ( ascope' , g_scope_list''''''' , [ ( funn' , stmt_stack' , scope_list''' ) ] ++ frame_list , Running ) %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -3141,32 +3177,32 @@ by inp = ab_list [ i ] ( in_out_list'' , ascope' ) = input_f ( in_out_list , ascope ) ----------------------------------- :: in - ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , Running ) -'> ( ( i + 1 , in_out_list'' , in_out_list' , ascope' ) , g_scope_list , arch_frame_list_empty , Running ) + ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , Running ) -'> ( ( i + 1 , in_out_list'' , in_out_list' , ascope' ) , g_scope_list , arch_frame_list_empty , Running ) pbl f ( e1 , .. , en ) = ab_list [ i ] pbl_type [ ( x1 , d1 ) , .. , ( xn , dn ) ] b_func_map t_scope pars_map tbl_map = pblock_map ( f ) stmt = lookup_block_body ( f , b_func_map ) - scope' = copyin_pbl ( ( x1 , .. , xn ) , [ d1 , .. , dn ] , [ e1 , .. , en ] , ascope ) - scope'' = declare_list_in_scope ( t_scope , scope' ) + ( scope' , i_opt ) = copyin_pbl ( ( x1 , .. , xn ) , [ d1 , .. , dn ] , [ e1 , .. , en ] , ascope , random_oracle ) + ( scope'' , i_opt' ) = declare_list_in_scope ( t_scope , scope' , i_opt , get_oracle_index ascope , random_oracle ) g_scope_list' = lastn 1 g_scope_list g_scope_list'' = [ scope'' ] ++ g_scope_list' %Note that the below means that the var_star of globally-defined functions is redefined every time pbl_init is applied g_scope_list''' = initialise_var_stars func_map b_func_map ext_map g_scope_list'' ----------------------------------- :: pbl_init - ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , Running ) -'> ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list''' , [ ( f , [ stmt ] , [ empty ] ) ] , Running ) + ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , Running ) -'> ( ( i , in_out_list , in_out_list' , set_oracle_index i_opt' ascope ) , g_scope_list''' , [ ( f , [ stmt ] , [ empty ] ) ] , Running ) ffbl x = ab_list [ i ] ff = ffblock_map ( x ) ascope' = ff ( ascope ) ----------------------------------- :: ffbl - ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , Running ) -'> ( ( i + 1 , in_out_list , in_out_list' , ascope' ) , g_scope_list , arch_frame_list_empty , Running ) + ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , Running ) -'> ( ( i + 1 , in_out_list , in_out_list' , ascope' ) , g_scope_list , arch_frame_list_empty , Running ) %Note that this always sets index to 0. This could be done conditionally, if it would not be ideal %to have the final state have index 0. out = ab_list [ i ] ( in_out_list'' , ascope' ) = output_f ( in_out_list' , ascope ) ----------------------------------- :: out - ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , Running ) -'> ( ( 0 , in_out_list , in_out_list'' , ascope' ) , g_scope_list , arch_frame_list_empty , Running ) + ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list_empty , Running ) -'> ( ( 0 , in_out_list , in_out_list'' , ascope' ) , g_scope_list , arch_frame_list_empty , Running ) %TODO: This could be solved directly at statement level... This is essentially the old pars_state rule @@ -3175,13 +3211,13 @@ by not_final_state ( x' ) stmt' = pars_map ( x' ) ----------------------------------- :: parser_trans - ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , frame_list , Trans x' ) -'> ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list' , [ ( x' , [ stmt' ] , [ empty ] ) ] , Running ) + ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , frame_list , Trans x' ) -'> ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list' , [ ( x' , [ stmt' ] , [ empty ] ) ] , Running ) pbl x ( e1 , .. , em ) = ab_list [ i ] pbl_type [ ( x1 , d1 ) , .. , ( xn , dn ) ] b_func_map t_scope pars_map tbl_map = pblock_map ( x ) - ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , frame_list , Running ) -f-> ( ascope' , g_scope_list' , frame_list' , status' ) + ( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , frame_list , Running ) -f-> ( ascope' , g_scope_list' , frame_list' , status' ) ----------------------------------- :: pbl_exec - ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , frame_list , Running ) -'> ( ( i , in_out_list , in_out_list' , ascope' ) , g_scope_list' , frame_list' , status' ) + ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , frame_list , Running ) -'> ( ( i , in_out_list , in_out_list' , ascope' ) , g_scope_list' , frame_list' , status' ) %... until execution using the regular statement semantics has finished @@ -3197,7 +3233,7 @@ by ascope' = copyout_pbl ( g_scope_list , ascope , [ d1 , .. , dn ] , ( x1 , .. , xn ) , status' ) %TODO: Relax requirement that statement be empty in initial state? ----------------------------------- :: pbl_ret - ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , frame_list , status ) -'> ( ( i + 1 , in_out_list , in_out_list' , ascope' ) , lastn 1 g_scope_list , arch_frame_list_empty , Running ) + ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , frame_list , status ) -'> ( ( i + 1 , in_out_list , in_out_list' , ascope' ) , lastn 1 g_scope_list , arch_frame_list_empty , Running ) %TODO: What should happen when all input has been processed? % Separate judgment form? @@ -3220,11 +3256,11 @@ defn by - ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list , status ) -'> ( ( i'' , in_out_list'' , in_out_list''' , ascope' ) , g_scope_list'' , arch_frame_list'' , status'' ) + ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i , in_out_list , in_out_list' , ascope ) , g_scope_list , arch_frame_list , status ) -'> ( ( i'' , in_out_list'' , in_out_list''' , ascope' ) , g_scope_list'' , arch_frame_list'' , status'' ) ----------------------------------- :: conc1 - ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( in_out_list , in_out_list' , ascope ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i' , g_scope_list' , arch_frame_list' , status' ) ) ) --'> ( ( in_out_list'' , in_out_list''' , ascope' ) , ( ( i'' , g_scope_list'' , arch_frame_list'' , status'' ) , ( i' , g_scope_list' , arch_frame_list' , status' ) ) ) + ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( in_out_list , in_out_list' , ascope ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i' , g_scope_list' , arch_frame_list' , status' ) ) ) --'> ( ( in_out_list'' , in_out_list''' , ascope' ) , ( ( i'' , g_scope_list'' , arch_frame_list'' , status'' ) , ( i' , g_scope_list' , arch_frame_list' , status' ) ) ) - ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( i' , in_out_list , in_out_list' , ascope ) , g_scope_list' , arch_frame_list' , status' ) -'> ( ( i'' , in_out_list'' , in_out_list''' , ascope' ) , g_scope_list'' , arch_frame_list'' , status'' ) + ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( i' , in_out_list , in_out_list' , ascope ) , g_scope_list' , arch_frame_list' , status' ) -'> ( ( i'' , in_out_list'' , in_out_list''' , ascope' ) , g_scope_list'' , arch_frame_list'' , status'' ) ----------------------------------- :: conc2 - ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map ) ( ( in_out_list , in_out_list' , ascope ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i' , g_scope_list' , arch_frame_list' , status' ) ) ) --'> ( ( in_out_list'' , in_out_list''' , ascope' ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i'' , g_scope_list'' , arch_frame_list'' , status'' ) ) ) + ( ab_list , pblock_map , ffblock_map , input_f , output_f , copyin_pbl , copyout_pbl , apply_table_f , ext_map , func_map , get_oracle_index , set_oracle_index , random_oracle ) ( ( in_out_list , in_out_list' , ascope ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i' , g_scope_list' , arch_frame_list' , status' ) ) ) --'> ( ( in_out_list'' , in_out_list''' , ascope' ) , ( ( i , g_scope_list , arch_frame_list , status ) , ( i'' , g_scope_list'' , arch_frame_list'' , status'' ) ) ) diff --git a/ott/p4_types.ott b/ott/p4_types.ott index ea172cbb..11265fba 100644 --- a/ott/p4_types.ott +++ b/ott/p4_types.ott @@ -1366,7 +1366,39 @@ extern_MoE_typed ext_map t_scope_list_g delta_g delta_b delta_x ext_map -| order t_scope_list_g delta_g delta_b delta_x +defns +WT_ec :: '' ::= +defn + ectx -| order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n :: :: WT_ec :: WT_ec_ +{{ com expression-level context well typed }} +{{ tex [[ectx]] -| [[order]] [[t_scope_list_g]] [[delta_g]] [[delta_b]] [[delta_x]] [[delta_t]] [[Prs_n]] }} +by +% TODO: remove dom_tmap_ei ( delta_g , delta_b ) because the prop is satisfies in typying_domains_ei +% TODO: parser map has nothing to do with those semantics, shall we say that Prs_n is the domain or pars_map? ... + +WF_o order +length_is_2 ( t_scope_list_g ) +length_eq delta_b b_func_map +length_eq delta_t tbl_map +dom_map_ei ( func_map , b_func_map ) +dom_tmap_ei ( delta_g , delta_b ) +typying_domains_ei ( delta_g , delta_b , delta_x ) +dom_g_eq ( delta_g , func_map ) +dom_b_eq ( delta_b , b_func_map ) +dom_x_eq ( delta_x , ext_map ) +dom_t_eq ( delta_t , tbl_map ) +Fg_star_defined ( func_map , t_scope_list_g ) +Fb_star_defined ( b_func_map , t_scope_list_g ) +X_star_defined ( ext_map , t_scope_list_g ) +X_star_not_defined t_scope_list_g +func_map -| order t_scope_list_g delta_g delta_b delta_x Prs_n +b_func_map -| order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n +ext_map -| order t_scope_list_g delta_g delta_b delta_x +table_map_typed tbl_map apply_table_f delta_g delta_b order +f_in_apply_tbl tbl_map apply_table_f +--------------------------------------- :: c +( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , i , random_oracle ) -| order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n @@ -1402,7 +1434,7 @@ ext_map -| order t_scope_list_g delta_g delta_b delta_x table_map_typed tbl_map apply_table_f delta_g delta_b order f_in_apply_tbl tbl_map apply_table_f --------------------------------------- :: c -( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) -| order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n +( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) -| order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n @@ -1530,7 +1562,7 @@ ctx state Prs_n order ( t_scope_list_g , t_scopes_frames ) delta :: :: WT_state {{ com context well typed }} {{ tex WT [[ctx]] [[state]] [[Prs_n]] [[order]] [[t_scope_list_g]] [[t_scopes_frames]] [[delta]] }} by - + % We need type_scopes_list for globals because we need to know that the scopes are typed before we do the passing % we need type_state_tsll because it is easier for teh proof, @@ -1542,7 +1574,7 @@ type_scopes_list g_scope_list t_scope_list_g ctx -| order t_scope_list_g delta_g delta_b delta_x delta_t Prs_n ( g_scope_list , [ [ ( funn1 , stmt_stack1 , scope_list1 ) ] , .. , [ ( funnn , stmt_stackn , scope_listn ) ] ] , status ) -||| Prs_n order ( t_scope_list_g , [ t_scope_list1 , .. , t_scope_listn ] ) ( delta_g , delta_b , delta_x , delta_t ) func_map b_func_map ---------------------------------------------------------------------- :: state -( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map ) ( ascope , g_scope_list , [ [ ( funn1 , stmt_stack1 , scope_list1 ) ] , .. , [ ( funnn , stmt_stackn , scope_listn ) ] ] , status ) Prs_n order ( t_scope_list_g , [ t_scope_list1 , .. , t_scope_listn ] ) ( delta_g , delta_b , delta_x , delta_t ) +( apply_table_f , ext_map , func_map , b_func_map , pars_map , tbl_map , get_oracle_index , set_oracle_index , random_oracle ) ( ascope , g_scope_list , [ [ ( funn1 , stmt_stack1 , scope_list1 ) ] , .. , [ ( funnn , stmt_stackn , scope_listn ) ] ] , status ) Prs_n order ( t_scope_list_g , [ t_scope_list1 , .. , t_scope_listn ] ) ( delta_g , delta_b , delta_x , delta_t )