Commit aa571dab authored by Heiko Becker's avatar Heiko Becker

Fix translation

parent 13438299
Subproject commit 800745426c5c2ef2f5c5475c26640641dd222f04
Subproject commit daa2d5c014fffca8301ddca1a17592d13b452455
open preamble
open simpLib realTheory realLib RealArith stringTheory
open ml_translatorTheory ml_translatorLib cfTacticsLib basisProgTheory
open ml_translatorTheory ml_translatorLib cfTacticsLib basis basisProgTheory
open AbbrevsTheory ExpressionsTheory RealSimpsTheory ExpressionAbbrevsTheory
ErrorBoundsTheory IntervalArithTheory DaisyTactics IntervalValidationTheory
......@@ -65,12 +65,13 @@ val check_all_def = Define `
| _ => "Failure: Number of Functions in certificate\n"`;
val runChecker_def = Define `
runChecker (input:tvarN) =
let tokList = lex input in
case tokList of
runChecker (input:mlstring list) =
let inp = concat input in
let tokList = lex (explode inp) in
implode (case tokList of
(* FIRST: number of iterations, SECOND: number of functions *)
| DCONST n :: DCONST m :: tokRest => check_all m n tokRest
| _ => "failure no num of functions"`;
| _ => "failure no num of functions")`;
(* for recursive translation *)
......@@ -424,56 +425,108 @@ recInduct str_of_num_ind
\\ match_mp_tac LESS_TRANS
\\ qexists_tac `10 + 48` \\ fs []) |> update_precondition;
val res = translate runChecker_def;
val valid_runchecker_output_def = Define`
valid_runchecker_output file_contents output =
(runChecker file_contents = output)`;
(* Although we have defined valid_wordfreq_output as a relation between
file_contents and output, it is actually functional (there is only one correct
output). We prove this below: existence and uniqueness. *)
val valid_runchecker_output_exists = Q.store_thm("valid_runchecker_output_exists",
`output. valid_runchecker_output file_chars output`,
fs[valid_runchecker_output_def]);
val runchecker_output_spec_def =
new_specification("runchecker_output_spec_def",["runchecker_output_spec"],
GEN_ALL valid_runchecker_output_exists |> SIMP_RULE std_ss [SKOLEM_THM]);
(* -- I/O routines from here onwards -- *)
val main = process_topdecs`
fun main u =
write_list (runchecker (read_all []))`;
case TextIO.inputLinesFrom (List.hd (CommandLine.arguments()))
of SOME lines =>
TextIO.print (runchecker lines)`;
(* fun main u = *)
(* write_list (runchecker (read_all []))`; *)
val _ = append_prog main;
val res = ml_prog_update(ml_progLib.add_prog main I)
(* val res = ml_prog_update(ml_progLib.add_prog main I) *)
val st = get_ml_prog_state()
(* Specification of the runchecker function:
Running the checker on an input file inp appends the result of running
the function to STDOUT *)
val main_spec = Q.store_thm("main_spec",
`app (p:'ffi ffi_proj) ^(fetch_v "main" st)
[Conv NONE []] (STDOUT out * STDERR err * STDIN inp F)
(POSTv uv. &UNIT_TYPE () uv *
STDOUT (out ++ runChecker inp) *
STDERR err *
STDIN "" T)`,
`hasFreeFD fs inFS_fname fs (File fname)
cl = [pname; fname]
contents = lines_of (implode (THE (ALOOKUP fs.files (File fname)))) ==>
app (p:'ffi ffi_proj) ^(fetch_v "main" st)
[uv] (COMMANDLINE cl * STDIO fs)
(POSTv uv. &UNIT_TYPE () uv *
(STDIO (add_stdout fs (runchecker_output_spec contents))) * COMMANDLINE cl)`,
(* [Conv NONE []] (STDOUT out * STDERR err * STDIN inp F) *)
(* (POSTv uv. &UNIT_TYPE () uv * *)
(* STDOUT (out ++ runChecker inp) * *)
(* STDERR err * *)
(* STDIN "" T)`, *)
xcf "main" st
\\ qmatch_abbrev_tac`_ frame _`
\\ xlet`POSTv uv. &(LIST_TYPE CHAR [] uv) * frame`
\\ xlet_auto
>- (xcon \\ xsimpl \\ EVAL_TAC)
\\ qunabbrev_tac`frame`
\\ xlet`POSTv cv. &LIST_TYPE CHAR inp cv * STDERR err * STDIN "" T * STDOUT out`
>- (xapp \\ instantiate \\ xsimpl
\\ map_every qexists_tac[`STDERR err * STDOUT out`,`F`,`inp`]
\\ xlet_auto
>- (xsimpl \\ qexistsl_tac [`STDIO fs`, `cl`]
\\ xsimpl)
\\ qmatch_abbrev_tac`_ frame _`
\\ qmatch_goalsub_abbrev_tac`STRCAT _ res`
\\ xlet`POSTv xv. &LIST_TYPE CHAR res xv * frame`
\\ xlet_auto
>- (xsimpl)
\\ reverse(Cases_on`wfcl cl`)
>- (fs[COMMANDLINE_def] \\ xpull \\ rfs[])
\\ `FILENAME fname fnamev` by (fs[FILENAME_def,EVERY_MEM,wfcl_def,validArg_def])
\\ xlet`(POSTv sv. &OPTION_TYPE (LIST_TYPE STRING_TYPE)
(if inFS_fname fs (File fname) then SOME (all_lines fs (File fname))
else NONE) sv * STDIO fs *
COMMANDLINE [pname; fname])`
>- (xapp \\ instantiate \\ xsimpl)
\\ xapp \\ instantiate
\\ simp[Abbr`frame`]
\\ map_every qexists_tac[`STDERR err * STDIN "" T`,`out`]
\\ xmatch
\\ fs[OPTION_TYPE_def]
(* this part solves the validate_pat conjunct *)
\\ reverse conj_tac >- (EVAL_TAC \\ simp[])
\\ xlet_auto
>- (xsimpl)
\\ xapp \\ instantiate \\ xsimpl
\\ CONV_TAC(SWAP_EXISTS_CONV) \\ qexists_tac`fs` \\ xsimpl
\\ qmatch_abbrev_tac`STDIO (add_stdout _ xxxx) ==>> STDIO (add_stdout _ yyyy) * GC`
\\ `xxxx = yyyy` suffices_by xsimpl
(* now let us unabbreviate xxxx and yyyy *)
\\ map_every qunabbrev_tac[`xxxx`,`yyyy`] \\ simp[]
\\ assume_tac (REWRITE_RULE [valid_runchecker_output_def] runchecker_output_spec_def)
\\ fs[all_lines_def]);
val main_whole_prog_spec = Q.store_thm("main_whole_prog_spec",
`hasFreeFD fs /\ inFS_fname fs (File fname) /\
cl = [pname; fname] /\
contents = lines_of (implode (THE (ALOOKUP fs.files (File fname)))) ==>
whole_prog_spec ^(fetch_v "main" st) cl fs
((=) (add_stdout fs (runchecker_output_spec contents)))`,
disch_then assume_tac
\\ simp[whole_prog_spec_def]
\\ qmatch_goalsub_abbrev_tac`fs1 = _ with numchars := _`
\\ qexists_tac`fs1`
\\ simp[Abbr`fs1`,GSYM add_stdo_with_numchars,with_same_numchars]
\\ match_mp_tac (MP_CANON (MATCH_MP app_wgframe (UNDISCH main_spec)))
\\ xsimpl);
val spec = main_spec |> UNDISCH_ALL |> add_basis_proj;
val name = "main"
val (semantics_thm,prog_tm) = call_thm st name spec;
val (sem_thm,prog_tm) = whole_prog_thm (get_ml_prog_state ()) "main" (UNDISCH main_whole_prog_spec);
val entire_program_def = Define`entire_program = ^prog_tm`;
val main_prog_def = Define `main_prog = ^prog_tm`;
val semantics_entire_program =
semantics_thm
|> PURE_ONCE_REWRITE_RULE[GSYM entire_program_def]
|> REWRITE_RULE [APPEND]
|> CONV_RULE(RENAME_VARS_CONV["io_events"])
|> DISCH_ALL |> GEN_ALL
|> CONV_RULE(RENAME_VARS_CONV["inp","cls"])
|> curry save_thm "semantics_entire_program";
val main_semantics =
sem_thm |> ONCE_REWRITE_RULE[GSYM main_prog_def]
|> DISCH_ALL |> Q.GENL[`cl`,`contents`]
|> SIMP_RULE(srw_ss())[AND_IMP_INTRO,GSYM CONJ_ASSOC]
|> curry save_thm "main_semantics";
val _ = export_theory();
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment