src/Pure/logic.ML
changeset 28856 5e009a80fe6d
parent 28448 31a59d7d2168
child 29276 94b1ffec9201
equal deleted inserted replaced
28855:5d21a3e7303c 28856:5e009a80fe6d
   160 
   160 
   161 val true_prop = Term.all propT $ Abs ("dummy", propT, mk_implies (Bound 0, Bound 0));
   161 val true_prop = Term.all propT $ Abs ("dummy", propT, mk_implies (Bound 0, Bound 0));
   162 val conjunction = Const ("Pure.conjunction", propT --> propT --> propT);
   162 val conjunction = Const ("Pure.conjunction", propT --> propT --> propT);
   163 
   163 
   164 
   164 
   165 (*A && B*)
   165 (*A &&& B*)
   166 fun mk_conjunction (A, B) = conjunction $ A $ B;
   166 fun mk_conjunction (A, B) = conjunction $ A $ B;
   167 
   167 
   168 (*A && B && C -- improper*)
   168 (*A &&& B &&& C -- improper*)
   169 fun mk_conjunction_list [] = true_prop
   169 fun mk_conjunction_list [] = true_prop
   170   | mk_conjunction_list ts = foldr1 mk_conjunction ts;
   170   | mk_conjunction_list ts = foldr1 mk_conjunction ts;
   171 
   171 
   172 (*(A && B) && (C && D) -- balanced*)
   172 (*(A &&& B) &&& (C &&& D) -- balanced*)
   173 fun mk_conjunction_balanced [] = true_prop
   173 fun mk_conjunction_balanced [] = true_prop
   174   | mk_conjunction_balanced ts = BalancedTree.make mk_conjunction ts;
   174   | mk_conjunction_balanced ts = BalancedTree.make mk_conjunction ts;
   175 
   175 
   176 
   176 
   177 (*A && B*)
   177 (*A &&& B*)
   178 fun dest_conjunction (Const ("Pure.conjunction", _) $ A $ B) = (A, B)
   178 fun dest_conjunction (Const ("Pure.conjunction", _) $ A $ B) = (A, B)
   179   | dest_conjunction t = raise TERM ("dest_conjunction", [t]);
   179   | dest_conjunction t = raise TERM ("dest_conjunction", [t]);
   180 
   180 
   181 (*A && B && C -- improper*)
   181 (*A &&& B &&& C -- improper*)
   182 fun dest_conjunction_list t =
   182 fun dest_conjunction_list t =
   183   (case try dest_conjunction t of
   183   (case try dest_conjunction t of
   184     NONE => [t]
   184     NONE => [t]
   185   | SOME (A, B) => A :: dest_conjunction_list B);
   185   | SOME (A, B) => A :: dest_conjunction_list B);
   186 
   186 
   187 (*(A && B) && (C && D) -- balanced*)
   187 (*(A &&& B) &&& (C &&& D) -- balanced*)
   188 fun dest_conjunction_balanced 0 _ = []
   188 fun dest_conjunction_balanced 0 _ = []
   189   | dest_conjunction_balanced n t = BalancedTree.dest dest_conjunction n t;
   189   | dest_conjunction_balanced n t = BalancedTree.dest dest_conjunction n t;
   190 
   190 
   191 (*((A && B) && C) && D && E -- flat*)
   191 (*((A &&& B) &&& C) &&& D &&& E -- flat*)
   192 fun dest_conjunctions t =
   192 fun dest_conjunctions t =
   193   (case try dest_conjunction t of
   193   (case try dest_conjunction t of
   194     NONE => [t]
   194     NONE => [t]
   195   | SOME (A, B) => dest_conjunctions A @ dest_conjunctions B);
   195   | SOME (A, B) => dest_conjunctions A @ dest_conjunctions B);
   196 
   196