src/HOL/Tools/SMT/z3_interface.ML
changeset 69593 3dda49e08b9d
parent 66551 4df6b0ae900d
child 69597 ff784d5a5bfb
equal deleted inserted replaced
69592:a80d8ec6c998 69593:3dda49e08b9d
   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