| @@ -26,6 +26,9 @@ fun lookup :: "string \<Rightarrow> string list \<Rightarrow> nat option" where |
| 26 | 26 | "lookup name [] = None" |
| 27 | 27 | | "lookup name (x # xs) = (if name = x then Some 0 else map_option Suc (lookup name xs))" |
| 28 | 28 | |
| 29 | +lemma lookup_bound: "lookup name names = Some i \<Longrightarrow> i < length names" |
| 30 | + by (induction names arbitrary: i) (auto split: if_splits option.splits) |
| 31 | + |
| 29 | 32 | fun operator :: "string \<Rightarrow> operator option" where |
| 30 | 33 | "operator s = (if s = ''+'' then Some Add else if s = ''-'' then Some Sub else if s = ''*'' then Some Mul |
| 31 | 34 | else if s = ''and'' then Some And else if s = ''or'' then Some Or else if s = ''xor'' then Some Xor |
| @@ -36,10 +39,16 @@ definition atom :: "string list \<Rightarrow> string \<Rightarrow> expression op |
| 36 | 39 | if s = ''x'' then Some (Input X) else if s = ''y'' then Some (Input Y) else if s = ''t'' then Some (Input T) |
| 37 | 40 | else map_option (Literal \<circ> word_of_nat) (number s))" |
| 38 | 41 | |
| 42 | +lemma atom_scoped: "atom names s = Some e \<Longrightarrow> scoped (length names) e" |
| 43 | + by (auto simp: atom_def split: option.splits if_splits dest: lookup_bound) |
| 44 | + |
| 39 | 45 | fun close :: "expression \<Rightarrow> string list \<Rightarrow> (expression \<times> string list) option" where |
| 40 | 46 | "close e (s # rest) = (if s = '')'' then Some (e,rest) else None)" |
| 41 | 47 | | "close e [] = None" |
| 42 | 48 | |
| 49 | +lemma close_expression: "close e tokens = Some (a,rest) \<Longrightarrow> a = e" |
| 50 | + by (cases tokens) (auto split: if_splits) |
| 51 | + |
| 43 | 52 | function parse :: "nat \<Rightarrow> string list \<Rightarrow> string list \<Rightarrow> (expression \<times> string list) option" where |
| 44 | 53 | "parse fuel names tokens = (if fuel = 0 then None else case tokens of [] \<Rightarrow> None | s # rest \<Rightarrow> |
| 45 | 54 | if s \<noteq> ''('' then map_option (\<lambda>e. (e,rest)) (atom names s) |
| @@ -58,20 +67,35 @@ function parse :: "nat \<Rightarrow> string list \<Rightarrow> string list \<Rig |
| 58 | 67 | by pat_completeness auto |
| 59 | 68 | termination by (relation "measure (\<lambda>(fuel,names,tokens). fuel)") auto |
| 60 | 69 | |
| 70 | +declare parse.simps [simp del] |
| 71 | + |
| 72 | +theorem parse_scoped: |
| 73 | + "parse fuel names tokens = Some (e,rest) \<Longrightarrow> scoped (length names) e" |
| 74 | +proof (induction fuel arbitrary: names tokens e rest) |
| 75 | + case 0 |
| 76 | + then show ?case by (subst (asm) parse.simps) auto |
| 77 | +next |
| 78 | + case (Suc fuel) |
| 79 | + from Suc.prems show ?case |
| 80 | + by (subst (asm) parse.simps) |
| 81 | + (auto simp del: operator.simps dest: atom_scoped split: list.splits if_splits bind_splits option.splits prod.splits; |
| 82 | + drule close_expression; auto dest: Suc.IH) |
| 83 | +qed |
| 84 | + |
| 61 | 85 | definition prepare :: "string \<Rightarrow> expression option" where |
| 62 | 86 | "prepare s = (if \<not> list_all (\<lambda>c. nat_of_char c < 128) s then None else |
| 63 | 87 | Option.bind (parse 128 [] (lex s [] [])) (\<lambda>(e,rest). |
| 64 | | - if rest = [] \<and> scoped 0 e \<and> nodes e \<le> 4096 then |
| 88 | + if rest = [] \<and> nodes e \<le> 4096 then |
| 65 | 89 | let code = compile (optimise e) [] in |
| 66 | 90 | if check code 0 = Some 1 \<and> demand (optimise e) \<le> 512 \<and> list_all encodable (native code) |
| 67 | 91 | then Some e else None else None))" |
| 68 | 92 | |
| 69 | 93 | lemma prepare_scoped: "prepare s = Some e \<Longrightarrow> scoped 0 e" |
| 70 | | - by (auto simp: prepare_def Let_def split: if_splits bind_splits prod.splits) |
| 94 | + by (auto simp: prepare_def Let_def dest: parse_scoped split: if_splits bind_splits prod.splits) |
| 71 | 95 | |
| 72 | 96 | lemma prepare_bounded: |
| 73 | 97 | "prepare s = Some e \<Longrightarrow> bounded 512 (compile (optimise e) []) 0" |
| 74 | | - by (auto simp: prepare_def Let_def closed_demand optimise_scoped split: if_splits bind_splits prod.splits) |
| 98 | + by (auto simp: prepare_def Let_def closed_demand optimise_scoped dest: parse_scoped split: if_splits bind_splits prod.splits) |
| 75 | 99 | |
| 76 | 100 | lemma prepare_encodable: |
| 77 | 101 | "prepare s = Some e \<Longrightarrow> list_all encodable (native (compile (optimise e) []))" |