src/HOL/Tools/SMT2/smt2_translate.ML
changeset 57541 147e3f1e0459
parent 57540 10e7aabe1762
--- a/src/HOL/Tools/SMT2/smt2_translate.ML	Thu Jul 10 17:01:23 2014 +0200
+++ b/src/HOL/Tools/SMT2/smt2_translate.ML	Thu Jul 10 18:08:21 2014 +0200
@@ -29,6 +29,7 @@
     context: Proof.context,
     typs: typ Symtab.table,
     terms: term Symtab.table,
+    ll_defs: term list,
     rewrite_rules: thm list,
     assms: (int * thm) list }
 
@@ -72,6 +73,7 @@
   context: Proof.context,
   typs: typ Symtab.table,
   terms: term Symtab.table,
+  ll_defs: term list,
   rewrite_rules: thm list,
   assms: (int * thm) list }
 
@@ -118,7 +120,7 @@
   dtyps = dtyps,
   funcs = Termtab.fold (fn (_, (n, SOME ss)) => cons (n,ss) | _ => I) terms []}
 
-fun replay_data_of ctxt rules assms (_, typs, terms) =
+fun replay_data_of ctxt ll_defs rules assms (_, typs, terms) =
   let
     fun add_typ (T, (n, _)) = Symtab.update (n, T)
     val typs' = Typtab.fold add_typ typs Symtab.empty
@@ -126,7 +128,8 @@
     fun add_fun (t, (n, _)) = Symtab.update (n, t)
     val terms' = Termtab.fold add_fun terms Symtab.empty
   in
-    {context=ctxt, typs=typs', terms=terms', rewrite_rules=rules, assms=assms}
+    {context = ctxt, typs = typs', terms = terms', ll_defs = ll_defs, rewrite_rules = rules,
+     assms = assms}
   end
 
 
@@ -499,15 +502,13 @@
           |> (fn t => @{const trigger} $ t $ eq)
       | mk_trigger t = t
 
-    val (ctxt2, ts3) =
+    val (ctxt2, (ts3, ll_defs)) =
       ts2
       |> eta_expand ctxt1 funcs
       |> rpair ctxt1
       |-> Lambda_Lifting.lift_lambdas NONE is_binder
-      |-> (fn (ts', defs) => fn ctxt' =>
-          ts' @ map mk_trigger defs
-          |> intro_explicit_application ctxt' funcs
-          |> pair ctxt')
+      |-> (fn (ts', ll_defs) => fn ctxt' =>
+          (ctxt', (intro_explicit_application ctxt' funcs (map mk_trigger ll_defs @ ts'), ll_defs)))
 
     val ((rewrite_rules, builtin), ts4) = folify ctxt2 ts3
       |>> apfst (cons fun_app_eq)
@@ -515,7 +516,7 @@
     (ts4, tr_context)
     |-> intermediate logic dtyps (builtin SMT2_Builtin.dest_builtin) ctxt2
     |>> uncurry (serialize smt_options comments)
-    ||> replay_data_of ctxt2 rewrite_rules ithms
+    ||> replay_data_of ctxt2 ll_defs rewrite_rules ithms
   end
 
 end;