src/Pure/logic.ML
changeset 13659 3cf622f6b0b2
parent 12902 a23dc0b7566f
child 13799 77614fe09362
equal deleted inserted replaced
13658:c9ad3e64ddcf 13659:3cf622f6b0b2
    22   val strip_imp_concl   : term -> term
    22   val strip_imp_concl   : term -> term
    23   val strip_prems       : int * term list * term -> term list * term
    23   val strip_prems       : int * term list * term -> term list * term
    24   val count_prems       : term * int -> int
    24   val count_prems       : term * int -> int
    25   val mk_conjunction    : term * term -> term
    25   val mk_conjunction    : term * term -> term
    26   val mk_conjunction_list: term list -> term
    26   val mk_conjunction_list: term list -> term
    27   val mk_flexpair       : term * term -> term
    27   val strip_horn        : term -> term list * term
    28   val dest_flexpair     : term -> term * term
       
    29   val list_flexpairs    : (term*term)list * term -> term
       
    30   val rule_of           : (term*term)list * term list * term -> term
       
    31   val strip_flexpairs   : term -> (term*term)list * term
       
    32   val skip_flexpairs    : term -> term
       
    33   val strip_horn        : term -> (term*term)list * term list * term
       
    34   val mk_cond_defpair   : term list -> term * term -> string * term
    28   val mk_cond_defpair   : term list -> term * term -> string * term
    35   val mk_defpair        : term * term -> string * term
    29   val mk_defpair        : term * term -> string * term
    36   val mk_type           : typ -> term
    30   val mk_type           : typ -> term
    37   val dest_type         : term -> typ
    31   val dest_type         : term -> typ
    38   val mk_inclass        : typ * class -> term
    32   val mk_inclass        : typ * class -> term
   116 
   110 
   117 (*Count premises -- quicker than (length ostrip_prems) *)
   111 (*Count premises -- quicker than (length ostrip_prems) *)
   118 fun count_prems (Const("==>", _) $ A $ B, n) = count_prems (B,n+1)
   112 fun count_prems (Const("==>", _) $ A $ B, n) = count_prems (B,n+1)
   119   | count_prems (_,n) = n;
   113   | count_prems (_,n) = n;
   120 
   114 
       
   115 (*strip a proof state (Horn clause):
       
   116   B1 ==> ... Bn ==> C   goes to   ([B1, ..., Bn], C)    *)
       
   117 fun strip_horn A = (strip_imp_prems A, strip_imp_concl A);
       
   118 
   121 
   119 
   122 (** conjunction **)
   120 (** conjunction **)
   123 
   121 
   124 fun mk_conjunction (t, u) =
   122 fun mk_conjunction (t, u) =
   125   Term.list_all ([("C", propT)], mk_implies (list_implies ([t, u], Bound 0), Bound 0));
   123   Term.list_all ([("C", propT)], mk_implies (list_implies ([t, u], Bound 0), Bound 0));
   126 
   124 
   127 fun mk_conjunction_list [] = Term.all propT $ Abs ("dummy", propT, mk_implies (Bound 0, Bound 0))
   125 fun mk_conjunction_list [] = Term.all propT $ Abs ("dummy", propT, mk_implies (Bound 0, Bound 0))
   128   | mk_conjunction_list ts = foldr1 mk_conjunction ts;
   126   | mk_conjunction_list ts = foldr1 mk_conjunction ts;
   129 
       
   130 
       
   131 (** flex-flex constraints **)
       
   132 
       
   133 (*Make a constraint.*)
       
   134 fun mk_flexpair(t,u) = flexpair(fastype_of t) $ t $ u;
       
   135 
       
   136 fun dest_flexpair (Const("=?=",_) $ t $ u)  =  (t,u)
       
   137   | dest_flexpair t = raise TERM("dest_flexpair", [t]);
       
   138 
       
   139 (*make flexflex antecedents: ( [(a1,b1),...,(an,bn)] , C )
       
   140     goes to (a1=?=b1) ==>...(an=?=bn)==>C *)
       
   141 fun list_flexpairs ([], A) = A
       
   142   | list_flexpairs ((t,u)::pairs, A) =
       
   143         implies $ (mk_flexpair(t,u)) $ list_flexpairs(pairs,A);
       
   144 
       
   145 (*Make the object-rule tpairs==>As==>B   *)
       
   146 fun rule_of (tpairs, As, B) = list_flexpairs(tpairs, list_implies(As, B));
       
   147 
       
   148 (*Remove and return flexflex pairs:
       
   149     (a1=?=b1)==>...(an=?=bn)==>C  to  ( [(a1,b1),...,(an,bn)] , C )
       
   150   [Tail recursive in order to return a pair of results] *)
       
   151 fun strip_flex_aux (pairs, Const("==>", _) $ (Const("=?=",_)$t$u) $ C) =
       
   152         strip_flex_aux ((t,u)::pairs, C)
       
   153   | strip_flex_aux (pairs,C) = (rev pairs, C);
       
   154 
       
   155 fun strip_flexpairs A = strip_flex_aux([], A);
       
   156 
       
   157 (*Discard flexflex pairs*)
       
   158 fun skip_flexpairs (Const("==>", _) $ (Const("=?=",_)$_$_) $ C) =
       
   159         skip_flexpairs C
       
   160   | skip_flexpairs C = C;
       
   161 
       
   162 (*strip a proof state (Horn clause):
       
   163    (a1==b1)==>...(am==bm)==>B1==>...Bn==>C
       
   164     goes to   ( [(a1,b1),...,(am,bm)] , [B1,...,Bn] , C)    *)
       
   165 fun strip_horn A =
       
   166   let val (tpairs,horn) = strip_flexpairs A
       
   167   in  (tpairs, strip_imp_prems horn, strip_imp_concl horn)   end;
       
   168 
   127 
   169 
   128 
   170 (** definitions **)
   129 (** definitions **)
   171 
   130 
   172 fun mk_cond_defpair As (lhs, rhs) =
   131 fun mk_cond_defpair As (lhs, rhs) =
   268   let
   227   let
   269     fun is_meta (Const ("==>", _) $ _ $ _) = true
   228     fun is_meta (Const ("==>", _) $ _ $ _) = true
   270       | is_meta (Const ("==", _) $ _ $ _) = true
   229       | is_meta (Const ("==", _) $ _ $ _) = true
   271       | is_meta (Const ("all", _) $ _) = true
   230       | is_meta (Const ("all", _) $ _) = true
   272       | is_meta _ = false;
   231       | is_meta _ = false;
   273     val horn = skip_flexpairs prop;
       
   274   in
   232   in
   275     (case strip_prems (i, [], horn) of
   233     (case strip_prems (i, [], prop) of
   276       (B :: _, _) => exists is_meta (strip_assums_hyp B)
   234       (B :: _, _) => exists is_meta (strip_assums_hyp B)
   277     | _ => false) handle TERM _ => false
   235     | _ => false) handle TERM _ => false
   278   end;
   236   end;
   279 
   237 
   280 (*Removes the parameters from a subgoal and renumber bvars in hypotheses,
   238 (*Removes the parameters from a subgoal and renumber bvars in hypotheses,