104 fun get_mk_builtins ctxt = map snd (Mk_Builtins.get (Context.Proof ctxt)) |
104 fun get_mk_builtins ctxt = map snd (Mk_Builtins.get (Context.Proof ctxt)) |
105 |
105 |
106 |
106 |
107 (** basic and additional constructors **) |
107 (** basic and additional constructors **) |
108 |
108 |
109 fun mk_builtin_typ _ (Sym ("Bool", _)) = SOME @{typ bool} |
109 fun mk_builtin_typ _ (Sym ("Bool", _)) = SOME \<^typ>\<open>bool\<close> |
110 | mk_builtin_typ _ (Sym ("Int", _)) = SOME @{typ int} |
110 | mk_builtin_typ _ (Sym ("Int", _)) = SOME \<^typ>\<open>int\<close> |
111 | mk_builtin_typ _ (Sym ("bool", _)) = SOME @{typ bool} (*FIXME: legacy*) |
111 | mk_builtin_typ _ (Sym ("bool", _)) = SOME \<^typ>\<open>bool\<close> (*FIXME: legacy*) |
112 | mk_builtin_typ _ (Sym ("int", _)) = SOME @{typ int} (*FIXME: legacy*) |
112 | mk_builtin_typ _ (Sym ("int", _)) = SOME \<^typ>\<open>int\<close> (*FIXME: legacy*) |
113 | mk_builtin_typ ctxt sym = chained_mk_builtin_typ (get_mk_builtins ctxt) sym |
113 | mk_builtin_typ ctxt sym = chained_mk_builtin_typ (get_mk_builtins ctxt) sym |
114 |
114 |
115 fun mk_builtin_num _ i @{typ int} = SOME (Numeral.mk_cnumber @{ctyp int} i) |
115 fun mk_builtin_num _ i \<^typ>\<open>int\<close> = SOME (Numeral.mk_cnumber \<^ctyp>\<open>int\<close> i) |
116 | mk_builtin_num ctxt i T = |
116 | mk_builtin_num ctxt i T = |
117 chained_mk_builtin_num ctxt (get_mk_builtins ctxt) i T |
117 chained_mk_builtin_num ctxt (get_mk_builtins ctxt) i T |
118 |
118 |
119 val mk_true = Thm.cterm_of @{context} (@{const Not} $ @{const False}) |
119 val mk_true = Thm.cterm_of \<^context> (@{const Not} $ @{const False}) |
120 val mk_false = Thm.cterm_of @{context} @{const False} |
120 val mk_false = Thm.cterm_of \<^context> @{const False} |
121 val mk_not = Thm.apply (Thm.cterm_of @{context} @{const Not}) |
121 val mk_not = Thm.apply (Thm.cterm_of \<^context> @{const Not}) |
122 val mk_implies = Thm.mk_binop (Thm.cterm_of @{context} @{const HOL.implies}) |
122 val mk_implies = Thm.mk_binop (Thm.cterm_of \<^context> @{const HOL.implies}) |
123 val mk_iff = Thm.mk_binop (Thm.cterm_of @{context} @{const HOL.eq (bool)}) |
123 val mk_iff = Thm.mk_binop (Thm.cterm_of \<^context> @{const HOL.eq (bool)}) |
124 val conj = Thm.cterm_of @{context} @{const HOL.conj} |
124 val conj = Thm.cterm_of \<^context> @{const HOL.conj} |
125 val disj = Thm.cterm_of @{context} @{const HOL.disj} |
125 val disj = Thm.cterm_of \<^context> @{const HOL.disj} |
126 |
126 |
127 fun mk_nary _ cu [] = cu |
127 fun mk_nary _ cu [] = cu |
128 | mk_nary ct _ cts = uncurry (fold_rev (Thm.mk_binop ct)) (split_last cts) |
128 | mk_nary ct _ cts = uncurry (fold_rev (Thm.mk_binop ct)) (split_last cts) |
129 |
129 |
130 val eq = SMT_Util.mk_const_pat @{theory} @{const_name HOL.eq} SMT_Util.destT1 |
130 val eq = SMT_Util.mk_const_pat \<^theory> \<^const_name>\<open>HOL.eq\<close> SMT_Util.destT1 |
131 fun mk_eq ct cu = Thm.mk_binop (SMT_Util.instT' ct eq) ct cu |
131 fun mk_eq ct cu = Thm.mk_binop (SMT_Util.instT' ct eq) ct cu |
132 |
132 |
133 val if_term = |
133 val if_term = |
134 SMT_Util.mk_const_pat @{theory} @{const_name If} (SMT_Util.destT1 o SMT_Util.destT2) |
134 SMT_Util.mk_const_pat \<^theory> \<^const_name>\<open>If\<close> (SMT_Util.destT1 o SMT_Util.destT2) |
135 fun mk_if cc ct = Thm.mk_binop (Thm.apply (SMT_Util.instT' ct if_term) cc) ct |
135 fun mk_if cc ct = Thm.mk_binop (Thm.apply (SMT_Util.instT' ct if_term) cc) ct |
136 |
136 |
137 val access = SMT_Util.mk_const_pat @{theory} @{const_name fun_app} SMT_Util.destT1 |
137 val access = SMT_Util.mk_const_pat \<^theory> \<^const_name>\<open>fun_app\<close> SMT_Util.destT1 |
138 fun mk_access array = Thm.apply (SMT_Util.instT' array access) array |
138 fun mk_access array = Thm.apply (SMT_Util.instT' array access) array |
139 |
139 |
140 val update = |
140 val update = |
141 SMT_Util.mk_const_pat @{theory} @{const_name fun_upd} (Thm.dest_ctyp o SMT_Util.destT1) |
141 SMT_Util.mk_const_pat \<^theory> \<^const_name>\<open>fun_upd\<close> (Thm.dest_ctyp o SMT_Util.destT1) |
142 fun mk_update array index value = |
142 fun mk_update array index value = |
143 let val cTs = Thm.dest_ctyp (Thm.ctyp_of_cterm array) |
143 let val cTs = Thm.dest_ctyp (Thm.ctyp_of_cterm array) |
144 in Thm.apply (Thm.mk_binop (SMT_Util.instTs cTs update) array index) value end |
144 in Thm.apply (Thm.mk_binop (SMT_Util.instTs cTs update) array index) value end |
145 |
145 |
146 val mk_uminus = Thm.apply (Thm.cterm_of @{context} @{const uminus (int)}) |
146 val mk_uminus = Thm.apply (Thm.cterm_of \<^context> @{const uminus (int)}) |
147 val add = Thm.cterm_of @{context} @{const plus (int)} |
147 val add = Thm.cterm_of \<^context> @{const plus (int)} |
148 val int0 = Numeral.mk_cnumber @{ctyp int} 0 |
148 val int0 = Numeral.mk_cnumber \<^ctyp>\<open>int\<close> 0 |
149 val mk_sub = Thm.mk_binop (Thm.cterm_of @{context} @{const minus (int)}) |
149 val mk_sub = Thm.mk_binop (Thm.cterm_of \<^context> @{const minus (int)}) |
150 val mk_mul = Thm.mk_binop (Thm.cterm_of @{context} @{const times (int)}) |
150 val mk_mul = Thm.mk_binop (Thm.cterm_of \<^context> @{const times (int)}) |
151 val mk_div = Thm.mk_binop (Thm.cterm_of @{context} @{const z3div}) |
151 val mk_div = Thm.mk_binop (Thm.cterm_of \<^context> @{const z3div}) |
152 val mk_mod = Thm.mk_binop (Thm.cterm_of @{context} @{const z3mod}) |
152 val mk_mod = Thm.mk_binop (Thm.cterm_of \<^context> @{const z3mod}) |
153 val mk_lt = Thm.mk_binop (Thm.cterm_of @{context} @{const less (int)}) |
153 val mk_lt = Thm.mk_binop (Thm.cterm_of \<^context> @{const less (int)}) |
154 val mk_le = Thm.mk_binop (Thm.cterm_of @{context} @{const less_eq (int)}) |
154 val mk_le = Thm.mk_binop (Thm.cterm_of \<^context> @{const less_eq (int)}) |
155 |
155 |
156 fun mk_builtin_fun ctxt sym cts = |
156 fun mk_builtin_fun ctxt sym cts = |
157 (case (sym, cts) of |
157 (case (sym, cts) of |
158 (Sym ("true", _), []) => SOME mk_true |
158 (Sym ("true", _), []) => SOME mk_true |
159 | (Sym ("false", _), []) => SOME mk_false |
159 | (Sym ("false", _), []) => SOME mk_false |
169 | (Sym ("=", _), [ct, cu]) => SOME (mk_eq ct cu) |
169 | (Sym ("=", _), [ct, cu]) => SOME (mk_eq ct cu) |
170 | (Sym ("select", _), [ca, ck]) => SOME (Thm.apply (mk_access ca) ck) |
170 | (Sym ("select", _), [ca, ck]) => SOME (Thm.apply (mk_access ca) ck) |
171 | (Sym ("store", _), [ca, ck, cv]) => SOME (mk_update ca ck cv) |
171 | (Sym ("store", _), [ca, ck, cv]) => SOME (mk_update ca ck cv) |
172 | _ => |
172 | _ => |
173 (case (sym, try (Thm.typ_of_cterm o hd) cts, cts) of |
173 (case (sym, try (Thm.typ_of_cterm o hd) cts, cts) of |
174 (Sym ("+", _), SOME @{typ int}, _) => SOME (mk_nary add int0 cts) |
174 (Sym ("+", _), SOME \<^typ>\<open>int\<close>, _) => SOME (mk_nary add int0 cts) |
175 | (Sym ("-", _), SOME @{typ int}, [ct]) => SOME (mk_uminus ct) |
175 | (Sym ("-", _), SOME \<^typ>\<open>int\<close>, [ct]) => SOME (mk_uminus ct) |
176 | (Sym ("-", _), SOME @{typ int}, [ct, cu]) => SOME (mk_sub ct cu) |
176 | (Sym ("-", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_sub ct cu) |
177 | (Sym ("*", _), SOME @{typ int}, [ct, cu]) => SOME (mk_mul ct cu) |
177 | (Sym ("*", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_mul ct cu) |
178 | (Sym ("div", _), SOME @{typ int}, [ct, cu]) => SOME (mk_div ct cu) |
178 | (Sym ("div", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_div ct cu) |
179 | (Sym ("mod", _), SOME @{typ int}, [ct, cu]) => SOME (mk_mod ct cu) |
179 | (Sym ("mod", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_mod ct cu) |
180 | (Sym ("<", _), SOME @{typ int}, [ct, cu]) => SOME (mk_lt ct cu) |
180 | (Sym ("<", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_lt ct cu) |
181 | (Sym ("<=", _), SOME @{typ int}, [ct, cu]) => SOME (mk_le ct cu) |
181 | (Sym ("<=", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_le ct cu) |
182 | (Sym (">", _), SOME @{typ int}, [ct, cu]) => SOME (mk_lt cu ct) |
182 | (Sym (">", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_lt cu ct) |
183 | (Sym (">=", _), SOME @{typ int}, [ct, cu]) => SOME (mk_le cu ct) |
183 | (Sym (">=", _), SOME \<^typ>\<open>int\<close>, [ct, cu]) => SOME (mk_le cu ct) |
184 | _ => chained_mk_builtin_fun ctxt (get_mk_builtins ctxt) sym cts)) |
184 | _ => chained_mk_builtin_fun ctxt (get_mk_builtins ctxt) sym cts)) |
185 |
185 |
186 |
186 |
187 (* abstraction *) |
187 (* abstraction *) |
188 |
188 |