src/Provers/quantifier1.ML
changeset 42457 de868abd131e
parent 42456 13b4b6ba3593
child 42458 5dfae6d348fd
equal deleted inserted replaced
42456:13b4b6ba3593 42457:de868abd131e
    74 end;
    74 end;
    75 
    75 
    76 functor Quantifier1Fun(Data: QUANTIFIER1_DATA): QUANTIFIER1 =
    76 functor Quantifier1Fun(Data: QUANTIFIER1_DATA): QUANTIFIER1 =
    77 struct
    77 struct
    78 
    78 
    79 open Data;
       
    80 
       
    81 (* FIXME: only test! *)
    79 (* FIXME: only test! *)
    82 fun def xs eq =
    80 fun def xs eq =
    83   (case dest_eq eq of
    81   (case Data.dest_eq eq of
    84      SOME(c,s,t) =>
    82      SOME(c,s,t) =>
    85        let val n = length xs
    83        let val n = length xs
    86        in s = Bound n andalso not(loose_bvar1(t,n)) orelse
    84        in s = Bound n andalso not(loose_bvar1(t,n)) orelse
    87           t = Bound n andalso not(loose_bvar1(s,n)) end
    85           t = Bound n andalso not(loose_bvar1(s,n)) end
    88    | NONE => false);
    86    | NONE => false);
    89 
    87 
    90 fun extract_conj fst xs t = case dest_conj t of NONE => NONE
    88 fun extract_conj fst xs t = case Data.dest_conj t of NONE => NONE
    91     | SOME(conj,P,Q) =>
    89     | SOME(conj,P,Q) =>
    92         (if def xs P then (if fst then NONE else SOME(xs,P,Q)) else
    90         (if def xs P then (if fst then NONE else SOME(xs,P,Q)) else
    93          if def xs Q then SOME(xs,Q,P) else
    91          if def xs Q then SOME(xs,Q,P) else
    94          (case extract_conj false xs P of
    92          (case extract_conj false xs P of
    95             SOME(xs,eq,P') => SOME(xs,eq, conj $ P' $ Q)
    93             SOME(xs,eq,P') => SOME(xs,eq, Data.conj $ P' $ Q)
    96           | NONE => (case extract_conj false xs Q of
    94           | NONE => (case extract_conj false xs Q of
    97                        SOME(xs,eq,Q') => SOME(xs,eq,conj $ P $ Q')
    95                        SOME(xs,eq,Q') => SOME(xs,eq,Data.conj $ P $ Q')
    98                      | NONE => NONE)));
    96                      | NONE => NONE)));
    99 
    97 
   100 fun extract_imp fst xs t = case dest_imp t of NONE => NONE
    98 fun extract_imp fst xs t = case Data.dest_imp t of NONE => NONE
   101     | SOME(imp,P,Q) => if def xs P then (if fst then NONE else SOME(xs,P,Q))
    99     | SOME(imp,P,Q) => if def xs P then (if fst then NONE else SOME(xs,P,Q))
   102                        else (case extract_conj false xs P of
   100                        else (case extract_conj false xs P of
   103                                SOME(xs,eq,P') => SOME(xs, eq, imp $ P' $ Q)
   101                                SOME(xs,eq,P') => SOME(xs, eq, Data.imp $ P' $ Q)
   104                              | NONE => (case extract_imp false xs Q of
   102                              | NONE => (case extract_imp false xs Q of
   105                                           NONE => NONE
   103                                           NONE => NONE
   106                                         | SOME(xs,eq,Q') =>
   104                                         | SOME(xs,eq,Q') =>
   107                                             SOME(xs,eq,imp$P$Q')));
   105                                             SOME(xs,eq,Data.imp$P$Q')));
   108 
   106 
   109 fun extract_quant extract q =
   107 fun extract_quant extract q =
   110   let fun exqu xs ((qC as Const(qa,_)) $ Abs(x,T,Q)) =
   108   let fun exqu xs ((qC as Const(qa,_)) $ Abs(x,T,Q)) =
   111             if qa = q then exqu ((qC,x,T)::xs) Q else NONE
   109             if qa = q then exqu ((qC,x,T)::xs) Q else NONE
   112         | exqu xs P = extract (null xs) xs P
   110         | exqu xs P = extract (null xs) xs P
   116   let
   114   let
   117     val ctxt = Simplifier.the_context ss;
   115     val ctxt = Simplifier.the_context ss;
   118     val (goal, ctxt') =
   116     val (goal, ctxt') =
   119       yield_singleton (Variable.import_terms true) (Logic.mk_equals tu) ctxt;
   117       yield_singleton (Variable.import_terms true) (Logic.mk_equals tu) ctxt;
   120     val thm =
   118     val thm =
   121       Goal.prove ctxt' [] [] goal (K (rtac iff_reflection 1 THEN tac));
   119       Goal.prove ctxt' [] [] goal (K (rtac Data.iff_reflection 1 THEN tac));
   122   in singleton (Variable.export ctxt' ctxt) thm end;
   120   in singleton (Variable.export ctxt' ctxt) thm end;
   123 
   121 
   124 fun qcomm_tac qcomm qI i = REPEAT_DETERM (rtac qcomm i THEN rtac qI i) 
   122 fun qcomm_tac qcomm qI i = REPEAT_DETERM (rtac qcomm i THEN rtac qI i) 
   125 
   123 
   126 (* Proves (? x0..xn. ... & x0 = t & ...) = (? x1..xn x0. x0 = t & ... & ...)
   124 (* Proves (? x0..xn. ... & x0 = t & ...) = (? x1..xn x0. x0 = t & ... & ...)
   127    Better: instantiate exI
   125    Better: instantiate exI
   128 *)
   126 *)
   129 local
   127 local
   130 val excomm = ex_comm RS iff_trans
   128 val excomm = Data.ex_comm RS Data.iff_trans
   131 in
   129 in
   132 val prove_one_point_ex_tac = qcomm_tac excomm iff_exI 1 THEN rtac iffI 1 THEN
   130 val prove_one_point_ex_tac = qcomm_tac excomm Data.iff_exI 1 THEN rtac Data.iffI 1 THEN
   133     ALLGOALS(EVERY'[etac exE, REPEAT_DETERM o (etac conjE), rtac exI,
   131     ALLGOALS(EVERY'[etac Data.exE, REPEAT_DETERM o (etac Data.conjE), rtac Data.exI,
   134                     DEPTH_SOLVE_1 o (ares_tac [conjI])])
   132                     DEPTH_SOLVE_1 o (ares_tac [Data.conjI])])
   135 end;
   133 end;
   136 
   134 
   137 (* Proves (! x0..xn. (... & x0 = t & ...) --> P x0) =
   135 (* Proves (! x0..xn. (... & x0 = t & ...) --> P x0) =
   138           (! x1..xn x0. x0 = t --> (... & ...) --> P x0)
   136           (! x1..xn x0. x0 = t --> (... & ...) --> P x0)
   139 *)
   137 *)
   140 local
   138 local
   141 val tac = SELECT_GOAL
   139 val tac = SELECT_GOAL
   142           (EVERY1[REPEAT o (dtac uncurry), REPEAT o (rtac impI), etac mp,
   140           (EVERY1[REPEAT o (dtac Data.uncurry), REPEAT o (rtac Data.impI), etac Data.mp,
   143                   REPEAT o (etac conjE), REPEAT o (ares_tac [conjI])])
   141                   REPEAT o (etac Data.conjE), REPEAT o (ares_tac [Data.conjI])])
   144 val allcomm = all_comm RS iff_trans
   142 val allcomm = Data.all_comm RS Data.iff_trans
   145 in
   143 in
   146 val prove_one_point_all_tac =
   144 val prove_one_point_all_tac =
   147       EVERY1[qcomm_tac allcomm iff_allI,rtac iff_allI, rtac iffI, tac, tac]
   145       EVERY1[qcomm_tac allcomm Data.iff_allI,rtac Data.iff_allI, rtac Data.iffI, tac, tac]
   148 end
   146 end
   149 
   147 
   150 fun renumber l u (Bound i) = Bound(if i < l orelse i > u then i else
   148 fun renumber l u (Bound i) = Bound(if i < l orelse i > u then i else
   151                                    if i=u then l else i+1)
   149                                    if i=u then l else i+1)
   152   | renumber l u (s$t) = renumber l u s $ renumber l u t
   150   | renumber l u (s$t) = renumber l u s $ renumber l u t
   162 
   160 
   163 fun rearrange_all ss (F as (all as Const(q,_)) $ Abs(x,T, P)) =
   161 fun rearrange_all ss (F as (all as Const(q,_)) $ Abs(x,T, P)) =
   164      (case extract_quant extract_imp q P of
   162      (case extract_quant extract_imp q P of
   165         NONE => NONE
   163         NONE => NONE
   166       | SOME(xs,eq,Q) =>
   164       | SOME(xs,eq,Q) =>
   167           let val R = quantify all x T xs (imp $ eq $ Q)
   165           let val R = quantify all x T xs (Data.imp $ eq $ Q)
   168           in SOME (prove_conv prove_one_point_all_tac ss (F,R)) end)
   166           in SOME (prove_conv prove_one_point_all_tac ss (F,R)) end)
   169   | rearrange_all _ _ = NONE;
   167   | rearrange_all _ _ = NONE;
   170 
   168 
   171 fun rearrange_ball tac ss (F as Ball $ A $ Abs(x,T,P)) =
   169 fun rearrange_ball tac ss (F as Ball $ A $ Abs(x,T,P)) =
   172      (case extract_imp true [] P of
   170      (case extract_imp true [] P of
   173         NONE => NONE
   171         NONE => NONE
   174       | SOME(xs,eq,Q) => if not(null xs) then NONE else
   172       | SOME(xs,eq,Q) => if not(null xs) then NONE else
   175           let val R = imp $ eq $ Q
   173           let val R = Data.imp $ eq $ Q
   176           in SOME (prove_conv tac ss (F,Ball $ A $ Abs(x,T,R))) end)
   174           in SOME (prove_conv tac ss (F,Ball $ A $ Abs(x,T,R))) end)
   177   | rearrange_ball _ _ _ = NONE;
   175   | rearrange_ball _ _ _ = NONE;
   178 
   176 
   179 fun rearrange_ex ss (F as (ex as Const(q,_)) $ Abs(x,T,P)) =
   177 fun rearrange_ex ss (F as (ex as Const(q,_)) $ Abs(x,T,P)) =
   180      (case extract_quant extract_conj q P of
   178      (case extract_quant extract_conj q P of
   181         NONE => NONE
   179         NONE => NONE
   182       | SOME(xs,eq,Q) =>
   180       | SOME(xs,eq,Q) =>
   183           let val R = quantify ex x T xs (conj $ eq $ Q)
   181           let val R = quantify ex x T xs (Data.conj $ eq $ Q)
   184           in SOME(prove_conv prove_one_point_ex_tac ss (F,R)) end)
   182           in SOME(prove_conv prove_one_point_ex_tac ss (F,R)) end)
   185   | rearrange_ex _ _ = NONE;
   183   | rearrange_ex _ _ = NONE;
   186 
   184 
   187 fun rearrange_bex tac ss (F as Bex $ A $ Abs(x,T,P)) =
   185 fun rearrange_bex tac ss (F as Bex $ A $ Abs(x,T,P)) =
   188      (case extract_conj true [] P of
   186      (case extract_conj true [] P of
   189         NONE => NONE
   187         NONE => NONE
   190       | SOME(xs,eq,Q) => if not(null xs) then NONE else
   188       | SOME(xs,eq,Q) => if not(null xs) then NONE else
   191           SOME(prove_conv tac ss (F,Bex $ A $ Abs(x,T,conj$eq$Q))))
   189           SOME(prove_conv tac ss (F,Bex $ A $ Abs(x,T,Data.conj$eq$Q))))
   192   | rearrange_bex _ _ _ = NONE;
   190   | rearrange_bex _ _ _ = NONE;
   193 
   191 
   194 fun rearrange_Collect tac ss (F as Coll $ Abs(x,T,P)) =
   192 fun rearrange_Collect tac ss (F as Coll $ Abs(x,T,P)) =
   195      (case extract_conj true [] P of
   193      (case extract_conj true [] P of
   196         NONE => NONE
   194         NONE => NONE
   197       | SOME(_,eq,Q) =>
   195       | SOME(_,eq,Q) =>
   198           let val R = Coll $ Abs(x,T, conj $ eq $ Q)
   196           let val R = Coll $ Abs(x,T, Data.conj $ eq $ Q)
   199           in SOME(prove_conv tac ss (F,R)) end);
   197           in SOME(prove_conv tac ss (F,R)) end);
   200 
   198 
   201 end;
   199 end;