diff -r 24ec32bee347 -r a6dc1769fdda src/HOL/IMP/Compiler.thy --- a/src/HOL/IMP/Compiler.thy Wed Jun 25 21:25:51 2008 +0200 +++ b/src/HOL/IMP/Compiler.thy Wed Jun 25 22:01:34 2008 +0200 @@ -8,16 +8,16 @@ subsection "The compiler" -consts compile :: "com \ instr list" -primrec -"compile \ = []" -"compile (x:==a) = [SET x a]" -"compile (c1;c2) = compile c1 @ compile c2" -"compile (\ b \ c1 \ c2) = - [JMPF b (length(compile c1) + 1)] @ compile c1 @ - [JMPF (\x. False) (length(compile c2))] @ compile c2" -"compile (\ b \ c) = [JMPF b (length(compile c) + 1)] @ compile c @ - [JMPB (length(compile c)+1)]" +primrec compile :: "com \ instr list" +where + "compile \ = []" +| "compile (x:==a) = [SET x a]" +| "compile (c1;c2) = compile c1 @ compile c2" +| "compile (\ b \ c1 \ c2) = + [JMPF b (length(compile c1) + 1)] @ compile c1 @ + [JMPF (\x. False) (length(compile c2))] @ compile c2" +| "compile (\ b \ c) = [JMPF b (length(compile c) + 1)] @ compile c @ + [JMPB (length(compile c)+1)]" subsection "Compiler correctness" @@ -65,31 +65,33 @@ lemma [simp]: "(\[],q,s\ -*\ \p',q',t\) = (p' = [] \ q' = q \ t = s)" by(simp add: rtrancl_is_UN_rel_pow) -constdefs - forws :: "instr \ nat set" -"forws instr == case instr of - SET x a \ {0} | - JMPF b n \ {0,n} | - JMPB n \ {}" - backws :: "instr \ nat set" -"backws instr == case instr of - SET x a \ {} | - JMPF b n \ {} | - JMPB n \ {n}" +definition + forws :: "instr \ nat set" where + "forws instr = (case instr of + SET x a \ {0} | + JMPF b n \ {0,n} | + JMPB n \ {})" -consts closed :: "nat \ nat \ instr list \ bool" -primrec -"closed m n [] = True" -"closed m n (instr#is) = ((\j \ forws instr. j \ size is+n) \ - (\j \ backws instr. j \ m) \ closed (Suc m) n is)" +definition + backws :: "instr \ nat set" where + "backws instr = (case instr of + SET x a \ {} | + JMPF b n \ {} | + JMPB n \ {n})" + +primrec closed :: "nat \ nat \ instr list \ bool" +where + "closed m n [] = True" +| "closed m n (instr#is) = ((\j \ forws instr. j \ size is+n) \ + (\j \ backws instr. j \ m) \ closed (Suc m) n is)" lemma [simp]: "\m n. closed m n (C1@C2) = (closed m (n+size C2) C1 \ closed (m+size C1) n C2)" -by(induct C1, simp, simp add:add_ac) +by(induct C1) (simp, simp add:add_ac) theorem [simp]: "\m n. closed m n (compile c)" -by(induct c, simp_all add:backws_def forws_def) +by(induct c) (simp_all add:backws_def forws_def) lemma drop_lem: "n \ size(p1@p2) \ (p1' @ p2 = drop n p1 @ drop (n - size p1) p2) =