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 |