correctly unfold applied 'let's (e.g. '(let x = a in f) b') -- and removed dead code
authorblanchet
Tue, 20 Jun 2017 14:33:45 +0200
changeset 66134 a1fb6beb2731
parent 66133 0b635a6774fb
child 66135 1451a32479ba
correctly unfold applied 'let's (e.g. '(let x = a in f) b') -- and removed dead code
src/HOL/Tools/SMT/smt_translate.ML
src/HOL/Tools/SMT/smtlib_interface.ML
--- a/src/HOL/Tools/SMT/smt_translate.ML	Tue Jun 20 08:01:56 2017 +0200
+++ b/src/HOL/Tools/SMT/smt_translate.ML	Tue Jun 20 14:33:45 2017 +0200
@@ -12,7 +12,6 @@
   datatype sterm =
     SVar of int |
     SApp of string * sterm list |
-    SLet of string * sterm * sterm |
     SQua of squant * string list * sterm spattern list * sterm
 
   (*translation configuration*)
@@ -47,12 +46,12 @@
 
 datatype squant = SForall | SExists
 
-datatype 'a spattern = SPat of 'a list | SNoPat of 'a list
+datatype 'a spattern =
+  SPat of 'a list | SNoPat of 'a list
 
 datatype sterm =
   SVar of int |
   SApp of string * sterm list |
-  SLet of string * sterm * sterm |
   SQua of squant * string list * sterm spattern list * sterm
 
 
@@ -204,7 +203,6 @@
       | expand ((q as Const (@{const_name Ex}, _)) $ Abs a) = q $ abs_expand a
       | expand ((q as Const (@{const_name Ex}, T)) $ t) = q $ exp expand T t
       | expand (q as Const (@{const_name Ex}, T)) = exp2 T q
-      | expand (Const (@{const_name Let}, _) $ t $ u) = expand (Term.betapply (u, t))
       | expand (Const (@{const_name Let}, T) $ t) =
           let val U = Term.domain_type (Term.range_type T)
           in Abs (Name.uu, U, Bound 0 $ Term.incr_boundvars 1 t) end
@@ -213,7 +211,9 @@
           in Abs (Name.uu, Term.domain_type T, Abs (Name.uu, U, Bound 0 $ Bound 1)) end
       | expand t =
           (case Term.strip_comb t of
-            (u as Const (c as (_, T)), ts) =>
+            (Const (@{const_name Let}, _), t1 :: t2 :: ts) =>
+            betapplys (Term.betapply (expand t2, expand t1), map expand ts)
+          | (u as Const (c as (_, T)), ts) =>
               (case SMT_Builtin.dest_builtin ctxt c ts of
                 SOME (_, k, us, mk) =>
                   if k = length us then mk (map expand us)
@@ -438,8 +438,6 @@
               fold_map transT Ts ##>> fold_map (fold_map_pat trans) ps ##>>
               trans b #>> (fn ((Ts', ps'), b') => SQua (q, Ts', ps', b'))
           | NONE => raise TERM ("unsupported quantifier", [t]))
-      | (Const (@{const_name Let}, _), [t1, Abs (_, T, t2)]) =>
-          transT T ##>> trans t1 ##>> trans t2 #>> (fn ((U, u1), u2) => SLet (U, u1, u2))
       | (u as Const (c as (_, T)), ts) =>
           (case builtin ctxt c ts of
             SOME (n, _, us, _) => fold_map trans us #>> app n
@@ -516,7 +514,6 @@
 
     val ((rewrite_rules, builtin), ts4) = folify ctxt2 ts3
       |>> apfst (cons fun_app_eq)
-val _ = dtyps : (BNF_Util.fp_kind * (string * (string * (string * string) list) list)) list (*###*)
   in
     (ts4, tr_context)
     |-> intermediate logic dtyps (builtin SMT_Builtin.dest_builtin) ctxt2
--- a/src/HOL/Tools/SMT/smtlib_interface.ML	Tue Jun 20 08:01:56 2017 +0200
+++ b/src/HOL/Tools/SMT/smtlib_interface.ML	Tue Jun 20 14:33:45 2017 +0200
@@ -94,8 +94,6 @@
   | tree_of_sterm _ (SMT_Translate.SApp (n, [])) = SMTLIB.Sym n
   | tree_of_sterm l (SMT_Translate.SApp (n, ts)) =
       SMTLIB.S (SMTLIB.Sym n :: map (tree_of_sterm l) ts)
-  | tree_of_sterm _ (SMT_Translate.SLet _) =
-      raise Fail "SMT-LIB: unsupported let expression"
   | tree_of_sterm l (SMT_Translate.SQua (q, ss, pats, t)) =
       let
         val l' = l + length ss