Update from HH

diff --git a/Jordan/float.ml b/Jordan/float.ml
new file mode 100644 (file)
index 0000000..cceacec
--- /dev/null
+++ b/Jordan/float.ml
@@ -0,0 +1,1825 @@
+(* ------------------------------------------------------------------ *)
+(* Author and Copyright: Thomas C. Hales                              *)
+(* License: GPL http://www.gnu.org/copyleft/gpl.html                  *)
+(* Project: FLYSPECK http://www.math.pitt.edu/~thales/flyspeck/       *)
+(* ------------------------------------------------------------------ *)
+
+
+
+prioritize_real();;
+
+let add_test,test = new_test_suite();;
+
+let twopow =
+  new_definition(
+        `twopow x = if (?n. (x = (int_of_num n)))
+        then ((&2) pow (nabs x))
+        else inv((&2) pow (nabs x))`);;
+
+let float =
+  new_definition(
+                  `float x n = (real_of_int x)*(twopow n)`);;
+
+let interval =
+  new_definition(
+                   `interval x f eps = ((abs (x-f)) <= eps)`);;
+
+(*--------------------------------------------------------------------*)
+
+let mk_interval a b ex =
+   mk_comb(mk_comb (mk_comb (`interval`,a),b),ex);;
+
+add_test("mk_interval",
+   mk_interval `#3` `#4` `#1` = `interval #3 #4 #1`);;
+
+let dest_interval intv =
+   let (h1,ex) = dest_comb intv in
+   let (h2,f) = dest_comb h1 in
+   let (h3,a) = dest_comb h2 in
+   let _ = assert(h3 = `interval`) in
+   (a,f,ex);;
+
+add_test("dest_interval",
+   let a = `#3` and b = `#4` and c = `#1` in
+   dest_interval (mk_interval a b c) = (a,b,c));;
+
+(*--------------------------------------------------------------------*)
+
+let (dest_int:term-> Num.num) =
+  fun b ->
+  let dest_pos_int a =
+    let (op,nat) = dest_comb a in
+    if (fst (dest_const op) = "int_of_num") then (dest_numeral nat)
+      else fail() in
+    let (op',u) = (dest_comb b) in
+    try (if (fst (dest_const op') = "int_neg") then
+           minus_num (dest_pos_int u) else
+             dest_pos_int b) with
+        Failure _ -> failwith "dest_int ";;
+
+
+let (mk_int:Num.num -> term) =
+  fun a ->
+    let sgn = Num.sign_num a in
+    let abv = Num.abs_num a in
+    let r = mk_comb(`&:`,mk_numeral abv) in
+    try (if (sgn<0) then mk_comb (`--:`,r) else r) with
+        Failure _ -> failwith ("dest_int "^(string_of_num a));;
+
+add_test("mk_int",
+   (mk_int (Int (-1443)) = `--: (&:1443)`) &&
+   (mk_int (Int 37) = `(&:37)`));;
+
+(* ------------------------------------------------------------------ *)
+
+let (split_ratio:Num.num -> Num.num*Num.num) =
+  function
+    (Ratio r) -> (Big_int (Ratio.numerator_ratio r)),
+         (Big_int (Ratio.denominator_ratio r))|
+    u -> (u,(Int 1));;
+
+add_test("split_ratio",
+   let (a,b) = split_ratio ((Int 4)//(Int 20)) in
+   (a =/ (Int 1)) && (b =/ (Int 5)));;
+
+(* ------------------------------------------------------------------ *)
+
+(* break nonzero int r into a*(C**b) with a prime to C . *)
+let (factor_C:int -> Num.num -> Num.num*Num.num) =
+  function c ->
+  let intC = (Int c) in
+  let rec divC (a,b) =
+    if ((Int 0) =/ mod_num a intC) then (divC (a//intC,b+/(Int 1)))
+      else (a,b) in
+  function r->
+  if ((Num.is_integer_num r)&& not((Num.sign_num r) = 0)) then
+    divC (r,(Int 0)) else failwith "factor_C";;
+
+add_test("factor_C",
+   (factor_C 2 (Int (4096+32)) = (Int 129,Int 5)) &&
+   (factor_C 10 (Int (5000)) = (Int 5,Int 3)) &&
+   (cannot (factor_C 2) ((Int 50)//(Int 3))));;
+
+(*--------------------------------------------------------------------*)
+
+let (dest_float:term -> Num.num) =
+  fun f ->
+    let (a,b) = dest_binop `float` f in
+    (dest_int a)*/ ((Int 2) **/ (dest_int b));;
+
+add_test("dest_float",
+   dest_float `float (&:3) (&:17)` = (Int 393216));;
+
+add_test("dest_float2", (* must express as numeral first *)
+   cannot dest_float `float ((&:3)+:(&:1)) (&:17)`);;
+
+(* ------------------------------------------------------------------ *)
+(* creates float of the form `float a b` with a odd *)
+let (mk_float:Num.num -> term) =
+  function r ->
+    let (a,b) = split_ratio r in
+    let (a',exp_a) = if (a=/(Int 0)) then ((Int 0),(Int 0)) else factor_C 2 a in
+    let (b',exp_b) = factor_C 2 b in
+    let c = a'//b' in
+    if (Num.is_integer_num c) then
+          mk_binop `float` (mk_int c) (mk_int (exp_a -/ exp_b))
+          else failwith "mk_float";;
+
+add_test("mk_float",
+   mk_float (Int (4096+32)) = `float (&:129) (&:5)` &&
+   (mk_float (Int 0) = `float (&:0) (&:0)`));;
+
+add_test("mk_float2",  (* throws exception exactly when denom != 2^k *)
+   let rtest = fun t -> (t =/ dest_float (mk_float t)) in
+   rtest ((Int 3)//(Int 1024)) &&
+  (cannot rtest ((Int 1)//(Int 3))));;
+
+add_test("mk_float dest_float",  (* constructs canonical form of float *)
+  mk_float (dest_float `float (&:4) (&:3)`) = `float (&:1) (&:5)`);;
+
+(* ------------------------------------------------------------------ *)
+(* creates decimal of the form `DECIMAL a b` with a prime to 10 *)
+let (mk_pos_decimal:Num.num -> term) =
+  function r ->
+    let _ = assert (r >=/ (Int 0)) in
+    let (a,b) = split_ratio r in
+    if (a=/(Int 0)) then `#0` else
+    let (a1,exp_a5) = factor_C 5 a in
+    let (a2,exp_a2) = factor_C 2 a1 in
+    let (b1,exp_b5) = factor_C 5 b in
+    let (b2,exp_b2) = factor_C 2 b1 in
+    let _ = assert(b2 =/ (Int 1)) in
+    let c = end_itlist Num.max_num [exp_b5-/exp_a5;exp_b2-/exp_a2;(Int 0)] in
+    let a' = a2*/((Int 2)**/ (c +/ exp_a2 -/ exp_b2))*/
+             ((Int 5)**/(c +/ exp_a5 -/ exp_b5)) in
+    let b' = (Int 10) **/ c in
+    mk_binop `DECIMAL` (mk_numeral a') (mk_numeral b');;
+
+add_test("mk_pos_decimal",
+   mk_pos_decimal (Int (5000)) = `#5000` &&
+   (mk_pos_decimal ((Int 30)//(Int 40)) = `#0.75`) &&
+   (mk_pos_decimal (Int 0) = `#0`) &&
+   (mk_pos_decimal ((Int 15)//(Int 25)) = `#0.6`) &&
+   (mk_pos_decimal ((Int 25)//(Int 4)) = `#6.25`) &&
+   (mk_pos_decimal ((Int 2)//(Int 25)) = `#0.08`));;
+
+let (mk_decimal:Num.num->term) =
+  function r ->
+  let a = Num.sign_num r in
+  let b = mk_pos_decimal (Num.abs_num r) in
+  if (a < 0) then (mk_comb (`--.`, b)) else b;;
+
+add_test("mk_decimal",
+  (mk_decimal (Int 3) = `#3`) &&
+  (mk_decimal (Int (-3)) = `--. (#3)`));;
+
+
+
+(*--------------------------------------------------------------------*)
+
+let (dest_decimal:term -> Num.num) =
+  fun f ->
+    let (a,b) = dest_binop `DECIMAL` f in
+    let a1 = dest_numeral a in
+    let b1 = dest_numeral b in
+        a1//b1;;
+
+add_test("dest_decimal",
+   dest_decimal `#3.4` =/ ((Int 34)//(Int 10)));;
+add_test("dest_decimal2",
+   cannot dest_decimal `--. (#3.4)`);;
+
+
+
+
+
+(*--------------------------------------------------------------------*)
+(*   Properties of integer powers of 2.                               *)
+(* ------------------------------------------------------------------ *)
+
+
+let TWOPOW_POS = prove(`!n. (twopow (int_of_num n) = (&2) pow n)`,
+        (REWRITE_TAC[twopow])
+        THEN GEN_TAC
+        THEN COND_CASES_TAC
+        THENL [AP_TERM_TAC;ALL_TAC]
+        THEN (REWRITE_TAC[NABS_POS])
+        THEN (UNDISCH_EL_TAC 0)
+        THEN (TAUT_TAC (` ( A    ) ==> (~ A ==> B)`))
+        THEN (MESON_TAC[]));;
+
+let TWOPOW_NEG = prove(`!n. (twopow (--(int_of_num n)) = inv((&2) pow n))`,
+        GEN_TAC
+        THEN (REWRITE_TAC[twopow])
+        THEN (COND_CASES_TAC THENL [ALL_TAC;REWRITE_TAC[NABS_NEG]])
+        THEN (POP_ASSUM CHOOSE_TAC)
+        THEN (REWRITE_TAC[NABS_NEG])
+        THEN (UNDISCH_EL_TAC 0)
+        THEN (REWRITE_TAC[int_eq;int_neg_th;INT_NUM_REAL])
+        THEN (REWRITE_TAC[prove (`! u y.((--(real_of_num u) = (real_of_num y))=
+                ((real_of_num u) +(real_of_num y) = (&0)))`,REAL_ARITH_TAC)])
+        THEN (REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_EQ;ADD_EQ_0])
+        THEN (DISCH_TAC)
+        THEN (ASM_REWRITE_TAC[real_pow;REAL_INV_1]));;
+
+
+let TWOPOW_INV = prove(`!a. (twopow (--: a) = (inv (twopow a)))`,
+  (GEN_TAC)
+  THEN ((ASSUME_TAC (SPEC `a:int` INT_REP2)))
+  THEN ((POP_ASSUM CHOOSE_TAC))
+  THEN ((POP_ASSUM DISJ_CASES_TAC))
+  THEN ((ASM_REWRITE_TAC[TWOPOW_POS;TWOPOW_NEG;REAL_INV_INV;INT_NEG_NEG])));;
+
+let INT_REP3 = prove(`!a .(?n.( (a = &: n) \/ (a = --: (&: (n+1)))))`,
+(GEN_TAC)
+THEN ((ASSUME_TAC (SPEC `a:int` INT_REP2)))
+THEN ((POP_ASSUM CHOOSE_TAC))
+THEN ((DISJ_CASES_TAC (prove (`((a:int) = (&: 0)) \/ ~((a:int) =(&: 0))`, MESON_TAC[]))))
+(* cases *)
+THENL[ ((EXISTS_TAC `0`)) THEN ((ASM_REWRITE_TAC[]));ALL_TAC]
+THEN ((UNDISCH_EL_TAC 0))
+THEN ((POP_ASSUM DISJ_CASES_TAC))
+THENL [DISCH_TAC THEN ((ASM MESON_TAC)[]);ALL_TAC]
+THEN (DISCH_TAC)
+THEN ((EXISTS_TAC `PRE n`))
+THEN ((DISJ2_TAC))
+THEN ((ASM_REWRITE_TAC[INT_EQ_NEG2]))
+(*** Changed by JRH, 2006/03/28 to avoid PRE_ELIM_TAC ***)
+THEN (FIRST_X_ASSUM(MP_TAC o check(is_neg o concl)))
+THEN (ASM_REWRITE_TAC[INT_NEG_EQ_0; INT_OF_NUM_EQ])
+THEN (ARITH_TAC));;
+
+let REAL_EQ_INV = prove(`!x y. ((x:real = y) <=> (inv(x) = inv (y)))`,
+((REPEAT GEN_TAC))
+THEN (EQ_TAC)
+THENL [((DISCH_TAC THEN (ASM_REWRITE_TAC[])));
+ (* branch 2*) ((DISCH_TAC))
+THEN ((ONCE_REWRITE_TAC [(GSYM REAL_INV_INV)]))
+THEN ((ASM_REWRITE_TAC[]))]);;
+
+let TWOPOW_ADD_1 =
+  prove(`!a. (twopow (a +: (&:1)) = twopow (a) *. (twopow (&:1)))`,
+EVERY[
+  GEN_TAC;
+  CHOOSE_TAC (SPEC `a:int` INT_REP3);
+  POP_ASSUM DISJ_CASES_TAC
+  THENL[
+    ASM_REWRITE_TAC[TWOPOW_POS;INT_OF_NUM_ADD;REAL_POW_ADD];
+    EVERY[
+      ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD;INT_NEG_ADD;GSYM INT_ADD_ASSOC;INT_ADD_LINV;INT_ADD_RID];
+      REWRITE_TAC[GSYM INT_NEG_ADD;INT_OF_NUM_ADD;TWOPOW_NEG;TWOPOW_POS];
+      ONCE_REWRITE_TAC[SPEC `(&. 2) pow 1` (GSYM REAL_INV_INV)];
+      REWRITE_TAC[GSYM REAL_INV_MUL;GSYM REAL_EQ_INV;REAL_POW_ADD;GSYM REAL_MUL_ASSOC;REAL_POW_1];
+      REWRITE_TAC[MATCH_MP REAL_MUL_RINV (REAL_ARITH `~((&. 2) = (&. 0))`); REAL_MUL_RID]
+    ]
+  ]
+]);;
+
+let REAL_INV2 = prove(
+  `(inv(&. 2)*(&. 2) = (&.1)) /\ ((&. 2)*inv(&. 2) = (&.1))`,
+  SUBGOAL_TAC `~((&.2) = (&.0))`
+THENL[
+  REAL_ARITH_TAC;
+  SIMP_TAC[REAL_MUL_RINV;REAL_MUL_LINV]]);;
+
+let TWOPOW_0 = prove(`twopow (&: 0) = (&. 1)`,
+ (REWRITE_TAC[TWOPOW_POS;real_pow]));;
+
+let TWOPOW_SUB_NUM = prove(`!m n.( twopow((&:m) - (&: n)) = twopow((&:m))*. twopow(--: (&:n)))`,
+((INDUCT_TAC))
+THENL [REWRITE_TAC[INT_SUB_LZERO;REAL_MUL_LID;TWOPOW_0];ALL_TAC]
+THEN ((INDUCT_TAC THEN
+   ( (ASM_REWRITE_TAC[INT_SUB_RZERO;TWOPOW_0;REAL_MUL_RID;INT_NEG_0;ADD1;GSYM INT_OF_NUM_ADD]))))
+THEN ((ASM_REWRITE_TAC [TWOPOW_ADD_1;TWOPOW_INV;prove (`((&:m)+(&:1)) -: ((&:n) +: (&:1)) = ((&:m)-: (&:n))`,INT_ARITH_TAC)]))
+THEN ((REWRITE_TAC[REAL_INV_MUL]))
+THEN ((ABBREV_TAC `a:real = twopow (&: m)`))
+THEN ((ABBREV_TAC `b:real = inv(twopow (&: n))`))
+THEN ((REWRITE_TAC[TWOPOW_POS;REAL_POW_1;GSYM REAL_MUL_ASSOC;prove (`!(x:real). ((&.2)*x = x*(&.2))`,REAL_ARITH_TAC)]))
+THEN ((REWRITE_TAC[REAL_INV2;REAL_MUL_RID])));;
+
+let TWOPOW_ADD_NUM = prove(
+  `!m n. (twopow ((&:m) + (&:n)) = twopow((&:m))*. twopow((&:n)))`,
+(REWRITE_TAC[TWOPOW_POS;REAL_POW_ADD;INT_OF_NUM_ADD]));;
+
+let TWOPOW_ADD_INT = prove(
+  `!a b. (twopow (a +: b) = twopow(a) *. (twopow(b)))`,
+ ((REPEAT GEN_TAC))
+THEN ((ASSUME_TAC (SPEC `a:int` INT_REP)))
+THEN ((POP_ASSUM CHOOSE_TAC))
+THEN ((POP_ASSUM CHOOSE_TAC))
+THEN ((ASSUME_TAC (SPEC `b:int` INT_REP)))
+THEN ((REPEAT (POP_ASSUM CHOOSE_TAC)))
+THEN ((ASM_REWRITE_TAC[]))
+THEN ((SUBGOAL_TAC `&: n -: &: m +: &: n' -: &: m' = (&: (n+n')) -: (&: (m+m'))`))
+(* branch *)
+THENL[ ((REWRITE_TAC[GSYM INT_OF_NUM_ADD]))
+THEN ((INT_ARITH_TAC));ALL_TAC]
+(* 2nd *)
+THEN ((DISCH_TAC))
+THEN ((ASM_REWRITE_TAC[TWOPOW_SUB_NUM;TWOPOW_INV;TWOPOW_POS;REAL_POW_ADD;REAL_INV_MUL;GSYM REAL_MUL_ASSOC]))
+THEN ((ABBREV_TAC `a':real = inv ((&. 2) pow m)`))
+THEN ((ABBREV_TAC `c :real = (&. 2) pow n`))
+THEN ((ABBREV_TAC `d :real = (&. 2) pow n'`))
+THEN ((ABBREV_TAC `e :real = inv ((&. 2) pow m')`))
+THEN (MESON_TAC[REAL_MUL_AC]));;
+
+let TWOPOW_ABS = prove(`!a. ||. (twopow a) = (twopow a)`,
+(GEN_TAC)
+THEN ((CHOOSE_THEN DISJ_CASES_TAC (SPEC `a:int` INT_REP2)))
+(* branch *)
+THEN ((ASM_REWRITE_TAC[TWOPOW_POS;TWOPOW_NEG;REAL_ABS_POW;REAL_ABS_NUM;REAL_ABS_INV])));;
+
+let REAL_POW_POW = prove(
+  `!x m n . (x **. m) **. n = x **. (m *| n)`,
+((GEN_TAC THEN GEN_TAC THEN INDUCT_TAC))
+(* branch *)
+THENL[ ((REWRITE_TAC[real_pow;MULT_0]));
+(* second branch *)
+((REWRITE_TAC[real_pow]))
+THEN ((ASM_REWRITE_TAC[ADD1;LEFT_ADD_DISTRIB;REAL_POW_ADD;REAL_MUL_AC;MULT_CLAUSES]))]);;
+
+let INT_POW_POW = INT_OF_REAL_THM REAL_POW_POW;;
+
+let TWOPOW_POW = prove(
+  `!a n. (twopow a) pow n = twopow (a *: (&: n))`,
+((REPEAT GEN_TAC))
+THEN ((CHOOSE_THEN DISJ_CASES_TAC (SPEC `a:int` INT_REP2)))
+(* branch *)
+THEN ((ASM_REWRITE_TAC[TWOPOW_POS;INT_OF_NUM_MUL;
+   REAL_POW_POW;TWOPOW_NEG;REAL_POW_INV;INT_OF_NUM_MUL;GSYM INT_NEG_LMUL])));;
+
+(* ------------------------------------------------------------------ *)
+(*   Arithmetic operations on float                                   *)
+(* ------------------------------------------------------------------ *)
+let FLOAT_NEG = prove(`!a m. --. (float a m) = float (--: a) m`,
+ REPEAT GEN_TAC THEN
+ REWRITE_TAC[float;GSYM REAL_MUL_LNEG;int_neg_th]);;
+
+
+
+let FLOAT_MUL = prove(`!a b m n. (float a m) *. (float b n) = (float (a *: b) (m +: n))`,
+((REPEAT GEN_TAC))
+THEN ((REWRITE_TAC[float;GSYM REAL_MUL_ASSOC;TWOPOW_ADD_INT;int_mul_th]))
+THEN ((MESON_TAC[REAL_MUL_AC])));;
+
+let FLOAT_ADD = prove(
+  `!a b c m. (float a (m+: (&:c))) +. (float b m)
+     = (float ( (&:(2 EXP c))*a +: b) m)`,
+((REWRITE_TAC[float;int_add_th;REAL_ADD_RDISTRIB;int_mul_th;TWOPOW_ADD_INT]))
+THEN ((REPEAT GEN_TAC))
+THEN ((REWRITE_TAC[TWOPOW_POS;INT_NUM_REAL;GSYM REAL_OF_NUM_POW]))
+THEN ((MESON_TAC[REAL_MUL_AC])));;
+
+let FLOAT_ADD_EQ = prove(
+  `!a b m. (float a  m) +. (float b m) =
+  (float (a+:b) m)`,
+ ((REPEAT GEN_TAC))
+THEN ((REWRITE_TAC[REWRITE_RULE[INT_ADD_RID] (SPEC `m:int` (SPEC `0` (SPEC `b:int` (SPEC `a:int` FLOAT_ADD))))]))
+THEN ((REWRITE_TAC[EXP;INT_MUL_LID])));;
+
+let FLOAT_ADD_NP = prove(
+  `!a b m n.  (float b (--:(&: n))) +. (float a (&: m)) = (float a (&: m)) +. (float b (--:(&: n)))`,
+(REWRITE_TAC[REAL_ADD_AC]));;
+
+let FLOAT_ADD_PN = prove(
+  `!a b m n. (float a (&: m)) +. (float b (--(&: n))) = (float ( (&:(2 EXP (m+| n)))*a + b) (--:(&: n)))`,
+((REPEAT GEN_TAC))
+THEN ((SUBGOAL_TAC `&: m = (--:(&: n)) + (&:(m+n))`))
+THENL[ ((REWRITE_TAC[GSYM INT_OF_NUM_ADD]))
+THEN ((INT_ARITH_TAC));
+(* branch *)
+((DISCH_TAC))
+THEN ((ASM_REWRITE_TAC[FLOAT_ADD]))]);;
+
+let FLOAT_ADD_PP = prove(
+  `!a b m n. ((n <=| m) ==>( (float a (&: m)) +. (float b (&: n)) = (float  ((&:(2 EXP (m -| n))) *a + b) (&: n))))`,
+((REPEAT GEN_TAC))
+THEN (DISCH_TAC)
+THEN ((SUBGOAL_TAC `&: m = (&: n) + (&: (m-n))`))
+THENL[ ((REWRITE_TAC[INT_OF_NUM_ADD]))
+THEN (AP_TERM_TAC)
+THEN ((REWRITE_TAC[prove (`!(m:num) n. (n+m-n) = (m-n)+n`,REWRITE_TAC[ADD_AC])]))
+THEN ((UNDISCH_EL_TAC 0))
+THEN ((MATCH_ACCEPT_TAC(GSYM SUB_ADD)));
+(* branch *)
+((DISCH_TAC))
+THEN ((ASM_REWRITE_TAC[FLOAT_ADD]))]);;
+
+let FLOAT_ADD_PPv2 = prove(
+  `!a b m n. ((m <| n) ==>( (float a (&: m)) +. (float b (&: n)) = (float  ((&:(2 EXP (n -| m))) *b + a) (&: m))))`,
+((REPEAT GEN_TAC))
+THEN (DISCH_TAC)
+THEN ((H_MATCH_MP (THM (prove(`!m n. m<|n ==> m <=|n`,MESON_TAC[LT_LE]))) (HYP_INT 0)))
+THEN ((UNDISCH_EL_TAC 0))
+THEN ((SIMP_TAC[GSYM FLOAT_ADD_PP]))
+THEN (DISCH_TAC)
+THEN ((REWRITE_TAC[REAL_ADD_AC])));;
+
+let FLOAT_ADD_NN = prove(
+`!a b m n. ((n <=| m) ==>( (float a (--:(&: m))) +. (float b (--:(&: n)))
+     = (float  ((&:(2 EXP (m -| n))) *b + a) (--:(&: m)))))`,
+((REPEAT GEN_TAC))
+THEN (DISCH_TAC)
+THEN ((SUBGOAL_TAC `--: (&: n) = --: (&: m) + (&: (m-n))`))
+THENL [((UNDISCH_EL_TAC 0))
+THEN ((SIMP_TAC [INT_OF_REAL_THM (GSYM REAL_OF_NUM_SUB)]))
+THEN (DISCH_TAC)
+THEN ((INT_ARITH_TAC));
+(*branch*)
+((DISCH_TAC))
+THEN (ASM_REWRITE_TAC[GSYM FLOAT_ADD;REAL_ADD_AC])]);;
+
+let FLOAT_ADD_NNv2 = prove(
+`!a b m n. ((m <| n) ==>( (float a (--:(&: m))) +. (float b (--:(&: n)))
+     = (float  ((&:(2 EXP (n -| m))) *a + b) (--:(&: n)))))`,
+((REPEAT GEN_TAC))
+THEN (DISCH_TAC)
+THEN (((H_MATCH_MP (THM (prove(`!m n. m<|n ==> m <=|n`,MESON_TAC[LT_LE]))) (HYP_INT 0))))
+THEN (((UNDISCH_EL_TAC 0)))
+THEN (((SIMP_TAC[GSYM FLOAT_ADD_NN])))
+THEN ((DISCH_TAC))
+THEN (((REWRITE_TAC[REAL_ADD_AC]))));;
+
+let FLOAT_SUB = prove(
+  `!a b n m. (float a n) -. (float b m)
+     = (float a n) +. (float (--: b) m)`,
+REWRITE_TAC[float;int_neg_th;real_sub;REAL_NEG_LMUL]);;
+
+let FLOAT_ABS = prove(
+  `!a n. ||. (float a n) = (float (||: a) n)`,
+(REWRITE_TAC[float;int_abs_th;REAL_ABS_MUL;TWOPOW_ABS]));;
+
+
+let FLOAT_POW = prove(
+  `!a n m. (float a n) **. m = (float (a **: m) (n *: (&:m)))`,
+(REWRITE_TAC[float;REAL_POW_MUL;int_pow_th;TWOPOW_POW]));;
+
+let INT_SUB = prove(
+  `!a b. (a -: b) = (a +: (--: b))`,
+ (REWRITE_TAC[GSYM INT_SUB_RNEG;INT_NEG_NEG]));;
+
+let INT_ABS_NUM = prove(
+  `!n. ||: (&: n) = (&: n)`,
+ (REWRITE_TAC[int_eq;int_abs_th;INT_NUM_REAL;REAL_ABS_NUM]));;
+
+let INT_ABS_NEG_NUM = prove(
+  `!n. ||: (--: (&: n)) = (&: n)`,
+ (REWRITE_TAC[int_eq;int_abs_th;int_neg_th;INT_NUM_REAL;REAL_ABS_NUM;REAL_ABS_NEG]));;
+
+let INT_ADD_NEG_NUM = prove(`!x y. --: (&: x) +: (&: y) = (&: y) +: (--: (&: x))`,
+ (REWRITE_TAC[INT_ADD_AC]));;
+
+let INT_POW_MUL = INT_OF_REAL_THM REAL_POW_MUL;;
+
+let INT_POW_NEG1 = prove (
+  `!x n. (--: (&: x)) **: n = ((--: (&: 1)) **: n) *: ((&: x) **: n)`,
+(REWRITE_TAC[GSYM INT_POW_MUL; GSYM INT_NEG_MINUS1]));;
+
+
+
+let INT_POW_EVEN_NEG1 = prove(
+  `!x n. (--: (&: x)) **: (NUMERAL (BIT0 n)) =  ((&: x) **: (NUMERAL (BIT0 n)))`,
+((REPEAT GEN_TAC))
+THEN ((ONCE_REWRITE_TAC[INT_POW_NEG1]))
+THEN ((ABBREV_TAC `a = &: 1`))
+THEN ((ABBREV_TAC `b = (&: x)**: (NUMERAL (BIT0 n))`))
+THEN ((REWRITE_TAC[NUMERAL;BIT0]))
+THEN ((REWRITE_TAC[GSYM MULT_2;GSYM INT_POW_POW;INT_OF_REAL_THM REAL_POW_2;INT_NEG_MUL2]))
+THEN ((EXPAND_TAC "a"))
+THEN ((REWRITE_TAC[INT_MUL_RID;INT_MUL_LID;INT_OF_REAL_THM REAL_POW_ONE])));;
+
+let INT_POW_ODD_NEG1 = prove(
+  `!x n. (--: (&: x)) **: (NUMERAL (BIT1 n)) = --: ((&: x) **: (NUMERAL (BIT1 n)))`,
+((REPEAT GEN_TAC))
+THEN ((ONCE_REWRITE_TAC[INT_POW_NEG1]))
+THEN (((ABBREV_TAC `a = &: 1`)))
+THEN (((ABBREV_TAC `b = (&: x)**: (NUMERAL (BIT1 n))`)))
+THEN ((REWRITE_TAC[NUMERAL;BIT1]))
+THEN ((ONCE_REWRITE_TAC[ADD1]))
+THEN ((EXPAND_TAC "a"))
+THEN ((REWRITE_TAC[GSYM MULT_2]))
+THEN ((REWRITE_TAC[INT_OF_REAL_THM POW_MINUS1;INT_OF_REAL_THM REAL_POW_ADD]))
+THEN ((REWRITE_TAC[INT_OF_REAL_THM POW_1;INT_MUL_LID;INT_MUL_LNEG])));;
+
+(* subtraction of integers *)
+
+let INT_ADD_NEG = prove(
+ `!x y. (x < y ==> ((&: x) +: (--: (&: y)) = --: (&: (y - x))))`,
+((REPEAT GEN_TAC))
+THEN ((DISCH_TAC))
+THEN ((SUBGOAL_TAC `&: (y-x ) = (&: y) - (&: x)`))
+THENL [((SUBGOAL_TAC `x <=| y`))
+         (* branch *)
+         THENL [(((ASM MESON_TAC)[LE_LT]));((SIMP_TAC[GSYM (INT_OF_REAL_THM REAL_OF_NUM_SUB)]))]
+(* branch *)
+; ((DISCH_TAC))
+THEN ((ASM_REWRITE_TAC[]))
+THEN (ACCEPT_TAC(INT_ARITH `&: x +: --: (&: y) = --: (&: y -: &: x)`))]);;
+
+let INT_ADD_NEGv2 = prove(
+ `!x y. (y <= x ==> ((&: x) +: (--: (&: y)) = (&: (x - y))))`,
+ ((REPEAT GEN_TAC))
+ THEN ((DISCH_TAC))
+ THEN ((SUBGOAL_TAC `&: (x - y) = (&: x) - (&: y)`))
+ THENL[
+  ((UNDISCH_EL_TAC 0)) THEN ((SIMP_TAC[GSYM (INT_OF_REAL_THM REAL_OF_NUM_SUB)]));
+  ((DISCH_TAC)) THEN ((ASM_REWRITE_TAC[INT_SUB]))
+     ]
+);;
+
+(* assumes a term of the form &:a +: (--: (&: b))  *)
+let INT_SUB_CONV t =
+    let a,b = dest_binop `(+:)` t in
+  let (_,a) = dest_comb a in
+  let (_,b) = dest_comb b in
+  let (_,b) = dest_comb b in
+  let a = dest_numeral a in
+  let b = dest_numeral b in
+  let thm = if  (b <=/ a) then
+    INT_ADD_NEGv2
+  else INT_ADD_NEG in
+  (ARITH_SIMP_CONV[thm]) t;; (*   (SIMP_CONV[thm;ARITH]) t;; *)
+
+
+(* ------------------------------------------------------------------ *)
+(*   Simplifies an arithmetic expression in floats                    *)
+(*   A workhorse                                                      *)
+(* ------------------------------------------------------------------ *)
+
+let FLOAT_CONV =
+              (ARITH_SIMP_CONV[FLOAT_MUL;FLOAT_SUB;FLOAT_ABS;FLOAT_POW;
+              FLOAT_ADD_NN;FLOAT_ADD_NNv2;FLOAT_ADD_PP;FLOAT_ADD_PPv2;
+              FLOAT_ADD_NP;FLOAT_ADD_PN;FLOAT_NEG;
+              INT_NEG_NEG;INT_SUB;
+              INT_ABS_NUM;INT_ABS_NEG_NUM;
+              INT_MUL_LNEG;INT_MUL_RNEG;INT_NEG_MUL2;INT_OF_NUM_MUL;
+              INT_OF_NUM_ADD;GSYM INT_NEG_ADD;INT_ADD_NEG_NUM;
+              INT_OF_NUM_POW;INT_POW_ODD_NEG1;INT_POW_EVEN_NEG1;
+              INT_ADD_NEG;INT_ADD_NEGv2 (* ; ARITH *)
+              ]) ;;
+
+add_test("FLOAT_CONV1",
+  let f z =
+    let (x,y) =  dest_eq z in
+    let (u,v) =  dest_thm (FLOAT_CONV x) in
+    (u=[]) && (z = v) in
+  f `float (&:3) (&:0) = float (&:3) (&:0)` &&
+  f `float (&:3) (&:3) = float (&:3) (&:3)` &&
+  f `float (&:3) (&:0) +. (float (&:4) (&:0)) = (float (&:7) (&:0))` &&
+  f `float (&:1 + (&:3)) (&:4) = float (&:4) (&:4)` &&
+  f `float (&:3 - (&:7)) (&:0) = float (--:(&:4)) (&:0)` &&
+  f `float (&:3) (&:4) *. (float (--: (&:2)) (&:3)) = float (--: (&:6))
+                                                        (&:7)` &&
+  f `--. (float (--: (&:3)) (&:0)) = float (&:3) (&:0)`
+        );;
+
+(* ------------------------------------------------------------------ *)
+(*   Operations on interval. Preliminary stuff to deal with           *)
+(*   chains of inequalities.                                          *)
+(* ------------------------------------------------------------------ *)
+
+
+let REAL_ADD_LE_SUBST_RHS = prove(
+  `!a b c P. ((a <=. ((P b)) /\ (!x. (P x) =  x + (P (&. 0))) /\ (b <=. c)) ==> (a <=. (P c)))`,
+(((REPEAT GEN_TAC)))
+THEN (((REPEAT (TAUT_TAC `(b ==> a==> c) ==> (a /\ b ==> c)`))))
+THEN (((REPEAT DISCH_TAC)))
+THEN ((((H_RULER(ONCE_REWRITE_RULE))[HYP_INT 1] (HYP_INT 0))))
+THEN ((((ASM ONCE_REWRITE_TAC)[])))
+THEN ((((ASM MESON_TAC)[REAL_LE_RADD;REAL_LE_TRANS]))));;
+
+let REAL_ADD_LE_SUBST_LHS = prove(
+  `!a b c P. (((P(a) <=. b /\ (!x. (P x) =  x + (P (&. 0))) /\ (c <=. a)))
+     ==> ((P c) <=. b))`,
+(REP_GEN_TAC)
+THEN (DISCH_ALL_TAC)
+THEN (((H_RULER(ONCE_REWRITE_RULE)) [HYP_INT 1] (HYP_INT 0)))
+THEN (((ASM ONCE_REWRITE_TAC)[]))
+THEN (((ASM MESON_TAC)[REAL_LE_RADD;REAL_LE_TRANS])));;
+(*
+let rec SPECL =
+    function [] -> I |
+    (a::b)  -> fun thm ->(SPECL b (SPEC a thm));;
+*)
+(*
+  input:
+    rel: b <=. c
+    thm: a <=. P(b).
+
+  output: a <=. P(c).
+
+  condition: REAL_ARITH must be able to prove !x. P(x) = x+. P(&.0).
+  condition: the term `a` must appear exactly once the lhs of the thm.
+  *)
+
+let IWRITE_REAL_LE_RHS rel thm =
+  let bvar = genvar `:real` in
+  let (bt,_) = dest_binop `(<=.)` (concl rel) in
+  let sub = SUBS_CONV[ASSUME (mk_eq(bt,bvar))] in
+  let rule = (fun th -> EQ_MP (sub (concl th)) th) in
+  let (subrel,subthm) = (rule rel,rule thm) in
+  let (a,p) = dest_binop `(<=.)` (concl subthm) in
+  let (_,c) = dest_binop `(<=.)` (concl subrel) in
+  let pfn = mk_abs (bvar,p) in
+  let imp_th = BETA_RULE (SPECL [a;bvar;c;pfn] REAL_ADD_LE_SUBST_RHS) in
+  let ppart =   REAL_ARITH
+      (fst(dest_conj(snd(dest_conj(fst(dest_imp(concl imp_th))))))) in
+  let prethm = MATCH_MP imp_th (CONJ subthm (CONJ ppart subrel)) in
+  let prethm2 = SPEC bt (GEN bvar (DISCH
+       (find (fun x -> try(bvar = rhs x) with failure -> false) (hyp prethm)) prethm)) in
+  MATCH_MP prethm2 (REFL bt);;
+
+(*
+  input:
+    rel: c <=. a
+    thm: P a <=. b
+
+  output: P c <=. b
+
+  condition: REAL_ARITH must be able to prove !x. P(x) = x+. P(&.0).
+  condition: the term `a` must appear exactly once the lhs of the thm.
+  *)
+
+let IWRITE_REAL_LE_LHS rel thm =
+  let avar = genvar `:real` in
+  let (_,at) = dest_binop `(<=.)` (concl rel) in
+  let sub = SUBS_CONV[ASSUME (mk_eq(at,avar))] in
+  let rule = (fun th -> EQ_MP (sub (concl th)) th) in
+  let (subrel,subthm) = (rule rel,rule thm) in
+  let (p,b) = dest_binop `(<=.)` (concl subthm) in
+  let (c,_) = dest_binop `(<=.)` (concl subrel) in
+  let pfn = mk_abs (avar,p) in
+  let imp_th = BETA_RULE (SPECL [avar;b;c;pfn] REAL_ADD_LE_SUBST_LHS) in
+  let ppart =   REAL_ARITH
+      (fst(dest_conj(snd(dest_conj(fst(dest_imp(concl imp_th))))))) in
+  let prethm = MATCH_MP imp_th (CONJ subthm (CONJ ppart subrel)) in
+  let prethm2 = SPEC at (GEN avar (DISCH
+       (find (fun x -> try(avar = rhs x) with failure -> false) (hyp prethm)) prethm)) in
+  MATCH_MP prethm2 (REFL at);;
+
+(* ------------------------------------------------------------------ *)
+(*   INTERVAL ADD, NEG, SUBTRACT                                      *)
+(* ------------------------------------------------------------------ *)
+
+
+let INTERVAL_ADD = prove(
+   `!x f ex y g ey. interval x f ex /\ interval y g ey ==>
+                         interval (x +. y) (f +. g) (ex +. ey)`,
+EVERY[
+ REPEAT GEN_TAC;
+ TAUT_TAC `(A==>B==>C)==>(A/\ B ==> C)`;
+ REWRITE_TAC[interval];
+ REWRITE_TAC[prove(`(x+.y) -. (f+.g) = (x-.f) +. (y-.g)`,REAL_ARITH_TAC)];
+ ABBREV_TAC `a = x-.f`;
+ ABBREV_TAC `b = y-.g`;
+ ASSUME_TAC (SPEC `b:real` (SPEC `a:real` ABS_TRIANGLE));
+ UNDISCH_EL_TAC 0;
+ ABBREV_TAC `a':real = abs a`;
+ ABBREV_TAC `b':real = abs b`;
+ REPEAT DISCH_TAC;
+ (H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 2);
+ (H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 2) (HYP_INT 0);
+ ASM_REWRITE_TAC[]]);;
+
+let INTERVAL_NEG = prove(
+  `!x f ex. interval x f ex = interval (--. x) (--. f) ex`,
+(REWRITE_TAC[interval;REAL_ABS_NEG;REAL_ARITH `!x y. -- x -. (-- y) = --. (x -. y)`]));;
+
+let INTERVAL_NEG2 = prove(
+  `!x f ex. interval (--. x) f ex = interval x (--. f) ex`,
+ (REWRITE_TAC[interval;REAL_ABS_NEG;REAL_ARITH `!x y. -- x -. y = --. (x -. (--. y))`]));;
+
+
+let INTERVAL_SUB = prove(
+   `!x f ex y g ey. interval x f ex /\ interval y g ey ==> interval (x -. y) (f -. g) (ex +. ey)`,
+((REWRITE_TAC[real_sub]))
+THEN (DISCH_ALL_TAC)
+THEN (((H_RULER (ONCE_REWRITE_RULE))[THM(INTERVAL_NEG)] (HYP_INT 1)))
+THEN (((ASM MESON_TAC)[INTERVAL_ADD])));;
+
+(* ------------------------------------------------------------------ *)
+(*   INTERVAL MULTIPLICATION                                          *)
+(* ------------------------------------------------------------------ *)
+
+
+let REAL_PROP_LE_LABS = prove(
+  `!x y z. (y <=. z) ==> ((abs x)* y <=. (abs x) *z)`,(SIMP_TAC[REAL_LE_LMUL_IMP;ABS_POS]));;
+
+(* renamed from REAL_LE_ABS_RMUL *)
+let REAL_PROP_LE_RABS = prove(
+  `!x y z. (y <=. z) ==> ( y * (abs x) <=. z *(abs x))`,(SIMP_TAC[REAL_LE_RMUL_IMP;ABS_POS]));;
+
+let REAL_LE_ABS_MUL = prove(
+  `!x y z w. (( x <=. y) /\ (abs z <=. w)) ==> (x*.w <=. y*.w) `,
+(DISCH_ALL_TAC)
+THEN ((ASSUME_TAC (REAL_ARITH `abs z <=. w ==> (&.0) <=. w`)))
+THEN (((ASM MESON_TAC)[REAL_LE_RMUL_IMP])));;
+
+let INTERVAL_MUL = prove(
+  `!x f ex y g ey. (interval x f ex) /\ (interval y g ey) ==>
+         (interval (x *. y) (f *. g) (abs(f)*.ey +. ex*. abs(g) +. ex*.ey))`,
+(REP_GEN_TAC)
+THEN ((REWRITE_TAC[interval]))
+THEN ((REWRITE_TAC[REAL_ARITH `(x*. y -. f*. g) = (f *.(y -. g) +. (x -. f)*.g +. (x-.f)*.(y-. g))`]))
+THEN (DISCH_ALL_TAC)
+THEN ((ASSUME_TAC (SPECL [`f*.(y-g)`;`(x-f)*g +. (x-f)*.(y-g)`] ABS_TRIANGLE)))
+THEN ((ASSUME_TAC (SPECL [`(x-f)*.g`;`(x-f)*.(y-g)`] ABS_TRIANGLE)))
+THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1)))
+THEN ((H_REWRITE_RULE [THM ABS_MUL] (HYP_INT 0)))
+THEN ((H_MATCH_MP (THM (SPECL [`g:real`; `abs (x -. f)`; `ex:real`] REAL_PROP_LE_RABS)) (HYP_INT 4)))
+THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1)))
+THEN ((H_MATCH_MP (THM (SPECL [`f:real`; `abs (y -. g)`; `ey:real`] REAL_PROP_LE_LABS)) (HYP_INT 7)))
+THEN (((H_VAL2 (IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1)))
+THEN ((H_MATCH_MP (THM (SPECL [`x-.f`; `abs (y -. g)`; `ey:real`] REAL_PROP_LE_LABS)) (HYP_INT 9)))
+THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 1)))
+THEN ((ASSUME_TAC (SPECL [`abs(x-.f)`;`ex:real`;`y-.g`;`ey:real`] REAL_LE_ABS_MUL)))
+THEN ((H_CONJ (HYP_INT 11) (HYP_INT 12)))
+THEN ((H_MATCH_MP (HYP_INT 1) (HYP_INT 0)))
+THEN (((H_VAL2(IWRITE_REAL_LE_RHS)) (HYP_INT 0) (HYP_INT 3)))
+THEN ((POP_ASSUM ACCEPT_TAC)));;
+
+(* ------------------------------------------------------------------ *)
+(*   INTERVAL BASIC OPERATIONS                                        *)
+(* ------------------------------------------------------------------ *)
+
+
+let INTERVAL_NUM = prove(
+  `!n. (interval(&.n) (float(&:n) (&:0)) (float  (&: 0) (&:0)))`,
+(REWRITE_TAC[interval;float;TWOPOW_POS;pow;REAL_MUL_RID;INT_NUM_REAL;REAL_SUB_REFL;REAL_ABS_0;REAL_LE_REFL]));;
+
+let INTERVAL_CENTER = prove(
+  `!x f ex g. (interval x f ex) ==> (interval x g (abs(f-g)+.ex))`,
+((REWRITE_TAC[interval]))
+THEN (DISCH_ALL_TAC)
+THEN ((ASSUME_TAC (REAL_ARITH `abs(x -. g) <=. abs(f-.g) +. abs(x -. f)`)))
+THEN ((H_VAL2 IWRITE_REAL_LE_RHS (HYP_INT 1) (HYP_INT 0)))
+THEN ((ASM_REWRITE_TAC[])));;
+
+let INTERVAL_WIDTH = prove(
+  `!x f ex ex'. (ex <=. ex') ==> (interval x f ex) ==> (interval x f ex')`,
+((REWRITE_TAC[interval]))
+THEN (DISCH_ALL_TAC)
+THEN ((H_VAL2 IWRITE_REAL_LE_RHS (HYP_INT 1) (HYP_INT 0)))
+THEN ((ASM_REWRITE_TAC[])));;
+
+let INTERVAL_MAX = prove(
+  `!x f ex. interval x f ex ==> (x <=. f+.ex)`,
+(REWRITE_TAC[interval]) THEN REAL_ARITH_TAC);;
+
+let INTERVAL_MIN = prove(
+  `!x f ex. interval x f ex ==> (f-. ex <=. x)`,
+(REWRITE_TAC[interval]) THEN REAL_ARITH_TAC);;
+
+let INTERVAL_ABS_MIN = prove(
+  `!x f ex. interval x f ex ==> (abs(f)-. ex <=. abs(x))`,
+  (REWRITE_TAC[interval] THEN REAL_ARITH_TAC)
+);;
+
+let INTERVAL_ABS_MAX = prove(
+  `!x f ex. interval x f ex ==> (abs(x) <=. abs(f)+. ex)`,
+  (REWRITE_TAC[interval] THEN REAL_ARITH_TAC)
+);;
+
+let REAL_RINV_2 = prove(
+  `&.2 *. (inv (&.2 )) = &. 1`,
+EVERY[
+  MATCH_MP_TAC REAL_MUL_RINV;
+  REAL_ARITH_TAC]);;
+
+let INTERVAL_MK = prove(
+   `let half = float(&:1)(--:(&:1)) in
+    !x xmin xmax. ((xmin <=. x) /\ (x <=. xmax)) ==>
+      interval x
+         ((xmin+.xmax)*.half)
+         ((xmax-.xmin)*.half)`,
+EVERY[
+  REWRITE_TAC[LET_DEF;LET_END_DEF];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[interval;float;TWOPOW_NEG;INT_NUM_REAL;REAL_POW_1;REAL_MUL_LID];
+  REWRITE_TAC[GSYM INTERVAL_ABS];
+  CONJ_TAC
+  ]
+THENL[
+  EVERY[
+    REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
+    REWRITE_TAC[REAL_ARITH `(b+.a)-.(a-.b)=b*.(&.2)`;GSYM REAL_MUL_ASSOC];
+    ASM_REWRITE_TAC[REAL_RINV_2;REAL_MUL_RID]
+  ];
+  EVERY[
+    REWRITE_TAC[GSYM REAL_ADD_RDISTRIB];
+    REWRITE_TAC[REAL_ARITH `(b+.a)+. a -. b=a*.(&.2)`;GSYM REAL_MUL_ASSOC];
+    ASM_REWRITE_TAC[REAL_RINV_2;REAL_MUL_RID]
+  ]
+]);;
+
+let INTERVAL_EPS_POS = prove(`!x f ex.
+  (interval x f ex) ==> (&.0 <=. ex)`,
+EVERY[
+  REWRITE_TAC[interval];
+  REPEAT (GEN_TAC);
+  DISCH_THEN(fun x -> (MP_TAC (CONJ (SPEC `x-.f` REAL_ABS_POS) x)));
+  MATCH_ACCEPT_TAC REAL_LE_TRANS]);;
+
+let INTERVAL_EPS_0 = prove(
+  `!x f n. (interval x f (float (&:0) n)) ==> (x = f)`,
+EVERY[
+  REWRITE_TAC[interval;float;int_of_num_th;REAL_MUL_LZERO];
+  REAL_ARITH_TAC]);;
+
+
+
+let REAL_EQ_RCANCEL_IMP' = prove(`!x y z.(x * z = y * z) ==> (~(z = &0) ==> (x=y))`,
+  MESON_TAC[REAL_EQ_RCANCEL_IMP]);;
+
+(* renamed from REAL_ABS_POS *)
+let REAL_MK_POS_ABS_' = prove (`!x. (~(x=(&.0))) ==> (&.0 < abs(x))`,
+  MESON_TAC[REAL_PROP_NZ_ABS;ABS_POS;REAL_LT_LE]);;
+
+(* ------------------------------------------------------------------ *)
+(*   INTERVAL DIVIDE                                                  *)
+(* ------------------------------------------------------------------ *)
+
+let INTERVAL_DIV = prove(`!x f ex y g ey h ez.
+  (((interval x f ex) /\ (interval y g ey) /\ (ey <. (abs g)) /\
+  ((ex +. (abs (f -. (h*.g))) +. (abs h)*. ey) <=. (ez*.((abs g) -. ey))))
+  ==> (interval (x / y) h ez))`,
+
+let lemma1 = prove( `&.0 < u /\ ||. z <=. e*. u ==> (&.0) <=. e`,
+  EVERY[
+    DISCH_ALL_TAC;
+    ASSUME_TAC (SPEC `z:real` REAL_MK_NN_ABS);
+    H_MATCH_MP (THM REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 0) (HYP_INT 2));
+    H_MATCH_MP (THM REAL_PROP_NN_RCANCEL) (H_RULE2 CONJ (HYP_INT 2) (HYP_INT 0));
+    ASM_REWRITE_TAC[]
+  ]) in
+EVERY[
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `~(y= (&.0))`
+  THENL[
+    EVERY[
+      UNDISCH_LIST[1;2];
+      REWRITE_TAC[interval];
+      REAL_ARITH_TAC
+    ];
+    EVERY[
+      REWRITE_TAC[interval];
+      DISCH_TAC THEN (H I (HYP_INT 0)) THEN (UNDISCH_EL_TAC 0);
+      DISCH_THEN (fun th -> (MP_TAC(MATCH_MP REAL_MK_POS_ABS_' th)));
+      MATCH_MP_TAC REAL_MUL_RTIMES_LE;
+      REWRITE_TAC[GSYM ABS_MUL;REAL_SUB_RDISTRIB;real_div;GSYM REAL_MUL_ASSOC];
+      ASM_SIMP_TAC[REAL_MUL_LINV;REAL_MUL_RID];
+      H (REWRITE_RULE[interval]) (HYP_INT 1);
+      H (REWRITE_RULE[interval]) (HYP_INT 3);
+      H (MATCH_MP INTERVAL_ABS_MIN) (HYP_INT 4);
+      POPL_TAC[3;4;5];
+      H_VAL2 (IWRITE_REAL_LE_LHS) (HYP_INT 2) (HYP_INT 4);
+      H (REWRITE_RULE[ REAL_ADD_ASSOC]) (HYP_INT 0);
+      H_VAL2 (IWRITE_REAL_LE_LHS) (THM (SPEC `f-. h*g` (SPEC `x-.f` ABS_TRIANGLE))) (HYP_INT 0);
+      H (ONCE_REWRITE_RULE[REAL_ABS_SUB]) (HYP_INT 4);
+      H (MATCH_MP (SPEC `h:real` REAL_PROP_LE_LABS)) (HYP_INT 0);
+      H (REWRITE_RULE[GSYM ABS_MUL]) (HYP_INT 0);
+      H_VAL2 (IWRITE_REAL_LE_LHS) (HYP_INT 0) (HYP_INT 3);
+      H_VAL2 (IWRITE_REAL_LE_LHS) (THM (SPEC `h*.(g-.y)` (SPEC`(x-.f)+(f-. h*g)`  ABS_TRIANGLE))) (HYP_INT 0);
+      POPL_TAC[1;2;3;4;5;6;7;9;10;12];
+      H (ONCE_REWRITE_RULE[REAL_ARITH `((x-.f) +. (f -. h*. g)) +. h*.(g-. y) = x -. h*. y `]) (HYP_INT 0);
+      ABBREV_TAC `z = x -. h*.y`;
+      H (ONCE_REWRITE_RULE[GSYM REAL_SUB_LT]) (HYP_INT 4);
+      ABBREV_TAC `u = abs(g) -. ey`;
+      POPL_TAC[0;2;4;6];
+      H (MATCH_MP lemma1 ) (H_RULE2 CONJ (HYP_INT 0) (HYP_INT 1));
+      H (MATCH_MP REAL_PROP_LE_LMUL) (H_RULE2 CONJ (HYP_INT 0) (HYP_INT 3));
+      H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 3) (HYP_INT 0));
+      ASM_REWRITE_TAC[]
+  ];
+  ]]);;
+
+(* ------------------------------------------------------------------ *)
+(*   INTERVAL ABS VALUE                                               *)
+(* ------------------------------------------------------------------ *)
+
+let INTERVAL_ABSV = prove(`!x f ex. interval x f ex ==> (interval (abs x) (abs f) ex)`,
+EVERY[
+  REWRITE_TAC[interval];
+  DISCH_ALL_TAC;
+  ASSUME_TAC (SPECL [`x:real`;`f:real`] REAL_ABS_SUB_ABS);
+  ASM_MESON_TAC[REAL_LE_TRANS]
+]);;  (* 7 minutes *)
+
+(* ------------------------------------------------------------------ *)
+(*   INTERVAL SQRT                                                    *)
+(*   This requires some preliminaries. Extend sqrt by 0 on negatives  *)
+(* ------------------------------------------------------------------ *)
+
+let ssqrt = new_definition `ssqrt x = if (x <. (&.0)) then (&.0) else sqrt x`;; (*2m*)
+
+let LET_TAC = REWRITE_TAC[LET_DEF;LET_END_DEF];;
+
+
+let REAL_SSQRT_NEG = prove(`!x. (x <. (&.0)) ==> (ssqrt x = (&.0))`,
+  EVERY[
+    DISCH_ALL_TAC;
+    REWRITE_TAC[ssqrt];
+    COND_CASES_TAC
+    THENL[
+      ACCEPT_TAC (REFL `&.0`);
+      ASM_MESON_TAC[]
+    ]
+  ]);;
+(* 5 min*)
+
+let REAL_SSQRT_NN = prove(`!x. (&.0) <=. x ==> (ssqrt x = (sqrt x))`,
+  EVERY[
+  DISCH_ALL_TAC;
+  REWRITE_TAC[ssqrt];
+  COND_CASES_TAC
+  THENL[
+    ASM_MESON_TAC[real_lt];
+    ACCEPT_TAC (REFL `sqrt x`)
+  ]
+  ]);;  (* 12 min, mostly spent loading *index-shell* *)
+
+
+(*17 minutes*)
+let REAL_MK_NN_SSQRT = prove(`!x. (&.0) <=. (ssqrt x)`,
+  EVERY[
+    GEN_TAC;
+    DISJ_CASES_TAC (SPECL[`x:real`;`&.0`] REAL_LTE_TOTAL)
+    THENL[
+      POP_ASSUM (fun th -> MP_TAC(MATCH_MP (REAL_SSQRT_NEG) th)) THEN
+      MESON_TAC[REAL_LE_REFL];
+      POP_ASSUM (fun th -> ASSUME_TAC(CONJ th (MATCH_MP (REAL_SSQRT_NN) th)))  THEN
+      ASM_MESON_TAC[REAL_PROP_NN_SQRT]
+    ]
+  ]);;
+
+let REAL_SV_SSQRT_0  = prove(`!x. ssqrt (&.0) = (&.0)`,
+  EVERY[
+    GEN_TAC;
+    MP_TAC (SPEC `&.0` REAL_LE_REFL);
+    DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_SSQRT_NN th]);
+    ACCEPT_TAC REAL_SV_SQRT_0
+  ]);; (* 6 minutes *)
+
+
+let REAL_SSQRT_EQ_0 = prove(`!(x:real). (ssqrt(x) = (&.0)) ==> (x <=. (&.0))`,
+  EVERY[
+    GEN_TAC;
+    DISJ_CASES_TAC (SPECL[`x:real`;`&.0`] REAL_LTE_TOTAL)
+    THENL[
+      ASM_MESON_TAC[REAL_LT_IMP_LE];
+      ASM_SIMP_TAC[REAL_SSQRT_NN] THEN
+      ASM_MESON_TAC[SQRT_EQ_0;REAL_EQ_IMP_LE]
+    ]
+  ]);;  (* 15 minutes *)
+
+
+let REAL_SSQRT_MONO = prove(`!x. (x<=. y) ==> (ssqrt x <=. (ssqrt y))`,
+  EVERY[
+    GEN_TAC;
+    DISJ_CASES_TAC (SPECL[`x:real`;`&.0`] REAL_LTE_TOTAL)
+      THENL[
+        ASM_MESON_TAC[REAL_SSQRT_NEG;REAL_MK_NN_SSQRT];
+        ASM_MESON_TAC[REAL_LE_TRANS;REAL_SSQRT_NN;REAL_PROP_LE_SQRT];
+      ]
+  ]);;  (* 5 minutes *)
+
+let REAL_SSQRT_CHAR = prove(`!x t. (&.0 <=. t /\ (t*t = x)) ==> (t = (ssqrt x))`,
+  EVERY[
+    DISCH_ALL_TAC;
+    H_ASSUME_TAC (H_RULE_LIST REWRITE_RULE[HYP_INT 1] (THM (SPEC `t:real` REAL_MK_NN_SQUARE)));
+    ASM_MESON_TAC[REAL_SSQRT_NN;SQRT_MUL;POW_2_SQRT_ABS;REAL_POW_2;REAL_ABS_REFL];
+  ]);;  (* 13 minutes *)
+
+let REAL_SSQRT_SQUARE = prove(`!x. (&.0 <=. x) ==> ((ssqrt x)*.(ssqrt x) = x)`,
+  MESON_TAC[REAL_SSQRT_NN;POW_2;SQRT_POW_2]);;(* 7min *)
+
+let REAL_SSQRT_SQUARE' = prove(`!x. (&.0<=. x) ==> (ssqrt (x*.x) = x)`,
+  DISCH_ALL_TAC THEN
+  REWRITE_TAC[(MATCH_MP REAL_SSQRT_NN (SPEC `x:real` REAL_MK_NN_SQUARE))] THEN
+  ASM_SIMP_TAC[SQRT_MUL;GSYM POW_2;SQRT_POW_2]);; (*20min*)
+
+
+(* an alternate proof appears in RCS *)
+let INTERVAL_SSQRT = prove(`!x f ex u ey ez v. (interval x f ex) /\ (interval (u*.u) f ey) /\
+  (ex +.ey <=. ez*.(v+.u)) /\ (v*.v <=. f-.ex) /\ (&.0 <. u) /\ (&.0 <=. v) ==>
+  (interval (ssqrt x) u ez)`,
+EVERY[
+  DISCH_ALL_TAC;
+  H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (THM (SPEC `v:real` REAL_MK_NN_SQUARE)) (HYP_INT 3));
+  H (MATCH_MP (INTERVAL_MIN)) (HYP_INT 1);
+  H (MATCH_MP REAL_LE_TRANS)  (H_RULE2 CONJ (HYP_INT 1) (HYP_INT 0));
+  H (MATCH_MP INTERVAL_EPS_POS) (HYP_INT 3);
+  H (MATCH_MP INTERVAL_EPS_POS) (HYP_INT 5);
+  H (MATCH_MP REAL_PROP_NN_ADD2) (H_RULE2 CONJ (HYP_INT 1) (HYP_INT 0));
+  H (MATCH_MP REAL_PROP_POS_LADD) (H_RULE2 CONJ (HYP_INT 11) (HYP_INT 10));
+  H (MATCH_MP REAL_PROP_POS_LADD) (H_RULE2 CONJ (THM (SPEC `x:real` REAL_MK_NN_SSQRT)) (HYP_INT 11));
+  H (MATCH_MP REAL_PROP_POS_INV) (HYP_INT 0);
+  ASSUME_TAC (REAL_ARITH  `(ssqrt x -. u) = (ssqrt x -. u)*.(&.1)`);
+  H (MATCH_MP REAL_MK_NZ_POS) (HYP_INT 2);
+  H (MATCH_MP REAL_MUL_RINV) (HYP_INT 0);
+  H_REWRITE_RULE[(H_RULE GSYM) (HYP_INT 0)] (HYP_INT 2);
+  POPL_TAC[1;2;3];
+  H (REWRITE_RULE[REAL_MUL_ASSOC]) (HYP_INT 0);
+  H (REWRITE_RULE[ONCE_REWRITE_RULE[REAL_MUL_SYM] REAL_DIFFSQ]) (HYP_INT 0);
+  POPL_TAC[1;2];
+  H_SIMP_RULE[HYP_INT 7;THM REAL_SSQRT_SQUARE] (HYP_INT 0);
+  ASSUME_TAC (REAL_ARITH `abs(x -. u*.u) <=. abs(x -. f) + abs(f-. u*.u)`);
+  H (REWRITE_RULE[interval]) (HYP_INT 12);
+  H (ONCE_REWRITE_RULE[interval]) (HYP_INT 14);
+  H (ONCE_REWRITE_RULE[REAL_ABS_SUB]) (HYP_INT 0);
+  POPL_TAC[1;5;15;16];
+  H (MATCH_MP REAL_LE_ADD2) (H_RULE2 CONJ (HYP_INT 1) (HYP_INT 0));
+  H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 3) (HYP_INT 0));
+  POPL_TAC[1;2;3;4];
+  H (AP_TERM `||.`) (HYP_INT 1);
+  H (REWRITE_RULE[ABS_MUL]) (HYP_INT 0);
+  H (MATCH_MP REAL_LT_IMP_LE)  (HYP_INT 4);
+  H (REWRITE_RULE[GSYM REAL_ABS_REFL]) (HYP_INT 0);
+  H_REWRITE_RULE [HYP_INT 0] (HYP_INT 2);
+  H (MATCH_MP REAL_LE_RMUL) (H_RULE2 CONJ (HYP_INT 5) (HYP_INT 2));
+  H_REWRITE_RULE [H_RULE GSYM (HYP_INT 1)] (HYP_INT 0);
+  POPL_TAC[1;2;3;5;6;7;8];
+  H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 12) (HYP_INT 9));
+  H (MATCH_MP REAL_SSQRT_MONO) (HYP_INT 0);
+  H (MATCH_MP REAL_SSQRT_SQUARE') (HYP_INT 16);
+  H_REWRITE_RULE [HYP_INT 0] (HYP_INT 1);
+  H (ONCE_REWRITE_RULE[GSYM (SPECL[`v:real`;`ssqrt x`;`u:real`] REAL_LE_RADD)]) (HYP_INT 0);
+  H (MATCH_MP REAL_LE_INV2) (H_RULE2 CONJ (HYP_INT 9) (HYP_INT 0));
+  POPL_TAC[1;2;3;4;5;7;8;9;12;13];
+  H (MATCH_MP REAL_LE_LMUL) (H_RULE2 CONJ (HYP_INT 3) (HYP_INT 0));
+  H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 2) (HYP_INT 0));
+  H (MATCH_MP REAL_PROP_POS_INV) (HYP_INT 4);
+  H (MATCH_MP REAL_LT_IMP_LE) (HYP_INT 0);
+  H (MATCH_MP REAL_LE_RMUL) (H_RULE2 CONJ (HYP_INT 11) (HYP_INT 0));
+  H (REWRITE_RULE[GSYM REAL_MUL_ASSOC]) (HYP_INT 0);
+  H (MATCH_MP REAL_MK_NZ_POS) (HYP_INT 8);
+  H (MATCH_MP REAL_MUL_RINV) (HYP_INT 0);
+  H_REWRITE_RULE[HYP_INT 0; THM REAL_MUL_RID] (HYP_INT 2);
+  H (MATCH_MP REAL_LE_TRANS) (H_RULE2 CONJ (HYP_INT 7) (HYP_INT 0));
+  ASM_REWRITE_TAC[interval]
+  ]);;
+
+
+
+test();;
+
+
+(* conversion for interval *)
+
+(* ------------------------------------------------------------------ *)
+(*   Take a term x of type real.  Convert to a thm of the form        *)
+(*   interval x f eps                                                 *)
+(*                                                                    *)
+(* ------------------------------------------------------------------ *)
+
+let DOUBLE_CONV_FILE=true;;
+
+let add_test,test = new_test_suite();;
+
+(* Num package docs at http://caml.inria.fr/ocaml/htmlman/libref/Num.html *)
+
+(* ------------------------------------------------------------------ *)
+(* num_exponent
+   Take the absolute value of input.
+   Write it as a*2^k, where 1 <= a < 2, return k.
+
+   Except:
+   num_exponent (Int 0) is -1.
+*)
+let (num_exponent:Num.num -> Num.num) =
+  fun a ->
+    let afloat = float_of_num (abs_num a) in
+    Int ((snd (frexp afloat)) - 1);;
+
+(*test*)let f (u,v) = ((num_exponent u) =(Int v)) in
+    add_test("num_exponenwt",
+                forall f
+    [Int 1,0; Int 65,6; Int (-65),6;
+     Int 0,-1; (Int 3)//(Int 4),-1]);;
+(* ------------------------------------------------------------------ *)
+
+let dest_unary op tm =
+  try let xop,r = dest_comb tm in
+      if xop = op then r else fail()
+  with Failure _ -> failwith "dest_unary";;
+
+
+(* ------------------------------------------------------------------ *)
+
+
+(* finds a nearby (outward-rounded) Int with only prec_b significant bits *)
+let (round_outward: int -> Num.num -> Num.num) =
+  fun prec_b a ->
+    let b = abs_num a in
+    let sign = if (a =/ b) then I else minus_num in
+    let throw_bits = Num.max_num (Int 0) ((num_exponent b)-/ (Int prec_b)) in
+    let twoexp = power_num (Int 2) throw_bits  in
+    (sign (ceiling_num (b // twoexp)))*/twoexp;;
+
+let (round_inward: int-> Num.num -> Num.num) =
+  fun prec_b a ->
+    let b = abs_num a in
+    let sign = if (a=/b) then I else minus_num in
+    let throw_bits = Num.max_num (Int 0) ((num_exponent b)-/ (Int prec_b)) in
+    let twoexp = power_num (Int 2) throw_bits  in
+    (sign (floor_num (b // twoexp)))*/twoexp;;
+
+let round_rat bprec n =
+  let b = abs_num n in
+  let sign = if (b =/ n) then I else minus_num in
+  let powt  = ((Int 2) **/ (Int bprec)) in
+  sign ((round_outward bprec (Num.ceiling_num (b */ powt)))//powt);;
+
+let round_inward_rat bprec n =
+  let b = abs_num n in
+  let sign = if (b =/ n) then I else minus_num in
+  let powt  = ((Int 2) **/ (Int bprec)) in
+  sign ((round_inward bprec (Num.floor_num (b */ powt)))//powt);;
+
+let (round_outward_float: int -> float -> Num.num) =
+ fun  bprec f ->
+  if (f=0.0) then (Int 0) else
+  begin
+    let b = abs_float f in
+    let sign = if (f >= 0.0) then I else minus_num in
+    let (x,n) = frexp b in
+    let u = int_of_float( ceil (ldexp x bprec)) in
+    sign ((Int u)*/ ((Int 2) **/ (Int (n - bprec))))
+  end;;
+
+let (round_inward_float: int -> float -> Num.num) =
+ fun  bprec f ->
+  if (f=0.0) then (Int 0) else
+  begin
+    (* avoid overflow on 30 bit integers *)
+    let bprec = if (bprec > 25) then 25 else bprec in
+    let b = abs_float f in
+    let sign = if (f >= 0.0) then I else minus_num in
+    let (x,n) = frexp b in
+    let u = int_of_float( floor (ldexp x bprec)) in
+    sign ((Int u)*/ ((Int 2) **/ (Int (n - bprec))))
+  end;;
+
+(* ------------------------------------------------------------------ *)
+
+(* This doesn't belong here.  A general term substitution function *)
+let SUBST_TERM sublist tm =
+  rhs (concl ((SPECL (map fst sublist)) (GENL (map snd sublist)
+                                          (REFL tm))));;
+
+add_test("SUBST_TERM",
+ SUBST_TERM [(`#1`,`a:real`);(`#2`,`b:real`)] (`a +. b +. c`) =
+ `#1 + #2 + c`);;
+
+(* ------------------------------------------------------------------ *)
+
+(* take a term of the form `interval x f ex` and clean up the f and ex *)
+
+let INTERVAL_CLEAN_CONV:conv =
+  fun interv ->
+    let (ixf,ex) = dest_comb interv in
+    let (ix,f) = dest_comb ixf in
+    let fthm = FLOAT_CONV f in
+    let exthm = FLOAT_CONV ex in
+    let ixfthm = AP_TERM ix fthm in
+    MK_COMB (ixfthm, exthm);;
+
+(*test*) add_test("INTERVAL_CLEAN_CONV",
+  let testval = INTERVAL_CLEAN_CONV `interval ((&.1) +. (&.1))
+       (float (&:3) (&:4) +. (float (&:2) (--: (&:3))))
+       (float (&:1) (&:2) *. (float (&:3) (--: (&:2))))` in
+  let hypval = hyp testval in
+  let concval = concl testval in
+        (length hypval = 0) &&
+        concval =
+     `interval (&1 + &1) (float (&:3) (&:4) + float (&:2) (--: (&:3)))
+     (float (&:1) (&:2) * float (&:3) (--: (&:2))) =
+     interval (&1 + &1) (float (&:386) (--: (&:3))) (float (&:3) (&:0))`
+                  );;
+
+(* ------------------------------------------------------------------ *)
+(*   GENERAL lemmas                                                   *)
+(* ------------------------------------------------------------------ *)
+
+
+(* verifies statement of the form `float a b = float a' b'` *)
+
+let FLOAT_EQ = prove(
+  `!a b a' b'.  (float a b = (float a'  b')) <=>
+        ((float a b) -. (float a' b') = (&.0))`,MESON_TAC[REAL_SUB_0]);;
+
+let FLOAT_LT = prove(
+  `!a b a' b'. (float a b <. (float a' b')) <=>
+        ((&.0) <. (float a' b') -. (float a b))`,MESON_TAC[REAL_SUB_LT]);;
+
+let FLOAT_LE = prove(
+  `!a b a' b'. (float a b <=. (float a' b')) <=>
+        ((&.0) <=. (float a' b') -. (float a b))`,MESON_TAC[REAL_SUB_LE]);;
+
+let TWOPOW_MK_POS = prove(
+  `!a. (&.0 <. ( twopow a))`,
+EVERY[
+  GEN_TAC;
+  CHOOSE_TAC (SPEC `a:int` INT_REP2);
+  POP_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[TWOPOW_POS;TWOPOW_NEG];
+  TRY (MATCH_MP_TAC REAL_INV_POS);
+  MATCH_MP_TAC REAL_POW_LT ;
+  REAL_ARITH_TAC;
+]);;
+
+let TWOPOW_NZ = prove(
+  `!a. ~(twopow a = (&.0))`,
+  GEN_TAC THEN
+  ACCEPT_TAC (MATCH_MP REAL_MK_NZ_POS (SPEC `a:int` TWOPOW_MK_POS)));;
+
+let FLOAT_ZERO = prove(
+  `!a b. (float a b = (&.0)) <=> (a = (&:0))`,
+EVERY[
+  REWRITE_TAC[float;REAL_ENTIRE;INT_OF_NUM_DEST];
+  MESON_TAC[TWOPOW_NZ];
+]);;
+
+let INT_ZERO = prove(
+  `!n. ((&:n = (&:0)) = (n=0))`,REWRITE_TAC[INT_OF_NUM_EQ]);;
+
+let INT_ZERO_NEG=prove(
+  `!n. ((--: (&:n) = (&:0))) <=> (n=0)`,
+    REWRITE_TAC[INT_NEG_EQ_0;INT_ZERO]);;
+
+let FLOAT_NN = prove(
+  `!a b. ((&.0) <=. (float a b)) <=> (&:0 <=: a)`,
+EVERY[
+  REWRITE_TAC[float;INT_OF_NUM_DEST];
+  REP_GEN_TAC;
+  EQ_TAC THENL[EVERY[
+  DISCH_ALL_TAC;
+  INPUT_COMBO[THM REAL_PROP_NN_RCANCEL;THM (SPEC `b:int` TWOPOW_MK_POS) &&& (HYP"0")];
+  ASM_MESON_TAC[int_le;int_of_num_th]];
+  EVERY[
+  DISCH_ALL_TAC;
+  INPUT_COMBO[THM REAL_PROP_NN_POS;THM(SPEC`b:int`TWOPOW_MK_POS)];
+  INPUT_COMBO[THM int_of_num_th   ; THM int_le ;(HYP"0")];
+  INPUT_COMBO[THM REAL_PROP_NN_MUL2; (HYP"2")&&&(HYP"1")];
+  ASM_REWRITE_TAC[]]]
+]);;
+
+let INT_NN = INT_POS;;
+
+let INT_NN_NEG = prove(`!n. ((&:0) <=: (--:(&:n))) <=> (n = 0)`,
+  REWRITE_TAC[INT_NEG_GE0;INT_OF_NUM_LE] THEN ARITH_TAC
+                      );;
+
+let FLOAT_POS = prove(`!a b. ((&.0) <. (float a b)) <=> (&:0 <: a)`,
+  MESON_TAC[FLOAT_NN;FLOAT_ZERO;INT_LT_LE;REAL_LT_LE]);;
+
+let INT_POS' = prove(`!n. (&:0) <: (&:n) <=> (~(n=0) )`,
+  REWRITE_TAC[INT_OF_NUM_LT] THEN ARITH_TAC);;
+
+let INT_POS_NEG =prove(`!n. ((&:0) <: (--:(&:n))) <=> F`,
+  REWRITE_TAC[INT_OF_NUM_LT] THEN ARITH_TAC);;
+
+let RAT_LEMMA1_SUB = prove(`~(y1 = &0) /\ ~(y2 = &0) ==>
+      ((x1 / y1) - (x2 / y2) = (x1 * y2 - x2 * y1) * inv(y1) * inv(y2))`,
+  EVERY[REWRITE_TAC[real_div];
+  REWRITE_TAC[real_sub;GSYM REAL_MUL_LNEG];
+  REWRITE_TAC[GSYM real_div];
+  SIMP_TAC[RAT_LEMMA1];
+  DISCH_TAC;
+  MESON_TAC[real_div]]);;
+
+let INTERVAL_0 = prove(`! a f ex. (interval a f ex <=> (&.0 <= (ex - (abs (a -. f)))))`,
+   MESON_TAC[interval;REAL_SUB_LE]);;
+
+
+
+let ABS_NUM = prove (`!m n. abs (&. n -. (&. m)) = &.((m-|n) + (n-|m))`,
+  REPEAT GEN_TAC THEN
+  DISJ_CASES_TAC (SPECL [`m:num`;`n:num`] LTE_CASES) THENL[
+  (* first case *)
+  EVERY[ LABEL_ALL_TAC;
+  H_REWRITE_RULE [THM (GSYM REAL_OF_NUM_LT)] (HYP "0");
+  LABEL_ALL_TAC;
+  H_ONCE_REWRITE_RULE[THM (GSYM REAL_SUB_LT)] (HYP "1");
+  LABEL_ALL_TAC;
+  H_MATCH_MP (THM REAL_LT_IMP_LE) (HYP "2");
+  LABEL_ALL_TAC;
+  H_REWRITE_RULE [THM (GSYM ABS_REFL)] (HYP "3");
+  ASM_REWRITE_TAC[];
+  H_MATCH_MP (THM LT_IMP_LE) (HYP "0");
+  ASM_SIMP_TAC[REAL_OF_NUM_SUB];
+  REWRITE_TAC[REAL_OF_NUM_EQ];
+  ONCE_REWRITE_TAC[ARITH_RULE `!x:num y:num. (x = y) = (y  = x)`];
+  REWRITE_TAC[EQ_ADD_RCANCEL_0];
+  ASM_REWRITE_TAC[SUB_EQ_0]];
+  (* second case *)
+  EVERY[LABEL_ALL_TAC;
+  H_REWRITE_RULE [THM (GSYM REAL_OF_NUM_LE)] (HYP "0");
+  LABEL_ALL_TAC;
+  H_ONCE_REWRITE_RULE[THM (GSYM REAL_SUB_LE)] (HYP "1");
+  LABEL_ALL_TAC;
+  H_REWRITE_RULE [THM (GSYM ABS_REFL)] (HYP "2");
+  ONCE_REWRITE_TAC[GSYM REAL_ABS_NEG];
+  REWRITE_TAC[REAL_ARITH `!x y. --.(x -. y) = (y-x)`];
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[REAL_OF_NUM_SUB];
+  REWRITE_TAC[REAL_OF_NUM_EQ];
+  ONCE_REWRITE_TAC[ARITH_RULE `!x:num y:num. (x = y) <=> (y  = x)`];
+  REWRITE_TAC[EQ_ADD_LCANCEL_0];
+  ASM_REWRITE_TAC[SUB_EQ_0]]]);;
+
+let INTERVAL_TO_LESS = prove(
+  `!a f ex b g ey. ((interval a f ex) /\ (interval b g ey) /\
+      (&.0 <. (g -. (ey +. ex +. f)))) ==> (a <. b)`,
+   let lemma1 = REAL_ARITH `!ex ey f g. (&.0 <.
+     (g -. (ey +. ex +. f))) ==> ((f +. ex)<. (g -. ey)) ` in
+   EVERY[
+   REPEAT GEN_TAC;
+   DISCH_ALL_TAC;
+   H_MATCH_MP (THM lemma1) (HYP "2");
+   H_MATCH_MP (THM INTERVAL_MAX) (HYP "0");
+   H_MATCH_MP (THM INTERVAL_MIN) (HYP "1");
+   LABEL_ALL_TAC;
+   H_MATCH_MP (THM REAL_LET_TRANS) (H_RULE2 CONJ (HYP "4") (HYP "5"));
+   LABEL_ALL_TAC;
+   H_MATCH_MP (THM REAL_LTE_TRANS) (H_RULE2 CONJ (HYP "6") (HYP "3"));
+   ASM_REWRITE_TAC[]
+   ]);;
+
+let ABS_TO_INTERVAL = prove(
+  `!c u k. (abs (c - u) <=. k) ==> (!f g ex ey.((interval u f ex) /\ (interval k g ey) ==> (interval c f (g+.ey+.ex))))`,
+   EVERY[
+   REWRITE_TAC[interval];
+   DISCH_ALL_TAC;
+   REPEAT GEN_TAC;
+   DISCH_ALL_TAC;
+   ONCE_REWRITE_TAC [REAL_ARITH `c -. f = (c-. u) + (u-. f)`];
+   ONCE_REWRITE_TAC [REAL_ADD_ASSOC];
+   ASSUME_TAC (SPECL [`c-.u`;`u-.f`] ABS_TRIANGLE);
+   IMP_RES_THEN ASSUME_TAC (REAL_ARITH `||.(k-.g) <=. ey ==> (k <=. (g +. ey))`);
+   MATCH_MP_TAC (REAL_ARITH `(?a b.((x <=. (a+.b)) /\ (a <=. u) /\ (b <=. v)))  ==> (x <=. (u +. v))`);
+   EXISTS_TAC `abs (c-.u)`;
+   EXISTS_TAC `abs(u-.f)`;
+   ASM_REWRITE_TAC[];
+   ASM_MESON_TAC[REAL_LE_TRANS];
+   ]);;
+
+
+(* end of general lemmas *)
+(* ------------------------------------------------------------------ *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Cache of computed constants (abs (c - u) <= k)  *)
+(* ------------------------------------------------------------------ *)
+
+let calculated_constants = ref ([]:(term*thm) list);;
+
+let add_real_constant ineq =
+  try(
+  let (abst,k) = dest_binop `(<=.)` (concl ineq) in
+  let (absh,cmu) = dest_comb abst in
+  let (c,u) = dest_binop `(-.)` cmu in
+  calculated_constants := (c,ineq)::(!calculated_constants))
+  with _ ->
+  (try(
+  let (c,f,ex) = dest_interval (concl ineq) in
+  calculated_constants :=  (c,ineq)::(!calculated_constants))
+  with _ -> failwith "calculated_constants format : abs(c - u) <= k");;
+
+let get_real_constant tm =
+  assoc tm !calculated_constants;;
+
+let remove_real_constant tm =
+  calculated_constants :=
+    filter (fun t -> not ((fst t) = tm)) !calculated_constants;;
+
+
+
+(* ------------------------------------------------------------------ *)
+
+(* term of the form '&.n'. Assume error checking done already. *)
+let INTERVAL_OF_NUM:conv =
+  fun tm ->
+    let tm1 = snd (dest_comb tm) in
+    let th1 = (ARITH_REWRITE_CONV[] tm1) in
+    ONCE_REWRITE_RULE[AP_TERM `&.` (GSYM th1)]
+      (SPEC (rhs (concl th1)) INTERVAL_NUM);;
+
+add_test("INTERVAL_OF_NUM",
+   dest_thm (INTERVAL_OF_NUM `&.3`) = ([],
+   `interval (&3) (float (&:3) (&:0)) (float (&:0) (&:0))`));;
+
+(* term of the form `--. (&.n)`.  Assume format checking already done. *)
+let INTERVAL_OF_NEG:conv =
+  fun tm ->
+    let (sign,u) = dest_comb tm in
+    let _ = assert(sign = `--.`) in
+    let (amp,tm1) = (dest_comb u) in
+    let _ = assert(amp = `&.`) in
+    let th1 = (ARITH_REWRITE_CONV[] tm1) in
+    ONCE_REWRITE_RULE[FLOAT_NEG] (
+    ONCE_REWRITE_RULE[INTERVAL_NEG] (
+    ONCE_REWRITE_RULE[AP_TERM `&.` (GSYM th1)] (
+       (SPEC (rhs (concl th1)) INTERVAL_NUM))));;
+
+add_test("INTERVAL_OF_NEG",
+   dest_thm (INTERVAL_OF_NEG `--.(&. (3+4))`) =
+   ([],`interval( --.(&.(3 + 4)) )
+      (float (--: (&:7)) (&:0)) (float (&:0) (&:0))`));;
+
+(* ------------------------------------------------------------------ *)
+
+let INTERVAL_TO_LESS_CONV = fun thm1 thm2 ->
+   let (a,f,ex) = dest_interval (concl thm1) in
+   let (b,g,ey) = dest_interval (concl thm2) in
+   let rthm = ASSUME `!f g ex ey. (&.0 <. (g -. (ey +. ex +. f)))` in
+   let rspec = concl (SPECL [f;g;ex;ey] rthm) in
+   let rspec_simp = FLOAT_CONV (snd (dest_binop `(<.)` rspec)) in
+   let rthm2 = prove (rspec,REWRITE_TAC[rspec_simp;FLOAT_POS;INT_POS';
+                                        INT_POS_NEG] THEN ARITH_TAC) in
+   let fthm = CONJ thm1 (CONJ thm2 rthm2) in
+   MATCH_MP INTERVAL_TO_LESS fthm;;
+
+add_test("INTERVAL_TO_LESS_CONV",
+  let thm1 = ASSUME
+   `interval (#0.1) (float (&:1) (--: (&:1))) (float (&:1) (--: (&:2)))` in
+  let thm2 = ASSUME `interval (#7) (float (&:4) (&:1)) (float (&:1) (&:0))` in
+  let thm3 = INTERVAL_TO_LESS_CONV thm1 thm2 in
+    concl thm3 = `#0.1 <. (#7)`);;
+
+add_test("INTERVAL_TO_LESS_CONV2",
+   let (h,c) = dest_thm (INTERVAL_TO_LESS_CONV
+     (INTERVAL_OF_NUM `&.3`) (INTERVAL_OF_NUM `&.8`)) in
+     (h=[]) && (c = `&.3 <. (&.8)`));;
+
+(* ------------------------------------------------------------------ *)
+
+(* conversion for DEC <= posfloat and posfloat <= DEC *)
+
+let lemma1 = prove(
+  `!n m p. ((&.p/(&.m)) <= (&.n)) <=> ((&.p/(&.m)) <= (&.n)/(&.1))`,
+  MESON_TAC[REAL_DIV_1]);;
+
+let lemma2 = prove(
+  `!n m p. ((&.p) <= ((&.n)/(&.m))) <=> ((&.p/(&.1)) <= (&.n)/(&.m))`,
+  MESON_TAC[REAL_DIV_1]);;
+
+let lemma3 = prove(`!a b c d. (
+   ((0<b) /\ (0<d) /\ (a*d <=| c*b))
+    ==> (&.a/(&.b) <=. ((&.c)/(&.d))))`,
+   EVERY[REPEAT GEN_TAC;
+   DISCH_ALL_TAC;
+   ASM_SIMP_TAC[RAT_LEMMA4;REAL_LT;REAL_OF_NUM_MUL;REAL_LE]]);;
+
+let DEC_FLOAT = EQT_ELIM o
+   ARITH_SIMP_CONV[DECIMAL;float;TWOPOW_POS;TWOPOW_NEG;GSYM real_div;
+       REAL_OF_NUM_POW;INT_NUM_REAL;REAL_OF_NUM_MUL;
+       lemma1;lemma2;lemma3];;
+
+add_test("DEC_FLOAT",
+   let f c x =
+      dest_thm (c x) = ([],x) in
+   ((f DEC_FLOAT `#10.0 <= (float (&:3) (&:2))`) &&
+    (f DEC_FLOAT `#10 <= (float (&:3) (&:2))`) &&
+    (f DEC_FLOAT `#0.1 <= (float (&:1) (--: (&:2)))`) &&
+    (f DEC_FLOAT `float (&:3) (&:2) <= (#13.0)`) &&
+    (f DEC_FLOAT `float (&:3) (&:2) <= (#13)`) &&
+    (f DEC_FLOAT `float (&:1) (--: (&:2)) <= (#0.3)`)));;
+(* ------------------------------------------------------------------ *)
+(* conversion for float inequalities *)
+
+let FLOAT_INEQ_CONV t =
+  let thm1=  (ONCE_REWRITE_CONV[GSYM REAL_SUB_LT;GSYM REAL_SUB_LE] t) in
+  let rhsx= rhs (concl thm1) in
+  let thm2= prove(rhsx,REWRITE_TAC[FLOAT_CONV (snd (dest_comb rhsx))] THEN
+                    REWRITE_TAC[FLOAT_NN;FLOAT_POS;INT_NN;INT_NN_NEG;
+                       INT_POS';INT_POS_NEG] THEN ARITH_TAC) in
+  REWRITE_RULE[GSYM thm1] thm2;;
+
+let t1 = `(float (&:3) (&:0)) +. (float (&:4) (&:0)) <. (float (&:8) (&:1))`;;
+
+
+add_test("FLOAT_INEQ_CONV",
+  let f c x =
+    dest_thm (c x) = ([],x) in
+  let t1 =
+   `(float (&:3) (&:0)) +. (float (&:4) (&:0)) <. (float (&:8) (&:1))` in
+    ((f FLOAT_INEQ_CONV t1)));;
+
+
+
+
+(* ------------------------------------------------------------------ *)
+
+(* converts a DECIMAL TO A THEOREM *)
+
+let INTERVAL_MINMAX = prove(`!x f ex.
+   ((f -. ex) <= x) /\ (x <=. (f +. ex)) ==> (interval x f ex)`,
+   EVERY[REPEAT GEN_TAC;
+   REWRITE_TAC[interval;ABS_BOUNDS];
+   REAL_ARITH_TAC]);;
+
+
+let INTERVAL_OF_DECIMAL bprec dec =
+  let a_num = dest_decimal dec in
+  let f_num = round_rat bprec a_num in
+  let ex_num = round_rat bprec (Num.abs_num (f_num -/ a_num)) in
+  let _ = assert (ex_num <=/ f_num) in
+  let f = mk_float f_num in
+  let ex= mk_float ex_num in
+  let fplus_ex = FLOAT_CONV (mk_binop `(+.)` f ex) in
+  let fminus_ex= FLOAT_CONV (mk_binop `(-.)` f ex) in
+  let fplus_term = rhs (concl fplus_ex) in
+  let fminus_term = rhs (concl fminus_ex) in
+  let th1 = DEC_FLOAT (mk_binop `(<=.)` fminus_term dec) in
+  let th2 = DEC_FLOAT (mk_binop `(<=.)` dec fplus_term) in
+  let intv = mk_interval dec f ex in
+  EQT_ELIM (SIMP_CONV[INTERVAL_MINMAX;fplus_ex;fminus_ex;th1;th2] intv);;
+
+add_test("INTERVAL_OF_DECIMAL",
+  let (h,c) = dest_thm (INTERVAL_OF_DECIMAL 4 `#36.1`) in
+  let (x,f,ex) = dest_interval c in
+   (h=[]) && (x = `#36.1`));;
+
+add_test("INTERVAL_OF_DECIMAL2",
+ can (fun() -> INTERVAL_TO_LESS_CONV (INTERVAL_OF_DECIMAL 4 `#33.33`)
+  (INTERVAL_OF_DECIMAL 4 `#36.1`)) ());;
+
+(*--------------------------------------------------------------------*)
+(*   functions to check format.                                       *)
+(*   There are various implicit rules:                                *)
+(*   NUMERAL is followed by bits and no other kind of num, etc.       *)
+(*   FLOAT a b, both a and b are &:NUMERAL or --:&:NUMERAL, etc.      *)
+(*--------------------------------------------------------------------*)
+
+
+(* converts exceptions to false *)
+let falsify_ex f x = try (f x) with _ -> false;;
+
+let is_bits_format  =
+    let rec format x =
+    if (x = `_0`) then true
+    else let (h,t) = dest_comb x  in
+      (((h = `BIT1`) or (h = `BIT0`)) && (format t))
+    in falsify_ex format;;
+
+let is_numeral_format =
+    let fn x =
+    let (h,t) = dest_comb x in
+      ((h = `NUMERAL`) && (is_bits_format t)) in
+    falsify_ex fn;;
+
+let is_decimal_format  =
+    let fn x =
+      let (t1,t2) = dest_binop `DECIMAL` x in
+        ((is_numeral_format t1) && (is_numeral_format t2)) in
+    falsify_ex fn;;
+
+let is_pos_int_format =
+    let fn x =
+      let (h,t) = dest_comb x in
+       (h = `&:`) && (is_numeral_format t) in
+    falsify_ex fn;;
+
+let is_neg_int_format =
+    let fn x =
+      let (h,t) = dest_comb x in
+        (h = `--:`) && (is_pos_int_format t) in
+      falsify_ex fn;;
+
+let is_int_format x =
+  (is_neg_int_format x) or (is_pos_int_format x);;
+
+let is_float_format =
+    let fn x =
+      let (t1,t2) = dest_binop `float` x in
+      (is_int_format t1) && (is_int_format t2) in
+    falsify_ex fn;;
+
+let is_interval_format =
+  let fn x =
+    let (a,b,c) = dest_interval x in
+      (is_float_format b) && (is_float_format c) in
+    falsify_ex fn;;
+
+let is_neg_real =
+  let fn x =
+     let (h,t) = dest_comb x in
+      (h= `--.`) in
+    falsify_ex fn;;
+
+let is_real_num_format =
+  let fn x =
+    let (h,t) = dest_comb x in
+      (h=`&.`) && (is_numeral_format t) in
+  falsify_ex fn;;
+
+let is_comb_of t u =
+  let fn t u =
+    t = (fst (dest_comb u)) in
+  try (fn t u) with failure -> false;;
+
+(* ------------------------------------------------------------------ *)
+(* Heron's formula for the square root of A
+   Return a value x that is always at most the actual square root
+   and such that abs (x  - A/x ) < epsilon *)
+
+let rec heron_sqrt depth A x eps =
+    let half = (Int 1)//(Int 2) in
+    if (depth <= 0) then raise (Failure "sqrt recursion depth exceeded") else
+    if (Num.abs_num (x -/ (A//x) ) </ eps) & (x*/ x >=/ A)  then (A//x) else
+    let x' = half */ (x +/ (A//x)) in
+    heron_sqrt (depth -1) A x' eps;;
+
+let INTERVAL_OF_TWOPOW = prove(
+   `!n. interval (twopow n) (float (&:1) n) (float (&:0) (&:0))`,
+   REWRITE_TAC[interval;float;int_of_num_th] THEN
+   REAL_ARITH_TAC
+   );;
+
+(* ------------------------------------------------------------------ *)
+
+let rec INTERVAL_OF_TERM bprec tm =
+  (* treat cached values first *)
+  if (can get_real_constant tm) then
+    begin
+    try(
+    let int_thm = get_real_constant tm in
+    if (can dest_interval (concl int_thm)) then int_thm
+    else (
+    let absthm = get_real_constant tm in
+    let (abst,k) = dest_binop `(<=.)` (concl absthm) in
+    let (absh,cmu) = dest_comb abst in
+    let (c,u) = dest_binop `(-.)` cmu in
+    let intk = INTERVAL_OF_TERM bprec k in
+    let intu = INTERVAL_OF_TERM bprec u in
+    let thm1 = MATCH_MP ABS_TO_INTERVAL absthm in
+    let thm2 = MATCH_MP thm1 (CONJ intu intk) in
+    let (_,f,ex)= dest_interval (concl thm2) in
+    let fthm = FLOAT_CONV f in
+    let exthm = FLOAT_CONV ex in
+    let thm3 = REWRITE_RULE[fthm;exthm] thm2 in
+    (add_real_constant thm3; thm3)
+    ))
+    with _ -> failwith "INTERVAL_OF_TERM : CONSTANT"
+    end
+  else if (is_real_num_format tm) then (INTERVAL_OF_NUM tm)
+  else if (is_decimal_format tm) then (INTERVAL_OF_DECIMAL bprec tm)
+  (* treat negative terms *)
+  else if (is_neg_real tm) then
+    begin
+    try(
+    let (_,t) = dest_comb tm in
+    let int1 = INTERVAL_OF_TERM bprec t in
+    let (_,b,_) = dest_interval (concl int1) in
+    let thm1  = FLOAT_CONV (mk_comb (`--.`, b)) in
+    REWRITE_RULE[thm1] (ONCE_REWRITE_RULE[INTERVAL_NEG] int1))
+    with _ -> failwith "INTERVAL_OF_TERM : NEG"
+    end
+  (* treat abs value *)
+  else if (is_comb_of `||.` tm) then
+    begin
+      try(
+      let (_,b) = dest_comb tm in
+      let b_int = MATCH_MP INTERVAL_ABSV (INTERVAL_OF_TERM bprec b) in
+      let (_,f,_) = dest_interval (concl b_int) in
+      let thm1 = FLOAT_CONV f in
+      REWRITE_RULE[thm1] b_int)
+      with _ -> failwith "INTERVAL_OF_TERM : ABS"
+    end
+  (* treat twopow *)
+  else if (is_comb_of `twopow` tm) then
+    begin
+      try(
+      let (_,b) = dest_comb tm in
+      SPEC b INTERVAL_OF_TWOPOW
+      )
+      with _ -> failwith "INTERVAL_OF_TERM : TWOPOW"
+    end
+  (* treat addition *)
+  else if (can (dest_binop `(+.)`) tm) then
+    begin
+    try(
+    let (a,b) = dest_binop `(+.)` tm in
+    let a_int = INTERVAL_OF_TERM bprec a in
+    let b_int = INTERVAL_OF_TERM bprec b in
+    let c_int = MATCH_MP INTERVAL_ADD (CONJ a_int b_int) in
+    let (_,f,ex) = dest_interval (concl c_int) in
+    let thm1 = FLOAT_CONV f and thm2 = FLOAT_CONV ex in
+    REWRITE_RULE[thm1;thm2] c_int)
+    with _ -> failwith "INTERVAL_OF_TERM : ADD"
+    end
+  (* treat subtraction *)
+  else if (can (dest_binop `(-.)`) tm) then
+    begin
+    try(
+    let (a,b) = dest_binop `(-.)` tm in
+    let a_int = INTERVAL_OF_TERM bprec a in
+    let b_int = INTERVAL_OF_TERM bprec b in
+    let c_int = MATCH_MP INTERVAL_SUB (CONJ a_int b_int) in
+    let (_,f,ex) = dest_interval (concl c_int) in
+    let thm1 = FLOAT_CONV f and thm2 = FLOAT_CONV ex in
+    REWRITE_RULE[thm1;thm2] c_int)
+    with _ -> failwith "INTERVAL_OF_TERM : SUB"
+    end
+  (* treat multiplication *)
+  else if (can (dest_binop `( *. )`) tm) then
+    begin
+    try(
+    let (a,b) = dest_binop `( *. )` tm in
+    let a_int = INTERVAL_OF_TERM bprec a in
+    let b_int = INTERVAL_OF_TERM bprec b in
+    let c_int = MATCH_MP INTERVAL_MUL (CONJ a_int b_int) in
+    let (_,f,ex) = dest_interval (concl c_int) in
+    let thm1 = FLOAT_CONV f and thm2 = FLOAT_CONV ex in
+    REWRITE_RULE[thm1;thm2] c_int)
+    with _ -> failwith "INTERVAL_OF_TERM : MUL"
+    end
+  (* treat division : instantiate INTERVAL_DIV *)
+  else if (can (dest_binop `( / )`) tm) then
+    begin
+    try(
+    let (a,b) = dest_binop `( / )` tm in
+    let a_int = INTERVAL_OF_TERM bprec a in
+    let b_int = INTERVAL_OF_TERM bprec b in
+    let (_,f,ex) = dest_interval (concl a_int) in
+    let (_,g,ey) = dest_interval (concl b_int) in
+    let f_num = dest_float f in
+    let ex_num = dest_float ex in
+    let g_num = dest_float g in
+    let ey_num = dest_float ey in
+    let h_num = round_rat bprec (f_num//g_num) in
+    let h = mk_float h_num in
+    let ez_rat = (ex_num +/ abs_num (f_num -/ (h_num*/ g_num))
+        +/ (abs_num h_num */ ey_num))//((abs_num g_num) -/ (ey_num)) in
+    let ez_num = round_rat bprec (ez_rat) in
+    let _ = assert((ez_num >=/ (Int 0))) in
+    let ez = mk_float ez_num in
+    let hyp1 = a_int in
+    let hyp2 = b_int in
+    let hyp3 = FLOAT_INEQ_CONV (mk_binop `(<.)` ey (mk_comb (`||.`,g))) in
+    let thm = SPECL [a;f;ex;b;g;ey;h;ez] INTERVAL_DIV in
+    let conj2 x = snd (dest_conj x) in
+    let hyp4t = (conj2 (conj2 (conj2 (fst(dest_imp (concl thm)))))) in
+    let hyp4 = FLOAT_INEQ_CONV hyp4t in
+    let hyp_all = end_itlist CONJ [hyp1;hyp2;hyp3;hyp4] in
+    MATCH_MP thm hyp_all)
+    with _ -> failwith "INTERVAL_OF_TERM :DIV"
+    end
+  (* treat sqrt : instantiate INTERVAL_SSQRT *)
+  else if (can (dest_unary `ssqrt`) tm) then
+    begin
+    try(
+    let x = dest_unary `ssqrt` tm in
+    let x_int = INTERVAL_OF_TERM bprec x in
+    let (_,f,ex)  = dest_interval (concl x_int) in
+    let f_num = dest_float f in
+    let ex_num = dest_float ex in
+    let fd_num = f_num -/ ex_num in
+    let fe_f = Num.float_of_num fd_num in
+    let apprx_sqrt = Pervasives.sqrt fe_f in
+    (* put in heron's formula *)
+    let v_num1 = round_inward_float 25 (apprx_sqrt) in
+    let v_num = round_inward_rat bprec
+         (heron_sqrt 10 fd_num v_num1 ((Int 2) **/ (Int (-bprec-4)))) in
+    let u_num1 = round_inward_float 25
+        (Pervasives.sqrt (float_of_num f_num)) in
+    let u_num = round_inward_rat bprec
+        (heron_sqrt 10 f_num u_num1 ((Int 2) **/ (Int (-bprec-4)))) in
+    let ey_num = round_rat bprec (abs_num (f_num -/ (u_num */ u_num))) in
+    let ez_num = round_rat bprec ((ex_num +/ ey_num)//(u_num +/ v_num)) in
+    let (v,u) = (mk_float v_num,mk_float u_num) in
+    let (ey,ez) = (mk_float ey_num,mk_float ez_num) in
+    let thm = SPECL [x;f;ex;u;ey;ez;v] INTERVAL_SSQRT in
+    let conjhyp = fst (dest_imp (concl thm)) in
+    let [hyp6;hyp5;hyp4;hyp3;hyp2;hyp1] =
+      let rec break_conj c acc =
+        if (not(is_conj c)) then (c::acc) else
+        let (u,v) = dest_conj c in break_conj v (u::acc) in
+       (break_conj conjhyp []) in
+    let thm2 = prove(hyp2,REWRITE_TAC[interval] THEN
+                       (CONV_TAC FLOAT_INEQ_CONV)) in
+    let thm3 = FLOAT_INEQ_CONV hyp3 in
+    let thm4 = FLOAT_INEQ_CONV hyp4 in
+    let float_tac = REWRITE_TAC[FLOAT_NN;FLOAT_POS;INT_NN;INT_NN_NEG;
+                       INT_POS';INT_POS_NEG] THEN ARITH_TAC in
+    let thm5 = prove( hyp5,float_tac) in
+    let thm6 = prove( hyp6,float_tac) in
+    let ant  = end_itlist CONJ[x_int;thm2;thm3;thm4;thm5;thm6] in
+    MATCH_MP thm ant
+    )
+    with _ -> failwith "INTERVAL_OF_TERM : SSQRT"
+    end
+  else failwith "INTERVAL_OF_TERM : case not installed";;
+
+
+let real_ineq bprec tm =
+  let (t1,t2) = dest_binop `(<.)` tm in
+  let int1 = INTERVAL_OF_TERM bprec t1 in
+  let int2 = INTERVAL_OF_TERM bprec t2 in
+  INTERVAL_TO_LESS_CONV int1 int2;;
+
+pop_priority();;
+
+

diff --git a/Jordan/jordan_curve_theorem.ml b/Jordan/jordan_curve_theorem.ml
new file mode 100644 (file)
index 0000000..7f9d99f
--- /dev/null
+++ b/Jordan/jordan_curve_theorem.ml
@@ -0,0 +1,59310 @@
+(*
+
+   Proof of the Jordan curve theorem
+   Format: HOL-LIGHT (OCaml version 2003)
+   File started April 20, 2004
+   Completed January 19, 2005
+   Author: Thomas C. Hales
+
+   The proof follows
+   Carsten Thomassen
+   "The Jordan-Schoenflies theorem and the classification of
+    surfaces"
+   American Math Monthly 99 (1992) 116 - 130.
+
+   There is one major difference from Thomassen's proof.
+   He uses general polygonal jordan curves in the "easy" case of the
+   Jordan curve theorem.  This file restricts the "easy" case
+   even further to jordan curves that are made of horizontal
+   and vertical segments with integer length.
+
+   Thomassen shows finite planar graphs admit polygonal
+   embeddings.  This file shows that finite planar graphs such
+   that every vertex has degree at most 4 admit
+   embeddings with edges that are piecewise horizontal and
+   vertical segments of integer length.
+
+   I have apologies:
+
+   1. I'm still a novice and haven't settled on a style.  The
+      entire proof is a clumsy experiment.
+   2. The lemmas have been ordered by my stream of consciousness.
+      The file is long, the dependencies are nontrivial, and reordering
+      is best accomplished by an automated tool.
+
+*)
+
+
+let jordan_def = local_definition "jordan";;
+mk_local_interface "jordan";;
+prioritize_real();;
+
+let basic_rewrite_bak = basic_rewrites();;
+let basic_net_bak = basic_net();;
+let PARTIAL_REWRITE_CONV thl =
+  GENERAL_REWRITE_CONV true TOP_DEPTH_CONV (basic_net_bak) thl;;
+let PARTIAL_REWRITE_TAC thl = CONV_TAC(PARTIAL_REWRITE_CONV thl);;
+
+let reset() = (set_basic_rewrites basic_rewrite_bak);;
+extend_basic_rewrites
+  (* sets *)
+  [(* UNIV *)
+   INR IN_UNIV;
+   UNIV_NOT_EMPTY;
+   EMPTY_NOT_UNIV;
+   DIFF_UNIV;
+   INSERT_UNIV;
+   INTER_UNIV ;
+   EQ_UNIV;
+   UNIV_SUBSET;
+   SUBSET_UNIV;
+   (* EMPTY *)
+   IN;IN_ELIM_THM';
+   (* EMPTY_EXISTS; *)  (* leave EMPTY EXISTS out next time *)
+   EMPTY_DELETE;
+   INTERS_EMPTY;
+   INR NOT_IN_EMPTY;
+   EMPTY_SUBSET;
+   (* SUBSET_EMPTY; *)  (* leave out *)
+   (* INTERS *)
+   inters_singleton;
+   (* SUBSET_INTER; *)
+   (* unions *)
+   UNIONS_0;
+   UNIONS_1;
+  ];;
+
+
+let DISCH_THEN_REWRITE = (DISCH_THEN (fun t -> REWRITE_TAC[t]));;
+let ISUBSET = INR SUBSET;;
+
+(* ------------------------------------------------------------------ *)
+(* Logic, Sets, Metric Space Material *)
+(* ------------------------------------------------------------------ *)
+
+(* logic *)
+
+
+(* sets *)
+let PAIR_LEMMAv2 = prove_by_refinement(
+   `!x (i:A) (j:B). (x = (i,j)) <=> ((FST x = i) /\ (SND x = j))` ,
+(* {{{ proof *)
+   [
+   MESON_TAC[FST;SND;PAIR];
+   ]);;
+(* }}} *)
+
+let PAIR_SPLIT = prove_by_refinement(
+   `!x (y:A#B). (x = y) <=> ((FST x = FST y) /\ (SND x = SND y))` ,
+(* {{{ proof *)
+   [
+   MESON_TAC[FST;SND;PAIR];
+   ]);;
+(* }}} *)
+
+let single_inter = prove_by_refinement(
+  `!(a:A) U. ( ~({a} INTER U = EMPTY) <=> U a)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[INSERT;INTER;EMPTY_EXISTS ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let inters_inter = prove_by_refinement(
+  `!(X:A->bool) Y. (X INTER Y) = (INTERS {X,Y})`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `{X,Y} Y` SUBGOAL_TAC;
+  REWRITE_TAC[INSERT ];
+  DISCH_TAC;
+  USE 0 (MATCH_MP delete_inters);
+  ASM_REWRITE_TAC[DELETE_INSERT; ];
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[INTER;];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let unions_delete_choice = prove_by_refinement(
+  `!(A:(A->bool)->bool). ~(A =EMPTY) ==>
+     (UNIONS A = (UNIONS (A DELETE CHOICE A)) UNION (CHOICE A))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[UNIONS;UNION;DELETE  ];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[];
+  TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (INR CHOICE_DEF  );
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let image_delete_choice = prove_by_refinement(
+  `!(A:(A->bool)) (f:A->B). ~(A= EMPTY) ==>
+     (IMAGE f A =
+        ((IMAGE f (A DELETE CHOICE A)) UNION {(f (CHOICE A))}))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[IMAGE;UNION;DELETE];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INSERT ];
+  TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (INR CHOICE_DEF  );
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let UNIONS_UNION = prove_by_refinement(
+  `!(A:(A->bool)->bool) B.
+    UNIONS (A UNION B) = (UNIONS A) UNION (UNIONS B)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[UNIONS;UNION];
+  IMATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* reals *)
+
+let half_pos = prove_by_refinement(
+  `!x. (&.0 < x) ==> (&.0 < x/(&.2)) /\ (x/(&.2)) < x`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[REAL_LT_HALF2;REAL_LT_HALF1];
+  ]);;
+  (* }}} *)
+
+(* topology *)
+let convex_inter = prove_by_refinement(
+  `!S T. (convex S) /\ (convex T) ==> (convex (S INTER T))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[convex;mk_segment;INTER;SUBSET_INTER  ];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TYPEL_THEN [`x`;`y`] (USE 0 o ISPECL);
+  REWR 0;
+  TYPEL_THEN [`x`;`y`] (USE 1 o ISPECL);
+  REWR 1;
+  ]);;
+
+  (* }}} *)
+
+let closed_inter2 = prove_by_refinement(
+  `!U (A:A->bool) B. (topology_ U) /\ (closed_ U A) /\ (closed_ U B) ==>
+   (closed_ U (A INTER B))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[inters_inter];
+  IMATCH_MP_TAC  closed_inter ;
+  ASM_REWRITE_TAC[INR INSERT;EMPTY_EXISTS ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let closure_univ = prove_by_refinement(
+  `!U (X:A->bool). ~(X SUBSET UNIONS U) ==> (closure U X = UNIV)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[closure;closed];
+  TYPE_THEN `{B | (B SUBSET UNIONS U /\ open_ U (UNIONS U DIFF B)) /\ X SUBSET B} = EMPTY ` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 1 (REWRITE_RULE[EMPTY_EXISTS ]);
+  CHO 1;
+  ASM_MESON_TAC[SUBSET_TRANS];
+  DISCH_THEN_REWRITE;
+  ]);;
+
+  (* }}} *)
+
+let closure_inter = prove_by_refinement(
+  `!(X:A->bool) Y U.
+   (topology_ U)
+    ==> ((closure U (X INTER Y) SUBSET
+   (closure U X) INTER closure U Y))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `X SUBSET UNIONS  U` ASM_CASES_TAC THEN (TYPE_THEN `Y SUBSET UNIONS  U` ASM_CASES_TAC) THEN TRY(IMP_RES_THEN (fun t -> REWRITE_TAC[t]) closure_univ)  THEN (  IMATCH_MP_TAC  closure_subset );
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  closed_inter2;
+  ASM_SIMP_TAC[closure_closed ];
+  REWRITE_TAC[INTER;ISUBSET ];
+  ASM_MESON_TAC[subset_closure;ISUBSET];
+  ASM_MESON_TAC[closure_closed;INTER_SUBSET; SUBSET_TRANS ;subset_closure ];
+  ASM_MESON_TAC[closure_closed;INTER_SUBSET; SUBSET_TRANS ;subset_closure ];
+  ]);;
+
+  (* }}} *)
+
+let closure_open_ball = prove_by_refinement(
+  `!(X:A->bool) d Z .
+    ((metric_space(X,d)) /\ (Z SUBSET X)) ==>
+     (({a | !r. (&.0 < r) ==> (?z. (Z z /\ open_ball(X,d) a r z))}
+         = closure (top_of_metric(X,d)) Z))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `topology_ (top_of_metric(X,d)) /\ (Z SUBSET (UNIONS (top_of_metric (X,d))))` SUBGOAL_TAC;
+  ASM_SIMP_TAC[top_of_metric_top;GSYM top_of_metric_unions];
+  DISCH_TAC;
+  USE 2 (MATCH_MP closure_open);
+  TYPE_THEN `{a | !r. (&.0 < r) ==> (?z. (Z z /\ open_ball(X,d) a r z))}` (USE 2 o SPEC);
+  ASM_REWRITE_TAC[];
+  CONJ_TAC; (* 1st prong *)
+  REWRITE_TAC[ISUBSET;];
+  GEN_TAC;
+  DISCH_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_MESON_TAC[SUBSET;IN;INR open_ball_nonempty];
+  CONJ_TAC;
+  REWRITE_TAC[closed;open_DEF ];
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';open_ball ;];
+  DISCH_ALL_TAC;
+  TYPE_THEN `&.1` (USE 3 o SPEC);
+  UND 3;
+  REDUCE_TAC;
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  MESON_TAC[];
+  ASM_SIMP_TAC[top_of_metric_nbd];
+  REWRITE_TAC[IN;DIFF; ISUBSET ];
+  CONJ_TAC;
+  MESON_TAC[];
+  DISCH_ALL_TAC;
+  LEFT 4 "r";
+  CHO 4;
+  USE 4 (REWRITE_RULE[NOT_IMP]);
+  TYPE_THEN `r` EXISTS_TAC;
+  NAME_CONFLICT_TAC;
+  ASM_REWRITE_TAC[NOT_IMP];
+  DISCH_ALL_TAC;
+  AND 4;
+  SUBCONJ_TAC;
+  UND 5;
+  REWRITE_TAC[open_ball;  ];
+  MESON_TAC[];
+  DISCH_TAC;
+  LEFT_TAC "r'";
+  JOIN 0 5;
+  USE 0 (MATCH_MP (INR open_ball_center));
+  CHO 0;
+  TYPE_THEN `r'` EXISTS_TAC;
+  UND 0;
+  UND 4;
+  MESON_TAC[SUBSET;IN];
+  (* final prong *)
+  (* fp  *)
+  ONCE_REWRITE_TAC[TAUT (`a /\ b ==> e <=> (a /\ ~e ==> ~b)`)];
+  REWRITE_TAC[open_DEF;EMPTY_EXISTS ];
+  DISCH_ALL_TAC;
+  CHO 4;
+  USE 4 (REWRITE_RULE[INTER ]);
+  AND 4;
+  UND 3;
+  ASM_SIMP_TAC[top_of_metric_nbd;];
+  DISCH_ALL_TAC;
+  TSPEC `u` 6;
+  REWR 6;
+  CHO 6;
+  TSPEC `r` 4;
+  REWR 4;
+  CHO 4;
+  TYPE_THEN `z` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  ASM_MESON_TAC[ISUBSET];
+  ]);;
+  (* }}} *)
+
+let closed_union = prove_by_refinement(
+  `!U (A:A->bool) B. (topology_ U) /\ (closed_ U A) /\ (closed_ U B) ==>
+     (closed_ U (A UNION B))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closed;open_DEF;union_subset  ];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `UNIONS U DIFF (A UNION B) = (UNIONS U DIFF A) INTER  (UNIONS U DIFF B)` SUBGOAL_TAC;
+  REWRITE_TAC[DIFF;UNION;IN;INTER;IN_ELIM_THM'];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
+  ASM_MESON_TAC[SUBSET;IN];
+  DISCH_THEN (fun t->REWRITE_TAC[t]);
+  ASM_MESON_TAC[top_inter];
+  ]);;
+  (* }}} *)
+
+(* euclid *)
+let euclid_scale0 = prove_by_refinement(
+  `!x. (&.0 *# x) = (euclid0)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[euclid_scale;euclid0];
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let euclid_minus0 = prove_by_refinement(
+  `!x. (x - euclid0) = x`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[euclid0;euclid_minus];
+  REDUCE_TAC;
+(*** Changed by JRH since MESON no longer automatically applies extensionality
+  MESON_TAC[];
+ ***)
+  REWRITE_TAC[FUN_EQ_THM]
+  ]);;
+  (* }}} *)
+
+let norm_scale2 = prove_by_refinement(
+  `!t x. (euclidean x) ==> (norm (t *# x) = abs(t) * norm x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP norm_scale);
+  TYPEL_THEN [`t`;`&.0`] (USE 0 o ISPECL);
+  USE 0 (REWRITE_RULE[euclid_scale0;d_euclid;euclid_minus0]);
+  UND 0;
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* half-spaces  *)
+(* ------------------------------------------------------------------ *)
+
+let closed_half_space = jordan_def `closed_half_space n v b =
+  {z | (euclid n z) /\ (dot v z <=. b) }`;;
+
+let open_half_space = jordan_def `open_half_space n v b =
+  {z | (euclid n z) /\ (dot v z <. b) }`;;
+
+let hyperplane = jordan_def `hyperplane n v b =
+  {z | (euclid n z) /\ (dot v z = b) }`;;
+
+let closed_half_space_euclid = prove_by_refinement(
+  `!n v b. (closed_half_space n v b SUBSET euclid n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closed_half_space;SUBSET;IN;IN_ELIM_THM'  ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let open_half_space_euclid = prove_by_refinement(
+  `!n v b. (open_half_space n v b SUBSET euclid n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[open_half_space;SUBSET;IN;IN_ELIM_THM'  ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let hyperplane_euclid = prove_by_refinement(
+  `!n v b. (hyperplane n v b SUBSET euclid n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[hyperplane;SUBSET;IN;IN_ELIM_THM'  ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let closed_half_space_scale = prove_by_refinement(
+  `!n v b r. ( &.0 < r) /\ (euclid n v) ==>
+   (closed_half_space n (r *# v) (r * b) = closed_half_space n v b)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[closed_half_space];
+  IMATCH_MP_TAC  EQ_EXT ;
+  GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
+  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
+  DISCH_ALL_TAC;
+  JOIN 1 2;
+  USE 1 (MATCH_MP dot_scale);
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[dot_scale];
+  IMATCH_MP_TAC  REAL_LE_LMUL_EQ;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let open_half_space_scale = prove_by_refinement(
+  `!n v b r. ( &.0 < r) /\ (euclid n v) ==>
+   (open_half_space n (r *# v) (r * b) = open_half_space n v b)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[open_half_space];
+  IMATCH_MP_TAC  EQ_EXT ;
+  GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
+  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
+  DISCH_ALL_TAC;
+  JOIN 1 2;
+  USE 1 (MATCH_MP dot_scale);
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[dot_scale];
+  IMATCH_MP_TAC  REAL_LT_LMUL_EQ;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let hyperplane_scale = prove_by_refinement(
+  `!n v b r. ~( r = &.0) /\ (euclid n v) ==>
+   (hyperplane n (r *# v) (r * b)= hyperplane n v  b)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[hyperplane];
+  IMATCH_MP_TAC  EQ_EXT ;
+  GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM'];
+  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
+  DISCH_ALL_TAC;
+  JOIN 1 2;
+  USE 1 (MATCH_MP dot_scale);
+  ASM_REWRITE_TAC[REAL_EQ_MUL_LCANCEL ];
+  ]);;
+  (* }}} *)
+
+let open_half_space_diff = prove_by_refinement(
+  `!n v b. (euclid n v) ==>
+     ((euclid n) DIFF (open_half_space n v b) =
+       (closed_half_space n (-- v) (--. b)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[open_half_space;closed_half_space;DIFF ];
+  REWRITE_TAC[IN; IN_ELIM_THM'];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IN_ELIM_THM;dot_neg ];
+  GEN_TAC;
+  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let closed_half_space_diff = prove_by_refinement(
+  `!n v b. (euclid n v) ==>
+     ((euclid n) DIFF (closed_half_space n v b) =
+       (open_half_space n (-- v) (--. b)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[open_half_space;closed_half_space;DIFF ];
+  REWRITE_TAC[IN; IN_ELIM_THM'];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IN_ELIM_THM;dot_neg ];
+  GEN_TAC;
+  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let closed_half_space_inter = prove_by_refinement(
+  `!n v b. (euclid n v) ==>
+    (closed_half_space n v b INTER closed_half_space n (-- v) (--b) =
+    hyperplane n v b)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[closed_half_space;INTER;IN;hyperplane;IN_ELIM_THM' ];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  REWRITE_TAC[GSYM CONJ_ASSOC ];
+  IMATCH_MP_TAC  (TAUT `(C ==> (a <=> b)) ==> ((C /\ a) <=> (C /\ b))`);
+  DISCH_TAC;
+  ASM_REWRITE_TAC[dot_neg ];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let open_half_space_convex = prove_by_refinement(
+  `!n v b. (euclid n v) ==> (convex (open_half_space n v b))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[convex;open_half_space;mk_segment;IN_ELIM_THM';SUBSET;IN  ];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  CHO 5;
+  UND 5;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  KILL 7;
+  ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure;];
+  TYPE_THEN `dot v (euclid_plus (a *# x) ((&1 - a) *# y)) = a * (dot v x) + (&1 - a)* (dot v y)` SUBGOAL_TAC;
+  ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure;dot_linear2;dot_scale2 ];
+  DISCH_THEN (fun t -> REWRITE_TAC[t]);
+  ASM_CASES_TAC `&.0 = a`;
+  EXPAND_TAC "a";
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  GEN_REWRITE_TAC (RAND_CONV)[REAL_ARITH `b = a * b + ((&.1)* b - a* b)`];
+  IMATCH_MP_TAC  REAL_LTE_ADD2;
+  CONJ_TAC;
+  MP_TAC (REAL_ARITH `~(&.0 = a) /\ (&.0 <= a) ==> (&.0 < a)`);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[REAL_LT_LMUL_EQ];
+  REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
+  IMATCH_MP_TAC  REAL_LE_LMUL;
+  UND 6;
+  UND 4;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let closed_half_space_convex = prove_by_refinement(
+  `!n v b. (euclid n v) ==> (convex (closed_half_space n v b))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[convex;closed_half_space;mk_segment;IN_ELIM_THM';SUBSET;IN];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  CHO 5;
+  UND 5;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  KILL 7;
+  ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure;];
+  TYPE_THEN `dot v (euclid_plus (a *# x) ((&1 - a) *# y)) = a * (dot v x) + (&1 - a)* (dot v y)` SUBGOAL_TAC;
+  ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure;dot_linear2;dot_scale2 ];
+  DISCH_THEN (fun t -> REWRITE_TAC[t]);
+  GEN_REWRITE_TAC (RAND_CONV)[REAL_ARITH `b = a * b + ((&.1)* b - a* b)`];
+  IMATCH_MP_TAC  REAL_LE_ADD2;
+  REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
+  USE 6 (MATCH_MP (REAL_ARITH `(a <= &.1) ==> (&.0 <= (&1-a))`));
+  CONJ_TAC THEN (IMATCH_MP_TAC REAL_LE_LMUL) THEN ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let hyperplane_convex = prove_by_refinement(
+  `!n v b. (euclid n v) ==> convex(hyperplane n v b)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[GSYM closed_half_space_inter];
+  IMATCH_MP_TAC  convex_inter;
+  ASM_MESON_TAC[closed_half_space_convex;neg_dim ];
+  ]);;
+
+  (* }}} *)
+
+let open_half_space_open = prove_by_refinement(
+  `!n v b. (euclid n v) ==>
+    (top_of_metric(euclid n,d_euclid)) (open_half_space n v b)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[top_of_metric_nbd;metric_euclid;SUBSET;IN;IN_ELIM_THM' ];
+  REWRITE_TAC[open_half_space;open_ball;IN_ELIM_THM' ];
+  CONJ_TAC ;
+  MESON_TAC[];
+  DISCH_ALL_TAC;
+  ASM_CASES_TAC `v = euclid0`;
+  UND 2;
+  ASM_REWRITE_TAC[dot_lzero];
+  MESON_TAC[];
+  TYPE_THEN `(b - (dot v a))/(norm v)` EXISTS_TAC;
+  TYPE_THEN `&.0 < (norm v)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `&0 <= x /\ (~(x = &.0)) ==> (&.0 < x)`);
+  ASM_MESON_TAC[norm;norm_nonneg;dot_nonneg;SQRT_EQ_0;dot_zero];
+  DISCH_ALL_TAC;
+  SUBCONJ_TAC;
+  ASM_SIMP_TAC[REAL_LT_RDIV_0];
+  UND 2;
+  REAL_ARITH_TAC;
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(x:num->real) = a + (x - a)` SUBGOAL_TAC;
+  REWRITE_TAC[euclid_plus;euclid_minus];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC THEN BETA_TAC;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]);
+  TYPE_THEN `dot v (a + (x - a)) = (dot v a) + (dot v (x-a))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  dot_linear2;
+  TYPE_THEN `n` EXISTS_TAC;
+  ASM_SIMP_TAC[euclid_sub_closure];
+  DISCH_THEN (fun t -> REWRITE_TAC[t]);
+  IMATCH_MP_TAC  (REAL_ARITH `(?d. (b<=d) /\ d < C - a) ==> a +b < C`);
+  TYPE_THEN `(norm v)*. (d_euclid a x)` EXISTS_TAC;
+  CONJ_TAC;
+  ASSUME_TAC metric_euclid;
+  TYPE_THEN `n` (USE 9 o SPEC);
+  COPY 7;
+  JOIN  6 7;
+  JOIN 9 6;
+  USE 6 (MATCH_MP metric_space_symm);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[d_euclid];
+  IMATCH_MP_TAC  (REAL_ARITH `||. u <=. C ==> (u <=. C)`);
+  IMATCH_MP_TAC  cauchy_schwartz;
+  ASM_MESON_TAC[euclidean;euclid_sub_closure];
+  UND 8;
+  ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
+  REAL_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let closed_half_space_closed = prove_by_refinement(
+  `!n v b. (euclid n v) ==>
+     closed_ (top_of_metric(euclid n,d_euclid))
+      (closed_half_space n v b)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closed;open_DEF ];
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid;closed_half_space_diff;open_half_space_open;euclid_neg_closure ];
+  REWRITE_TAC[closed_half_space;SUBSET;IN;IN_ELIM_THM' ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let hyperplane_closed = prove_by_refinement(
+  `!n v b. (euclid n v) ==>
+     closed_ (top_of_metric(euclid n,d_euclid))
+     (hyperplane n v b)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[GSYM closed_half_space_inter];
+  IMATCH_MP_TAC  closed_inter2;
+  ASM_MESON_TAC[euclid_neg_closure;top_of_metric_top ;metric_euclid ;closed_half_space_closed;];
+  ]);;
+  (* }}} *)
+
+let closure_half_space = prove_by_refinement(
+  `!n v b. (euclid n v) /\ (~(v = euclid0)) ==>
+   ((closure (top_of_metric(euclid n,d_euclid))
+    (open_half_space n v b)) = (closed_half_space n v b))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  closure_subset;
+  ASM_SIMP_TAC [top_of_metric_top;metric_euclid];
+  ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid;closed_half_space_closed];
+  REWRITE_TAC[SUBSET;IN;closed_half_space;open_half_space;IN_ELIM_THM' ];
+  MESON_TAC[REAL_ARITH `a < b ==> a <=. b`];
+  ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid;open_half_space_euclid];
+  REWRITE_TAC[open_half_space;closed_half_space;SUBSET;IN;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `t = ((r/(&.2))/(norm v ))` ABBREV_TAC;
+  TYPE_THEN `u = x - (t)*# v` ABBREV_TAC;
+  TYPE_THEN `u` EXISTS_TAC;
+  TYPE_THEN `&.0 < (dot v v)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `~(x = &.0) /\ (&.0 <=. x) ==> (&.0 < x)`);
+  REWRITE_TAC[dot_nonneg];
+  ASM_MESON_TAC[euclidean;dot_zero_euclidean ];
+  DISCH_TAC;
+  TYPE_THEN `&.0 < t` SUBGOAL_TAC;
+  EXPAND_TAC "t";
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  REWRITE_TAC[norm];
+  IMATCH_MP_TAC  SQRT_POS_LT;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  SUBCONJ_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[euclid_sub_closure ;euclid_scale_closure ];
+  TYPE_THEN `dot v u = (dot v x - t* (dot v v))` SUBGOAL_TAC;
+  EXPAND_TAC "u";
+  ASM_MESON_TAC[dot_minus_linear2;dot_scale2;euclid_sub_closure;euclid_scale_closure];
+  DISCH_THEN (fun t->REWRITE_TAC[t]);
+  IMATCH_MP_TAC  (REAL_ARITH `(a <= b) /\ (&.0 < C) ==> (a - C < b)`);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[open_ball;IN_ELIM_THM' ];
+  EXPAND_TAC "u";
+  REWRITE_TAC[d_euclid];
+  TYPE_THEN `euclid_minus x (euclid_minus x (t *# v)) = ( t) *# v` SUBGOAL_TAC;
+  REWRITE_TAC[euclid_minus;euclid_scale];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC THEN BETA_TAC;
+  REAL_ARITH_TAC ;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  TYPE_THEN `norm (t *# v) = t * norm v` SUBGOAL_TAC;
+  ASM_MESON_TAC[euclidean;norm_scale2;ABS_REFL;REAL_ARITH `&.0 < t ==> &.0 <= t`];
+  DISCH_THEN (fun t -> REWRITE_TAC[t]);
+  EXPAND_TAC "t";
+  TYPE_THEN `((r / &2) / norm v) * norm v = r/(&.2)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_DIV_RMUL;
+  REWRITE_TAC[norm];
+  ASM_MESON_TAC[SQRT_POS_LT;REAL_ARITH `&.0 < x ==> ~(x = &.0)`];
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  ASM_MESON_TAC[half_pos];
+  ]);;
+
+  (* }}} *)
+
+
+let subset_of_closure = prove_by_refinement(
+  `!(A:A->bool) B U. (topology_ U) /\ (A SUBSET B) ==>
+    (closure U A SUBSET closure U B)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `(A SUBSET (UNIONS U))` ASM_CASES_TAC;
+  TYPE_THEN `(B SUBSET (UNIONS U))` ASM_CASES_TAC;
+  IMATCH_MP_TAC  closure_subset;
+  ASM_REWRITE_TAC[];
+  WITH 0 (MATCH_MP subset_closure);
+  USE 4 (ISPEC `B:A->bool`);
+  JOIN 1 4;
+  USE 1 (MATCH_MP SUBSET_TRANS);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC [closure_closed;];
+  USE 3 (MATCH_MP closure_univ);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `~(B SUBSET UNIONS U)` SUBGOAL_TAC;
+  UND 2;
+  UND 1;
+  REWRITE_TAC[ISUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  USE 2 (MATCH_MP closure_univ);
+  USE 3 (MATCH_MP closure_univ);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let closure_union = prove_by_refinement(
+  `!(A:A->bool)  B U. (topology_ U) ==>
+    (closure U (A UNION B) = (closure U A) UNION (closure U B))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN  `A SUBSET UNIONS U` ASM_CASES_TAC THEN (TYPE_THEN `B SUBSET UNIONS U` ASM_CASES_TAC ) THEN TRY(IMP_RES_THEN (fun t -> REWRITE_TAC[t;UNION_UNIV;SUBSET_UNIV;INTER_UNIV]) closure_univ)  THEN TRY (IMATCH_MP_TAC  closure_univ) THEN TRY (UNDISCH_FIND_TAC `(~)`);
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC closure_subset;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  ASM_MESON_TAC[closed_union; closure_closed];
+  REWRITE_TAC[union_subset];
+  TYPE_THEN `(A SUBSET closure U A) /\ (B SUBSET closure U B)` SUBGOAL_TAC;
+  ASM_SIMP_TAC[subset_closure];
+  REWRITE_TAC[UNION;ISUBSET ];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[union_subset];
+  CONJ_TAC THEN IMATCH_MP_TAC  subset_of_closure THEN ASM_REWRITE_TAC[ISUBSET;UNION ] THEN (MESON_TAC []);
+  REWRITE_TAC [UNION;SUBSET; ];
+  MESON_TAC[];
+  REWRITE_TAC[UNION;SUBSET];
+  MESON_TAC[];
+  REWRITE_TAC[UNION;SUBSET];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let closure_empty = prove_by_refinement(
+  `!U. (topology_ U) ==> (closure U (EMPTY:A->bool) = EMPTY)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  ASM_MESON_TAC[SUBSET_EMPTY;closure_subset;empty_closed];
+  ]);;
+  (* }}} *)
+
+let closure_unions = prove_by_refinement(
+  `!(A:(A->bool)->bool) U. (topology_ U) /\ (FINITE A) ==>
+    (closure U (UNIONS A) = UNIONS (IMAGE (closure U) A))`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  TYPE_THEN `n = CARD A` ABBREV_TAC;
+  UND 0;
+  TYPE_THEN `A` (fun t-> SPEC_TAC (t,t));
+  TYPE_THEN `n` (fun t-> SPEC_TAC (t,t));
+  INDUCT_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `A HAS_SIZE 0` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[HAS_SIZE];
+  ASM_REWRITE_TAC[HAS_SIZE_0];
+  DISCH_THEN_REWRITE;
+  ASM_SIMP_TAC [closure_empty;IMAGE_CLAUSES];
+  DISCH_ALL_TAC;
+  TYPE_THEN `~(A HAS_SIZE 0)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[HAS_SIZE];
+  ARITH_TAC;
+  TYPE_THEN `A` (MP_TAC o ((C ISPEC)  CARD_DELETE_CHOICE));
+  REWRITE_TAC[HAS_SIZE_0];
+  DISCH_ALL_TAC;
+  REWR 5;
+  USE 5 (CONV_RULE REDUCE_CONV );
+  TYPE_THEN `(A DELETE CHOICE A)` (USE 0 o ISPEC);
+  USE 0 (REWRITE_RULE[FINITE_DELETE]);
+  REWR 0;
+  TYPE_THEN `A (CHOICE A)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (INR CHOICE_DEF);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `UNIONS A = (UNIONS (A DELETE CHOICE A)) UNION (CHOICE A)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  unions_delete_choice;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `(IMAGE  (closure U) A) = (IMAGE (closure U) (A DELETE CHOICE A) UNION {(closure U (CHOICE A))})` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_delete_choice ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_SIMP_TAC[closure_union];
+  REWRITE_TAC[UNIONS_UNION];
+  ]);;
+  (* }}} *)
+
+let metric_space_zero2 = prove_by_refinement(
+  `!X d (x:A) y. (metric_space(X,d) /\ (X x) /\ (X y)) ==>
+   ((d x y = &.0) <=> (x = y))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  USE 0 (REWRITE_RULE[metric_space]);
+  TYPEL_THEN [`x`;`y`;`x`] (USE 0 o ISPECL);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let d_euclid_zero = prove_by_refinement(
+  `!n x y. (euclid n x) /\ (euclid n y)  ==>
+    ((d_euclid x y = &.0) <=> (x = y))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPEL_THEN [`euclid n`;`d_euclid`;`x`;`y`] (ASSUME_TAC o (C ISPECL) metric_space_zero2);
+  ASM_MESON_TAC[metric_euclid];
+  ]);;
+  (* }}} *)
+
+let d_euclid_pos2 = prove_by_refinement(
+  `!x y n. ~(x = y) /\ euclid n x /\ euclid n y ==> &0 <. d_euclid x y`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `&.0 <= x /\ ~(x = &.0) ==> (&.0 < x)`);
+  ASM_MESON_TAC[d_euclid_pos;d_euclid_zero];
+  ]);;
+  (* }}} *)
+
+let euclid_segment = prove_by_refinement(
+  `!n x y. (euclid n x) /\
+   (!t. (&.0 <. t) /\ (t <=. &.1) ==>
+         (euclid n (t *# x + (&.1 - t)*# y)))
+     ==>
+   (euclid n y)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `t = &.1/(&.2)` ABBREV_TAC;
+  TYPE_THEN `y = ((&.2) *# ((t *# x) + (&.1 - t)*# y)) - x` SUBGOAL_TAC;
+  REWRITE_TAC[euclid_minus;euclid_scale;euclid_plus];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC THEN BETA_TAC ;
+  REWRITE_TAC[REAL_ADD_LDISTRIB];
+  REWRITE_TAC[REAL_MUL_ASSOC;REAL_SUB_LDISTRIB ];
+  EXPAND_TAC "t";
+  SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&.2 = &.0)`];
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  TYPE_THEN `t` (USE 1 o SPEC);
+  TYPE_THEN `v = (euclid_plus (t *# x) ((&1 - t) *# y))` ABBREV_TAC;
+  KILL 3;
+  TYPE_THEN `&0 < t /\ t <= &1` SUBGOAL_TAC;
+  EXPAND_TAC "t";
+  CONJ_TAC ;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  REAL_ARITH_TAC;
+  IMATCH_MP_TAC  REAL_LE_LDIV;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  REWR 1;
+  ASM_SIMP_TAC[euclid_sub_closure;euclid_scale_closure];
+  ]);;
+  (* }}} *)
+
+let euclid_xy = prove_by_refinement(
+  `!n x y. (!t . (&.0 < t) /\ (t < &.1) ==>
+    (euclid n (t *# x + (&.1-t)*# y))) ==> (euclid n x) /\ (euclid n y)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `u = (&.1/(&.3))*# x + (&.1 - (&.1/(&.3))) *# y` ABBREV_TAC;
+  TYPE_THEN `v = (&.2/(&.3))*# x + (&.1 - (&.2/(&.3))) *# y` ABBREV_TAC;
+  TYPE_THEN `euclid n u` SUBGOAL_TAC;
+  EXPAND_TAC "u";
+  UND 0;
+  DISCH_THEN IMATCH_MP_TAC ;
+  CONV_TAC REAL_RAT_REDUCE_CONV;
+  DISCH_TAC;
+  TYPE_THEN `euclid n v` SUBGOAL_TAC;
+  EXPAND_TAC "v";
+  UND 0;
+  DISCH_THEN IMATCH_MP_TAC ;
+  CONV_TAC REAL_RAT_REDUCE_CONV;
+  DISCH_TAC;
+  TYPE_THEN `x = (&.2)*# v - (&.1) *# u` SUBGOAL_TAC;
+  EXPAND_TAC "u";
+  EXPAND_TAC "v";
+  REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale];
+  IMATCH_MP_TAC  EQ_EXT;
+  DISCH_ALL_TAC;
+  BETA_TAC;
+  TYPE_THEN `a = x x'`  ABBREV_TAC ;
+  TYPE_THEN `b= y x'`  ABBREV_TAC ;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  ASM_SIMP_TAC[euclid_scale_closure;euclid_sub_closure];
+  TYPE_THEN `y = (&.2)*# u - (&.1) *# v` SUBGOAL_TAC;
+  EXPAND_TAC "u";
+  EXPAND_TAC "v";
+  REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale];
+  IMATCH_MP_TAC  EQ_EXT;
+  DISCH_ALL_TAC;
+  BETA_TAC;
+  TYPE_THEN `a = x x'`  ABBREV_TAC ;
+  TYPE_THEN `b= y x'`  ABBREV_TAC ;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  ASM_SIMP_TAC[euclid_scale_closure;euclid_sub_closure];
+  ]);;
+  (* }}} *)
+
+
+let closure_segment = prove_by_refinement(
+  `!C n x y. (C SUBSET (euclid n)) /\
+      (!t. (&.0 < t) /\ (t < &.1) ==> (C (t *# x + (&.1-t)*# y))) ==>
+      (closure (top_of_metric(euclid n,d_euclid)) C y)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `euclid n x /\ (euclid n y)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  euclid_xy;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_ALL_TAC;
+  (* case x=y *)
+  TYPE_THEN `x = y` ASM_CASES_TAC ;
+  TYPE_THEN `C SUBSET (closure (top_of_metric (euclid n,d_euclid)) C)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  subset_closure;
+  ASM_SIMP_TAC [top_of_metric_top;metric_euclid];
+  REWRITE_TAC[ISUBSET];
+  TYPE_THEN `C x` SUBGOAL_TAC;
+  REWR 1;
+  USE 1 (REWRITE_RULE[trivial_lin_combo]);
+  TSPEC `&.1/(&.2)` 1;
+  USE 1 (CONV_RULE (REAL_RAT_REDUCE_CONV));
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  (* now ~(x=y) *)
+  TYPE_THEN `&.0 < d_euclid x y` SUBGOAL_TAC;
+  ASM_MESON_TAC[d_euclid_pos2];
+  DISCH_TAC;
+  ASM_SIMP_TAC[GSYM closure_open_ball;metric_euclid];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[open_ball];
+  (* ## *)
+  TYPE_THEN `?t. (&.0 <. t) /\ (t <. &.1) /\ (t *. (d_euclid x y) <. r)` SUBGOAL_TAC;
+  TYPE_THEN  `(&.1/(&.2))*. d_euclid x y < r` ASM_CASES_TAC;
+  TYPE_THEN `(&.1/(&.2))` EXISTS_TAC;
+  CONV_TAC (REAL_RAT_REDUCE_CONV);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(r/(&.2))/(d_euclid x y)` EXISTS_TAC;
+  ASM_SIMP_TAC[REAL_LT_DIV;REAL_LT_HALF1];
+  CONJ_TAC;
+  ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
+  REDUCE_TAC;
+  TYPE_THEN `s = d_euclid x y ` ABBREV_TAC;
+  ineq_lt_tac `r/(&.2) + ( (&1/(&2))*s - r)*(&1/(&2)) + (s)*(&3/(&4)) = s`;
+  ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ;REAL_LT_RDIV;half_pos];
+  DISCH_TAC;
+  CHO 7;
+  TYPE_THEN `t` (USE 1 o SPEC);
+  REWR 1;
+  TYPE_THEN `z = (euclid_plus (t *# x) ((&1 - t) *# y))` ABBREV_TAC ;
+  TYPE_THEN `z` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  EXPAND_TAC "z";
+  ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure];
+  DISCH_TAC;
+  TYPE_THEN `y = (t *# y) + ((&.1 - t)*# y)` SUBGOAL_TAC;
+  ASM_MESON_TAC[trivial_lin_combo];
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
+  EXPAND_TAC "z";
+  TYPE_THEN `euclid n (t*# y) /\  (euclid n (t *# x)) /\ (euclid n ((&.1-t)*# y))` SUBGOAL_TAC;
+  ASM_SIMP_TAC[euclid_add_closure;euclid_scale_closure];
+  DISCH_TAC;
+  USE 10 (MATCH_MP metric_translate);
+  KILL 8;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `d_euclid (t *# y) (t *# x) = d_euclid (t *# x) (t *# y)` SUBGOAL_TAC;
+  ASM_MESON_TAC [ISPEC `euclid n` metric_space_symm; euclid_scale_closure;metric_euclid];
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
+  JOIN 2 3;
+  USE 2 (MATCH_MP norm_scale_vec);
+  TSPEC `t` 2;
+  ASM_REWRITE_TAC[];
+  AND 7;
+  USE 7 (MATCH_MP (REAL_ARITH `&.0 < t ==> (&.0 <=. t)`));
+  USE 7 (REWRITE_RULE[GSYM ABS_REFL]);
+  ASM_REWRITE_TAC [];
+  ]);;
+
+  (* }}} *)
+
+
+
+(* ------------------------------------------------------------------ *)
+(* POINTS *)
+(* ------------------------------------------------------------------ *)
+
+
+let point = jordan_def `point z =
+   (FST z) *# (dirac_delta 0) + (SND z) *# (dirac_delta 1)`;;
+
+let dest_pt = jordan_def `dest_pt p =
+   @u.  p = point u`;;
+
+let point_xy = prove_by_refinement(
+  `!x y. point(x,y) = x *# (dirac_delta 0) + y *# (dirac_delta 1)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[point;];
+  ]);;
+  (* }}} *)
+
+let coord01 = prove_by_refinement(
+  `!p. (point p 0 = FST p) /\ (point p 1 = SND p)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[point;euclid_plus;euclid_scale ];
+  REWRITE_TAC[dirac_delta;ARITH_RULE   `~(1=0) /\ ~(0=1)`];
+  REDUCE_TAC ;
+  ]);;
+  (* }}} *)
+
+let euclid_point = prove_by_refinement(
+  `!p. euclid 2 (point p)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[point;euclid];
+  REWRITE_TAC[point;euclid_plus;euclid_scale;dirac_delta ];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP (ARITH_RULE `(2 <=| m) ==> (~(0=m) /\ (~(1=m)))`));
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC ;
+  ]);;
+  (* }}} *)
+
+let point_inj = prove_by_refinement(
+  `!p q. (point p = point q) <=> (p = q)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC ;
+  DISCH_TAC ;
+  WITH  0 (fun t -> AP_THM t `0`);
+  USE 0 (fun t-> AP_THM t `1`);
+  UND 0;
+  UND 1;
+  REWRITE_TAC[coord01;];
+  ASM_MESON_TAC[PAIR];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let point_onto = prove_by_refinement(
+  `!v. (euclid 2 v) ==> ?p. (v = point p)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `(v 0 ,v 1)` EXISTS_TAC;
+  IMATCH_MP_TAC  EQ_EXT ;
+  GEN_TAC ;
+  REWRITE_TAC[point;euclid_plus;euclid_scale;dirac_delta];
+  MP_TAC (ARITH_RULE `(0 = x) \/ ( 1 = x) \/ (2 <= x)`);
+  REP_CASES_TAC;
+  WITH 1 (MATCH_MP (ARITH_RULE  `(0=x) ==> ~(1=x)`));
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "x";
+  REDUCE_TAC;
+  WITH 1 (MATCH_MP (ARITH_RULE  `(1=x) ==> ~(0=x)`));
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "x";
+  REDUCE_TAC;
+  WITH 1 (MATCH_MP (ARITH_RULE  `(2 <=| x) ==> (~(0=x)/\ ~(1=x))`));
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ASM_MESON_TAC[euclid];
+  ]);;
+  (* }}} *)
+
+let dest_pt_point = prove_by_refinement(
+  `!p. dest_pt(point p) = p`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[dest_pt];
+  DISCH_ALL_TAC;
+  SELECT_TAC;
+  ASM_MESON_TAC[point_inj];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let point_dest_pt = prove_by_refinement(
+  `!v. (euclid 2 v) <=> (point (dest_pt v) = v)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  EQ_TAC;
+  REWRITE_TAC[dest_pt];
+  DISCH_ALL_TAC;
+  SELECT_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[point_onto];
+  ASM_MESON_TAC[euclid_point];
+  ]);;
+  (* }}} *)
+
+let Q_POINT = prove_by_refinement(
+  `!Q z. (?u v. (point z = point (u,v)) /\ (Q z u v)) <=> (Q z (FST z) (SND z))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[point_inj];
+  EQ_TAC;
+  DISCH_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `FST z` EXISTS_TAC;
+  TYPE_THEN `SND z` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let pointI = jordan_def `pointI p =
+   point(real_of_int (FST p),real_of_int (SND p))`;;
+
+let convex_pointI = prove_by_refinement(
+  `!p. (convex {(pointI p)})`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[convex;mk_segment;INSERT;IN_ELIM_THM';SUBSET; ];
+  REWRITE_TAC[IN;EMPTY];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[trivial_lin_combo];
+  DISCH_ALL_TAC;
+  CHO 2;
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let point_closure = prove_by_refinement(
+  `!p q a b. (?r. (a *# (point p) + (b *# (point q)) = (point r)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `euclid 2 (a *# (point p) + (b *# (point q)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC euclid_add_closure;
+  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN REWRITE_TAC [euclid_point];
+  MESON_TAC[point_onto];
+  ]);;
+  (* }}} *)
+
+let point_scale = prove_by_refinement(
+  `!a u v. a *# (point (u,v)) = point(a* u,a* v)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[point;euclid_scale;euclid_plus ];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC THEN BETA_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let point_add = prove_by_refinement(
+  `!u v u' v'. (point(u,v))+(point(u',v')) = (point(u+u',v+v'))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[point;euclid_plus;euclid_scale];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC THEN BETA_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+
+
+(* ------------------------------------------------------------------ *)
+(* the FLOOR function *)
+(* ------------------------------------------------------------------ *)
+
+
+let floor = jordan_def `floor x =
+   @m. (real_of_int m <=. x /\ (x < (real_of_int (m + &:1))))`;;
+
+let int_suc = prove_by_refinement(
+  `!m. (real_of_int (m + &:1) = real_of_int m + &.1)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[int_add_th;INT_NUM_REAL ];
+  ]);;
+  (* }}} *)
+
+let floor_ineq = prove_by_refinement(
+  `!x. (real_of_int (floor x) <=. x) /\ (x <. (real_of_int (floor x)) + &.1)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[floor];
+  SELECT_TAC;
+  REWRITE_TAC[int_suc];
+  MP_TAC (SPEC `&.1` REAL_ARCH_LEAST);
+  REDUCE_TAC;
+  DISCH_TAC;
+  ASM_CASES_TAC `&.0 <= x`;
+  TSPEC `x` 1;
+  REWR 1;
+  CHO 1;
+  LEFT 0 "y";
+  TSPEC `&:n` 0;
+  USE 0  (REWRITE_RULE[INT_NUM_REAL;int_add_th;REAL_OF_NUM_ADD ]);
+  ASM_MESON_TAC[];
+  TSPEC `--. x` 1;
+    COPY 2;
+  IMP_REAL `~(&.0 <=. x) ==> (&.0 <=. (-- x))` 2;
+  REWR 1;
+  CHO 1;
+  LEFT 0 "y";
+  ASM_CASES_TAC `&.n = --x`;
+  TSPEC `-- (&:n)` 0;
+  USE 0 (REWRITE_RULE[int_neg_th;int_add_th ;INT_NUM_REAL;REAL_OF_NUM_ADD]);
+  JOIN 0 1;
+  USE 0 (REWRITE_RULE[ GSYM REAL_OF_NUM_ADD]);
+  PROOF_BY_CONTR_TAC;
+  UND 0;
+  UND 4;
+  REAL_ARITH_TAC ;
+  TSPEC `--: (&:(n+| 1))` 0;
+  JOIN 1 0;
+  USE 0 (REWRITE_RULE[int_neg_th;int_add_th ;INT_NUM_REAL; GSYM REAL_OF_NUM_ADD;]);
+  JOIN 4 0;
+  PROOF_BY_CONTR_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let int_arch = prove_by_refinement(
+  `!m n. (n <=: m) /\ (m <: (n +: (&:1))) <=> (n = m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[int_lt;int_le;int_eq ;int_add_th;int_of_num_th   ];
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  MP_TAC (SPEC `m:int` dest_int_rep);
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  MP_TAC (SPEC `n:int` dest_int_rep);
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC)) THEN ((UNDISCH_FIND_TAC  `(/\)`)) THEN (  ASM_REWRITE_TAC[int_add_th;int_of_num_th ]) THEN  REDUCE_TAC THEN   TRY ARITH_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let floor_int = prove_by_refinement(
+  `!m. (floor (real_of_int m) = m)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `floor (real_of_int m) <=: m /\ (m <: (floor (real_of_int m)) + (&:1))` SUBGOAL_TAC;
+  REWRITE_TAC[int_le;int_lt;int_add_th ;int_of_num_th;floor_ineq  ];
+  REWRITE_TAC[int_arch ];
+  ]);;
+  (* }}} *)
+
+let int_lt_suc_le = prove_by_refinement(
+  `!m n. m <: n + &:1 <=> m <=: n`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  MP_TAC (SPEC `m:int` dest_int_rep);
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  MP_TAC (SPEC `n:int` dest_int_rep);
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC)) THEN ((UNDISCH_FIND_TAC  `(+:)`)) THEN (  ASM_REWRITE_TAC[int_add_th;int_of_num_th ]) THEN  REDUCE_TAC THEN   TRY ARITH_TAC;
+  REWRITE_TAC[int_le;int_lt;int_add_th;int_of_num_th];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let floor_le = prove_by_refinement(
+  `!m x. (real_of_int m <=. x) <=> (m <=: (floor x))`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  REWRITE_TAC[int_le];
+  REWRITE_TAC[GSYM int_le ;GSYM   int_lt_suc_le;];
+  REWRITE_TAC[int_lt ;int_add_th;int_of_num_th;];
+  ASM_MESON_TAC[floor_ineq; REAL_LET_TRANS];
+  REWRITE_TAC[int_le];
+  MP_TAC (SPEC `x:real` floor_ineq);
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let floor_lt = prove_by_refinement(
+  `!m x. (x < real_of_int m + &.1) <=> (floor x <=: m)`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  REWRITE_TAC[GSYM int_lt_suc_le ;];
+  REWRITE_TAC[int_lt;int_add_th;int_of_num_th;];
+  UND 0;
+  MP_TAC (SPEC `x:real` floor_ineq);
+  REAL_ARITH_TAC;
+  REWRITE_TAC[int_le;];
+  MP_TAC (SPEC `x:real` floor_ineq);
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let floor_mono = prove_by_refinement(
+  `!x y. (x <=. y) ==> (floor x <=: floor y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM floor_le];
+  REP_GEN_TAC;
+  MP_TAC (SPEC `x:real` floor_ineq);
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let floor_level = prove_by_refinement(
+  `!m x. ((&.0 <=. x) /\ (x <. &.1)) ==> (floor (real_of_int(m) + x) = m)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC  `!a b. (b <=: a /\ ~(b <: a)) ==> (a = b)`;
+  REWRITE_TAC[int_le;int_lt;int_eq];
+  REAL_ARITH_TAC;
+  DISCH_THEN IMATCH_MP_TAC ;
+  SUBCONJ_TAC;
+  REWRITE_TAC[GSYM floor_le];
+  UND 0;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 3 (REWRITE_RULE[]);
+  USE 3 (ONCE_REWRITE_RULE[GSYM INT_LT_RADD ]);
+  USE 3 (GEN `z:int`);
+  TSPEC `&:1` 3;
+  USE 3 (REWRITE_RULE [int_lt_suc_le ;]);
+  MP_TAC (SPEC `real_of_int m + x` floor_ineq);
+  UND 3;
+  UND 1;
+  REWRITE_TAC[int_add_th;int_le;int_of_num_th];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+
+let floor_range = prove_by_refinement(
+  `!x m. (floor x = m) <=> (real_of_int m <=. x /\ x <. real_of_int m +. &.1)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_THEN (fun t -> REWRITE_TAC[GSYM t;floor_ineq]);
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[GSYM INT_LE_ANTISYM;GSYM floor_lt;GSYM floor_le;];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* edges and squares *)
+(* ------------------------------------------------------------------ *)
+
+
+let h_edge = jordan_def `h_edge p =
+   { Z  | ?u v. (Z = point(u,v)) /\
+    (real_of_int (FST p) <. u) /\ (u <. (real_of_int ((FST p)+: (&:1)))) /\
+       (v = real_of_int (SND p)) }`;;
+
+let v_edge = jordan_def `v_edge p =
+   { Z  | ?u v. (Z = point(u,v)) /\
+    (real_of_int (SND p) <. v) /\ (v <. (real_of_int ((SND p) +: (&:1)))) /\
+       (u = real_of_int (FST p)) }`;;
+
+let squ = jordan_def `squ p =
+   {Z | ?u v. (Z = point(u,v)) /\
+    (real_of_int (FST p) <. u) /\ (u <. (real_of_int ((FST p) +: (&:1)))) /\
+    (real_of_int (SND p) <. v) /\ (v <. (real_of_int ((SND p) +: (&:1)))) }`;;
+
+let row = jordan_def `row k = {Z | ?u . (Z = point(u,real_of_int k))}`;;
+
+let col = jordan_def `col k = {Z | ?v . (Z = point(real_of_int k ,v))}`;;
+
+
+let pointI_inj = prove_by_refinement(
+  `!p q. (pointI p = pointI q) <=> (p = q) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[pointI;point_inj;PAIR_EQ;GSYM int_eq ];
+  MESON_TAC[PAIR;PAIR_EQ];
+  ]);;
+  (* }}} *)
+
+let h_edge_row = prove_by_refinement(
+  `!p . h_edge p  SUBSET  row (SND p) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;IN;h_edge;row;IN_ELIM_THM';];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let h_edge_floor = prove_by_refinement(
+  `!p. h_edge p SUBSET { z | floor (z 0)  = FST p }`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;IN;h_edge;IN_ELIM_THM';int_of_num_th;int_add_th;];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[coord01;floor_range];
+  UND 0;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let row_disj = prove_by_refinement(
+  `!a b. ~((row a) INTER (row b) = EMPTY) <=> (a = b)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS;IN;INTER;row;IN_ELIM_THM'  ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  AND 0;
+  CHO 0;
+  CHO 1;
+  REWRITE_TAC[int_eq];
+  USE 1 (GSYM);
+  REWR 1;
+  USE 1 (REWRITE_RULE [point_inj;PAIR_EQ ]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC [t]);
+  MESON_TAC[];
+   ]);;
+  (* }}} *)
+
+let h_edge_disj = prove_by_refinement(
+  `!p q. ~(h_edge p INTER h_edge q = EMPTY) <=> (p = q)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS;IN;INTER;IN_ELIM_THM'];
+  EQ_TAC;
+  DISCH_TAC;
+  CHO 0;
+  ONCE_REWRITE_TAC [GSYM PAIR];
+  REWRITE_TAC[PAIR_EQ];
+  CONJ_TAC;
+  MP_TAC h_edge_floor;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM'];
+  ASM_MESON_TAC[];
+  MP_TAC h_edge_row;
+  MP_TAC row_disj;
+  REWRITE_TAC[SUBSET;INTER;IN;IN_ELIM_THM';EMPTY_EXISTS;];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[h_edge;IN_ELIM_THM' ];
+  DISCH_THEN (fun t -> REWRITE_TAC[t;int_add_th ;int_of_num_th;]);
+  NAME_CONFLICT_TAC;
+  LEFT_TAC "u'";
+  TYPE_THEN `?x. (&.0 < x ) /\ (x < &.1)` SUBGOAL_TAC;
+  TYPE_THEN `&.1/(&.2)` EXISTS_TAC;
+  IMATCH_MP_TAC  half_pos;
+  ARITH_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `real_of_int (FST q) + x` EXISTS_TAC;
+  LEFT_TAC "v'";
+  TYPE_THEN `real_of_int (SND q)` EXISTS_TAC ;
+  TYPE_THEN `point (real_of_int (FST q) + x,real_of_int (SND q))` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let h_edge_pointI = prove_by_refinement(
+  `!p q. ~(h_edge p (pointI q))`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[pointI;h_edge;IN_ELIM_THM' ];
+  PROOF_BY_CONTR_TAC;
+  USE 0 (REWRITE_RULE[]);
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  USE 0 (REWRITE_RULE[point_inj;PAIR_EQ ]);
+  USE 0 GSYM ;
+  REWR 1;
+  REWR 2;
+  USE 2 (REWRITE_RULE[GSYM int_lt ;int_lt_suc_le ]);
+  USE 2 (REWRITE_RULE[int_le]);
+  UND 2;
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let v_edge_col = prove_by_refinement(
+  `!p . v_edge p  SUBSET  col (FST p) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;IN;v_edge;col;IN_ELIM_THM';];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let v_edge_floor = prove_by_refinement(
+  `!p. v_edge p SUBSET { z | floor (z 1)  = SND  p }`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;IN;v_edge;IN_ELIM_THM';int_of_num_th;int_add_th;];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[coord01;floor_range];
+  UND 0;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let col_disj = prove_by_refinement(
+  `!a b. ~((col a) INTER (col b) = EMPTY) <=> (a = b)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS;IN;INTER;col;IN_ELIM_THM'  ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  AND 0;
+  CHO 0;
+  CHO 1;
+  REWRITE_TAC[int_eq];
+  USE 1 (GSYM);
+  REWR 1;
+  USE 1 (REWRITE_RULE [point_inj;PAIR_EQ ]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC [t]);
+  MESON_TAC[];
+   ]);;
+  (* }}} *)
+
+let v_edge_disj = prove_by_refinement(
+  `!p q. ~(v_edge p INTER v_edge q = EMPTY) <=> (p = q)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS;IN;INTER;IN_ELIM_THM'];
+  EQ_TAC;
+  DISCH_TAC;
+  CHO 0;
+  ONCE_REWRITE_TAC [GSYM PAIR];
+  REWRITE_TAC[PAIR_EQ];
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b/\ a`);
+  CONJ_TAC;
+  MP_TAC v_edge_floor;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM'];
+  ASM_MESON_TAC[];
+  MP_TAC v_edge_col;
+  MP_TAC col_disj;
+  REWRITE_TAC[SUBSET;INTER;IN;IN_ELIM_THM';EMPTY_EXISTS;];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[v_edge;IN_ELIM_THM' ];
+  DISCH_THEN (fun t -> REWRITE_TAC[t;int_add_th ;int_of_num_th;]);
+  NAME_CONFLICT_TAC;
+  LEFT_TAC "u'";
+  TYPE_THEN `?x. (&.0 < x ) /\ (x < &.1)` SUBGOAL_TAC;
+  TYPE_THEN `&.1/(&.2)` EXISTS_TAC;
+  IMATCH_MP_TAC  half_pos;
+  ARITH_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  LEFT_TAC "v'";
+  LEFT_TAC "v'";
+  TYPE_THEN `real_of_int (SND q) + x` EXISTS_TAC;
+  TYPE_THEN `real_of_int (FST  q)` EXISTS_TAC ;
+  TYPE_THEN `point (real_of_int (FST q),real_of_int (SND q) +x)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let v_edge_pointI = prove_by_refinement(
+  `!p q. ~(v_edge p (pointI q))`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[pointI;v_edge;IN_ELIM_THM' ];
+  PROOF_BY_CONTR_TAC;
+  USE 0 (REWRITE_RULE[]);
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  USE 0 (REWRITE_RULE[point_inj;PAIR_EQ ]);
+  USE 0 GSYM ;
+  REWR 1;
+  REWR 2;
+  USE 2 (REWRITE_RULE[GSYM int_lt ;int_lt_suc_le ]);
+  USE 2 (REWRITE_RULE[int_le]);
+  UND 2;
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let row_col = prove_by_refinement(
+  `!a b. (row b INTER col a) = { (pointI(a,b)) }`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[col;row;INTER;IN;IN_ELIM_THM';pointI];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IN_ELIM_THM';INSERT;NOT_IN_EMPTY ];
+  GEN_TAC;
+  ASM_MESON_TAC[PAIR_EQ ;point_inj];
+  ]);;
+  (* }}} *)
+
+let hv_edge = prove_by_refinement(
+  `!p q. h_edge p INTER v_edge q = EMPTY`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `h_edge p INTER v_edge q SUBSET (row (SND p)) INTER (col (FST q))` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET_INTER;];
+  MESON_TAC[h_edge_row;v_edge_col;SUB_IMP_INTER ];
+  REWRITE_TAC[row_col];
+  DISCH_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 1 (REWRITE_RULE[EMPTY_EXISTS;IN  ]);
+  CHO 1;
+  USE 0 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM';INSERT;EMPTY ]);
+  TSPEC `u` 0;
+  REWR 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[INTER;IN;IN_ELIM_THM';h_edge_pointI]);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let square_col = prove_by_refinement(
+  `!p a. (squ p INTER col a) = EMPTY `,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[squ;col];
+  DISCH_ALL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 0 (REWRITE_RULE[EMPTY_EXISTS;IN ]);
+  CHO 0;
+  USE 0 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']);
+  AND 0;
+  CHO 0;
+  CHO 1;
+  CHO 1;
+  UND 1;
+  DISCH_ALL_TAC;
+  REWR 0;
+  USE 0 (REWRITE_RULE[point_inj;PAIR_EQ]);
+  REWR 3;
+  REWR 2;
+  USE 3 (REWRITE_RULE[GSYM int_lt; int_lt_suc_le ;]);
+  USE 3 (REWRITE_RULE[ int_le;]);
+  UND 2;
+  UND 3;
+  REAL_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let square_row = prove_by_refinement(
+  `!p a. (squ p INTER row a) = EMPTY `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[squ;row];
+  DISCH_ALL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 0 (REWRITE_RULE[EMPTY_EXISTS;IN ]);
+  CHO 0;
+  USE 0 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']);
+  AND 0;
+  CHO 0;
+  CHO 1;
+  CHO 1;
+  UND 1;
+  DISCH_ALL_TAC;
+  REWR 0;
+  USE 0 (REWRITE_RULE[point_inj;PAIR_EQ]);
+  REWR 5;
+  REWR 4;
+  USE 5 (REWRITE_RULE[GSYM int_lt; int_lt_suc_le ;]);
+  USE 5 (REWRITE_RULE[ int_le;]);
+  UND 5;
+  UND 4;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let pointI_row = prove_by_refinement(
+  `!p.   (row (SND p)) (pointI p)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[row;pointI;IN_ELIM_THM' ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let pointI_col = prove_by_refinement(
+  `!p.   (col (FST p)) (pointI p)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[col;pointI;IN_ELIM_THM' ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let square_v_edge = prove_by_refinement(
+  `!p q. (squ p INTER v_edge q = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  TYPE_THEN `squ p INTER v_edge q SUBSET squ p INTER col (FST q)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET_INTER];
+  MESON_TAC[SUB_IMP_INTER;v_edge_col;SUBSET_REFL];
+  REWRITE_TAC[square_col;SUBSET_EMPTY ];
+  ]);;
+  (* }}} *)
+
+let square_h_edge = prove_by_refinement(
+  `!p q. (squ p INTER h_edge q = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  TYPE_THEN `squ p INTER h_edge q SUBSET squ p INTER row (SND  q)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET_INTER];
+  MESON_TAC[SUB_IMP_INTER;h_edge_row;SUBSET_REFL];
+  REWRITE_TAC[square_row;SUBSET_EMPTY ];
+  ]);;
+  (* }}} *)
+
+let square_pointI = prove_by_refinement(
+  `!p q. ~(squ p (pointI q))`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  TYPE_THEN `q` (fun t -> ASSUME_TAC (SPEC t pointI_col));
+  TYPEL_THEN [`p`;`FST q`] (fun t -> MP_TAC (SPECL t square_col));
+  REWRITE_TAC[INTER;IN;];
+  IMATCH_MP_TAC  (TAUT `(a ==> ~b) ==> (b ==> ~ a)`);
+  DISCH_TAC;
+  REWRITE_TAC[EMPTY_EXISTS;IN ];
+  TYPE_THEN `pointI q` EXISTS_TAC;
+  ASM_REWRITE_TAC[IN_ELIM_THM'];
+  ]);;
+  (* }}} *)
+
+let square_floor0 = prove_by_refinement(
+  `!p. (squ p SUBSET { z | (floor (z 0)) = (FST p) })`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';squ];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[coord01;floor_range];
+  UND 1;
+  UND 2;
+  REWRITE_TAC[int_add_th;int_of_num_th];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let square_floor1 = prove_by_refinement(
+  `!p. (squ p SUBSET { z | (floor (z 1)) = (SND p) })`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';squ];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[coord01;floor_range];
+  UND 3;
+  UND 4;
+  REWRITE_TAC[int_add_th;int_of_num_th];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let square_square = prove_by_refinement(
+  `!p q. ~(squ p INTER squ q = {}) ==> (squ p = squ q)`,
+  (* {{{ proof *)
+  [
+  MP_TAC square_floor0;
+  MP_TAC square_floor1;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';INTER;EMPTY_EXISTS  ];
+  DISCH_ALL_TAC;
+  REP_GEN_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `p = q` SUBGOAL_TAC;
+  ONCE_REWRITE_TAC [GSYM PAIR];
+  REWRITE_TAC[PAIR_EQ];
+  ASM_MESON_TAC[];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let square_disj = prove_by_refinement(
+  `!p q. ~(squ p INTER squ q = EMPTY) <=> (p = q)`,
+  (* {{{ proof *)
+  [
+  MP_TAC square_floor0;
+  MP_TAC square_floor1;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';INTER;EMPTY_EXISTS  ];
+  DISCH_ALL_TAC;
+  REP_GEN_TAC;
+  EQ_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  ONCE_REWRITE_TAC [GSYM PAIR];
+  REWRITE_TAC[PAIR_EQ];
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[squ];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "u''");
+  TYPE_THEN `real_of_int (FST q) + (&.1/(&.2))` EXISTS_TAC;
+  TYPE_THEN `real_of_int (SND q) + (&.1/(&.2))` EXISTS_TAC;
+  REWRITE_TAC[int_suc];
+  TYPE_THEN `a = real_of_int(FST q)` ABBREV_TAC;
+(*** Modified by JRH since ABBREV_TAC now forbids existing variables
+  TYPE_THEN `a = real_of_int(SND  q)` ABBREV_TAC;
+ ****)
+  TYPE_THEN `a' = real_of_int(SND  q)` ABBREV_TAC;
+  MP_TAC (REAL_RAT_REDUCE_CONV `&.0 < &.1/(&.2) /\ (&.1/(&.2)) < &.1`);
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(*  cells *)
+(* ------------------------------------------------------------------ *)
+
+
+let cell = jordan_def `cell =
+  {z | (?p. (z = { (pointI p) }) \/ (z = h_edge p) \/
+              (z = v_edge p) \/ (z = squ p))}`;;
+
+let cell_rules = prove_by_refinement(
+  `!p. cell {(pointI p)} /\ (cell (h_edge p)) /\
+      (cell (v_edge p)) /\ (cell (squ p))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cell;IN_ELIM_THM';];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let cell_mem = prove_by_refinement(
+  `!C. (cell C) <=> (?p. C = ({(pointI p)})) \/ (?p. C = h_edge p) \/
+    (?p. C = v_edge p) \/ (?p. C = squ p)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cell;IN_ELIM_THM'];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let square_domain = prove_by_refinement(
+  `!z.  (let (p = (floor(FST z),floor(SND z))) in
+       (({(pointI p)} UNION
+        (h_edge p) UNION
+        (v_edge p) UNION
+        (squ p) ))) (point z) `,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  LET_TAC;
+  REWRITE_TAC[UNION;IN;IN_ELIM_THM' ];
+  REWRITE_TAC[pointI;h_edge;v_edge;squ;int_add_th;int_of_num_th;IN_ELIM_THM';INSERT;EMPTY;point_inj;Q_POINT ];
+  ASSUME_TAC floor_ineq;
+  TYPE_THEN `FST z` (WITH 0 o SPEC);
+  TSPEC `SND z` 0;
+  UND 0;
+  UND 1;
+  REWRITE_TAC[PAIR_LEMMAv2];
+  REWRITE_TAC[REAL_ARITH `(a <= b) <=> ((a = b) \/ (a < b))`];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let square_cell = prove_by_refinement(
+  `!z. (let (p = (floor(FST z),floor(SND z))) in
+       (({(pointI p)} UNION
+        (h_edge p) UNION
+        (v_edge p) UNION
+        (squ p) ))) SUBSET (UNIONS cell) `,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  LET_TAC;
+  REWRITE_TAC[union_subset];
+  REPEAT CONJ_TAC THEN (IMATCH_MP_TAC  sub_union) THEN (REWRITE_TAC[cell_rules]);
+  ]);;
+  (* }}} *)
+
+let cell_unions = prove_by_refinement(
+  `!z. (UNIONS cell (point z))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  ASM_MESON_TAC[square_cell;square_domain;SUBSET;IN];
+  ]);;
+  (* }}} *)
+
+let cell_partition = prove_by_refinement(
+  `!C D. (cell C) /\ (cell D) /\ ~(C INTER D = EMPTY) ==> (C = D)`,
+  (* {{{ proof *)
+  let revr = PURE_ONCE_REWRITE_RULE [INTER_COMM] in
+  [
+  PARTIAL_REWRITE_TAC[cell_mem;];
+  PARTIAL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR ];
+  REP_GEN_TAC;
+  PARTIAL_REWRITE_TAC[TAUT `((a \/ b ==> C)) <=> ((a ==> C) /\ (b ==> C))`];
+  PARTIAL_REWRITE_TAC[TAUT `((a /\ b) ==> C) <=> (a ==> b ==> C)`];
+  REPEAT CONJ_TAC THEN (REPEAT (DISCH_THEN CHOOSE_TAC)) THEN (TRY (UNDISCH_FIND_TAC `(INTER)`))  THEN (ASM PARTIAL_REWRITE_TAC[])  THEN ASM PARTIAL_REWRITE_TAC[square_h_edge;square_v_edge;revr square_h_edge;revr square_v_edge;v_edge_disj;h_edge_disj;hv_edge;revr hv_edge;revr single_inter; single_inter;square_pointI;v_edge_pointI;h_edge_pointI; square_square;INR NOT_IN_EMPTY;INR IN_SING ] THEN (DISCH_THEN (fun t-> REWRITE_TAC[t]));
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* adjacency, closure, convexity, AND strict dominance on cells. *)
+(* ------------------------------------------------------------------ *)
+
+
+let top2 = jordan_def `top2 = top_of_metric (euclid 2,d_euclid)`;;
+
+let adj = jordan_def `adj X Y <=> (~(X = Y) /\
+   ~(closure top2 X INTER (closure top2 Y) = EMPTY))`;;
+
+let strict_dom = jordan_def `strict_dom X Y <=> (cell X) /\ (cell Y) /\
+  (closure top2 Y PSUBSET (closure top2 X))`;;
+
+let adj_symm = prove_by_refinement(
+  `!X Y. (adj X Y) <=> (adj Y X)`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[adj];
+  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [INTER_COMM];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let adj_irrefl = prove_by_refinement(
+  `!X. (~(adj X X))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[adj;];
+  ]);;
+  (* }}} *)
+
+let strict_dom_trans = prove_by_refinement(
+  `!X Y Z. (strict_dom X Y) /\ (strict_dom Y Z) ==> (strict_dom X Z)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[strict_dom];
+  MESON_TAC[PSUBSET_TRANS];
+  ]);;
+  (* }}} *)
+
+let strict_dom_irrefl = prove_by_refinement(
+  `!X. ~(strict_dom X X)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[strict_dom;PSUBSET_IRREFL ];
+  ]);;
+  (* }}} *)
+
+let dot_point = prove_by_refinement(
+  `!p q . (dot (point p) (point q)) = (FST p)*(FST q) + (SND p)*(SND q)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `dot (point p) (point q) = sum (0,2) (\i. (point p i)*(point q i))` SUBGOAL_TAC;
+  IMATCH_MP_TAC dot_euclid;
+  ASM_SIMP_TAC[euclid_point];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[ARITH_RULE `2 = SUC 1`];
+  REWRITE_TAC[sum];
+  REWRITE_TAC[ARITH_RULE `1 = SUC 0`];
+  REWRITE_TAC[sum];
+  REDUCE_TAC;
+  REWRITE_TAC[ARITH_RULE `SUC 0 = 1`;coord01];
+  ]);;
+  (* }}} *)
+
+
+(* 2d half planes *)
+let open_half_plane2D_FLT = prove_by_refinement(
+  `!r. { z | ?p. ((z = point p) /\ (FST p <. r))  } =
+     open_half_space 2 (point (&.1,&.0)) r `,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[open_half_space ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASM_REWRITE_TAC[dot_point;euclid_point;];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC [];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let open_half_plane2D_LTF = prove_by_refinement(
+  `!r. { z | ?p. ((z = point p) /\ (r <. FST p ))  } =
+     open_half_space 2 (point (--. (&.1),&.0)) (--. r) `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[open_half_space ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASM_REWRITE_TAC[dot_point;euclid_point;];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let open_half_plane2D_SLT = prove_by_refinement(
+  `!r. { z | ?p. ((z = point p) /\ (SND p <. r ))  } =
+     open_half_space 2 (point (&.0,&.1)) ( r) `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[open_half_space ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASM_REWRITE_TAC[dot_point;euclid_point;];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let open_half_plane2D_LTS = prove_by_refinement(
+  `!r. { z | ?p. ((z = point p) /\ (r <. SND p  ))  } =
+     open_half_space 2 (point (&.0,--.(&.1))) (--. r) `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[open_half_space ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASM_REWRITE_TAC[dot_point;euclid_point;];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_FLE = prove_by_refinement(
+  `!r. { z | ?p. ((z = point p) /\ (FST p <=. r))  } =
+     closed_half_space 2 (point (&.1,&.0)) r `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASM_REWRITE_TAC[dot_point;euclid_point;];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC [];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_LEF = prove_by_refinement(
+  `!r. { z | ?p. ((z = point p) /\ (r <=. FST p))  } =
+     closed_half_space 2 (point (--.(&.1),&.0)) (--. r) `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASM_REWRITE_TAC[dot_point;euclid_point;];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC [];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_SLE = prove_by_refinement(
+  `!r. { z | ?p. ((z = point p) /\ (SND p <=. r))  } =
+     closed_half_space 2 (point (&.0,&.1)) r `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASM_REWRITE_TAC[dot_point;euclid_point;];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC [];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_LES = prove_by_refinement(
+  `!r. { z | ?p. ((z = point p) /\ (r <=. SND p ))  } =
+     closed_half_space 2 (point (&.0,(--. (&.1)))) (--. r) `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASM_REWRITE_TAC[dot_point;euclid_point;];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC [];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let line2D_F = prove_by_refinement(
+  `!r. { z | ?p. ((z = point p) /\ (FST p = r))  } =
+     hyperplane 2 (point (&.1,&.0)) r `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASM_REWRITE_TAC[dot_point;euclid_point;];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC [];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let line2D_S = prove_by_refinement(
+  `!r. { z | ?p. ((z = point p) /\ (SND p = r))  } =
+     hyperplane 2 (point (&.0,&.1)) r `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[open_half_space;hyperplane;closed_half_space ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASM_REWRITE_TAC[dot_point;euclid_point;];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC [];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[dot_point;euclid_point]);
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let open_half_plane2D_FLT_open = prove_by_refinement(
+  `!r. top2 { z | ?p. ((z = point p) /\ (FST p <. r))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_FLT;top2];
+  SIMP_TAC[open_half_space_open;euclid_point];
+  ]);;
+  (* }}} *)
+
+let open_half_plane2D_LTF_open = prove_by_refinement(
+  `!r. top2 { z | ?p. ((z = point p) /\ (r <. FST p ))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_LTF;top2];
+  SIMP_TAC[open_half_space_open;euclid_point];
+  ]);;
+  (* }}} *)
+
+let open_half_plane2D_SLT_open = prove_by_refinement(
+  `!r. top2 { z | ?p. ((z = point p) /\ (SND p <. r  ))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_SLT;top2];
+  SIMP_TAC[open_half_space_open;euclid_point];
+  ]);;
+  (* }}} *)
+
+let open_half_plane2D_LTS_open = prove_by_refinement(
+  `!r. top2 { z | ?p. ((z = point p) /\ (r <. SND p   ))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_LTS;top2];
+  SIMP_TAC[open_half_space_open;euclid_point];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_FLT_closed = prove_by_refinement(
+  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (FST p <=. r))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[closed_half_plane2D_FLE;top2];
+  SIMP_TAC[closed_half_space_closed;euclid_point];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_LTF_closed = prove_by_refinement(
+  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (r <=. FST p ))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[closed_half_plane2D_LEF;top2];
+  SIMP_TAC[closed_half_space_closed;euclid_point];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_SLT_closed = prove_by_refinement(
+  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (SND p <=. r  ))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[closed_half_plane2D_SLE;top2];
+  SIMP_TAC[closed_half_space_closed;euclid_point];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_LTS_closed = prove_by_refinement(
+  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (r <=. SND p   ))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[closed_half_plane2D_LES;top2];
+  SIMP_TAC[closed_half_space_closed;euclid_point];
+  ]);;
+  (* }}} *)
+
+let line2D_F_closed = prove_by_refinement(
+  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (FST p = r))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[line2D_F;top2];
+  SIMP_TAC[hyperplane_closed;euclid_point];
+  ]);;
+  (* }}} *)
+
+let line2D_S_closed = prove_by_refinement(
+  `!r. closed_ top2 { z | ?p. ((z = point p) /\ (SND p = r))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[line2D_S;top2];
+  SIMP_TAC[hyperplane_closed;euclid_point];
+  ]);;
+  (* }}} *)
+
+let open_half_plane2D_FLT_convex = prove_by_refinement(
+  `!r. convex { z | ?p. ((z = point p) /\ (FST p <. r))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_FLT;];
+  SIMP_TAC[open_half_space_convex;euclid_point];
+  ]);;
+  (* }}} *)
+
+let open_half_plane2D_LTF_convex = prove_by_refinement(
+  `!r. convex { z | ?p. ((z = point p) /\ (r <. FST p ))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_LTF;];
+  SIMP_TAC[open_half_space_convex;euclid_point];
+  ]);;
+  (* }}} *)
+
+let open_half_plane2D_SLT_convex = prove_by_refinement(
+  `!r. convex { z | ?p. ((z = point p) /\ (SND p <. r))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_SLT;];
+  SIMP_TAC[open_half_space_convex;euclid_point];
+  ]);;
+  (* }}} *)
+
+let open_half_plane2D_LTS_convex = prove_by_refinement(
+  `!r. convex { z | ?p. ((z = point p) /\ (r <. SND p ))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_LTS;];
+  SIMP_TAC[open_half_space_convex;euclid_point];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_FLT_convex = prove_by_refinement(
+  `!r. convex { z | ?p. ((z = point p) /\ (FST p <=. r))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[closed_half_plane2D_FLE;];
+  SIMP_TAC[closed_half_space_convex;euclid_point];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_LTF_convex = prove_by_refinement(
+  `!r. convex { z | ?p. ((z = point p) /\ (r <=. FST p ))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[closed_half_plane2D_LEF;];
+  SIMP_TAC[closed_half_space_convex;euclid_point];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_SLT_convex = prove_by_refinement(
+  `!r. convex { z | ?p. ((z = point p) /\ (SND p <=. r))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[closed_half_plane2D_SLE;];
+  SIMP_TAC[closed_half_space_convex;euclid_point];
+  ]);;
+  (* }}} *)
+
+let closed_half_plane2D_LTS_convex = prove_by_refinement(
+  `!r. convex { z | ?p. ((z = point p) /\ (r <=. SND p ))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[closed_half_plane2D_LES;];
+  SIMP_TAC[closed_half_space_convex;euclid_point];
+  ]);;
+  (* }}} *)
+
+let line2D_F_convex = prove_by_refinement(
+  `!r. convex { z | ?p. ((z = point p) /\ ( FST p = r ))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[line2D_F;];
+  SIMP_TAC[hyperplane_convex;euclid_point];
+  ]);;
+  (* }}} *)
+
+let line2D_S_convex = prove_by_refinement(
+  `!r. convex { z | ?p. ((z = point p) /\ (SND p = r))  }`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[line2D_S;];
+  SIMP_TAC[hyperplane_convex;euclid_point];
+  ]);;
+  (* }}} *)
+
+let closure_FLT = prove_by_refinement(
+  `!r. (closure top2 { z | ?p. ((z = point p) /\ (FST p <. r))  } =
+       { z | ?p. ((z = point p) /\ (FST p <=. r))  })`,
+  (* {{{ proof *)
+
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_FLT;closed_half_plane2D_FLE;top2];
+  TYPE_THEN `~(point(&.1,&.0) = euclid0)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 0(REWRITE_RULE[]);
+  USE 0  (fun t -> AP_THM t `0`);
+  USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(&.1= &.0)`]);
+  ASM_REWRITE_TAC[];
+  SIMP_TAC[closure_half_space;euclid_point];
+  ]);;
+
+  (* }}} *)
+
+let closure_LTF = prove_by_refinement(
+  `!r. (closure top2 { z | ?p. ((z = point p) /\ (r <. FST p))  } =
+       { z | ?p. ((z = point p) /\ (r <=. FST p ))  })`,
+  (* {{{ proof *)
+
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_LTF;closed_half_plane2D_LEF;top2];
+  TYPE_THEN `~(point(--. (&.1),&.0) = euclid0)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 0(REWRITE_RULE[]);
+  USE 0  (fun t -> AP_THM t `0`);
+  USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(--. (&.1)= &.0)`]);
+  ASM_REWRITE_TAC[];
+  SIMP_TAC[closure_half_space;euclid_point];
+  ]);;
+
+  (* }}} *)
+
+let closure_SLT = prove_by_refinement(
+  `!r. (closure top2 { z | ?p. ((z = point p) /\ (SND  p <. r))  } =
+       { z | ?p. ((z = point p) /\ (SND  p <=. r))  })`,
+  (* {{{ proof *)
+
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_SLT;closed_half_plane2D_SLE;top2];
+  TYPE_THEN `~(point(&.0,&.1) = euclid0)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 0(REWRITE_RULE[]);
+  USE 0  (fun t -> AP_THM t `1`);
+  USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(&.1= &.0)`]);
+  ASM_REWRITE_TAC[];
+  SIMP_TAC[closure_half_space;euclid_point];
+  ]);;
+
+  (* }}} *)
+
+let closure_LTS = prove_by_refinement(
+  `!r. (closure top2 { z | ?p. ((z = point p) /\ (r <. SND  p))  } =
+       { z | ?p. ((z = point p) /\ (r <=. SND  p ))  })`,
+  (* {{{ proof *)
+
+  [
+  GEN_TAC;
+  REWRITE_TAC[open_half_plane2D_LTS;closed_half_plane2D_LES;top2];
+  TYPE_THEN `~(point(&.0, --. (&.1)) = euclid0)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 0(REWRITE_RULE[]);
+  USE 0  (fun t -> AP_THM t `1`);
+  USE 0 (REWRITE_RULE[coord01;euclid0;REAL_ARITH `~(--. (&.1)= &.0)`]);
+  ASM_REWRITE_TAC[];
+  SIMP_TAC[closure_half_space;euclid_point];
+  ]);;
+
+  (* }}} *)
+
+
+
+(* ------------------------------------------------------------------ *)
+(* SECTION B *)
+(* ------------------------------------------------------------------ *)
+
+(* -> sets *)
+let single_subset = prove_by_refinement(
+  `!(x:A) A. ({x} SUBSET A) <=> (A x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;INSERT];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let top2_top = prove_by_refinement(
+  `topology_ top2  `,
+  (* {{{ proof *)
+  [
+  ASM_SIMP_TAC [top2;top_of_metric_top;metric_euclid];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* H_edge & v_edge, convexity, closure, closed, adj, etc. *)
+(* ------------------------------------------------------------------ *)
+
+let e1 = jordan_def `e1 = point(&.1,&.0)`;;
+let e2 = jordan_def `e2 = point(&.0,&.1)`;;
+
+let hc_edge = jordan_def `hc_edge m =
+   (h_edge m) UNION {(pointI m)} UNION {(pointI m + e1)}`;;
+
+let vc_edge = jordan_def `vc_edge m =
+   (v_edge m) UNION {(pointI m)} UNION {(pointI m + e2)}`;;
+
+
+
+(* H edge *)
+let h_edge_inter = prove_by_refinement(
+  `!m. (h_edge m) =
+   ({z | ?p. (z = point p) /\ (real_of_int (FST  m) <. FST p)}
+      INTER {z | ?p. (z = point p) /\ (FST p <. real_of_int(FST  m +: &:1))}
+      INTER {z | ?p. (z = point p) /\ (SND p = real_of_int(SND  m))})`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[INTER;h_edge];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[point_inj];
+  REPEAT CONJ_TAC THEN (TYPE_THEN `(u,real_of_int(SND m))` EXISTS_TAC) THEN ASM_REWRITE_TAC[PAIR_SPLIT];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 1;
+  CHO 2;
+  TYPE_THEN `FST p` EXISTS_TAC;
+  TYPE_THEN `SND  p` EXISTS_TAC;
+  REWR 1;
+  REWR 2;
+  USE 2 (REWRITE_RULE[point_inj]);
+  USE 1 (REWRITE_RULE[point_inj]);
+  AND 1;
+  AND 2;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let h_edge_convex = prove_by_refinement(
+  `!m. (convex (h_edge m))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[h_edge_inter;];
+  IMATCH_MP_TAC convex_inter;
+  CONJ_TAC;
+  REWRITE_TAC [open_half_plane2D_LTF_convex;];
+  IMATCH_MP_TAC  convex_inter;
+  REWRITE_TAC[open_half_plane2D_FLT_convex;line2D_S_convex];
+  ]);;
+  (* }}} *)
+
+let hc_edge_inter = prove_by_refinement(
+  `!m. (hc_edge m) =
+   ({z | ?p. (z = point p) /\ (real_of_int (FST  m) <=. FST p)}
+      INTER {z | ?p. (z = point p) /\ (FST p <=. real_of_int(FST  m +: &:1))}
+      INTER {z | ?p. (z = point p) /\ (SND p = real_of_int(SND  m))})`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[hc_edge;e1];
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  REPEAT (CONJ_TAC);
+  REWRITE_TAC[h_edge_inter];
+  REWRITE_TAC[SUBSET;INTER];
+  ASM_MESON_TAC[REAL_ARITH `a < b ==> a <=. b`];
+  REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; int_suc];
+  REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m),real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN  ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`];
+  REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; point_add;int_suc];
+  REDUCE_TAC;
+  REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m) + &.1,real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN  ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`];
+  REWRITE_TAC[INTER;SUBSET;UNION;e1;h_edge;pointI;point_add;point_inj;INR IN_SING ;int_suc ];
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  REWR 1;
+  REWR 2;
+  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  REWRITE_TAC[prove_by_refinement( `!P x y. (?u v. (((x:A) = u) /\ ((y:B) = v)) /\ P u v) <=> (P x y)`,[MESON_TAC[]])];
+  UND 2;
+  UND 1;
+  REWRITE_TAC[point_inj;];
+  REWRITE_TAC[prove_by_refinement (`!Q p. (?p'. ((p:A) = p') /\ (Q p')) <=> (Q p)`,[MESON_TAC[]])];
+  AND 0;
+  UND 0;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let hc_edge_closed = prove_by_refinement(
+  `!m. (closed_ top2 (hc_edge m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[hc_edge_inter];
+  GEN_TAC;
+  IMATCH_MP_TAC  closed_inter2;
+  REWRITE_TAC[top2_top;closed_half_plane2D_LTF_closed];
+  IMATCH_MP_TAC  closed_inter2;
+  REWRITE_TAC[top2_top;closed_half_plane2D_FLT_closed;line2D_S_closed;];
+  ]);;
+  (* }}} *)
+
+let hc_edge_convex = prove_by_refinement(
+  `!m. (convex (hc_edge m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[hc_edge_inter];
+  GEN_TAC;
+  IMATCH_MP_TAC convex_inter;
+  REWRITE_TAC[closed_half_plane2D_LTF_convex];
+  IMATCH_MP_TAC  convex_inter;
+  REWRITE_TAC[closed_half_plane2D_FLT_convex;line2D_S_convex;];
+  ]);;
+  (* }}} *)
+
+let h_edge_subset = prove_by_refinement(
+  `!m. (h_edge m SUBSET hc_edge m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[hc_edge;SUBSET;UNION;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let h_edge_euclid = prove_by_refinement(
+  `!m. (h_edge m) SUBSET (euclid 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;h_edge];
+  MESON_TAC[euclid_point];
+  ]);;
+  (* }}} *)
+
+let h_edge_closure = prove_by_refinement(
+  `!m. (closure top2 (h_edge m)) = hc_edge m`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  closure_subset;
+  REWRITE_TAC[h_edge_subset;top2_top;hc_edge_closed];
+  REWRITE_TAC[hc_edge];
+  REWRITE_TAC[union_subset;e1;pointI;single_subset;point_add];
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_closure;
+  REWRITE_TAC[top2_top];
+  REWRITE_TAC[top2];
+  SUBGOAL_TAC `!t u. t*u +. (&.1- t)*u = u` ;
+  REWRITE_TAC[GSYM REAL_RDISTRIB];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  CONJ_TAC THEN (IMATCH_MP_TAC  closure_segment) THEN REWRITE_TAC[h_edge_euclid];
+  TYPE_THEN `(pointI m)+point(&.1,&.0)` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[h_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[int_suc];
+  TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
+  UND 1;
+  UND 2;
+  REAL_ARITH_TAC ;
+  TYPE_THEN `pointI m` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[h_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[int_suc];
+  TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
+  UND 1;
+  UND 2;
+  REAL_ARITH_TAC ;
+  ]);;
+
+  (* }}} *)
+
+(* move up *)
+let point_split = prove_by_refinement(
+  `!z u v. (z = point(u,v)) <=> (u = z 0) /\ (v = z 1) /\ (euclid 2 z)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC ;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[coord01;euclid_point];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  DISJ_CASES_TAC (ARITH_RULE  `(x = 0) \/ (x = 1) \/ (2 <= x)`);
+  ASM_REWRITE_TAC[coord01];
+  UND 3;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[coord01];
+  ASM_MESON_TAC[euclid;euclid_point]
+  ]);;
+  (* }}} *)
+
+
+(* V edge *)
+let v_edge_inter = prove_by_refinement(
+  `!m. (v_edge m) =
+   ({z | ?p. (z = point p) /\ (real_of_int (SND   m) <. SND  p)}
+      INTER {z | ?p. (z = point p) /\ (SND  p <. real_of_int(SND  m +: &:1))}
+      INTER {z | ?p. (z = point p) /\ (FST p = real_of_int(FST  m))})`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[INTER;v_edge;int_suc ];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[point_inj];
+  CONV_TAC (dropq_conv "p");
+  ASM_REWRITE_TAC[];
+  CONV_TAC (dropq_conv "p");
+  CONV_TAC (dropq_conv "p'");
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "u");
+  REWRITE_TAC[point_split;];
+  CONV_TAC (dropq_conv "v");
+  ASM_MESON_TAC[FST;SND;PAIR;coord01;euclid_point;point_onto];
+  ]);;
+  (* }}} *)
+
+let v_edge_convex = prove_by_refinement(
+  `!m. (convex (v_edge m))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[v_edge_inter;];
+  IMATCH_MP_TAC convex_inter;
+  CONJ_TAC;
+  REWRITE_TAC [open_half_plane2D_LTS_convex;];
+  IMATCH_MP_TAC  convex_inter;
+  REWRITE_TAC[open_half_plane2D_SLT_convex;line2D_F_convex];
+  ]);;
+  (* }}} *)
+
+let vc_edge_inter = prove_by_refinement(
+  `!m. (vc_edge m) =
+   ({z | ?p. (z = point p) /\ (real_of_int (SND   m) <=. SND  p)}
+      INTER {z | ?p. (z = point p) /\ (SND p <=. real_of_int(SND  m +: &:1))}
+      INTER {z | ?p. (z = point p) /\ (FST  p = real_of_int(FST   m))})`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[vc_edge;e2];
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  REPEAT (CONJ_TAC);
+  REWRITE_TAC[v_edge_inter];
+  REWRITE_TAC[SUBSET;INTER];
+  ASM_MESON_TAC[REAL_ARITH `a < b ==> a <=. b`];
+  REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; int_suc];
+  REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m),real_of_int(SND m))` EXISTS_TAC) THEN REWRITE_TAC[] THEN  ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`];
+  REWRITE_TAC[single_subset;INTER;pointI;point_inj;PAIR_SPLIT ; point_add;int_suc];
+  REDUCE_TAC;
+  REPEAT (CONJ_TAC) THEN (TYPE_THEN `(real_of_int(FST m) ,real_of_int(SND m) + &.1)` EXISTS_TAC) THEN REWRITE_TAC[] THEN  ASM_MESON_TAC[REAL_LE_REFL;REAL_ARITH `x <=. x+ &.1`];
+  REWRITE_TAC[INTER;SUBSET;UNION;e2;v_edge;pointI;point_add;point_inj;INR IN_SING ;int_suc ];
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  REWR 1;
+  REWR 2;
+  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  REWRITE_TAC[prove_by_refinement( `!P x y. (?u v. (((x:A) = u) /\ ((y:B) = v)) /\ P u v) <=> (P x y)`,[MESON_TAC[]])];
+  UND 2;
+  UND 1;
+  REWRITE_TAC[point_inj;];
+  REWRITE_TAC[prove_by_refinement (`!Q p. (?p'. ((p:A) = p') /\ (Q p')) <=> (Q p)`,[MESON_TAC[]])];
+  AND 0;
+  UND 0;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let vc_edge_closed = prove_by_refinement(
+  `!m. (closed_ top2 (vc_edge m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[vc_edge_inter];
+  GEN_TAC;
+  IMATCH_MP_TAC  closed_inter2;
+  REWRITE_TAC[top2_top;closed_half_plane2D_LTS_closed];
+  IMATCH_MP_TAC  closed_inter2;
+  REWRITE_TAC[top2_top;closed_half_plane2D_SLT_closed;line2D_F_closed;];
+  ]);;
+  (* }}} *)
+
+let vc_edge_convex = prove_by_refinement(
+  `!m. (convex (vc_edge m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[vc_edge_inter];
+  GEN_TAC;
+  IMATCH_MP_TAC convex_inter;
+  REWRITE_TAC[closed_half_plane2D_LTS_convex];
+  IMATCH_MP_TAC  convex_inter;
+  REWRITE_TAC[closed_half_plane2D_SLT_convex;line2D_F_convex;];
+  ]);;
+  (* }}} *)
+
+let v_edge_subset = prove_by_refinement(
+  `!m. (v_edge m SUBSET vc_edge m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[vc_edge;SUBSET;UNION;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let v_edge_euclid = prove_by_refinement(
+  `!m. (v_edge m) SUBSET (euclid 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;v_edge];
+  MESON_TAC[euclid_point];
+  ]);;
+  (* }}} *)
+
+let v_edge_closure = prove_by_refinement(
+  `!m. (closure top2 (v_edge m)) = vc_edge m`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  closure_subset;
+  REWRITE_TAC[v_edge_subset;top2_top;vc_edge_closed];
+  REWRITE_TAC[vc_edge];
+  REWRITE_TAC[union_subset;e2;pointI;single_subset;point_add];
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_closure;
+  REWRITE_TAC[top2_top];
+  REWRITE_TAC[top2];
+  SUBGOAL_TAC `!t u. t*u +. (&.1- t)*u = u` ;
+  REWRITE_TAC[GSYM REAL_RDISTRIB];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  CONJ_TAC THEN (IMATCH_MP_TAC  closure_segment) THEN REWRITE_TAC[v_edge_euclid];
+  TYPE_THEN `(pointI m)+point(&.0,&.1)` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[v_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[int_suc];
+  TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
+  UND 1;
+  UND 2;
+  REAL_ARITH_TAC ;
+  TYPE_THEN `pointI m` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[v_edge;pointI;point_add;point_scale;PAIR_SPLIT;point_inj;];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[int_suc];
+  TYPE_THEN `a = real_of_int(FST m)` ABBREV_TAC;
+  UND 1;
+  UND 2;
+  REAL_ARITH_TAC ;
+  ]);;
+
+  (* }}} *)
+
+let squ_euclid = prove_by_refinement(
+  `!m. (squ m) SUBSET (euclid 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;squ];
+  MESON_TAC[euclid_point];
+  ]);;
+  (* }}} *)
+
+let cell_euclid = prove_by_refinement(
+  `!X. (cell X) ==> (X SUBSET euclid 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cell];
+  GEN_TAC;
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  REP_CASES_TAC THEN ASM_REWRITE_TAC[h_edge_euclid;squ_euclid;v_edge_euclid];
+  REWRITE_TAC[ISUBSET;INR IN_SING;pointI;euclid_point];
+  ASM_MESON_TAC[euclid_point];
+  ]);;
+  (* }}} *)
+
+let edge = jordan_def `edge C <=> ?m. ((C = v_edge m) \/ (C = h_edge m))`;;
+
+let edge_v = prove_by_refinement(
+  `!m. edge (v_edge m)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[edge];
+  ]);;
+  (* }}} *)
+
+let edge_h = prove_by_refinement(
+  `!m. edge (h_edge m)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[edge];
+  ]);;
+  (* }}} *)
+
+let num_closure = jordan_def `num_closure G x =
+      CARD { C | (G C) /\ (closure top2 C x) }`;;
+
+let num_lower = jordan_def `num_lower G n =
+   CARD { m | (G (h_edge m)) /\ (FST m = FST n) /\ (SND m <=: SND n) }`;;
+
+let set_lower = jordan_def `set_lower G n =
+    { m | (G (h_edge m)) /\ (FST m = FST n) /\ (SND m <=: SND n) }`;;
+
+let num_lower_set = prove_by_refinement(
+  `!G n. num_lower G n = CARD (set_lower G n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[num_lower;set_lower];
+  ]);;
+  (* }}} *)
+
+let even_cell = jordan_def `even_cell G C <=>
+   (?m. (C = {(pointI m)}) /\ (EVEN (num_lower G m))) \/
+   (?m. (C = h_edge m) /\ (EVEN (num_lower G m))) \/
+   (?m. (C = v_edge m) /\ (EVEN (num_lower G m))) \/
+   (?m. (C = squ m) /\ (EVEN (num_lower G m)))`;;
+
+(* set *)
+let eq_sing = prove_by_refinement(
+(*** Parens added by JRH; parser no longer hacks "=" specially
+     so it is really right associative
+  `!X (y:A). X = {y} = ((X y) /\ (!u. (X u) ==> (u=y)))`,
+ ***)
+  `!X (y:A). (X = {y}) <=> ((X y) /\ (!u. (X u) ==> (u=y)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INSERT ;];
+  DISCH_ALL_TAC;
+  EQ_TAC ;
+  DISCH_THEN_REWRITE;
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let h_edge_pointIv2 = prove_by_refinement(
+  `!p q. ~(h_edge p = {(pointI q)})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[eq_sing;h_edge_pointI];
+  ]);;
+  (* }}} *)
+
+let v_edge_pointIv2 = prove_by_refinement(
+  `!p q. ~(v_edge p = {(pointI q)})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[eq_sing;v_edge_pointI];
+  ]);;
+  (* }}} *)
+
+let square_pointIv2 = prove_by_refinement(
+  `!p q. ~(squ p = {(pointI q)})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[eq_sing;square_pointI];
+  ]);;
+  (* }}} *)
+
+let cell_nonempty = prove_by_refinement(
+  `!z. (cell z) ==> ~(z = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cell_mem];
+  GEN_TAC;
+  REP_CASES_TAC ;
+  CHO 1;
+  USE 1(  REWRITE_RULE [eq_sing]);
+  ASM_MESON_TAC[EMPTY];
+  CHO 1;
+  ASM_MESON_TAC[h_edge_disj;INTER_EMPTY];
+  CHO 1;
+  ASM_MESON_TAC[v_edge_disj;INTER_EMPTY];
+  CHO 1;
+  ASM_MESON_TAC[square_disj;INTER_EMPTY];
+  ]);;
+  (* }}} *)
+
+let hv_edgeV2 = prove_by_refinement(
+  `!p q. ~(h_edge p = v_edge q)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[cell_rules;cell_nonempty;hv_edge;INTER_IDEMPOT];
+  ]);;
+  (* }}} *)
+
+let square_v_edgeV2 = prove_by_refinement(
+  `!p q. ~(squ p = v_edge q)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[cell_rules;cell_nonempty;square_v_edge;INTER_IDEMPOT];
+  ]);;
+  (* }}} *)
+
+let square_h_edgeV2 = prove_by_refinement(
+  `!p q. ~(squ p = h_edge q)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[cell_rules;cell_nonempty;square_h_edge;INTER_IDEMPOT];
+  ]);;
+  (* }}} *)
+
+let h_edge_inj = prove_by_refinement(
+  `!p q . (h_edge p = h_edge q) <=> (p = q)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[cell_rules;cell_nonempty;h_edge_disj;INTER_IDEMPOT];
+  ]);;
+  (* }}} *)
+
+let v_edge_inj = prove_by_refinement(
+  `!p q . (v_edge p = v_edge q) <=> (p = q)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[cell_rules;cell_nonempty;v_edge_disj;INTER_IDEMPOT];
+  ]);;
+  (* }}} *)
+
+let squ_inj = prove_by_refinement(
+  `!p q . (squ p = squ q) <=> (p = q)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[cell_rules;cell_nonempty;square_disj;INTER_IDEMPOT];
+  ]);;
+  (* }}} *)
+
+let finite_set_lower = prove_by_refinement(
+  `!G n. (FINITE G) ==> (FINITE (set_lower G n))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `INJ h_edge (set_lower G n) G` SUBGOAL_TAC;
+  REWRITE_TAC[INJ;set_lower;h_edge_inj];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  JOIN  0 1;
+  USE 0 (MATCH_MP FINITE_INJ);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let even_cell_point = prove_by_refinement(
+  `!G m. even_cell G {(pointI m)} <=> EVEN(num_lower G m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[even_cell;square_pointIv2;v_edge_pointIv2;h_edge_pointIv2];
+  REWRITE_TAC[pointI_inj;INSERT;eq_sing];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let even_cell_h_edge = prove_by_refinement(
+  `!G m. even_cell G (h_edge m) <=> EVEN(num_lower G m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[even_cell;h_edge_pointIv2];
+  REWRITE_TAC[pointI_inj;INSERT;h_edge_inj;GSYM square_h_edgeV2;hv_edgeV2;eq_sing];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let even_cell_v_edge = prove_by_refinement(
+  `!G m. even_cell G (v_edge m) <=> EVEN(num_lower G m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[even_cell;v_edge_pointIv2];
+  REWRITE_TAC[pointI_inj;INSERT;v_edge_inj;GSYM square_v_edgeV2;hv_edgeV2;eq_sing];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let even_cell_squ = prove_by_refinement(
+  `!G m. even_cell G (squ m) <=> EVEN(num_lower G m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[even_cell;v_edge_pointIv2];
+  REWRITE_TAC[pointI_inj;INSERT;squ_inj;GSYM square_v_edgeV2;GSYM square_h_edgeV2;square_pointI;eq_sing];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let h_edge_squ_parity = prove_by_refinement(
+  `!G m. even_cell G (h_edge m) <=> even_cell G (squ m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[even_cell_squ;even_cell_h_edge;num_lower];
+  ]);;
+  (* }}} *)
+
+let up = jordan_def `up (m:int#int) = (FST m,SND m +: (&:1))`;;
+let down = jordan_def `down (m:int#int) = (FST m,SND m -: (&:1))`;;
+let left = jordan_def `left (m:int#int) = (FST m -: (&:1),SND m)`;;
+let right = jordan_def `right (m:int#int) = (FST m +: (&:1),SND m)`;;
+
+let set_lower_delete = prove_by_refinement(
+  `!G n. set_lower G (down n) = (set_lower G n) DELETE n`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[set_lower;down;DELETE ];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[PAIR_SPLIT;INT_LE_SUB_LADD;GSYM INT_LT_DISCRETE;];
+  REWRITE_TAC[int_le;int_lt;];
+  REWRITE_TAC[ (ARITH_RULE `! x y. (x <. y) <=> ((x <= y) /\ ~(x = y))`)];
+  REWRITE_TAC[GSYM int_eq];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let set_lower_n = prove_by_refinement(
+  `!G n. set_lower G n n = (G (h_edge n))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[set_lower;int_le ; REAL_LE_REFL];
+  ]);;
+  (* }}} *)
+
+(* set *)
+let CARD_SUC_DELETE = prove_by_refinement(
+  `!(x:A) s. FINITE s /\ s x ==>
+    ((SUC (CARD (s DELETE x))) = CARD s)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `s = (x INSERT (s DELETE x))` SUBGOAL_TAC;
+  ASM_MESON_TAC[INR INSERT_DELETE];
+  USE 0 (ONCE_REWRITE_RULE[GSYM FINITE_DELETE]);
+  TYPE_THEN `b = s DELETE x`  ABBREV_TAC ;
+  DISCH_THEN_REWRITE;
+  ASM_SIMP_TAC [INR CARD_CLAUSES];
+  COND_CASES_TAC;
+  ASM_MESON_TAC[INR IN_DELETE];
+  REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let even_delete = prove_by_refinement(
+  `!(x:A) s. FINITE s ==>
+     ((EVEN (CARD (s DELETE x)) <=> EVEN (CARD s)) <=> ~(s x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `s x`  ASM_CASES_TAC ;
+  ASM_MESON_TAC[CARD_SUC_DELETE;EVEN ];
+  ASM_SIMP_TAC[CARD_DELETE];
+  ]);;
+  (* }}} *)
+
+let num_lower_down = prove_by_refinement(
+  `!G m. (FINITE G) ==>
+       ((EVEN (num_lower G (down m)) <=> EVEN (num_lower G m)) <=>
+           ~(set_lower G m m))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[num_lower_set;set_lower_delete];
+  IMATCH_MP_TAC  even_delete;
+  REWRITE_TAC[even_cell_squ;even_cell_h_edge;num_lower;down];
+  ASM_MESON_TAC[finite_set_lower];
+  ]);;
+  (* }}} *)
+
+let squ_down = prove_by_refinement(
+  `!G m. (FINITE G) ==>
+        ((even_cell G (squ (down m)) <=> even_cell G (squ m)) <=>
+             ~(set_lower G m m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[even_cell_squ;num_lower_down];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(*  edge combinatorics *)
+(* ------------------------------------------------------------------ *)
+
+let pair_size_2 = prove_by_refinement(
+  `!(a:A) b. ~(a= b) ==> ({a, b} HAS_SIZE 2)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  ASM_SIMP_TAC[FINITE_SING;CARD_CLAUSES;INR IN_SING ];
+  CONJ_TAC;
+  REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
+  REWRITE_TAC[ARITH_RULE `2 = SUC 1`;SUC_INJ;];
+  MESON_TAC[SING;CARD_SING];
+  ]);;
+  (* }}} *)
+
+let has_size2 = prove_by_refinement(
+  `!u. (u HAS_SIZE 2) <=> (?(a:A) b. (u = {a , b}) /\ ~(a=b))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  DISCH_ALL_TAC;
+  TYPE_THEN `~(u = EMPTY)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  REWR 2;
+  REWR 1;
+  USE 1 (REWRITE_RULE[CARD_CLAUSES]);
+  UND 1;
+  ARITH_TAC;
+  DISCH_TAC;
+  COPY 0;
+  COPY 2;
+  JOIN 0 2;
+  USE 0 (MATCH_MP CARD_DELETE_CHOICE);
+  TYPE_THEN `CARD (u DELETE CHOICE u) = 1` SUBGOAL_TAC;
+  ONCE_REWRITE_TAC [GSYM SUC_INJ];
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `u DELETE CHOICE u HAS_SIZE 1` SUBGOAL_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  ASM_REWRITE_TAC[FINITE_DELETE];
+  DISCH_TAC;
+  USE 5 (MATCH_MP CARD_SING_CONV);
+  USE 5 (REWRITE_RULE [SING]);
+  CHO 5;
+  TYPE_THEN `CHOICE u` EXISTS_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  USE 5 (SYM);
+  ASM_REWRITE_TAC[];
+  USE 4 (MATCH_MP CHOICE_DEF);
+  ASM_SIMP_TAC[INSERT_DELETE];
+  TYPE_THEN `(u DELETE (CHOICE u)) x` SUBGOAL_TAC;
+  USE 5 (SYM);
+  ASM_REWRITE_TAC[INR IN_SING ];
+  DISCH_TAC;
+  TYPE_THEN `~((u DELETE CHOICE u) (CHOICE u))` SUBGOAL_TAC;
+  REWRITE_TAC[INR IN_DELETE];
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[pair_size_2];
+  ]);;
+  (* }}} *)
+
+let in_pair = prove_by_refinement(
+  `!(a:A) b t. {a , b} t <=> (t = b) \/ (t = a)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INSERT];
+  ]);;
+  (* }}} *)
+
+let pair_swap_select =
+   jordan_def `pair_swap u (x:A) = @y. ~(x = y) /\ (u y)`;;
+
+let pair_swap_pair = prove_by_refinement(
+  `!(a:A) b. ~(a = b) ==>
+       (pair_swap {a,b} a = b) /\ (pair_swap {a,b} b = a)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[pair_swap_select];
+  REWRITE_TAC[in_pair];
+  CONJ_TAC THEN SELECT_TAC THEN (ASM_MESON_TAC[]);
+  ]);;
+  (* }}} *)
+
+let pair_swap = prove_by_refinement(
+  `!u (x:A). (u HAS_SIZE 2)/\ (u x) ==>
+         (~(pair_swap u x = x)) /\ (u (pair_swap u x))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[has_size2];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[];
+  REWR 1;
+  USE 1 (REWRITE_RULE[in_pair]);
+  CONJ_TAC;
+  ASM_MESON_TAC[pair_swap_pair];
+  UND 1;
+  DISCH_THEN (DISJ_CASES_TAC) THEN ASM_SIMP_TAC [pair_swap_pair] THEN REWRITE_TAC[INSERT];
+  ]);;
+  (* }}} *)
+
+let pair_swap_invol = prove_by_refinement(
+  `!u (x:A). (u HAS_SIZE 2) /\ (u x) ==>
+       (pair_swap u (pair_swap u x) = x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[has_size2];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[];
+  REWR 1;
+  USE 1 (REWRITE_RULE[in_pair]);
+  UND 1;
+  DISCH_THEN (DISJ_CASES_TAC);
+  ASM_SIMP_TAC [pair_swap_pair];
+  ASM_SIMP_TAC [pair_swap_pair];
+  ]);;
+  (* }}} *)
+
+
+
+(* ------------------------------------------------------------------ *)
+(* SECTION C *)
+(* ------------------------------------------------------------------ *)
+
+(* ------------------------------------------------------------------ *)
+(* rectagons *)
+(* ------------------------------------------------------------------ *)
+
+let rectagon = jordan_def `rectagon G <=>
+  (FINITE G) /\ ~(G = EMPTY ) /\ (G SUBSET edge) /\
+      (!m . ({0,2} (num_closure G (pointI m)))) /\
+      (!S. ((S SUBSET G) /\ ~(S = EMPTY) /\
+        (!C C'. (S C) /\ (G C') /\ (adj C C') ==> (S C'))) ==>
+        (S = G))`;;
+
+let segment = jordan_def `segment G <=>
+  (FINITE G) /\ ~(G = EMPTY ) /\ (G SUBSET edge) /\
+      (!m . ({0,1,2} (num_closure G (pointI m)))) /\
+      (!S. ((S SUBSET G) /\ ~(S = EMPTY) /\
+        (!C C'. (S C) /\ (G C') /\ (adj C C') ==> (S C'))) ==>
+        (S = G))`;;
+
+let psegment = jordan_def `psegment G <=>
+   segment G /\ ~(rectagon G)`;;
+
+let rectagon_segment = prove_by_refinement(
+  `!G. (rectagon G ) ==> (segment G)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[segment;rectagon;INSERT ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let endpoint = jordan_def `endpoint G m <=>
+  (num_closure G (pointI m) = 1)`;;
+
+let midpoint = jordan_def `midpoint G m <=>
+  (num_closure G (pointI m) = 2)`;;
+
+let psegment_endpoint = prove_by_refinement(
+  `!G. (psegment G) ==> (?m. (endpoint G m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[psegment;rectagon;segment;endpoint];
+  DISCH_ALL_TAC;
+  UND 5;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  LEFT 5 "m";
+  CHO 5;
+  TSPEC `m` 3;
+  USE 3 (REWRITE_RULE[INSERT]);
+  USE 5 (REWRITE_RULE[INSERT]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let rectagon_endpoint = prove_by_refinement(
+  `!G. (rectagon G) ==> ~(?m. (endpoint G m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[rectagon;endpoint;INSERT ];
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASM_MESON_TAC[ARITH_RULE `(~(1=2)) /\ ~(1=0)` ];
+  ]);;
+  (* }}} *)
+
+let num_closure_mono = prove_by_refinement(
+  `!G G' x. (FINITE G') /\ (G SUBSET G') ==>
+       (num_closure G x <= num_closure G' x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[num_closure];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC CARD_SUBSET ;
+  REWRITE_TAC[ISUBSET];
+  CONJ_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `G'` EXISTS_TAC;
+  ASM_REWRITE_TAC[ISUBSET];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let endpoint_psegment = prove_by_refinement(
+  `!G. (?m. (endpoint G m)) /\ (segment G) ==> (psegment G)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC  [psegment;rectagon_endpoint];
+  ]);;
+  (* }}} *)
+
+let num_closure_size = prove_by_refinement(
+  `!G x. FINITE G ==>
+     ({C | G C /\ closure top2 C x} HAS_SIZE (num_closure G x) )`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[HAS_SIZE;num_closure];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `G` EXISTS_TAC;
+  REWRITE_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let endpoint_edge = prove_by_refinement(
+  `!G m.  (FINITE G) /\ (endpoint G m) ==> (?! e. (G e) /\
+     (closure top2 e (pointI m)))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[endpoint;];
+  DISCH_ALL_TAC;
+  TYPE_THEN `{C | G C /\ closure top2 C (pointI m)} HAS_SIZE 1` SUBGOAL_TAC;
+  UND 1;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  IMATCH_MP_TAC  num_closure_size;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  USE 2 (MATCH_MP CARD_SING_CONV);
+  USE 2 (REWRITE_RULE[SING]);
+  CHO 2;
+  USE 2 (REWRITE_RULE[eq_sing]);
+  REWRITE_TAC[EXISTS_UNIQUE_ALT];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let midpoint_edge = prove_by_refinement(
+  `!G m. (FINITE G) /\ (midpoint G m) ==>
+     {C | G C /\ closure top2 C (pointI m)} HAS_SIZE 2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[midpoint;];
+  DISCH_ALL_TAC;
+  UND 1;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  IMATCH_MP_TAC  num_closure_size;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let two_endpoint = prove_by_refinement(
+  `!e. (edge e) ==> ({ m | (closure top2 e (pointI m)) } HAS_SIZE 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge];
+  DISCH_ALL_TAC;
+  CHO 0;
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[v_edge_closure;h_edge_closure];
+  REWRITE_TAC[vc_edge;UNION;has_size2];
+  TYPE_THEN `m` EXISTS_TAC;
+  TYPE_THEN `(FST m,SND m +: (&:1))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INR IN_SING ;];
+  TYPE_THEN `euclid_plus (pointI m) e2 = pointI (FST m,SND m +: (&:1))` SUBGOAL_TAC ;
+  REWRITE_TAC[pointI;e2;point_add;int_suc ];
+  REDUCE_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[v_edge_pointI;pointI_inj;];
+  REWRITE_TAC[INSERT];
+  MESON_TAC[];
+  REWRITE_TAC[PAIR_SPLIT];
+  INT_ARITH_TAC;
+  (* 2nd case: *)
+  ASM_REWRITE_TAC[v_edge_closure;h_edge_closure];
+  REWRITE_TAC[hc_edge;UNION;has_size2];
+  TYPE_THEN `m` EXISTS_TAC;
+  TYPE_THEN `(FST m +: (&:1),SND m )` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INR IN_SING ;];
+  TYPE_THEN `euclid_plus (pointI m) e1 = pointI (FST m +: (&:1),SND m )` SUBGOAL_TAC ;
+  REWRITE_TAC[pointI;e1;point_add;int_suc ];
+  REDUCE_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[h_edge_pointI;pointI_inj;];
+  REWRITE_TAC[INSERT];
+  MESON_TAC[];
+  REWRITE_TAC[PAIR_SPLIT];
+  INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let edge_midend = prove_by_refinement(
+  `!G e m. (segment G) /\ (G e) /\ (closure top2 e (pointI m)) ==>
+      (midpoint G m) \/ (endpoint G m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[segment;midpoint;endpoint];
+  DISCH_ALL_TAC;
+  TSPEC `m` 3;
+  USE 3 (REWRITE_RULE[INSERT]);
+  TYPE_THEN `~(num_closure G (pointI m) = 0)` SUBGOAL_TAC;
+  USE 0 (MATCH_MP num_closure_size);
+  TSPEC `pointI m` 0;
+  PROOF_BY_CONTR_TAC;
+  REWR 7;
+  REWR 0;
+  USE 0(REWRITE_RULE[HAS_SIZE_0]);
+  UND 0;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 3;
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let plus_e12 = prove_by_refinement(
+  `!m. ((pointI m) + e2 = pointI (FST m,SND m +: (&:1))) /\
+      ((pointI m) + e1 = pointI (FST m +: (&:1),SND m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[e1;e2];
+  REWRITE_TAC[pointI;point_add;int_suc];
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let c_edge_euclid = prove_by_refinement(
+  `!e. (edge e) ==> (closure top2 e) SUBSET (euclid 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge];
+  GEN_TAC;
+  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC ) THEN ASM_REWRITE_TAC[hc_edge;vc_edge;h_edge_closure;v_edge_closure;union_subset;plus_e12] THEN MESON_TAC[cell_rules; cell_euclid];
+  ]);;
+  (* }}} *)
+
+(* slow proof... *)
+let inter_lattice = prove_by_refinement(
+  `!x e e'. (edge e) /\ (edge e') /\ (~(e=e')) /\
+    ((closure top2 e INTER closure top2 e') x) ==>
+       (?m. x = pointI m)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `euclid 2 x` SUBGOAL_TAC;
+  USE 3 (REWRITE_RULE[INTER]);
+  AND 3;
+  USE 0 (MATCH_MP c_edge_euclid);
+  USE 0 (REWRITE_RULE[ISUBSET]);
+  ASM_MESON_TAC[];
+  DISCH_THEN (MP_TAC o (MATCH_MP point_onto));
+  DISCH_TAC;
+  CHO 4;
+  ASM_REWRITE_TAC[];
+  ASSUME_TAC square_domain;
+  TSPEC `p` 5;
+  USE 5 (CONV_RULE (NAME_CONFLICT_CONV));
+  UND 5;
+  LET_TAC ;
+  REWRITE_TAC[UNION];
+  UND 3;
+  ASM_REWRITE_TAC[INTER];
+  KILL 4;
+  UND 2;
+  UND 0;
+  REWRITE_TAC[edge] ;
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  UND 1;
+  REWRITE_TAC[edge] ;
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  REP_CASES_TAC THEN UNDISCH_FIND_TAC `(~)` THEN UNDISCH_FIND_TAC `(closure)` THEN  UNDISCH_FIND_TAC `(point p)` THEN ASM_REWRITE_TAC[] THEN (REWRITE_TAC[INR IN_SING;h_edge_closure;v_edge_closure;UNION;vc_edge;hc_edge;plus_e12 ]) THEN
+  (* 1st,2nd,3rd, *)
+  (* tx *)
+  (let tx = REWRITE_RULE[EQ_EMPTY;INTER ] in  MESON_TAC[tx hv_edge;tx v_edge_disj;tx h_edge_disj;tx square_v_edge;tx square_h_edge;v_edge_inj;h_edge_inj]);
+  ]);;
+  (* }}} *)
+
+let edgec_convex = prove_by_refinement(
+  `!e. (edge e) ==> (convex (closure top2 e))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC ) THEN ASM_REWRITE_TAC[v_edge_closure;h_edge_closure;hc_edge_convex;vc_edge_convex];
+  ]);;
+  (* }}} *)
+
+let midpoint_h_edge = prove_by_refinement(
+  `!m. (h_edge m) (((&.1)/(&.2))*# (pointI m) +
+         ((&.1)/(&.2))*# (pointI m + e1))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[plus_e12];
+  REWRITE_TAC[h_edge;pointI;point_add;point_scale;point_inj;PAIR_SPLIT;int_suc];
+  GEN_TAC;
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  TYPE_THEN `a = real_of_int(SND m)` ABBREV_TAC;
+  TYPE_THEN `b = real_of_int(FST  m)` ABBREV_TAC;
+  CONJ_TAC;
+  real_poly_tac ;
+  CONJ_TAC;
+  ineq_lt_tac `b + (&.1/(&.2)) = &1 / &2 * b + &1 / &2 * (b + &1)`;
+  ineq_lt_tac `((&1 / &2) * b + &1 / &2 * (b + &1)) + (&1 / &2) = b +. &1`
+  ]);;
+  (* }}} *)
+
+let midpoint_v_edge = prove_by_refinement(
+  `!m. (v_edge m) (((&.1)/(&.2))*# (pointI m) +
+         ((&.1)/(&.2))*# (pointI m + e2))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[plus_e12];
+  REWRITE_TAC[v_edge;pointI;point_add;point_scale;point_inj;PAIR_SPLIT;int_suc];
+  GEN_TAC;
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  TYPE_THEN `a = real_of_int(SND m)` ABBREV_TAC;
+  TYPE_THEN `b = real_of_int(FST  m)` ABBREV_TAC;
+  CONJ_TAC;
+  real_poly_tac ;
+  CONJ_TAC;
+  ineq_lt_tac `a +. (&1/ &2)= &1 / &2 * a + &1 / &2 * (a + &1)`;
+  ineq_lt_tac `(&1 / &2 * a + &1 / &2 * (a + &1)) +(&1/ &2) =  a + &1`;
+  ]);;
+  (* }}} *)
+
+let midpoint_unique = prove_by_refinement(
+  `!x y e e'. (edge e) /\ (edge e') /\ (~(e = e')) /\
+    ((closure top2 e INTER closure top2 e') x) /\
+    ((closure top2 e INTER closure top2 e') y) ==>
+    ( x = y)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `convex (closure top2 e INTER closure top2 e')` SUBGOAL_TAC;
+  IMATCH_MP_TAC  convex_inter ;
+  ASM_MESON_TAC[edgec_convex];
+  TYPE_THEN `(?m. x = pointI m) /\ (?n. y = pointI n)` SUBGOAL_TAC;
+  ASM_MESON_TAC[inter_lattice];
+  DISCH_ALL_TAC;
+  CHO 6;
+  CHO 7;
+  ASM_REWRITE_TAC[];
+  REWR 3;
+  REWR 4;
+  KILL 6;
+  KILL 7;
+  TYPE_THEN `(closure top2 e (pointI n)) /\ closure top2 e (pointI m)` SUBGOAL_TAC;
+  UND 4;
+  UND 3;
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  DISCH_ALL_TAC;
+  WITH 0 (MATCH_MP edgec_convex);
+  UND 6;
+  USE 0 (REWRITE_RULE[edge]);
+  CHO 0;
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[];
+  (* ml -- start of 1st main branch. *)
+  DISCH_ALL_TAC;
+  TYPE_THEN `((n = m') \/ (n = (FST m',SND m' + &:1))) /\ ((m = m') \/ (m = (FST m',SND m' + &:1)))` SUBGOAL_TAC;
+  UND 6;
+  UND 7;
+  ASM_REWRITE_TAC[h_edge_closure;hc_edge;v_edge_closure;UNION;vc_edge;INR IN_SING;plus_e12;pointI_inj;v_edge_pointI ;h_edge_pointI];
+  MESON_TAC[];
+  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
+  TYPE_THEN  `X = (closure top2 e INTER closure top2 e')` ABBREV_TAC;
+  (* start A*)
+  TYPE_THEN `X (pointI m') /\ X (pointI m' + e2) ==> ~(X INTER (v_edge m') = EMPTY)` SUBGOAL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  USE 5 (REWRITE_RULE[convex;mk_segment]);
+  DISCH_TAC ;
+  H_MATCH_MP (HYP "5") (HYP "10");
+  USE 11 (REWRITE_RULE[ISUBSET]);
+  TYPE_THEN `b = (&1 / &2) *# (pointI m') + (&1 / &2) *# (pointI m' + e2)` ABBREV_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  TSPEC `b` 11;
+  CONJ_TAC;
+  UND 11;
+  DISCH_THEN IMATCH_MP_TAC  ;
+  TYPE_THEN `&1/ &2` EXISTS_TAC;
+  CONV_TAC REAL_RAT_REDUCE_CONV;
+  EXPAND_TAC "b";
+  MESON_TAC[];
+  EXPAND_TAC "b";
+  MATCH_ACCEPT_TAC midpoint_v_edge; (* end of goal A *)
+  REWRITE_TAC[plus_e12];
+  (* start  B*)
+  TYPE_THEN `X INTER (v_edge m') = EMPTY ` SUBGOAL_TAC;
+  REWRITE_TAC[EQ_EMPTY];
+  DISCH_ALL_TAC;
+  USE 10 (REWRITE_RULE[INTER]);
+  TYPE_THEN `?r. (x = pointI r)` SUBGOAL_TAC;
+  ASM_MESON_TAC[inter_lattice;edge];
+  DISCH_TAC;
+  CHO 11;
+  REWR 10;
+  ASM_MESON_TAC[v_edge_pointI];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  REP_CASES_TAC THEN ASM_MESON_TAC[];
+  (* end of FIRST main branch  -- snd main branch -- fully parallel *)
+  DISCH_ALL_TAC;
+  TYPE_THEN `((n = m') \/ (n = (FST m' + &:1,SND m'))) /\ ((m = m') \/ (m = (FST m' + &:1,SND m' )))` SUBGOAL_TAC;
+  UND 6;
+  UND 7;
+  ASM_REWRITE_TAC[h_edge_closure;hc_edge;v_edge_closure;UNION;vc_edge;INR IN_SING;plus_e12;pointI_inj;v_edge_pointI ;h_edge_pointI];
+  MESON_TAC[];
+  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
+  TYPE_THEN  `X = (closure top2 e INTER closure top2 e')` ABBREV_TAC;
+  (* start A'  *)
+  TYPE_THEN `X (pointI m') /\ X (pointI m' + e1) ==> ~(X INTER (h_edge m') = EMPTY)` SUBGOAL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  USE 5 (REWRITE_RULE[convex;mk_segment]);
+  DISCH_TAC ;
+  H_MATCH_MP (HYP "5") (HYP "10");
+  USE 11 (REWRITE_RULE[ISUBSET]);
+  TYPE_THEN `b = (&1 / &2) *# (pointI m') + (&1 / &2) *# (pointI m' + e1)` ABBREV_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  TSPEC `b` 11;
+  CONJ_TAC;
+  UND 11;
+  DISCH_THEN IMATCH_MP_TAC  ;
+  TYPE_THEN `&1/ &2` EXISTS_TAC;
+  CONV_TAC REAL_RAT_REDUCE_CONV;
+  EXPAND_TAC "b";
+  MESON_TAC[];
+  EXPAND_TAC "b";
+  MATCH_ACCEPT_TAC midpoint_h_edge; (* end of goal A' *)
+  REWRITE_TAC[plus_e12];
+  (* start  B' *)
+  TYPE_THEN `X INTER (h_edge m') = EMPTY ` SUBGOAL_TAC;
+  REWRITE_TAC[EQ_EMPTY];
+  DISCH_ALL_TAC;
+  USE 10 (REWRITE_RULE[INTER]);
+  TYPE_THEN `?r. (x = pointI r)` SUBGOAL_TAC;
+  ASM_MESON_TAC[inter_lattice;edge];
+  DISCH_TAC;
+  CHO 11;
+  REWR 10;
+  ASM_MESON_TAC[h_edge_pointI];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  REP_CASES_TAC  THEN ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let edge_inter = prove_by_refinement(
+  `!C C'. (edge C) /\ (edge C') /\ (adj C C')  ==>
+      (?m. (closure top2 C) INTER (closure top2 C') = {(pointI m)}) `,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[adj];
+  DISCH_ALL_TAC;
+  USE 3 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 3;
+  TYPE_THEN `(?m. u = pointI m)` SUBGOAL_TAC;
+  ASM_MESON_TAC[inter_lattice];
+  DISCH_THEN (CHOOSE_TAC);
+  REWR 3;
+  TYPE_THEN `m` EXISTS_TAC;
+  ASM_REWRITE_TAC [eq_sing];
+  ASM_MESON_TAC[midpoint_unique];
+  ]);;
+
+  (* }}} *)
+
+let inter_midpoint = prove_by_refinement(
+  `!G C C' m. (segment G) /\ (G C) /\ (G C') /\ (adj C C') /\
+      (((closure top2 C) INTER (closure top2 C')) (pointI m)) ==>
+    (midpoint G m) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[midpoint;segment];
+  DISCH_ALL_TAC;
+  TSPEC `m` 3;
+  USE 3 (REWRITE_RULE[INSERT]);
+  UND 3;
+  USE 0 (MATCH_MP num_closure_size);
+  TSPEC `pointI m` 0;
+  TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC ;
+  TYPE_THEN `X C /\ X C'` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  UND 8;
+  REWRITE_TAC[INTER]; (* done WITH subgoal *)
+  DISCH_TAC;
+  TYPE_THEN `~(C = C')` SUBGOAL_TAC;
+  ASM_MESON_TAC[adj];
+  DISCH_TAC;
+  REP_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  REWR 0;
+  USE 0 (MATCH_MP CARD_SING_CONV);
+  USE 0 (REWRITE_RULE[SING;eq_sing]);
+  ASM_MESON_TAC[];
+  REWR 0;
+  USE 0 (REWRITE_RULE[HAS_SIZE_0;EQ_EMPTY]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let mid_end_disj = prove_by_refinement(
+  `!G m. ~(endpoint G m /\ midpoint G m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[endpoint;midpoint];
+  ASM_MESON_TAC[ARITH_RULE `~(1=2)`];
+  ]);;
+  (* }}} *)
+
+let two_exclusion  = prove_by_refinement(
+  `!X p q (r:A). (X HAS_SIZE 2) /\ (X p) /\ (X q) /\ (X r) /\ (~(p = r))
+    /\ (~(q = r)) ==> (p = q)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[has_size2;];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  UND 1;
+  UND 2;
+  UND 3;
+  ASM_REWRITE_TAC[INSERT];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let midpoint_exists = prove_by_refinement(
+  `!G e. (segment G) /\ (G e) /\ (~(G = {e})) ==>
+      (?m. (closure top2 e (pointI m)) /\ (midpoint G m))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `!m. (closure top2 e (pointI m)) ==> (endpoint G m)` SUBGOAL_TAC;
+  ASM_MESON_TAC[edge_midend];
+  DISCH_TAC;
+  UND 2;
+  REWRITE_TAC[];
+  UND 0;
+  REWRITE_TAC[segment];
+  DISCH_ALL_TAC;
+  TSPEC `{e}` 7;
+  UND 7;
+  DISCH_THEN (IMATCH_MP_TAC  o GSYM);
+  ASM_REWRITE_TAC[ISUBSET;INR IN_SING;];
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC [eq_sing];
+  DISCH_ALL_TAC;
+  TYPE_THEN `(?m. (closure top2 e) INTER (closure top2 C') = {(pointI m)})` SUBGOAL_TAC;
+  IMATCH_MP_TAC  edge_inter;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_THEN CHOOSE_TAC;
+  TSPEC `m` 4;
+  TYPE_THEN `endpoint G m` SUBGOAL_TAC;
+  UND 4;
+  DISCH_THEN IMATCH_MP_TAC ;
+  UND 10;
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  REWRITE_TAC[endpoint];
+  USE 0 (MATCH_MP num_closure_size);
+  TSPEC `(pointI m)` 0;
+  DISCH_TAC;
+  REWR 0;
+  USE 0 (MATCH_MP CARD_SING_CONV);
+  USE 0 (REWRITE_RULE[SING]);
+  CHO 0;
+  USE 0 (REWRITE_RULE[eq_sing]);
+  USE 10 (REWRITE_RULE[eq_sing]);
+  USE 10 (REWRITE_RULE[INTER]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let pair_swap_unique = prove_by_refinement(
+  `!u x (y:A). (u HAS_SIZE 2) /\ (u x) /\ (u y) /\ ~(x = y) ==>
+    (y = pair_swap u x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  two_exclusion ;
+  TYPE_THEN `u` EXISTS_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[pair_swap];
+  ]);;
+  (* }}} *)
+
+let pair_swap_adj = prove_by_refinement(
+  `!G e m e'. (segment G) /\ (G e) /\ (midpoint G m) /\
+     (closure top2 e (pointI m)) /\
+     (e' = pair_swap {C | G C /\ closure top2 C (pointI m)} e) ==>
+     ({C | G C /\ closure top2 C (pointI m)} HAS_SIZE 2) /\
+             G e' /\ adj e' e /\ (closure top2 e' (pointI m)) `,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC;
+  USE 3 (REWRITE_RULE[midpoint]);
+  USE 1 (REWRITE_RULE[segment]);
+  UND 1;
+  DISCH_ALL_TAC;
+  USE 1 (MATCH_MP num_closure_size);
+  TSPEC `pointI m` 1;
+  REWR 1;
+  DISCH_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `X e` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (*  SUBCONJ_TAC; *)
+  TYPE_THEN `X e'` SUBGOAL_TAC;
+  ASM_MESON_TAC[pair_swap];
+  DISCH_TAC;
+  SUBCONJ_TAC;
+  UND 8;
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  MESON_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  SUBCONJ_TAC;
+  UND 8;
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  MESON_TAC[];
+  ASM_REWRITE_TAC[adj];
+  ASM_SIMP_TAC[pair_swap];
+  REWRITE_TAC[EMPTY_EXISTS];
+  ASM_REWRITE_TAC[INTER];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+(*
+   A terminal edge is expressed as
+   (endpoint G m) /\ (closure top2 e (pointI m))
+*)
+
+let terminal_edge_adj = prove_by_refinement(
+  `!G e m. (segment G) /\ (G e) /\ (~(G = {e})) /\
+     (endpoint G m) /\ (closure top2 e (pointI m))
+     ==>
+       (?! e'. (G e') /\ (adj e e')) `,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[EXISTS_UNIQUE_ALT ];
+  TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  midpoint_exists;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  AND 5;
+  COPY 5;
+  USE 5 (REWRITE_RULE[midpoint]);
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC;
+  USE 8 (MATCH_MP num_closure_size);
+  TSPEC `pointI m'` 8;
+  REWR 8;
+  TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m')}` ABBREV_TAC;
+  TYPE_THEN `X e` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `pair_swap X e` EXISTS_TAC;
+  GEN_TAC;
+
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `(?m. (closure top2 e) INTER (closure top2 y) = {(pointI m)}) ` SUBGOAL_TAC;
+  IMATCH_MP_TAC  edge_inter;
+  ASM_MESON_TAC[segment;ISUBSET;];
+  DISCH_THEN CHOOSE_TAC;
+  (* show m''=m', then X y, then y != e, then it is the PAIR swap *)
+  TYPE_THEN `ec = (closure top2 e)` ABBREV_TAC;
+  TYPE_THEN `ec (pointI m'')` SUBGOAL_TAC;
+  UND 13;
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[INTER];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `m'' = m'` SUBGOAL_TAC;
+  TYPE_THEN `Z = {m | ec (pointI m)}` ABBREV_TAC;
+  IMATCH_MP_TAC  two_exclusion;
+  TYPE_THEN `Z` EXISTS_TAC;
+  TYPE_THEN `m` EXISTS_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "Z";
+  EXPAND_TAC "ec";
+  IMATCH_MP_TAC  two_endpoint;
+  ASM_MESON_TAC[segment;ISUBSET];
+  EXPAND_TAC "Z";
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `midpoint G m''` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  inter_midpoint;
+  TYPE_THEN `e` EXISTS_TAC;
+  TYPE_THEN `y` EXISTS_TAC;
+  ASM_REWRITE_TAC[INR IN_SING ];
+  ASM_MESON_TAC[mid_end_disj]; (* m'' = m' done *)
+  DISCH_TAC;
+  TYPE_THEN `X y` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  USE 13 (REWRITE_RULE[INTER;eq_sing]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~(y = e)` SUBGOAL_TAC;
+  UND 12;
+  MESON_TAC[adj];
+  DISCH_TAC;
+  IMATCH_MP_TAC  (GSYM pair_swap_unique);
+  ASM_REWRITE_TAC[];
+  (* now second direction nsd *)
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  ASSUME_TAC pair_swap_adj;
+  TYPEL_THEN [`G`;`e`;`m'`;`pair_swap X e`] (USE 11 o ISPECL);
+  UND 11;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `X (pair_swap X e)` SUBGOAL_TAC;
+  ASM_MESON_TAC[pair_swap];
+  DISCH_TAC;
+  TYPE_THEN `closure top2 (pair_swap X e) (pointI m')` SUBGOAL_TAC;
+  UND 11;
+  TYPE_THEN  `e'' = pair_swap X e` ABBREV_TAC ;
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  MESON_TAC[];
+  ASM_MESON_TAC[adj_symm];
+  ]);;
+  (* }}} *)
+
+let psegment_edge = prove_by_refinement(
+  `!e. (edge e) ==> (psegment {e})`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  endpoint_psegment;
+  ASM_REWRITE_TAC[endpoint;segment;EQ_EMPTY ;INR IN_SING;FINITE_SING;ISUBSET;num_closure];
+  CONJ_TAC;
+  UND 0;
+  REWRITE_TAC[edge];
+  DISCH_TAC ;
+  CHO 0;
+  TYPE_THEN `m` EXISTS_TAC;
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  CARD_SING;
+  REWRITE_TAC[SING];
+  TYPE_THEN `v_edge m` EXISTS_TAC;
+  REWRITE_TAC[eq_sing;h_edge_closure;v_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING ];
+  MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  CARD_SING;
+  REWRITE_TAC[SING];
+  TYPE_THEN `h_edge m` EXISTS_TAC;
+  REWRITE_TAC[eq_sing;h_edge_closure;v_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING ];
+  MESON_TAC[];
+  CONJ_TAC;
+  MESON_TAC[];
+  CONJ_TAC ;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[INSERT];
+  GEN_TAC;
+  TYPE_THEN `closure top2 e (pointI m)`  ASM_CASES_TAC ;
+  DISJ1_TAC THEN DISJ2_TAC ;
+  IMATCH_MP_TAC  CARD_SING;
+  REWRITE_TAC[SING ;eq_sing];
+  ASM_MESON_TAC[];
+  DISJ2_TAC ;
+  TYPE_THEN `{C | (C = e) /\ closure top2 C (pointI m)} = {}` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 2 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 2;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[CARD_CLAUSES];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[eq_sing];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let segment_delete = prove_by_refinement(
+  `!G e m. (segment G) /\ (endpoint G m) /\
+        (closure top2 e (pointI m)) /\ (~(G = {e}))
+                ==> (segment (G DELETE e))`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  TYPE_THEN `~G e` ASM_CASES_TAC;
+  USE 0 (REWRITE_RULE[INR DELETE_NON_ELEMENT]);
+  ASM_MESON_TAC[];
+  REWRITE_TAC[segment];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[FINITE_DELETE;delete_empty];
+  CONJ_TAC;
+  UND 3;
+  MESON_TAC[ISUBSET ;INR IN_DELETE];
+  CONJ_TAC;
+  GEN_TAC;
+  REWRITE_TAC[INSERT];
+  TYPE_THEN `num_closure (G DELETE e) (pointI m')  <=| (num_closure G (pointI m'))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  num_closure_mono;
+  ASM_REWRITE_TAC[INR IN_DELETE;ISUBSET];
+  MESON_TAC[];
+  TSPEC `m'` 4;
+  USE 4 (REWRITE_RULE[INSERT]);
+  UND 4;
+  ARITH_TAC;
+  DISCH_ALL_TAC;
+  (* tsh1 *)
+  TYPE_THEN `(?! e'. (G e') /\ (adj e e'))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  terminal_edge_adj;
+  REWRITE_TAC[segment];
+  TYPE_THEN `m` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[EXISTS_UNIQUE_ALT];
+  DISCH_THEN CHOOSE_TAC;
+  (* tsh2 *)
+  TYPE_THEN `(e INSERT S = G) ==> (S = G DELETE e)` SUBGOAL_TAC;
+  UND 9;
+  IMATCH_MP_TAC  (TAUT `(a ==> b ==> C) ==> (b ==> a ==> C)`);
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[DELETE_INSERT];
+  REWRITE_TAC[DELETE;ISUBSET;];
+  DISCH_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  UND 9;
+  MESON_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  (* tsh3 *)
+  TYPE_THEN `S e'` ASM_CASES_TAC;
+  TSPEC `e INSERT S` 5;
+  UND 5;
+  DISCH_THEN IMATCH_MP_TAC ;
+  REWR 0;
+  ASM_REWRITE_TAC [INR INSERT_SUBSET;NOT_INSERT_EMPTY];
+  CONJ_TAC;
+  UND 9;
+  MESON_TAC[ISUBSET;INR IN_DELETE];
+  DISCH_ALL_TAC;
+  TSPEC `C` 11;
+  TSPEC `C'` 11;
+  REWR 11; (* ok to here *)
+  (* oth1 *)
+  TYPE_THEN `C' = e` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[INSERT];
+  ASM_REWRITE_TAC[INSERT]; (* *)
+  (* UND 12; *)
+  TYPE_THEN `C = e` ASM_CASES_TAC;
+  REWR 15;
+  TSPEC `C'` 12;
+  REWR 12;
+  ASM_MESON_TAC[];
+  (* start not not -- *)
+  UND 11;
+  DISCH_THEN IMATCH_MP_TAC ;
+  CONJ_TAC;
+  UND 5;
+  REWRITE_TAC[INSERT];
+  ASM_MESON_TAC[];
+  UND 14;
+  REWRITE_TAC[DELETE];
+  ASM_MESON_TAC[];
+  (* LAST case *)
+  TSPEC `S` 5;
+  TYPE_THEN `S = G` SUBGOAL_TAC;
+  UND 5;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  UND 9;
+  REWRITE_TAC[DELETE;ISUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  DISCH_ALL_TAC;
+  TYPEL_THEN [`C`;`C'`] (USE 11 o ISPECL);
+  UND 11;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[DELETE];
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  TSPEC `C` 12;
+  TYPE_THEN `G C /\ adj e C` SUBGOAL_TAC;
+  ASM_MESON_TAC[adj_symm;ISUBSET];
+  DISCH_TAC;
+  REWR 12;
+  ASM_MESON_TAC[];
+  TSPEC `e'` 12;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let other_end = jordan_def `other_end e m =
+  pair_swap {m | closure top2 e (pointI m)} m`;;
+
+let other_end_prop = prove_by_refinement(
+  `!e m. (edge e) /\ (closure top2 e (pointI m))==>
+   (closure top2 e (pointI (other_end e m))) /\
+      (~(other_end e m = m)) /\
+      (other_end e (other_end e m) = m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[other_end];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP two_endpoint);
+  TYPE_THEN `X = {m | closure top2 e (pointI m)}` ABBREV_TAC;
+  TYPE_THEN `X m` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC [];
+  DISCH_TAC;
+  ASM_SIMP_TAC[pair_swap_invol;pair_swap];
+  TYPE_THEN `X (pair_swap X m)` SUBGOAL_TAC ;
+  ASM_SIMP_TAC[pair_swap];
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let num_closure_delete = prove_by_refinement(
+  `!G e p. (FINITE G) ==> ((num_closure (G DELETE e) p) =
+    (if ((G e) /\ (closure top2 e p)) then ((num_closure G p) -| 1)
+       else (num_closure G p)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  COND_CASES_TAC;
+  REWRITE_TAC[num_closure];
+  TYPE_THEN `{C | (G DELETE e) C /\ closure top2 C p} = {C | G C /\ closure top2 C p} DELETE e` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[DELETE ];
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `FINITE {C | G C /\ closure top2 C p}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[ISUBSET;];
+  MESON_TAC[];
+  DISCH_TAC;
+  USE 2 (MATCH_MP CARD_DELETE);
+  TSPEC `e` 2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[num_closure;DELETE ];
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  GEN_TAC;
+  TYPE_THEN `x = e` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let psegment_delete_end = prove_by_refinement(
+  `!G m e. (psegment G) /\ (endpoint G m) /\ (G e) /\
+        (closure top2 e (pointI m)) /\ (~(G = {e})) ==>
+     (endpoint (G DELETE e) =
+       (((other_end e m) INSERT (endpoint G)) DELETE m))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[psegment;segment];
+  DISCH_TAC;
+  TYPE_THEN `edge e` SUBGOAL_TAC;
+  ASM_MESON_TAC[psegment;segment;ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `X = {m | closure top2 e (pointI m)}` ABBREV_TAC;
+  TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  IMATCH_MP_TAC  two_endpoint;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[endpoint;ISUBSET;INSERT;];
+  GEN_TAC;
+  ASM_SIMP_TAC[num_closure_delete];
+  REWRITE_TAC[DELETE];
+  TYPE_THEN `x = m` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  USE 1 (REWRITE_RULE[endpoint]);
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `x = other_end e m` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  COND_CASES_TAC;
+  DISCH_TAC;
+  TYPE_THEN `X x /\ X m /\ X (other_end e m) /\ (~(m= other_end e m))` SUBGOAL_TAC ;
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[other_end_prop];
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[two_exclusion];
+  MESON_TAC[];
+  (* snd half *)
+  REWRITE_TAC[SUBSET;endpoint;DELETE_INSERT];
+  ASM_SIMP_TAC[other_end_prop];
+  ASM_SIMP_TAC[num_closure_delete];
+  REWRITE_TAC[INSERT;DELETE ];
+  GEN_TAC;
+  TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC;
+  ASM_MESON_TAC[psegment;midpoint_exists];
+  DISCH_THEN CHOOSE_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  (* ---m *)
+  COND_CASES_TAC;
+  TYPE_THEN `X m /\ X m' /\ X x /\ (~(x = m)) /\ (~(m' = m)) /\ (~(x = m'))` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[mid_end_disj];
+  ASM_MESON_TAC[two_exclusion];
+  USE 10 (REWRITE_RULE[endpoint]);
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[other_end_prop];
+  TYPE_THEN `X m /\ X m' /\ X x /\ (~(x = m)) /\ (~(m = m'))` SUBGOAL_TAC;
+   EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[other_end_prop];
+  ASM_MESON_TAC[mid_end_disj];
+  DISCH_TAC;
+  TYPE_THEN `x = m'` SUBGOAL_TAC;
+  ASM_MESON_TAC[two_exclusion];
+  USE 9 (REWRITE_RULE[midpoint]);
+  ASM_MESON_TAC[ARITH_RULE `(x = 2) ==> (x -| 1 = 1)`];
+  ]);;
+  (* }}} *)
+
+let endpoint_size2 = prove_by_refinement(
+  `!G. (psegment G) ==> (endpoint G HAS_SIZE 2)`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `(!n G. (psegment G) /\ (G HAS_SIZE n) ==> (endpoint G HAS_SIZE 2)) ==> (!G. (psegment G) ==> endpoint G HAS_SIZE 2)` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `?n. G HAS_SIZE n` SUBGOAL_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  CONV_TAC (dropq_conv "n");
+  ASM_MESON_TAC[psegment;segment];
+  DISCH_THEN CHOOSE_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  INDUCT_TAC;
+  REWRITE_TAC[psegment;segment];
+  ASM_MESON_TAC[HAS_SIZE_0];
+  DISCH_ALL_TAC;
+  TYPE_THEN `(?m. (endpoint G m))` SUBGOAL_TAC;
+  ASM_SIMP_TAC[psegment_endpoint];
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC ;
+  ASM_MESON_TAC[psegment;segment];
+  DISCH_TAC;
+  TYPE_THEN `?e. (G e /\ closure top2 e (pointI m))` SUBGOAL_TAC;
+  USE 3 (REWRITE_RULE[endpoint]);
+  USE 4 (MATCH_MP num_closure_size);
+  TSPEC `(pointI m)` 4;
+  REWR 4;
+  USE 4 (MATCH_MP CARD_SING_CONV);
+  USE 4(REWRITE_RULE[SING]);
+  CHO 4;
+  USE 4 (REWRITE_RULE[eq_sing]);
+  ASM_MESON_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `G = {e}` ASM_CASES_TAC;
+  TYPE_THEN `endpoint G = { m | closure top2 e (pointI m)}` SUBGOAL_TAC;
+  MATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[endpoint];
+  USE 4 (MATCH_MP num_closure_size );
+  GEN_TAC;
+  TSPEC `pointI x` 4;
+  REWR 4;
+  USE 4 (REWRITE_RULE[INR IN_SING]);
+  EQ_TAC;
+  DISCH_TAC;
+  REWR 4;
+  USE 4 (MATCH_MP CARD_SING_CONV);
+  USE 4(REWRITE_RULE[SING;eq_sing]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `{C | (C = e) /\ closure top2 C (pointI x)} ={e}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING ];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 4;
+  USE 4 (REWRITE_RULE[HAS_SIZE]);
+  ASM_MESON_TAC[CARD_SING;SING];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  two_endpoint;
+  ASM_MESON_TAC[psegment;segment;ISUBSET];
+  (*pm*)
+  (* main case *)
+  TYPE_THEN `edge e` SUBGOAL_TAC;
+  ASM_MESON_TAC[psegment;segment;ISUBSET];
+  DISCH_TAC;
+  TSPEC `G DELETE e` 0;
+  TYPE_THEN `psegment (G DELETE e) /\ G DELETE e HAS_SIZE n` SUBGOAL_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[psegment];
+  CONJ_TAC;
+  IMATCH_MP_TAC  segment_delete;
+  TYPE_THEN `m` EXISTS_TAC;
+  ASM_REWRITE_TAC[psegment];
+  ASM_MESON_TAC[psegment];
+  (* it isn't a rectagon if it has an endpoint *)
+  TYPE_THEN `(endpoint (G DELETE e) (other_end e m)) ` SUBGOAL_TAC;
+  ASM_SIMP_TAC[psegment_delete_end];
+  REWRITE_TAC[DELETE_INSERT];
+  COND_CASES_TAC;
+  ASM_MESON_TAC[other_end_prop];
+  REWRITE_TAC[INSERT];
+  ASM_MESON_TAC[rectagon_endpoint];
+  UND 2;
+  REWRITE_TAC[HAS_SIZE];
+  ASM_MESON_TAC[SUC_INJ;FINITE_DELETE_IMP;CARD_SUC_DELETE];
+  DISCH_TAC;
+  REWR 0;
+  UND 0;
+  ASM_SIMP_TAC[psegment_delete_end];
+  DISCH_TAC;
+  TYPE_THEN `G' = (other_end e m INSERT endpoint G)` ABBREV_TAC;
+  TYPE_THEN `G' HAS_SIZE 3` SUBGOAL_TAC;
+  UND 0;
+  REWRITE_TAC[HAS_SIZE;ARITH_RULE `3 = SUC 2`;FINITE_DELETE];
+  TYPE_THEN `G' m` SUBGOAL_TAC;
+  EXPAND_TAC "G'";
+  KILL 9;
+  ASM_REWRITE_TAC [INSERT];
+  ASM_MESON_TAC[CARD_SUC_DELETE];
+  (* nearly there! *)
+  EXPAND_TAC "G'";
+  REWRITE_TAC[HAS_SIZE;FINITE_INSERT];
+  DISCH_ALL_TAC;
+  UND 11;
+  ASM_SIMP_TAC [CARD_CLAUSES];
+  COND_CASES_TAC;
+  TYPE_THEN `(?m. (closure top2 e (pointI m)) /\ (midpoint G m))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  midpoint_exists;
+  ASM_MESON_TAC[psegment];
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `X = { m | closure top2 e (pointI m) }` ABBREV_TAC;
+  TYPE_THEN `X HAS_SIZE 2` SUBGOAL_TAC;
+  USE 7 (MATCH_MP two_endpoint);
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `X m /\ X m' /\ X (other_end e m) /\ (~(m=m')) /\ (~(m= other_end e m)) /\ (~(m'=other_end e m))` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[other_end_prop];
+  ASM_MESON_TAC [mid_end_disj];
+  ASM_MESON_TAC[two_exclusion];
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let sing_has_size1 = prove_by_refinement(
+  `!(x:A). {x} HAS_SIZE 1`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[HAS_SIZE];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[FINITE_SING ];
+  ASM_MESON_TAC[CARD_SING;SING];
+  ]);;
+  (* }}} *)
+
+let num_closure1 = prove_by_refinement(
+  `!G x. (FINITE G) ==>
+       ((num_closure G (x) = 1) <=>
+          (?e. (!e'. (G e' /\ (closure top2 e' (x))) <=> (e = e'))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  COPY 0;
+  USE 0 (MATCH_MP (num_closure_size));
+  TSPEC `x` 0;
+  TYPE_THEN `t = num_closure G x` ABBREV_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  REWR 0;
+  USE 0 (MATCH_MP CARD_SING_CONV);
+  USE 0 (REWRITE_RULE[SING;eq_sing]);
+  CHO 0;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  CHO 3;
+  TYPE_THEN `{C | G C /\ closure top2 C x} = {e}` SUBGOAL_TAC;
+  REWRITE_TAC[eq_sing];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 0;
+  TYPE_THEN `e` (fun t -> ASSUME_TAC (ISPEC t sing_has_size1));
+  UND 5;
+  UND 0;
+  REWRITE_TAC [HAS_SIZE];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* SECTION D *)
+(* ------------------------------------------------------------------ *)
+
+
+
+let inductive_set = jordan_def `inductive_set G S <=>
+   S SUBSET G /\
+              ~(S = {}) /\
+              (!C C'. S C /\ G C' /\ adj C C' ==> S C')`;;
+
+let inductive_univ = prove_by_refinement(
+  `!G. (~(G = EMPTY )) ==> (inductive_set G G)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[inductive_set];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let inductive_inter = prove_by_refinement(
+  `!T G. (T SUBSET G) /\ (~(T = EMPTY )) ==>
+        (inductive_set G
+            (INTERS {S | (T SUBSET S) /\ (inductive_set G S)}))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ONCE_REWRITE_TAC[inductive_set];
+  CONJ_TAC;
+  IMATCH_MP_TAC  INTERS_SUBSET2;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL];
+  IMATCH_MP_TAC  inductive_univ;
+  UND 1;
+  REWRITE_TAC[EMPTY_EXISTS];
+  ASM_MESON_TAC[ISUBSET];
+  CONJ_TAC;
+  USE 1 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 1;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `u` EXISTS_TAC;
+  REWRITE_TAC[INTERS];
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_ALL_TAC;
+  USE  2 (REWRITE_RULE[INTERS]);
+  REWRITE_TAC[INTERS];
+  DISCH_ALL_TAC;
+  TSPEC `u` 2;
+  REWR 2;
+  ASM_MESON_TAC[inductive_set];
+  ]);;
+  (* }}} *)
+
+let segment_of = jordan_def `segment_of G e =
+   INTERS { S | S e /\ inductive_set G S }`;;
+
+let inductive_segment = prove_by_refinement(
+  `!G e. (G e) ==> (inductive_set G (segment_of G e))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[segment_of];
+  ASSUME_TAC inductive_inter;
+  TYPEL_THEN [`{e}`;`G`] (USE 1 o ISPECL);
+  USE 1 (REWRITE_RULE[single_subset;EMPTY_EXISTS;INR IN_SING ]);
+  UND 1;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let segment_of_G = prove_by_refinement(
+  `!G e. (G e) ==> (segment_of G e ) SUBSET G`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[segment_of];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  (INR INTERS_SUBSET2 );
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL];
+  IMATCH_MP_TAC  inductive_univ;
+  REWRITE_TAC [EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let segment_not_in = prove_by_refinement(
+  `!G e. ~(G e) ==> (segment_of G e = UNIV)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[segment_of;];
+  DISCH_ALL_TAC;
+  TYPE_THEN `{S | S e /\ inductive_set G S} = EMPTY ` SUBGOAL_TAC ;
+  REWRITE_TAC[EQ_EMPTY];
+  GEN_TAC;
+  REWRITE_TAC[inductive_set];
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_THEN_REWRITE;
+  ]);;
+  (* }}} *)
+
+let segment_of_finite = prove_by_refinement(
+  `!G e. (FINITE G) /\ (G e) ==> (FINITE (segment_of G e))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  ASM_MESON_TAC[segment_of_G];
+  ]);;
+  (* }}} *)
+
+let segment_of_in = prove_by_refinement(
+  `!G e.  (segment_of G e e)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `G e` ASM_CASES_TAC;
+  REWRITE_TAC[segment_of;INTERS;inductive_set ];
+  MESON_TAC[];
+  ASM_SIMP_TAC[segment_not_in];
+  ]);;
+  (* }}} *)
+
+let segment_of_subset = prove_by_refinement(
+  `!G e f. (G e) /\ (segment_of G e f) ==>
+      (segment_of G f) SUBSET (segment_of G e)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[ISUBSET;segment_of;INTERS ];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let inductive_diff = prove_by_refinement(
+  `!G S S'. (inductive_set G S) /\
+        (inductive_set G S') /\ ~(S DIFF S' = {}) ==>
+        (inductive_set G (S DIFF S'))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[inductive_set;DIFF;SUBSET  ];
+  ASM_MESON_TAC[adj_symm];
+  ]);;
+  (* }}} *)
+
+(* sets *)
+let subset_imp_eq = prove_by_refinement(
+  `!A (B:A->bool). (A SUBSET B) /\ (B DIFF A = EMPTY) ==> (A = B)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;DIFF;EQ_EMPTY];
+  MESON_TAC[EQ_EXT];
+  ]);;
+  (* }}} *)
+
+let segment_of_eq = prove_by_refinement(
+  `!G e f. (G e) /\ (segment_of G e f) ==>
+      ((segment_of G e) = (segment_of G f))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  (GSYM subset_imp_eq);
+  CONJ_TAC;
+  ASM_MESON_TAC[segment_of_subset];
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `G f` SUBGOAL_TAC;
+  USE 0 (MATCH_MP segment_of_G);
+  USE 0 (REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `X = (segment_of G e DIFF segment_of G f)` ABBREV_TAC;
+  TYPE_THEN `X e` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  REWRITE_TAC[DIFF];
+  ASM_SIMP_TAC [segment_of_in];
+  DISCH_ALL_TAC;
+  USE 2 (GSYM);
+  USE 2 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 2;
+  UND 2;
+  EXPAND_TAC "X";
+  REWRITE_TAC[DIFF];
+  JOIN 3 5;
+  USE 2 (MATCH_MP segment_of_subset);
+  ASM_MESON_TAC[ISUBSET]; (* done WITH X e *)
+  DISCH_TAC;
+  TYPE_THEN `inductive_set G (segment_of G e DIFF segment_of G f)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  inductive_diff;
+  ASM_SIMP_TAC[inductive_segment];
+  DISCH_TAC;
+  TYPE_THEN `segment_of G e SUBSET X` SUBGOAL_TAC;
+  REWRITE_TAC[segment_of];
+  IMATCH_MP_TAC  INTERS_SUBSET;
+  REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET];
+  LEFT_TAC "x";
+  TYPE_THEN `f` EXISTS_TAC;
+  EXPAND_TAC "X";
+  REWRITE_TAC[DIFF];
+  ASM_MESON_TAC[segment_of_in];
+  ]);;
+  (* }}} *)
+
+let segment_of_segment = prove_by_refinement(
+  `!G P e. (segment G) /\ (P SUBSET G) /\ (P e) ==>
+      (segment (segment_of P e))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC;
+  TYPE_THEN `FINITE P` SUBGOAL_TAC;
+  ASM_MESON_TAC[FINITE_SUBSET];
+  DISCH_TAC;
+  REWRITE_TAC[segment];
+  ASM_SIMP_TAC[segment_of_finite;EMPTY_EXISTS];
+  CONJ_TAC;
+  ASM_MESON_TAC[segment_of_in];
+  SUBCONJ_TAC;
+  UND 1;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  MP_TAC  segment_of_G;
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASSUME_TAC segment_of_G;
+  (* ok to here *)
+  CONJ_TAC;
+  GEN_TAC;
+  REWRITE_TAC[INSERT];
+  TYPEL_THEN [`P`;`e`] (USE 6 o ISPECL);
+  REWR 6;
+  JOIN 4 6;
+  USE 4 (MATCH_MP num_closure_mono);
+  TSPEC `pointI m` 4;
+  UND 4;
+  JOIN 3 1;
+  USE 1 (MATCH_MP num_closure_mono);
+  TSPEC `(pointI m)` 1;
+  UND 1;
+  UND 0;
+  REWRITE_TAC[segment];
+  REWRITE_TAC[INSERT];
+  DISCH_ALL_TAC;
+  TSPEC `m` 7;
+  UND 7;
+  UND 0;
+  UND 1;
+  ARITH_TAC;
+  (* ok2 *)
+  DISCH_ALL_TAC;
+  CHO 8;
+  (* IMATCH_MP_TAC  subset_imp_eq; *)
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  ASM_REWRITE_TAC[];
+  (*   PROOF_BY_CONTR_TAC; *)
+  TYPE_THEN `! C C'. S C /\ P C' /\ adj C C' ==> S C'` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `segment_of P C C'` SUBGOAL_TAC;
+  REWRITE_TAC[segment_of;INTERS;];
+  X_GEN_TAC `R:((num->real)->bool)->bool`;
+  REWRITE_TAC[inductive_set];
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `segment_of P e = segment_of P C` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  segment_of_eq;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_THEN (fun t-> REWRITE_TAC [GSYM t]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `inductive_set P S` SUBGOAL_TAC;
+  REWRITE_TAC[inductive_set];
+  ASM_REWRITE_TAC[EMPTY_EXISTS];
+  ASM_MESON_TAC[ISUBSET;segment_of_G];
+  TYPE_THEN `segment_of P e = segment_of P u` SUBGOAL_TAC;
+  IMATCH_MP_TAC  segment_of_eq;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[segment_of];
+  DISCH_TAC;
+  IMATCH_MP_TAC  (INR INTERS_SUBSET);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+(* move up *)
+let rectagon_subset = prove_by_refinement(
+  `!G S. (rectagon G) /\ (segment S) /\ (G SUBSET S) ==> (G = S)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[rectagon;segment];
+  DISCH_ALL_TAC;
+  TSPEC `G` 9;
+  UND 9 ;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `(?m. closure top2 C INTER closure top2 C' = {(pointI m)})` SUBGOAL_TAC;
+  ASM_MESON_TAC[edge_inter];
+  DISCH_TAC;
+  CHO 14;
+  (*loss*)
+  COPY 10;
+  COPY 5;
+  JOIN 5 10;
+  USE 5 (MATCH_MP num_closure_mono);
+  TSPEC `pointI m` 5;
+  TYPE_THEN `num_closure G (pointI m) = 2` SUBGOAL_TAC;
+  TSPEC `m` 3;
+  USE 3 (REWRITE_RULE[INSERT]);
+  UND 3;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  UND 3;
+  USE 0 (MATCH_MP num_closure_size);
+  TSPEC  `(pointI m)` 0;
+  DISCH_ALL_TAC;
+  REWR 0;
+  USE 0 (REWRITE_RULE[HAS_SIZE_0]);
+  UND 0;
+  REWRITE_TAC[EMPTY_EXISTS ];
+  UND 14;
+  REWRITE_TAC[INTER;eq_sing; ];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `num_closure S (pointI m) = 2` SUBGOAL_TAC;
+  TSPEC `m` 8;
+  USE 8(REWRITE_RULE[INSERT]);
+  UND 8;
+  TSPEC `m` 3;
+  USE 3 (REWRITE_RULE[INSERT]);
+  UND 3;
+  UND 5;
+  UND 10;
+  ARITH_TAC;
+  DISCH_TAC;
+  (* ok  *)
+  (* num_closure G = num_closure S, C' in latter, so in former *)
+  TYPE_THEN `{C | G C /\ closure top2 C (pointI m)} = {C | S C /\ closure top2 C (pointI m)}`  SUBGOAL_TAC;
+  IMATCH_MP_TAC  CARD_SUBSET_LE;
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `S` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  CONJ_TAC;
+  UND 15;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  USE 0 (MATCH_MP num_closure_size);
+  TSPEC `pointI m` 0;
+  USE 16 (MATCH_MP num_closure_size);
+  TSPEC `pointI m` 16;
+  UND 16;
+  UND 0;
+  ASM_REWRITE_TAC [HAS_SIZE];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  DISCH_TAC;
+  TAPP `C'` 18;
+  UND 18;
+  ASM_REWRITE_TAC[];
+  UND 14;
+  REWRITE_TAC[INTER;eq_sing];
+  MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let rectagon_h_edge = prove_by_refinement(
+  `!G. (rectagon G) ==> (?m. (G (h_edge m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `!e. G e ==> (?m. (e= (v_edge m))) ` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `edge e` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon;ISUBSET];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `X = {m | (G (v_edge m)) }` ABBREV_TAC;
+  TYPE_THEN `FINITE X /\ ~(X = {})` SUBGOAL_TAC;
+  CONJ_TAC;
+  TYPE_THEN `?C. C SUBSET X /\ FINITE C /\ (G = IMAGE (v_edge) C)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  finite_subset;
+  REWRITE_TAC[IMAGE;SUBSET];
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  CONJ_TAC;
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[rectagon];
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_ALL_TAC;
+  TYPE_THEN `C = X` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_ALL_TAC;
+  UND 7;
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  UND 6;
+  REWRITE_TAC[IMAGE];
+  DISCH_THEN_REWRITE ;
+  DISCH_THEN CHOOSE_TAC;
+  USE 6 (REWRITE_RULE[v_edge_inj;h_edge_inj]);
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  USE 0 (REWRITE_RULE[rectagon]);
+  UND 0;
+  DISCH_ALL_TAC;
+  USE 5(REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 5;
+  TSPEC `u` 2;
+  REWR 2;
+  CHO 2;
+  UND 0;
+  EXPAND_TAC "X";
+  REWRITE_TAC[EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* dwf done finite X ...  Messed up. X must have type real->bool. *)
+  TYPE_THEN `Y = IMAGE (real_of_int o SND ) X` ABBREV_TAC;
+  TYPE_THEN ` FINITE Y /\ ~(Y = EMPTY)` SUBGOAL_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "Y";
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "Y";
+  REWRITE_TAC[IMAGE;EMPTY_EXISTS ];
+  CONV_TAC (dropq_conv "u");
+  AND 4;
+  USE 4 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 4;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  USE 6 (MATCH_MP min_finite);
+  CHO 6;
+  TYPE_THEN `?m. (G (v_edge m)) /\ (real_of_int (SND m) = delta)` SUBGOAL_TAC;
+  USE 5 (REWRITE_RULE[IMAGE;o_DEF]);
+  TAPP `delta` 5;
+  REWR 5;
+  CHO 5;
+  TAPP `x` 3;
+  REWR 3;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  CHO 7;
+  (* now show that m is an endpoint *)
+  TYPE_THEN `endpoint G m` SUBGOAL_TAC;
+  REWRITE_TAC[endpoint];
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon];
+  DISCH_TAC;
+  ASM_SIMP_TAC[num_closure1];
+  TYPE_THEN `v_edge m` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `edge e'` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon;ISUBSET];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[v_edge_inj];
+  REWR 10;
+  USE 10 (REWRITE_RULE[v_edge_closure;vc_edge ;UNION;INR IN_SING ;plus_e12 ; pointI_inj; v_edge_pointI]);
+  UND 10;
+  DISCH_THEN   DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `  Y (real_of_int (SND m'))` SUBGOAL_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `m'` EXISTS_TAC;
+  REWRITE_TAC[o_DEF];
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  AND 6;
+  TSPEC `(real_of_int(SND m'))` 6;
+  REWR 6;
+  USE 7 GSYM;
+  REWR 6;
+  USE 6 (REWRITE_RULE[int_suc ]);
+  ASM_MESON_TAC[REAL_ARITH `~(x + &.1 <= x)`];
+  ASM_MESON_TAC[hv_edgeV2];
+  DISCH_TAC;
+  EXPAND_TAC "e'";
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "e'";
+  REWRITE_TAC[v_edge_closure;vc_edge;UNION ;INR IN_SING ;];
+  ASM_MESON_TAC[rectagon_endpoint];
+  ]);;
+  (* }}} *)
+
+let rectagon_v_edge = prove_by_refinement(
+  `!G. (rectagon G) ==> (?m. (G (v_edge m)))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `!e. G e ==> (?m. (e= (h_edge m))) ` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `edge e` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon;ISUBSET];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `X = {m | (G (h_edge m)) }` ABBREV_TAC;
+  TYPE_THEN `FINITE X /\ ~(X = {})` SUBGOAL_TAC;
+  CONJ_TAC;
+  TYPE_THEN `?C. C SUBSET X /\ FINITE C /\ (G = IMAGE (h_edge) C)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  finite_subset;
+  REWRITE_TAC[IMAGE;SUBSET];
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  CONJ_TAC;
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[rectagon];
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_ALL_TAC;
+  TYPE_THEN `C = X` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_ALL_TAC;
+  UND 7;
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  UND 6;
+  REWRITE_TAC[IMAGE];
+  DISCH_THEN_REWRITE ;
+  DISCH_THEN CHOOSE_TAC;
+  USE 6 (REWRITE_RULE[h_edge_inj;v_edge_inj]);
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  USE 0 (REWRITE_RULE[rectagon]);
+  UND 0;
+  DISCH_ALL_TAC;
+  USE 5(REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 5;
+  TSPEC `u` 2;
+  REWR 2;
+  CHO 2;
+  UND 0;
+  EXPAND_TAC "X";
+  REWRITE_TAC[EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* dwfx done finite X ...  Messed up. X must have type real->bool. *)
+  TYPE_THEN `Y = IMAGE (real_of_int o FST ) X` ABBREV_TAC;
+  TYPE_THEN ` FINITE Y /\ ~(Y = EMPTY)` SUBGOAL_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "Y";
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "Y";
+  REWRITE_TAC[IMAGE;EMPTY_EXISTS ];
+  CONV_TAC (dropq_conv "u");
+  AND 4;
+  USE 4 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 4;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  USE 6 (MATCH_MP min_finite);
+  CHO 6;
+  TYPE_THEN `?m. (G (h_edge m)) /\ (real_of_int (FST  m) = delta)` SUBGOAL_TAC;
+  USE 5 (REWRITE_RULE[IMAGE;o_DEF]);
+  TAPP `delta` 5;
+  REWR 5;
+  CHO 5;
+  TAPP `x` 3;
+  REWR 3;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  CHO 7;
+  (* now show that m is an endpoint *)
+  TYPE_THEN `endpoint G m` SUBGOAL_TAC;
+  REWRITE_TAC[endpoint];
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon];
+  DISCH_TAC;
+  ASM_SIMP_TAC[num_closure1];
+  TYPE_THEN `h_edge m` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `edge e'` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon;ISUBSET];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  IMATCH_MP_TAC  (TAUT `((A \/ B) ==> C) ==> ((B \/ A) ==> C)`);
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[h_edge_inj];
+  REWR 10;
+  USE 10 (REWRITE_RULE[h_edge_closure;hc_edge ;UNION;INR IN_SING ;plus_e12 ; pointI_inj; h_edge_pointI]);
+  UND 10;
+  DISCH_THEN   DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `  Y (real_of_int (FST  m'))` SUBGOAL_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `m'` EXISTS_TAC;
+  REWRITE_TAC[o_DEF];
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  AND 6;
+  TSPEC `(real_of_int(FST  m'))` 6;
+  REWR 6;
+  USE 7 GSYM;
+  REWR 6;
+  USE 6 (REWRITE_RULE[int_suc ]);
+  ASM_MESON_TAC[REAL_ARITH `~(x + &.1 <= x)`];
+  ASM_MESON_TAC[hv_edgeV2];
+  DISCH_TAC;
+  EXPAND_TAC "e'";
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "e'";
+  REWRITE_TAC[h_edge_closure;hc_edge;UNION ;INR IN_SING ;];
+  ASM_MESON_TAC[rectagon_endpoint];
+  ]);;
+
+  (* }}} *)
+
+(* move down *)
+let part_below = jordan_def `part_below G m =
+   {C | G C /\
+          ((?n. (C = v_edge n) /\ (SND n <=: SND m) /\ (FST n = FST m)) \/
+           (?n. (C = h_edge n) /\ (SND n <=: SND m) /\
+                 (closure top2 C (pointI (FST m,SND n))))) }`;;
+
+let part_below_h = prove_by_refinement(
+  `!G m n. part_below G m (h_edge n) <=>
+         (set_lower G m n) \/ (set_lower G (left m) n)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[part_below;set_lower;left ];
+  REWRITE_TAC[h_edge_closure;hc_edge;UNION ;h_edge_pointI];
+  REWRITE_TAC[hv_edgeV2;plus_e12;INR IN_SING ;pointI_inj ;PAIR_SPLIT ];
+  REWRITE_TAC[h_edge_inj];
+  CONV_TAC (dropq_conv "n'");
+  REWRITE_TAC[INT_ARITH `(x = y+: &:1) <=> (x -: (&:1) = y)`];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let part_below_v = prove_by_refinement(
+  `!G m n. part_below G m (v_edge n) <=>
+         (G (v_edge n)) /\ (FST n = FST m) /\ (SND n <=: SND m)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[part_below;v_edge_closure;vc_edge;UNION;plus_e12; INR IN_SING; pointI_inj ; PAIR_SPLIT; v_edge_inj; hv_edgeV2];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* sets *)
+let has_size_bij = prove_by_refinement(
+  `!(A:A->bool) n. (A HAS_SIZE n) <=> (?f. BIJ f {m | m < n} A)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  USE 0 (MATCH_MP (INR HAS_SIZE_INDEX));
+  CHO 0;
+  REWRITE_TAC[BIJ;INJ ;SURJ ;];
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  USE 0 (REWRITE_RULE[EXISTS_UNIQUE_ALT]);
+  ASM_MESON_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  ASSUME_TAC CARD_NUMSEG_LT;
+  TSPEC `n` 1;
+  EXPAND_TAC "n";
+  SUBCONJ_TAC;
+  ASSUME_TAC FINITE_NUMSEG_LT;
+  TSPEC `n` 2;
+  JOIN 2 0;
+  USE 0 (MATCH_MP FINITE_BIJ);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  (GSYM BIJ_CARD);
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[FINITE_NUMSEG_LT];
+  ]);;
+  (* }}} *)
+
+let has_size_bij2 = prove_by_refinement(
+  `!(A:A->bool) n. (A HAS_SIZE n) <=> (?f. BIJ f A {m | m < n})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[has_size_bij];
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `INV f {m | m <| n} A` EXISTS_TAC;
+  IMATCH_MP_TAC  INVERSE_BIJ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `INV f A {m | m <| n}` EXISTS_TAC;
+  IMATCH_MP_TAC  INVERSE_BIJ;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let fibre_card = prove_by_refinement(
+  `!(f:A->B) A B m n.  (B HAS_SIZE n) /\ (IMAGE f A SUBSET B) /\
+        (!b. (B b) ==> ({u | (A u) /\ (f u = b)} HAS_SIZE m)) ==>
+           (A HAS_SIZE m*n)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `!b. ?g. (B b) ==> (BIJ g {u | (A u) /\ (f u = b)} {j | j <| m})` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  RIGHT_TAC "g";
+  DISCH_TAC;
+  REWRITE_TAC[GSYM has_size_bij2];
+  TSPEC `b` 2;
+  REWR 2;
+  DISCH_TAC;
+  LEFT 3 "g";
+  CHO 3;
+  (* case m=0 *)
+  DISJ_CASES_TAC (ARITH_RULE `(m=0) \/ 0 < m`);
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  REWRITE_TAC[HAS_SIZE_0];
+  REWR 2;
+  USE 2 (REWRITE_RULE[HAS_SIZE_0]);
+  USE 1 (REWRITE_RULE[IMAGE;ISUBSET ]);
+  PROOF_BY_CONTR_TAC;
+  USE 5 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 5;
+  USE 1 (CONV_RULE NAME_CONFLICT_CONV);
+  USE 1 (CONV_RULE (dropq_conv "x''"));
+  TSPEC `u` 1;
+  REWR 1;
+  TSPEC `f u` 2;
+  REWR 2;
+  USE 2 (REWRITE_RULE[EQ_EMPTY]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `BIJ (\x. (f x, g (f x) x)) A {(x,y) | B x /\ {j|j <|m} y}` SUBGOAL_TAC;
+  REWRITE_TAC[BIJ;INJ;SURJ];
+  SUBCONJ_TAC;
+  SUBCONJ_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `f x` EXISTS_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "y");
+  SUBCONJ_TAC;
+  UND 1;
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TSPEC `f x` 3;
+  REWR 3;
+  UND 3;
+  REWRITE_TAC[BIJ;SURJ];
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  DISCH_ALL_TAC;
+  USE 8(REWRITE_RULE[PAIR_SPLIT]);
+  AND 8;
+  REWR 8;
+  (* r8 *)
+  TYPE_THEN `B (f y)` SUBGOAL_TAC;
+  UND 1;
+  REWRITE_TAC [IMAGE;SUBSET];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TSPEC `f y` 3;
+  REWR 3;
+  USE 3 (REWRITE_RULE[BIJ;INJ]);
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "x'");
+  NAME_CONFLICT_TAC;
+  GEN_TAC;
+  LEFT_TAC  "x''";
+  GEN_TAC;
+  RIGHT_TAC "y''";
+  DISCH_THEN_REWRITE ;
+  RIGHT_TAC "y''";
+  DISCH_ALL_TAC;
+  USE 9 GSYM;
+  REWR 8;
+  ASM_REWRITE_TAC[];
+  KILL 9;
+  TSPEC `FST x` 2;
+  REWR 2;
+  TSPEC `FST x` 3;
+  REWR 3;
+  USE 3 (REWRITE_RULE[BIJ;SURJ]);
+  ASM_MESON_TAC[];
+  REWRITE_TAC[HAS_SIZE];
+  DISCH_TAC;
+  (* r9 *)
+  TYPE_THEN `FINITE B /\ FINITE {j | j <| m}` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[FINITE_NUMSEG_LT];
+  ASM_MESON_TAC[HAS_SIZE];
+  DISCH_TAC;
+  COPY 6;
+  USE 6 (MATCH_MP   (INR FINITE_PRODUCT));
+  REWR 6;
+  COPY 7;
+  USE 7 (MATCH_MP (INR CARD_PRODUCT));
+  SUBCONJ_TAC;
+  JOIN  6 5;
+  USE 5 (MATCH_MP FINITE_BIJ2);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  JOIN 9 5;
+  USE 5 (MATCH_MP BIJ_CARD);
+  REWR 7;
+  ASM_REWRITE_TAC[CARD_NUMSEG_LT];
+  USE 0 (REWRITE_RULE[HAS_SIZE]);
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+(* sets *)
+let even_card_even = prove_by_refinement(
+  `!X (Y:A->bool). (FINITE X) /\ (FINITE Y) /\ (X INTER Y = EMPTY) ==>
+    ((EVEN (CARD X) <=> EVEN (CARD Y)) <=> (EVEN (CARD (X UNION Y))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC [CARD_UNION];
+  REWRITE_TAC[EVEN_ADD];
+  ]);;
+  (* }}} *)
+
+
+(*
+  terminal edge: (endpoint G m) /\ (closure top2 e (pointI m))
+  produce bij-MAP from terminal edges to endpoints (of P SUBSET G)
+  2-1 MAP from  terminal edges to segments.
+  Hence an EVEN number of endpoints.
+
+*)
+
+
+
+let terminal_edge = jordan_def `terminal_edge G m =
+    @e. (G e) /\ (closure top2 e (pointI m))`;;
+
+let terminal_endpoint = prove_by_refinement(
+  `!G m. (FINITE G) /\ (endpoint G m)  ==> ((G (terminal_edge G m)) /\
+          (closure top2 (terminal_edge G m) (pointI m)) ) `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[terminal_edge];
+  SELECT_TAC;
+  MESON_TAC[];
+  ASM_MESON_TAC[endpoint_edge;EXISTS_UNIQUE_ALT];
+  ]);;
+  (* }}} *)
+
+let terminal_unique = prove_by_refinement(
+  `!G m e. (FINITE G) /\ (endpoint G m) ==>
+       ( (G e) /\ (closure top2 e (pointI m)) <=> (e = terminal_edge G m))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  REWRITE_TAC[terminal_edge];
+  SELECT_TAC;
+  USE 1(REWRITE_RULE[endpoint]);
+  ASM_MESON_TAC[num_closure1];
+  ASM_MESON_TAC[terminal_endpoint];
+  ASM_MESON_TAC[terminal_endpoint];
+  ]);;
+  (* }}} *)
+
+
+let segment_of_endpoint = prove_by_refinement(
+  `!P e m. (P e) /\ (FINITE P) ==>
+     (endpoint P m /\
+         (segment_of P (terminal_edge P m) = segment_of P e)
+        <=>
+        endpoint (segment_of P e) m)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE (segment_of P e)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  ASM_MESON_TAC[segment_of_G];
+  DISCH_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  COPY 3;
+  UND 5;
+  REWRITE_TAC[endpoint];
+  ASM_SIMP_TAC[num_closure1];
+  DISCH_ALL_TAC;
+  CHO 5;
+  TYPE_THEN `e'` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  USE 0 (MATCH_MP segment_of_G);
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
+  COPY 5;
+  TSPEC `e'` 5;
+  USE 5 (REWRITE_RULE[]);
+  ASM_REWRITE_TAC[];
+  UND 4;
+  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
+  TSPEC `terminal_edge P m` 6;
+  UND 4;
+  ASM_SIMP_TAC[terminal_endpoint];
+  REWRITE_TAC[segment_of_in];
+  DISCH_TAC;
+  (* se *)
+  SUBCONJ_TAC;
+  UND 3;
+  REWRITE_TAC[endpoint];
+  ASM_SIMP_TAC[num_closure1];
+  DISCH_ALL_TAC;
+  CHO 3;
+  TYPE_THEN `e'` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  TYPE_THEN `P e'' /\ closure top2 e'' (pointI m) ==> segment_of P e e''` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  COPY 3;
+  TSPEC `e'` 3;
+  USE 3 (REWRITE_RULE []);
+  TYPE_THEN `e'' = e'` ASM_CASES_TAC;
+  ASM_MESON_TAC[];
+  USE 0 (MATCH_MP inductive_segment);
+  USE 0 (REWRITE_RULE[inductive_set]);
+  UND 0;
+  DISCH_ALL_TAC;
+  TYPEL_THEN [`e'`;`e''`] (USE 9 o ISPECL);
+  UND 9;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[adj;EMPTY_EXISTS;];
+  TYPE_THEN `pointI m` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
+  ASM_MESON_TAC[segment_of_G;ISUBSET ];
+  (* I'm getting lost in the thickets *)
+  (* se2 *)
+  DISCH_TAC;
+  IMATCH_MP_TAC  (GSYM segment_of_eq);
+  ASM_REWRITE_TAC[];
+  COPY 4;
+  COPY 3;
+  UND 3;
+  UND 4;
+  REWRITE_TAC[endpoint];
+  ASM_SIMP_TAC[num_closure1];
+  DISCH_THEN CHOOSE_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  (* *)
+  COPY 3;
+  TSPEC `e''` 3;
+  TYPE_THEN `e' = e''` SUBGOAL_TAC;
+  TSPEC `e''` 4;
+  USE 4 (REWRITE_RULE[]);
+  ASM_MESON_TAC[segment_of_G;ISUBSET ];
+  DISCH_TAC;
+  TSPEC `terminal_edge P m` 7;
+  TYPE_THEN `e' = terminal_edge P m` SUBGOAL_TAC;
+  ASM_MESON_TAC[terminal_endpoint];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let fibre2 = prove_by_refinement(
+  `!P G. (segment G) /\ (P SUBSET G) /\ (~(rectagon P)) ==>
+    (!S. ({ S | (?e. (P e) /\ (S = segment_of P e)) }  S) ==>
+      ({m | (endpoint P m) /\ (segment_of P (terminal_edge P m) = S)}
+              HAS_SIZE 2))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  CHO 3;
+  ASM_REWRITE_TAC[];
+  USE 3 (CONJUNCT1 );
+  TYPE_THEN `psegment (segment_of P e)` SUBGOAL_TAC;
+  REWRITE_TAC[psegment];
+  CONJ_TAC;
+  ASM_MESON_TAC[rectagon_subset;segment_of_G;segment_of_segment];
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `segment_of P e = G` SUBGOAL_TAC;
+  IMATCH_MP_TAC  rectagon_subset;
+  REWR 4;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[SUBSET_TRANS;segment_of_G];
+  USE 3 (MATCH_MP segment_of_G);
+  DISCH_TAC;
+  REWR 3;
+  JOIN 1 3;
+  USE 1 (MATCH_MP SUBSET_ANTISYM);
+  REWR 4;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  USE 4 (MATCH_MP endpoint_size2);
+  TYPE_THEN `{m | endpoint P m /\ (segment_of P (terminal_edge P m) = segment_of P e)} = endpoint (segment_of P e)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC ;
+  REWRITE_TAC[];
+  (* f2 *)
+  IMATCH_MP_TAC  segment_of_endpoint;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  ASM_MESON_TAC[segment];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let endpoint_even = prove_by_refinement(
+  `!P G. (segment G) /\ (P SUBSET G) /\ (~(rectagon P)) ==>
+        (endpoint P HAS_SIZE 2 *|
+           (CARD {S | (?e. (P e) /\ (S = segment_of P e))})  )`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN  `f =  (segment_of P) o (terminal_edge P)` ABBREV_TAC;
+  TYPE_THEN `B = { S | (?e. (P e) /\ (S = segment_of P e)) }` ABBREV_TAC;
+  TYPE_THEN `f` (fun t-> IMATCH_MP_TAC   (ISPEC t fibre_card));
+  TYPE_THEN `B` EXISTS_TAC;
+  ASM_REWRITE_TAC[HAS_SIZE;IMAGE;SUBSET ; ];
+  EXPAND_TAC "B";
+  EXPAND_TAC "f";
+  REWRITE_TAC[o_DEF ];
+  SUBCONJ_TAC;
+  TYPE_THEN `{S | ?e. P e /\ (S = segment_of P e)} = IMAGE (\x. (segment_of P x)) P` SUBGOAL_TAC;
+  REWRITE_TAC[IMAGE];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  IMATCH_MP_TAC  FINITE_SUBSET ;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC;
+  CONJ_TAC;
+  NAME_CONFLICT_TAC;
+  GEN_TAC;
+  DISCH_THEN CHOOSE_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `terminal_edge P x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `FINITE P` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment;FINITE_SUBSET];
+  ASM_MESON_TAC[terminal_endpoint];
+  (* ee *)
+  REWRITE_TAC[GSYM HAS_SIZE];
+  ASSUME_TAC fibre2;
+  USE 6 (REWRITE_RULE[]);
+  UND 6;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let num_closure0 = prove_by_refinement(
+  `! G x.
+     FINITE G ==> ((num_closure G x = 0) <=>
+             (!e. (G e) ==> (~(closure top2 e x))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP num_closure_size);
+  TSPEC `x` 0;
+  EQ_TAC;
+  DISCH_TAC;
+  REWR 0;
+  USE 0 (REWRITE_RULE[HAS_SIZE_0;EQ_EMPTY ]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `{C | G C /\ closure top2 C x} = {}` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 2 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 2;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 0;
+  USE 0 (REWRITE_RULE[HAS_SIZE]);
+  ASM_MESON_TAC[CARD_CLAUSES];
+  ]);;
+  (* }}} *)
+
+let num_closure2 = prove_by_refinement(
+  `!G x.
+    FINITE G ==> ((num_closure G x = 2) <=>
+           (?a b. (~(a = b)) /\
+              ((!e. (G e /\ closure top2 e x) <=> (( e= a)\/ (e =b))))))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP num_closure_size);
+  TSPEC `x` 0;
+  EQ_TAC;
+  DISCH_TAC;
+  REWR 0;
+  USE 0 (REWRITE_RULE[has_size2 ; ]);
+  CHO 0;
+  CHO 0;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  AND 0;
+  TAPP `e` 2;
+  USE 2(REWRITE_RULE[INSERT]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  CHO 1;
+  CHO 1;
+  TYPE_THEN `X = {C | G C /\ closure top2 C x} ` ABBREV_TAC;
+  TYPE_THEN `(?a b. (X = {a, b}) /\ ~(a = b))` SUBGOAL_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INSERT];
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  USE 3 (REWRITE_RULE[GSYM has_size2]);
+  RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let endpoint_subrectagon = prove_by_refinement(
+  `!G P m. (rectagon G) /\ (P SUBSET G) ==>
+        ((endpoint P m) <=>
+        (?C C'. (P C) /\ (G C') /\ (~(P C')) /\ (~(C = C')) /\
+           (closure top2 C (pointI m)) /\ (closure top2 C' (pointI m))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon];
+  DISCH_TAC;
+  TYPE_THEN `FINITE P` SUBGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  TYPE_THEN `midpoint G m` SUBGOAL_TAC;
+  REWRITE_TAC[midpoint];
+  USE 0 (REWRITE_RULE[rectagon;INSERT]);
+  UND 0;
+  DISCH_ALL_TAC;
+  TSPEC `m` 7;
+  UND 7;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  USE 4 (REWRITE_RULE[endpoint]);
+  JOIN 0 1;
+  USE 0 (MATCH_MP num_closure_mono);
+  ASM_MESON_TAC[ARITH_RULE `~(1 <=| 0)`];
+  REWRITE_TAC[midpoint];
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon];
+  DISCH_THEN (MP_TAC o (MATCH_MP num_closure_size));
+  DISCH_ALL_TAC;
+  TSPEC `pointI m` 6;
+  REWR 6;
+  USE 4 (REWRITE_RULE[endpoint]);
+  UND 4;
+  ASM_SIMP_TAC[num_closure1];
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC;
+  COPY 6;
+  UND 8;
+  REWRITE_TAC[has_size2];
+  DISCH_THEN CHOOSE_TAC;
+  CHO 8;
+  TYPE_THEN `X a /\ X b /\ X e` SUBGOAL_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[INSERT ];
+  CONJ_TAC;
+  ASM_REWRITE_TAC[INSERT];
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  TSPEC `e` 4;
+  USE 4(REWRITE_RULE[]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `P e /\ (closure top2 e (pointI m))` SUBGOAL_TAC;
+  TSPEC `e` 4;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `G a /\ closure top2 a (pointI m) /\ G b /\ closure top2 b (pointI m)` SUBGOAL_TAC;
+  UND 9;
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  MESON_TAC[];
+  DISCH_ALL_TAC;
+  TYPE_THEN `(e =a) \/ (e = b)` SUBGOAL_TAC;
+  ASM_MESON_TAC[two_exclusion];
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `a` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  CHO 4;
+  CHO 4;
+  UND 4;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[endpoint];
+  UND 0;
+  REWRITE_TAC[rectagon;INSERT ];
+  DISCH_ALL_TAC;
+  TSPEC `m` 12;
+  UND 12;
+  (* rg *)
+  DISCH_THEN DISJ_CASES_TAC;
+  USE 3 (MATCH_MP num_closure1);
+  ASM_REWRITE_TAC[];
+  USE 0 (MATCH_MP num_closure2);
+  REWR 12;
+  CHO 12;
+  CHO 12;
+  AND 12;
+  TYPE_THEN `(C = a) \/ (C = b)` SUBGOAL_TAC;
+  UND 12;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `(C' = a) \/ (C' = b)` SUBGOAL_TAC;
+  UND 12;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  TSPEC `e'` 12;
+  REWR 12;
+  TYPE_THEN `G e'` SUBGOAL_TAC;
+  UND 17;
+  UND 1;
+  MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  KILL 0;
+  KILL 3;
+  KILL 18;
+  KILL 13;
+  ASM_MESON_TAC[];
+  KILL 0;
+  KILL 3;
+  KILL 13;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  ASM_REWRITE_TAC[];
+  (* rg2 *)
+  USE 0(MATCH_MP num_closure0);
+  REWR 12;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let part_below_finite = prove_by_refinement(
+  `!G m. (FINITE G) ==> FINITE(part_below G m)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[part_below;ISUBSET ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let part_below_subset = prove_by_refinement(
+  `!G m. (part_below G m) SUBSET G`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[part_below;ISUBSET];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let v_edge_cpoint = prove_by_refinement(
+  `!m n. (closure top2 (v_edge m) (pointI n) <=>
+          ((n = m) \/ (n = (FST m,SND m +: (&:1)))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[v_edge_closure;vc_edge;UNION];
+  REWRITE_TAC[v_edge_pointI;INR IN_SING ;plus_e12;pointI_inj];
+  ]);;
+  (* }}} *)
+
+let h_edge_cpoint = prove_by_refinement(
+  `!m n. (closure top2 (h_edge m) (pointI n) <=>
+          ((n = m) \/ (n = (FST m +: (&:1),SND m ))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[h_edge_closure;hc_edge;UNION];
+  REWRITE_TAC[h_edge_pointI;INR IN_SING ;plus_e12;pointI_inj];
+  ]);;
+  (* }}} *)
+
+let endpoint_lemma = prove_by_refinement(
+  `!G m x.  (rectagon G) /\
+      (endpoint (part_below G m) x)
+       ==>
+      (? C C' m'.
+          ((C = v_edge m') \/ (C = h_edge m')) /\
+          (edge C') /\
+          (!e. G e /\ closure top2 e (pointI x) <=> (e = C) \/ (e = C')) /\
+          (~(G = {})) /\
+          (G SUBSET edge) /\
+          (part_below G m C) /\
+          (G C') /\
+          (~part_below G m C') /\
+          (~(C = C')) /\
+          (closure top2 C (pointI x)) /\
+          (closure top2 C' (pointI x)) /\
+         (part_below G m SUBSET G) /\
+         (endpoint (part_below G m) x))
+          `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `part_below G m SUBSET G` SUBGOAL_TAC;
+  ASM_MESON_TAC[part_below_subset];
+  DISCH_TAC ;
+  COPY 2;
+  COPY 1;
+  UND 1;
+  UND 3;
+  UND 0;
+  SIMP_TAC[endpoint_subrectagon];
+  DISCH_TAC;
+  DISCH_TAC;
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_ALL_TAC;
+  USE 0 (REWRITE_RULE[rectagon;INSERT ]);
+  UND 0;
+  DISCH_ALL_TAC;
+  TSPEC `x` 12;
+  UND 12;
+  DISCH_THEN DISJ_CASES_TAC;
+  USE 0 (MATCH_MP num_closure2);
+  REWR 12;
+  CHO 12;
+  CHO 12;
+  KILL 0;
+  AND 12;
+  TYPE_THEN `(C = a) \/ (C = b)`  SUBGOAL_TAC;
+ TSPEC `C` 0;
+  UND 0;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  ASM_MESON_TAC[ISUBSET];
+  TYPE_THEN `(C' = a) \/ (C' = b)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `!e. G e /\ closure top2 e (pointI x) <=> ((e = C) \/ (e = C'))` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  TSPEC `e` 0;
+  ASM_REWRITE_TAC[];
+  UND 15;
+  UND 14;
+  UND 12;
+  UND 7;
+  MESON_TAC[];
+  DISCH_TAC;
+  KILL 15;
+  KILL 14;
+  KILL 0;
+  KILL 12;
+  KILL 13;
+  TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET;];
+  DISCH_ALL_TAC;
+  USE 0 (REWRITE_RULE[edge]);
+  UND 0;
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `m'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* snd case *)
+  USE 0 (MATCH_MP num_closure0);
+  REWR 12;
+  PROOF_BY_CONTR_TAC;
+  UND 12;
+  UND 5;
+  UND 9;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let endpoint_lemma_small_fst = prove_by_refinement(
+  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
+       (FST m <=: FST x +: &:1) `,
+  (* {{{ proof *)
+
+  [
+  REP_GEN_TAC;
+  DISCH_TAC;
+  COPY 0;
+  USE 0 (MATCH_MP endpoint_lemma);
+  CHO 0;
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`];
+  DISCH_ALL_TAC;
+  (* setup complete *)
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC;
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_v]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `FST x = FST m'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 14;
+  AND 6;
+  AND 6;
+  REWR 14;
+  UND 14;
+  INT_ARITH_TAC;
+  (* 2nd case *)
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `(FST x = FST m') \/ (FST x = FST m' +: (&:1))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `(FST m' = FST m) \/ (FST m' = FST m -: &:1)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  UND 14;
+  INT_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+(* identical proof to endpoint_lemma_small_fst *)
+let endpoint_lemma_big_fst = prove_by_refinement(
+  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
+       (FST x <=: FST m +: &:1) `,
+  (* {{{ proof *)
+
+  [
+  REP_GEN_TAC;
+  DISCH_TAC;
+  COPY 0;
+  USE 0 (MATCH_MP endpoint_lemma);
+  CHO 0;
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`];
+  DISCH_ALL_TAC;
+  (* setup complete *)
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC;
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_v]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `FST x = FST m'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 14;
+  AND 6;
+  AND 6;
+  REWR 14;
+  UND 14;
+  INT_ARITH_TAC;
+  (* 2nd case *)
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `(FST x = FST m') \/ (FST x = FST m' +: (&:1))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `(FST m' = FST m) \/ (FST m' = FST m -: &:1)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  UND 14;
+  INT_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let endpoint_lemma_big_snd = prove_by_refinement(
+  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
+       (SND  x <=: SND  m +: &:1) `,
+  (* {{{ proof *)
+
+  [
+  REP_GEN_TAC;
+  DISCH_TAC;
+  COPY 0;
+  USE 0 (MATCH_MP endpoint_lemma);
+  CHO 0;
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[INT_ARITH `x <=: z +: y <=> ~(z +: y <: x)`];
+  DISCH_ALL_TAC;
+  (* setup complete *)
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC;
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_v]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `(SND x = SND m') \/ (SND x = SND m' +: &:1)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  UND 14;
+  AND 6;
+  AND 6;
+  UND 6;
+  INT_ARITH_TAC;
+  (* 2nd case *)
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `SND x = SND m'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `(SND m' <=: SND m)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  UND 14;
+  INT_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let endpoint_lemma_mid_fst = prove_by_refinement(
+  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
+       (FST x = FST m) ==> (SND  x = SND  m +: &:1) `,
+  (* {{{ proof *)
+
+  [
+  REP_GEN_TAC;
+  DISCH_TAC;
+  COPY 0;
+  USE 0 (MATCH_MP endpoint_lemma);
+  CHO 0;
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  (* setup complete *)
+  UND 2;
+  DISCH_THEN DISJ_CASES_TAC;
+  REWR 7;
+  USE 7 (REWRITE_RULE[part_below_v]);
+  REWR 11;
+  USE 11 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `(SND x = SND m') \/ (SND x = SND m' +: &:1)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  AND 7;
+  AND 7;
+  UND 7;
+  USE 3 (REWRITE_RULE[edge]);
+  CHO 3;
+  UND 3;
+  DISCH_THEN DISJ_CASES_TAC;
+  REWR 9;
+  USE 7 (REWRITE_RULE[part_below_v]);
+  REWR 8;
+  REWR 7;
+  REWR 12;
+  USE 9 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `(FST m'' = FST m) /\ (FST x = FST m'')` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 9;
+  REWR 7;
+  UND 7;
+  UND 9;
+  INT_ARITH_TAC;
+  (* 2nd case *)
+  REWR 12;
+  USE 7 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
+  REWR 8;
+  REWR 9;
+  USE 9 (REWRITE_RULE[left ;set_lower;part_below_h]);
+  REWR 9;
+  TYPE_THEN `(FST x = FST m') ` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 7;
+  DISCH_ALL_TAC;
+  REWR 7;
+  KILL 12;
+  REWR 7;
+  KILL  11;
+  (* try *)
+  UND 7;
+  UND 17;
+  UND 18;
+  UND 9;
+  INT_ARITH_TAC;
+  (* 3rd case *)
+  (* 3c *)
+  REWR 11;
+  USE 11(REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
+  USE 3(REWRITE_RULE[edge]);
+  CHO 3;
+  UND 3;
+  DISCH_THEN DISJ_CASES_TAC;
+  REWR 9;
+  USE 9(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]);
+  REWR 8;
+  REWR 9;
+  UND 9;
+  UND 11;
+  UND 0;
+  REWR 12;
+  USE 0(REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
+  UND 0;
+  USE 1 (MATCH_MP endpoint_lemma_big_snd );
+  UND 0;
+  INT_ARITH_TAC;
+  (* LAST case ,3d *)
+  TYPE_THEN `G (h_edge m')` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  REWR 12;
+  USE 12 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `SND x = SND m''` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 12;
+  REWR 7;
+   USE 7(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]);
+  REWR 7;
+  TYPE_THEN `SND m' <=: SND m` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  UND 7;
+  COPY 17;
+  UND 7;
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  REWR 9;
+   USE 9(REWRITE_RULE[left ;set_lower;part_below_v;part_below_h]);
+  REWR 8;
+  REWR 9;
+  TYPE_THEN `SND x = SND m'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  UND 11;
+  COPY 18;
+  UND 11;
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  TYPE_THEN `(FST m'' = FST m) \/ (FST m'' = FST m -: &:1)` SUBGOAL_TAC;
+  UND 11;
+  UND 7;
+  UND 12;
+  INT_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `~(SND m'' <=: SND m)` SUBGOAL_TAC;
+  UND 19;
+  UND 9;
+  INT_ARITH_TAC;
+  UND 16;
+  UND 18;
+  UND 17;
+  INT_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let endpoint_lemma_upper_left = prove_by_refinement(
+  `!G m . (rectagon G) ==>
+       ~(endpoint (part_below G m) (FST m -: &:1, SND m +: &:1))`,
+  (* {{{ proof *)
+
+  [
+  (* needs to be rewritten, template only *)
+  REP_GEN_TAC;
+  TYPE_THEN  `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m -: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m -: &:1,SND m +: &:1)))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  GEN_TAC;
+  DISCH_TAC;
+  USE 0 (MATCH_MP endpoint_lemma);
+  CHO 0;
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  UND 1;
+  DISCH_THEN DISJ_CASES_TAC;
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_v]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `FST m -: &:1 = FST m'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `FST m' = FST m` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  INT_ARITH_TAC;
+  (* 2nd case *)
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  INT_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let endpoint_lemma_upper_left = prove_by_refinement(
+  `!G m . (rectagon G) ==>
+       ~(endpoint (part_below G m) (FST m -: &:1, SND m +: &:1))`,
+  (* {{{ proof *)
+
+  [
+  (* needs to be rewritten, template only *)
+  REP_GEN_TAC;
+  TYPE_THEN  `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m -: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m -: &:1,SND m +: &:1)))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  GEN_TAC;
+  DISCH_TAC;
+  USE 0 (MATCH_MP endpoint_lemma);
+  CHO 0;
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  UND 1;
+  DISCH_THEN DISJ_CASES_TAC;
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_v]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `FST m -: &:1 = FST m'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `FST m' = FST m` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  INT_ARITH_TAC;
+  (* 2nd case *)
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  INT_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let endpoint_lemma_upper_right = prove_by_refinement(
+  `!G m . (rectagon G) ==>
+       ~(endpoint (part_below G m) (FST m +: &:1, SND m +: &:1))`,
+  (* {{{ proof *)
+
+  [
+  (* needs to be rewritten, template only *)
+  REP_GEN_TAC;
+  TYPE_THEN  `(! x. (rectagon G) /\ (endpoint (part_below G m) x) ==> ~(x = (FST m +: &:1, SND m +: &:1))) ==> (rectagon G ==> ~( endpoint (part_below G m) (FST m +: &:1,SND m +: &:1)))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  GEN_TAC;
+  DISCH_TAC;
+  USE 0 (MATCH_MP endpoint_lemma);
+  CHO 0;
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  UND 1;
+  DISCH_THEN DISJ_CASES_TAC;
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_v]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `FST m +: &:1 = FST m'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `FST m' = FST m` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  INT_ARITH_TAC;
+  (* 2nd case *)
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_h ;set_lower  ;left  ;]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[h_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `(SND m +: &:1 = SND m') /\ (SND m' <=: SND m)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  INT_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let endpoint_lemma_summary = prove_by_refinement(
+  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
+    ((FST x = FST m -: &:1) /\ (SND x <=: SND  m)) \/
+    ((FST x = FST m +: &:1) /\ (SND x <=: SND m)) \/
+    ((FST x = FST m) /\ (SND x = SND m +: &:1 )) `,
+  (* {{{ proof *)
+  [
+  (* USE int -arith to show cases of fst x, then for each give *)
+  REP_GEN_TAC;
+  DISCH_TAC;
+  TYPE_THEN `(FST x < FST m -: &:1) \/ (FST x = FST m -: &:1) \/ (FST x = FST m ) \/ (FST x = FST m +: &:1) \/ (FST m +: &:1 <: FST x  )` SUBGOAL_TAC;
+  INT_ARITH_TAC;
+  REP_CASES_TAC ;
+  USE 0 (MATCH_MP endpoint_lemma_small_fst);
+  PROOF_BY_CONTR_TAC;
+  UND 0;
+  UND 1;
+  INT_ARITH_TAC;
+  DISJ1_TAC;
+  ASM_REWRITE_TAC[];
+  COPY 0;
+  USE 0 (MATCH_MP endpoint_lemma_big_snd);
+  IMATCH_MP_TAC  (INT_ARITH `x <=: m+ &:1 /\ ~(x = m + &:1) ==> ( x <=: m)`);
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  REWR 3;
+  TYPE_THEN `x = (FST m -: &:1, SND m + &:1)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[PAIR_SPLIT];
+  DISCH_TAC;
+  REWR 2;
+  ASM_MESON_TAC[endpoint_lemma_upper_left];
+  USE 0 (MATCH_MP endpoint_lemma_mid_fst);
+  ASM_MESON_TAC[];
+  DISJ2_TAC;
+  DISJ1_TAC ;
+  ASM_REWRITE_TAC[];
+  COPY 0;
+  USE 0 (MATCH_MP endpoint_lemma_big_snd);
+  IMATCH_MP_TAC  (INT_ARITH `x <=: m+ &:1 /\ ~(x = m + &:1) ==> ( x <=: m)`);
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  REWR 3;
+  TYPE_THEN `x = (FST m +: &:1, SND m + &:1)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[PAIR_SPLIT];
+  DISCH_TAC;
+  REWR 2;
+  ASM_MESON_TAC[endpoint_lemma_upper_right];
+  USE 0 (MATCH_MP endpoint_lemma_big_fst);
+  PROOF_BY_CONTR_TAC;
+  UND 0;
+  UND 1;
+  INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let terminal_case1 = prove_by_refinement(
+  `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\
+      (closure top2 (h_edge n) (pointI x)) /\ (set_lower G m n ) ==>
+      (x = right  n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[h_edge_cpoint; set_lower];
+  DISCH_ALL_TAC;
+  USE 2 (REWRITE_RULE[PAIR_SPLIT]);
+  UND 2;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `FST x = FST m` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  JOIN 0 1;
+  USE 0 (MATCH_MP endpoint_lemma_mid_fst);
+  REWR 0;
+  UND 0;
+  UND 2;
+  UND 5;
+  INT_ARITH_TAC;
+  TYPE_THEN `FST x = FST m +: &:1` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[PAIR_SPLIT;right  ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let terminal_case2 = prove_by_refinement(
+  `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\
+      (closure top2 (h_edge n) (pointI x)) /\
+          (set_lower G (left  m) n ) ==>
+      (x =  n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[h_edge_cpoint; set_lower ];
+  DISCH_ALL_TAC;
+  USE 2 (REWRITE_RULE[PAIR_SPLIT]);
+  UND 2;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `FST x = FST m` SUBGOAL_TAC;
+  UND 2;
+  UND 4;
+  REWRITE_TAC[left ];
+  INT_ARITH_TAC ;
+  DISCH_TAC;
+  JOIN 0 1;
+  USE 0 (MATCH_MP endpoint_lemma_mid_fst);
+  AND 2;
+  UND 2;
+  REWR 0;
+  DISCH_TAC;
+  UND 5;
+  UND 0;
+  REWRITE_TAC[left  ];
+  INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let terminal_case_v = prove_by_refinement(
+  `!G m n x. (rectagon G) /\ (endpoint (part_below G m) x) /\
+      (closure top2 (v_edge n) (pointI x)) /\
+          (part_below G m (v_edge n)) ==>
+      (x = up m) /\ (m =n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[part_below_v; v_edge_cpoint;];
+  DISCH_ALL_TAC;
+  JOIN 0 1;
+  USE 2 (REWRITE_RULE[PAIR_SPLIT]);
+  REWR 1;
+  TYPE_THEN `FST x = FST m` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 1;
+  REWRITE_TAC[PAIR_SPLIT; up ;];
+  ASM_REWRITE_TAC[];
+  USE 0 (MATCH_MP endpoint_lemma_mid_fst);
+  REWR 0;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  UND 1;
+  UND 5;
+  INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let inj_terminal = prove_by_refinement(
+  `!G m. (rectagon G) ==>
+     (INJ (terminal_edge (part_below G m))
+         (endpoint (part_below G m)) UNIV)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE (part_below G m)` SUBGOAL_TAC ;
+  ASM_MESON_TAC[part_below_finite;rectagon];
+  DISCH_TAC;
+  REWRITE_TAC[INJ];
+  DISCH_ALL_TAC;
+  TYPE_THEN `e = terminal_edge (part_below G m) x` ABBREV_TAC;
+  TYPE_THEN `closure top2 e (pointI x) /\ closure top2 e (pointI y)` SUBGOAL_TAC;
+  ASM_MESON_TAC[terminal_endpoint];
+  DISCH_ALL_TAC;
+  TYPE_THEN `(part_below G m) e` SUBGOAL_TAC;
+  ASM_MESON_TAC[terminal_endpoint];
+  DISCH_TAC;
+  TYPE_THEN `part_below G m SUBSET G` SUBGOAL_TAC;
+  REWRITE_TAC[part_below;ISUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `edge e` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET;rectagon];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
+  TYPE_THEN `(x = up m) /\ (y = up m)` SUBGOAL_TAC;
+  ASM_MESON_TAC[terminal_case_v];
+  MESON_TAC[];
+  (* h-case *)
+  UND 4;
+  REWR 8;
+  USE 4 (REWRITE_RULE[part_below_h ;]);
+  DISCH_TAC;
+  UND 4;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `(x = right  m') /\ (y = right m')` SUBGOAL_TAC  ;
+  ASM_MESON_TAC[terminal_case1];
+  MESON_TAC[];
+  TYPE_THEN `( x= m' ) /\ (y = m') ` SUBGOAL_TAC;
+  ASM_MESON_TAC[terminal_case2];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* now start on surjectivity results *)
+
+let endpoint_criterion = prove_by_refinement(
+  `!G m e. (FINITE G) /\
+       (!e'. (G e' /\ (closure top2 e' (pointI m))) = (e = e')) ==>
+     (endpoint G m) /\ (e = terminal_edge G m)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  SUBCONJ_TAC;
+  REWRITE_TAC[endpoint;];
+  ASM_SIMP_TAC[num_closure1];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_MESON_TAC[terminal_unique];
+  ]);;
+  (* }}} *)
+
+let target_set = jordan_def `target_set G m =
+    { e | (?n. (e = h_edge n) /\ (set_lower G m n)) \/
+          (?n. (e = h_edge n) /\ (set_lower G (left m) n)) \/
+          ((e = v_edge m) /\ G e)}`;;
+
+let target_set_subset = prove_by_refinement(
+  `!G m. target_set G m SUBSET G`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[ISUBSET;target_set;set_lower];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let target_edge = prove_by_refinement(
+  `!G m. target_set G m SUBSET edge`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[target_set;edge;ISUBSET ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let target_h = prove_by_refinement(
+  `!G m n. target_set G m (h_edge n) <=>
+         (set_lower G m n) \/ (set_lower G (left  m) n)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[target_set;h_edge_inj; hv_edgeV2;];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let target_v = prove_by_refinement(
+  `!G m n. target_set G m (v_edge n) <=>
+        (n = m) /\ G (v_edge n)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[target_set;hv_edgeV2;v_edge_inj;];
+  ]);;
+  (* }}} *)
+
+let part_below_subset = prove_by_refinement(
+  `!G m. (part_below G m SUBSET G)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[part_below;ISUBSET];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let part_below_finite = prove_by_refinement(
+  `!G m. (FINITE G ==> FINITE (part_below G m))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[part_below_subset];
+  ]);;
+  (* }}} *)
+
+let terminal_edge_image = prove_by_refinement(
+  `!G m x. (rectagon G) /\ (endpoint (part_below G m) x) ==>
+      (target_set G m (terminal_edge (part_below G m) x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon];
+  DISCH_TAC;
+  COPY 2;
+  USE 2 ( MATCH_MP part_below_finite);
+  TSPEC `m` 2;
+  REWRITE_TAC[target_set];
+  TYPE_THEN `e = terminal_edge (part_below G m) x` ABBREV_TAC;
+  TYPE_THEN `(part_below G m e) /\ (closure top2 e (pointI x))` SUBGOAL_TAC;
+  ASM_MESON_TAC[terminal_endpoint];
+  DISCH_ALL_TAC;
+  TYPE_THEN `edge e` SUBGOAL_TAC;
+  ASM_MESON_TAC[part_below_subset;ISUBSET;rectagon];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
+  ASM_REWRITE_TAC[hv_edgeV2;v_edge_inj];
+  REWR 5;
+  USE 5 (REWRITE_RULE[part_below_v]);
+  ASM_REWRITE_TAC[PAIR_SPLIT ];
+  REWR 6;
+  USE 6 (REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT]);
+  TYPE_THEN `FST x = FST m'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 6;
+  TYPE_THEN `SND x = SND m +: &:1` SUBGOAL_TAC;
+  ASM_MESON_TAC[endpoint_lemma_mid_fst];
+  UND 6;
+  AND 5;
+  AND 5;
+  UND 5;
+  INT_ARITH_TAC;
+  (* H edge *)
+  ASM_REWRITE_TAC[hv_edgeV2;h_edge_inj;];
+  REWR 5;
+  USE 5(REWRITE_RULE[part_below_h ]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let terminal_edge_surj = prove_by_refinement(
+  `!G m e. (rectagon G) /\ (target_set G m e) ==>
+       (?x. (endpoint (part_below G m) x) /\
+          (e = terminal_edge (part_below G m) x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon];
+  DISCH_TAC;
+  TYPE_THEN `FINITE (part_below G m)` SUBGOAL_TAC;
+  ASM_MESON_TAC[part_below_finite];
+  DISCH_TAC;
+  TYPE_THEN `(part_below G m) SUBSET G` SUBGOAL_TAC;
+  ASM_MESON_TAC[part_below_subset];
+  DISCH_TAC;
+  TYPE_THEN `edge e` SUBGOAL_TAC;
+  ASM_MESON_TAC[target_edge;ISUBSET];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
+  REWR 1;
+  USE 1(REWRITE_RULE[target_v]);
+  AND 1;
+  REWR 1;
+  REWR 5;
+  KILL 6;
+  TYPE_THEN `up m` EXISTS_TAC;
+  IMATCH_MP_TAC  endpoint_criterion;
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `edge e'` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET;rectagon];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_v]);
+  ASM_REWRITE_TAC [v_edge_inj;PAIR_SPLIT];
+  REWR 7;
+  USE 7(REWRITE_RULE[v_edge_cpoint;PAIR_SPLIT;up;]);
+  AND 6;
+  AND 6;
+  UND 6;
+  UND 7;
+  INT_ARITH_TAC;
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_h;set_lower;left  ;]);
+  TYPE_THEN `SND m' <=: SND m` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 7;
+  USE 7(REWRITE_RULE[h_edge_cpoint; up; PAIR_SPLIT ]);
+  UND 7;
+  UND 9;
+  INT_ARITH_TAC;
+  DISCH_TAC;
+  EXPAND_TAC "e'";
+  KILL 6;
+  ASM_REWRITE_TAC [part_below_v;v_edge_cpoint;up];
+  INT_ARITH_TAC;
+  (* half-on-proof , hedge *)
+  (* hop *)
+  REWR 1;
+  USE 1(REWRITE_RULE[target_h]);
+  UND 1;
+  DISCH_THEN (DISJ_CASES_TAC); (* split LEFT and RIGHT H *)
+  TYPE_THEN `right  m'` EXISTS_TAC;
+  IMATCH_MP_TAC  endpoint_criterion;
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `edge e'` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET;rectagon];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC); (* snd H or v *)
+  REWR 6;
+  USE 6 (REWRITE_RULE[part_below_v]);
+  REWR 7;
+  USE 7(REWRITE_RULE[v_edge_cpoint;right  ;PAIR_SPLIT; ]);
+  REWRITE_TAC[h_edge_inj;hv_edgeV2;];
+  USE 1 (REWRITE_RULE[set_lower]);
+  ASM_MESON_TAC[INT_ARITH `~(x +: &:1 = x)`];
+  ASM_REWRITE_TAC [h_edge_inj;PAIR_SPLIT ];  (* snd H *)
+  KILL 5;
+  UND 8;
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE [t]));
+  RULE_ASSUM_TAC (REWRITE_RULE[part_below_h;h_edge_cpoint;PAIR_SPLIT;right  ]);
+  UND 6;
+  DISCH_THEN DISJ_CASES_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[set_lower]);
+  ASM_MESON_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[set_lower;left  ]);
+  AND 5;
+  AND 5;
+  PROOF_BY_CONTR_TAC;
+  UND 8;
+  UND 7;
+  UND 1;
+  INT_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[part_below_h;h_edge_cpoint;right  ];
+  ASM_REWRITE_TAC[];
+  KILL 5;
+  (* finally LEFT case: now everything needs to have an endpoint *)
+  (* hop3*)
+  USE 1 (REWRITE_RULE[set_lower;left  ]);
+  TYPE_THEN `  m'` EXISTS_TAC ; (* was left  m *)
+  IMATCH_MP_TAC  endpoint_criterion;
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `edge e'` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon;ISUBSET];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
+  ASM_REWRITE_TAC[];
+  UND 7;
+  DISCH_THEN  (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  RULE_ASSUM_TAC  (REWRITE_RULE[part_below_v;v_edge_cpoint;left  ;PAIR_SPLIT ;]);
+  UND 5;
+  UND 6;
+  UND 1;
+  INT_ARITH_TAC;
+  (* now H *)
+  ASM_REWRITE_TAC[];
+  UND 7;
+  DISCH_THEN  (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  RULE_ASSUM_TAC  (REWRITE_RULE[part_below_h;h_edge_cpoint;left  ;PAIR_SPLIT ;]);
+  UND 5;
+  DISCH_THEN DISJ_CASES_TAC;
+  USE 5(REWRITE_RULE[set_lower]);
+  UND 5;
+  UND 6;
+  UND 1;
+  INT_ARITH_TAC;
+  (* hop2 *)
+  USE 5 (REWRITE_RULE[set_lower]);
+  REWRITE_TAC[h_edge_inj;PAIR_SPLIT;];
+  UND 5;
+  UND 6;
+  UND 1;
+  INT_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  ASM_REWRITE_TAC[part_below_h;h_edge_cpoint; set_lower; left  ];
+  ]);;
+  (* }}} *)
+
+(* set *)
+let inj_subset = prove_by_refinement(
+  `!t t' s (f:A->B). (INJ f s t') /\ (t SUBSET t') /\
+         (IMAGE f s SUBSET t) ==> (INJ f s t)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ;IMAGE;SUBSET ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let terminal_edge_bij = prove_by_refinement(
+  `!G m. (rectagon G) ==>
+     (BIJ (terminal_edge (part_below G m))
+         (endpoint (part_below G m)) (target_set G m))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  inj_subset;
+  TYPE_THEN `UNIV:((num->real)->bool)->bool` EXISTS_TAC;
+  ASM_SIMP_TAC[inj_terminal];
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_MESON_TAC[terminal_edge_image];
+  REWRITE_TAC[INJ;SURJ];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[terminal_edge_surj];
+  ]);;
+  (* }}} *)
+
+let target_set_finite = prove_by_refinement(
+  `!G m. (FINITE  G) ==> (FINITE (target_set G m))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_MESON_TAC[target_set_subset];
+  ]);;
+  (* }}} *)
+
+let rectagon_endpoint0 = prove_by_refinement(
+  `!G. (rectagon G) ==> ((endpoint G) HAS_SIZE 0)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `endpoint G = {}` SUBGOAL_TAC;
+  REWRITE_TAC[EQ_EMPTY];
+  ASM_MESON_TAC[rectagon_endpoint];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[HAS_SIZE_0];
+  ]);;
+  (* }}} *)
+
+let target_set_even = prove_by_refinement(
+  `!G m. (rectagon G) ==> (EVEN (CARD (target_set G m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `CARD (endpoint(part_below G m)) = CARD (target_set G m)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  BIJ_CARD ;
+  TYPE_THEN `terminal_edge (part_below G m)` EXISTS_TAC;
+  ASM_SIMP_TAC[terminal_edge_bij];
+  ASSUME_TAC terminal_edge_bij;
+  TYPEL_THEN [`G`;`m`] (USE 1 o ISPECL);
+  REWR 1;
+  ASSUME_TAC target_set_finite;
+  TYPEL_THEN [`G`;`m`] (USE 2 o ISPECL);
+  ASM_MESON_TAC[FINITE_BIJ2;rectagon];
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  TYPE_THEN `rectagon (part_below G m)` ASM_CASES_TAC;
+  TYPE_THEN `CARD (endpoint (part_below G m)) =0` SUBGOAL_TAC;
+  ASM_MESON_TAC[HAS_SIZE;rectagon_endpoint0];
+  MESON_TAC[EVEN];
+  TYPE_THEN `P = part_below G m` ABBREV_TAC ;
+  TYPE_THEN `segment G /\ (P SUBSET G) /\ ~(rectagon P)` SUBGOAL_TAC;
+  ASM_SIMP_TAC[rectagon_segment];
+  ASM_MESON_TAC[part_below_subset];
+  DISCH_TAC;
+  USE 3 (MATCH_MP endpoint_even );
+  USE 3 (REWRITE_RULE[HAS_SIZE]);
+  ASM_REWRITE_TAC[EVEN_DOUBLE];
+  ]);;
+  (* }}} *)
+
+let bij_target_set = prove_by_refinement(
+  `!G m. (rectagon G) /\ ~(G (v_edge m)) ==>
+     (BIJ h_edge (set_lower G (left  m) UNION (set_lower G m))
+           (target_set G m))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  REWRITE_TAC[target_set;set_lower;UNION;h_edge_inj;hv_edgeV2; ];
+  MESON_TAC[];
+  REWRITE_TAC[h_edge_inj;];
+  MESON_TAC[];
+  REWRITE_TAC[INJ;SURJ];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[target_set;set_lower;UNION;];
+  GEN_TAC;
+  REP_CASES_TAC;
+  CHO 4;
+  UND 4;
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[];
+  CHO 4;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let bij_target_set_odd = prove_by_refinement(
+  `!G m. (rectagon G) /\ (G (v_edge m)) ==>
+     (BIJ h_edge (set_lower G (left  m) UNION
+             (set_lower G m) )
+           (target_set G m DELETE (v_edge m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  REWRITE_TAC[target_set;set_lower;UNION;h_edge_inj;hv_edgeV2; DELETE ];
+  MESON_TAC[];
+  REWRITE_TAC[h_edge_inj;];
+  MESON_TAC[];
+  REWRITE_TAC[INJ;SURJ];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[target_set;set_lower;UNION;DELETE ];
+  GEN_TAC;
+  DISCH_TAC;
+  AND  4;
+  REWR 5;
+  UND 5;
+  REP_CASES_TAC;
+  CHO 5;
+  UND 5;
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[];
+  CHO 5;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let target_set_odd = prove_by_refinement(
+  `!G m. (rectagon G) /\ (G (v_edge m)) ==>
+         ~(EVEN(CARD (target_set G m DELETE (v_edge m))))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM EVEN];
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE (target_set G m)` SUBGOAL_TAC;
+  ASM_MESON_TAC[target_set_finite;rectagon];
+  DISCH_TAC;
+  TYPE_THEN `target_set G m (v_edge m)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC [target_v];
+  DISCH_TAC;
+  TYPE_THEN `SUC (CARD (target_set G m DELETE (v_edge m))) = CARD (target_set G m )` SUBGOAL_TAC;
+  IMATCH_MP_TAC  CARD_SUC_DELETE;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[target_set_even];
+  ]);;
+  (* }}} *)
+
+let squ_left_even = prove_by_refinement(
+  `!G m. (rectagon G) /\ ~(G (v_edge m)) ==>
+     ((even_cell G (squ (left m)) = even_cell G(squ m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon];
+  DISCH_TAC;
+  REWRITE_TAC[even_cell_squ;num_lower_set];
+  TYPE_THEN `(EVEN (CARD (set_lower G (left m))) <=> EVEN (CARD (set_lower G m))) <=> (EVEN (CARD ((set_lower G (left m)) UNION (set_lower G m))))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  even_card_even;
+  ASM_SIMP_TAC[finite_set_lower];
+  REWRITE_TAC[set_lower;INTER ;left ;EQ_EMPTY ];
+  MESON_TAC[INT_ARITH `~(z = z -: &:1)`];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `BIJ h_edge (set_lower G (left  m) UNION (set_lower G m)) (target_set G m) ` SUBGOAL_TAC;
+  ASM_MESON_TAC[bij_target_set];
+  DISCH_TAC;
+  TYPE_THEN `CARD (set_lower G (left  m) UNION (set_lower G m)) = CARD (target_set G m)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  BIJ_CARD ;
+  TYPE_THEN `h_edge` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[FINITE_UNION];
+  ASM_MESON_TAC[finite_set_lower];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[target_set_even];
+  ]);;
+  (* }}} *)
+
+let squ_left_odd = prove_by_refinement(
+  `!G m. (rectagon G) /\ (G (v_edge m)) ==>
+     (~(even_cell G (squ (left m)) = even_cell G(squ m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon];
+  DISCH_TAC;
+  UND 0;
+  REWRITE_TAC[even_cell_squ;num_lower_set];
+  TYPE_THEN `(EVEN (CARD (set_lower G (left m))) <=> EVEN (CARD (set_lower G m))) <=> (EVEN (CARD ((set_lower G (left m)) UNION (set_lower G m))))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  even_card_even;
+  ASM_SIMP_TAC[finite_set_lower];
+  REWRITE_TAC[set_lower;INTER ;left ;EQ_EMPTY ];
+  MESON_TAC[INT_ARITH `~(z = z -: &:1)`];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `BIJ h_edge (set_lower G (left  m) UNION (set_lower G m)) (target_set G m DELETE (v_edge m)) ` SUBGOAL_TAC;
+  ASM_MESON_TAC[bij_target_set_odd];
+  DISCH_TAC;
+  TYPE_THEN `CARD (set_lower G (left  m) UNION (set_lower G m)) = CARD (target_set G m DELETE (v_edge m))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  BIJ_CARD ;
+  TYPE_THEN `h_edge` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[FINITE_UNION];
+  ASM_MESON_TAC[finite_set_lower];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[target_set_odd];
+  ]);;
+  (* }}} *)
+
+let squ_left_par = prove_by_refinement(
+  `!G m. (rectagon G) ==>
+       (((even_cell G (squ (left m)) = even_cell G(squ m))) <=>
+            ~(G (v_edge m)))`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[squ_left_even;squ_left_odd];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION E *)
+(* ------------------------------------------------------------------ *)
+
+
+let rectangle = jordan_def `rectangle p q =
+  {Z | ?u v. (Z = point(u,v)) /\
+    (real_of_int (FST p ) <. u) /\ (u <. (real_of_int (FST q ))) /\
+    (real_of_int (SND p ) <. v) /\ (v <. (real_of_int (SND q))) }`;;
+
+let rectangle_inter = prove_by_refinement(
+  `!p q. rectangle p q =
+      {z | ?r. (z = point r) /\ (real_of_int(FST p) <. FST r)} INTER
+      {z | ?r. (z = point r) /\ (real_of_int(SND p) <. SND r)} INTER
+     {z | ?r. (z = point r) /\ (FST r ) <. real_of_int(FST q)} INTER
+    {z | ?r. (z = point r) /\ (SND  r ) <. real_of_int(SND  q)}  `,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[rectangle;INTER];
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[point_inj];
+  CONV_TAC (dropq_conv "r");
+  ASM_REWRITE_TAC[];
+  CONV_TAC (dropq_conv "r");
+  ASM_REWRITE_TAC[];
+  CONV_TAC (dropq_conv "r'");
+  CONV_TAC (dropq_conv "r");
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[point_inj]);
+  USE 1(CONV_RULE (dropq_conv "r'"));
+  REWR 2;
+  USE 2(REWRITE_RULE[point_inj]);
+  USE 2(CONV_RULE (dropq_conv "r'"));
+  REWR 3;
+  USE 3(REWRITE_RULE[point_inj]);
+  USE 3(CONV_RULE (dropq_conv "r'"));
+  REWRITE_TAC[point_inj;PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let rectangle_open = prove_by_refinement(
+  `!p q. top2 (rectangle p q)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[rectangle_inter];
+  ASSUME_TAC top2_top;
+  DISCH_ALL_TAC;
+  REPEAT (IMATCH_MP_TAC  top_inter THEN ASM_REWRITE_TAC[top_inter;open_half_plane2D_FLT_open;open_half_plane2D_LTF_open;open_half_plane2D_SLT_open;open_half_plane2D_LTS_open]);
+  ]);;
+  (* }}} *)
+
+let rectangle_convex = prove_by_refinement(
+  `!p q. convex (rectangle p q)`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[rectangle_inter];
+  REPEAT (IMATCH_MP_TAC  convex_inter THEN REWRITE_TAC[open_half_plane2D_FLT_convex;open_half_plane2D_LTF_convex;open_half_plane2D_SLT_convex;open_half_plane2D_LTS_convex]);
+  ]);;
+  (* }}} *)
+
+let rectangle_squ = prove_by_refinement(
+  `!p. squ p = rectangle p (FST p +: &:1,SND p +: &:1)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[squ;rectangle];
+  ]);;
+  (* }}} *)
+
+let squ_inter = prove_by_refinement(
+  `!p. squ p =
+   {z | ?r. (z = point r) /\ (real_of_int(FST p) <. FST r)} INTER
+      {z | ?r. (z = point r) /\ (real_of_int(SND p) <. SND r)} INTER
+     {z | ?r. (z = point r) /\ (FST r ) <. real_of_int(FST p +: &:1) } INTER
+    {z | ?r. (z = point r) /\ (SND  r ) <. real_of_int(SND p +: &:1) }`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[rectangle_squ;rectangle_inter];
+  ]);;
+  (* }}} *)
+
+(* set *)
+let subset3_absorb = prove_by_refinement(
+  `!(A:A->bool) B C. (B SUBSET C) ==> (B INTER A = B INTER C INTER A)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[INTER_ACI];
+  AP_TERM_TAC;
+  ASM_MESON_TAC[SUBSET_INTER_ABSORPTION];
+  ]);;
+  (* }}} *)
+
+let rectangle_lemma1 = prove_by_refinement(
+  `!p. squ(down p) =
+     (rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1))
+    INTER {z | ?r. (z = point r) /\ (SND  r <. real_of_int(SND  p))}`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[squ_inter;rectangle_inter;down];
+  REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`];
+  REWRITE_TAC[INTER_ACI];
+  AP_TERM_TAC;
+  AP_TERM_TAC;
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INTER;int_suc ;];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  ASSUME_TAC (REAL_ARITH `!u. u <. u + &.1`);
+  CONJ_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  ASM_MESON_TAC[REAL_LT_TRANS ];
+  ASM_MESON_TAC[];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+let rectangle_lemma2 = prove_by_refinement(
+  `!p. squ(p) =
+     (rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1))
+    INTER {z | ?r. (z = point r) /\ ( real_of_int(SND  p) <. SND  r)}`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[squ_inter;rectangle_inter;down];
+  REWRITE_TAC[INTER_ACI];
+  AP_TERM_TAC;
+  TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}` ABBREV_TAC ;
+  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND p -: &:1) < SND r}` ABBREV_TAC ;
+  REWRITE_TAC[INTER_ACI];
+  IMATCH_MP_TAC  subset3_absorb;
+  EXPAND_TAC "B";
+  EXPAND_TAC "C";
+  REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th];
+  ASM_MESON_TAC[REAL_ARITH `a <. b ==> (a - &.1 <. b)`];
+  ]);;
+  (* }}} *)
+
+let rectangle_lemma3 = prove_by_refinement(
+  `!q. h_edge q =
+    (rectangle (FST q , SND q -: &:1) (FST q +: &:1 , SND q +: &:1))
+    INTER {z | ?r. (z = point r) /\ ( SND  r = real_of_int(SND  q))}`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[h_edge_inter;rectangle_inter;];
+  TYPE_THEN `B = {z | ?p. (z = point p) /\ (SND p = real_of_int (SND q))}` ABBREV_TAC ;
+  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q -: &:1) < SND r}` ABBREV_TAC ;
+  TYPE_THEN `D = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ;
+  REWRITE_TAC[INTER_ACI];
+  TYPE_THEN `!A. B INTER C INTER D INTER A = B INTER (C INTER D) INTER A` SUBGOAL_TAC;
+  REWRITE_TAC[INTER_ACI];
+  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
+  IMATCH_MP_TAC subset3_absorb;
+  REWRITE_TAC[SUBSET_INTER];
+  EXPAND_TAC "B";
+  EXPAND_TAC "C";
+  EXPAND_TAC "D";
+  REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th;int_add_th;];
+  ASM_MESON_TAC[REAL_ARITH `x - &.1 <. x /\ x < x + &.1`];
+  ]);;
+  (* }}} *)
+
+let rectangle_h = prove_by_refinement(
+  `!p. rectangle (FST p , SND p -: &:1) (FST p +: &:1 , SND p +: &:1) =
+     ((squ (down p)) UNION (h_edge p) UNION  (squ p) )`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[rectangle_lemma1;rectangle_lemma2;rectangle_lemma3];
+  REWRITE_TAC[GSYM UNION_OVER_INTER];
+  TYPE_THEN `({z | ?r. (z = point r) /\ SND r < real_of_int (SND p)} UNION  {z | ?r. (z = point r) /\ (SND r = real_of_int (SND p))} UNION  {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[UNION];
+  ASM_MESON_TAC[REAL_ARITH `!x y. (x <. y) \/ (x = y) \/ (y <. x)`];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `rectangle (FST p,SND p -: &:1) (FST p +: &:1,SND p +: &:1) SUBSET  {z | ?r. z = point r}` SUBGOAL_TAC;
+  REWRITE_TAC[rectangle;SUBSET ];
+  ASM_MESON_TAC[];
+  REWRITE_TAC [SUBSET_INTER_ABSORPTION;];
+  DISCH_THEN_REWRITE;
+  ]);;
+  (* }}} *)
+
+let rectangle_lemma4 = prove_by_refinement(
+  `!p. squ(left   p) =
+     (rectangle (FST p -: &:1 , SND p)(FST p +: &:1 , SND p +: &:1))
+    INTER {z | ?r. (z = point r) /\ (FST   r <. real_of_int(FST  p))}`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[squ_inter;rectangle_inter;left  ];
+  REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`];
+  REWRITE_TAC[INTER_ACI];
+  AP_TERM_TAC;
+  AP_TERM_TAC;
+  TYPE_THEN `B = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p)}` ABBREV_TAC  ;
+  TYPE_THEN `C = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)}` ABBREV_TAC ;
+  REWRITE_TAC[INTER_ACI];
+  IMATCH_MP_TAC  subset3_absorb;
+  EXPAND_TAC "B";
+  EXPAND_TAC "C";
+  REWRITE_TAC[SUBSET;int_suc];
+  ASM_MESON_TAC[REAL_ARITH `x <. y ==> x <. y + &.1`];
+  ]);;
+  (* }}} *)
+
+let rectangle_lemma5 = prove_by_refinement(
+  `!p. squ(p) =
+     (rectangle (FST p -: &:1 , SND p) (FST p +: &:1 , SND p +: &:1))
+    INTER {z | ?r. (z = point r) /\ ( real_of_int(FST   p) <. FST   r)}`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[squ_inter;rectangle_inter;];
+TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r} ` ABBREV_TAC ;
+  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ;
+  REWRITE_TAC[INTER_ACI];
+  IMATCH_MP_TAC  subset3_absorb;
+  EXPAND_TAC "B";
+  EXPAND_TAC "C";
+  REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th];
+  ASM_MESON_TAC[REAL_ARITH `a <. b ==> (a - &.1 <. b)`];
+  ]);;
+  (* }}} *)
+
+let rectangle_lemma6 = prove_by_refinement(
+  `!q. v_edge q =
+    (rectangle (FST q -: &:1 , SND q) (FST q +: &:1 , SND q +: &:1))
+    INTER {z | ?r. (z = point r) /\ ( FST   r = real_of_int(FST   q))}`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[v_edge_inter;rectangle_inter;];
+  REWRITE_TAC[INTER_ACI];
+  TYPE_THEN `B = {z | ?p. (z = point p) /\ (FST  p = real_of_int (FST  q))}` ABBREV_TAC ;
+  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST q -: &:1) < FST r}` ABBREV_TAC ;
+  TYPE_THEN `D = {z | ?r. (z = point r) /\ FST r < real_of_int (FST q +: &:1)}` ABBREV_TAC ;
+  REWRITE_TAC[INTER_ACI];
+  TYPE_THEN `!A. B INTER C INTER D INTER A = B INTER (C INTER D) INTER A` SUBGOAL_TAC;
+  REWRITE_TAC[INTER_ACI];
+  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
+  IMATCH_MP_TAC subset3_absorb;
+  REWRITE_TAC[SUBSET_INTER];
+  EXPAND_TAC "B";
+  EXPAND_TAC "C";
+  EXPAND_TAC "D";
+  REWRITE_TAC[SUBSET;int_sub_th; int_of_num_th;int_add_th;];
+  ASM_MESON_TAC[REAL_ARITH `x - &.1 <. x /\ x < x + &.1`];
+  ]);;
+  (* }}} *)
+
+let rectangle_v = prove_by_refinement(
+  `!p. rectangle (FST p -: &:1 , SND p ) (FST p +: &:1 , SND p +: &:1) =
+     ((squ (left p)) UNION (v_edge p) UNION  (squ p) )`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[rectangle_lemma4;rectangle_lemma5;rectangle_lemma6];
+  REWRITE_TAC[GSYM UNION_OVER_INTER];
+  TYPE_THEN `({z | ?r. (z = point r) /\ FST r < real_of_int (FST p)} UNION  {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} UNION  {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[UNION];
+  ASM_MESON_TAC[REAL_ARITH `!x y. (x <. y) \/ (x = y) \/ (y <. x)`];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `rectangle (FST p -: &:1 ,SND p) (FST p +: &:1,SND p +: &:1) SUBSET  {z | ?r. z = point r}` SUBGOAL_TAC;
+  REWRITE_TAC[rectangle;SUBSET ];
+  ASM_MESON_TAC[];
+  REWRITE_TAC [SUBSET_INTER_ABSORPTION;];
+  DISCH_THEN_REWRITE;
+  ]);;
+  (* }}} *)
+
+let long_v = jordan_def `long_v p =
+  {z | (?r. (z = point r) /\ (FST r = real_of_int (FST p)) /\
+       (real_of_int(SND  p) - &1 <. SND r) /\
+       (SND r <. real_of_int(SND p) + &1) )}`;;
+
+let long_v_inter = prove_by_refinement(
+  `!p. long_v p =
+    {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} INTER
+      {z | ?r. (z = point r) /\ (real_of_int(SND p -: &:1) <. SND r)} INTER
+     {z | ?r. (z = point r) /\ (SND  r  <. real_of_int(SND  p +: &:1))} `,
+  (* {{{ proof *)
+
+  [
+  GEN_TAC;
+  IMATCH_MP_TAC  EQ_EXT ;
+  REWRITE_TAC[long_v;INTER;int_add_th;int_sub_th;int_of_num_th];
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  CHO 0;
+  REWR 1;
+  REWR 2;
+  RULE_ASSUM_TAC  (REWRITE_RULE[point_inj]);
+  USE 2(CONV_RULE (dropq_conv "r'"));
+  USE 1(CONV_RULE (dropq_conv "r'"));
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let long_v_lemma1 = prove_by_refinement(
+  `!q. v_edge (down q) =
+     long_v q INTER
+         {z | ?r. (z = point r) /\ (SND  r  <. real_of_int(SND  q))}`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[v_edge_inter;long_v_inter;down ];
+  REWRITE_TAC[INT_ARITH `x -: &:1 +: &:1 = x`];
+  GEN_TAC;
+  TYPE_THEN `B = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q)}` ABBREV_TAC ;
+  TYPE_THEN `C = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ;
+  alpha_tac;
+  REWRITE_TAC[INTER_ACI];
+  IMATCH_MP_TAC  subset3_absorb;
+  EXPAND_TAC "B";
+  EXPAND_TAC "C";
+  REWRITE_TAC[SUBSET;int_add_th;int_of_num_th];
+  MESON_TAC[REAL_ARITH `x <. y ==> x <. y + &1`];
+  ]);;
+  (* }}} *)
+
+let long_v_lemma2 = prove_by_refinement(
+  `!q. v_edge q =
+     long_v q INTER
+         {z | ?r. (z = point r) /\ (real_of_int(SND  q) <. SND  r  )}`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[v_edge_inter;long_v_inter;down;int_suc;int_sub_th;int_of_num_th ];
+  GEN_TAC;
+  TYPE_THEN `B = {z | ?r. (z = point r) /\  real_of_int (SND q) < SND r}` ABBREV_TAC ;
+  TYPE_THEN `C = {z | ?r. (z = point r) /\  real_of_int (SND q) - &1 < SND r}` ABBREV_TAC ;
+  alpha_tac;
+  REWRITE_TAC[INTER_ACI];
+  IMATCH_MP_TAC  subset3_absorb;
+  EXPAND_TAC "B";
+  EXPAND_TAC "C";
+  REWRITE_TAC[SUBSET;int_add_th;int_of_num_th];
+  MESON_TAC[REAL_ARITH `x <. y ==> x - &1 <. y`];
+  ]);;
+  (* }}} *)
+
+let pointI_inter = prove_by_refinement(
+  `!q. {(pointI q)} =
+        {z | ?r. (z = point r) /\ (FST r = real_of_int (FST q))} INTER
+        {z | ?r. (z = point r) /\ (real_of_int (SND q) = SND r)}`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR IN_SING;pointI ];
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[point_inj];
+  CONV_TAC (dropq_conv "r");
+  CONV_TAC (dropq_conv "r'");
+  DISCH_ALL_TAC;
+  CHO 0;
+  REWR 1;
+  USE 1(REWRITE_RULE[point_inj]);
+  USE 1(CONV_RULE (dropq_conv "r'"));
+  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;];
+  ]);;
+  (* }}} *)
+
+let long_v_lemma3 = prove_by_refinement(
+  `!q. {(pointI q)} = long_v q INTER
+       { z | ?r. (z = point r) /\ (real_of_int(SND q) = SND r)}`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[pointI_inter;long_v_inter];
+  GEN_TAC;
+  alpha_tac;
+  TYPE_THEN `A = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST q))}` ABBREV_TAC ;
+  TYPE_THEN `B = {z | ?r. (z = point r) /\ (real_of_int (SND q) = SND r)}` ABBREV_TAC ;
+  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (SND q -: &:1) < SND r}` ABBREV_TAC ;
+  TYPE_THEN `D = {z | ?r. (z = point r) /\ SND r < real_of_int (SND q +: &:1)}` ABBREV_TAC ;
+  REWRITE_TAC[INTER_ACI];
+  AP_TERM_TAC;
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION];
+  EXPAND_TAC "B";
+  EXPAND_TAC "C";
+  EXPAND_TAC "D";
+  REWRITE_TAC[SUBSET;INTER;int_sub_th;int_of_num_th;int_add_th];
+  ASM_MESON_TAC[REAL_ARITH `(x = y) ==> (x - &1 <. y /\ x <. y + &1)`];
+  ]);;
+  (* }}} *)
+
+let long_v_union = prove_by_refinement(
+  `!p. long_v p =
+      (v_edge (down p)) UNION {(pointI p)} UNION (v_edge p)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[long_v_lemma1;long_v_lemma2;long_v_lemma3];
+  REWRITE_TAC[GSYM UNION_OVER_INTER];
+  TYPE_THEN `({z | ?r. (z = point r) /\ SND r < real_of_int (SND p)} UNION  {z | ?r. (z = point r) /\ (real_of_int (SND p) = SND r)} UNION  {z | ?r. (z = point r) /\ real_of_int (SND p) < SND r}) = {z | ?r. (z = point r)}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT  ;
+  GEN_TAC;
+  REWRITE_TAC[UNION;];
+  EQ_TAC;
+  MESON_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  ASM_REWRITE_TAC[point_inj];
+  CONV_TAC (dropq_conv "r'");
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION;];
+  REWRITE_TAC[long_v;SUBSET];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let two_two_lemma1 = prove_by_refinement(
+  `!p. rectangle(FST p - &:1 , SND p - &:1) (FST p , SND p + &:1) =
+  rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1)
+     INTER
+  {z | (?r. (z = point r) /\ (FST r <. real_of_int(FST p)))}`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[rectangle_inter];
+  alpha_tac;
+  TYPE_THEN `B  = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p)}` ABBREV_TAC  ;
+  TYPE_THEN `C = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)} ` ABBREV_TAC ;
+  REWRITE_TAC[INTER_ACI];
+  IMATCH_MP_TAC  subset3_absorb;
+  EXPAND_TAC "B";
+  EXPAND_TAC "C";
+  REWRITE_TAC[SUBSET;int_suc;];
+  MESON_TAC[REAL_ARITH `x <. y ==> x < y + &1`];
+  ]);;
+  (* }}} *)
+
+let two_two_lemma2 = prove_by_refinement(
+  `!p. rectangle(FST p , SND p - &:1) (FST p + &:1 ,SND p + &:1) =
+  rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1)
+  INTER
+  {z | (?r. (z = point r) /\ ( real_of_int(FST p) <. FST r ))}`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[rectangle_inter];
+  alpha_tac;
+  TYPE_THEN `B = {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r}` ABBREV_TAC ;
+  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ;
+  REWRITE_TAC[INTER_ACI];
+  IMATCH_MP_TAC  subset3_absorb;
+  EXPAND_TAC "B";
+  EXPAND_TAC "C";
+  REWRITE_TAC[SUBSET;int_sub_th;int_add_th;int_of_num_th;];
+  ASM_MESON_TAC[REAL_ARITH `x < y ==> (x - &1 <. y)`];
+  ]);;
+  (* }}} *)
+
+let two_two_lemma3 = prove_by_refinement(
+  `!p. long_v p =
+  rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1)
+  INTER
+    {z | (?r. (z = point r) /\ (  FST r =  real_of_int(FST p)  ))}`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[long_v_inter;rectangle_inter];
+  alpha_tac;
+  TYPE_THEN `B = {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} ` ABBREV_TAC ;
+  TYPE_THEN `C = {z | ?r. (z = point r) /\ real_of_int (FST p -: &:1) < FST r}` ABBREV_TAC ;
+  TYPE_THEN `D = {z | ?r. (z = point r) /\ FST r < real_of_int (FST p +: &:1)} ` ABBREV_TAC ;
+  REWRITE_TAC[INTER_ACI];
+  TYPE_THEN `!A. (B INTER C INTER D INTER A) = B INTER (C INTER D) INTER A` SUBGOAL_TAC;
+  REWRITE_TAC[INTER_ACI];
+  DISCH_THEN (fun t-> PURE_REWRITE_TAC[t]);
+  IMATCH_MP_TAC  subset3_absorb;
+  EXPAND_TAC "B";
+  EXPAND_TAC "C";
+  EXPAND_TAC "D";
+  REWRITE_TAC[SUBSET;INTER;int_sub_th;int_add_th;int_of_num_th];
+  GEN_TAC;
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  ASM_MESON_TAC[REAL_ARITH `(x = y) ==> (x - &.1 <. y /\ x <. y+ &1)`];
+  ]);;
+  (* }}} *)
+
+let two_two_union = prove_by_refinement(
+  `!p. rectangle (FST p -: &:1 , SND p -: &:1)
+     (FST p +: &:1 , SND p + &:1) =
+   rectangle(FST p - &:1 , SND p - &:1) (FST p  , SND p + &:1) UNION
+   long_v p UNION
+   rectangle(FST p , SND p - &:1) (FST p + &:1 ,SND p + &:1)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[two_two_lemma1;two_two_lemma2;two_two_lemma3];
+  REWRITE_TAC[GSYM UNION_OVER_INTER];
+  GEN_TAC;
+  TYPE_THEN `{z | ?r. (z = point r)} = ({z | ?r. (z = point r) /\ FST r < real_of_int (FST p)} UNION {z | ?r. (z = point r) /\ (FST r = real_of_int (FST p))} UNION {z | ?r. (z = point r) /\ real_of_int (FST p) < FST r})` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[UNION];
+  EQ_TAC;
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC [point_inj];
+  CONV_TAC (dropq_conv "r'");
+  REAL_ARITH_TAC;
+  MESON_TAC[];
+  DISCH_TAC;
+  USE 0 SYM;
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION];
+  REWRITE_TAC[rectangle;SUBSET];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let two_two_nine = prove_by_refinement(
+  `!p. rectangle (FST p -: &:1 , SND p -: &:1) (FST p +: &:1 , SND p + &:1) =
+   squ (FST p -: &:1,SND p -: &:1) UNION squ (FST p -: &:1,SND p ) UNION
+   squ (FST p,SND p -: &:1) UNION squ p UNION
+   h_edge (left  p) UNION h_edge  p UNION
+   v_edge (down p) UNION v_edge p UNION {(pointI p)}`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[two_two_union;rectangle_h;rectangle_v];
+  TYPE_THEN `rectangle (FST p -: &:1,SND p -: &:1) (FST p,SND p +: &:1) = rectangle (FST (left  p),SND (left  p) -: &:1) (FST (left  p) +: &:1,SND (left   p) +: &:1)` SUBGOAL_TAC;
+  REWRITE_TAC[left ;INT_ARITH `x -: &:1 +: &:1 = x`];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[rectangle_h];
+  REWRITE_TAC[left ;down; long_v_union];
+  REWRITE_TAC[UNION_ACI];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+
+let curve_cell = jordan_def `curve_cell G = G UNION
+   {z | (?n. (z = {(pointI n)}) /\ (closure top2 (UNIONS G) (pointI n)))}`;;
+
+let curve_cell_cell = prove_by_refinement(
+  `!G. (G SUBSET edge) ==> (curve_cell G SUBSET cell)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;edge;curve_cell;cell;UNION ];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  UND 1;
+  DISCH_THEN DISJ_CASES_TAC;
+  TSPEC `x` 0;
+  REWR 0;
+  CHO 0;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let curve_cell_point = prove_by_refinement(
+  `!G n. (FINITE G) /\ (G SUBSET edge) ==> (curve_cell G {(pointI n)} <=>
+           (?e. (G e /\ (closure top2 e (pointI n)))))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[curve_cell;UNION ;edge;SUBSET ];
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  TSPEC `{(pointI n)}` 1;
+  USE 1(GSYM);
+  USE 1(REWRITE_RULE[eq_sing;v_edge_pointI;h_edge_pointI;]);
+  ASM_MESON_TAC[];
+  USE 2 (REWRITE_RULE[eq_sing;INR IN_SING ;pointI_inj]);
+  USE 2(CONV_RULE (dropq_conv "n'"));
+  ASSUME_TAC top2_top;
+  UND 2;
+  ASM_SIMP_TAC[closure_unions];
+  REWRITE_TAC[IMAGE;INR IN_UNIONS ];
+  DISCH_THEN CHOOSE_TAC;
+  AND 2;
+  CHO 4;
+  ASM_MESON_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  DISJ2_TAC;
+  REWRITE_TAC[eq_sing;INR IN_SING;pointI_inj;];
+  CONV_TAC (dropq_conv "n'") ;
+  TYPE_THEN `closure top2 e SUBSET closure top2 (UNIONS G)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  subset_of_closure;
+  REWRITE_TAC[top2_top];
+  IMATCH_MP_TAC  sub_union;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let curve_cell_h = prove_by_refinement(
+  `!G n. (segment G) ==> (curve_cell G (h_edge n) = G (h_edge n))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; h_edge_pointI];
+  ]);;
+  (* }}} *)
+
+let curve_cell_v = prove_by_refinement(
+  `!G n. (segment G) ==> (curve_cell G (v_edge n) = G (v_edge n))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; v_edge_pointI];
+  ]);;
+  (* }}} *)
+
+let curve_cell_in = prove_by_refinement(
+  `!C G . (G SUBSET edge) /\ (curve_cell G C) ==>
+    (?n. (C = {(pointI n)}) \/ (C = h_edge n) \/ (C = v_edge n))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[curve_cell;UNION ;SUBSET; edge ];
+  DISCH_ALL_TAC;
+  UND 1;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let curve_cell_subset = prove_by_refinement(
+  `!G. (G SUBSET (curve_cell G))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;curve_cell;UNION ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let curve_closure = prove_by_refinement(
+  `!G. (segment G) ==>
+    (closure top2 (UNIONS G) = (UNIONS (curve_cell G)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC ;
+  ASSUME_TAC top2_top;
+  (* ASM_SIMP_TAC[closure_unions]; *)
+  TYPE_THEN `G SUBSET edge ` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  ASM_SIMP_TAC[closure_unions];
+  REWRITE_TAC[IMAGE;INR IN_UNIONS;SUBSET ];
+  DISCH_ALL_TAC;
+  CHO 4;
+  AND 4;
+  CHO 5;
+  TYPE_THEN `edge x'` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment;ISUBSET];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
+  REWR 5;
+  REWR 4;
+  COPY 4;
+  USE 4(REWRITE_RULE[v_edge_closure;vc_edge;UNION ;INR IN_SING ]);
+  UND 4;
+  REP_CASES_TAC;
+  TYPE_THEN `v_edge m` EXISTS_TAC;
+  ASM_SIMP_TAC [curve_cell_v];
+  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
+
+  ASM_SIMP_TAC [curve_cell_point];
+  REWRITE_TAC[INR IN_SING];
+  ASM_MESON_TAC[];
+  USE 4(REWRITE_RULE[plus_e12]);
+  TYPE_THEN `{(pointI (FST m,SND m +: &:1))}` EXISTS_TAC;
+
+  ASM_SIMP_TAC [curve_cell_point];
+  REWRITE_TAC[INR IN_SING];
+  ASM_MESON_TAC[];
+  (* dt2 , down to 2 goals *)
+  REWR 5;
+  REWR 4;
+  COPY 4;
+  USE 4 (REWRITE_RULE[h_edge_closure;hc_edge;UNION;INR IN_SING]);
+  UND 4;
+  REP_CASES_TAC;
+  TYPE_THEN `h_edge m` EXISTS_TAC;
+  ASM_SIMP_TAC[curve_cell_h];
+  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
+  ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ];
+  ASM_MESON_TAC[];
+  USE 4(REWRITE_RULE[plus_e12]);
+  TYPE_THEN `{x}` EXISTS_TAC;
+  ASM_REWRITE_TAC[INR IN_SING];
+  ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ];
+  ASM_MESON_TAC[];
+  (* dt1 *)
+  REWRITE_TAC[curve_cell; UNIONS_UNION; union_subset];
+  ASM_SIMP_TAC[closure_unions];
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;IMAGE;UNIONS];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "u");
+  NAME_CONFLICT_TAC;
+  CHO 4;
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[subset_closure;ISUBSET ];
+  (* // *)
+  TYPE_THEN `A = UNIONS (IMAGE (closure top2) G)` ABBREV_TAC ;
+  REWRITE_TAC[UNIONS;SUBSET ];
+  CONV_TAC (dropq_conv "u");
+  REWRITE_TAC[INR IN_SING];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* logic *)
+let not_not = prove_by_refinement(
+  `!x y. (~x = ~y) <=> (x = y)`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let not_eq = prove_by_refinement(
+  `!x y. (~x = y) <=> (x = ~y)`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let cell_inter = prove_by_refinement(
+  `!C D. (cell C) /\ (D SUBSET cell) ==>
+         ((C INTER (UNIONS D) = EMPTY) <=> ~(D C))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[INTER;IN_UNIONS;SUBSET;EQ_EMPTY  ];
+  DISCH_ALL_TAC;
+  RIGHT_TAC  "x";
+  REWRITE_TAC[not_not ];
+  EQ_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  AND 2;
+  CHO 2;
+  TYPE_THEN `t = C` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  USE 0(MATCH_MP cell_nonempty);
+  USE 0(REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 0;
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let curve_cell_h_inter = prove_by_refinement(
+  `!G m. (segment G) ==>
+     (((h_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
+         (~(G (h_edge m))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[GSYM curve_cell_h];
+  IMATCH_MP_TAC  cell_inter;
+  ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
+  ASM_MESON_TAC[segment;curve_cell_cell];
+  ]);;
+  (* }}} *)
+
+let curve_cell_v_inter = prove_by_refinement(
+  `!G m. (segment G) ==>
+     (((v_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
+         (~(G (v_edge m))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[GSYM curve_cell_v];
+  IMATCH_MP_TAC  cell_inter;
+  ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
+  ASM_MESON_TAC[segment;curve_cell_cell];
+  ]);;
+  (* }}} *)
+
+let curve_cell_squ = prove_by_refinement(
+  `!G m. (segment G) ==> ~curve_cell G (squ m)`,
+  (* {{{ proof *)
+  [
+    REWRITE_TAC[curve_cell;UNION ;eq_sing;square_pointI; segment];
+  REWRITE_TAC[SUBSET; edge];
+  DISCH_ALL_TAC;
+  TSPEC `squ m` 3;
+  USE 3(REWRITE_RULE[square_v_edgeV2;square_h_edgeV2;]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let curve_cell_squ_inter = prove_by_refinement(
+  `!G m. (segment G) ==>
+     (((squ m) INTER (UNIONS (curve_cell G)) = {}))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `cell (squ m)` SUBGOAL_TAC;
+  REWRITE_TAC[cell_rules];
+  DISCH_TAC;
+  TYPE_THEN `(curve_cell G SUBSET cell)` SUBGOAL_TAC;
+  ASM_MESON_TAC[curve_cell_cell;segment];
+  DISCH_TAC;
+  ASM_SIMP_TAC [cell_inter];
+  ASM_MESON_TAC [curve_cell_squ];
+  ]);;
+  (* }}} *)
+
+let curve_point_unions = prove_by_refinement(
+  `!G m. (segment G) ==>
+     (UNIONS (curve_cell G) (pointI m) = curve_cell G {(pointI m)})`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `UNIONS (curve_cell G) (pointI m) <=> ~({(pointI m)} INTER (UNIONS (curve_cell G)) = EMPTY )` SUBGOAL_TAC;
+  REWRITE_TAC[REWRITE_RULE[not_eq] single_inter];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC [not_eq];
+  IMATCH_MP_TAC  cell_inter;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC;
+  ASM_MESON_TAC[cell_rules;curve_cell_cell];
+  ]);;
+  (* }}} *)
+
+let curve_cell_not_point = prove_by_refinement(
+  `!G m. (segment G) ==> ((curve_cell G {(pointI m)} <=>
+     ~(num_closure G (pointI m) = 0)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE G /\ (G SUBSET edge)` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC;
+  ASM_SIMP_TAC[curve_cell_point;num_closure0];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+
+let par_cell = jordan_def `par_cell eps G C <=>
+  ((?m. (C = {(pointI m)}) /\ (eps = EVEN (num_lower G m))) \/
+         (?m. (C = h_edge m) /\ (eps = EVEN (num_lower G m))) \/
+         (?m. (C = v_edge m) /\ (eps = EVEN (num_lower G m))) \/
+         (?m. (C = squ m) /\ (eps= EVEN (num_lower G m)))) /\
+   (C INTER (UNIONS (curve_cell G)) = EMPTY )`;;
+
+let par_cell_curve_disj = prove_by_refinement(
+  `!G C eps. (par_cell eps G C) ==>
+          (C INTER (UNIONS (curve_cell G)) = EMPTY )`,
+  (* {{{ proof *)
+  [
+ REWRITE_TAC[par_cell];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_cell = prove_by_refinement(
+  `!G eps.  (par_cell eps G SUBSET cell)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;par_cell;even_cell];
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[cell_rules];
+  ]);;
+  (* }}} *)
+
+let par_cell_h = prove_by_refinement(
+  `!G m eps. (segment G) ==> ((par_cell eps G (h_edge m) <=>
+      (~(G (h_edge m))) /\ (eps = EVEN (num_lower G m))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[par_cell;eq_sing;h_edge_inj;hv_edgeV2;h_edge_pointI;];
+  REWRITE_TAC[square_h_edgeV2];
+  ASM_SIMP_TAC[curve_cell_h_inter];
+  CONV_TAC (dropq_conv "m'");
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_v = prove_by_refinement(
+  `!G m eps. (segment G) ==> ((par_cell eps G (v_edge m) <=>
+      (~(G (v_edge m))) /\ (eps = EVEN (num_lower G m))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[par_cell;eq_sing;v_edge_inj;hv_edgeV2;v_edge_pointI;];
+  REWRITE_TAC[square_v_edgeV2];
+  ASM_SIMP_TAC[curve_cell_v_inter];
+  CONV_TAC (dropq_conv "m'");
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_squ = prove_by_refinement(
+  `!G m eps. (segment G) ==> ((par_cell eps G (squ m) <=>
+       (eps = EVEN (num_lower G m))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[par_cell;eq_sing;square_h_edgeV2;square_v_edgeV2;squ_inj];
+  ASM_SIMP_TAC[curve_cell_squ_inter];
+  REWRITE_TAC[square_pointI];
+  CONV_TAC (dropq_conv "m'");
+  ]);;
+  (* }}} *)
+
+let par_cell_point = prove_by_refinement(
+  `!G m eps. (segment G) ==> ((par_cell eps G {(pointI m)} <=>
+      ((num_closure G (pointI m) = 0) /\
+          (eps = EVEN (num_lower G m)))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[par_cell;eq_sing;INR IN_SING;point_inj;];
+  SUBGOAL_TAC  `!u x. ({(pointI u)} = x) <=> (x = {(pointI u)})` ;
+  ASM_MESON_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  REWRITE_TAC[eq_sing;INR IN_SING ;h_edge_pointI; v_edge_pointI; square_pointI;];
+  REWRITE_TAC[pointI_inj; REWRITE_RULE[not_eq] single_inter];
+  CONV_TAC (dropq_conv "m'");
+  ASM_SIMP_TAC [curve_point_unions;curve_cell_not_point];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let eq_sing_sym = prove_by_refinement(
+  `!X (y:A). ({y} = X) <=> X y /\ (!u. X u ==> (u = y))`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[eq_sing];
+  ]);;
+  (* }}} *)
+
+let par_cell_disjoint = prove_by_refinement(
+  `!G eps. (par_cell eps G INTER par_cell (~eps) G = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[EQ_EMPTY;INTER ];
+  REP_GEN_TAC;
+  REWRITE_TAC[par_cell];
+  REPEAT (REPEAT (LEFT_TAC "m") THEN (GEN_TAC));
+  REPEAT (LEFT_TAC "m");
+  REPEAT (REPEAT (LEFT_TAC "m'") THEN  (GEN_TAC ));
+  REPEAT (LEFT_TAC ("m'"));
+  REPEAT (REPEAT (LEFT_TAC "m''") THEN  (GEN_TAC ));
+  REPEAT (LEFT_TAC ("m''"));
+  LEFT_TAC "m'''" THEN GEN_TAC;
+  LEFT_TAC "m''''" THEN GEN_TAC;
+  LEFT_TAC "m'''''" THEN GEN_TAC;
+  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
+  REWRITE_TAC[DE_MORGAN_THM];
+  REPEAT (CONJ_TAC) THEN (REWRITE_TAC[GSYM DE_MORGAN_THM;GSYM CONJ_ASSOC]) THEN (REWRITE_TAC[TAUT `~(A /\ B) <=> (A ==> ~B)`]) THEN (DISCH_THEN_REWRITE ) THEN (REWRITE_TAC[eq_sing;eq_sing_sym;pointI_inj;h_edge_pointI;v_edge_pointI;square_pointI; INR IN_SING ; hv_edgeV2; h_edge_inj ; v_edge_inj; square_v_edgeV2;square_h_edgeV2;squ_inj ]) THEN (ASM_MESON_TAC[]);
+  ]);;
+  (* }}} *)
+
+let par_cell_nonempty = prove_by_refinement(
+  `!G eps. (rectagon G) ==> ~(par_cell eps G = EMPTY)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  COPY 1;
+  USE 1 (MATCH_MP rectagon_h_edge);
+  CHO 1;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon];
+  DISCH_TAC ;
+  USE 3(MATCH_MP squ_down);
+  TSPEC `m` 3;
+  USE 3 (REWRITE_RULE[set_lower_n]);
+  UND 3;
+  ASM_REWRITE_TAC[even_cell_squ;];
+  PROOF_BY_CONTR_TAC;
+  UND 0;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `segment G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon_segment];
+  DISCH_TAC ;
+  TYPE_THEN `eps = EVEN (num_lower G m)` ASM_CASES_TAC;
+  TYPE_THEN `squ m` EXISTS_TAC;
+  ASM_SIMP_TAC [par_cell_squ];
+  TYPE_THEN `squ (down m)` EXISTS_TAC;
+  ASM_SIMP_TAC[par_cell_squ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_unions_nonempty = prove_by_refinement(
+  `!G eps. (rectagon G) ==> ~(UNIONS (par_cell eps G) = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[UNIONS;EMPTY_EXISTS ];
+  NAME_CONFLICT_TAC;
+  DISCH_TAC ;
+  USE 0 (MATCH_MP par_cell_nonempty);
+  TSPEC `eps` 0;
+  USE 0 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 0;
+ LEFT_TAC "u'";
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `cell u` SUBGOAL_TAC;
+  ASM_MESON_TAC[par_cell_cell;ISUBSET ];
+  DISCH_THEN (fun t-> MP_TAC (MATCH_MP cell_nonempty t));
+  REWRITE_TAC[EMPTY_EXISTS];
+  ]);;
+  (* }}} *)
+
+let ctop = jordan_def `ctop G =
+   induced_top top2 (euclid 2 DIFF (UNIONS (curve_cell G)))`;;
+
+let top2_unions = prove_by_refinement(
+  `UNIONS (top2) = (euclid 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC [top2];
+  ASM_MESON_TAC[top_of_metric_unions;metric_euclid];
+  ]);;
+  (* }}} *)
+
+let curve_closed = prove_by_refinement(
+  `!G. (segment G) ==> (closed_ top2 (UNIONS (curve_cell G)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[GSYM curve_closure];
+  IMATCH_MP_TAC  closure_closed;
+  REWRITE_TAC[top2_top];
+  IMATCH_MP_TAC  UNIONS_SUBSET;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  REWRITE_TAC[SUBSET;top2_unions;edge;  ];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TSPEC `A` 1;
+  REWR 1;
+  CHO 1;
+  ASM_MESON_TAC[REWRITE_RULE[SUBSET] h_edge_euclid;REWRITE_RULE[SUBSET] v_edge_euclid];
+  ]);;
+  (* }}} *)
+
+let ctop_unions = prove_by_refinement(
+  `!G. UNIONS (ctop G) = (euclid 2 DIFF (UNIONS (curve_cell G)))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[ctop];
+  REWRITE_TAC[induced_top_support];
+  REWRITE_TAC[top2_unions];
+  REWRITE_TAC[INTER;DIFF;];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_partition = prove_by_refinement(
+  `!G eps. (segment G) ==>
+  ((UNIONS (par_cell eps G) UNION (UNIONS (par_cell (~eps) G))) =
+    (UNIONS (ctop G))) `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM ;
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  TYPE_THEN `eps` (fun t-> SPEC_TAC (t,t));
+  RIGHT_TAC "eps";
+  SUBCONJ_TAC;
+  GEN_TAC;
+  IMATCH_MP_TAC  UNIONS_SUBSET;
+  REWRITE_TAC[ctop_unions;DIFF_SUBSET ];
+  DISCH_ALL_TAC;
+  COPY 1;
+  USE 2(MATCH_MP par_cell_curve_disj);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  cell_euclid;
+  ASM_MESON_TAC[par_cell_cell ;ISUBSET ];
+  DISCH_TAC ;
+  GEN_TAC;
+  TSPEC `~eps` 1;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[ctop_unions;SUBSET ;DIFF ; UNION ; UNIONS ];
+  DISCH_ALL_TAC;
+  USE 1(MATCH_MP point_onto);
+  CHO 1;
+  ASSUME_TAC cell_unions;
+  TSPEC `p` 3;
+  USE 3 (REWRITE_RULE[UNIONS]);
+  CHO 3;
+  USE 3 (REWRITE_RULE[cell]);
+  AND 3;
+  CHO 4;
+  UND 4;
+  REP_CASES_TAC;
+  NAME_CONFLICT_TAC;
+  ASM_REWRITE_TAC[];
+  REWR 3;
+  USE 3(REWRITE_RULE[INR IN_SING;pointI;point_inj ;]);
+  ASM_REWRITE_TAC[GSYM pointI];
+  LEFT_TAC "u'";
+  TYPE_THEN `{(pointI p')}` EXISTS_TAC;
+  ASM_SIMP_TAC[par_cell_point];
+  REWRITE_TAC[INR IN_SING];
+  LEFT 2 "u";
+  TSPEC `{(pointI p')}` 2;
+  REWR 2;
+  USE 2(REWRITE_RULE[GSYM pointI;INR IN_SING ]);
+  UND 2;
+  ASM_SIMP_TAC [curve_cell_not_point];
+  MESON_TAC[];
+  (* case 2 *)
+  LEFT_TAC "u";
+  TYPE_THEN `h_edge p'` EXISTS_TAC ;
+  ASM_SIMP_TAC [par_cell_h];
+  LEFT 2 "u";
+  REWR 3;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `(G (h_edge p'))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC ;
+  TSPEC `h_edge p'` 2;
+  ASM_MESON_TAC[curve_cell_h];
+  (* case 3 *)
+  LEFT_TAC "u";
+  TYPE_THEN `v_edge p'` EXISTS_TAC ;
+  ASM_SIMP_TAC [par_cell_v];
+  LEFT 2 "u";
+  REWR 3;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `(G (v_edge p'))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC ;
+  TSPEC `v_edge p'` 2;
+  ASM_MESON_TAC[curve_cell_v];
+  (* case 4 *)
+  LEFT_TAC "u";
+  TYPE_THEN `squ p'` EXISTS_TAC ;
+  ASM_SIMP_TAC [par_cell_squ];
+  LEFT 2 "u";
+  REWR 3;
+  ASM_REWRITE_TAC[];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(*  openness of par_cell *)
+(* ------------------------------------------------------------------ *)
+
+let par_cell_h_squ = prove_by_refinement(
+  `!G m eps. (segment G) /\ (par_cell eps G (h_edge m)) ==>
+     (par_cell eps G (squ m) /\ par_cell eps G (squ (down m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  UND 1;
+  ASM_SIMP_TAC [par_cell_h;par_cell_squ];
+  DISCH_ALL_TAC;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC ;
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  ASM_SIMP_TAC[num_lower_down];
+  ASM_MESON_TAC[set_lower_n];
+  ]);;
+  (* }}} *)
+
+let par_cell_v_squ = prove_by_refinement(
+  `!G m eps. (rectagon G) /\ (par_cell eps G (v_edge m)) ==>
+     (par_cell eps G (squ m) /\ par_cell eps G (squ (left m)))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  UND 1;
+  TYPE_THEN `segment G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon_segment];
+  ASM_SIMP_TAC [par_cell_v;par_cell_squ];
+  DISCH_ALL_TAC;
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  ASM_SIMP_TAC[REWRITE_RULE[even_cell_squ] squ_left_par];
+  ]);;
+
+  (* }}} *)
+
+(* move up *)
+let segment_finite = prove_by_refinement(
+  `!G. (segment G) ==> (FINITE G)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[segment];
+  ]);;
+  (* }}} *)
+
+let num_closure0_edge = prove_by_refinement(
+  `!G m. (FINITE G) /\ (num_closure G (pointI m) = 0) ==>
+    ~G (v_edge m) /\ ~G (v_edge (down m)) /\
+          ~G (h_edge m) /\ ~G(h_edge (left  m))`,
+  (* {{{ proof *)
+
+  let rule = REWRITE_RULE[down;left ;h_edge_closure;hc_edge;v_edge_closure;vc_edge;UNION ;plus_e12; INR IN_SING ; INT_ARITH `x -: &:1 +: &:1 = x`] in
+  [
+  DISCH_ALL_TAC;
+  UND 1;
+  ASM_SIMP_TAC[num_closure0];
+  DISCH_TAC;
+  REWRITE_TAC[GSYM DE_MORGAN_THM];
+  PURE_REWRITE_TAC [GSYM IMP_CLAUSES];
+  REP_CASES_TAC;
+  TSPEC `v_edge m` 1;
+  JOIN 1 2;
+  USE 1(rule);
+  ASM_MESON_TAC[];
+  TSPEC `v_edge (down m)` 1;
+  JOIN 2 1;
+  USE 1(rule);
+  ASM_MESON_TAC[];
+  TSPEC `h_edge ( m)` 1;
+  JOIN 1 2;
+  USE 1(rule);
+  ASM_MESON_TAC[];
+  TSPEC `h_edge (left  m)` 1;
+  JOIN 1 2;
+  USE 1(rule);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_point_h = prove_by_refinement(
+  `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==>
+     (par_cell eps G (h_edge m) /\ par_cell eps G (h_edge (left m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  UND 1;
+  TYPE_THEN `segment G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon_segment];
+  ASM_SIMP_TAC [par_cell_h;par_cell_point];
+  DISCH_ALL_TAC;
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  ASM_SIMP_TAC[REWRITE_RULE[even_cell_squ] squ_left_par];
+  UND 1;
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment_finite];
+  ASM_MESON_TAC[num_closure0_edge];
+  ]);;
+  (* }}} *)
+
+let par_cell_point_v = prove_by_refinement(
+  `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==>
+     (par_cell eps G (v_edge m) /\ par_cell eps G (v_edge (down m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  UND 1;
+  TYPE_THEN `segment G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon_segment];
+  ASM_SIMP_TAC [par_cell_v;par_cell_point];
+  DISCH_ALL_TAC;
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment_finite];
+  ASM_SIMP_TAC[num_lower_down];
+  REWRITE_TAC [set_lower_n];
+  ASM_MESON_TAC[num_closure0_edge];
+  ]);;
+  (* }}} *)
+
+let par_cell_point_rectangle = prove_by_refinement(
+  `!G m eps. (rectagon G) /\ (par_cell eps G {(pointI m)}) ==>
+     (rectangle (FST m -: &:1,SND m -: &:1) (FST m +: &:1,SND m +: &:1)
+       SUBSET (UNIONS (par_cell eps G)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `segment G` SUBGOAL_TAC;
+  ASM_SIMP_TAC[rectagon_segment];
+  DISCH_TAC;
+  REWRITE_TAC[two_two_union;union_subset];
+  CONJ_TAC;
+  TYPE_THEN `rectangle (FST m -: &:1,SND m -: &:1) (FST m,SND m +: &:1) = rectangle (FST (left  m),SND (left  m) -: &:1) (FST (left  m) +: &:1,SND (left  m) +: &:1)` SUBGOAL_TAC;
+  REWRITE_TAC[left ;INT_ARITH ` x -: &:1 +: &:1 =x`];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[rectangle_h;union_subset ];
+  TYPE_THEN `par_cell eps G (h_edge (left  m))` SUBGOAL_TAC;
+  ASM_MESON_TAC[par_cell_point_h];
+  ASM_MESON_TAC[sub_union;par_cell_h_squ];
+  CONJ_TAC;
+  REWRITE_TAC[long_v_union;union_subset;];
+  ASM_MESON_TAC[sub_union; par_cell_point_v;];
+  REWRITE_TAC[rectangle_h;union_subset ];
+  TYPE_THEN `par_cell eps G (h_edge (  m))` SUBGOAL_TAC;
+  ASM_MESON_TAC[par_cell_point_h];
+  ASM_MESON_TAC[sub_union;par_cell_h_squ];
+  ]);;
+  (* }}} *)
+
+let par_cell_h_rectangle = prove_by_refinement(
+  `!G m eps. (rectagon G) /\ (par_cell eps G (h_edge m)) ==>
+     (rectangle (FST m ,SND m -: &:1) (FST m +: &:1,SND m +: &:1)
+       SUBSET (UNIONS (par_cell eps G)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `segment G` SUBGOAL_TAC;
+  ASM_SIMP_TAC[rectagon_segment];
+  DISCH_TAC;
+  REWRITE_TAC[rectangle_h;union_subset ];
+  ASM_MESON_TAC[sub_union;par_cell_h_squ];
+  ]);;
+  (* }}} *)
+
+let par_cell_v_rectangle = prove_by_refinement(
+  `!G m eps. (rectagon G) /\ (par_cell eps G (v_edge m)) ==>
+     (rectangle (FST m -: &:1 ,SND m ) (FST m +: &:1,SND m +: &:1)
+       SUBSET (UNIONS (par_cell eps G)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `segment G` SUBGOAL_TAC;
+  ASM_SIMP_TAC[rectagon_segment];
+  DISCH_TAC;
+  REWRITE_TAC[rectangle_v;union_subset ];
+  ASM_MESON_TAC[sub_union;par_cell_v_squ];
+  ]);;
+  (* }}} *)
+
+let par_cell_squ_rectangle = prove_by_refinement(
+  `!G m eps. (rectagon G) /\ (par_cell eps G (squ m)) ==>
+     (rectangle (FST m  ,SND m ) (FST m +: &:1,SND m +: &:1)
+       SUBSET (UNIONS (par_cell eps G)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[GSYM rectangle_squ];
+  IMATCH_MP_TAC  sub_union;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_point_in_rectangle = prove_by_refinement(
+  `!m. (rectangle (FST m -: &:1,SND m -: &:1)
+            (FST m +: &:1,SND m +: &:1) (pointI m))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[two_two_union;UNION ;long_v_union ; INR IN_SING ;];
+  ]);;
+  (* }}} *)
+
+let par_cell_h_in_rectangle = prove_by_refinement(
+  `!m. (h_edge m SUBSET
+     (rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1)))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[rectangle_h; UNION ; ISUBSET; INR IN_SING ;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_v_in_rectangle = prove_by_refinement(
+  `!m. (v_edge m SUBSET
+     (rectangle (FST m -: &:1 ,SND m) (FST m +: &:1,SND m +: &:1)))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[rectangle_v; UNION ; ISUBSET; INR IN_SING ;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let ctop_top = prove_by_refinement(
+  `!G. topology_ (ctop G)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[ctop];
+  IMATCH_MP_TAC induced_top_top;
+  REWRITE_TAC[top2_top];
+  ]);;
+  (* }}} *)
+
+let ctop_open = prove_by_refinement(
+  `!G B eps. (segment G) /\ (B SUBSET UNIONS (par_cell eps G)) /\
+      (top2 B) ==> (ctop G B)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[ctop;induced_top;IMAGE];
+  TYPE_THEN `B` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION;GSYM ctop_unions];
+  ASM_SIMP_TAC[GSYM par_cell_partition];
+  REWRITE_TAC[UNION;ISUBSET ];
+  ASM_MESON_TAC[ISUBSET];
+  ]);;
+  (* }}} *)
+
+let par_cell_open = prove_by_refinement(
+  `!G eps. (rectagon G) ==> (ctop G (UNIONS (par_cell eps G )))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `segment G` SUBGOAL_TAC;
+  ASM_MESON_TAC[rectagon_segment];
+  DISCH_TAC;
+  ASSUME_TAC ctop_top;
+  TSPEC `G` 2;
+  USE 2(MATCH_MP open_nbd);
+  UND 2;
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]) ;
+  GEN_TAC;
+  RIGHT_TAC "B";
+  DISCH_TAC;
+  USE 2(REWRITE_RULE[UNIONS]);
+  CHO 2;
+  TYPE_THEN `?p. (u = {(pointI p)}) \/ (u = h_edge p) \/ (u = v_edge p) \/ (u = squ p)` SUBGOAL_TAC;
+  AND 2;
+  USE 3 (MATCH_MP (REWRITE_RULE[ISUBSET ]par_cell_cell));
+  USE 3(REWRITE_RULE[cell]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (CHOOSE_THEN MP_TAC );
+  ASSUME_TAC rectangle_open;
+  REP_CASES_TAC ;
+  (* 1st case *)
+  REWR 2;
+  USE 2(REWRITE_RULE[INR IN_SING]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `rectangle (FST p -: &:1,SND p -: &:1) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
+  REWRITE_TAC[par_cell_point_in_rectangle];
+  SUBCONJ_TAC;
+  ASM_SIMP_TAC[par_cell_point_rectangle];
+  ASM_MESON_TAC[ctop_open];
+  (* 2nd case *)
+  REWR 2;
+  TYPE_THEN `rectangle (FST p,SND p -: &:1) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
+  ASM_SIMP_TAC [REWRITE_RULE[ISUBSET] par_cell_h_in_rectangle];
+  SUBCONJ_TAC;
+  ASM_SIMP_TAC[par_cell_h_rectangle];
+  ASM_MESON_TAC[ctop_open];
+  (* 3rd case *)
+  REWR 2;
+  TYPE_THEN `rectangle (FST p -: &:1,SND p ) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
+  ASM_SIMP_TAC [REWRITE_RULE[ISUBSET] par_cell_v_in_rectangle];
+  SUBCONJ_TAC;
+  ASM_SIMP_TAC[par_cell_v_rectangle];
+  ASM_MESON_TAC[ctop_open];
+  (* 4th case *)
+  REWR 2;
+  TYPE_THEN `rectangle (FST p,SND p ) (FST p +: &:1,SND p +: &:1)` EXISTS_TAC;
+  ASSUME_TAC rectangle_squ;
+  TSPEC `p` 5;
+  SUBCONJ_TAC;
+  ASM_SIMP_TAC[par_cell_squ_rectangle];
+  DISCH_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[PAIR];
+  ASM_MESON_TAC[ctop_open];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* start on connected components of ctop G *)
+(* ------------------------------------------------------------------ *)
+
+(* move *)
+let connected_empty = prove_by_refinement(
+  `!(U:(A->bool)->bool). connected U EMPTY `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[connected];
+  ]);;
+  (* }}} *)
+
+let par_cell_union_disjoint = prove_by_refinement(
+  `!G eps. (UNIONS (par_cell eps G) INTER (UNIONS (par_cell (~eps) G)) =
+              EMPTY )`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[INTER;EQ_EMPTY ;UNIONS;];
+  DISCH_ALL_TAC;
+  AND 0;
+  CHO 0;
+  CHO 1;
+  TYPE_THEN `cell u /\ cell u'` SUBGOAL_TAC;
+  ASM_MESON_TAC[par_cell_cell;ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `u = u'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASSUME_TAC par_cell_disjoint;
+  USE 4(REWRITE_RULE[INTER;EQ_EMPTY]);
+  TYPEL_THEN[`G`;`eps`;`u`] (USE 4 o ISPECL);
+  USE 3 (GSYM);
+  REWR 1;
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let par_cell_comp = prove_by_refinement(
+  `!G eps x. (rectagon G) ==>
+         (component  (ctop G) x SUBSET (UNIONS (par_cell eps G))) \/
+            (component (ctop G) x SUBSET (UNIONS (par_cell (~eps) G)))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `component  (ctop G) x SUBSET (UNIONS (ctop G))` SUBGOAL_TAC;
+  REWRITE_TAC[component_DEF ;SUBSET ;connected ];
+  MESON_TAC[];
+  TYPE_THEN `segment G` SUBGOAL_TAC;
+  ASM_MESON_TAC [rectagon_segment];
+  DISCH_TAC;
+  ASM_SIMP_TAC[GSYM par_cell_partition];
+  DISCH_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 3 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]);
+  AND 3;
+  LEFT 3 "x'";
+  CHO 3;
+  LEFT 4 "x'";
+  CHO 4;
+  TYPE_THEN `component  (ctop G) x x'' /\ component  (ctop G) x x' ` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `component  (ctop G) x' x'' ` SUBGOAL_TAC;
+  ASM_MESON_TAC[component_symm;component_trans];
+  DISCH_TAC;
+  USE 6(REWRITE_RULE[component_DEF]);
+  CHO 6;
+  USE 6(REWRITE_RULE[connected]);
+  AND 6;
+  AND 6;
+  AND 7;
+  TYPE_THEN `A = UNIONS (par_cell eps G)` ABBREV_TAC ;
+  TYPE_THEN `B = UNIONS (par_cell (~eps) G)` ABBREV_TAC ;
+  TYPEL_THEN [`A`;`B`] (USE 7 o ISPECL);
+  UND 7;
+  REWRITE_TAC[];
+  TYPE_THEN `ctop G A /\ ctop G B` SUBGOAL_TAC;
+  ASM_MESON_TAC[par_cell_open];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `Z SUBSET (A UNION B)` SUBGOAL_TAC;
+  ASM_MESON_TAC[par_cell_partition];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `A INTER B = EMPTY` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  EXPAND_TAC "B";
+  ASM_MESON_TAC[par_cell_union_disjoint;INTER_ACI;];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[ISUBSET];
+  ]);;
+
+  (* }}} *)
+
+(* move *)
+let connected_component = prove_by_refinement(
+  `!U Z (x:A). (connected U Z) /\ (Z x) ==> (Z SUBSET (component U x)) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[component_DEF  ;SUBSET ];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `Z` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let cont_mk_segment = prove_by_refinement(
+  `!x y n. (euclid n x) /\ (euclid n y) ==>
+    (continuous (joinf (\u. x)
+        (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1))
+          (&.0))
+   (top_of_metric (UNIV,d_real)) (top_of_metric (euclid n,d_euclid)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  joinf_cont;
+  CONJ_TAC;
+  IMATCH_MP_TAC  const_continuous;
+  IMATCH_MP_TAC  top_of_metric_top;
+  REWRITE_TAC[metric_real];
+  CONJ_TAC;
+  IMATCH_MP_TAC  joinf_cont;
+  CONJ_TAC;
+  IMATCH_MP_TAC  continuous_lin_combo;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  const_continuous;
+  IMATCH_MP_TAC  top_of_metric_top;
+  REWRITE_TAC[metric_real];
+  BETA_TAC;
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_rzero ];
+  REWRITE_TAC[joinf];
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero ];
+  ]);;
+  (* }}} *)
+
+let mk_segment_image = prove_by_refinement(
+  `!x y n. (euclid n x) /\ (euclid n y) ==> (?f.
+     (continuous f
+        (top_of_metric(UNIV,d_real))
+        (top_of_metric (euclid n,d_euclid))) /\
+     (IMAGE f {t | &.0 <=. t /\ t <=. &.1}  = mk_segment x y))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  cont_mk_segment;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[joinf;IMAGE ];
+  REWRITE_TAC[mk_segment];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  ASM_REWRITE_TAC[];
+  EQ_TAC;
+  DISCH_TAC;
+  CHO 2;
+  UND 2;
+  COND_CASES_TAC;
+  DISCH_ALL_TAC;
+  JOIN 3 2;
+  ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`];
+  DISCH_ALL_TAC;
+  UND 5;
+  COND_CASES_TAC;
+  DISCH_TAC;
+  TYPE_THEN `&1 - x''` EXISTS_TAC;
+  SUBCONJ_TAC;
+  UND 5;
+  REAL_ARITH_TAC ;
+  DISCH_TAC;
+  CONJ_TAC;
+  UND 3;
+  REAL_ARITH_TAC ;
+  ONCE_REWRITE_TAC [euclid_add_comm];
+  REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `&0` EXISTS_TAC;
+  CONJ_TAC;
+  REAL_ARITH_TAC ;
+  CONJ_TAC;
+  REAL_ARITH_TAC ;
+  REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
+  (* 2nd half *)
+  DISCH_TAC;
+  CHO 2;
+  TYPE_THEN `&1 - a` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  AND 2;
+  AND 2;
+  UND 3;
+  UND 4;
+  REAL_ARITH_TAC ;
+  COND_CASES_TAC;
+  ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`];
+  COND_CASES_TAC;
+  REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
+  ASM_MESON_TAC [euclid_add_comm];
+  TYPE_THEN `a = &.0` SUBGOAL_TAC;
+  UND 4;
+  UND 3;
+  AND 2;
+  UND 3;
+  REAL_ARITH_TAC ;
+  DISCH_TAC;
+  REWR 2;
+  REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
+  ]);;
+  (* }}} *)
+
+let euclid_n_convex = prove_by_refinement(
+  `!n. (convex (euclid n))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[convex;mk_segment;SUBSET ];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  CHO 2;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[euclid_add_closure;euclid_scale_closure];
+  ]);;
+  (* }}} *)
+
+let connected_mk_segment = prove_by_refinement(
+  `!x y n. (euclid n x) /\ (euclid n y) ==>
+   (connected (top_of_metric(euclid n,d_euclid)) (mk_segment x y))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `?f. (continuous f    (top_of_metric(UNIV,d_real))  (top_of_metric (euclid n,d_euclid))) /\  (IMAGE f {t | &.0 <=. t /\ t <=. &.1}  = mk_segment x y)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  mk_segment_image;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  USE 2(GSYM);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  connect_image;
+  TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  USE 2(GSYM);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `UNIONS (top_of_metric (euclid n,d_euclid) ) = (euclid n)` SUBGOAL_TAC;
+  ASM_MESON_TAC [top_of_metric_unions;metric_euclid];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[convex;euclid_n_convex];
+  MATCH_ACCEPT_TAC connect_real;
+  ]);;
+  (* }}} *)
+
+let ctop_open = prove_by_refinement(
+  `!G A. (top2 A /\ (A SUBSET (UNIONS (ctop G))) ==> ctop G A)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[ctop;induced_top;IMAGE ];
+  TYPE_THEN `A` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  REWRITE_TAC[GSYM SUBSET_INTER_ABSORPTION];
+  REWRITE_TAC[GSYM ctop_unions];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let ctop_top2 = prove_by_refinement(
+  `!G A. (segment G /\ ctop G A ==> top2 A)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[ctop;induced_top;IMAGE ;];
+  DISCH_ALL_TAC;
+  TYPE_THEN `U = top_of_metric(euclid 2,d_euclid)` ABBREV_TAC ;
+  TYPE_THEN `euclid 2 = UNIONS U` SUBGOAL_TAC;
+  EXPAND_TAC "U";
+  ASM_MESON_TAC[top_of_metric_unions;metric_euclid];
+  CHO 1;
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  top_inter;
+  ASM_REWRITE_TAC[top2_top;];
+  ASM_SIMP_TAC[GSYM curve_closure;top2];
+  IMATCH_MP_TAC  (REWRITE_RULE[open_DEF] closed_open);
+  IMATCH_MP_TAC  closure_closed;
+  CONJ_TAC;
+  EXPAND_TAC "U";
+  ASM_MESON_TAC[top_of_metric_top;metric_euclid];
+  USE 3(GSYM);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  UNIONS_SUBSET;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  REWRITE_TAC[edge;ISUBSET;];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TSPEC `A'` 4;
+  REWR 4;
+  CHO 4;
+  UND 4;
+  DISCH_THEN DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] ;
+  MATCH_ACCEPT_TAC (REWRITE_RULE[ISUBSET;] v_edge_euclid);
+  MATCH_ACCEPT_TAC (REWRITE_RULE[ISUBSET;] h_edge_euclid);
+  ]);;
+  (* }}} *)
+
+let mk_segment_sym_lemma = prove_by_refinement(
+  `!x y z. (mk_segment x y z ==> mk_segment y x z)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[mk_segment];
+  DISCH_ALL_TAC;
+  CHO 0;
+  TYPE_THEN `&1 - a` EXISTS_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[REAL_ARITH `a <= &1 ==> &0 <= &1 - a`];
+  CONJ_TAC;
+  ASM_MESON_TAC[REAL_ARITH `&0 <= a ==> &1 - a <= &1`];
+  ONCE_REWRITE_TAC[euclid_add_comm];
+  ASM_REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
+  ]);;
+  (* }}} *)
+
+let mk_segment_sym = prove_by_refinement(
+  `!x y. (mk_segment x y = mk_segment y x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  EQ_TAC THEN ASM_MESON_TAC[mk_segment_sym_lemma];
+  ]);;
+  (* }}} *)
+
+let mk_segment_end = prove_by_refinement(
+  `!x y. (mk_segment x y x /\ mk_segment x y y)`,
+  (* {{{ proof *)
+  [
+  RIGHT_TAC "y";
+  RIGHT_TAC "x";
+  SUBCONJ_TAC;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[mk_segment];
+  TYPE_THEN `&1` EXISTS_TAC;
+  REDUCE_TAC;
+  CONJ_TAC;
+  ARITH_TAC;
+  REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
+  DISCH_TAC;
+  ONCE_REWRITE_TAC[mk_segment_sym];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let convex_connected = prove_by_refinement(
+  `!G Z. (segment G /\ convex Z) /\ (Z SUBSET (UNIONS (ctop G))) ==>
+            (connected (ctop G) Z)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[connected];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 7 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]);
+  AND 7;
+  LEFT 7 "x";
+  CHO 7;
+  LEFT 8 "x";
+  CHO 8;
+  TYPE_THEN `Z x /\ Z x'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `mk_segment x x' SUBSET A UNION B` SUBGOAL_TAC;
+  USE 1(REWRITE_RULE[convex]);
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) (mk_segment x x')` SUBGOAL_TAC;
+  IMATCH_MP_TAC  connected_mk_segment;
+  USE 2(REWRITE_RULE[ctop_unions;SUBSET;DIFF;]);
+  ASM_MESON_TAC[];
+  REWRITE_TAC[connected];
+  DISCH_ALL_TAC;
+  AND 11;
+  TYPEL_THEN [`A`;`B`] (USE 11 o ISPECL);
+  REWR 11;
+  TYPE_THEN `top_of_metric (euclid 2,d_euclid) A /\ top_of_metric (euclid 2,d_euclid) B` SUBGOAL_TAC;
+  REWRITE_TAC[GSYM top2];
+  ASM_MESON_TAC[ctop_top2;top2];
+  DISCH_TAC;
+  UND 11;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[DE_MORGAN_THM;ISUBSET;];
+  CONJ_TAC;
+  LEFT_TAC "x''";
+  TYPE_THEN `x'` EXISTS_TAC;
+  REWRITE_TAC[mk_segment_end];
+  ASM_MESON_TAC[];
+  LEFT_TAC "x''";
+  TYPE_THEN `x` EXISTS_TAC;
+  REWRITE_TAC[mk_segment_end];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let component_replace = prove_by_refinement(
+  `!U (x:A) y. component  U x y ==> (component  U x = component  U y)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  USE 0(MATCH_MP component_symm);
+  ASM_MESON_TAC[component_trans];
+  ASM_MESON_TAC[component_trans;component_symm];
+  ]);;
+
+  (* }}} *)
+
+let convex_component = prove_by_refinement(
+  `!G Z x. (segment G /\ convex Z /\ (Z SUBSET (UNIONS (ctop G))) /\
+     (~(Z INTER (component  (ctop G) x ) = EMPTY))  ==>
+        (Z SUBSET (component  (ctop G) x)))  `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `connected (ctop G) Z` SUBGOAL_TAC;
+  ASM_SIMP_TAC[convex_connected];
+  DISCH_TAC;
+  USE 3(REWRITE_RULE[EMPTY_EXISTS;INTER ]);
+  CHO 3;
+  AND 3;
+  USE 3(MATCH_MP component_replace);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  connected_component;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let cell_convex = prove_by_refinement(
+  `!C.  (cell C) ==> (convex C)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cell];
+  GEN_TAC;
+  DISCH_THEN (CHOOSE_THEN MP_TAC ) THEN REP_CASES_TAC THEN ASM_REWRITE_TAC[v_edge_convex;h_edge_convex;convex_pointI;rectangle_squ;rectangle_convex];
+
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+
+let cell_of = jordan_def `cell_of C = { A | (cell A) /\ (A SUBSET C) }`;;
+
+let unions_cell_of = prove_by_refinement(
+  `!G x. (segment G ==>
+     (UNIONS (cell_of (component  (ctop G) x)) =
+           component  (ctop G) x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  REWRITE_TAC[UNIONS;SUBSET;cell_of];
+  CONJ_TAC;
+  DISCH_ALL_TAC;
+  CHO 1;
+  AND 1;
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  TYPE_THEN `(euclid 2 x')` SUBGOAL_TAC;
+  UND 1;
+  REWRITE_TAC[component_DEF   ;connected;SUBSET ;ctop_unions;DIFF ];
+  DISCH_THEN CHOOSE_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  USE 2 (MATCH_MP point_onto);
+  CHO 2;
+  REWR 1;
+  ASM_REWRITE_TAC[];
+  ASSUME_TAC cell_unions;
+  TSPEC `p` 3;
+  USE 3 (REWRITE_RULE[UNIONS]);
+  CHO 3;
+  TYPE_THEN `u` EXISTS_TAC;
+  TYPE_THEN `u SUBSET (component  (ctop G) x) ==> (!x'. u x' ==> component  (ctop G) x x')` SUBGOAL_TAC;
+  REWRITE_TAC[ISUBSET];
+  ASM_REWRITE_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  convex_component ;
+  ASM_REWRITE_TAC[EMPTY_EXISTS];
+  CONJ_TAC;
+  ASM_MESON_TAC[cell_convex];
+  CONJ_TAC;
+  REWRITE_TAC[ctop_unions];
+  REWRITE_TAC[DIFF;SUBSET ];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  AND 3;
+  UND 5;
+  UND 4;
+  ASM_MESON_TAC[cell_euclid;ISUBSET];
+  REWRITE_TAC[UNIONS];
+  LEFT_TAC  "u";
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC;
+  USE 6 (MATCH_MP   curve_cell_cell);
+  USE 6 (REWRITE_RULE[ISUBSET]);
+  TSPEC `u'` 6;
+  REWR 6;
+  TYPE_THEN `u = u'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  REWRITE_TAC[EMPTY_EXISTS;INTER];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  USE 1 (REWRITE_RULE[component_DEF;connected;SUBSET ]);
+  TYPE_THEN `UNIONS (ctop G) (point p)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[ctop_unions;DIFF ;UNIONS ;DE_MORGAN_THM ];
+  DISJ2_TAC ;
+  ASM_MESON_TAC[];
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `point p` EXISTS_TAC;
+  ASM_REWRITE_TAC [INTER];
+  ]);;
+  (* }}} *)
+
+
+
+
+(* ------------------------------------------------------------------ *)
+(* SECTION F *)
+(* ------------------------------------------------------------------ *)
+
+(* ------------------------------------------------------------------ *)
+(* num_abs_of_int *)
+(* ------------------------------------------------------------------ *)
+
+let num_abs_of_int_exists = prove_by_refinement(
+  `!m. ?i. &i = abs  (real_of_int(m))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[GSYM int_abs_th];
+  ASSUME_TAC dest_int_rep;
+  TSPEC `||: m` 0;
+  CHO 0;
+  TYPE_THEN `n` EXISTS_TAC;
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  WITH 0 (REWRITE_RULE[int_abs_th]);
+  TYPE_THEN `&0 <= abs  (real_of_int m)` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_POS];
+  TYPE_THEN `abs  (real_of_int m) <= &.0` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC ;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC ;
+  ]);;
+  (* }}} *)
+
+let num_abs_of_int_select = new_definition
+     `num_abs_of_int m = @i. (&i = abs  (real_of_int m))`;;
+
+let num_abs_of_int_th = prove_by_refinement(
+  `!m. &(num_abs_of_int m) = abs  (real_of_int m)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[num_abs_of_int_select];
+  SELECT_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[num_abs_of_int_exists];
+  ]);;
+  (* }}} *)
+
+let num_abs_of_int_mul = prove_by_refinement(
+  `!m n. (num_abs_of_int (m * n) = num_abs_of_int m * num_abs_of_int n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;GSYM REAL_MUL;num_abs_of_int_th;int_mul_th;ABS_MUL;];
+  ]);;
+  (* }}} *)
+
+let num_abs_of_int_num = prove_by_refinement(
+  `!n. (num_abs_of_int (&: n) = n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;int_of_num_th;REAL_ABS_NUM;];
+  ]);;
+  (* }}} *)
+
+let num_abs_of_int_triangle = prove_by_refinement(
+  `!n m. num_abs_of_int (m + n) <=|
+           num_abs_of_int(m) +| num_abs_of_int n`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[GSYM REAL_OF_NUM_LE;num_abs_of_int_th;int_add_th;GSYM REAL_OF_NUM_ADD;ABS_TRIANGLE;];
+  ]);;
+  (* }}} *)
+
+let num_abs_of_int0 = prove_by_refinement(
+  `!m. (num_abs_of_int m = 0) <=> (m = &:0)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;REAL_ABS_ZERO;];
+  REWRITE_TAC[int_eq;];
+  REWRITE_TAC[int_of_num_th;];
+  ]);;
+  (* }}} *)
+
+let num_abs_of_int_neg = prove_by_refinement(
+  `!m. (num_abs_of_int (--: m) = num_abs_of_int m)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;int_neg_th;REAL_ABS_NEG;];
+  ]);;
+  (* }}} *)
+
+let num_abs_of_int_suc = prove_by_refinement(
+  `!m. (&:0 <=: m) ==>
+     (SUC (num_abs_of_int m) = num_abs_of_int (m +: &:1))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[int_le;int_of_num_th;];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;ADD1;GSYM REAL_ADD;int_suc];
+  UND 0;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let num_abs_of_int_pre = prove_by_refinement(
+  `!m. (m <=: &:0) ==>
+     (SUC (num_abs_of_int m) = num_abs_of_int (m -: &:1))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[int_le;int_of_num_th;];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[GSYM REAL_OF_NUM_EQ;num_abs_of_int_th;ADD1;GSYM REAL_ADD;int_suc;int_sub_th;int_of_num_th;];
+  UND 0;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* closure of squares *)
+(* ------------------------------------------------------------------ *)
+
+let right_left = prove_by_refinement(
+  `!m. (right  (left  m) = m) /\ (left  (right  m) = m) /\
+    (up (down m) = m) /\ (down (up m) = m) /\
+    (up (right  m) = right  (up m)) /\ (up (left  m) = left  (up m)) /\
+    (down (right  m) = right  (down m)) /\
+    (down (left  m) = (left  (down m)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[right ;left ;up;down;PAIR_SPLIT];
+  INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let squc = jordan_def `squc p = {Z | ?u v.
+                  (Z = point (u,v)) /\
+                  real_of_int (FST p) <= u /\
+                  u <= real_of_int (FST p +: &:1) /\
+                  real_of_int (SND p) <= v /\
+                  v <= real_of_int (SND p +: &:1)}`;;
+
+let squc_inter = prove_by_refinement(
+  `!p. squc p =
+   {z | ?r. (z = point r) /\ real_of_int (FST p) <= FST r} INTER
+         {z | ?r. (z = point r) /\ real_of_int (SND p) <= SND r} INTER
+         {z | ?r. (z = point r) /\ FST r <= real_of_int (FST p +: &:1)} INTER
+         {z | ?r. (z = point r) /\ SND r <= real_of_int (SND p +: &:1)}`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[squc];
+  GEN_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INTER];
+  EQ_TAC;
+  DISCH_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[point_inj;];
+  CONV_TAC (dropq_conv "r");
+  ASM_REWRITE_TAC[];
+  CONV_TAC (dropq_conv "r");
+  ASM_REWRITE_TAC[];
+  CONV_TAC (dropq_conv "r'");
+  ASM_REWRITE_TAC[];
+  CONV_TAC (dropq_conv "r");
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  CHO 0;
+  AND 0;
+  REWR 1;
+  REWRITE_TAC[point_inj;PAIR_SPLIT ;];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  USE 1 (REWRITE_RULE[point_inj;]);
+  USE 1 (CONV_RULE (dropq_conv "r'"));
+  REWR 2;
+  USE 2 (REWRITE_RULE[point_inj;]);
+  USE 2 (CONV_RULE (dropq_conv "r'"));
+  REWR 3;
+  USE 3 (REWRITE_RULE[point_inj;]);
+  USE 3 (CONV_RULE (dropq_conv "r'"));
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let squc_closed = prove_by_refinement(
+  `!p. closed_ (top2) (squc p)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  ASSUME_TAC top2_top;
+  REWRITE_TAC[squc_inter];
+  ASM_SIMP_TAC[closed_inter2;closed_half_plane2D_LTS_closed;closed_half_plane2D_SLT_closed;closed_half_plane2D_LTF_closed;closed_half_plane2D_FLT_closed];
+  ]);;
+  (* }}} *)
+
+let squ_subset_sqc = prove_by_refinement(
+  `!p. (squ p SUBSET (squc p))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[SUBSET;squ;squc];
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  TYPE_THEN `u` EXISTS_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_MESON_TAC[REAL_ARITH `x < y ==> x <=. y`];
+  ]);;
+  (* }}} *)
+
+let squc_union_lemma1 = prove_by_refinement(
+  `!p. squc p INTER
+     {z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} =
+   {(pointI p)} UNION (v_edge p) UNION {(pointI (up p))}`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[squc;UNION ;INR IN_SING ;INTER ;up; int_of_num_th; int_add_th;];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  REWR 1;
+  USE 1(REWRITE_RULE[point_inj]);
+  USE 1(CONV_RULE (dropq_conv "r"));
+  UND 0;
+  DISCH_ALL_TAC;
+  UND 4;
+  UND 5;
+  REWRITE_TAC[REAL_ARITH `(x <=y) <=> (y = x) \/ (x <. y)`];
+  KILL 2;
+  KILL 3;
+  KILL 0;
+  USE 1 (GSYM);
+  ASM_REWRITE_TAC[];
+  KILL 0;
+  REP_CASES_TAC;
+  ASM_MESON_TAC[REAL_ARITH `~(v = v + &.1)`];
+  EXPAND_TAC "v";
+  REWRITE_TAC[pointI;int_suc;];
+  ASM_REWRITE_TAC[pointI];
+  REWRITE_TAC[v_edge];
+  DISJ2_TAC ;
+  DISJ1_TAC ;
+  REWRITE_TAC[point_inj; PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v'");
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[int_suc];
+  REP_CASES_TAC;
+  ASM_REWRITE_TAC[pointI;point_inj;];
+  CONJ_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  REAL_ARITH_TAC ;
+  CONV_TAC (dropq_conv "r");
+  USE 0 (REWRITE_RULE[v_edge]);
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[point_inj];
+  CONJ_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v'");
+  AND  0;
+  UND 0;
+  REWRITE_TAC[int_suc];
+  REAL_ARITH_TAC ;
+  CONV_TAC (dropq_conv "r");
+  (* LAST *)
+  ASM_REWRITE_TAC[pointI;point_inj;];
+  CONJ_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  REWRITE_TAC[int_suc];
+  REAL_ARITH_TAC ;
+  CONV_TAC (dropq_conv "r");
+  ]);;
+  (* }}} *)
+
+let squc_union_lemma2 = prove_by_refinement(
+  `!p. squc p INTER
+     {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} =
+   {(pointI (right  p))} UNION (v_edge (right  p)) UNION
+     {(pointI (up (right  p)))}`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[squc;right  ;UNION ;INR IN_SING ;INTER ;up; int_of_num_th; int_add_th;];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  REWR 1;
+  USE 1(REWRITE_RULE[point_inj]);
+  USE 1(CONV_RULE (dropq_conv "r"));
+  UND 0;
+  DISCH_ALL_TAC;
+  UND 4;
+  UND 5;
+  REWRITE_TAC[REAL_ARITH `(x <=y) <=> (y = x) \/ (x <. y)`];
+  KILL 2;
+  KILL 3;
+  KILL 0;
+  USE 1 (GSYM);
+  ASM_REWRITE_TAC[];
+  KILL 0;
+  REP_CASES_TAC;
+  ASM_MESON_TAC[REAL_ARITH `~(v = v + &.1)`];
+  EXPAND_TAC "v";
+  REWRITE_TAC[pointI;int_suc;];
+  (* 3 LEFT *)
+  ASM_REWRITE_TAC[pointI;int_suc;];
+  (* 2 LEFT *)
+  REWRITE_TAC[v_edge];
+  DISJ2_TAC ;
+  DISJ1_TAC ;
+  REWRITE_TAC[point_inj; PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u");
+  REWRITE_TAC[int_suc];
+  CONV_TAC (dropq_conv "v'");
+  ASM_REWRITE_TAC[];
+  (* second half  *)
+  ASM_REWRITE_TAC[int_suc];
+  REP_CASES_TAC;
+  ASM_REWRITE_TAC[pointI;point_inj;];
+  CONJ_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  ASM_REWRITE_TAC[int_suc];
+  REAL_ARITH_TAC ;
+  CONV_TAC (dropq_conv "r");
+  REWRITE_TAC[int_suc];
+  (* 2 LEFT *)
+  USE 0 (REWRITE_RULE[v_edge]);
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[point_inj];
+  CONJ_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v'");
+  AND  0;
+  UND 0;
+  REWRITE_TAC[int_suc];
+  REAL_ARITH_TAC ;
+  CONV_TAC (dropq_conv "r");
+  REWRITE_TAC[int_suc];
+  (* LAST *)
+  ASM_REWRITE_TAC[pointI;point_inj;];
+  CONJ_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  REWRITE_TAC[int_suc];
+  REAL_ARITH_TAC ;
+  CONV_TAC (dropq_conv "r");
+  REWRITE_TAC[int_suc];
+  ]);;
+  (* }}} *)
+
+let squc_union_lemma3 = prove_by_refinement(
+  `!p. squc p INTER
+    {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\
+       (real_of_int(FST p) <. FST r) } =
+    (h_edge p) UNION squ p UNION (h_edge (up p))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INTER;squc;UNION;];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[point_inj]);
+  USE 1 (CONV_RULE (dropq_conv "r"));
+  AND 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  KILL  0;
+  KILL  3;
+  UND 4;
+  UND 5;
+  REWRITE_TAC[REAL_ARITH `(x <= y) <=> (y = x) \/ (x <. y)`;int_suc];
+  REP_CASES_TAC;
+  ASM_MESON_TAC[REAL_ARITH `~(v = v + &1)`];
+  EXPAND_TAC "v";
+  REWRITE_TAC[up;h_edge];
+  DISJ2_TAC;
+  DISJ2_TAC;
+  REWRITE_TAC[point_inj;];
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u'");
+  CONV_TAC (dropq_conv "v");
+  ASM_REWRITE_TAC[int_suc];
+  (* 3 to go *)
+  ASM_REWRITE_TAC[];
+  DISJ1_TAC;
+  REWRITE_TAC[h_edge;point_inj;PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u'");
+  CONV_TAC (dropq_conv "v");
+  ASM_REWRITE_TAC[int_suc];
+  (* 2 to go *)
+  DISJ2_TAC;
+  DISJ1_TAC;
+  REWRITE_TAC[squ;point_inj;PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u'");
+  CONV_TAC (dropq_conv "v'");
+  ASM_REWRITE_TAC[int_suc];
+  (* 2nd half *)
+  DISCH_TAC;
+  TYPE_THEN `?q. x = point q` ASM_CASES_TAC;
+  CHO 1;
+  ASM_REWRITE_TAC[point_inj];
+  CONJ_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  REWR 0;
+  UND 0;
+  REWRITE_TAC[h_edge;squ;up;int_suc ;point_inj; PAIR_SPLIT ;];
+  REP_CASES_TAC;
+  USE 0 (CONV_RULE (dropq_conv "u"));
+  USE 0 (CONV_RULE (dropq_conv "v"));
+  UND 0;
+  REAL_ARITH_TAC ;
+  USE 0 (CONV_RULE (dropq_conv "u"));
+  USE 0 (CONV_RULE (dropq_conv "v"));
+  UND 0;
+  REAL_ARITH_TAC ;
+  USE 0 (CONV_RULE (dropq_conv "u"));
+  USE 0 (CONV_RULE (dropq_conv "v"));
+  UND 0;
+  REAL_ARITH_TAC ;
+  CONV_TAC (dropq_conv "r");
+  REWR 0;
+  UND 0;
+  REWRITE_TAC[h_edge;squ;up;int_suc ;point_inj; PAIR_SPLIT ;];
+  REP_CASES_TAC;
+  USE 0 (CONV_RULE (dropq_conv "u"));
+  USE 0 (CONV_RULE (dropq_conv "v"));
+  UND 0;
+  REAL_ARITH_TAC ;
+  USE 0 (CONV_RULE (dropq_conv "u"));
+  USE 0 (CONV_RULE (dropq_conv "v"));
+  UND 0;
+  REAL_ARITH_TAC ;
+  USE 0 (CONV_RULE (dropq_conv "u"));
+  USE 0 (CONV_RULE (dropq_conv "v"));
+  UND 0;
+  REAL_ARITH_TAC ;
+  (* 1 goal LEFT *)
+  PROOF_BY_CONTR_TAC;
+  KILL 2;
+  UND 1;
+  REWRITE_TAC[];
+  IMATCH_MP_TAC  point_onto;
+  ASM_MESON_TAC[h_edge_euclid;squ_euclid;v_edge_euclid;ISUBSET ];
+  ]);;
+  (* }}} *)
+
+let squc_lemma4 = prove_by_refinement(
+  `!p. squc p SUBSET
+    {z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} UNION
+     {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} UNION
+      {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\
+       (real_of_int(FST p) <. FST r) } `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;UNION ;squc ];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[point_inj ;];
+  LEFT_TAC "r";
+  CONV_TAC (dropq_conv "r");
+  UND 0;
+  DISCH_ALL_TAC;
+  UND 1;
+  UND 2;
+  ASM_REWRITE_TAC[int_suc];
+  REAL_ARITH_TAC ;
+  ]);;
+  (* }}} *)
+
+let squc_union = prove_by_refinement(
+  `!p. squc p = {(pointI p)} UNION {(pointI (right  p))} UNION
+       {(pointI (up p))} UNION {(pointI (up (right   p)))} UNION
+       (h_edge p) UNION (h_edge (up p)) UNION
+       (v_edge p) UNION (v_edge (right  p)) UNION
+       (squ p)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  TYPE_THEN `squc p = squc p  INTER ({z | ?r. (z = point r) /\ (real_of_int(FST p) = FST r)} UNION   {z | ?r. (z = point r) /\ (real_of_int(FST p) + &1= FST r )} UNION   {z | ?r. (z = point r) /\ (FST r <. real_of_int(FST p) + &1 ) /\  (real_of_int(FST p) <. FST r) } )` SUBGOAL_TAC;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  REWRITE_TAC  [GSYM SUBSET_INTER_ABSORPTION];
+  MATCH_ACCEPT_TAC squc_lemma4;
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[squc_union_lemma1;squc_union_lemma2;squc_union_lemma3];
+  REWRITE_TAC[UNION_ACI];
+  ]);;
+  (* }}} *)
+
+let squ_closure_h = prove_by_refinement(
+  `!p. (h_edge p) SUBSET (closure top2 (squ p))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[top2];
+  IMATCH_MP_TAC  closure_segment;
+  ASM_REWRITE_TAC[squ_euclid];
+  TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  point_onto;
+  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] h_edge_euclid];
+  DISCH_TAC;
+  CHO 1;
+  REWR 0;
+  KILL 1;
+  TYPE_THEN `point (FST q, SND q + &1)` EXISTS_TAC;
+  REWRITE_TAC[point_scale;point_add;];
+  UND 0;
+  TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
+  REWRITE_TAC[];
+  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
+  PURE_REWRITE_TAC[point_add;point_scale];
+  REWRITE_TAC[h_edge;squ;point_inj;PAIR_SPLIT;];
+  DISCH_ALL_TAC;
+  USE 0 (CONV_RULE (dropq_conv "u"));
+  USE 0 (CONV_RULE (dropq_conv "v"));
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  UND 0;
+  REWRITE_TAC[int_suc];
+  ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ASSUME_TAC (real_poly_conv `t *(y + &1) + (&1- t)* y`);
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  UND 1;
+  UND 2;
+  REDUCE_TAC ;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let squ_closure_up_h = prove_by_refinement(
+  `!p. (h_edge (up   p)) SUBSET (closure top2 (squ p))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;up  ];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[top2];
+  IMATCH_MP_TAC  closure_segment;
+  ASM_REWRITE_TAC[squ_euclid];
+  TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  point_onto;
+  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] h_edge_euclid];
+  DISCH_TAC;
+  CHO 1;
+  REWR 0;
+  KILL 1;
+  TYPE_THEN `point (FST q , SND q - &1)` EXISTS_TAC;
+  REWRITE_TAC[point_scale;point_add;];
+  UND 0;
+  TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
+  REWRITE_TAC[];
+  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
+  PURE_REWRITE_TAC[point_add;point_scale];
+  REWRITE_TAC[h_edge;squ;point_inj;PAIR_SPLIT;];
+  DISCH_ALL_TAC;
+  USE 0 (CONV_RULE (dropq_conv "u"));
+  USE 0 (CONV_RULE (dropq_conv "v"));
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  UND 0;
+  REWRITE_TAC[int_suc];
+  ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ASSUME_TAC (real_poly_conv `t *(y - &1) + (&1- t)* y`);
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  UND 1;
+  UND 2;
+  REDUCE_TAC ;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let squ_closure_down_h = prove_by_refinement(
+  `!p. (h_edge p SUBSET (closure top2 (squ (down p))))`,
+  (* {{{ proof *)
+
+  [
+  GEN_TAC;
+  ASSUME_TAC squ_closure_up_h ;
+  TSPEC `down p` 0;
+  USE 0 (REWRITE_RULE [right_left]);
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let squ_closure_v = prove_by_refinement(
+  `!p. (v_edge p) SUBSET (closure top2 (squ p))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[top2];
+  IMATCH_MP_TAC  closure_segment;
+  ASM_REWRITE_TAC[squ_euclid];
+  TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  point_onto;
+  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] v_edge_euclid];
+  DISCH_TAC;
+  CHO 1;
+  REWR 0;
+  KILL 1;
+  TYPE_THEN `point (FST q + &1, SND q )` EXISTS_TAC;
+  REWRITE_TAC[point_scale;point_add;];
+  UND 0;
+  TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
+  REWRITE_TAC[];
+  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
+  PURE_REWRITE_TAC[point_add;point_scale];
+  REWRITE_TAC[v_edge;squ;point_inj;PAIR_SPLIT;];
+  DISCH_ALL_TAC;
+  USE 0 (CONV_RULE (dropq_conv "u"));
+  USE 0 (CONV_RULE (dropq_conv "v"));
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  UND 0;
+  REWRITE_TAC[int_suc];
+  ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ASSUME_TAC (real_poly_conv `t *(y + &1) + (&1- t)* y`);
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  UND 1;
+  UND 2;
+  REDUCE_TAC ;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let squ_closure_right_v = prove_by_refinement(
+  `!p. (v_edge (right     p)) SUBSET (closure top2 (squ p))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;right    ];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[top2];
+  IMATCH_MP_TAC  closure_segment;
+  ASM_REWRITE_TAC[squ_euclid];
+  TYPE_THEN `?q. (x = point q)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  point_onto;
+  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] v_edge_euclid];
+  DISCH_TAC;
+  CHO 1;
+  REWR 0;
+  KILL 1;
+  TYPE_THEN `point (FST q - &1 , SND q )` EXISTS_TAC;
+  REWRITE_TAC[point_scale;point_add;];
+  UND 0;
+  TYPE_THEN `point q = point (FST q,SND q)` SUBGOAL_TAC;
+  REWRITE_TAC[];
+  DISCH_THEN (fun t-> PURE_REWRITE_TAC [t]);
+  PURE_REWRITE_TAC[point_add;point_scale];
+  REWRITE_TAC[v_edge;squ;point_inj;PAIR_SPLIT;];
+  DISCH_ALL_TAC;
+  USE 0 (CONV_RULE (dropq_conv "u"));
+  USE 0 (CONV_RULE (dropq_conv "v"));
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  UND 0;
+  REWRITE_TAC[int_suc];
+  ASSUME_TAC (real_poly_conv `t *x + (&1 - t)* x`);
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ASSUME_TAC (real_poly_conv `t *(y - &1) + (&1- t)* y`);
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  UND 1;
+  UND 2;
+  REDUCE_TAC ;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let squ_closure_left_v  = prove_by_refinement(
+  `!p. (v_edge p SUBSET (closure top2 (squ (left  p))))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  ASSUME_TAC squ_closure_right_v;
+  TSPEC `left  p` 0;
+  USE 0 (REWRITE_RULE[right_left]);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let squ_closure_hc = prove_by_refinement(
+  `!p. (hc_edge p) SUBSET (closure top2 (squ p))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[GSYM h_edge_closure];
+  IMATCH_MP_TAC  closure_subset;
+  ASSUME_TAC top2_top;
+  ASM_REWRITE_TAC[squ_closure_h];
+  IMATCH_MP_TAC  closure_closed;
+  ASM_REWRITE_TAC[top2_unions;squ_euclid];
+  ]);;
+
+  (* }}} *)
+
+let squ_closure_up_hc = prove_by_refinement(
+  `!p. (hc_edge (up p)) SUBSET (closure top2 (squ p))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[GSYM h_edge_closure];
+  IMATCH_MP_TAC  closure_subset;
+  ASSUME_TAC top2_top;
+  ASM_REWRITE_TAC[squ_closure_up_h];
+  IMATCH_MP_TAC  closure_closed;
+  ASM_REWRITE_TAC[top2_unions;squ_euclid];
+  ]);;
+  (* }}} *)
+
+let squ_closure_vc = prove_by_refinement(
+  `!p. (vc_edge p) SUBSET (closure top2 (squ p))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[GSYM v_edge_closure];
+  IMATCH_MP_TAC  closure_subset;
+  ASSUME_TAC top2_top;
+  ASM_REWRITE_TAC[squ_closure_v];
+  IMATCH_MP_TAC  closure_closed;
+  ASM_REWRITE_TAC[top2_unions;squ_euclid];
+  ]);;
+  (* }}} *)
+
+let squ_closure = prove_by_refinement(
+  `!p. (closure top2 (squ p)) = (squc p)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  ASSUME_TAC top2_top;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  closure_subset;
+  ASM_REWRITE_TAC[squc_closed];
+  REWRITE_TAC[squc_union];
+  REWRITE_TAC[SUBSET;UNION];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[squc_union];
+  REWRITE_TAC[union_subset];
+  ASSUME_TAC squ_closure_hc;
+  TSPEC `p` 1;
+  ASSUME_TAC squ_closure_up_hc;
+  TSPEC `p` 2;
+  USE 1 (REWRITE_RULE[hc_edge;plus_e12;union_subset]);
+  USE 2 (REWRITE_RULE[hc_edge;plus_e12;up;union_subset]);
+  ASM_REWRITE_TAC [up;right;squ_closure_v;REWRITE_RULE[right  ] squ_closure_right_v  ];
+  ASM_SIMP_TAC[subset_closure];
+  ]);;
+
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* adj_edge *)
+(* ------------------------------------------------------------------ *)
+
+
+let adj_edge = jordan_def `adj_edge x y <=> (~(x = y)) /\
+  (?e. (edge e) /\
+   (e SUBSET (closure top2 x)) /\ (e SUBSET (closure top2 y)))`;;
+
+let adj_edge_sym = prove_by_refinement(
+  `!x y. (adj_edge x y = adj_edge y x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[adj_edge];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let adj_edge_left = prove_by_refinement(
+  `!m. (adj_edge (squ m) (squ (left  m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[adj_edge];
+  REWRITE_TAC[squ_closure;squ_inj;];
+  CONJ_TAC;
+  REWRITE_TAC[left ;PAIR_SPLIT;];
+  INT_ARITH_TAC;
+  TYPE_THEN `v_edge m` EXISTS_TAC;
+  REWRITE_TAC[edge;v_edge_inj;];
+  CONV_TAC (dropq_conv "m'");
+  REWRITE_TAC[squc_union; SUBSET;UNION ;];
+  REWRITE_TAC[right_left];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let adj_edge_right = prove_by_refinement(
+  `!m. (adj_edge (squ m) (squ (right    m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[adj_edge];
+  REWRITE_TAC[squ_closure;squ_inj;];
+  CONJ_TAC;
+  REWRITE_TAC[right   ;PAIR_SPLIT;];
+  INT_ARITH_TAC;
+  TYPE_THEN `v_edge (right  m)` EXISTS_TAC;
+  REWRITE_TAC[edge;v_edge_inj;];
+  CONV_TAC (dropq_conv "m'");
+  REWRITE_TAC[squc_union; SUBSET;UNION ;];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let adj_edge_down = prove_by_refinement(
+  `!m. (adj_edge (squ m) (squ (down  m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[adj_edge];
+  REWRITE_TAC[squ_closure;squ_inj;];
+  CONJ_TAC;
+  REWRITE_TAC[down ;PAIR_SPLIT;];
+  INT_ARITH_TAC;
+  TYPE_THEN `h_edge m` EXISTS_TAC;
+  REWRITE_TAC[edge;h_edge_inj;];
+  CONV_TAC (dropq_conv "m'");
+  REWRITE_TAC[squc_union; SUBSET;UNION ;];
+  REWRITE_TAC[right_left];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let adj_edge_right = prove_by_refinement(
+  `!m. (adj_edge (squ m) (squ (up    m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[adj_edge];
+  REWRITE_TAC[squ_closure;squ_inj;];
+  CONJ_TAC;
+  REWRITE_TAC[up   ;PAIR_SPLIT;];
+  INT_ARITH_TAC;
+  TYPE_THEN `h_edge (up  m)` EXISTS_TAC;
+  REWRITE_TAC[edge;h_edge_inj;];
+  CONV_TAC (dropq_conv "m'");
+  REWRITE_TAC[squc_union; SUBSET;UNION ;];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* components  *)
+(* ------------------------------------------------------------------ *)
+
+let rectangle_euclid = prove_by_refinement(
+  `!p q. (rectangle p q SUBSET (euclid 2))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[rectangle;SUBSET ;];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  ASM_REWRITE_TAC[euclid_point];
+  ]);;
+  (* }}} *)
+
+let component_unions = prove_by_refinement(
+  `!U (x:A). (component  U x SUBSET (UNIONS U))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET; component_DEF; connected ;];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_h_rect = prove_by_refinement(
+  `!G m x. (segment G /\
+     (h_edge m SUBSET component  (ctop G) x)) ==>
+   (rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1)
+       SUBSET component  (ctop G) x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC   convex_component;
+  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
+  CONJ_TAC;
+  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
+  REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;];
+  DISCH_ALL_TAC;
+  AND 2;
+  TYPE_THEN `~(squ (down m) x') /\ ~(squ m x')` SUBGOAL_TAC;
+  USE 0(MATCH_MP curve_cell_squ_inter);
+  COPY 0;
+  TSPEC `m` 0;
+  TSPEC `down m` 4;
+  UND 4;
+  UND 0;
+  REWRITE_TAC [EQ_EMPTY; INTER];
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  REWR 3;
+  TYPE_THEN `h_edge m SUBSET (UNIONS (ctop G))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `component  (ctop G) x` EXISTS_TAC;
+  ASM_REWRITE_TAC[component_unions];
+  REWRITE_TAC[ctop_unions ;DIFF_SUBSET; EQ_EMPTY ; h_edge_euclid; INTER;];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[rectangle_h; EMPTY_EXISTS; UNION ; INTER;];
+  USE 1 (REWRITE_RULE[SUBSET]);
+  TYPE_THEN `~(h_edge m = EMPTY)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  cell_nonempty;
+  REWRITE_TAC[cell_rules];
+  REWRITE_TAC[EMPTY_EXISTS];
+  DISCH_TAC;
+  CHO 2;
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_v_rect = prove_by_refinement(
+  `!G m x. (segment G /\
+     (v_edge m SUBSET component  (ctop G) x)) ==>
+   (rectangle (FST m -: &:1, SND m ) (FST m +: &:1,SND m +: &:1)
+       SUBSET component  (ctop G) x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC   convex_component;
+  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
+  CONJ_TAC;
+  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
+  REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;];
+  DISCH_ALL_TAC;
+  AND 2;
+  TYPE_THEN `~(squ (left   m) x') /\ ~(squ m x')` SUBGOAL_TAC;
+  USE 0(MATCH_MP curve_cell_squ_inter);
+  COPY 0;
+  TSPEC `m` 0;
+  TSPEC `left   m` 4;
+  UND 4;
+  UND 0;
+  REWRITE_TAC [EQ_EMPTY; INTER];
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  REWR 3;
+  TYPE_THEN `v_edge m SUBSET (UNIONS (ctop G))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `component  (ctop G) x` EXISTS_TAC;
+  ASM_REWRITE_TAC[component_unions];
+  REWRITE_TAC[ctop_unions ;DIFF_SUBSET; EQ_EMPTY ; v_edge_euclid; INTER;];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[rectangle_v; EMPTY_EXISTS; UNION ; INTER;];
+  USE 1 (REWRITE_RULE[SUBSET]);
+  TYPE_THEN `~(v_edge m = EMPTY)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  cell_nonempty;
+  REWRITE_TAC[cell_rules];
+  REWRITE_TAC[EMPTY_EXISTS];
+  DISCH_TAC;
+  CHO 2;
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let long_v_convex = prove_by_refinement(
+  `!p. (convex (long_v p))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[long_v_inter];
+  GEN_TAC;
+  IMATCH_MP_TAC  convex_inter;
+  REWRITE_TAC[line2D_F_convex];
+  IMATCH_MP_TAC  convex_inter;
+  REWRITE_TAC[open_half_plane2D_LTS_convex;open_half_plane2D_SLT_convex];
+  ]);;
+  (* }}} *)
+
+let long_v_euclid = prove_by_refinement(
+  `!p. (long_v p SUBSET (euclid 2))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[long_v_union;union_subset;v_edge_euclid;single_subset;pointI;euclid_point];
+  ]);;
+  (* }}} *)
+
+let comp_pointI_long = prove_by_refinement(
+  `!G m x. (segment G /\ component  (ctop G) x (pointI m)) ==>
+   (long_v m SUBSET component  (ctop G) x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  convex_component;
+  ASM_REWRITE_TAC[long_v_convex;ctop_unions;DIFF_SUBSET;long_v_euclid];
+  CONJ_TAC;
+  REWRITE_TAC[long_v_union;EQ_EMPTY;UNION;INTER];
+  GEN_TAC;
+  TYPE_THEN `UNIONS (ctop G) (pointI m)` SUBGOAL_TAC;
+  ASSUME_TAC (ISPEC `(ctop G)` component_unions);
+  ASM_MESON_TAC[ISUBSET];
+  REWRITE_TAC[ctop_unions;DIFF ;];
+  DISCH_ALL_TAC;
+  AND 2;
+  TYPE_THEN `~(curve_cell G {(pointI m)})` SUBGOAL_TAC;
+  USE 4(REWRITE_RULE[UNIONS]);
+  LEFT 4 "u";
+  TSPEC `{(pointI m)}` 4;
+  USE 4(REWRITE_RULE [INR IN_SING;]);
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[curve_cell_not_point;];
+  TYPE_THEN `FINITE G` SUBGOAL_TAC;
+  ASM_SIMP_TAC[segment_finite];
+  ASM_SIMP_TAC[num_closure0];
+  DISCH_TAC;
+  UND 5;
+  REP_CASES_TAC; (* cases *)
+  TYPE_THEN `~(v_edge (down m) INTER  UNIONS (curve_cell G) = EMPTY)` SUBGOAL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  ASM_MESON_TAC[];
+  ASM_SIMP_TAC[curve_cell_v_inter];
+  DISCH_ALL_TAC;
+  TSPEC `v_edge (down m)` 5;
+  UND 5;
+  ASM_REWRITE_TAC[v_edge_closure;vc_edge;plus_e12;UNION; INR IN_SING; pointI_inj; down; PAIR_SPLIT ; INT_ARITH `x = x -: &:1 +: &:1`;];
+  (* next case *)
+  USE 7 (REWRITE_RULE[INR IN_SING]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `~(v_edge (m) INTER  UNIONS (curve_cell G) = EMPTY)` SUBGOAL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  ASM_MESON_TAC[];
+  ASM_SIMP_TAC[curve_cell_v_inter];
+  DISCH_ALL_TAC;
+  TSPEC `v_edge (m)` 5;
+  UND 5;
+  ASM_REWRITE_TAC[v_edge_closure;vc_edge;plus_e12;UNION; INR IN_SING; pointI_inj; down; PAIR_SPLIT ; INT_ARITH `x = x -: &:1 +: &:1`;];
+  (* LAST *)
+  REWRITE_TAC[long_v_union;EMPTY_EXISTS;];
+  TYPE_THEN `(pointI m)` EXISTS_TAC;
+  ASM_REWRITE_TAC[INTER;UNION;INR IN_SING;];
+  ]);;
+  (* }}} *)
+
+let comp_h_squ = prove_by_refinement(
+  `!G x m. (segment G /\ (h_edge m SUBSET (component  (ctop G) x)) ==>
+     (squ m SUBSET (component  (ctop G ) x)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC;
+  IMATCH_MP_TAC comp_h_rect;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[rectangle_h];
+  REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_v_squ = prove_by_refinement(
+  `!G x m. (segment G /\ (v_edge m SUBSET (component  (ctop G) x)) ==>
+     (squ m SUBSET (component  (ctop G ) x)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `(rectangle (FST m -: &:1 , SND m ) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC;
+  IMATCH_MP_TAC comp_v_rect;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `rectangle (FST m -: &:1 ,SND m) (FST m +: &:1,SND m +: &:1)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[rectangle_v];
+  REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_p_squ = prove_by_refinement(
+  `!G x m. (segment G /\ (component  (ctop G) x (pointI m))) ==>
+     (squ m SUBSET (component  (ctop G ) x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `long_v m SUBSET component  (ctop G) x` SUBGOAL_TAC;
+  IMATCH_MP_TAC comp_pointI_long;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[long_v_union];
+  REWRITE_TAC[union_subset];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  comp_v_squ;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_squ = prove_by_refinement(
+  `!G x. (segment G /\ (~(component  (ctop G) x = EMPTY)) ==>
+     (?m. (squ m SUBSET (component  (ctop G ) x))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  COPY 0;
+  USE 0 (MATCH_MP unions_cell_of);
+  TSPEC `x` 0;
+  USE 0 (SYM);
+  USE 1 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 1;
+  UND 0;
+  DISCH_THEN (fun t-> USE 1 (ONCE_REWRITE_RULE[t]));
+  USE 0 (REWRITE_RULE[cell_of;UNIONS]);
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  USE 0 (REWRITE_RULE[cell]);
+  CHO 0;
+  UND 0;
+  REP_CASES_TAC;
+  REWR 1;
+  USE 1 (REWRITE_RULE[single_subset]);
+  ASM_MESON_TAC[comp_p_squ];
+  ASM_MESON_TAC[comp_h_squ];
+  ASM_MESON_TAC[comp_v_squ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_squ_left_rect_v = prove_by_refinement(
+  `!G m x. (segment G /\ ~(G (v_edge (  m))) /\
+    (squ m SUBSET component (ctop G) x) ==>
+   (rectangle (FST m -: &:1 ,SND m ) (FST m +: &:1,SND m +: &:1) SUBSET
+ component (ctop G) x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  UND 1;
+  ASM_SIMP_TAC[GSYM curve_cell_v];
+  DISCH_TAC;
+  (*  *)
+  IMATCH_MP_TAC   convex_component;
+  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
+  CONJ_TAC;
+  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
+  REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;];
+  DISCH_ALL_TAC;
+  AND 3;
+  TYPE_THEN `~(squ (left   m) x') /\ ~(squ m x')` SUBGOAL_TAC;
+  USE 0(MATCH_MP curve_cell_squ_inter);
+  COPY 0;
+  TSPEC `m` 0;
+  TSPEC `left   m` 5;
+  UND 5;
+  UND 0;
+  REWRITE_TAC [EQ_EMPTY; INTER];
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  REWR 4;
+  USE 3 (REWRITE_RULE[UNIONS;]);
+  CHO 3;
+  TYPE_THEN `cell u` SUBGOAL_TAC;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  ASM_MESON_TAC[ISUBSET; curve_cell_cell];
+  DISCH_TAC;
+  TYPE_THEN `u = v_edge m ` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[rectangle_v;EMPTY_EXISTS;];
+  TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
+  ASM_MESON_TAC[cell_nonempty;cell_rules];
+  REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
+  USE 2(REWRITE_RULE[ISUBSET]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_squ_left_rect = prove_by_refinement(
+  `!G m x. (segment G /\
+    (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
+         (squ p SUBSET (component  (ctop G) x))))) /\
+     (squ m SUBSET component  (ctop G) x)) ==>
+   (rectangle (FST m -: &:1, SND m ) (FST m +: &:1,SND m +: &:1)
+       SUBSET component  (ctop G) x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  LEFT 1 "p";
+  TSPEC `m` 1;
+  LEFT 1 "e";
+  TSPEC `v_edge m` 1;
+  REWR 1;
+  USE 1(REWRITE_RULE[squ_closure_v]);
+  IMATCH_MP_TAC  comp_squ_left_rect_v;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_squ_right_rect_v = prove_by_refinement(
+  `!G m x. (segment G /\ ~(G (v_edge (right  m))) /\
+    (squ m SUBSET component (ctop G) x) ==>
+   (rectangle (FST m,SND m ) (FST m +: &:2,SND m +: &:1) SUBSET
+ component (ctop G) x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  UND 1;
+  ASM_SIMP_TAC[GSYM curve_cell_v];
+  DISCH_TAC;
+  (*  *)
+  IMATCH_MP_TAC   convex_component;
+  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
+  TYPE_THEN `rectangle m (FST m +: &:2,SND m +: &:1) = rectangle (FST (right  m) -: &:1, SND (right  m)) (FST (right  m) +: &:1, SND (right  m) +: &:1)` SUBGOAL_TAC;
+  REWRITE_TAC[right ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
+  DISCH_THEN_REWRITE;
+  CONJ_TAC;
+  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
+  REWRITE_TAC[rectangle_v; EQ_EMPTY ;UNION ; INTER;];
+  DISCH_ALL_TAC;
+  AND 3;
+  USE 4 (REWRITE_RULE[right_left]);
+  TYPE_THEN `~(squ  m x') /\ ~(squ (right  m) x')` SUBGOAL_TAC;
+  USE 0(MATCH_MP curve_cell_squ_inter);
+  COPY 0;
+  TSPEC `m` 0;
+  TSPEC `right   m` 5;
+  UND 5;
+  UND 0;
+  REWRITE_TAC [EQ_EMPTY; INTER];
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  REWR 4;
+  USE 3 (REWRITE_RULE[UNIONS;]);
+  CHO 3;
+  TYPE_THEN `cell u` SUBGOAL_TAC;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  ASM_MESON_TAC[ISUBSET; curve_cell_cell];
+  DISCH_TAC;
+  TYPE_THEN `u = v_edge (right  m) ` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[rectangle_v;EMPTY_EXISTS;];
+  REWRITE_TAC[right_left];
+  TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
+  ASM_MESON_TAC[cell_nonempty;cell_rules];
+  REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
+  USE 2(REWRITE_RULE[ISUBSET]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_squ_right_rect = prove_by_refinement(
+  `!G m x. (segment G /\
+    (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
+         (squ p SUBSET (component  (ctop G) x))))) /\
+     (squ m SUBSET component  (ctop G) x)) ==>
+   (rectangle (FST m , SND m ) (FST m +: &:2,SND m +: &:1)
+       SUBSET component  (ctop G) x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  LEFT 1 "p";
+  TSPEC `m` 1;
+  LEFT 1 "e";
+  TSPEC `v_edge (right  m)` 1;
+  REWR 1;
+  USE 1(REWRITE_RULE[squ_closure_right_v]);
+  IMATCH_MP_TAC  comp_squ_right_rect_v;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_squ_down_rect_h = prove_by_refinement(
+  `!G m x. (segment G /\ ~(G (h_edge m)) /\
+    (squ m SUBSET component (ctop G) x) ==>
+   (rectangle (FST m,SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET
+ component (ctop G) x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  UND 1;
+  ASM_SIMP_TAC[GSYM curve_cell_h];
+  DISCH_TAC;
+  (*  *)
+  IMATCH_MP_TAC   convex_component;
+  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
+  CONJ_TAC;
+  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
+  REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;];
+  DISCH_ALL_TAC;
+  AND 3;
+  TYPE_THEN `~(squ (down   m) x') /\ ~(squ m x')` SUBGOAL_TAC;
+  USE 0(MATCH_MP curve_cell_squ_inter);
+  COPY 0;
+  TSPEC `m` 0;
+  TSPEC `down   m` 5;
+  UND 5;
+  UND 0;
+  REWRITE_TAC [EQ_EMPTY; INTER];
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  REWR 4;
+  USE 3 (REWRITE_RULE[UNIONS;]);
+  CHO 3;
+  TYPE_THEN `cell u` SUBGOAL_TAC;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  ASM_MESON_TAC[ISUBSET; curve_cell_cell];
+  DISCH_TAC;
+  TYPE_THEN `u = h_edge m ` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[rectangle_h;EMPTY_EXISTS;];
+  TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
+  ASM_MESON_TAC[cell_nonempty;cell_rules];
+  REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
+  USE 2(REWRITE_RULE[ISUBSET]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_squ_down_rect = prove_by_refinement(
+  `!G m x. (segment G /\
+    (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
+         (squ p SUBSET (component  (ctop G) x))))) /\
+     (squ m SUBSET component  (ctop G) x)) ==>
+   (rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1)
+       SUBSET component  (ctop G) x)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  LEFT 1 "p";
+  TSPEC `m` 1;
+  LEFT 1 "e";
+  TSPEC `h_edge m` 1;
+  REWR 1;
+  USE 1(REWRITE_RULE[squ_closure_h]);
+  ASM_MESON_TAC[comp_squ_down_rect_h];
+  ]);;
+
+  (* }}} *)
+
+let comp_squ_up_rect_h = prove_by_refinement(
+  `!G m x. (segment G /\ ~(G (h_edge (up m))) /\
+    (squ m SUBSET component (ctop G) x) ==>
+   (rectangle (FST m,SND m ) (FST m +: &:1,SND m +: &:2) SUBSET
+ component (ctop G) x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  UND 1;
+  ASM_SIMP_TAC[GSYM curve_cell_h];
+  DISCH_TAC;
+  (*  *)
+  IMATCH_MP_TAC   convex_component;
+  ASM_REWRITE_TAC[rectangle_convex; ctop_unions;];
+  TYPE_THEN `rectangle m (FST m +: &:1,SND m +: &:2) = rectangle (FST (up  m) , SND (up  m) -: &:1) (FST (up  m) +: &:1, SND (up  m) +: &:1)` SUBGOAL_TAC;
+  REWRITE_TAC[up ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
+  DISCH_THEN_REWRITE;
+  CONJ_TAC;
+  REWRITE_TAC[DIFF_SUBSET;rectangle_euclid];
+  REWRITE_TAC[rectangle_h; EQ_EMPTY ;UNION ; INTER;];
+  DISCH_ALL_TAC;
+  AND 3;
+  USE 4 (REWRITE_RULE[right_left]);
+  TYPE_THEN `~(squ  m x') /\ ~(squ (up  m) x')` SUBGOAL_TAC;
+  USE 0(MATCH_MP curve_cell_squ_inter);
+  COPY 0;
+  TSPEC `m` 0;
+  TSPEC `up   m` 5;
+  UND 5;
+  UND 0;
+  REWRITE_TAC [EQ_EMPTY; INTER];
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  REWR 4;
+  USE 3 (REWRITE_RULE[UNIONS;]);
+  CHO 3;
+  TYPE_THEN `cell u` SUBGOAL_TAC;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  ASM_MESON_TAC[ISUBSET; curve_cell_cell];
+  DISCH_TAC;
+  TYPE_THEN `u = h_edge (up  m) ` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  ASM_REWRITE_TAC[EMPTY_EXISTS;INTER;cell_rules];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[rectangle_h;EMPTY_EXISTS;];
+  REWRITE_TAC[right_left];
+  TYPE_THEN `~(squ m = EMPTY )` SUBGOAL_TAC;
+  ASM_MESON_TAC[cell_nonempty;cell_rules];
+  REWRITE_TAC[EMPTY_EXISTS;UNION;INTER;];
+  USE 2(REWRITE_RULE[ISUBSET]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_squ_up_rect = prove_by_refinement(
+  `!G m x. (segment G /\
+    (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
+         (squ p SUBSET (component  (ctop G) x))))) /\
+     (squ m SUBSET component  (ctop G) x)) ==>
+   (rectangle (FST m , SND m ) (FST m +: &:1,SND m +: &:2)
+       SUBSET component  (ctop G) x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  LEFT 1 "p";
+  TSPEC `m` 1;
+  LEFT 1 "e";
+  TSPEC `h_edge (up  m)` 1;
+  REWR 1;
+  USE 1(REWRITE_RULE[squ_closure_up_h]);
+  IMATCH_MP_TAC  comp_squ_up_rect_h;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_squ_right_left = prove_by_refinement(
+  `!G x m. (segment G /\ (squ m SUBSET (component  (ctop G) x))  /\
+    (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
+         (squ p SUBSET (component  (ctop G) x)))))) ==>
+     (squ (left    m) SUBSET (component  (ctop G) x))  /\
+    (squ (right      m) SUBSET (component  (ctop G) x))  /\
+    (squ (up  m) SUBSET (component  (ctop G) x))  /\
+   (squ (down  m) SUBSET (component  (ctop G) x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  JOIN 2 1;
+  JOIN 0 1;
+  WITH 0 (MATCH_MP comp_squ_up_rect);
+  WITH 0 (MATCH_MP comp_squ_down_rect);
+  WITH 0 (MATCH_MP comp_squ_left_rect);
+  WITH 0 (MATCH_MP comp_squ_right_rect);
+  TYPE_THEN `rectangle m (FST m +: &:1,SND m +: &:2) = rectangle (FST (up  m) , SND (up  m) -: &:1) (FST (up  m) +: &:1, SND (up  m) +: &:1)` SUBGOAL_TAC;
+  REWRITE_TAC[up ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
+  DISCH_THEN (fun t-> USE 1 (REWRITE_RULE[t]));
+  TYPE_THEN `rectangle m (FST m +: &:2,SND m +: &:1) = rectangle (FST (right  m) -: &:1, SND (right  m)) (FST (right  m) +: &:1, SND (right  m) +: &:1)` SUBGOAL_TAC;
+  REWRITE_TAC[right ;INT_ARITH `(x +: &:1)-: &:1 = x`;INT_ARITH `(x +: &:1) +: &:1 = x +: &:2` ];
+  DISCH_THEN (fun t-> USE 4 (REWRITE_RULE[t]));
+  RULE_ASSUM_TAC (REWRITE_RULE[rectangle_h;rectangle_v;union_subset;right_left ]);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+(* move *)
+let suc_sum = prove_by_refinement(
+  `!j a b. (SUC j = a+ b) ==> (?k. (SUC k = a) \/ (SUC k = b))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  PROOF_BY_CONTR_TAC;
+  LEFT 1 "k";
+  USE 1(REWRITE_RULE[DE_MORGAN_THM]);
+  TYPE_THEN `a = 0 ` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  ASM_MESON_TAC[num_CASES];
+  TYPE_THEN `b = 0` SUBGOAL_TAC;
+  ASM_MESON_TAC[num_CASES];
+  UND 0;
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let squ_induct = prove_by_refinement(
+  `!j m n. ?p.
+    ((SUC j) = (num_abs_of_int (FST m -: FST n) +
+             num_abs_of_int (SND  m -: SND  n))) ==>
+    ((j = (num_abs_of_int (FST p -: FST n) +
+             num_abs_of_int (SND  p -: SND  n))) /\
+     ((p = left  m) \/ (p = right  m) \/ (p = up m) \/ (p = down m))) `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  RIGHT_TAC "p";
+  DISCH_TAC;
+  WITH  0 (MATCH_MP suc_sum);
+  CHO 1;
+  UND 1;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `~(num_abs_of_int (FST m -: FST n) = 0)` SUBGOAL_TAC;
+  UND 1;
+  ARITH_TAC;
+  REWRITE_TAC[num_abs_of_int0];
+  DISCH_TAC;
+  TYPE_THEN `FST m <: FST n \/ FST n <: FST m` SUBGOAL_TAC;
+  UND 2;
+  INT_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `right  m` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[right ];
+  ONCE_REWRITE_TAC[GSYM SUC_INJ];
+  REWRITE_TAC[GSYM ADD];
+  TYPE_THEN `(FST m +: &:1) -: FST n <=: &:0` SUBGOAL_TAC;
+  UND 3;
+  INT_ARITH_TAC;
+  ASM_SIMP_TAC[num_abs_of_int_pre];
+  TYPE_THEN `(FST m +: &:1) -: FST n -: &:1 = FST m -: FST n` SUBGOAL_TAC;
+  INT_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  (* next *)
+  TYPE_THEN `left    m` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[left   ];
+  ONCE_REWRITE_TAC[GSYM SUC_INJ];
+  REWRITE_TAC[GSYM ADD];
+  TYPE_THEN `&:0 <=: (FST m -: &:1) -: FST n ` SUBGOAL_TAC;
+  UND 3;
+  INT_ARITH_TAC;
+  ASM_SIMP_TAC[num_abs_of_int_suc];
+  TYPE_THEN `(FST m -: &:1 -: FST n +: &:1) = FST m -: FST n` SUBGOAL_TAC;
+  INT_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  (* next *)
+  TYPE_THEN `~(num_abs_of_int (SND  m -: SND  n) = 0)` SUBGOAL_TAC;
+  UND 1;
+  ARITH_TAC;
+  REWRITE_TAC[num_abs_of_int0];
+  DISCH_TAC;
+  TYPE_THEN `SND  m <: SND  n \/ SND  n <: SND  m` SUBGOAL_TAC;
+  UND 2;
+  INT_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  (* next *)
+  TYPE_THEN `up    m` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[up  ];
+  ONCE_REWRITE_TAC[GSYM SUC_INJ];
+  REWRITE_TAC[GSYM ADD_SUC];
+  TYPE_THEN `(SND  m +: &:1) -: SND  n <=: &:0` SUBGOAL_TAC;
+  UND 3;
+  INT_ARITH_TAC;
+  ASM_SIMP_TAC[num_abs_of_int_pre];
+  TYPE_THEN `((SND  m +: &:1) -: SND  n -: &:1) = SND  m -: SND  n` SUBGOAL_TAC;
+  INT_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  (* final *)
+  TYPE_THEN `down    m` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[down   ];
+  ONCE_REWRITE_TAC[GSYM SUC_INJ];
+  REWRITE_TAC[GSYM ADD_SUC];
+  TYPE_THEN `&:0 <=: (SND  m -: &:1) -: SND  n ` SUBGOAL_TAC;
+  UND 3;
+  INT_ARITH_TAC;
+  ASM_SIMP_TAC[num_abs_of_int_suc];
+  TYPE_THEN `(SND  m -: &:1 -: SND  n +: &:1) = SND  m -: SND  n` SUBGOAL_TAC;
+  INT_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ]);;
+  (* }}} *)
+
+let comp_squ_fill = prove_by_refinement(
+  `!G x m. (segment G /\ (squ m SUBSET (component  (ctop G ) x)) /\
+  (~(?p e. (G e /\ e SUBSET closure top2 (squ p) /\
+         (squ p SUBSET (component  (ctop G) x)))))) ==>
+  (!n. (squ n SUBSET (component  (ctop G) x)))
+  `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  GEN_TAC;
+  TYPE_THEN `(!j n. (j = (num_abs_of_int (FST n -: FST m) + num_abs_of_int (SND  n -: SND  m))) ==> (squ n SUBSET component (ctop G) x)) ==> (squ n SUBSET component (ctop G) x)` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  INDUCT_TAC;
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  REWRITE_TAC[ADD_EQ_0;num_abs_of_int0];
+  GEN_TAC;
+  DISCH_TAC;
+  TYPE_THEN `n = m` SUBGOAL_TAC;
+  UND 3;
+  REWRITE_TAC[PAIR_SPLIT];
+  INT_ARITH_TAC;
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  USE 4 (MATCH_MP (CONV_RULE (quant_right_CONV "p") squ_induct));
+  CHO 4;
+  TSPEC `p` 3;
+  REWR 3;
+  AND 4;
+  TYPE_THEN `(n = left p) \/ (n = right p) \/ (n = up p) \/ (n = down p)` SUBGOAL_TAC;
+  UND 4;
+  REP_CASES_TAC THEN (ASM_REWRITE_TAC[right_left]);
+  KILL 4;
+  KILL 5;
+  KILL 1;
+  JOIN  3 2;
+  JOIN 0 1;
+  USE 0 (MATCH_MP comp_squ_right_left);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let comp_squ_adj = prove_by_refinement(
+  `!G x m. (segment G /\ (squ m SUBSET (component  (ctop G ) x))) ==>
+     (?p e. (G e /\ e SUBSET closure top2 (squ p) /\
+         (squ p SUBSET (component  (ctop G) x))))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `(!n. (squ n SUBSET (component  (ctop G) x)))` SUBGOAL_TAC;
+  ASM_MESON_TAC[comp_squ_fill];
+  DISCH_TAC;
+  TYPE_THEN `?e. (G e /\ (edge e))` SUBGOAL_TAC;
+  USE 0 (REWRITE_RULE [segment;EMPTY_EXISTS;SUBSET;]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  UND 2;
+  REWRITE_TAC[];
+  LEFT_TAC "e";
+  CHO 4;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  AND 2;
+  USE 2(REWRITE_RULE[edge]);
+  CHO 2;
+  UND 2;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `m'` EXISTS_TAC;
+  ASM_REWRITE_TAC[squ_closure_v;squ_closure_h];
+  ASM_MESON_TAC[squ_closure_v;squ_closure_h];
+  ]);;
+
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+
+
+let along_seg = jordan_def `along_seg G e x <=> G e /\
+     (?p. (e SUBSET closure top2 (squ p) /\
+          squ p SUBSET (component  (ctop G) x) ))`;;
+
+let along_lemma1 = prove_by_refinement(
+  `!G m x.  (segment G /\ (squ m SUBSET component  (ctop G) x) /\
+     (G (v_edge m)) /\ (G (h_edge m))) ==>
+   (?p. (h_edge m) SUBSET closure top2 (squ p) /\
+       (squ p SUBSET (component  (ctop G) x)))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `m` EXISTS_TAC;
+  ASM_MESON_TAC[squ_closure_h];
+  ]);;
+
+  (* }}} *)
+
+let midpoint_exclusion = prove_by_refinement(
+  `!G m e e' e''. (segment G /\ G e /\ G e' /\ G e'' /\ (~(e = e')) /\
+    (closure top2 e (pointI m)) /\ (closure top2 e' (pointI m)) /\
+    (closure top2 e'' (pointI m))   ==> ((e'' = e) \/ (e'' = e')))
+    `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  USE 0 (REWRITE_RULE[segment;INSERT; ]);
+  UND 0;
+  DISCH_ALL_TAC;
+  TYPE_THEN `num_closure G (pointI m) = 2` SUBGOAL_TAC;
+  TSPEC `m` 10;
+  UND 10;
+  REP_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  UND 10;
+  USE 0 (MATCH_MP num_closure1);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  CHO 10;
+  COPY 10;
+  TSPEC `e` 12;
+  TSPEC `e'` 10;
+  ASM_MESON_TAC[];
+  USE 0 (MATCH_MP num_closure0);
+  TSPEC `pointI m` 0;
+  REWR 0;
+  TSPEC `e` 0;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  USE 0 (MATCH_MP num_closure_size);
+  TSPEC `pointI m` 0;
+  REWR 0;
+  TYPE_THEN `X = {C | G C /\ closure top2 C (pointI m)}` ABBREV_TAC ;
+  TYPE_THEN `X e /\ X e' /\ X e''` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  UND 0;
+  UND 4;
+  MESON_TAC[two_exclusion];
+  ]);;
+  (* }}} *)
+
+(* indexed to here *)
+let along_lemma2 = prove_by_refinement(
+  `!G m. (segment G /\ G (v_edge m) /\ G (v_edge (down m)) ==>
+     ~(G (h_edge m)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `(h_edge m = v_edge m) \/ (h_edge m = v_edge (down m))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  midpoint_exclusion;
+  TYPE_THEN `G` EXISTS_TAC;
+  TYPE_THEN `m` EXISTS_TAC;
+  ASM_REWRITE_TAC[v_edge_inj;down;v_edge_cpoint;h_edge_cpoint;PAIR_SPLIT;];
+  INT_ARITH_TAC ;
+  REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2];
+  ]);;
+  (* }}} *)
+
+let along_lemma3 = prove_by_refinement(
+  `!G m. (segment G /\ G (v_edge m) /\ G(h_edge (left  m)) ==>
+     ~(G (h_edge m)) /\ ~(G (v_edge (down m))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 3(REWRITE_RULE[]);
+  TYPE_THEN `(h_edge m = v_edge m) \/ (h_edge m = h_edge (left  m))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  midpoint_exclusion;
+  TYPE_THEN `G` EXISTS_TAC;
+  TYPE_THEN `m` EXISTS_TAC;
+  ASM_REWRITE_TAC[v_edge_inj;left;v_edge_cpoint;GSYM hv_edgeV2;h_edge_cpoint;PAIR_SPLIT;];
+  INT_ARITH_TAC ;
+  REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2;left ;h_edge_inj;PAIR_SPLIT;];
+  INT_ARITH_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 3(REWRITE_RULE[]);
+  TYPE_THEN `(h_edge (left  m) = v_edge m) \/ (h_edge (left  m) = v_edge (down m))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  midpoint_exclusion;
+  TYPE_THEN `G` EXISTS_TAC;
+  TYPE_THEN `m` EXISTS_TAC;
+  ASM_REWRITE_TAC[v_edge_inj;down;left ;v_edge_cpoint;h_edge_cpoint;PAIR_SPLIT;];
+  INT_ARITH_TAC ;
+  REWRITE_TAC[hv_edgeV2;GSYM hv_edgeV2];
+  ]);;
+  (* }}} *)
+
+let along_lemma4 = prove_by_refinement(
+  `!G m x.  (segment G /\ (squ m SUBSET component  (ctop G) x) /\
+     (G (v_edge m)) /\ (G (v_edge (down m)))) ==>
+   (?p. (v_edge (down m)) SUBSET closure top2 (squ p) /\
+       (squ p SUBSET (component  (ctop G) x)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `down m` EXISTS_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[squ_closure_v];
+  TYPE_THEN `~(G (h_edge m))` SUBGOAL_TAC;
+  ASM_MESON_TAC[along_lemma2];
+  DISCH_TAC;
+  TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  comp_squ_down_rect_h;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[rectangle_h; union_subset];
+  MESON_TAC [];
+  ]);;
+  (* }}} *)
+
+let along_lemma5 = prove_by_refinement(
+  `!G m x. (segment G /\ (squ m SUBSET component  (ctop G) x) /\
+     (G (v_edge m)) /\ (G (h_edge (left   m)))) ==>
+   (?p. (h_edge (left   m)) SUBSET closure top2 (squ p) /\
+       (squ p SUBSET (component  (ctop G) x)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `left  (down m)` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[GSYM right_left];
+  ASM_MESON_TAC[squ_closure_down_h];
+  TYPE_THEN ` ~(G (h_edge m)) /\ ~(G (v_edge (down m)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  along_lemma3;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  TYPE_THEN `(rectangle (FST m , SND m -: &:1) (FST m +: &:1,SND m +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  comp_squ_down_rect_h;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[rectangle_h; union_subset];
+  DISCH_ALL_TAC;
+  TYPE_THEN `(rectangle (FST (down m) -: &:1,SND (down m)) (FST (down m) +: &:1,SND (down m) +: &:1) SUBSET component  (ctop G) x)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  comp_squ_left_rect_v;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[rectangle_v;union_subset;];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let along_lemma6 = prove_by_refinement(
+  `!G m x e. (segment G /\ (squ m SUBSET component  (ctop G) x) /\
+     (G (v_edge m)) /\ G e /\ (closure top2 e (pointI m)) ==>
+   (?p. e SUBSET closure top2 (squ p) /\
+       (squ p SUBSET (component  (ctop G) x))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC ;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC;
+  TYPE_THEN `edge e` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET;];
+  REWRITE_TAC[edge];
+  DISCH_THEN (CHOOSE_THEN DISJ_CASES_TAC);
+  REWR 4;
+  USE 4 (REWRITE_RULE[v_edge_cpoint]);
+  UND 4;
+  DISCH_TAC;
+  TYPE_THEN `(m' = m) \/ (m' = (down m))` SUBGOAL_TAC;
+  UND 4;
+  REWRITE_TAC[down;PAIR_SPLIT];
+  INT_ARITH_TAC ;
+  KILL 4;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `m` EXISTS_TAC;
+  ASM_REWRITE_TAC[squ_closure_v];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  along_lemma4;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  REWR 4;
+  USE 4(REWRITE_RULE[h_edge_cpoint]);
+  TYPE_THEN `(m' = m) \/ (m' = (left  m))` SUBGOAL_TAC;
+  UND 4;
+  REWRITE_TAC[left;PAIR_SPLIT];
+  INT_ARITH_TAC ;
+  KILL 4;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  along_lemma1;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  along_lemma5;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+
+let reflAf = jordan_def
+   `reflAf r (x:num->real) = point(&2 * (real_of_int r) - x 0, x 1)`;;
+
+let reflAi = jordan_def
+   `reflAi r (x:int#int) = ((&:2 *: r) -: FST x,SND x)`;;
+
+let reflBf = jordan_def
+   `reflBf r (x:num->real) = point( x 0 , &2 * (real_of_int r) - x 1)`;;
+
+let reflBi = jordan_def
+   `reflBi r (x:int#int) = (FST x, (&:2 *: r) -: SND x)`;;
+
+let reflCf = jordan_def
+   `reflCf  (x:num->real) = point (x 1, x 0)`;;
+
+let reflCi = jordan_def
+   `reflCi  (x:int#int) = (SND  x, FST  x)`;;
+
+let reflAf_inv = prove_by_refinement(
+  `!r m.  (reflAf r (reflAf r (point m)) = (point m))`,
+  (* {{{ proof *)
+
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[reflAf;coord01;PAIR_SPLIT ;point_inj ;];
+  REAL_ARITH_TAC ;
+  ]);;
+
+  (* }}} *)
+
+let reflBf_inv = prove_by_refinement(
+  `!r m.  (reflBf r (reflBf r (point m)) = (point m))`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[reflBf;coord01;PAIR_SPLIT ;point_inj ;];
+  REAL_ARITH_TAC ;
+  ]);;
+  (* }}} *)
+
+let reflCf_inv = prove_by_refinement(
+  `!m.  (reflCf  (reflCf  (point m)) = (point m))`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[reflCf;coord01;PAIR_SPLIT ;point_inj ;];
+  ]);;
+  (* }}} *)
+
+let reflAi_inv = prove_by_refinement(
+  `!r x.  (reflAi r (reflAi r x) = x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[reflAi;PAIR_SPLIT;];
+  INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let reflBi_inv = prove_by_refinement(
+  `!r x.  (reflBi r (reflBi r x) = x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[reflBi;PAIR_SPLIT;];
+  INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let reflCi_inv = prove_by_refinement(
+  `!x.  (reflCi  (reflCi  x) = x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[reflCi;PAIR_SPLIT;];
+  ]);;
+  (* }}} *)
+
+let invo_BIJ = prove_by_refinement(
+  `!f. (!m . (f (f (point m)) = (point m))) /\
+        (!x. (euclid 2 (f x))) ==>
+             (BIJ f (euclid 2) (euclid 2))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[BIJ;INJ;SURJ;];
+  SUBCONJ_TAC;
+  CONJ_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 2 (MATCH_MP (point_onto));
+  USE 3 (MATCH_MP (point_onto));
+  CHO 2;
+  CHO 3;
+  REWR 4;
+  TYPE_THEN `f` (USE 4 o AP_TERM );
+  REWR 4;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 4(MATCH_MP point_onto);
+  CHO 4;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN ` f (point p)` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let reflA_BIJ = prove_by_refinement(
+  `!r. (BIJ (reflAf r) (euclid 2) (euclid 2))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  IMATCH_MP_TAC  invo_BIJ;
+  REWRITE_TAC[reflAf_inv];
+  REWRITE_TAC[reflAf;euclid_point;];
+  ]);;
+  (* }}} *)
+
+let reflB_BIJ = prove_by_refinement(
+  `!r. (BIJ (reflBf r) (euclid 2) (euclid 2))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  IMATCH_MP_TAC  invo_BIJ;
+  REWRITE_TAC[reflBf_inv];
+  REWRITE_TAC[reflBf;euclid_point;];
+  ]);;
+  (* }}} *)
+
+let reflC_BIJ = prove_by_refinement(
+  `(BIJ (reflCf ) (euclid 2) (euclid 2))`,
+  (* {{{ proof *)
+  [
+  IMATCH_MP_TAC  invo_BIJ;
+  REWRITE_TAC[reflCf_inv];
+  REWRITE_TAC[reflCf;euclid_point;];
+  ]);;
+  (* }}} *)
+
+let invo_homeo = prove_by_refinement(
+  `!U (f:A->A). (continuous f U U) /\ (BIJ f (UNIONS U) (UNIONS U)) /\
+    (!x. (UNIONS U x ==> (f (f x ) = x))) ==> (homeomorphism f U U)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  bicont_homeomorphism;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `!x. (UNIONS U x) ==> (INV f (UNIONS U) (UNIONS U) x = f x)` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `UNIONS U (f x)` SUBGOAL_TAC;
+  UND 1;
+  REWRITE_TAC[BIJ;SURJ];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_SIMP_TAC [(INR INVERSE_XY)];
+  DISCH_ALL_TAC;
+  UND 0;
+  REWRITE_TAC[continuous];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TSPEC `v` 0;
+  REWR 0;
+  UND 0;
+  REWRITE_TAC[preimage];
+  TYPE_THEN `{x | UNIONS U x /\ v (INV f (UNIONS U) (UNIONS U) x)} = {x | UNIONS U x /\ v (f x)}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[];
+  IMATCH_MP_TAC  (TAUT `(C ==> (A <=> B)) ==> ( C /\ A <=> C /\ B)`);
+  DISCH_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ]);;
+
+  (* }}} *)
+
+let d_euclid_point = prove_by_refinement(
+  `!r s. (d_euclid (point r) (point s) =
+       sqrt ((FST r - FST s) pow 2 + ((SND r - SND s) pow 2)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `euclid 2 (point r) /\ euclid 2 (point s)` SUBGOAL_TAC;
+  REWRITE_TAC[euclid_point];
+  DISCH_TAC ;
+  USE 0(MATCH_MP d_euclid_n);
+  ASM_REWRITE_TAC[];
+  AP_TERM_TAC;
+  REWRITE_TAC[ARITH_RULE `2 = SUC 1`];
+  REWRITE_TAC[sum_DEF];
+  REDUCE_TAC;
+  REWRITE_TAC[ARITH_RULE `1 = SUC 0`];
+  REWRITE_TAC[sum_DEF];
+  REDUCE_TAC;
+  REWRITE_TAC[ARITH_RULE `(SUC 0  =1) /\ (SUC (SUC 0) = 2)`];
+  REWRITE_TAC[coord01];
+  REWRITE_TAC[POW_2];
+  ]);;
+  (* }}} *)
+
+let reflA_cont = prove_by_refinement(
+  `!r. continuous (reflAf r) top2 top2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[top2];
+  GEN_TAC;
+  TYPE_THEN `(IMAGE (reflAf r) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC;
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_SIMP_TAC[metric_euclid];
+  CONV_TAC (dropq_conv "x");
+  REWRITE_TAC[reflAf;euclid_point];
+  DISCH_TAC;
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;];
+  DISCH_ALL_TAC;
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 2(MATCH_MP point_onto);
+  CHO 2;
+  USE 3(MATCH_MP point_onto);
+  CHO 3;
+  UND 4;
+  ASM_REWRITE_TAC[reflAf;d_euclid_point;coord01;];
+  TYPE_THEN `(&2 * real_of_int r - FST p - (&2 * real_of_int r - FST p'))  = --. (FST p - FST p') ` SUBGOAL_TAC;
+  REAL_ARITH_TAC ;
+  DISCH_THEN_REWRITE;
+  ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS];
+  REWRITE_TAC[ABS_NEG];
+  ]);;
+  (* }}} *)
+
+let reflB_cont = prove_by_refinement(
+  `!r. continuous (reflBf r) top2 top2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[top2];
+  GEN_TAC;
+  TYPE_THEN `(IMAGE (reflBf r) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC;
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_SIMP_TAC[metric_euclid];
+  CONV_TAC (dropq_conv "x");
+  REWRITE_TAC[reflBf;euclid_point];
+  DISCH_TAC;
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;];
+  DISCH_ALL_TAC;
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 2(MATCH_MP point_onto);
+  CHO 2;
+  USE 3(MATCH_MP point_onto);
+  CHO 3;
+  UND 4;
+  ASM_REWRITE_TAC[reflBf;d_euclid_point;coord01;];
+  TYPE_THEN `(&2 * real_of_int r - SND  p - (&2 * real_of_int r - SND  p'))  = --. (SND  p - SND  p') ` SUBGOAL_TAC;
+  REAL_ARITH_TAC ;
+  DISCH_THEN_REWRITE;
+  ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS];
+  REWRITE_TAC[ABS_NEG];
+  ]);;
+  (* }}} *)
+
+let reflC_cont = prove_by_refinement(
+  ` continuous (reflCf) top2 top2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[top2];
+  TYPE_THEN `(IMAGE (reflCf) (euclid 2)) SUBSET (euclid 2) /\ (metric_space (euclid 2,d_euclid))` SUBGOAL_TAC;
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_SIMP_TAC[metric_euclid];
+  CONV_TAC (dropq_conv "x");
+  REWRITE_TAC[reflCf;euclid_point];
+  DISCH_TAC;
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_continuous;metric_continuous_pt;];
+  DISCH_ALL_TAC;
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 2(MATCH_MP point_onto);
+  CHO 2;
+  USE 3(MATCH_MP point_onto);
+  CHO 3;
+  UND 4;
+  ASM_REWRITE_TAC[reflCf;d_euclid_point;coord01;];
+  REWRITE_TAC[REAL_ADD_AC];
+  ]);;
+  (* }}} *)
+
+let reflA_homeo = prove_by_refinement(
+  `!r. (homeomorphism (reflAf r) top2 top2)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  ASSUME_TAC reflA_BIJ;
+  ASSUME_TAC top2_unions;
+  IMATCH_MP_TAC  invo_homeo;
+  REWRITE_TAC[reflA_cont];
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 2(MATCH_MP   point_onto);
+  CHO 2;
+  ASM_REWRITE_TAC[reflAf_inv];
+  ]);;
+  (* }}} *)
+
+let reflB_homeo = prove_by_refinement(
+  `!r. (homeomorphism (reflBf r) top2 top2)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  ASSUME_TAC reflB_BIJ;
+  ASSUME_TAC top2_unions;
+  IMATCH_MP_TAC  invo_homeo;
+  REWRITE_TAC[reflB_cont];
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 2(MATCH_MP   point_onto);
+  CHO 2;
+  ASM_REWRITE_TAC[reflBf_inv];
+  ]);;
+  (* }}} *)
+
+let reflC_homeo = prove_by_refinement(
+  ` (homeomorphism (reflCf ) top2 top2)`,
+  (* {{{ proof *)
+  [
+  ASSUME_TAC reflC_BIJ;
+  ASSUME_TAC top2_unions;
+  IMATCH_MP_TAC  invo_homeo;
+  REWRITE_TAC[reflC_cont];
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 2(MATCH_MP   point_onto);
+  CHO 2;
+  ASM_REWRITE_TAC[reflCf_inv];
+  ]);;
+  (* }}} *)
+
+let IMAGE2 = new_definition
+   `IMAGE2 (f:A->B) U = IMAGE (IMAGE (f:A->B)) U`;;
+
+let reflA_h_edge = prove_by_refinement(
+  `!m r.  IMAGE (reflAf r) (h_edge m) = h_edge (left  (reflAi r m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge;reflAf;reflAi;IMAGE ;left  ;];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[h_edge];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "x'");
+  CONV_TAC (dropq_conv "v");
+  REWRITE_TAC[coord01];
+  EQ_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
+  DISCH_ALL_TAC;
+  UND 0;
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
+  UND 0;
+  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
+  DISCH_ALL_TAC;
+  UND 2;
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let reflA_v_edge = prove_by_refinement(
+  `!m r.  IMAGE (reflAf r) (v_edge m) = v_edge (  (reflAi r m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge;reflAf;reflAi;IMAGE ;left  ;];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[v_edge];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "x'");
+  CONV_TAC (dropq_conv "u");
+  REWRITE_TAC[coord01];
+  REWRITE_TAC[int_sub_th;int_mul_th;int_of_num_th;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let reflA_edge = prove_by_refinement(
+  `!r e. (edge e ==> edge (IMAGE (reflAf r) e))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge];
+  DISCH_ALL_TAC;
+  CHO 0;
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  MESON_TAC[reflA_v_edge];
+  ASM_REWRITE_TAC[];
+  MESON_TAC[reflA_h_edge];
+  ]);;
+  (* }}} *)
+
+let reflB_v_edge = prove_by_refinement(
+  `!m r.  IMAGE (reflBf r) (v_edge m) = v_edge (down  (reflBi r m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge;reflBf;reflBi;IMAGE ;down  ;];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[v_edge];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "x'");
+  CONV_TAC (dropq_conv "u");
+  REWRITE_TAC[coord01];
+  EQ_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
+  DISCH_ALL_TAC;
+  UND 0;
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
+  UND 0;
+  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
+  DISCH_ALL_TAC;
+  UND 2;
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let reflB_h_edge = prove_by_refinement(
+  `!m r.  IMAGE (reflBf r) (h_edge m) = h_edge (  (reflBi r m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge;reflBf;reflBi;IMAGE ;down  ;];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[h_edge];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "x'");
+  CONV_TAC (dropq_conv "v");
+  REWRITE_TAC[coord01];
+  REWRITE_TAC[int_sub_th;int_mul_th;int_of_num_th;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let reflB_edge = prove_by_refinement(
+  `!r e. (edge e ==> edge (IMAGE (reflBf r) e))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge];
+  DISCH_ALL_TAC;
+  CHO 0;
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  MESON_TAC[reflB_v_edge];
+  ASM_REWRITE_TAC[];
+  MESON_TAC[reflB_h_edge];
+  ]);;
+  (* }}} *)
+
+let reflC_vh_edge = prove_by_refinement(
+  `!m .  IMAGE (reflCf) (v_edge m) = h_edge ( (reflCi m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge;reflCf;reflCi;IMAGE ;down  ;];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[v_edge;h_edge];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "x'");
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  REWRITE_TAC[coord01];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let reflC_hv_edge = prove_by_refinement(
+  `!m .  IMAGE (reflCf) (h_edge m) = v_edge ( (reflCi m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge;reflCf;reflCi;IMAGE ;down  ;];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[v_edge;h_edge];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "x'");
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  REWRITE_TAC[coord01];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let reflC_edge = prove_by_refinement(
+  `!e. (edge e ==> edge (IMAGE (reflCf ) e))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge];
+  DISCH_ALL_TAC;
+  CHO 0;
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  MESON_TAC[reflC_vh_edge];
+  ASM_REWRITE_TAC[];
+  MESON_TAC[reflC_hv_edge];
+  ]);;
+  (* }}} *)
+
+let homeo_bij = prove_by_refinement(
+  `!(f:A->B) U V. (homeomorphism f U V) ==> (BIJ (IMAGE f) U V)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[BIJ;homeomorphism;continuous;preimage;];
+  DISCH_ALL_TAC;
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  ASM_REWRITE_TAC[IMAGE;];
+  DISCH_ALL_TAC;
+  TAPP `u:B` 6;
+  USE 6 (REWRITE_RULE[]);
+  USE 6(CONV_RULE NAME_CONFLICT_CONV);
+  IMATCH_MP_TAC  EQ_EXT;
+  USE 6 (GEN `u:B`);
+  GEN_TAC;
+  COPY 6;
+  EQ_TAC;
+  DISCH_TAC;
+  TSPEC `f x'` 7;
+  TYPE_THEN `(?x''. x x'' /\ (f x' = f x''))` SUBGOAL_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  UND 7;
+  KILL 6;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  CHO 6;
+  CHO 9;
+  TYPE_THEN `(UNIONS U) x'' /\ (UNIONS U) x'''` SUBGOAL_TAC;
+  REWRITE_TAC[UNIONS;];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(UNIONS U x')` SUBGOAL_TAC;
+  REWRITE_TAC[UNIONS;];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `x' = x'''` SUBGOAL_TAC;
+  USE 0(REWRITE_RULE[INJ]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `x' = x''` SUBGOAL_TAC;
+  USE 0(REWRITE_RULE[INJ]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_MESON_TAC[];
+  (* mm *)
+  DISCH_TAC;
+  TSPEC `f x'` 7;
+  TYPE_THEN `(?x''. y x'' /\ (f x' = f x''))` SUBGOAL_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  UND 7;
+  KILL 6;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  CHO 6;
+  CHO 9;
+  TYPE_THEN `(UNIONS U) x'' /\ (UNIONS U) x'''` SUBGOAL_TAC;
+  REWRITE_TAC[UNIONS;];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(UNIONS U x')` SUBGOAL_TAC;
+  REWRITE_TAC[UNIONS;];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `x' = x'''` SUBGOAL_TAC;
+  USE 0(REWRITE_RULE[INJ]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `x' = x''` SUBGOAL_TAC;
+  USE 0(REWRITE_RULE[INJ]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[INJ;SURJ];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  TYPE_THEN `{z | UNIONS U z /\ x (f z)}` EXISTS_TAC;
+  CONJ_TAC;
+  UND 2;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;SUBSET ;];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x''");
+  MESON_TAC[];
+  REWRITE_TAC[SUBSET;IMAGE];
+  DISCH_ALL_TAC;
+  NAME_CONFLICT_TAC;
+  UND 1;
+  REWRITE_TAC[SURJ];
+  DISCH_ALL_TAC;
+  TSPEC `x'` 8;
+  TYPE_THEN `UNIONS V x'` SUBGOAL_TAC;
+  REWRITE_TAC[UNIONS;];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 8;
+  CHO 8;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let homeo_unions = prove_by_refinement(
+  `!(f:A->B) U V. (homeomorphism f U V) ==>
+      (IMAGE f (UNIONS U) = (UNIONS V))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[homeomorphism;BIJ;SURJ;IMAGE;];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  GEN_TAC;
+  NAME_CONFLICT_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 5;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TSPEC `x` 2;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let homeo_closed = prove_by_refinement(
+  `!(f:A->B) U V A. (homeomorphism f U V /\ (A SUBSET (UNIONS U)) ==>
+    (closed_ V (IMAGE f A) = closed_ U A))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+   TYPE_THEN `BIJ f (UNIONS U) (UNIONS V)` SUBGOAL_TAC;
+  ASM_MESON_TAC[homeomorphism];
+  DISCH_TAC;
+  USE 2(MATCH_MP DIFF_SURJ);
+  TSPEC `A` 2;
+  REWR 2;
+  ASM_REWRITE_TAC[closed;open_DEF];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  USE 0(REWRITE_RULE[homeomorphism;continuous]);
+  UND 0;
+  DISCH_ALL_TAC;
+  USE 2 SYM;
+  REWR 4;
+  TSPEC `IMAGE f (UNIONS U DIFF A)` 5;
+  REWR 5;
+  TYPE_THEN `preimage (UNIONS U) f (IMAGE f (UNIONS U DIFF A)) = UNIONS U DIFF A` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT ;
+  GEN_TAC;
+  REWRITE_TAC[INR in_preimage;IMAGE;DIFF;];
+  USE 0(REWRITE_RULE[BIJ;INJ]);
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 8;
+  ASM_MESON_TAC[];
+  MESON_TAC[];
+  DISCH_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  USE 0 (REWRITE_RULE[homeomorphism;BIJ;SURJ]);
+  REWRITE_TAC[IMAGE;SUBSET];
+  GEN_TAC;
+  NAME_CONFLICT_TAC;
+  UND 1;
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  USE 0(REWRITE_RULE[homeomorphism]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* SECTION G *)
+(* ------------------------------------------------------------------ *)
+
+
+let IMAGE_INTERS = prove_by_refinement(
+  `!(f:A->B) A X . (INJ f X UNIV) /\ (UNIONS A SUBSET X) /\
+     ~(A = EMPTY) ==>
+   ((IMAGE f) (INTERS A) = (INTERS (IMAGE2 f A)))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[IMAGE2;INTERS;IMAGE;];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 3;
+  AND 3;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  CHO 5;
+  AND 5;
+  ASM_REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  USE 3 (CONV_RULE (dropq_conv "u'"));
+  USE 3 (CONV_RULE (dropq_conv "y'"));
+  USE 2(REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 2;
+  COPY 3;
+  TSPEC `u` 3;
+  CHO 3;
+  REWR 3;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 0(REWRITE_RULE[INJ]);
+  TSPEC `u'` 4;
+  CHO 4;
+  REWR 4;
+  TYPEL_THEN [`x'`;`x''`] (USE 0 o ISPECL);
+  USE 1(REWRITE_RULE[UNIONS;ISUBSET]);
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let homeo_closure = prove_by_refinement(
+  `!(f:A->B) U V A. (homeomorphism f U V) /\ (A SUBSET (UNIONS U)) /\
+     (topology_ U)  ==>
+     (IMAGE f (closure U A) = closure V (IMAGE f A))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[closure];
+  TYPE_THEN `INJ f (UNIONS U) (UNIV)` SUBGOAL_TAC;
+  USE 0(REWRITE_RULE[homeomorphism;BIJ;INJ;]);
+  ASM_REWRITE_TAC[INJ];
+  DISCH_TAC;
+  TYPE_THEN `C = {B | closed_ U B /\ A SUBSET B}` ABBREV_TAC ;
+  TYPE_THEN `(UNIONS C SUBSET UNIONS U)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;];
+  EXPAND_TAC "C";
+  REWRITE_TAC[closed];
+  TYPE_THEN `X = UNIONS U` ABBREV_TAC ;
+  REWRITE_TAC[UNIONS];
+  MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `~(C = EMPTY)` SUBGOAL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `UNIONS U` EXISTS_TAC;
+  EXPAND_TAC "C";
+  ASM_REWRITE_TAC[closed; ISUBSET; DIFF_EQ_EMPTY;];
+  ASM_SIMP_TAC[INR open_EMPTY];
+  DISCH_TAC;
+  JOIN 5 6;
+  JOIN 3 5;
+  USE 3 (MATCH_MP IMAGE_INTERS);
+  ASM_REWRITE_TAC[];
+  AP_TERM_TAC;
+  REWRITE_TAC[IMAGE2];
+  EXPAND_TAC "C";
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
+  REWRITE_TAC[IMAGE];
+  NAME_CONFLICT_TAC;
+  EQ_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "g";
+  KILL 5;
+  TYPE_THEN `x' SUBSET (UNIONS U)` SUBGOAL_TAC;
+  USE 6(REWRITE_RULE[closed]);
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[homeo_closed];
+  DISCH_TAC;
+  REWRITE_TAC[ISUBSET;IMAGE];
+  NAME_CONFLICT_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_ALL_TAC;
+  TYPE_THEN `preimage (UNIONS U) f x` EXISTS_TAC;
+  TYPE_THEN `x = g (preimage (UNIONS U) f x)` SUBGOAL_TAC;
+  REWRITE_TAC[preimage];
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  REWRITE_TAC[IMAGE];
+  NAME_CONFLICT_TAC;
+  USE 0 (REWRITE_RULE[homeomorphism;BIJ;SURJ]);
+  UND 0;
+  DISCH_ALL_TAC;
+  TSPEC `x'` 10;
+  TYPE_THEN `UNIONS V x'` SUBGOAL_TAC;
+  USE 6(REWRITE_RULE[closed]);
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  REWR 10;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[IMAGE];
+  DISCH_THEN CHOOSE_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  USE 8 (SYM);
+  ONCE_ASM_REWRITE_TAC[];
+  REWRITE_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `preimage (UNIONS U) f x SUBSET (UNIONS U)` SUBGOAL_TAC;
+  REWRITE_TAC[preimage;SUBSET;];
+  MESON_TAC[];
+  ASM_SIMP_TAC[GSYM homeo_closed];
+  REWRITE_TAC[preimage;SUBSET];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  UND 7;
+  EXPAND_TAC "g";
+  REWRITE_TAC[IMAGE;ISUBSET;];
+  UND 9;
+  MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let INJ_IMAGE = prove_by_refinement(
+  `!(f :A->B) A B X . (A SUBSET X) /\ (B SUBSET X) /\
+     (INJ f X UNIV) ==> ((IMAGE f A = IMAGE f B) <=> (A = B))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]);
+  TAPP `y:B` 3;
+  RULE_ASSUM_TAC  (REWRITE_RULE[]);
+  USE 3(GEN `y:B`);
+  REWRITE_TAC[SUBSET];
+  PROOF_BY_CONTR_TAC;
+  USE 4(REWRITE_RULE [DE_MORGAN_THM]);
+  FIRST_ASSUM (DISJ_CASES_TAC);
+
+  LEFT  5 "x";
+  REP_BASIC_TAC;
+  TSPEC `f x ` 3;
+  TYPE_THEN `A x` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(?x'. A x' /\ (f x = f x'))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(?x'. B x' /\ (f x = f x'))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  USE 0(REWRITE_RULE[BIJ;INJ]);
+  TYPE_THEN `x = x'` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+
+  LEFT  5 "x";
+  REP_BASIC_TAC;
+  TSPEC `f x ` 3;
+  TYPE_THEN `B x` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(?x'. B x' /\ (f x = f x'))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(?x'. A x' /\ (f x = f x'))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  USE 0(REWRITE_RULE[BIJ;INJ]);
+  TYPE_THEN `x = x'` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ]);;
+  (* }}} *)
+
+let INJ_UNIV = prove_by_refinement(
+  `!(f: A->B) X Y. (INJ f X Y) ==> (INJ f X UNIV)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC [];
+  ]);;
+  (* }}} *)
+
+let homeo_adj = prove_by_refinement(
+  `!f X Y.  (homeomorphism f top2 top2) /\ (X SUBSET euclid 2) /\
+       (Y SUBSET euclid 2)
+       ==> (adj X Y ==> (adj (IMAGE f X) (IMAGE f Y)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[adj;INTER;EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  ASSUME_TAC top2_top;
+  ASSUME_TAC top2_unions;
+  TYPE_THEN `X SUBSET (UNIONS top2) /\ Y SUBSET (UNIONS (top2))` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `closure top2 (IMAGE f X) = IMAGE f (closure top2 X)` SUBGOAL_TAC;
+  ASM_MESON_TAC[GSYM homeo_closure];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `closure top2 (IMAGE f Y) = IMAGE f (closure top2 Y)` SUBGOAL_TAC;
+  ASM_MESON_TAC[GSYM homeo_closure];
+  DISCH_THEN_REWRITE;
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[]);
+  UND 2;
+  REWRITE_TAC[];
+  UND 10;
+  TYPE_THEN `INJ f (euclid 2) UNIV` SUBGOAL_TAC;
+  IMATCH_MP_TAC  INJ_UNIV;
+  RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ]);
+  REP_BASIC_TAC;
+  REWR 11;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[INJ_IMAGE];
+  (* done WITH both *)
+  TYPE_THEN `f u` EXISTS_TAC;
+  REWRITE_TAC[IMAGE];
+  ASM_MESON_TAC[];
+  (* converse *)
+  ]);;
+  (* }}} *)
+
+let homeomorphism_inv = prove_by_refinement(
+  `!(f:A->B) U V. homeomorphism f U V ==>
+    (homeomorphism (INV f (UNIONS U) (UNIONS V)) V U)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[homeomorphism];
+  ASM_SIMP_TAC[INV_homeomorphism];
+  USE 0(REWRITE_RULE [homeomorphism;continuous;]);
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[INVERSE_BIJ];
+  REP_BASIC_TAC;
+  TSPEC `A` 1;
+  REWR 1;
+  TYPE_THEN `g = INV f (UNIONS U) (UNIONS V)` ABBREV_TAC ;
+  TYPE_THEN `BIJ g (UNIONS V) (UNIONS U)` SUBGOAL_TAC;
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  INVERSE_BIJ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `!x'. (A x' ==> (f (g x') = x'))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPEL_THEN  [`f`;`UNIONS U`;`UNIONS V`] (fun t->  ASSUME_TAC (ISPECL  t (INR INVERSE_DEF)));
+  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ]);
+  REWR 6;
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC  ;
+  REWRITE_TAC[UNIONS];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  DISCH_TAC;
+  (* branch *)
+  TYPE_THEN `(IMAGE g A) = preimage (UNIONS U) f A` SUBGOAL_TAC;
+  REWRITE_TAC[IMAGE;preimage];
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  EQ_TAC;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[];
+  EXPAND_TAC "g";
+  USE 2(MATCH_MP   INVERSE_BIJ);
+  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC [UNIONS];
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `f x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `f x = f (g (f x))` SUBGOAL_TAC;
+  ASM_SIMP_TAC[];
+  DISCH_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  USE 9 SYM;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `UNIONS V (f x)` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let inv_comp_left = prove_by_refinement(
+  `!(f:A->B) X Y x.  (BIJ f X Y /\ X x) ==> (INV f X Y (f x) = x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `Y (f x)` SUBGOAL_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[INR INVERSE_XY];
+  ]);;
+  (* }}} *)
+
+let inv_comp_right = prove_by_refinement(
+  `!(f:A->B) X Y y. (BIJ f X Y /\ Y y) ==> (f (INV f X Y y) = y)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ]);
+  ASM_MESON_TAC[INR INVERSE_DEF;];
+  ]);;
+  (* }}} *)
+
+let image_inv_image = prove_by_refinement(
+  `!(f:A->B) A X Y. (BIJ f X Y) /\ (A SUBSET X) ==>
+    (IMAGE (INV f X Y) (IMAGE f A) = A)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x''");
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `x = x'` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC [inv_comp_left;ISUBSET;];
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  inv_comp_left;
+  ASM_MESON_TAC[ISUBSET];
+  ]);;
+  (* }}} *)
+
+let homeo_adj_eq = prove_by_refinement(
+  `!f X Y. (homeomorphism f top2 top2) /\ (X SUBSET euclid 2) /\
+       (Y SUBSET euclid 2)
+       ==> (adj X Y = (adj (IMAGE f X) (IMAGE f Y)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  EQ_TAC;
+  ASM_MESON_TAC[homeo_adj];
+  TYPEL_THEN  [`INV f (euclid 2) (euclid 2)`;`IMAGE f X`;`IMAGE f Y`] (fun t-> MP_TAC (ISPECL t homeo_adj));
+  ASSUME_TAC top2_unions;
+  TYPE_THEN `homeomorphism (INV f (euclid 2) (euclid 2)) top2 top2` SUBGOAL_TAC;
+  ASM_MESON_TAC[homeomorphism_inv];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `BIJ f (euclid 2) (euclid 2)` SUBGOAL_TAC;
+  ASM_MESON_TAC[homeomorphism];
+  DISCH_TAC;
+  ASM_SIMP_TAC[image_inv_image];
+  REP_BASIC_TAC;
+  TYPE_THEN `IMAGE f X SUBSET euclid 2 /\ IMAGE f Y SUBSET euclid 2` SUBGOAL_TAC;
+  REWRITE_TAC[IMAGE;SUBSET];
+  NAME_CONFLICT_TAC;
+  CONJ_TAC THEN (CONV_TAC (dropq_conv "x''")) THEN (RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]));
+  ASM_MESON_TAC[ISUBSET];
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let finite_num_closure = prove_by_refinement(
+  `!G top (x:A). FINITE G ==> (FINITE {C | G C /\ closure top C x})`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC FINITE_SUBSET;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let image_powerset = prove_by_refinement(
+  `!(f:A->B) X Y. (BIJ f X Y ==>
+     (BIJ (IMAGE f) {z | z SUBSET X} { z | z SUBSET Y}))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC ;
+  REWRITE_TAC[IMAGE;SUBSET;];
+  ASM_MESON_TAC[ISUBSET ;];
+  REWRITE_TAC[IMAGE;SUBSET;];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;INJ]);
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+
+  TAPP `z:B` 1;
+  USE 1(REWRITE_RULE[]);
+  USE 1(GEN `z:B`);
+  EQ_TAC;
+  TSPEC `f x'` 1;
+  REP_BASIC_TAC;
+  UND 1;
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `(?x''. x x'' /\ (f x' = f x''))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  REP_BASIC_TAC;
+  TYPE_THEN `x' = x''` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* 2 *)
+  TSPEC `f x'` 1;
+  REP_BASIC_TAC;
+  UND 1;
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `(?x''. y x'' /\ (f x' = f x''))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  REP_BASIC_TAC;
+  TYPE_THEN `x' = x''` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[INJ;SURJ];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `{z | X z /\ x (f z) }` EXISTS_TAC;
+  SUBCONJ_TAC;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_EXT ;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  EQ_TAC;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC;
+  TSPEC `x'` 0;
+  USE 3(REWRITE_RULE[SUBSET]);
+  TSPEC  `x'` 3;
+  REWR 3;
+  REWR 0;
+  REP_BASIC_TAC;
+  TYPE_THEN `y` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let image_power_inj = prove_by_refinement(
+  `!(f:A->B) X Y A B. (BIJ f X Y /\ A SUBSET X /\ B SUBSET X ==>
+     ((IMAGE f A = IMAGE f B) <=> (A = B)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPEL_THEN [`f`;`X`;`Y`]  (fun t -> ASSUME_TAC (ISPECL t image_powerset ));
+  REWR 3;
+  USE 3(REWRITE_RULE[BIJ;INJ;]);
+  REP_BASIC_TAC;
+  EQ_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ]);;
+  (* }}} *)
+
+let image_power_surj = prove_by_refinement(
+  `!(f:A->B) X Y B. (BIJ f X Y /\ B SUBSET Y ==>
+    (?A. (A SUBSET X /\ (IMAGE f A = B))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPEL_THEN [`f`;`X`;`Y`]  (fun t -> ASSUME_TAC (ISPECL t image_powerset ));
+  REWR 2;
+  USE 2(REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let segment_euclid = prove_by_refinement(
+  `!G e. (segment G /\ G e) ==> (e SUBSET (euclid 2))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  REP_BASIC_TAC;
+  USE 3(REWRITE_RULE[SUBSET]);
+  TSPEC `e` 3;
+  REWR 3;
+  USE 3(REWRITE_RULE[edge]);
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[h_edge_euclid;v_edge_euclid];
+  ]);;
+  (* }}} *)
+
+let image_app = prove_by_refinement(
+  `!(f:A->B) X Y x t. INJ f X Y /\ x SUBSET X /\ (X t) ==>
+   (IMAGE f x (f t) = x t)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ;IMAGE;SUBSET ;];
+  REP_BASIC_TAC;
+  EQ_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let homeo_num_closure = prove_by_refinement(
+  `!G f m. (homeomorphism f top2 top2 /\ segment G) ==>
+   (num_closure G (pointI m) =
+           (num_closure (IMAGE2 f G) (f (pointI m))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASSUME_TAC top2_unions;
+  ASSUME_TAC top2_top;
+  TYPE_THEN `BIJ f (euclid 2) (euclid 2)` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
+  ASM_MESON_TAC [];
+  DISCH_TAC;
+  TYPE_THEN `G` (fun t-> ASSUME_TAC (ISPEC t segment_euclid));
+  REWRITE_TAC[num_closure];
+  IMATCH_MP_TAC  BIJ_CARD;
+  TYPE_THEN `IMAGE f` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  finite_num_closure;
+  ASM_MESON_TAC[segment_finite];
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE2];
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `x SUBSET (UNIONS top2)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `IMAGE f (closure top2 x) = closure top2 (IMAGE f x)` SUBGOAL_TAC;
+  ASM_MESON_TAC [homeo_closure];
+  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[IMAGE];
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `x SUBSET (euclid 2) /\ y SUBSET (euclid 2)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_MESON_TAC[image_power_inj];
+  REWRITE_TAC[INJ;SURJ];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2]);
+  UND 9;
+  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
+  REWRITE_TAC[IMAGE];
+  EXPAND_TAC "g";
+  REP_BASIC_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWR 8;
+  UND 8;
+  TYPE_THEN `x' SUBSET (UNIONS top2)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `closure top2 (g x') = IMAGE f (closure top2 x')` SUBGOAL_TAC;
+  ASM_MESON_TAC [GSYM homeo_closure];
+  DISCH_THEN_REWRITE;
+  (* m3 *)
+  TYPE_THEN `INJ f (euclid 2) (euclid 2) /\ (closure top2 x' SUBSET (euclid 2)) /\ (euclid 2 (pointI m))` SUBGOAL_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[BIJ]);
+   ASM_REWRITE_TAC[pointI;euclid_point];
+  IMATCH_MP_TAC  c_edge_euclid;
+  ASM_MESON_TAC[segment;ISUBSET];
+  DISCH_TAC;
+  USE 12 (MATCH_MP image_app);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION H *)
+(* ------------------------------------------------------------------ *)
+
+let reflA_pointI = prove_by_refinement(
+  `!r m. (reflAf r (pointI m) = pointI (reflAi r m))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[reflAi;reflAf;pointI];
+  REWRITE_TAC[point_inj;PAIR_SPLIT;];
+  REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01];
+  ]);;
+  (* }}} *)
+
+let reflB_pointI = prove_by_refinement(
+  `!r m. (reflBf r (pointI m) = pointI (reflBi r m))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[reflBi;reflBf;pointI];
+  REWRITE_TAC[point_inj;PAIR_SPLIT;];
+  REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01];
+  ]);;
+  (* }}} *)
+
+let reflC_pointI = prove_by_refinement(
+  `!m. (reflCf  (pointI m) = pointI (reflCi m))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[reflCi;reflCf;pointI];
+  REWRITE_TAC[point_inj;PAIR_SPLIT;];
+  REWRITE_TAC[int_of_num_th;int_add_th;int_mul_th;int_sub_th;coord01];
+  ]);;
+  (* }}} *)
+
+let edge_euclid2 = prove_by_refinement(
+  `!e. (edge e ==> e SUBSET (euclid 2))`,
+  (* {{{ proof *)
+  [
+  MESON_TAC [edge;h_edge_euclid;v_edge_euclid;];
+  ]);;
+  (* }}} *)
+
+let reflA_segment = prove_by_refinement(
+  `!G r. (segment G ==> (segment (IMAGE2 (reflAf r) G)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[segment];
+  COPY 0;
+  USE 0(REWRITE_RULE[segment]);
+  REP_BASIC_TAC;
+  TYPE_THEN `homeomorphism (reflAf r) top2 top2` SUBGOAL_TAC;
+  REWRITE_TAC[reflA_homeo];
+  DISCH_TAC;
+  ASSUME_TAC top2_top;
+  ASSUME_TAC top2_unions;
+  TYPE_THEN `BIJ (reflAf r) (euclid 2) (euclid 2)` SUBGOAL_TAC;
+  ASM_MESON_TAC[homeomorphism];
+  DISCH_TAC;
+  TYPE_THEN `INJ (IMAGE (reflAf r)) edge edge` SUBGOAL_TAC;
+  REWRITE_TAC[INJ;reflA_edge;];
+  REP_BASIC_TAC;
+  TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC;
+  ASM_MESON_TAC[edge_euclid2];
+  DISCH_TAC;
+  ASM_MESON_TAC[image_power_inj];
+  DISCH_TAC;
+  (* start cases *)
+  SUBCONJ_TAC;
+  REWRITE_TAC[IMAGE2];
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  SUBCONJ_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2; EQ_EMPTY]);
+  TSPEC `IMAGE (reflAf r) u` 4;
+  UND 4;
+  REWRITE_TAC[];
+  TYPE_THEN `IMAGE (IMAGE (reflAf r)) G (IMAGE (reflAf r) u) = G u` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_app;
+  EXISTS_TAC `edge`;
+  EXISTS_TAC `edge`;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (*
+  ASM_MESON_TAC[image_power_inj];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  *)
+  SUBCONJ_TAC;
+  REWRITE_TAC[IMAGE2;SUBSET];
+  GEN_TAC;
+  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV )  [IMAGE];
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  reflA_edge;
+  ASM_MESON_TAC[ISUBSET;];
+  DISCH_TAC;
+  (* num closure clause *)
+  CONJ_TAC;
+  GEN_TAC;
+  TYPE_THEN `pointI m = reflAf r (pointI (reflAi r m))` SUBGOAL_TAC;
+  REWRITE_TAC[reflA_pointI;reflAi_inv];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `num_closure (IMAGE2 (reflAf r) G) (reflAf r (pointI (reflAi r m))) = num_closure G (pointI (reflAi r m))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_num_closure);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[];
+  (* inductive_set clause *)
+  REP_BASIC_TAC;
+  (* isc *)
+  USE 16(REWRITE_RULE[IMAGE2]);
+  USE 16 (MATCH_MP SUBSET_PREIMAGE);
+  REP_BASIC_TAC;
+  TSPEC `Z` 0;
+  TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[]);
+  REWR 16;
+  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE_CLAUSES]);
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `D = IMAGE (reflAf r) C` ABBREV_TAC ;
+  TYPE_THEN `D' = IMAGE (reflAf r) C'` ABBREV_TAC ;
+  TSPEC `D` 14; (* *)
+  TSPEC `D'` 14;
+  TYPE_THEN `S D /\ IMAGE2 (reflAf r) G D' /\ adj D D'` SUBGOAL_TAC;
+  SUBCONJ_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "D";
+  TYPE_THEN `IMAGE (IMAGE (reflAf r)) Z (IMAGE (reflAf r) C) = Z C` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_app;
+  TYPE_THEN `edge` EXISTS_TAC;
+  TYPE_THEN `edge` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* fh1 *)
+  SUBCONJ_TAC;
+  EXPAND_TAC "D'";
+  REWRITE_TAC[IMAGE2;IMAGE];
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  EXPAND_TAC "D";
+  EXPAND_TAC "D'";
+  TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET;edge_euclid2];
+  DISCH_TAC;
+  TYPE_THEN `(adj C C' ==> adj (IMAGE (reflAf r) C) (IMAGE (reflAf r) C'))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  homeo_adj;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWR 14;
+  UND 14;
+  EXPAND_TAC "D'";
+  TYPE_THEN `IMAGE (IMAGE (reflAf r)) Z (IMAGE (reflAf r) C') = Z C'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_app;
+  TYPE_THEN `edge` EXISTS_TAC;
+  TYPE_THEN `edge` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  UND 3;
+  UND 19;
+  ASM_MESON_TAC[ISUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  REWR 0;
+  ASM_REWRITE_TAC[IMAGE2];
+  ]);;
+  (* }}} *)
+
+let reflB_segment = prove_by_refinement(
+  `!G r. (segment G ==> (segment (IMAGE2 (reflBf r) G)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[segment];
+  COPY 0;
+  USE 0(REWRITE_RULE[segment]);
+  REP_BASIC_TAC;
+  TYPE_THEN `homeomorphism (reflBf r) top2 top2` SUBGOAL_TAC;
+  REWRITE_TAC[reflB_homeo];
+  DISCH_TAC;
+  ASSUME_TAC top2_top;
+  ASSUME_TAC top2_unions;
+  TYPE_THEN `BIJ (reflBf r) (euclid 2) (euclid 2)` SUBGOAL_TAC;
+  ASM_MESON_TAC[homeomorphism];
+  DISCH_TAC;
+  TYPE_THEN `INJ (IMAGE (reflBf r)) edge edge` SUBGOAL_TAC;
+  REWRITE_TAC[INJ;reflB_edge;];
+  REP_BASIC_TAC;
+  TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC;
+  ASM_MESON_TAC[edge_euclid2];
+  DISCH_TAC;
+  ASM_MESON_TAC[image_power_inj];
+  DISCH_TAC;
+  (* start cases *)
+  SUBCONJ_TAC;
+  REWRITE_TAC[IMAGE2];
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  SUBCONJ_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2; EQ_EMPTY]);
+  TSPEC `IMAGE (reflBf r) u` 4;
+  UND 4;
+  REWRITE_TAC[];
+  TYPE_THEN `IMAGE (IMAGE (reflBf r)) G (IMAGE (reflBf r) u) = G u` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_app;
+  EXISTS_TAC `edge`;
+  EXISTS_TAC `edge`;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (*
+  ASM_MESON_TAC[image_power_inj];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  *)
+  SUBCONJ_TAC;
+  REWRITE_TAC[IMAGE2;SUBSET];
+  GEN_TAC;
+  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV )  [IMAGE];
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  reflB_edge;
+  ASM_MESON_TAC[ISUBSET;];
+  DISCH_TAC;
+  (* num closure clause *)
+  CONJ_TAC;
+  GEN_TAC;
+  TYPE_THEN `pointI m = reflBf r (pointI (reflBi r m))` SUBGOAL_TAC;
+  REWRITE_TAC[reflB_pointI;reflBi_inv];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `num_closure (IMAGE2 (reflBf r) G) (reflBf r (pointI (reflBi r m))) = num_closure G (pointI (reflBi r m))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_num_closure);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[];
+  (* inductive_set clause *)
+  REP_BASIC_TAC;
+  (* isc *)
+  USE 16(REWRITE_RULE[IMAGE2]);
+  USE 16 (MATCH_MP SUBSET_PREIMAGE);
+  REP_BASIC_TAC;
+  TSPEC `Z` 0;
+  TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[]);
+  REWR 16;
+  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE_CLAUSES]);
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `D = IMAGE (reflBf r) C` ABBREV_TAC ;
+  TYPE_THEN `D' = IMAGE (reflBf r) C'` ABBREV_TAC ;
+  TSPEC `D` 14; (* *)
+  TSPEC `D'` 14;
+  TYPE_THEN `S D /\ IMAGE2 (reflBf r) G D' /\ adj D D'` SUBGOAL_TAC;
+  SUBCONJ_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "D";
+  TYPE_THEN `IMAGE (IMAGE (reflBf r)) Z (IMAGE (reflBf r) C) = Z C` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_app;
+  TYPE_THEN `edge` EXISTS_TAC;
+  TYPE_THEN `edge` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* fh1 *)
+  SUBCONJ_TAC;
+  EXPAND_TAC "D'";
+  REWRITE_TAC[IMAGE2;IMAGE];
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  EXPAND_TAC "D";
+  EXPAND_TAC "D'";
+  TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET;edge_euclid2];
+  DISCH_TAC;
+  TYPE_THEN `(adj C C' ==> adj (IMAGE (reflBf r) C) (IMAGE (reflBf r) C'))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  homeo_adj;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWR 14;
+  UND 14;
+  EXPAND_TAC "D'";
+  TYPE_THEN `IMAGE (IMAGE (reflBf r)) Z (IMAGE (reflBf r) C') = Z C'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_app;
+  TYPE_THEN `edge` EXISTS_TAC;
+  TYPE_THEN `edge` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  UND 3;
+  UND 19;
+  ASM_MESON_TAC[ISUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  REWR 0;
+  ASM_REWRITE_TAC[IMAGE2];
+  ]);;
+  (* }}} *)
+
+let reflC_segment = prove_by_refinement(
+  `!G . (segment G ==> (segment (IMAGE2 (reflCf) G)))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[segment];
+  COPY 0;
+  USE 0(REWRITE_RULE[segment]);
+  REP_BASIC_TAC;
+  TYPE_THEN `homeomorphism (reflCf) top2 top2` SUBGOAL_TAC;
+  REWRITE_TAC[reflC_homeo];
+  DISCH_TAC;
+  ASSUME_TAC top2_top;
+  ASSUME_TAC top2_unions;
+  TYPE_THEN `BIJ (reflCf) (euclid 2) (euclid 2)` SUBGOAL_TAC;
+  ASM_MESON_TAC[homeomorphism];
+  DISCH_TAC;
+  TYPE_THEN `INJ (IMAGE (reflCf)) edge edge` SUBGOAL_TAC;
+  REWRITE_TAC[INJ;reflC_edge;];
+  REP_BASIC_TAC;
+  TYPE_THEN `y SUBSET (euclid 2) /\ x SUBSET (euclid 2)` SUBGOAL_TAC;
+  ASM_MESON_TAC[edge_euclid2];
+  DISCH_TAC;
+  ASM_MESON_TAC[image_power_inj];
+  DISCH_TAC;
+  (* start cases *)
+  SUBCONJ_TAC;
+  REWRITE_TAC[IMAGE2];
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  SUBCONJ_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE2; EQ_EMPTY]);
+  TSPEC `IMAGE (reflCf) u` 4;
+  UND 4;
+  REWRITE_TAC[];
+  TYPE_THEN `IMAGE (IMAGE (reflCf)) G (IMAGE (reflCf) u) = G u` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_app;
+  EXISTS_TAC `edge`;
+  EXISTS_TAC `edge`;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (*
+  ASM_MESON_TAC[image_power_inj];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  *)
+  SUBCONJ_TAC;
+  REWRITE_TAC[IMAGE2;SUBSET];
+  GEN_TAC;
+  GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV )  [IMAGE];
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  reflC_edge;
+  ASM_MESON_TAC[ISUBSET;];
+  DISCH_TAC;
+  (* num closure clause *)
+  CONJ_TAC;
+  GEN_TAC;
+  TYPE_THEN `pointI m = reflCf (pointI (reflCi m))` SUBGOAL_TAC;
+  REWRITE_TAC[reflC_pointI;reflCi_inv];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `num_closure (IMAGE2 (reflCf) G) (reflCf (pointI (reflCi m))) = num_closure G (pointI (reflCi m))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_num_closure);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[];
+  (* inductive_set clause *)
+  REP_BASIC_TAC;
+  (* isc *)
+  USE 16(REWRITE_RULE[IMAGE2]);
+  USE 16 (MATCH_MP SUBSET_PREIMAGE);
+  REP_BASIC_TAC;
+  TSPEC `Z` 0;
+  TYPE_THEN `Z SUBSET G /\ ~(Z = {}) /\ (!C C'. Z C /\ G C' /\ adj C C' ==> Z C')` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[]);
+  REWR 16;
+  RULE_ASSUM_TAC  (REWRITE_RULE[IMAGE_CLAUSES]);
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `D = IMAGE (reflCf) C` ABBREV_TAC ;
+  TYPE_THEN `D' = IMAGE (reflCf) C'` ABBREV_TAC ;
+  TSPEC `D` 14; (* *)
+  TSPEC `D'` 14;
+  TYPE_THEN `S D /\ IMAGE2 (reflCf) G D' /\ adj D D'` SUBGOAL_TAC;
+  SUBCONJ_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "D";
+  TYPE_THEN `IMAGE (IMAGE (reflCf)) Z (IMAGE (reflCf) C) = Z C` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_app;
+  TYPE_THEN `edge` EXISTS_TAC;
+  TYPE_THEN `edge` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* fh1 *)
+  SUBCONJ_TAC;
+  EXPAND_TAC "D'";
+  REWRITE_TAC[IMAGE2;IMAGE];
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  EXPAND_TAC "D";
+  EXPAND_TAC "D'";
+  TYPE_THEN `C SUBSET (euclid 2) /\ (C' SUBSET (euclid 2))` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET;edge_euclid2];
+  DISCH_TAC;
+  TYPE_THEN `(adj C C' ==> adj (IMAGE (reflCf) C) (IMAGE (reflCf) C'))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  homeo_adj;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWR 14;
+  UND 14;
+  EXPAND_TAC "D'";
+  TYPE_THEN `IMAGE (IMAGE (reflCf)) Z (IMAGE (reflCf) C') = Z C'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_app;
+  TYPE_THEN `edge` EXISTS_TAC;
+  TYPE_THEN `edge` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  UND 3;
+  UND 19;
+  ASM_MESON_TAC[ISUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  REWR 0;
+  ASM_REWRITE_TAC[IMAGE2];
+  ]);;
+
+  (* }}} *)
+
+let point_x = prove_by_refinement(
+  `!x m. (x = point m) <=> (euclid 2 x /\ (FST m = x 0) /\ (SND m = x 1))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  EQ_TAC ;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[coord01;euclid_point];
+  REP_BASIC_TAC;
+  USE 2 (MATCH_MP   point_onto );
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[point_inj];
+  REWRITE_TAC[PAIR_SPLIT];
+  ASM_REWRITE_TAC[coord01];
+  ]);;
+  (* }}} *)
+
+(* next IMAGE of square *)
+
+let reflA_squ = prove_by_refinement(
+  `!m r.  IMAGE (reflAf r) (squ m) = squ (left  (reflAi r m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[squ;reflAf;reflAi;IMAGE ;left  ;];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "x'");
+  REWRITE_TAC[coord01;];
+  REWRITE_TAC[point_x];
+  CONV_TAC (dropq_conv "v");
+  EQ_TAC ;
+  REP_BASIC_TAC;
+  TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 4;
+  UND 5;
+  USE 0 (GSYM );
+  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
+  REAL_ARITH_TAC;
+  (* 2 *)
+  REP_BASIC_TAC;
+  TYPE_THEN `&2 * real_of_int r - u` EXISTS_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
+  UND 2;
+  UND 3;
+  USE 4 (GSYM);
+  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let reflB_squ = prove_by_refinement(
+  `!m r.  IMAGE (reflBf r) (squ m) = squ (down  (reflBi r m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[squ;reflBf;reflBi;IMAGE ;down  ;];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "x'");
+  REWRITE_TAC[coord01;];
+  REWRITE_TAC[point_x];
+  CONV_TAC (dropq_conv "u");
+  EQ_TAC ;
+  REP_BASIC_TAC;
+  TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 2;
+  UND 3;
+  USE 0 (GSYM );
+  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
+  REAL_ARITH_TAC;
+  (* 2 *)
+  REP_BASIC_TAC;
+  TYPE_THEN `&2 * real_of_int r - v` EXISTS_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `y - (y - x) = x`];
+  UND 0;
+  UND 1;
+  USE 4 (GSYM);
+  ASM_REWRITE_TAC[int_sub_th;int_of_num_th;int_add_th;int_mul_th;];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let reflC_squ = prove_by_refinement(
+  `!m.  IMAGE (reflCf) (squ m) = squ (  (reflCi m))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[squ;reflCf;reflCi;IMAGE ; ];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC EQ_EXT;
+  REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "x'");
+  REWRITE_TAC[coord01;];
+  REWRITE_TAC[point_x];
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "v");
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* move to sets *)
+let powerset = jordan_def `powerset (X:A->bool) = { z | z SUBSET X }`;;
+
+let image_sing = prove_by_refinement(
+  `!(f:A -> B) x. (IMAGE f {x} = {(f x)})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[IMAGE;INSERT];
+  CONV_TAC (dropq_conv "x'");
+  ]);;
+  (* }}} *)
+
+let image_unions = prove_by_refinement(
+  `!(f:A->B)  U.
+     (IMAGE f (UNIONS U) = UNIONS (IMAGE (IMAGE f) U))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[IMAGE;UNIONS;];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  CONV_TAC (dropq_conv "u");
+  ASM_REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  NAME_CONFLICT_TAC;
+  REWR 0;
+  KILL 1;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* move *)
+let segment_euclid = prove_by_refinement(
+  `!G. (segment G) ==> (closure top2 (UNIONS G) SUBSET euclid 2)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  closure_subset;
+  ASM_REWRITE_TAC[top2_top;GSYM top2_unions];
+  CONJ_TAC;
+  IMATCH_MP_TAC  closed_UNIV;
+  REWRITE_TAC[top2_top];
+  REWRITE_TAC[top2_unions;SUBSET;UNIONS;];
+  REP_BASIC_TAC;
+  TYPE_THEN `edge u` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment;ISUBSET];
+  ASM_MESON_TAC[edge_euclid2;ISUBSET];
+  ]);;
+  (* }}} *)
+
+let image_curve_cell_reflA  = prove_by_refinement(
+  `!G r. (segment G) ==>
+    (curve_cell (IMAGE2 (reflAf r) G) =
+           IMAGE2 (reflAf r) (curve_cell G))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[curve_cell];
+  REWRITE_TAC[IMAGE2;IMAGE_UNION;];
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;UNIONS;];
+  REP_BASIC_TAC;
+  TYPE_THEN `edge u` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment;ISUBSET;];
+  ASM_MESON_TAC[edge_euclid2;ISUBSET];
+  DISCH_TAC;
+  ASSUME_TAC top2_top;
+  ASSUME_TAC top2_unions;
+  (*  *)
+  TYPE_THEN `UNIONS (IMAGE (IMAGE (reflAf r)) G) = IMAGE (reflAf r) (UNIONS G)` SUBGOAL_TAC;
+  REWRITE_TAC[GSYM image_unions];
+  DISCH_THEN_REWRITE ;
+  (*  *)
+  TYPE_THEN `closure top2 (IMAGE (reflAf r) (UNIONS G)) = IMAGE (reflAf r) (closure top2 (UNIONS G))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_closure);
+  ASM_REWRITE_TAC[top2_top;reflA_homeo;top2_unions;];
+  DISCH_THEN_REWRITE;
+  (*  *)
+  TYPE_THEN `!n. IMAGE (reflAf r) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflAi r n))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN  `n' = reflAi r n` ABBREV_TAC ;
+  TYPE_THEN `pointI n = reflAf r (pointI n')` SUBGOAL_TAC;
+  EXPAND_TAC "n'";
+  KILL 4;
+  ASM_REWRITE_TAC[reflA_pointI;reflAi_inv];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  image_app;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+ TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  REWRITE_TAC[pointI;euclid_point];
+  ASSUME_TAC reflA_homeo;
+  RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  segment_euclid;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  (*  *)
+  REWRITE_TAC[IMAGE;];
+  CONV_TAC (dropq_conv "x'");
+(**** Modified by JRH to avoid GSPEC
+  REWRITE_TAC[INR IN_SING;GSPEC;];
+ ****)
+  REWRITE_TAC[INR IN_SING; UNWIND_THM2];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x'");
+  CONV_TAC (dropq_conv "y'");
+(**** Removed by JRH
+  REWRITE_TAC[GSPEC];
+ ****)
+  (*  *)
+  EQ_TAC ;
+  REP_BASIC_TAC;
+  TYPE_THEN `reflAi r n'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING; reflA_pointI; reflAi_inv;];
+(*** Removed by JRH
+  MESON_TAC[];
+ ****)
+  (*   *)
+  REP_BASIC_TAC;
+  TYPE_THEN `reflAi r n'` EXISTS_TAC;
+  ASM_REWRITE_TAC[reflAi_inv;];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING;reflA_pointI;];
+(*** Removed by JRH
+  MESON_TAC[];
+ ****)
+  ]);;
+  (* }}} *)
+
+let image_curve_cell_reflB  = prove_by_refinement(
+  `!G r. (segment G) ==>
+    (curve_cell (IMAGE2 (reflBf r) G) =
+           IMAGE2 (reflBf r) (curve_cell G))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[curve_cell];
+  REWRITE_TAC[IMAGE2;IMAGE_UNION;];
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;UNIONS;];
+  REP_BASIC_TAC;
+  TYPE_THEN `edge u` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment;ISUBSET;];
+  ASM_MESON_TAC[edge_euclid2;ISUBSET];
+  DISCH_TAC;
+  ASSUME_TAC top2_top;
+  ASSUME_TAC top2_unions;
+  (*  *)
+  TYPE_THEN `UNIONS (IMAGE (IMAGE (reflBf r)) G) = IMAGE (reflBf r) (UNIONS G)` SUBGOAL_TAC;
+  REWRITE_TAC[GSYM image_unions];
+  DISCH_THEN_REWRITE ;
+  (*  *)
+  TYPE_THEN `closure top2 (IMAGE (reflBf r) (UNIONS G)) = IMAGE (reflBf r) (closure top2 (UNIONS G))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_closure);
+  ASM_REWRITE_TAC[top2_top;reflB_homeo;top2_unions;];
+  DISCH_THEN_REWRITE;
+  (*  *)
+  TYPE_THEN `!n. IMAGE (reflBf r) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflBi r n))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN  `n' = reflBi r n` ABBREV_TAC ;
+  TYPE_THEN `pointI n = reflBf r (pointI n')` SUBGOAL_TAC;
+  EXPAND_TAC "n'";
+  KILL 4;
+  ASM_REWRITE_TAC[reflB_pointI;reflBi_inv];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  image_app;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+ TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  REWRITE_TAC[pointI;euclid_point];
+  ASSUME_TAC reflB_homeo;
+  RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  segment_euclid;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  (*  *)
+  REWRITE_TAC[IMAGE;];
+  CONV_TAC (dropq_conv "x'");
+
+(*** JRH changed this line to avoid GSPEC
+  REWRITE_TAC[INR IN_SING;GSPEC;];
+ ***)
+  REWRITE_TAC[INR IN_SING; UNWIND_THM2];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x'");
+  CONV_TAC (dropq_conv "y'");
+(*** JRH removed this to avoid GSPEC
+  REWRITE_TAC[GSPEC];
+ ***)
+  (*  *)
+  EQ_TAC ;
+  REP_BASIC_TAC;
+  TYPE_THEN `reflBi r n'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING; reflB_pointI; reflBi_inv;];
+(*** Removed by JRH
+  MESON_TAC[];
+ ****)
+  (*   *)
+  REP_BASIC_TAC;
+  TYPE_THEN `reflBi r n'` EXISTS_TAC;
+  ASM_REWRITE_TAC[reflBi_inv;];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING;reflB_pointI;];
+(*** Removed by JRH
+  MESON_TAC[];
+ ****)
+  ]);;
+  (* }}} *)
+
+let image_curve_cell_reflC  = prove_by_refinement(
+  `!G . (segment G) ==>
+    (curve_cell (IMAGE2 (reflCf ) G) =
+           IMAGE2 (reflCf) (curve_cell G))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[curve_cell];
+  REWRITE_TAC[IMAGE2;IMAGE_UNION;];
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  TYPE_THEN `UNIONS G SUBSET (euclid 2)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;UNIONS;];
+  REP_BASIC_TAC;
+  TYPE_THEN `edge u` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment;ISUBSET;];
+  ASM_MESON_TAC[edge_euclid2;ISUBSET];
+  DISCH_TAC;
+  ASSUME_TAC top2_top;
+  ASSUME_TAC top2_unions;
+  (*  *)
+  TYPE_THEN `UNIONS (IMAGE (IMAGE (reflCf)) G) = IMAGE (reflCf) (UNIONS G)` SUBGOAL_TAC;
+  REWRITE_TAC[GSYM image_unions];
+  DISCH_THEN_REWRITE ;
+  (*  *)
+  TYPE_THEN `closure top2 (IMAGE (reflCf) (UNIONS G)) = IMAGE (reflCf) (closure top2 (UNIONS G))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_closure);
+  ASM_REWRITE_TAC[top2_top;reflC_homeo;top2_unions;];
+  DISCH_THEN_REWRITE;
+  (*  *)
+  TYPE_THEN `!n. IMAGE (reflCf) (closure top2 (UNIONS G)) (pointI n) = closure top2 (UNIONS G) (pointI (reflCi n))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN  `n' = reflCi n` ABBREV_TAC ;
+  TYPE_THEN `pointI n = reflCf (pointI n')` SUBGOAL_TAC;
+  EXPAND_TAC "n'";
+  KILL 4;
+  ASM_REWRITE_TAC[reflC_pointI;reflCi_inv];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  image_app;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+ TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  REWRITE_TAC[pointI;euclid_point];
+  ASSUME_TAC reflC_homeo;
+  RULE_ASSUM_TAC  (REWRITE_RULE[homeomorphism;BIJ;top2_unions;]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  segment_euclid;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  (*  *)
+  REWRITE_TAC[IMAGE;];
+  CONV_TAC (dropq_conv "x'");
+(*** This line changed by JRH to avoid GSPEC
+  REWRITE_TAC[INR IN_SING;GSPEC;];
+ ***)
+  REWRITE_TAC[INR IN_SING; UNWIND_THM2];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x'");
+  CONV_TAC (dropq_conv "y'");
+ (*** Removed by JRH to avoid GSPEC
+  REWRITE_TAC[GSPEC];
+ ***)
+  (*  *)
+  EQ_TAC ;
+  REP_BASIC_TAC;
+  TYPE_THEN `reflCi n'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING; reflC_pointI; reflCi_inv;];
+(*** Removed by JRH
+  MESON_TAC[];
+ ****)
+  (*   *)
+  REP_BASIC_TAC;
+  TYPE_THEN `reflCi n'` EXISTS_TAC;
+  ASM_REWRITE_TAC[reflCi_inv;];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING;reflC_pointI;];
+(*** Removed by JRH
+  MESON_TAC[];
+ ****)
+  ]);;
+  (* }}} *)
+
+let inj_inter = prove_by_refinement(
+  `!(f:A->B) X Y A B. (INJ f X Y) /\ (A SUBSET X) /\ (B SUBSET X) ==>
+     (IMAGE f (A INTER B) = (IMAGE f A) INTER (IMAGE f B))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE;INTER ];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  EQ_TAC;
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[ISUBSET;];
+  REP_BASIC_TAC;
+  TYPE_THEN `x' = x''` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[ISUBSET;];
+  REP_BASIC_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let homeomorphism_induced_top = prove_by_refinement(
+  `!(f:A->B) U V A.  (homeomorphism f U V) /\ (A SUBSET (UNIONS U)) ==>
+      (IMAGE2 f (induced_top U A) = induced_top V (IMAGE f A))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[induced_top;];
+  COPY 1;
+  USE 1 (MATCH_MP homeo_bij);
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IMAGE2];
+  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
+  REWRITE_TAC[IMAGE];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x''");
+  (*  *)
+  TYPE_THEN `!t. U t ==> (g (t INTER A)  = g t INTER g A)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  inj_inter;
+  TYPE_THEN `(UNIONS U)` EXISTS_TAC;
+  TYPE_THEN `(UNIONS V)` EXISTS_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  sub_union;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (*   *)
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TSPEC `x'` 4;
+  REWR 4;
+  ASM_REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `g x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  (*  *)
+  REP_BASIC_TAC;
+  TYPE_THEN `?t. U t /\ (g t = x')` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TSPEC `t` 4;
+  REWR 4;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let ctop_reflA = prove_by_refinement(
+  `!G r. (segment G) ==>
+      (IMAGE2 (reflAf r) (ctop G) = ctop (IMAGE2 (reflAf r) G))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[ctop];
+  ASSUME_TAC reflA_homeo;
+  TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC;
+  REWRITE_TAC[top2_unions;DIFF;SUBSET;];
+  MESON_TAC[];
+  DISCH_TAC ;
+  (*   *)
+  TYPE_THEN `IMAGE2 (reflAf r) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflAf r) (euclid 2 DIFF  (UNIONS (curve_cell G))))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  homeomorphism_induced_top;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  AP_TERM_TAC;
+  TSPEC `r` 1;
+  (*  *)
+  TYPE_THEN `IMAGE (reflAf r) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflAf r) (UNIONS (curve_cell G)))` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]);
+  REP_BASIC_TAC;
+  USE 4 (MATCH_MP DIFF_SURJ);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[UNIONS;SUBSET;];
+  REP_BASIC_TAC;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC;
+  TYPE_THEN `cell u` SUBGOAL_TAC;
+  USE 7 (MATCH_MP curve_cell_cell);
+  ASM_MESON_TAC[ISUBSET;];
+  ASM_MESON_TAC[ISUBSET;cell_euclid];
+  DISCH_THEN_REWRITE;
+  AP_TERM_TAC;
+  REWRITE_TAC[image_unions];
+  AP_TERM_TAC;
+  ASM_SIMP_TAC[image_curve_cell_reflA];
+  REWRITE_TAC[IMAGE2];
+  ]);;
+  (* }}} *)
+
+let ctop_reflB = prove_by_refinement(
+  `!G r. (segment G) ==>
+      (IMAGE2 (reflBf r) (ctop G) = ctop (IMAGE2 (reflBf r) G))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[ctop];
+  ASSUME_TAC reflB_homeo;
+  TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC;
+  REWRITE_TAC[top2_unions;DIFF;SUBSET;];
+  MESON_TAC[];
+  DISCH_TAC ;
+  (*   *)
+  TYPE_THEN `IMAGE2 (reflBf r) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflBf r) (euclid 2 DIFF  (UNIONS (curve_cell G))))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  homeomorphism_induced_top;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  AP_TERM_TAC;
+  TSPEC `r` 1;
+  (*  *)
+  TYPE_THEN `IMAGE (reflBf r) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflBf r) (UNIONS (curve_cell G)))` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]);
+  REP_BASIC_TAC;
+  USE 4 (MATCH_MP DIFF_SURJ);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[UNIONS;SUBSET;];
+  REP_BASIC_TAC;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC;
+  TYPE_THEN `cell u` SUBGOAL_TAC;
+  USE 7 (MATCH_MP curve_cell_cell);
+  ASM_MESON_TAC[ISUBSET;];
+  ASM_MESON_TAC[ISUBSET;cell_euclid];
+  DISCH_THEN_REWRITE;
+  AP_TERM_TAC;
+  REWRITE_TAC[image_unions];
+  AP_TERM_TAC;
+  ASM_SIMP_TAC[image_curve_cell_reflB];
+  REWRITE_TAC[IMAGE2];
+  ]);;
+  (* }}} *)
+
+let ctop_reflC = prove_by_refinement(
+  `!G . (segment G) ==>
+      (IMAGE2 (reflCf) (ctop G) = ctop (IMAGE2 (reflCf) G))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[ctop];
+  ASSUME_TAC reflC_homeo;
+  TYPE_THEN `euclid 2 DIFF UNIONS (curve_cell G) SUBSET (UNIONS top2)` SUBGOAL_TAC;
+  REWRITE_TAC[top2_unions;DIFF;SUBSET;];
+  MESON_TAC[];
+  DISCH_TAC ;
+  (*   *)
+  TYPE_THEN `IMAGE2 (reflCf) (induced_top top2 (euclid 2 DIFF UNIONS (curve_cell G))) = induced_top top2 (IMAGE (reflCf) (euclid 2 DIFF  (UNIONS (curve_cell G))))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  homeomorphism_induced_top;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  AP_TERM_TAC;
+  (*  *)
+  TYPE_THEN `IMAGE (reflCf) (euclid 2 DIFF UNIONS (curve_cell G)) = euclid 2 DIFF (IMAGE (reflCf) (UNIONS (curve_cell G)))` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions;]);
+  REP_BASIC_TAC;
+  USE 4 (MATCH_MP DIFF_SURJ);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[UNIONS;SUBSET;];
+  REP_BASIC_TAC;
+  TYPE_THEN `G SUBSET edge` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment];
+  DISCH_TAC;
+  TYPE_THEN `cell u` SUBGOAL_TAC;
+  USE 7 (MATCH_MP curve_cell_cell);
+  ASM_MESON_TAC[ISUBSET;];
+  ASM_MESON_TAC[ISUBSET;cell_euclid];
+  DISCH_THEN_REWRITE;
+  AP_TERM_TAC;
+  REWRITE_TAC[image_unions];
+  AP_TERM_TAC;
+  ASM_SIMP_TAC[image_curve_cell_reflC];
+  REWRITE_TAC[IMAGE2];
+  ]);;
+  (* }}} *)
+
+let connected_homeo = prove_by_refinement(
+  `!(f:A->B) U V Z. (homeomorphism f U V /\ (Z SUBSET UNIONS U) ==>
+       (connected V (IMAGE f Z) = connected U Z))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `g = INV f (UNIONS U) (UNIONS V)` ABBREV_TAC ;
+  TYPE_THEN `Z = IMAGE g (IMAGE f Z)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IMAGE];
+  EXPAND_TAC "g";
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x''");
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
+  REP_BASIC_TAC;
+  TYPE_THEN `!x'. (UNIONS U x') ==> (INV f (UNIONS U) (UNIONS V) (f x') = x')` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  inv_comp_left;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (*  *)
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN ` x` EXISTS_TAC;
+  KILL 2;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET;];
+  REP_BASIC_TAC;
+  TSPEC `x'` 5;
+  TYPE_THEN `UNIONS U x'` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  REWR 5;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  EQ_TAC;
+  REP_BASIC_TAC;
+  UND 3;
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  IMATCH_MP_TAC  connect_image;
+  TYPE_THEN `V` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  INV_homeomorphism;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE;SUBSET;];
+  REP_BASIC_TAC;
+  UND 3;
+  EXPAND_TAC "g";
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `UNIONS U x''` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
+  TYPE_THEN `x = x''` SUBGOAL_TAC;
+  ASM_MESON_TAC[inv_comp_left];
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  connect_image;
+  TYPE_THEN `U` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE [homeomorphism;BIJ;INJ]);
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[SUBSET;IMAGE;];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x''");
+  ASM_MESON_TAC[ISUBSET;];
+  ]);;
+  (* }}} *)
+
+(* start here , Tues Jun 8 , 2004 *)
+
+let component = prove_by_refinement(
+  `!U (x:A) . (component  U x = {y | ?Z. connected U Z /\ Z x /\ Z y})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[component_DEF ;];
+  ]);;
+  (* }}} *)
+
+let component_homeo = prove_by_refinement(
+  `!(f:A->B) U V x. (homeomorphism f U V) /\ (UNIONS U x) ==>
+     (IMAGE f (component U x) = (component  V (f x)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[component ;IMAGE ; ];
+  IMATCH_MP_TAC  EQ_EXT ;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  CONV_TAC (dropq_conv "x'");
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `IMAGE f Z` EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `Z SUBSET UNIONS U` SUBGOAL_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[connected]);
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[connected_homeo];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE];
+  ASM_MESON_TAC[];
+  (*  *)
+  REP_BASIC_TAC;
+  (* *)
+  TYPE_THEN `?A. A SUBSET (UNIONS U) /\ (IMAGE f A = Z)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_power_surj;
+  TYPE_THEN `UNIONS V` EXISTS_TAC;
+  ASM_MESON_TAC[connected;homeomorphism];
+  REP_BASIC_TAC;
+  TYPE_THEN `A` EXISTS_TAC;
+  NAME_CONFLICT_TAC;
+  WITH 5 (REWRITE_RULE[IMAGE]);
+  USE 7 (GSYM);
+  REWR 2;
+  REP_BASIC_TAC;
+  TYPE_THEN `x''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWR 3;
+  REP_BASIC_TAC;
+  TYPE_THEN ` x = x'''` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE [homeomorphism;BIJ;INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC  ;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  KILL 7;
+  ASM_SIMP_TAC[GSYM connected_homeo];
+  ]);;
+  (* }}} *)
+
+let bij_homeo = prove_by_refinement(
+  `!(f:A->B) U V. (BIJ f (UNIONS U) (UNIONS V)) /\
+    (BIJ (IMAGE f) U V) ==> (homeomorphism f U V)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[homeomorphism;continuous;];
+  ASM_REWRITE_TAC[preimage;];
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  COPY 1;
+  UND 3;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ;SURJ]);
+  REP_BASIC_TAC;
+  TSPEC  `v` 1;
+  REWR 1;
+  REP_BASIC_TAC;
+  EXPAND_TAC "v";
+  TYPE_THEN `{x | UNIONS U x /\ IMAGE f y (f x)} = y` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  GEN_TAC;
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `IMAGE f y (f x) = y x` SUBGOAL_TAC;
+  IMATCH_MP_TAC image_app ;
+  TYPE_THEN `(UNIONS U)` EXISTS_TAC;
+  TYPE_THEN `(UNIONS V)` EXISTS_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[sub_union];
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[sub_union;ISUBSET];
+  REWRITE_TAC[IMAGE];
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  (* *)
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let homeomorphism_subset = prove_by_refinement(
+  `!(f:A->B) U V C. (homeomorphism f U V) /\ (C SUBSET U) ==>
+   (homeomorphism f C (IMAGE2 f C))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  bij_homeo;
+  SUBCONJ_TAC;
+  TYPE_THEN `UNIONS C SUBSET UNIONS U` SUBGOAL_TAC;
+  IMATCH_MP_TAC  UNIONS_UNIONS ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWRITE_TAC[IMAGE2 ;GSYM  image_unions;];
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ]);
+  REP_BASIC_TAC;
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+    SUBCONJ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `IMAGE f (UNIONS C) (f x) = (UNIONS C) x` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (image_app);
+  TYPE_THEN `(UNIONS U)` EXISTS_TAC;
+  TYPE_THEN `(UNIONS V)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC [ISUBSET];
+  REWRITE_TAC[INJ];
+  REP_BASIC_TAC;
+  REWRITE_TAC[SURJ];
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWRITE_TAC[BIJ];
+  WITH_FIRST (MATCH_MP homeo_bij);
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE2;];
+  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
+  REWRITE_TAC[IMAGE];
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  REWRITE_TAC[INJ;SURJ];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2]);
+  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
+  UND 6;
+  REWRITE_TAC[IMAGE];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let component_reflA = prove_by_refinement(
+  `!(f:A->B) G r x. (segment G) /\ (UNIONS (ctop G) x) ==>
+    (IMAGE (reflAf r) (component  (ctop G) x) =
+         (component  (ctop (IMAGE2 (reflAf r) G)) (reflAf r x)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  component_homeo;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `ctop (IMAGE2 (reflAf r) G) = IMAGE2 (reflAf r) (ctop G)` SUBGOAL_TAC ;
+  ASM_MESON_TAC[ctop_reflA];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  homeomorphism_subset;
+  TYPE_THEN `top2` EXISTS_TAC;
+  TYPE_THEN `top2` EXISTS_TAC;
+  REWRITE_TAC[reflA_homeo];
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[ctop_top2];
+  ]);;
+  (* }}} *)
+
+let component_reflB = prove_by_refinement(
+  `!(f:A->B) G r x. (segment G) /\ (UNIONS (ctop G) x) ==>
+    (IMAGE (reflBf r) (component  (ctop G) x) =
+         (component  (ctop (IMAGE2 (reflBf r) G)) (reflBf r x)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  component_homeo;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `ctop (IMAGE2 (reflBf r) G) = IMAGE2 (reflBf r) (ctop G)` SUBGOAL_TAC ;
+  ASM_MESON_TAC[ctop_reflB];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  homeomorphism_subset;
+  TYPE_THEN `top2` EXISTS_TAC;
+  TYPE_THEN `top2` EXISTS_TAC;
+  REWRITE_TAC[reflB_homeo];
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[ctop_top2];
+  ]);;
+  (* }}} *)
+
+let component_reflC = prove_by_refinement(
+  `!(f:A->B) G x. (segment G) /\ (UNIONS (ctop G) x) ==>
+    (IMAGE (reflCf) (component  (ctop G) x) =
+         (component  (ctop (IMAGE2 (reflCf) G)) (reflCf x)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  component_homeo;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `ctop (IMAGE2 (reflCf) G) = IMAGE2 (reflCf) (ctop G)` SUBGOAL_TAC ;
+  ASM_MESON_TAC[ctop_reflC];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  homeomorphism_subset;
+  TYPE_THEN `top2` EXISTS_TAC;
+  TYPE_THEN `top2` EXISTS_TAC;
+  REWRITE_TAC[reflC_homeo];
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[ctop_top2];
+  ]);;
+  (* }}} *)
+
+let subset_union_inter = prove_by_refinement(
+  `!(X:A->bool) A B. (X SUBSET (A UNION B)   ==>
+      (~(X INTER A = EMPTY )) \/ (~(X INTER B = EMPTY)) \/ (X = EMPTY ))`,
+  (* {{{ proof *)
+  [
+  (REWRITE_TAC [EMPTY_EXISTS;SUBSET;UNION;INTER;EQ_EMPTY ; ]);
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let squ_disj = prove_by_refinement(
+  `!m n. ((squ m INTER squ n = {}) <=> ~(m = n))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+    EQ_TAC;
+  DISCH_ALL_TAC;
+  REWR 1;
+  RULE_ASSUM_TAC (REWRITE_RULE[INTER_IDEMPOT;]);
+  ASM_MESON_TAC[cell_nonempty;cell_rules];
+  DISCH_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `squ m = squ n` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  ASM_MESON_TAC[cell_rules];
+  ASM_REWRITE_TAC[squ_inj];
+  ]);;
+  (* }}} *)
+
+(* move way up *)
+let cell_clauses = prove_by_refinement(
+  `(!m. (~(v_edge m = EMPTY ) /\ ~(h_edge m = EMPTY )
+       /\ ~(squ m = EMPTY ) /\ ~({(pointI m)} = EMPTY ))) /\
+   (!m n. (v_edge m INTER {(pointI n)} = EMPTY ) /\
+         ({(pointI n)} INTER v_edge m = EMPTY ) /\
+  (h_edge m INTER {(pointI n)} = EMPTY ) /\
+         ({(pointI n)} INTER h_edge m = EMPTY ) /\
+  (squ m INTER {(pointI n)} = EMPTY ) /\
+         ({(pointI n)} INTER squ m = EMPTY ) /\
+       ((v_edge m INTER v_edge n  = EMPTY ) <=> ~(m = n) ) /\
+   ((h_edge m INTER h_edge n  = EMPTY ) <=> ~(m = n) ) /\
+  ((squ m INTER squ n  = EMPTY ) <=> ~(m = n) ) /\
+  (squ m INTER h_edge n = EMPTY ) /\
+         (h_edge n INTER squ m = EMPTY ) /\
+  (squ m INTER v_edge n = EMPTY ) /\
+        ( v_edge n INTER squ m = EMPTY ) /\
+   (h_edge m INTER v_edge n = EMPTY ) /\
+        ( v_edge n INTER h_edge m = EMPTY ) /\
+   (({(pointI n)} INTER {(pointI m)} = EMPTY ) <=> ~(n = m)) /\
+   (({(pointI n)} = {(pointI m)}  ) <=> (n = m)) /\
+   ~(h_edge n = {(pointI m)}) /\
+   ~(v_edge n = {(pointI m)}) /\
+   ~(squ n = {(pointI m)}) /\
+   ~( {(pointI m)} = h_edge n) /\
+~( {(pointI m)} = v_edge n) /\
+~( {(pointI m)} = squ n) /\
+~(h_edge m = v_edge n) /\
+((h_edge m = h_edge n) <=> (m = n)) /\
+~(h_edge m = squ n) /\
+~(v_edge m = h_edge n) /\
+((v_edge m = v_edge n) <=> (m = n)) /\
+~(v_edge m = squ n) /\
+~(squ m = h_edge n) /\
+((squ m = squ n) <=> (m = n)) /\
+~(squ m = v_edge n) /\
+~(squ m (pointI n)) /\
+~(v_edge m (pointI n)) /\
+~(h_edge m (pointI n)) /\
+((pointI n = pointI m) <=> (n = m)))  `,
+
+  (* {{{ proof *)
+  (let notrr = REWRITE_RULE[not_eq] in
+  let interc = ONCE_REWRITE_RULE[INTER_COMM] in
+  ([
+  CONJ_TAC ;
+  ASM_MESON_TAC[cell_nonempty;cell_rules];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[INTER_ACI;notrr v_edge_disj;notrr h_edge_disj;interc square_h_edge;square_h_edge;interc square_v_edge;square_v_edge;square_disj;single_inter;h_edge_inj;v_edge_inj;notrr squ_inj;INR IN_SING;hv_edgeV2; square_h_edgeV2; square_v_edgeV2;hv_edge;square_pointIv2;v_edge_pointIv2;h_edge_pointIv2;notrr single_inter;v_edge_pointI;h_edge_pointI;square_pointI;pointI_inj;squ_disj];
+  REWRITE_TAC[eq_sing;INR IN_SING;pointI_inj;];
+  CONV_TAC (dropq_conv "u");
+  ASM_MESON_TAC[pointI_inj];
+  ])));;
+  (* }}} *)
+
+let inter_union = prove_by_refinement(
+  `!X A (B:A->bool). ~(X INTER (A UNION B) = EMPTY) ==>
+    ~(X INTER A = EMPTY) \/ ~(X INTER B = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INTER;UNION;EMPTY_EXISTS;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let squc_v = prove_by_refinement(
+  `!m n. (v_edge m SUBSET squc n) ==> (n = m) \/ (n = left  m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[squc_union;];
+  REP_BASIC_TAC;
+  USE_FIRST (MATCH_MP subset_union_inter) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
+  REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  KILL 0;
+  USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
+  ASM_REWRITE_TAC[right_left];
+  (*   *)
+  ]);;
+  (* }}} *)
+
+let squc_h = prove_by_refinement(
+  `!m n. (h_edge m SUBSET squc n) ==> (n = m) \/ (n = down  m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[squc_union;];
+  REP_BASIC_TAC;
+  USE_FIRST (MATCH_MP subset_union_inter) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
+  REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  KILL 0;
+  USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses])) ;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[right_left];
+  KILL 0;
+  REPEAT (USE_FIRST (MATCH_MP inter_union) THEN (RULE_ASSUM_TAC (REWRITE_RULE[cell_clauses]))) ;
+  ASM_MESON_TAC [];
+  (*   *)
+  ]);;
+  (* }}} *)
+
+let component_empty = prove_by_refinement(
+  `!U (x:A). (topology_ U) ==> ((component  U x = EMPTY) = ~(UNIONS U x))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[component ;EQ_EMPTY;];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TSPEC `x` 2;
+  ASM_MESON_TAC[connected_sing;INR IN_SING;];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[connected]);
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  ]);;
+  (* }}} *)
+
+let image_imp = prove_by_refinement(
+  `!(f:A->B) X t. X t ==> (IMAGE f X) (f t)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let image_inj = prove_by_refinement(
+  `!(f:A->B) X A B. (INJ f X UNIV) /\ (A SUBSET X ) /\ (B SUBSET X) /\
+     (IMAGE f A SUBSET IMAGE f B) ==> (A SUBSET B)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ;IMAGE;SUBSET;];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let closure_euclid = prove_by_refinement(
+  `closure (top2) (euclid 2) = euclid 2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closure;top2];
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  INTERS_SUBSET;
+  REWRITE_TAC[SUBSET_REFL;];
+  ASM_MESON_TAC[closed_UNIV;top_of_metric_top;metric_euclid;top_of_metric_unions;];
+  REWRITE_TAC[INTERS;SUBSET];
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let closure_euclid = prove_by_refinement(
+  `!A. (A SUBSET (euclid 2) ==> (closure top2 A SUBSET (euclid 2)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ONCE_REWRITE_TAC [GSYM closure_euclid];
+  IMATCH_MP_TAC  subset_of_closure;
+  ASM_REWRITE_TAC[top2_top];
+  ]);;
+  (* }}} *)
+
+let along_lemma7 = prove_by_refinement(
+  `!G m n x e. (segment G /\ (squ n SUBSET component  (ctop G) x) /\
+     (v_edge m SUBSET squc n) /\
+     (G (v_edge m)) /\ G e /\ (closure top2 e (pointI m)) ==>
+   (?p. e SUBSET closure top2 (squ p) /\
+       (squ p SUBSET (component  (ctop G) x))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  WITH_FIRST (MATCH_MP squc_v);
+  FIRST_ASSUM (DISJ_CASES_TAC);
+  REWR 3;
+  IMATCH_MP_TAC  along_lemma6;
+  TYPE_THEN `m` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWR 4;
+  (* 2nd side *)
+  REWR 4;
+  REWR 3;
+  KILL 6;
+  KILL 7;
+  TYPE_THEN `e' = IMAGE (reflAf (&:0)) e ` ABBREV_TAC ;
+  TYPE_THEN `G' = IMAGE2 (reflAf (&:0)) G` ABBREV_TAC ;
+  TYPE_THEN `x' = reflAf (&:0) x` ABBREV_TAC ;
+  TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC;
+  TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBGOAL_TAC;
+  USE 4(REWRITE_RULE[SUBSET]);
+  TYPE_THEN `~(squ (left  m) = EMPTY)` SUBGOAL_TAC;
+  ASM_MESON_TAC[cell_nonempty;cell_rules];
+  REWRITE_TAC[EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  TSPEC `u` 4;
+  REWR 4;
+  ASM_MESON_TAC[];
+  TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC;
+  ASM_MESON_TAC[ctop_top];
+  ASM_SIMP_TAC [component_empty];
+  DISCH_TAC;
+  TYPE_THEN `component  (ctop G') x' = IMAGE (reflAf (&:0)) (component  (ctop G) x)` SUBGOAL_TAC;
+  ASM_MESON_TAC[component_reflA;];
+  DISCH_TAC;
+  (*  *)
+  TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  along_lemma6;
+  TYPE_THEN `reflAi (&:0) m` EXISTS_TAC;
+  (SUBCONJ_TAC);
+  (* 1st claus *)
+  EXPAND_TAC "G'";
+  IMATCH_MP_TAC reflA_segment;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  (* 2nd clause *)
+  ASM_REWRITE_TAC[];
+  (* goal 2c *)
+  USE 4(MATCH_MP (ISPEC `reflAf (&:0)` IMAGE_SUBSET ));
+  TYPE_THEN `squ(reflAi (&:0) m) = IMAGE (reflAf (&:0)) (squ (left  m))` SUBGOAL_TAC;
+  REWRITE_TAC[reflA_squ];
+  AP_TERM_TAC;
+  REWRITE_TAC[reflAi;left ;PAIR_SPLIT; ];
+  INT_ARITH_TAC;
+  ASM_MESON_TAC[];
+  (* 3 *)
+  CONJ_TAC;
+  REWRITE_TAC[GSYM reflA_v_edge];
+  EXPAND_TAC "G'";
+  REWRITE_TAC[IMAGE2];
+  UND 2;
+  (* goal 3c *)
+  MESON_TAC[image_imp];
+  (* <2> *)
+  CONJ_TAC;
+  EXPAND_TAC "G'";
+  EXPAND_TAC "e'";
+  REWRITE_TAC[IMAGE2];
+  ASM_MESON_TAC[image_imp];
+  EXPAND_TAC "e'";
+  TYPE_THEN `closure top2 (IMAGE (reflAf (&:0)) e) = IMAGE (reflAf (&:0)) (closure top2 e)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_closure);
+  ASM_REWRITE_TAC[top2_top;reflA_homeo;top2_unions;];
+  TYPE_THEN `edge e ` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment;ISUBSET];
+  MESON_TAC[ISUBSET;edge_euclid2;];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[GSYM reflA_pointI];
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* <1> *)
+  TYPE_THEN `p = left  (reflAi (&:0) p')` ABBREV_TAC ;
+  TYPE_THEN `squ p' = IMAGE (reflAf (&:0) ) (squ p)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[reflA_squ;];
+  AP_TERM_TAC;
+  EXPAND_TAC "p";
+  REWRITE_TAC[left ;reflAi;PAIR_SPLIT;];
+  INT_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `p` EXISTS_TAC;
+  (* LAST *)
+  ASSUME_TAC top2_top;
+  TYPE_THEN `homeomorphism (reflAf (&:0)) top2 top2` SUBGOAL_TAC;
+  ASM_MESON_TAC[reflA_homeo];
+  DISCH_TAC;
+  ASSUME_TAC top2_unions;
+  TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC;
+  MESON_TAC[squ_euclid;top2_unions];
+  DISCH_TAC;
+  CONJ_TAC; (* split *)
+  UND 12;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "e'";
+  TYPE_THEN `closure top2 (IMAGE (reflAf (&:0)) (squ p)) = IMAGE (reflAf (&:0)) (closure top2 (squ p))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_closure);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  (* x *)
+  DISCH_TAC;
+  IMATCH_MP_TAC  (ISPEC `reflAf (&:0)` image_inj);
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  INJ_UNIV;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflA_homeo;];
+  CONJ_TAC;
+    TYPE_THEN `edge e ` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment;ISUBSET];
+  MESON_TAC[ISUBSET;edge_euclid2;];
+  IMATCH_MP_TAC  closure_euclid;
+  REWRITE_TAC[squ_euclid];
+  (* last'' *)
+  IMATCH_MP_TAC  (ISPEC `reflAf (&:0)` image_inj);
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  INJ_UNIV;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflA_homeo;];
+  CONJ_TAC;
+  REWRITE_TAC[squ_euclid];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
+  ASM_REWRITE_TAC[component_unions;ctop_unions];
+  REWRITE_TAC[DIFF;SUBSET];
+  MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let v_edge_cases = prove_by_refinement(
+  `!j m. closure top2 (v_edge j) (pointI m) ==> (j = m) \/ (j = down m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[v_edge_closure;vc_edge];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[UNION;cell_clauses;INR IN_SING;plus_e12]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  DISJ2_TAC;
+  ASM_REWRITE_TAC[down;PAIR_SPLIT;];
+  INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let squ_squc = prove_by_refinement(
+  `!r n m. (IMAGE (reflBf r) (squ n) = squ m) ==>
+    (IMAGE (reflBf r) (squc n) = squc m)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[GSYM squ_closure];
+  TYPE_THEN `IMAGE (reflBf r) (closure top2 (squ n)) = closure top2 (IMAGE (reflBf r) (squ n))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  homeo_closure;
+  ASM_REWRITE_TAC[top2_top;top2_unions;reflB_homeo;squ_euclid;];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let squ_squc_C = prove_by_refinement(
+  `!n m. (IMAGE (reflCf) (squ n) = squ m) ==>
+    (IMAGE (reflCf) (squc n) = squc m)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[GSYM squ_closure];
+  TYPE_THEN `IMAGE (reflCf) (closure top2 (squ n)) = closure top2 (IMAGE (reflCf) (squ n))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  homeo_closure;
+  ASM_REWRITE_TAC[top2_top;top2_unions;reflC_homeo;squ_euclid;];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let along_lemma8 = prove_by_refinement(
+  `!G m n j x e. (segment G /\ (squ n SUBSET component  (ctop G) x) /\
+     (v_edge j SUBSET squc n) /\ (closure top2 (v_edge j) (pointI m)) /\
+    (G (v_edge j)) /\ G e /\ (closure top2 e (pointI m)) ==>
+   (?p. e SUBSET closure top2 (squ p) /\
+       (squ p SUBSET (component  (ctop G) x))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  USE_FIRST (MATCH_MP v_edge_cases);
+  FIRST_ASSUM (DISJ_CASES_TAC);
+  IMATCH_MP_TAC  along_lemma7;
+  ASM_MESON_TAC[];
+  KILL 3;
+  REWR 4;
+  REWR 2;
+  KILL 7;
+  (* INSERT lemmas here *)
+  TYPE_THEN `e' = IMAGE (reflBf (&:0)) e ` ABBREV_TAC ;
+  TYPE_THEN `G' = IMAGE2 (reflBf (&:0)) G` ABBREV_TAC ;
+  TYPE_THEN `x' = reflBf (&:0) x` ABBREV_TAC ;
+  TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC;
+  TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBGOAL_TAC;
+  USE 5(REWRITE_RULE[SUBSET]);
+  TYPE_THEN `~(squ (n) = EMPTY)` SUBGOAL_TAC;
+  ASM_MESON_TAC[cell_nonempty;cell_rules];
+  REWRITE_TAC[EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC;
+  ASM_MESON_TAC[ctop_top];
+  ASM_SIMP_TAC [component_empty];
+  DISCH_TAC;
+  TYPE_THEN `component  (ctop G') x' = IMAGE (reflBf (&:0)) (component  (ctop G) x)` SUBGOAL_TAC;
+  ASM_MESON_TAC[component_reflB;];
+  DISCH_TAC;
+  (*  gok to here *)
+  TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  along_lemma7;
+  TYPE_THEN `(reflBi (&:0))  m` EXISTS_TAC;
+  TYPE_THEN `down (reflBi (&:0) n)` EXISTS_TAC;
+  (SUBCONJ_TAC);
+  (* 1st claus *)
+  EXPAND_TAC "G'";
+  IMATCH_MP_TAC reflB_segment;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  (* 2nd clause *)
+  ASM_REWRITE_TAC[GSYM reflB_squ];
+  (* goal 2c *)
+  IMATCH_MP_TAC   (ISPEC `reflBf (&:0)` IMAGE_SUBSET );
+  ASM_REWRITE_TAC[];
+  (* 3 *)
+  TYPE_THEN `squc (down (reflBi (&:0) n)) = IMAGE (reflBf (&:0)) (squc n)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM squ_squc);
+  REWRITE_TAC[reflB_squ];
+  DISCH_THEN_REWRITE;  (* end *)
+  TYPE_THEN `v_edge (reflBi (&:0) m) = IMAGE (reflBf (&:0)) (v_edge (down m))` SUBGOAL_TAC;
+  REWRITE_TAC[reflB_v_edge];
+  AP_TERM_TAC ;
+  REWRITE_TAC[reflBi;down;PAIR_SPLIT ];
+  INT_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  CONJ_TAC;
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  ASM_REWRITE_TAC[];
+  (* gok2 *)
+  CONJ_TAC;
+  EXPAND_TAC "G'";
+  REWRITE_TAC[IMAGE2];
+  UND 2;
+  (* goal 3c *)
+  MESON_TAC[image_imp];
+  (* <2> gok1 *)
+  CONJ_TAC;
+  EXPAND_TAC "G'";
+  EXPAND_TAC "e'";
+  REWRITE_TAC[IMAGE2];
+  ASM_MESON_TAC[image_imp];
+  EXPAND_TAC "e'";
+  (* 2 total *)
+  TYPE_THEN `closure top2 (IMAGE (reflBf (&:0)) e) = IMAGE (reflBf (&:0)) (closure top2 e)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_closure);
+  ASM_REWRITE_TAC[top2_top;reflB_homeo;top2_unions;];
+  TYPE_THEN `edge e ` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment;ISUBSET];
+  MESON_TAC[ISUBSET;edge_euclid2;];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[GSYM reflB_pointI];
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* <1> *)
+  TYPE_THEN `p = down  (reflBi (&:0) p')` ABBREV_TAC ;
+  TYPE_THEN `squ p' = IMAGE (reflBf (&:0) ) (squ p)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[reflB_squ;];
+  AP_TERM_TAC;
+  EXPAND_TAC "p";
+  REWRITE_TAC[down ;reflBi;PAIR_SPLIT;];
+  INT_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `p` EXISTS_TAC;
+  (* LAST *)
+  ASSUME_TAC top2_top;
+  TYPE_THEN `homeomorphism (reflBf (&:0)) top2 top2` SUBGOAL_TAC;
+  ASM_MESON_TAC[reflB_homeo];
+  DISCH_TAC;
+  ASSUME_TAC top2_unions;
+  TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC;
+  MESON_TAC[squ_euclid;top2_unions];
+  DISCH_TAC;
+  CONJ_TAC; (* split *)
+  UND 12;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "e'";
+  TYPE_THEN `closure top2 (IMAGE (reflBf (&:0)) (squ p)) = IMAGE (reflBf (&:0)) (closure top2 (squ p))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_closure);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  (* x *)
+  DISCH_TAC;
+  IMATCH_MP_TAC  (ISPEC `reflBf (&:0)` image_inj);
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  INJ_UNIV;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflB_homeo;];
+  CONJ_TAC;
+    TYPE_THEN `edge e ` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment;ISUBSET];
+  MESON_TAC[ISUBSET;edge_euclid2;];
+  IMATCH_MP_TAC  closure_euclid;
+  REWRITE_TAC[squ_euclid];
+  (* last'' *)
+  IMATCH_MP_TAC  (ISPEC `reflBf (&:0)` image_inj);
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  INJ_UNIV;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflB_homeo;];
+  CONJ_TAC;
+  REWRITE_TAC[squ_euclid];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
+  ASM_REWRITE_TAC[component_unions;ctop_unions];
+  REWRITE_TAC[DIFF;SUBSET];
+  MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let along_lemma9 = prove_by_refinement(
+  `!G m n e' x e. (segment G /\ (squ n SUBSET component  (ctop G) x) /\
+     (e' SUBSET squc n) /\ (closure top2 e' (pointI m)) /\ (edge e') /\
+    (G e') /\ G e /\ (closure top2 e (pointI m)) ==>
+   (?p. e SUBSET closure top2 (squ p) /\
+       (squ p SUBSET (component  (ctop G) x))))`,
+  (* {{{ proof *)
+  [
+    REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[edge]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM (DISJ_CASES_TAC);
+  IMATCH_MP_TAC  along_lemma8;
+  ASM_MESON_TAC[];
+  TYPE_THEN `edge e` SUBGOAL_TAC;
+  ASM_MESON_TAC[segment;ISUBSET];
+  ASM_SIMP_TAC[];
+  DISCH_TAC;
+  KILL 3;
+  REWR 4;
+  REWR 2;
+  REWR 5;
+  KILL 8;
+  (* INSERT lemmas here *)
+  TYPE_THEN `e' = IMAGE (reflCf) e ` ABBREV_TAC ;
+  TYPE_THEN `G' = IMAGE2 (reflCf) G` ABBREV_TAC ;
+  TYPE_THEN `x' = reflCf x` ABBREV_TAC ;
+  TYPE_THEN `UNIONS (ctop G) x` SUBGOAL_TAC;
+  TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBGOAL_TAC;
+  USE 6(REWRITE_RULE[SUBSET]);
+  TYPE_THEN `~(squ (n) = EMPTY)` SUBGOAL_TAC;
+  ASM_MESON_TAC[cell_nonempty;cell_rules];
+  REWRITE_TAC[EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `topology_ (ctop G)` SUBGOAL_TAC;
+  ASM_MESON_TAC[ctop_top];
+  ASM_SIMP_TAC [component_empty];
+  DISCH_TAC;
+  TYPE_THEN `component  (ctop G') x' = IMAGE (reflCf) (component  (ctop G) x)` SUBGOAL_TAC;
+  ASM_MESON_TAC[component_reflC;];
+  DISCH_TAC;
+  (*  gok to here *)
+  TYPE_THEN `?p'. e' SUBSET closure top2 (squ p') /\ squ p' SUBSET component (ctop G') x'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  along_lemma8;
+  TYPE_THEN `(reflCi)  m` EXISTS_TAC;
+  TYPE_THEN `(reflCi n)` EXISTS_TAC;
+  TYPE_THEN `reflCi m'` EXISTS_TAC;
+  (SUBCONJ_TAC);
+  (* 1st claus *)
+  EXPAND_TAC "G'";
+  IMATCH_MP_TAC reflC_segment;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  (* 2nd clause *)
+  ASM_REWRITE_TAC[GSYM reflC_squ];
+  (* goal 2c *)
+  IMATCH_MP_TAC   (ISPEC `reflCf` IMAGE_SUBSET );
+  ASM_REWRITE_TAC[];
+  (* 3 *)
+  TYPE_THEN `squc ( (reflCi n)) = IMAGE (reflCf) (squc n)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM squ_squc_C);
+  REWRITE_TAC[reflC_squ];
+  DISCH_THEN_REWRITE;  (* end *)
+  TYPE_THEN `v_edge (reflCi  m') = IMAGE (reflCf ) (h_edge ( m'))` SUBGOAL_TAC;
+  REWRITE_TAC[reflC_hv_edge];
+  DISCH_THEN_REWRITE;
+  CONJ_TAC;
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  ASM_REWRITE_TAC[];
+  (* gok2 *)
+  (* INSERT *)
+  TYPE_THEN `!e. (edge e) ==> (closure top2 (IMAGE (reflCf ) e) = IMAGE (reflCf) (closure top2 e))` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_closure);
+  ASM_REWRITE_TAC[top2_top;reflC_homeo;top2_unions;];
+  IMATCH_MP_TAC  edge_euclid2;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC ;
+  TYPE_THEN `edge (h_edge m')` SUBGOAL_TAC;
+  ASM_MESON_TAC[edge];
+  DISCH_TAC;
+  ASM_SIMP_TAC[];
+  REWRITE_TAC[GSYM reflC_pointI];
+  CONJ_TAC;
+  ASM_MESON_TAC[image_imp];
+  (* to here *)
+  CONJ_TAC;
+  EXPAND_TAC "G'";
+  REWRITE_TAC[IMAGE2];
+  UND 2;
+  (* goal 3c *)
+  MESON_TAC[image_imp];
+  (* <2> gok1 *)
+  CONJ_TAC;
+  EXPAND_TAC "G'";
+  EXPAND_TAC "e'";
+  REWRITE_TAC[IMAGE2];
+  ASM_MESON_TAC[image_imp];
+  EXPAND_TAC "e'";
+  (* 2 total *)
+  ASM_SIMP_TAC[];
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* <1> *)
+  TYPE_THEN `p = reflCi p'` ABBREV_TAC ;
+  TYPE_THEN `squ p' = IMAGE (reflCf ) (squ p)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[reflC_squ;];
+  AP_TERM_TAC;
+  EXPAND_TAC "p";
+  REWRITE_TAC[reflCi_inv;PAIR_SPLIT;];
+  DISCH_TAC;
+  TYPE_THEN `p` EXISTS_TAC;
+  (* LAST *)
+  ASSUME_TAC top2_top;
+  TYPE_THEN `homeomorphism (reflCf) top2 top2` SUBGOAL_TAC;
+  ASM_MESON_TAC[reflC_homeo];
+  DISCH_TAC;
+  ASSUME_TAC top2_unions;
+  TYPE_THEN `squ p SUBSET (UNIONS (top2))` SUBGOAL_TAC;
+  MESON_TAC[squ_euclid;top2_unions];
+  DISCH_TAC;
+  TYPE_THEN `closure top2 (IMAGE (reflCf) (squ p)) = IMAGE (reflCf) (closure top2 (squ p))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM homeo_closure);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  CONJ_TAC; (* split *)
+  IMATCH_MP_TAC  (ISPEC `reflCf` image_inj);
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  INJ_UNIV;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflC_homeo;];
+  CONJ_TAC;
+  ASM_MESON_TAC[edge_euclid2];
+  CONJ_TAC;
+  IMATCH_MP_TAC  closure_euclid;
+  REWRITE_TAC[squ_euclid];
+  UND 21;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[reflC_squ];
+  TYPE_THEN `reflCi p = p'` SUBGOAL_TAC;
+  EXPAND_TAC "p";
+  REWRITE_TAC[reflCi_inv];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  (* last'' *)
+  UND 13;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  (ISPEC `reflCf` image_inj);
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  INJ_UNIV;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  REWRITE_TAC [REWRITE_RULE[homeomorphism;BIJ;top2_unions] reflC_homeo;];
+  CONJ_TAC;
+  REWRITE_TAC[squ_euclid];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
+  ASM_REWRITE_TAC[component_unions;ctop_unions];
+  REWRITE_TAC[DIFF;SUBSET];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let along_lemma10 = prove_by_refinement(
+  `!G x. (segment G /\ ~(component  (ctop G) x  = EMPTY) ) ==>
+    inductive_set G
+        { e | (G e /\ (?p. (e SUBSET squc p) /\
+              (squ p SUBSET component  (ctop G) x)) ) } `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `S = { e | (G e /\ (?p. (e SUBSET squc p) /\ (squ p SUBSET component  (ctop G) x)) ) } ` ABBREV_TAC ;
+  REWRITE_TAC[inductive_set];
+  CONJ_TAC;
+  EXPAND_TAC "S";
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `(?m. squ m SUBSET (component  (ctop G) x))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  comp_squ;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `(?p e. G e /\ e SUBSET closure top2 (squ p) /\ squ p SUBSET component (ctop G) x)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  comp_squ_adj;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  UND 3;
+  REWRITE_TAC[EMPTY_EXISTS ];
+  EXPAND_TAC "S";
+  REWRITE_TAC[];
+  REWRITE_TAC [squ_closure];
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p` EXISTS_TAC;
+  ASM_REWRITE_TAC[GSYM squ_closure];
+  REP_BASIC_TAC;
+  UND 5;
+  EXPAND_TAC "S";
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `edge C /\ edge C'` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(?m. closure top2 C INTER closure top2 C' = {(pointI m)})` SUBGOAL_TAC;
+  IMATCH_MP_TAC  edge_inter;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  REWRITE_TAC[GSYM squ_closure];
+  IMATCH_MP_TAC  along_lemma9;
+  RULE_ASSUM_TAC (REWRITE_RULE[INTER;eq_sing;]);
+  TYPE_THEN `m` EXISTS_TAC;
+  TYPE_THEN `p` EXISTS_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let along_lemma11 = prove_by_refinement(
+  `!G  x e .  (segment G /\ ~(component  (ctop G) x  = EMPTY)  /\
+     (G e)) ==>
+   (?p. (e SUBSET squc p) /\ (squ p SUBSET component  (ctop G) x))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `S = {e | (G e /\ (?p. (e SUBSET squc p) /\ (squ p SUBSET component  (ctop G) x)) ) }` ABBREV_TAC ;
+  TYPE_THEN ` S = G` SUBGOAL_TAC;
+  COPY  2;
+  UND 4;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `inductive_set G S` SUBGOAL_TAC;
+  EXPAND_TAC "S";
+  IMATCH_MP_TAC  along_lemma10;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[inductive_set];
+  EXPAND_TAC "S";
+  DISCH_TAC;
+  USE 4 GSYM;
+  PROOF_BY_CONTR_TAC;
+  UND 0;
+  REWRITE_TAC[];
+  ONCE_ASM_REWRITE_TAC[];
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+(* along_lemma11
+   is essentially the proof that there are only two connected
+   components (because there are only two possible instantiations of p
+   Come back and finish the proof  of the Jordan curve.  *)
+
+
+(* ------------------------------------------------------------------ *)
+(* SECTION I *)
+(* ------------------------------------------------------------------ *)
+
+(* ALL about graphs *)
+
+(*** JRH systematically changed (Y,X)graph to (X,Y)graph for all X and Y,
+     and made corresponding changes to other type annotations.
+     The core now alphabetically sorts the type variables in a definition.
+ ***)
+
+let (mk_graph_t,dest_graph_t) = abbrev_type
+   `:(A->bool)#(B->bool)#(B->(A->bool))` "graph_t";;
+
+let graph_vertex = jordan_def
+   `graph_vertex (G:(A,B)graph_t) = FST (dest_graph_t G)`;;
+
+let graph_edge = jordan_def
+   `graph_edge (G:(A,B)graph_t) = part1 (dest_graph_t G)`;;
+
+let graph_inc = jordan_def
+   `graph_inc (G:(A,B)graph_t) = drop1 (dest_graph_t G)`;;
+
+let graph = jordan_def `graph (G:(A,B)graph_t) <=>
+   (IMAGE (graph_inc G) (graph_edge G)) SUBSET
+   { s | (s SUBSET (graph_vertex G)) /\ (s HAS_SIZE 2) }`;;
+
+let graph_incident = jordan_def `graph_incident
+   (G:(A,B)graph_t) e x <=>
+   (graph_edge G e) /\ (graph_inc G e x)`;;
+
+let graph_iso = jordan_def
+   `graph_iso f (G:(A,B)graph_t) (H:(A',B')graph_t) <=>
+   (?u v. (f = (u,v)) /\ (BIJ u (graph_vertex G) (graph_vertex H)) /\
+   (BIJ v (graph_edge G) (graph_edge H)) /\
+   (!e. (graph_edge G e) ==>
+      (graph_inc H (v e) = IMAGE u (graph_inc G e))))`;;
+
+(* specify a graph by
+   { {a,b}, .... } of endpoints of edges.  *)
+
+let mk_simple_graph = jordan_def `mk_simple_graph (E:(A->bool)->bool) =
+  mk_graph_t
+  (UNIONS E, (E:(A->bool)->bool),
+   (\ (x:A->bool) (y:A). (x y)))`;;
+
+let K33 = jordan_def `K33 = mk_simple_graph
+   { {1,10}, {2,10}, {3,10},
+     {1,20}, {2,20}, {3,20},
+     {1,30}, {2,30}, {3,30} }`;;
+
+let graph_del = jordan_def `graph_del (G:(A,B)graph_t) V E =
+  mk_graph_t
+   ((graph_vertex G DIFF V),
+    (graph_edge G DIFF
+        (E UNION { (e:B) | ?(v:A). (V v /\ graph_incident G e v ) })),
+    (graph_inc G))`;;
+
+let graph_path = jordan_def `graph_path (G:(A,B)graph_t) f n <=>
+   (?v e . (f = (v,e)) /\ (INJ v { m | m <=| n } (graph_vertex G)) /\
+   (INJ e { m | m <| n } (graph_edge G)) /\
+   (!i. (i <| n )  ==>
+         (graph_inc G (e i) = {(v  i), (v (SUC i))})))`;;
+
+let graph_cycle = jordan_def `graph_cycle (G:(A,B)graph_t) f n <=>
+   (?v e . (f = (v,e)) /\ (INJ v { m | m <| n } (graph_vertex G)) /\
+   (INJ e { m | m <| n } (graph_edge G)) /\
+   (!i. (i <| n )  ==>
+         (graph_inc G (e i) = {(v  i), (v ((SUC i) %| (n)))})))`;;
+
+let graph_connected = jordan_def `graph_connected (G:(A,B)graph_t) <=>
+  !v v'. (graph_vertex G v) /\ (graph_vertex G v') /\ ~(v = v') ==>
+   (?f n. (graph_path G f n) /\ (FST f 0 = v) /\ (FST f n = v'))`;;
+
+let graph_2_connected = jordan_def `graph_2_connected (G:(A,B)graph_t) <=>
+  (graph_connected G) /\
+  (!v. (graph_vertex G v) ==> (graph_connected
+     (graph_del G {v} EMPTY)))`;;
+
+let simple_arc = jordan_def `simple_arc (U:(A->bool)->bool) C <=>
+   (?f. (C = IMAGE f { x | &.0 <= x /\ x <= &.1}) /\
+   (continuous f (top_of_metric(UNIV,d_real)) U) /\
+   (INJ f { x | &.0 <= x /\ x <= &.1} (UNIONS U)))`;;
+
+let simple_closed_curve = jordan_def
+   `simple_closed_curve (U:(A->bool)->bool) C <=>
+   (?f. (C = IMAGE f { x | &.0 <= x /\ x <= &.1}) /\
+   (continuous f (top_of_metric(UNIV,d_real)) U) /\
+   (INJ f { x | &.0 <= x /\ x < &.1} (UNIONS U)) /\
+   (f (&.0) = f (&.1)))`;;
+
+let simple_polygonal_arc = jordan_def
+   `simple_polygonal_arc PE C <=>
+    (simple_arc (top_of_metric(euclid 2,d_euclid)) C) /\
+    (?E. (C SUBSET UNIONS E) /\ (FINITE E) /\ (PE E))`;;
+
+let simple_polygonal_curve = jordan_def
+   `simple_polygonal_curve PE C <=>
+    (simple_closed_curve (top_of_metric(euclid 2,d_euclid)) C) /\
+    (?E. (C SUBSET UNIONS E) /\ (FINITE E) /\ (PE E))`;;
+
+let hv_line = jordan_def
+   `hv_line E <=> (!e. (E e) ==> (?x y. (e = mk_line (point x) (point y)) /\
+      ((FST x = FST y) \/ (SND x = SND y))))`;;
+
+let p_conn = jordan_def
+   `p_conn A x y <=> (?C. (simple_polygonal_arc hv_line C) /\
+     (C SUBSET A) /\ (C x) /\ (C y))`;;
+
+let subf = jordan_def
+   `subf A (f:A->B) g x = if (A x) then (f x) else (g x)`;;
+
+let min_real_le = prove_by_refinement(
+  `!x y. (min_real x y <= x) /\ (min_real x y <= y)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[min_real];
+  COND_CASES_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  UND 0;
+  REAL_ARITH_TAC ;
+  ]);;
+  (* }}} *)
+
+let subf_lemma = prove_by_refinement(
+  `!X dX B (x:A).
+     (metric_space (X,dX)) /\ (closed_ (top_of_metric(X,dX)) B) /\
+     (~(B x)) /\ (X x) ==>
+     (?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(B y))))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[closed;open_DEF ];
+  REP_BASIC_TAC;
+  UND 2;
+  UND 3;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  REP_BASIC_TAC;
+  TYPE_THEN `(X DIFF B) x` SUBGOAL_TAC;
+  REWRITE_TAC[DIFF];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPEL_THEN [`X`;`dX`;`(X DIFF B)`;`x`] (fun t-> ASSUME_TAC (ISPECL t open_ball_nbd)); (* // *)
+  REP_BASIC_TAC;
+  REWR 6;
+  TYPE_THEN `e` EXISTS_TAC;
+  UND 6;
+  REWRITE_TAC[open_ball;SUBSET;DIFF;];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[ISUBSET ;];
+  ]);;
+
+  (* }}} *)
+
+let subf_cont = prove_by_refinement(
+  `!X dX Y dY A B (f:A->B) g.
+     ((metric_space (X,dX)) /\ (metric_space (Y,dY)) /\
+     (closed_ (top_of_metric(X,dX)) A ) /\
+     (closed_ (top_of_metric(X,dX)) B ) /\
+     (metric_continuous f (A,dX) (Y,dY)) /\
+     (metric_continuous g (B,dX) (Y,dY)) /\
+     (!x. (A x /\ B x) ==> (f x = g x))) ==>
+     (metric_continuous (subf A f g) (A UNION B,dX) (Y,dY))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  RIGHT_TAC "delta";
+  DISCH_TAC;
+  REWRITE_TAC[UNION];
+  TYPE_THEN `(A x \/ ~(A x)) /\ (B x \/ (~(B x)))` (fun t-> MP_TAC (TAUT  t ));
+  DISCH_THEN (fun t -> MP_TAC (REWRITE_RULE[GSYM DISJ_ASSOC;RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR] t));
+  REP_CASES_TAC;
+  TYPEL_THEN [`x`;`epsilon`] (USE 4 o ISPECL);
+  TYPEL_THEN [`x`;`epsilon`] (USE 5 o ISPECL);
+  REP_BASIC_TAC;
+  REWR 8;
+  REWR 9;
+  TYPE_THEN `min_real delta delta'` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[min_real];
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `A y \/ (~(A y) /\ B y)` SUBGOAL_TAC;
+  UND 9;
+  MESON_TAC[];
+  DISCH_THEN DISJ_CASES_TAC;
+  REWRITE_TAC[subf];
+  ASM_REWRITE_TAC[];
+  UND 12;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 8;
+  (* save_goal "ss" *)
+  TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC;
+  REWRITE_TAC[min_real_le];
+  REAL_ARITH_TAC;
+  (* 1b case *)
+  REWRITE_TAC[subf];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `f x = g x` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  UND 10;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 8;
+  TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC;
+  REWRITE_TAC[min_real_le];
+  REAL_ARITH_TAC ;
+  (* 2nd case *)
+  TYPE_THEN `X x` SUBGOAL_TAC;
+  UND 2;
+  REWRITE_TAC[closed;open_DEF;SUBSET ;];
+  REP_BASIC_TAC;
+  TSPEC  `x` 8;
+  UND 8;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  SIMP_TAC[GSYM top_of_metric_unions];
+  DISCH_TAC;
+  TYPE_THEN `(?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(B y))))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  subf_lemma;
+  TYPE_THEN `X` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPEL_THEN [`x`;`epsilon`] (USE 4 o ISPECL);
+  REP_BASIC_TAC;
+  REWR 4;
+  TYPE_THEN `min_real delta delta'` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[min_real];
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `A y` SUBGOAL_TAC;
+  TYPE_THEN `~(B y) ==> A y` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 4;
+  TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC;
+  REWRITE_TAC[min_real_le];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[subf];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 4;
+  TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC;
+  REWRITE_TAC[min_real_le];
+  REAL_ARITH_TAC;
+  (* 2 LEFT *)
+  TYPE_THEN `X x` SUBGOAL_TAC;
+  UND 3;
+  REWRITE_TAC[closed;open_DEF;SUBSET ;];
+  REP_BASIC_TAC;
+  TSPEC  `x` 8;
+  UND 8;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  SIMP_TAC[GSYM top_of_metric_unions];
+  DISCH_TAC;
+  TYPE_THEN `(?delta. (&0 < delta) /\ (!y. (dX x y < delta) ==> (~(A y))))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  subf_lemma;
+  TYPE_THEN `X` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPEL_THEN [`x`;`epsilon`] (USE 5 o ISPECL);
+  REP_BASIC_TAC;
+  REWR 5;
+  TYPE_THEN `min_real delta delta'` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[min_real];
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `~(A y)` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 5;
+  TYPE_THEN `min_real delta delta' <= delta` SUBGOAL_TAC;
+  REWRITE_TAC[min_real_le];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[subf];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `B y` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  UND 5;
+  TYPE_THEN `min_real delta delta' <= delta'` SUBGOAL_TAC;
+  REWRITE_TAC[min_real_le];
+  REAL_ARITH_TAC;
+  (* 1 LEFT *)
+  TYPE_THEN `&1` EXISTS_TAC;
+  ASM_MESON_TAC [REAL_ARITH `&0 < &1`];
+  ]);;
+  (* }}} *)
+
+let p_conn_subset = prove_by_refinement(
+  `!A B x y. (A SUBSET B) /\ (p_conn A x y) ==> (p_conn B x y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[p_conn];
+  REP_BASIC_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  ]);;
+  (* }}} *)
+
+let mk_line_symm = prove_by_refinement(
+  `!x y. mk_line x y = mk_line y x`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[mk_line];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `(&1 - t)` EXISTS_TAC;
+  ONCE_REWRITE_TAC [euclid_add_comm];
+  ASM_REWRITE_TAC[REAL_ARITH `(&1 - (&1 - t)) = t`];
+  REP_BASIC_TAC;
+  TYPE_THEN `(&1 - t)` EXISTS_TAC;
+  ONCE_REWRITE_TAC [euclid_add_comm];
+  ASM_REWRITE_TAC[REAL_ARITH `(&1 - (&1 - t)) = t`];
+  ]);;
+  (* }}} *)
+
+let mk_line_sub = prove_by_refinement(
+  `!x y z. ( ~(x = z) /\ (mk_line x y z)) ==>
+        (mk_line x y = mk_line x z)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[mk_line];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `~(t = &1)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  REWR 0;
+  UND 0;
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_rzero];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `s = (&1 /(&1 - t))` ABBREV_TAC;
+  TYPE_THEN `(t' - t)*s` EXISTS_TAC;
+  ASM_REWRITE_TAC[euclid_ldistrib;GSYM euclid_add_assoc;euclid_scale_act;GSYM euclid_rdistrib;];
+  TYPE_THEN `(&1 - t) * s = &1` SUBGOAL_TAC;
+  EXPAND_TAC "s";
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `(t' - t) * s + (&1 - (t' - t) * s) * t = (t' - t) *((&1- t)* s) + t ` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(&1 - (t' - t) * s)*(&1 - t) = (&1 - t) - (t' - t)*(&1-t)*s` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_ARITH  `((t' - t)* &1 + t = t') /\ (&1 - t - (t' - t)* &1 = (&1 - t'))`];
+  (* 2nd half *)
+  REP_BASIC_TAC;
+  UND 2;
+  ASM_REWRITE_TAC[euclid_ldistrib;GSYM euclid_add_assoc;euclid_scale_act;GSYM euclid_rdistrib;];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `t' + (&1 - t')*t` EXISTS_TAC;
+  TYPE_THEN `(&1 - (t' + (&1 - t') * t)) = ((&1 - t') * (&1 - t))` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  ]);;
+  (* }}} *)
+
+let mk_line_2 = prove_by_refinement(
+  `!x y p q. (mk_line x y p) /\ (mk_line x y q) /\ (~(p = q)) ==>
+    (mk_line x y = mk_line p q)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `x = p`  ASM_CASES_TAC ;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  mk_line_sub;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[mk_line_sub;mk_line_symm];
+  ]);;
+  (* }}} *)
+
+let mk_line_inter = prove_by_refinement(
+  `!x y p q. ~(mk_line x y = mk_line p q) ==>
+    (?z. (mk_line x y INTER mk_line p q) SUBSET {z} )`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(?z. (mk_line x y INTER mk_line p q) z)` ASM_CASES_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `z` EXISTS_TAC;
+  REWRITE_TAC[INTER;SUBSET;INR IN_SING;];
+  REP_BASIC_TAC;
+  UND 1;
+  REWRITE_TAC[INTER];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[mk_line_2];
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let mk_line_fin_inter = prove_by_refinement(
+  `!E. (FINITE E) /\ (!e. (E e) ==> (?x y. e = mk_line x y)) ==>
+    (?X. (FINITE X) /\
+    (!e f z. (E e) /\ (E f) /\ ~(e = f) /\ e z /\ f z ==> (X z)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `E2 = { (e,f) | (E e) /\ (E f) /\ (~(e = f)) }` ABBREV_TAC;
+  TYPE_THEN `EE = { (e,f) | (E e) /\ (E f) }` ABBREV_TAC;
+  (*   *)
+  TYPE_THEN `FINITE EE` SUBGOAL_TAC;
+  EXPAND_TAC "EE";
+  IMATCH_MP_TAC  (INR FINITE_PRODUCT);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (*   *)
+  TYPE_THEN `FINITE E2` SUBGOAL_TAC;
+  EXPAND_TAC "E2";
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `EE` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "EE";
+  EXPAND_TAC "E2";
+  REWRITE_TAC[SUBSET;];
+  MESON_TAC[];
+  DISCH_TAC;
+  (*  *)
+  TYPE_THEN `E3 = IMAGE (\u. (FST u INTER SND u)) E2` ABBREV_TAC;
+  TYPE_THEN `FINITE E3` SUBGOAL_TAC;
+  EXPAND_TAC "E3";
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (*  *)
+  TYPE_THEN `UNIONS E3` EXISTS_TAC;
+  CONJ_TAC;
+  ASM_SIMP_TAC[FINITE_FINITE_UNIONS];
+  GEN_TAC;
+  EXPAND_TAC "E3";
+  EXPAND_TAC "E2";
+  REWRITE_TAC[IMAGE];
+  CONV_TAC (dropq_conv "x");
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `e` (WITH 0 o ISPEC);
+  TYPE_THEN `f` (USE 0 o ISPEC);
+  UND 0;
+  UND 12;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  (*  *)
+  TYPE_THEN `(?z. (mk_line x y INTER mk_line x' y') SUBSET {z} )` SUBGOAL_TAC;
+  IMATCH_MP_TAC mk_line_inter;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `{z}` EXISTS_TAC;
+  ASM_REWRITE_TAC[FINITE_SING ];
+  REP_BASIC_TAC;
+  EXPAND_TAC "E3";
+  EXPAND_TAC "E2";
+  REWRITE_TAC[IMAGE];
+  REWRITE_TAC[UNIONS];
+  CONV_TAC (dropq_conv "x");
+  CONV_TAC (dropq_conv "u");
+  REWRITE_TAC[INTER];
+  TYPE_THEN `e` EXISTS_TAC;
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let euclid_euclid0 = prove_by_refinement(
+  `!n. (euclid n (euclid0))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[euclid0;euclid];
+  ]);;
+  (* }}} *)
+
+let euclid0_point = prove_by_refinement(
+  `euclid0 = point(&0,&0)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[point_split;euclid_euclid0];
+  REWRITE_TAC[euclid0];
+  ]);;
+  (* }}} *)
+
+let EVEN2 = prove_by_refinement(
+  `EVEN 0 /\ ~(EVEN 1) /\ (EVEN 2) /\ ~(EVEN 3) /\
+  (EVEN 4) /\ ~(EVEN 5)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[EVEN; ARITH_RULE `(1 = SUC 0) /\ (2 = SUC 1) /\ (3 = SUC 2) /\ (4 = SUC 3) /\ (5 = SUC 4)`];
+  ]);;
+  (* }}} *)
+
+let h_seg_openball = prove_by_refinement(
+  `!x e e'. (&0 < e) /\ (&0 <= e') /\ (e' < e) /\ (euclid 2 x) ==>
+     (mk_segment x (x + e' *# e1) SUBSET
+              (open_ball(euclid 2,d_euclid)) x e)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[open_ball;mk_segment;SUBSET;];
+  REP_BASIC_TAC;
+  USE 4 (SYM);
+  UND 4;
+  REWRITE_TAC[GSYM euclid_add_assoc;euclid_ldistrib;GSYM euclid_rdistrib];
+  REWRITE_TAC[REAL_ARITH `a + &1 - a = &1`;euclid_scale_one;euclid_scale_act];
+  TYPE_THEN  `x'' = (((&1 - a) * e') *# e1)` ABBREV_TAC ;
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `euclid 2 x''` SUBGOAL_TAC;
+  EXPAND_TAC "x''";
+  IMATCH_MP_TAC  euclid_scale_closure;
+  REWRITE_TAC[e1;euclid_point];
+  DISCH_TAC;
+  SUBCONJ_TAC;
+  EXPAND_TAC "x'";
+  IMATCH_MP_TAC  euclid_add_closure;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `!x y.  d_euclid x y = d_euclid (x+euclid0) y ` SUBGOAL_TAC;
+  REWRITE_TAC[euclid_rzero];
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  EXPAND_TAC "x'";
+  ASSUME_TAC euclid_euclid0;
+  KILL 7;
+  TYPE_THEN `d_euclid (euclid_plus x euclid0) (euclid_plus x x'') = d_euclid euclid0 x''` SUBGOAL_TAC;
+  ASM_MESON_TAC[metric_translate_LEFT];
+  DISCH_THEN_REWRITE;
+  EXPAND_TAC "x''";
+  REWRITE_TAC[e1;point_scale];
+  REDUCE_TAC;
+  REWRITE_TAC[euclid0_point;d_euclid_point;];
+  REDUCE_TAC;
+  REWRITE_TAC[EXP_2;ARITH_RULE `0 *| 0 = 0`];
+  REDUCE_TAC;
+  REWRITE_TAC[REAL_ARITH `&0 - x = --x`;REAL_POW_NEG;EVEN2];
+  TYPE_THEN `&0 <= (&1 - a) * e'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  ASM_REWRITE_TAC[];
+  UND 5;
+  REAL_ARITH_TAC;
+  ASM_SIMP_TAC[POW_2_SQRT;];
+  DISCH_TAC;
+  ASM_CASES_TAC `a = &0`;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(&1 - a) * e' < &1 * e ==> (&1 - a) * e' <  e` SUBGOAL_TAC;
+  REAL_ARITH_TAC;
+  DISCH_THEN IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  REAL_LT_MUL2;
+  ASM_REWRITE_TAC[];
+  UND 5;
+  UND 6;
+  UND 11;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let openball_convex = prove_by_refinement(
+  `!x e n. (convex (open_ball (euclid n,d_euclid) x e))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[convex;open_ball;SUBSET;mk_segment;];
+  REP_BASIC_TAC;
+  USE 0 SYM;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  EXPAND_TAC "x''";
+  IMATCH_MP_TAC  (euclid_add_closure);
+  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
+  DISCH_TAC;
+  TYPE_THEN `d_euclid x x'' = d_euclid (a *# x + (&1 - a) *# x) x''` SUBGOAL_TAC;
+  REWRITE_TAC[trivial_lin_combo];
+  DISCH_THEN_REWRITE;
+  EXPAND_TAC "x''";
+  (* special case *)
+  ASM_CASES_TAC `a = &0` ;
+  UND 10;
+  DISCH_THEN_REWRITE;
+  REDUCE_TAC;
+  ASM_REWRITE_TAC [euclid_scale0;euclid_scale_one;euclid_lzero;];
+  TYPE_THEN `(!d. (?u v. (d <= u + v) /\ (u < a*e) /\ (v <= (&1- a)*e))  ==> (d < e))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `u + v < (a*e) + (&1 - a)*e` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LTE_ADD2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1 * C = C )`];
+  UND 13;
+  REAL_ARITH_TAC ;
+  DISCH_THEN IMATCH_MP_TAC ;
+  TYPE_THEN `z = a *# x' + (&1 - a) *# x` ABBREV_TAC;
+  TYPE_THEN `d_euclid (a *# x + (&1 - a)*# x) z` EXISTS_TAC;
+  TYPE_THEN `d_euclid z x''` EXISTS_TAC;
+  TYPE_THEN `euclid n z` SUBGOAL_TAC;
+  EXPAND_TAC "z";
+  IMATCH_MP_TAC  (euclid_add_closure);
+  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
+  DISCH_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "x''";
+  IMATCH_MP_TAC  metric_space_triangle;
+  TYPE_THEN `euclid n` EXISTS_TAC;
+  REWRITE_TAC[metric_euclid];
+  ASM_REWRITE_TAC[trivial_lin_combo];
+  CONJ_TAC;
+  EXPAND_TAC "z";
+  TYPE_THEN `(d_euclid (euclid_plus (a *# x) ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# x))) = d_euclid  (a *# x) (a *# x') ` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_translate;
+  TYPE_THEN `n` EXISTS_TAC;
+  REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `d_euclid (a *# x) (a *# x')  = abs  (a) * d_euclid x x'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  norm_scale_vec;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `abs  a = a` SUBGOAL_TAC;
+  ASM_MESON_TAC[REAL_ABS_REFL];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  REAL_PROP_LT_LMUL;
+  ASM_REWRITE_TAC[];
+  UND 10;
+  UND 2;
+  REAL_ARITH_TAC;
+  (* LAST case *)
+  EXPAND_TAC "z";
+  EXPAND_TAC "x''";
+  TYPE_THEN `d_euclid (euclid_plus (a *# x') ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# y)) = d_euclid ((&1 - a) *# x) ((&1 - a) *# y)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_translate_LEFT;
+  TYPE_THEN `n` EXISTS_TAC;
+  REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `!b. d_euclid (b *# x) (b *# y)  = abs  (b) * d_euclid x y` SUBGOAL_TAC;
+  GEN_TAC;
+  IMATCH_MP_TAC  norm_scale_vec;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `abs  (&1 - a) = (&1 - a)` SUBGOAL_TAC;
+  REWRITE_TAC [REAL_ABS_REFL];
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 1;
+  REAL_ARITH_TAC;
+  UND 3;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let openball_mk_segment_end = prove_by_refinement(
+  `!x e n u v.
+     (open_ball(euclid n,d_euclid) x e u) /\
+     (open_ball(euclid n,d_euclid) x e v) ==>
+     (mk_segment u v SUBSET (open_ball(euclid n,d_euclid) x e))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASSUME_TAC openball_convex;
+  TYPEL_THEN [`x`;`e`;`n`] (USE 2 o ISPECL);
+  USE 2 (REWRITE_RULE[convex]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let euclid_eq_minus = prove_by_refinement(
+  `!x y. (x = y) <=> (euclid_minus x y = euclid0)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[euclid_minus;euclid0];
+  REP_BASIC_TAC;
+  EQ_TAC ;
+  DISCH_THEN_REWRITE;
+  REDUCE_TAC;
+  DISCH_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  ONCE_REWRITE_TAC [REAL_ARITH `(a = b) <=> (a - b = &0)`];
+  GEN_TAC;
+  FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `x':num`));
+  BETA_TAC ;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let euclid_plus_pair = prove_by_refinement(
+  `!x y u v. (euclid_plus (x + y) (u + v) = (x + u) + (y + v))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[euclid_plus];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  BETA_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let euclid_minus_scale = prove_by_refinement(
+  `!x y. (euclid_minus x y = euclid_plus x ((-- &.1) *# y))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[euclid_minus;euclid_plus;euclid_scale];
+  IMATCH_MP_TAC  EQ_EXT;
+  BETA_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let euclid_scale_cancel = prove_by_refinement(
+  `!t x y . (~(t = &0)) /\ (t *# x = t *# y) ==> (x = y)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  FIRST_ASSUM  (fun t -> MP_TAC (AP_THM t `x':num`));
+  REWRITE_TAC[euclid_scale;];
+  ASM_MESON_TAC[REAL_MUL_LTIMES];
+  ]);;
+  (* }}} *)
+
+let mk_segment_inj_image = prove_by_refinement(
+  `!x y n. (euclid n x) /\ (euclid n y) /\ ~(x = y) ==> (?f.
+     (continuous f
+        (top_of_metric(UNIV,d_real))
+        (top_of_metric (euclid n,d_euclid))) /\
+      (INJ f {x | &0 <= x /\ x <= &1} (euclid n)) /\
+     (IMAGE f {t | &.0 <=. t /\ t <=. &.1}  = mk_segment x y))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  cont_mk_segment;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[joinf;IMAGE ];
+  REWRITE_TAC[mk_segment];
+  CONJ_TAC;
+  (* new stuff *)
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
+  UND 4;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_CASES_TAC `x' < &1`;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  euclid_add_closure;
+  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  UND 3;
+  TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
+  UND 7;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `~(y' < &0)` SUBGOAL_TAC;
+  UND 5;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `(if (x' < &1) then (euclid_plus (x' *# y) ((&1 - x') *# x)) else y) = ( euclid_plus (x' *# y) ((&1 - x') *# x))` SUBGOAL_TAC;
+ TYPE_THEN `(x' < &1) \/ (x' = &1)` SUBGOAL_TAC;
+  UND 6;
+  REAL_ARITH_TAC;
+  DISCH_THEN   DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `~(x' < &1)` SUBGOAL_TAC;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
+  DISCH_THEN_REWRITE;
+
+  TYPE_THEN `(if (y' < &1) then (euclid_plus (y' *# y) ((&1 - y') *# x)) else y) = ( euclid_plus (y' *# y) ((&1 - y') *# x))` SUBGOAL_TAC;
+ TYPE_THEN `(y' < &1) \/ (y' = &1)` SUBGOAL_TAC;
+  UND 4;
+  REAL_ARITH_TAC;
+  DISCH_THEN   DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `~(y' < &1)` SUBGOAL_TAC;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
+  DISCH_THEN_REWRITE;
+  (* th *)
+  ONCE_REWRITE_TAC [euclid_eq_minus];
+  REWRITE_TAC[euclid_minus_scale;euclid_ldistrib;euclid_scale_act];
+  ONCE_REWRITE_TAC [euclid_plus_pair];
+  REWRITE_TAC[GSYM euclid_rdistrib];
+  REDUCE_TAC;
+  REWRITE_TAC[REAL_ARITH  `x' + -- &1 * y' = x' - y'`];
+  REWRITE_TAC[REAL_ARITH `&1 - x' - (&1 - y') = -- &1 *(x' - y')`];
+  REWRITE_TAC[GSYM euclid_scale_act;GSYM euclid_minus_scale;ONCE_REWRITE_RULE[EQ_SYM_EQ] euclid_eq_minus];
+  (* th1 *)
+  DISCH_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 2;
+  REWRITE_TAC[];
+  IMATCH_MP_TAC  euclid_scale_cancel;
+  TYPE_THEN `(x' - y')` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 8;
+  REAL_ARITH_TAC;
+  KILL 2;
+  (* old stuff *)
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  ASM_REWRITE_TAC[];
+  EQ_TAC;
+  DISCH_TAC;
+  CHO 2;
+  UND 2;
+  COND_CASES_TAC;
+  DISCH_ALL_TAC;
+  JOIN 3 2;
+  ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`];
+  DISCH_ALL_TAC;
+  UND 5;
+  COND_CASES_TAC;
+  DISCH_TAC;
+  TYPE_THEN `&1 - x''` EXISTS_TAC;
+  SUBCONJ_TAC;
+  UND 5;
+  REAL_ARITH_TAC ;
+  DISCH_TAC;
+  CONJ_TAC;
+  UND 3;
+  REAL_ARITH_TAC ;
+  ONCE_REWRITE_TAC [euclid_add_comm];
+  REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `&0` EXISTS_TAC;
+  CONJ_TAC;
+  REAL_ARITH_TAC ;
+  CONJ_TAC;
+  REAL_ARITH_TAC ;
+  REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
+  (* 2nd half *)
+  DISCH_TAC;
+  CHO 2;
+  TYPE_THEN `&1 - a` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  AND 2;
+  AND 2;
+  UND 3;
+  UND 4;
+  REAL_ARITH_TAC ;
+  COND_CASES_TAC;
+  ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`];
+  COND_CASES_TAC;
+  REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
+  ASM_MESON_TAC [euclid_add_comm];
+  TYPE_THEN `a = &.0` SUBGOAL_TAC;
+  UND 4;
+  UND 3;
+  AND 2;
+  UND 3;
+  REAL_ARITH_TAC ;
+  DISCH_TAC;
+  REWR 2;
+  REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
+  ]);;
+
+  (* }}} *)
+
+let h_simple_polygonal = prove_by_refinement(
+  `!x e. (euclid 2 x) /\ (~(e = &0)) ==>
+    (simple_polygonal_arc hv_line (mk_segment x (x + e *# e1)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_polygonal_arc;hv_line;simple_arc ];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  ASSUME_TAC mk_segment_inj_image;
+  TYPEL_THEN [`x`;`x + (e *# e1)`;`2`] (USE 2 o ISPECL);
+  TYPE_THEN `euclid 2 x /\ euclid 2 (euclid_plus x (e *# e1)) /\ ~(x = euclid_plus x (e *# e1))` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  euclid_add_closure;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  euclid_scale_closure;
+  REWRITE_TAC [e1;euclid_point];
+  REP_BASIC_TAC;
+  FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `0`));
+  REWRITE_TAC[euclid_plus;euclid_scale;e1;coord01];
+  UND 0;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  REWR 2;
+  REP_BASIC_TAC;
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SIMP_TAC  [GSYM top_of_metric_unions;metric_euclid];
+  ASM_REWRITE_TAC[];
+  (* E *)
+  USE 1 (MATCH_MP point_onto);
+  REP_BASIC_TAC;
+  TYPE_THEN `{(mk_line (point p) (point p + (e *# e1)))}` EXISTS_TAC;
+  REWRITE_TAC[INR IN_SING];
+  CONJ_TAC;
+  REWRITE_TAC[e1;ISUBSET;mk_segment;mk_line];
+  REP_BASIC_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[FINITE_SING];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p` EXISTS_TAC;
+  TYPE_THEN `(FST p + e, SND p)` EXISTS_TAC;
+  REWRITE_TAC[];
+  AP_TERM_TAC;
+  REWRITE_TAC[e1;point_scale];
+  REDUCE_TAC;
+  TYPE_THEN `euclid_plus (point p) (point (e,&0)) = euclid_plus (point (FST p,SND p)) (point (e,&0))` SUBGOAL_TAC;
+  REWRITE_TAC[];
+  DISCH_THEN (fun t-> PURE_ONCE_REWRITE_TAC[t]);
+  REWRITE_TAC[point_add];
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let pconn_refl = prove_by_refinement(
+  `!A x. (top2 A) /\ (A x) ==> (p_conn A x x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[p_conn;top2];
+  REP_BASIC_TAC;
+  TYPE_THEN `?e. (&0 < e) /\ (open_ball(euclid 2,d_euclid) x e SUBSET A)` SUBGOAL_TAC;
+  ASM_MESON_TAC[open_ball_nbd;metric_euclid];
+  REP_BASIC_TAC;
+  TYPE_THEN `mk_segment x (x + (e/(&2))*# e1)` EXISTS_TAC;
+  TYPE_THEN `euclid 2 x` SUBGOAL_TAC;
+  USE 1(MATCH_MP sub_union);
+  UND 1;
+  ASM_MESON_TAC [top_of_metric_unions;metric_euclid;ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `~(e/(&2) = &0)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `(&0 < x) ==> (~(x = &0))` );
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  DISCH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  h_simple_polygonal;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `open_ball (euclid 2,d_euclid) x e ` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  h_seg_openball;
+  ASM_REWRITE_TAC[];
+  UND 3;
+  MESON_TAC[half_pos;REAL_ARITH `&0 < x ==> &0 <= x`];
+  REWRITE_TAC[mk_segment];
+  TYPE_THEN `&1` EXISTS_TAC;
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale_one ;euclid_scale0;euclid_rzero;];
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let pconn_symm = prove_by_refinement(
+  `!A x y. (p_conn A x y ==> p_conn A y x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[p_conn;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let compose_cont = prove_by_refinement(
+  `!(f:A->B) (g:B->C) X dX Y dY Z dZ.
+    (metric_continuous f (X,dX) (Y,dY)) /\
+    (metric_continuous g (Y,dY) (Z,dZ)) /\
+    (IMAGE f X SUBSET Y) ==>
+    (metric_continuous (compose g f) (X,dX) (Z,dZ))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  REP_BASIC_TAC;
+  RIGHT_TAC "delta";
+  DISCH_TAC;
+  REWRITE_TAC[compose];
+  TYPEL_THEN [`f x`;`epsilon`] (USE 1 o ISPECL);
+  REP_BASIC_TAC;
+  REWR 1;
+  REP_BASIC_TAC;
+  TYPEL_THEN [`x`;`delta`] (USE 2 o ISPECL);
+  REP_BASIC_TAC;
+  REWR 2;
+  REP_BASIC_TAC;
+  TYPE_THEN `delta'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 0 (REWRITE_RULE[IMAGE;SUBSET]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let compose_image = prove_by_refinement(
+  `!(f:A->B) (g:B->C) X.
+   (IMAGE (compose g f) X) =
+    (IMAGE g (IMAGE f X))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[IMAGE];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  GEN_TAC;
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[compose];
+  CONV_TAC (dropq_conv "x''");
+  ]);;
+  (* }}} *)
+
+let linear_cont = prove_by_refinement(
+  `!a b. metric_continuous (\t. t * a + (&1 - t)* b)
+     (UNIV,d_real) (UNIV,d_real)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  REP_BASIC_TAC;
+  RIGHT_TAC "delta";
+  DISCH_TAC;
+  TYPE_THEN `a = b` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `!u. u + &1 - u = &1`];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[d_real;REAL_ARITH `b - b = &0`;ABS_0;];
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* snd *)
+  TYPE_THEN `delta = epsilon/(abs  (a-b))` ABBREV_TAC;
+  TYPE_THEN `delta` EXISTS_TAC;
+  SUBCONJ_TAC;
+  EXPAND_TAC "delta";
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  ASM_REWRITE_TAC[];
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  REWRITE_TAC[d_real];
+  REP_BASIC_TAC;
+  TYPE_THEN `((x * a + (&1 - x) * b) - (y * a + (&1 - y) * b))  = (x - y)*(a - b)` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `epsilon = delta * (abs  (a - b))` SUBGOAL_TAC;
+  EXPAND_TAC "delta";
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  IMATCH_MP_TAC  REAL_DIV_RMUL;
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[ABS_MUL];
+  IMATCH_MP_TAC  REAL_PROP_LT_RMUL;
+  ASM_REWRITE_TAC[];
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let linear_image_gen = prove_by_refinement(
+  `!a b c d. (a < b) /\ (c < d) ==>
+     (IMAGE (\t. (t - c)/(d-c) * a + (d - t)/(d - c) *b )
+         {x | c <= x /\ x <= d } =
+            {y | a <= y /\ y <= b})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  TYPE_THEN `&0 < (b - a)` SUBGOAL_TAC;
+  UND 1;
+  REAL_ARITH_TAC;
+  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  ABBREV_TAC   `e = &1/(d-c)`;
+  TYPE_THEN `!u. u/(d - c) = u*e` SUBGOAL_TAC;
+  GEN_TAC;
+  EXPAND_TAC "e";
+  REWRITE_TAC[real_div];
+  REDUCE_TAC;
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(d - c)*e = &1` SUBGOAL_TAC;
+  EXPAND_TAC "e";
+  REWRITE_TAC[real_div];
+  REDUCE_TAC;
+  REWRITE_TAC[GSYM real_div];
+  IMATCH_MP_TAC  REAL_DIV_REFL;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `&0 < e` SUBGOAL_TAC;
+  EXPAND_TAC "e";
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (*   *)
+  EQ_TAC;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `((d-c)*e*a <= ((x' - c) * e) * a + ((d - x') * e) * b) ==> (a <= ((x' - c) * e) * a + ((d - x') * e) * b)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_MUL_ASSOC];
+  REDUCE_TAC;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ineq_le_tac `(d-c)*e*a + (d - x')*(b - a)*e = ((x' - c) * e) * a + ((d - x') * e) * b`;
+  TYPE_THEN `(((x' - c) * e) * a + ((d - x') * e) * b <= b*((d- c)*e)) ==> (((x' - c) * e) * a + ((d - x') * e) * b <= b)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `x* &1 = x`];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ineq_le_tac `(((x' - c) * e) * a + ((d - x') * e) * b) + (x'-c )*(b-a)*e = b * (d - c) * e`;
+  (* 2nd direction *)
+  REP_BASIC_TAC;
+  TYPE_THEN `x' = ((d*b - a*c) - (d -c)*x)/(b - a)` ABBREV_TAC ;
+  TYPE_THEN `x'` EXISTS_TAC;
+  TYPE_THEN `x'*(b - a) = ((d*b - a*c) - (d -c)*x)` SUBGOAL_TAC;
+  EXPAND_TAC "x'";
+  IMATCH_MP_TAC  REAL_DIV_RMUL;
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* sv *)
+  SUBGOAL_TAC `!x a b. (a * x <= b * x /\ &0 < x) ==> (a <= b)`;
+  MESON_TAC[REAL_PROP_LE_RCANCEL];
+  DISCH_TAC;
+  CONJ_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `(b - a)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ineq_le_tac `c * (b - a) + (d-c)*(b-x) = d * b - a * c - (d - c) * x`;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `(b - a)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ineq_le_tac `(d * b - a * c - (d - c) * x) + (d-c)*(x-a) = d * (b - a)`;
+  TYPE_THEN `((x' - c) * e) * a + ((d - x') * e) * b = (d*b - c*a - x'*(b-a))*e` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(d * b - c * a - (d * b - a * c - (d - c) * x)) = x*(d-c)` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[GSYM REAL_MUL_ASSOC];
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let linear_image_rev = prove_by_refinement(
+  `!a b c d. (a < b) /\ (c < d) ==>
+     (IMAGE (\t. (t - c)/(d-c) * b + (d - t)/(d - c) *a )
+         {x | c <= x /\ x <= d } =
+            {y | a <= y /\ y <= b})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  TYPE_THEN `&0 < (b - a)` SUBGOAL_TAC;
+  UND 1;
+  REAL_ARITH_TAC;
+  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  ABBREV_TAC   `e = &1/(d-c)`;
+  TYPE_THEN `!u. u/(d - c) = u*e` SUBGOAL_TAC;
+  GEN_TAC;
+  EXPAND_TAC "e";
+  REWRITE_TAC[real_div];
+  REDUCE_TAC;
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(d - c)*e = &1` SUBGOAL_TAC;
+  EXPAND_TAC "e";
+  REWRITE_TAC[real_div];
+  REDUCE_TAC;
+  REWRITE_TAC[GSYM real_div];
+  IMATCH_MP_TAC  REAL_DIV_REFL;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `&0 < e` SUBGOAL_TAC;
+  EXPAND_TAC "e";
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (*   *)
+  EQ_TAC;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `((d-c)*e*a <= ((x' - c) * e) * b + ((d - x') * e) * a) ==> (a <= ((x' - c) * e) * b + ((d - x') * e) * a)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_MUL_ASSOC];
+  REDUCE_TAC;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ineq_le_tac `(d-c)*e*a + (x' - c)*(b - a)*e = ((x' - c) * e) * b + ((d - x') * e) * a`;
+  TYPE_THEN `(((x' - c) * e) * b + ((d - x') * e) * a <= b*((d- c)*e)) ==> (((x' - c) * e) * b + ((d - x') * e) * a <= b)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `x* &1 = x`];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ineq_le_tac `(((x' - c) * e) * b + ((d - x') * e) * a) + (d - x' )*(b-a)*e = b * (d - c) * e`;
+  (* 2nd direction *)
+  REP_BASIC_TAC;
+  TYPE_THEN `x' = ((b*c  - a*d) + (d -c)*x)/(b - a)` ABBREV_TAC ;
+  TYPE_THEN `x'` EXISTS_TAC;
+  TYPE_THEN `x'*(b - a) = ((b*c - a*d ) + (d -c)*x)` SUBGOAL_TAC;
+  EXPAND_TAC "x'";
+  IMATCH_MP_TAC  REAL_DIV_RMUL;
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* sv *)
+  SUBGOAL_TAC `!x a b. (a * x <= b * x /\ &0 < x) ==> (a <= b)`;
+  MESON_TAC[REAL_PROP_LE_RCANCEL];
+  DISCH_TAC;
+  CONJ_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `(b - a)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ineq_le_tac `c * (b - a) + (d-c)*(x-a) = b*c  - a*d + (d - c) * x`;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `(b - a)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ineq_le_tac `(b*c - a*d + (d - c) * x) + (d-c)*(b - x) = d * (b - a)`;
+  TYPE_THEN `((x' - c) * e) * b + ((d - x') * e) * a = (d*a - c*b + x'*(b-a))*e` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(d * a - c * b + b * c - a * d + (d - c) * x) = x*(d-c)` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[GSYM REAL_MUL_ASSOC];
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let linear_inj = prove_by_refinement(
+  `!a b c d. (a < b) /\ (c < d) ==>
+     (INJ (\t. (t - c)/(d-c) * a + (d - t)/(d - c) *b )
+         {x | c <= x /\ x <= d }
+            {y | a <= y /\ y <= b})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  ASSUME_TAC linear_image_gen;
+  TYPEL_THEN [`a`;`b`;`c`;`d`] (USE 4 o ISPECL);
+  REWR 4;
+  UND 4;
+  REWRITE_TAC[IMAGE];
+  DISCH_TAC;
+  FIRST_ASSUM (fun t-> ASSUME_TAC (AP_THM t `(x - c) / (d - c) * a + (d - x) / (d - c) * b`));
+  UND 5;
+  REWRITE_TAC[];
+  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* INJ proper *)
+  REP_BASIC_TAC;
+  UND 2;
+  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `e = &1/(d-c)` ABBREV_TAC ;
+  TYPE_THEN `!u. (u/(d-c) = u*e)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  EXPAND_TAC"e";
+  REWRITE_TAC[real_div];
+  REDUCE_TAC;
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  USE 8(ONCE_REWRITE_RULE [REAL_ARITH `(x = y) <=> (x - y = &0)`]);
+  UND 8;
+  TYPE_THEN `(((x - c) * e) * a + ((d - x) * e) * b) - (((y - c) * e) * a + ((d - y) * e) * b) = e*(b-a)*(y - x)` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[REAL_ENTIRE];
+  TYPE_THEN `~(b - a = &0)` SUBGOAL_TAC;
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `~(e = &0)` SUBGOAL_TAC;
+  EXPAND_TAC"e";
+  REWRITE_TAC[real_div];
+  REDUCE_TAC;
+  REWRITE_TAC[REAL_INV_EQ_0];
+  UND 0;
+  REAL_ARITH_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let linear_inj_rev = prove_by_refinement(
+  `!a b c d. (a < b) /\ (c < d) ==>
+     (INJ (\t. (t - c)/(d-c) * b + (d - t)/(d - c) *a )
+         {x | c <= x /\ x <= d }
+            {y | a <= y /\ y <= b})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  ASSUME_TAC linear_image_rev;
+  TYPEL_THEN [`a`;`b`;`c`;`d`] (USE 4 o ISPECL);
+  REWR 4;
+  UND 4;
+  REWRITE_TAC[IMAGE];
+  DISCH_TAC;
+  FIRST_ASSUM (fun t-> ASSUME_TAC (AP_THM t `(x - c) / (d - c) * b + (d - x) / (d - c) * a`));
+  UND 5;
+  REWRITE_TAC[];
+  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* INJ proper *)
+  REP_BASIC_TAC;
+  UND 2;
+  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `e = &1/(d-c)` ABBREV_TAC ;
+  TYPE_THEN `!u. (u/(d-c) = u*e)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  EXPAND_TAC"e";
+  REWRITE_TAC[real_div];
+  REDUCE_TAC;
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  USE 8(ONCE_REWRITE_RULE [REAL_ARITH `(x = y) <=> (x - y = &0)`]);
+  UND 8;
+  TYPE_THEN `(((x - c) * e) * b + ((d - x) * e) * a) - (((y - c) * e) * b + ((d - y) * e) * a) = e*(a-b)*(y - x)` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[REAL_ENTIRE];
+  TYPE_THEN `~(a-b = &0)` SUBGOAL_TAC;
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `~(e = &0)` SUBGOAL_TAC;
+  EXPAND_TAC"e";
+  REWRITE_TAC[real_div];
+  REDUCE_TAC;
+  REWRITE_TAC[REAL_INV_EQ_0];
+  UND 0;
+  REAL_ARITH_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let comp_comp = prove_by_refinement(
+  `(o) = (compose:(B->C) -> ((A->B)-> (A->C))) `,
+  (* {{{ proof *)
+  [
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[o_DEF;compose];
+  ]);;
+  (* }}} *)
+
+let arc_reparameter_rev = prove_by_refinement(
+  `!f a b c d. ( continuous f (top_of_metric (UNIV,d_real)) (top2) /\
+           INJ f {x | c <= x /\ x <= d} (euclid 2) /\
+         (a < b) /\ (c < d)  ==>
+           (?g. continuous g (top_of_metric (UNIV,d_real)) (top2) /\
+           INJ g {x | a <= x /\ x <= b} (euclid 2) /\
+         (f d  = g a) /\ (f c = g b) /\
+      (!x y x' y'. (f x = g x') /\ (f y = g y') /\
+         (c <= x /\ x <= d) /\ (c <= y /\ y <= d) /\
+         (a <= x' /\ x' <= b) /\ (a <= y' /\ y' <= b) ==>
+           ((x < y) = (y' < x'))) /\
+      (IMAGE f { x | c <= x /\ x <= d } =
+         IMAGE g { x | a <= x /\ x <= b } )))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `f2 = (\t. (t - a)/(b - a) * (c) + (b - t)/(b - a) *(d) )` ABBREV_TAC ;
+  TYPE_THEN `g = (f o f2)` ABBREV_TAC ;
+  TYPE_THEN `g` EXISTS_TAC;
+  (* general facts *)
+  TYPE_THEN `UNIONS(top_of_metric(UNIV,d_real)) = UNIV` SUBGOAL_TAC;
+  MESON_TAC[metric_real;top_of_metric_unions];
+  DISCH_TAC;
+  (* continuity *)
+  CONJ_TAC;
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  continuous_comp;
+  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[top2];
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV];
+  TYPE_THEN `f2 = (\t. t* (c - d + d*b - c*a)/(b - a) + (&1 - t)*(d*b-c*a)/(b - a))` SUBGOAL_TAC;
+  EXPAND_TAC "f2";
+  IMATCH_MP_TAC  EQ_EXT;
+  BETA_TAC;
+  GEN_TAC;
+  REWRITE_TAC[real_div;GSYM REAL_MUL_ASSOC;REAL_ARITH `(inv x)*y = y*(inv x)`];
+  REWRITE_TAC[REAL_MUL_ASSOC;GSYM REAL_RDISTRIB;REAL_EQ_MUL_RCANCEL];
+  DISJ1_TAC ;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[linear_cont];
+  (* IMAGE *)
+  TYPE_THEN `{x | c <= x /\ x <= d} = IMAGE f2 {x | a <= x /\ x <= b}` SUBGOAL_TAC;
+  REWRITE_TAC[];
+  EXPAND_TAC "f2";
+  ASM_SIMP_TAC[linear_image_gen];
+  DISCH_TAC;
+  TYPE_THEN `(IMAGE f {x | c <= x /\ x <= d} = IMAGE g {x | a <= x /\ x <= b})` SUBGOAL_TAC;
+  EXPAND_TAC "g";
+  REWRITE_TAC[comp_comp;compose_image;];
+  AP_TERM_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  (* INJ *)
+  EXPAND_TAC "g";
+  REWRITE_TAC[comp_comp];
+  (* XXX *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  (COMP_INJ);
+  TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC;
+  UND 2;
+  DISCH_THEN_REWRITE;
+  KILL 7;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "f2";
+  IMATCH_MP_TAC  linear_inj;
+  ASM_REWRITE_TAC[];
+  (* ends   *)
+  IMATCH_MP_TAC  (TAUT `(A /\ B) /\ C ==> A /\ B /\ C`);
+  CONJ_TAC;
+  EXPAND_TAC "f2";
+  REWRITE_TAC[compose];
+  REDUCE_TAC;
+  REWRITE_TAC[real_div;REAL_MUL_ASSOC;];
+  REDUCE_TAC;
+  TYPE_THEN `(b-a)*inv(b-a) = &1` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_MUL_RINV;
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REDUCE_TAC;
+  (* monotone *)
+  REWRITE_TAC[compose];
+  REP_BASIC_TAC;
+  TYPE_THEN `c <= f2 y' /\ f2 y' <= d` SUBGOAL_TAC;
+  USE 7 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `f2 y'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
+  REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `y'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `c <= f2 x' /\ f2 x' <= d` SUBGOAL_TAC;
+  USE 7 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `f2 x'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
+  REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `x = f2 x'` SUBGOAL_TAC;
+  USE 2 (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `y = f2 y'` SUBGOAL_TAC;
+  USE 2 (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "f2";
+  ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> ( &0 < y - x)`];
+  REWRITE_TAC[real_div];
+  TYPE_THEN `e = inv(b-a)` ABBREV_TAC ;
+  TYPE_THEN `(((y' - a) * e) * c + ((b - y') * e) * d) - (((x' - a) * e) * c + ((b - x') * e) * d) = (x' - y')*e*(d-c)` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `&0 < e` SUBGOAL_TAC;
+  EXPAND_TAC"e";
+  IMATCH_MP_TAC  REAL_PROP_POS_INV;
+  UND 1;
+  REAL_ARITH_TAC;
+  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_MUL_ASSOC];
+  ASM_SIMP_TAC[REAL_PROP_POS_RMUL];
+  ]);;
+  (* }}} *)
+
+let arc_reparameter_gen = prove_by_refinement(
+  `!f a b c d. ( continuous f (top_of_metric (UNIV,d_real)) (top2) /\
+           INJ f {x | c <= x /\ x <= d} (euclid 2) /\
+         (a < b) /\ (c < d)  ==>
+           (?g. continuous g (top_of_metric (UNIV,d_real)) (top2) /\
+           INJ g {x | a <= x /\ x <= b} (euclid 2) /\
+         (f c  = g a) /\ (f d = g b) /\
+      (!x y x' y'. (f x = g x') /\ (f y = g y') /\
+         (c <= x /\ x <= d) /\ (c <= y /\ y <= d) /\
+         (a <= x' /\ x' <= b) /\ (a <= y' /\ y' <= b) ==>
+           ((x < y) = (x' < y'))) /\
+      (IMAGE f { x | c <= x /\ x <= d } =
+         IMAGE g { x | a <= x /\ x <= b } )))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `f2 = (\t. (t - a)/(b - a) * (d) + (b - t)/(b - a) *(c) )` ABBREV_TAC ;
+  TYPE_THEN `g = (f o f2)` ABBREV_TAC ;
+  TYPE_THEN `g` EXISTS_TAC;
+  (* general facts *)
+  TYPE_THEN `UNIONS(top_of_metric(UNIV,d_real)) = UNIV` SUBGOAL_TAC;
+  MESON_TAC[metric_real;top_of_metric_unions];
+  DISCH_TAC;
+  (* continuity *)
+  CONJ_TAC;
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  continuous_comp;
+  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[top2];
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV];
+  TYPE_THEN `f2 = (\t. t* (d - c + c*b - d*a)/(b - a) + (&1 - t)*(c*b-d*a)/(b - a))` SUBGOAL_TAC;
+  EXPAND_TAC "f2";
+  IMATCH_MP_TAC  EQ_EXT;
+  BETA_TAC;
+  GEN_TAC;
+  REWRITE_TAC[real_div;GSYM REAL_MUL_ASSOC;REAL_ARITH `(inv x)*y = y*(inv x)`];
+  REWRITE_TAC[REAL_MUL_ASSOC;GSYM REAL_RDISTRIB;REAL_EQ_MUL_RCANCEL];
+  DISJ1_TAC ;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[linear_cont];
+  (* IMAGE *)
+  TYPE_THEN `{x | c <= x /\ x <= d} = IMAGE f2 {x | a <= x /\ x <= b}` SUBGOAL_TAC;
+  REWRITE_TAC[];
+  EXPAND_TAC "f2";
+  ASM_SIMP_TAC[linear_image_rev];
+  DISCH_TAC;
+  TYPE_THEN `(IMAGE f {x | c <= x /\ x <= d} = IMAGE g {x | a <= x /\ x <= b})` SUBGOAL_TAC;
+  EXPAND_TAC "g";
+  REWRITE_TAC[comp_comp;compose_image;];
+  AP_TERM_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  (* INJ *)
+  EXPAND_TAC "g";
+  REWRITE_TAC[comp_comp];
+  (* XXX *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  (COMP_INJ);
+  TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC;
+  UND 2;
+  DISCH_THEN_REWRITE;
+  KILL 7;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "f2";
+  IMATCH_MP_TAC  linear_inj_rev;
+  ASM_REWRITE_TAC[];
+  (* ends   *)
+  IMATCH_MP_TAC  (TAUT `(A /\ B) /\ C ==> A /\ B /\ C`);
+  CONJ_TAC;
+  EXPAND_TAC "f2";
+  REWRITE_TAC[compose];
+  REDUCE_TAC;
+  REWRITE_TAC[real_div;REAL_MUL_ASSOC;];
+  REDUCE_TAC;
+  TYPE_THEN `(b-a)*inv(b-a) = &1` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_MUL_RINV;
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REDUCE_TAC;
+  (* monotone *)
+  REWRITE_TAC[compose];
+  REP_BASIC_TAC;
+  TYPE_THEN `c <= f2 y' /\ f2 y' <= d` SUBGOAL_TAC;
+  USE 7 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `f2 y'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
+  REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `y'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `c <= f2 x' /\ f2 x' <= d` SUBGOAL_TAC;
+  USE 7 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `f2 x'` (fun s -> FIRST_ASSUM (fun t-> MP_TAC (AP_THM t s)));
+  REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `x = f2 x'` SUBGOAL_TAC;
+  USE 2 (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `y = f2 y'` SUBGOAL_TAC;
+  USE 2 (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "f2";
+  ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> ( &0 < y - x)`];
+  REWRITE_TAC[real_div];
+  TYPE_THEN `e = inv(b-a)` ABBREV_TAC ;
+  TYPE_THEN `(((y' - a) * e) * d + ((b - y') * e) * c) - (((x' - a) * e) * d + ((b - x') * e) * c) = (y' - x')*e*(d-c)` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `&0 < e` SUBGOAL_TAC;
+  EXPAND_TAC"e";
+  IMATCH_MP_TAC  REAL_PROP_POS_INV;
+  UND 1;
+  REAL_ARITH_TAC;
+  TYPE_THEN `&0 < (d - c)` SUBGOAL_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_MUL_ASSOC];
+  ASM_SIMP_TAC[REAL_PROP_POS_RMUL];
+  ]);;
+  (* }}} *)
+
+let image_preimage = prove_by_refinement(
+  `!(f:A->B) X Y. IMAGE f (preimage X f Y) SUBSET Y`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;INR in_preimage ;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let preimage_union2 = prove_by_refinement(
+  `!(f:A->B) A B X. (preimage X f (A UNION B)) =
+    (preimage X f A UNION preimage X f B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[preimage_union;image_preimage;];
+  REWRITE_TAC[preimage;SUBSET;];
+  MESON_TAC[];
+  REWRITE_TAC[union_subset];
+  REWRITE_TAC[preimage;SUBSET;UNION];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let union_diff  = prove_by_refinement(
+  `!(X:A->bool) A B. (X = A UNION B) /\ (A INTER B = EMPTY) ==>
+     (X DIFF B = A)`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  SET_TAC[];
+  ]);;
+  (* }}} *)
+
+let preimage_closed = prove_by_refinement(
+  `!U V C (f:A->B). (continuous f U V) /\ (closed_ V C) /\
+       (IMAGE f (UNIONS U) SUBSET (UNIONS V)) ==>
+           (closed_ U (preimage (UNIONS U) f C))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[closed;open_DEF;];
+  TYPE_THEN `(UNIONS U DIFF (preimage (UNIONS U) f C)) = preimage (UNIONS U) f (UNIONS V DIFF C)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  union_diff;
+  REWRITE_TAC[GSYM preimage_union2];
+  CONJ_TAC;
+  TYPE_THEN `UNIONS V DIFF C UNION C = UNIONS V` SUBGOAL_TAC;
+  TYPE_THEN `!P. C SUBSET P ==> (P DIFF C UNION C = P)` SUBGOAL_TAC;
+  SET_TAC[];
+  TYPE_THEN `C SUBSET UNIONS V` SUBGOAL_TAC;
+  UND 1;
+  REWRITE_TAC[closed;open_DEF;];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  DISCH_THEN (fun t-> ASM_SIMP_TAC[t]);
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  ASM_REWRITE_TAC [  subset_preimage;];
+  REWRITE_TAC[preimage;SUBSET];
+  MESON_TAC[];
+  IMATCH_MP_TAC  preimage_disjoint;
+  SET_TAC[];
+  DISCH_THEN_REWRITE;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;preimage];
+  MESON_TAC[];
+  UND 2;
+  REWRITE_TAC[continuous];
+  DISCH_THEN IMATCH_MP_TAC ;
+  UND 1;
+  REWRITE_TAC[closed;open_DEF;];
+  MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let preimage_restrict = prove_by_refinement(
+  `!(f:A->B) Z A B.  (A SUBSET B) ==>
+      (preimage A f Z = A INTER preimage B f Z)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[preimage;INTER;];
+  TYPE_THEN `!y. (A SUBSET B ==> (A y /\ B y <=> A y))` SUBGOAL_TAC;
+  MESON_TAC[ISUBSET];
+  ASM_SIMP_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let continuous_delta = prove_by_refinement(
+  `continuous (\x. (x *# dirac_delta 0)) (top_of_metric(UNIV,d_real))
+     (top_of_metric(euclid 1,d_euclid)) `,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `IMAGE (\x. (x *# dirac_delta 0)) (UNIV) SUBSET (euclid 1)` SUBGOAL_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;];
+  MESON_TAC[euclid_dirac];
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_euclid;metric_real];
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  REP_BASIC_TAC;
+  RIGHT_TAC "delta";
+  REP_BASIC_TAC;
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[euclid_dirac;euclid1_abs];
+  REWRITE_TAC[dirac_0];
+  USE 2 (REWRITE_RULE [d_real]);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let continuous_neg_delta = prove_by_refinement(
+  `continuous (\x. ((-- x) *# dirac_delta 0))
+   (top_of_metric(UNIV,d_real))
+     (top_of_metric(euclid 1,d_euclid)) `,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `IMAGE (\x. (-- x *# dirac_delta 0)) (UNIV) SUBSET (euclid 1)` SUBGOAL_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;];
+  MESON_TAC[euclid_dirac];
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_euclid;metric_real];
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  REP_BASIC_TAC;
+  RIGHT_TAC "delta";
+  REP_BASIC_TAC;
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[euclid_dirac;euclid1_abs];
+  REWRITE_TAC[dirac_0];
+  USE 2 (REWRITE_RULE [d_real]);
+  UND 2;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let compact_max_real = prove_by_refinement(
+  `!(f:A->real) U K.
+    continuous f U (top_of_metric (UNIV,d_real)) /\
+          compact U K /\
+          ~(K = {})
+          ==> (?x. K x /\ (!y. K y ==> f y  <= f x ))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `g = (\x. (x *# dirac_delta 0)) o f` ABBREV_TAC ;
+  TYPE_THEN `(?x. K x /\ (!y. K y ==> g y 0 <= g x 0 ))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  compact_max;
+  TYPE_THEN `U` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "g";
+  REWRITE_TAC[IMAGE_o];
+  TYPE_THEN `X = IMAGE f K` ABBREV_TAC ;
+  REWRITE_TAC[IMAGE ;SUBSET];
+  CONJ_TAC;
+  IMATCH_MP_TAC  continuous_comp;
+  TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC;
+  ASM_REWRITE_TAC[continuous_delta];
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
+  MESON_TAC[euclid_dirac];
+  REP_BASIC_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  UND 4;
+  EXPAND_TAC "g";
+  REWRITE_TAC[o_DEF;dirac_0];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let compact_min_real = prove_by_refinement(
+  `!(f:A->real) U K.
+    continuous f U (top_of_metric (UNIV,d_real)) /\
+          compact U K /\
+          ~(K = {})
+          ==> (?x. K x /\ (!y. K y ==> f x  <= f y ))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `g = (\x. (-- x *# dirac_delta 0)) o f` ABBREV_TAC ;
+  TYPE_THEN `(?x. K x /\ (!y. K y ==> g y 0 <= g x 0 ))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  compact_max;
+  TYPE_THEN `U` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "g";
+  REWRITE_TAC[IMAGE_o];
+  TYPE_THEN `X = IMAGE f K` ABBREV_TAC ;
+  REWRITE_TAC[IMAGE ;SUBSET];
+  CONJ_TAC;
+  IMATCH_MP_TAC  continuous_comp;
+  TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC;
+  ASM_REWRITE_TAC[continuous_neg_delta];
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
+  MESON_TAC[euclid_dirac];
+  REP_BASIC_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  UND 4;
+  EXPAND_TAC "g";
+  REWRITE_TAC[o_DEF;dirac_0];
+  ASM_MESON_TAC[REAL_ARITH `!u v. (-- u <= --v) <=> (v <= u)`];
+  ]);;
+  (* }}} *)
+
+let continuous_I = prove_by_refinement(
+  `continuous I (top_of_metric(UNIV,d_real))
+     (top_of_metric(UNIV,d_real))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[continuous];
+  REP_BASIC_TAC;
+  REWRITE_TAC[preimage];
+  SIMP_TAC [GSYM top_of_metric_unions;metric_real];
+  REWRITE_TAC[I_DEF];
+  TYPE_THEN `{x | v x} = v` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let compact_sup = prove_by_refinement(
+  `!X. (compact (top_of_metric(UNIV,d_real)) X) /\ ~(X=EMPTY ) ==>
+    (?x. (X x) /\ (!y. (X y) ==> (y <= x)))`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `!(u:real). I u = u` SUBGOAL_TAC;
+  REWRITE_TAC[I_DEF];
+  DISCH_TAC;
+  TYPE_THEN `!x y. y <= x <=> (I y <= I x)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t ->  ONCE_REWRITE_TAC [t]);
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  compact_max_real;
+  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
+  ASM_REWRITE_TAC[continuous_I];
+  ]);;
+  (* }}} *)
+
+let compact_inf = prove_by_refinement(
+  `!X. (compact (top_of_metric(UNIV,d_real)) X) /\ ~(X=EMPTY ) ==>
+    (?x. (X x) /\ (!y. (X y) ==> (x <= y)))`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `!(u:real). I u = u` SUBGOAL_TAC;
+  REWRITE_TAC[I_DEF];
+  DISCH_TAC;
+  TYPE_THEN `!x y. y <= x <=> (I y <= I x)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t ->  ONCE_REWRITE_TAC [t]);
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  compact_min_real;
+  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
+  ASM_REWRITE_TAC[continuous_I];
+  ]);;
+  (* }}} *)
+
+let preimage_compact = prove_by_refinement(
+  `!C (f:A->B) Y dY Z dZ Y0.
+   metric_space (Y,dY) /\ metric_space (Z,dZ) /\
+  (compact (top_of_metric(Y,dY)) Y0) /\
+  (continuous f (top_of_metric(Y0,dY))
+            (top_of_metric(Z,dZ))) /\
+  (IMAGE f Y0 SUBSET Z) /\
+  (closed_ (top_of_metric(Z,dZ)) C) /\
+  ~(IMAGE f Y0 INTER C = EMPTY) ==>
+  (compact (top_of_metric(Y,dY)) (preimage Y0 f C))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `X = preimage Y0 f C` ABBREV_TAC ;
+  TYPE_THEN `(UNIONS (top_of_metric(Y,dY)) = Y) /\ (UNIONS(top_of_metric(Z,dZ)) = Z)` SUBGOAL_TAC;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  REP_BASIC_TAC;
+  TYPE_THEN `Y0 SUBSET Y` SUBGOAL_TAC;
+  ASM_MESON_TAC [compact;];
+  DISCH_TAC;
+  WITH 10 (MATCH_MP preimage_restrict);
+  TYPEL_THEN [`f`;`C`] (USE 11 o ISPECL);
+  TYPE_THEN `metric_space (Y0,dY)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_subspace;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `closed_ (top_of_metric(Y0,dY)) X` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  TYPE_THEN `preimage Y0 f C = preimage (UNIONS (top_of_metric(Y0,dY))) f C` SUBGOAL_TAC;
+  AP_THM_TAC;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  preimage_closed;
+  TYPE_THEN `(top_of_metric (Z,dZ))` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  DISCH_TAC;
+  TYPE_THEN `~(X = EMPTY)` SUBGOAL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS;];
+  UND 0;
+  REWRITE_TAC[EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  UND 0;
+  REWRITE_TAC[IMAGE;INTER];
+  REP_BASIC_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  EXPAND_TAC "X";
+  REWRITE_TAC[preimage];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* next X compact in the reals , take inf X, *)
+  TYPE_THEN `U = top_of_metric(Y,dY)` ABBREV_TAC ;
+  TYPE_THEN `U0 = top_of_metric(Y0,dY)` ABBREV_TAC ;
+  TYPE_THEN `U00 = top_of_metric (X,dY)` ABBREV_TAC ;
+  TYPE_THEN `X SUBSET Y0` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  KILL 7;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INTER;SUBSET;];
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `induced_top U Y0 = U0` SUBGOAL_TAC;
+  EXPAND_TAC "U";
+  EXPAND_TAC "U0";
+  IMATCH_MP_TAC  top_of_metric_induced;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `UNIONS U = Y` SUBGOAL_TAC;
+  EXPAND_TAC "U";
+  ASM_SIMP_TAC [GSYM top_of_metric_unions];
+  DISCH_TAC;
+  TYPE_THEN `compact U0 Y0` SUBGOAL_TAC;
+  KILL 16;
+  EXPAND_TAC "U0";
+  ASM_SIMP_TAC[GSYM induced_compact;];
+  REP_BASIC_TAC;
+  (* ok to here *)
+  TYPE_THEN `compact U0 X` SUBGOAL_TAC;
+  IMATCH_MP_TAC  closed_compact;
+  TYPE_THEN `Y0` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  KILL 19;
+  EXPAND_TAC "U0";
+  IMATCH_MP_TAC  top_of_metric_top;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* done WITH compac U0 X *)
+  TYPE_THEN `induced_top U0 X = U00` SUBGOAL_TAC;
+  KILL 19;
+  EXPAND_TAC "U0";
+  EXPAND_TAC "U00";
+  IMATCH_MP_TAC  top_of_metric_induced;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `compact U00 X` SUBGOAL_TAC;
+  EXPAND_TAC "U00";
+  TYPE_THEN `X SUBSET UNIONS U0` SUBGOAL_TAC;
+  KILL 19;
+  EXPAND_TAC "U0";
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  ASM_SIMP_TAC[GSYM induced_compact];
+  DISCH_TAC;
+  TYPE_THEN `induced_top U X = U00` SUBGOAL_TAC;
+  KILL 19;
+  EXPAND_TAC "U";
+  KILL 23;
+  EXPAND_TAC "U00";
+  IMATCH_MP_TAC  top_of_metric_induced;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  UND 24;
+  EXPAND_TAC "U00";
+  TYPE_THEN `compact (induced_top U X) X = compact U X` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM induced_compact);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  ASM_MESON_TAC[];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let preimage_compact_interval = prove_by_refinement(
+  `!C n f a b.
+  (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
+            (top_of_metric(euclid n,d_euclid)) /\
+  (IMAGE f {x | a <= x /\ x <= b} SUBSET (euclid n)) /\
+  (closed_ (top_of_metric(euclid n,d_euclid)) C) /\
+  ~(IMAGE f {x | a <= x /\ x <= b} INTER C = EMPTY)) ==>
+  (compact (top_of_metric(UNIV,d_real))
+         (preimage {x | a <= x /\ x <= b} f C))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  preimage_compact;
+  TYPE_THEN `(euclid n)` EXISTS_TAC;
+  TYPE_THEN `d_euclid` EXISTS_TAC;
+  ASM_REWRITE_TAC[metric_real;metric_euclid;interval_compact;];
+  ]);;
+  (* }}} *)
+
+let preimage_first = prove_by_refinement(
+  `!C n f a b.
+  (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
+            (top_of_metric(euclid n,d_euclid)) /\
+  (IMAGE f {x | a <= x /\ x <= b} SUBSET (euclid n)) /\
+  (closed_ (top_of_metric(euclid n,d_euclid)) C) /\
+  ~(IMAGE f {x | a <= x /\ x <= b} INTER C = EMPTY)) ==>
+  (?t. (a <= t /\ t <= b) /\ (C (f t)) /\
+    (!s. (a <=s /\ s < t) ==> ~(C (f s))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(compact (top_of_metric(UNIV,d_real)) (preimage {x | a <= x /\ x <= b} f C))` SUBGOAL_TAC;
+  IMATCH_MP_TAC preimage_compact_interval;
+  TYPE_THEN `n` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~(preimage {x | a <= x /\ x <= b} f C = EMPTY)` SUBGOAL_TAC;
+  UND 0;
+  REWRITE_TAC[EMPTY_EXISTS];
+  REWRITE_TAC[IMAGE ;INTER;preimage];
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `X = preimage {x | a <= x /\ x <= b } f C` ABBREV_TAC ;
+  TYPE_THEN `(?x. (X x) /\ (!y. (X y) ==> (x <= y)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  compact_inf;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  UND 8;
+  UND 7;
+  EXPAND_TAC "X";
+  REWRITE_TAC[preimage];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TSPEC `s` 10;
+  REWR 10;
+  UND 10;
+  UND 12;
+  UND 8;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let inj_subset_domain = prove_by_refinement(
+  `!s s' t (f:A->B). INJ f s t /\ (s' SUBSET s) ==> INJ f s' t`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ;SUBSET;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let arc_restrict = prove_by_refinement(
+  `!a b c d C f t t'. (c <= t /\ t < t' /\ t' <= d) /\ (a < b) /\
+     (C = IMAGE f { x | c <= x /\ x <= d }) /\
+     INJ f {x | c <= x /\ x <= d} (euclid 2) /\
+     continuous f (top_of_metric(UNIV,d_real))
+            (top_of_metric(euclid 2,d_euclid)) ==>
+    (?g.
+  (IMAGE g {x | a <= x /\ x <= b} = IMAGE f {x | t <= x /\ x <= t'})  /\
+     (g a = f t) /\ (g b = f t') /\
+       INJ g { x | a <= x /\ x <= b} (euclid 2) /\
+       continuous g (top_of_metric(UNIV,d_real))
+            (top_of_metric(euclid 2,d_euclid)))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN ` continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | t <= x /\ x <= t'} (euclid 2) /\ (a < b) /\ (t < t')` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[top2];
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | c <= x /\ x <= d}` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET;];
+  UND 4;
+  UND 5;
+  UND 6;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
+  REP_BASIC_TAC;
+  TYPE_THEN `g` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[top2];
+  ]);;
+
+  (* }}} *)
+
+let continuous_induced_domain = prove_by_refinement(
+  `!(f:A->B) U V K. (continuous f U V) /\ (K SUBSET (UNIONS U)) ==>
+    (continuous f (induced_top U K) V)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[continuous;induced_top_support;];
+  REWRITE_TAC[preimage;induced_top];
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `{x | UNIONS U x /\ v (f x)}` EXISTS_TAC;
+  ASM_SIMP_TAC[];
+  REWRITE_TAC[INTER];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let inj_split = prove_by_refinement(
+  `!A B Z (f:A->B). (INJ f A Z) /\ (INJ f B Z) /\
+     (IMAGE f A INTER IMAGE f B = EMPTY) ==> (INJ f (A UNION B) Z)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ;INTER;IMAGE;UNION;];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  REP_GEN_TAC;
+  REP_BASIC_TAC;
+  UND 7;
+  UND 6;
+  REP_CASES_TAC;
+  KILL 1;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  REWRITE_TAC[EQ_EMPTY];
+  NAME_CONFLICT_TAC;
+  DISCH_TAC;
+  TSPEC `f y` 0;
+  USE 0 (REWRITE_RULE[DE_MORGAN_THM]);
+  ASM_MESON_TAC[];
+  USE 0 (REWRITE_RULE[EQ_EMPTY]);
+  TSPEC `f x` 0;
+  ASM_MESON_TAC[];
+  KILL 3;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let joinf_inj_below = prove_by_refinement(
+  `!(f:real->B) g a A.
+    (A SUBSET {x | x < a}) ==> (INJ (joinf f g a) A = INJ f A)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC EQ_EXT;
+  REWRITE_TAC[INJ];
+  REP_BASIC_TAC;
+  TYPE_THEN `!z. A z ==> (joinf f g a z = f z)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[joinf];
+  TSPEC `z` 0;
+  REWR 0;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let joinf_inj_above = prove_by_refinement(
+  `!(f:real->B) g a A.
+    (A SUBSET {x | a <= x}) ==> (INJ (joinf f g a) A = INJ g A)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC EQ_EXT;
+  REWRITE_TAC[INJ];
+  REP_BASIC_TAC;
+  TYPE_THEN `!z. A z ==> (joinf f g a z = g z)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[joinf];
+  TSPEC `z` 0;
+  REWR 0;
+  ASM_REWRITE_TAC[REAL_ARITH ` (z < a) <=> ~(a <= z) `];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let joinf_image_below = prove_by_refinement(
+  `!(f:real->B) g a A.
+    (A SUBSET {x | x < a}) ==> (IMAGE (joinf f g a) A = IMAGE f A)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC EQ_EXT;
+  REWRITE_TAC[IMAGE];
+  REP_BASIC_TAC;
+  TYPE_THEN `!z. A z ==> (joinf f g a z = f z)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[joinf];
+  TSPEC `z` 0;
+  REWR 0;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let joinf_image_above = prove_by_refinement(
+  `!(f:real->B) g a A.
+    (A SUBSET {x | a <= x}) ==> (IMAGE (joinf f g a) A = IMAGE g A)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC EQ_EXT;
+  REWRITE_TAC[IMAGE];
+  REP_BASIC_TAC;
+  TYPE_THEN `!z. A z ==> (joinf f g a z = g z)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[joinf];
+  TSPEC `z` 0;
+  REWR 0;
+  ASM_REWRITE_TAC[REAL_ARITH ` (z < a) <=> ~(a <= z) `];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let pconn_trans = prove_by_refinement(
+  `!A x y z. (p_conn A x y /\ p_conn A y z ==> p_conn A x z)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[p_conn;simple_polygonal_arc;simple_arc;];
+  REP_BASIC_TAC;
+  TYPE_THEN `C' x`  ASM_CASES_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `f'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  TYPE_THEN `~(x = y)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* now ~( x= y) *)
+  TYPE_THEN `C z` ASM_CASES_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  TYPE_THEN `~(z = y)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* now ~( z = y) *)
+  TYPE_THEN `?tx. (&0 <= tx) /\ (tx <= &1) /\ (f tx = x)` SUBGOAL_TAC;
+  UND 10;
+  ASM_REWRITE_TAC[IMAGE;];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `?ty. (&0 <= ty) /\ (ty <= &1) /\ (f ty = y)` SUBGOAL_TAC;
+  UND 9;
+  ASM_REWRITE_TAC[IMAGE;];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `~(tx = ty)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* reparameter C *)
+  TYPE_THEN `?g. (g (&0) = x) /\ (g (&1) = y) /\ INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\ continuous g (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ IMAGE g { x | &0 <= x /\ x <= &1 } SUBSET C` SUBGOAL_TAC;
+  TYPE_THEN `(tx < ty) \/ (ty < tx)` SUBGOAL_TAC;
+  UND 28;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `(?g.   (IMAGE g {x | &0 <= x /\ x <= &1} = IMAGE f {x | tx <= x /\ x <= ty})  /\     (g (&0) = f tx) /\ (g (&1) = f ty) /\       INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\       continuous g (top_of_metric(UNIV,d_real))             (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  arc_restrict;
+  TYPE_THEN `&0` EXISTS_TAC;
+  TYPE_THEN `&1` EXISTS_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;];
+  UND 15;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
+  REP_BASIC_TAC;
+  TYPE_THEN `g` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  REWRITE_TAC[SUBSET];
+  GEN_TAC;
+  UND 24;
+  UND 26;
+  REAL_ARITH_TAC;
+  TYPE_THEN `(?g.   (IMAGE g {x | &0 <= x /\ x <= &1} = IMAGE f {x | ty <= x /\ x <= tx})  /\     (g (&0) = f ty) /\ (g (&1) = f tx) /\       INJ g { x | &0 <= x /\ x <= &1 } (euclid 2) /\       continuous g (top_of_metric(UNIV,d_real))             (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  arc_restrict;
+  TYPE_THEN `&0` EXISTS_TAC;
+  TYPE_THEN `&1` EXISTS_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;];
+  UND 15;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
+  REP_BASIC_TAC;
+  (* REVERSE reparameter on C XX0 *)
+  TYPE_THEN `(?g'. continuous g' (top_of_metric (UNIV,d_real)) (top2) /\           INJ g' {x | (&0) <= x /\ x <= (&1)} (euclid 2) /\         (g (&1)  = g' (&0)) /\ (g (&0) = g' (&1)) /\      (!x y x' y'. (g x = g' x') /\ (g y = g' y') /\         ((&0) <= x /\ x <= (&1)) /\ ((&0) <= y /\ y <= (&1)) /\         ((&0) <= x' /\ x' <= (&1)) /\ ((&0) <= y' /\ y' <= (&1)) ==>           ((x < y) <=> (y' < x'))) /\      (IMAGE g { x | (&0) <= x /\ x <= (&1) } =          IMAGE g' { x | (&0) <= x /\ x <= (&1) } ))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  arc_reparameter_rev;
+  ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;top2;];
+  REP_BASIC_TAC;
+  TYPE_THEN `g'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  ASM_MESON_TAC[];  (* L80 *)
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  ASM_MESON_TAC[top2];
+  TYPE_THEN `IMAGE g' {x | &0 <= x /\ x <= &1} = IMAGE f {x | ty <= x /\ x <= tx }` SUBGOAL_TAC;
+  UND 34;
+  UND 35;
+  alpha_tac;
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  REWRITE_TAC[SUBSET];
+  UND 23;
+  UND 27;
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  (* now restrict C to [x,y'] *)
+  (* rC *)
+  TYPE_THEN `Cg = IMAGE g {x | &0 <= x /\ x <= &1 }` ABBREV_TAC ;
+  TYPE_THEN `Z = Cg INTER C'` ABBREV_TAC ;
+  TYPE_THEN `?t'. (&0 <= t' /\ t' <= &1) /\ (Z (g t')) /\ (!s. (&0 <=s /\ s < t') ==> ~(Z (g s)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  preimage_first;
+  EXISTS_TAC `2`;
+  (* restriction conditions *)
+  CONJ_TAC;
+  TYPE_THEN `induced_top(top_of_metric(UNIV,d_real)) {x | &0 <= x /\ x <= &1 } = top_of_metric ({x | &0 <= x /\ x <= &1 },d_real)` SUBGOAL_TAC;
+  ASM_SIMP_TAC[SUBSET_UNIV;metric_real;top_of_metric_induced];
+  DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]);
+  IMATCH_MP_TAC  continuous_induced_domain;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
+  SUBCONJ_TAC;
+  UND 31;
+  REWRITE_TAC[INJ;IMAGE;SUBSET;];
+  MESON_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  (* rC2 *)
+  TYPE_THEN `!C. (?f a b. (continuous f (top_of_metric(UNIV,d_real)) (top2)) /\ (INJ f {x | a <= x /\ x <= b} (euclid 2)) /\ (IMAGE f {x | a <= x /\ x <= b} = C)) ==> (closed_ top2 C)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  compact_closed;
+  ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid];
+  ASM_SIMP_TAC[top_of_metric_top;metric_euclid];
+  EXPAND_TAC "C''";
+  IMATCH_MP_TAC  image_compact;
+  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid;interval_compact];
+  ASM_SIMP_TAC[GSYM top2];
+  EXPAND_TAC "C''";
+  UND 38;
+  REWRITE_TAC[INJ;IMAGE;SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  REWRITE_TAC[GSYM top2];
+  EXPAND_TAC "Z";
+  IMATCH_MP_TAC  closed_inter2;
+  REWRITE_TAC[top2_top];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `g` EXISTS_TAC;
+  TYPE_THEN `&0` EXISTS_TAC;
+  TYPE_THEN `&1` EXISTS_TAC;
+  ASM_REWRITE_TAC[];  (* XX2 *)
+  ASM_SIMP_TAC[top2];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `f'` EXISTS_TAC;
+  TYPE_THEN `&0` EXISTS_TAC;
+  TYPE_THEN `&1` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[top2];
+  UND 6;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
+  EXPAND_TAC "Z";
+  REWRITE_TAC[EMPTY_EXISTS;INTER;IMAGE];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `&1` EXISTS_TAC;
+  EXPAND_TAC "Cg";
+  ASM_REWRITE_TAC[IMAGE;];
+  REPEAT (CONJ_TAC THEN (TRY (REAL_ARITH_TAC)));
+  EXPAND_TAC "Cg";  (* L160 *)
+  (remark "LINE 160"; ALL_TAC);
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `&1` EXISTS_TAC;
+  REPEAT (CONJ_TAC THEN (TRY (REAL_ARITH_TAC)));
+  ASM_REWRITE_TAC[];
+  UND 1;
+  ASM_REWRITE_TAC[IMAGE];
+  REP_BASIC_TAC;
+  TYPE_THEN `(t' = &0) \/ (&0 < t')` SUBGOAL_TAC;
+  UND 39;
+  REAL_ARITH_TAC;
+  (* elim t' =0 *)
+  DISCH_THEN DISJ_CASES_TAC;
+  UND 37;
+  EXPAND_TAC "Z";
+  REWRITE_TAC[INTER];
+  ASM_MESON_TAC[];
+  (*  **  START ON 2nd BRANCH  ** *** ** *)
+  (* 2b*)
+  TYPE_THEN `?tz. (&0 <= tz) /\ (tz <= &1) /\ (f' tz = z)` SUBGOAL_TAC;
+  UND 0;
+  ASM_REWRITE_TAC[IMAGE;];
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  LEFT_TAC "tz";
+  TYPE_THEN `x'` EXISTS_TAC;
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `?t''. (&0 <= t'') /\ (t'' <= &1) /\ (f' t'' = g t')` SUBGOAL_TAC;
+  UND 37;
+  EXPAND_TAC "Z";
+  REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[IMAGE;];
+  DISCH_THEN (fun t-> MP_TAC (CONJUNCT2 t));
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `~(tz = t'')` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `C (g t')` SUBGOAL_TAC;
+  UND 37;
+  EXPAND_TAC "Z";
+  REWRITE_TAC[INTER];
+  UND 29;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* reparam on C' *)
+  TYPE_THEN `?h. (h (&1/(&2)) = g t') /\ (h (&1) = z) /\ INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\ continuous h (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ IMAGE h { x | &1/(&2) <= x /\ x <= &1 } SUBSET C'` SUBGOAL_TAC;
+  TYPE_THEN `(t'' < tz) \/ (tz < t'')` SUBGOAL_TAC;
+  UND 47;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `(?h.   (IMAGE h {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | t'' <= x /\ x <= tz})  /\     (h (&1/(&2)) = f' t'') /\ (h (&1) = f' tz) /\       INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\       continuous h (top_of_metric(UNIV,d_real))             (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  arc_restrict;
+  TYPE_THEN `&0` EXISTS_TAC;
+  TYPE_THEN `&1` EXISTS_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 6;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
+  DISCH_TAC;
+  REWRITE_TAC[REAL_LT_HALF2];
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `h` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  REWRITE_TAC[SUBSET];
+  GEN_TAC;
+  UND 42;
+  UND 46;
+  REAL_ARITH_TAC;
+  TYPE_THEN `(?h.   (IMAGE h {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | tz <= x /\ x <= t'' })  /\     (h (&1/(&2)) = f' tz) /\ (h (&1) = f' t'') /\       INJ h { x | &1/(&2) <= x /\ x <= &1 } (euclid 2) /\       continuous h (top_of_metric(UNIV,d_real))  (top_of_metric(euclid 2,d_euclid)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  arc_restrict;
+  TYPE_THEN `&0` EXISTS_TAC;
+  TYPE_THEN `&1` EXISTS_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[REAL_LT_HALF2;REAL_ARITH `&0 < &1`];
+  UND 6;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
+  REP_BASIC_TAC;  (* L240 *)
+  (remark "LINE 240"; ALL_TAC);
+  (* REVERSE reparameter on C *)
+  TYPE_THEN `(?h'. continuous h' (top_of_metric (UNIV,d_real)) (top2) /\           INJ h' {x | (&1/(&2)) <= x /\ x <= (&1)} (euclid 2) /\         (h (&1)  = h' (&1/(&2))) /\ (h (&1/(&2)) = h' (&1)) /\      (!x y x' y'. (h x = h' x') /\ (h y = h' y') /\         ((&1/(&2)) <= x /\ x <= (&1)) /\ ((&1/(&2)) <= y /\ y <= (&1)) /\         ((&1/(&2)) <= x' /\ x' <= (&1)) /\ ((&1/(&2)) <= y' /\ y' <= (&1)) ==>           ((x < y) <=> (y' < x'))) /\      (IMAGE h { x | (&1/(&2)) <= x /\ x <= (&1) } =          IMAGE h' { x | (&1/(&2)) <= x /\ x <= (&1) } ))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  arc_reparameter_rev;
+  ASM_REWRITE_TAC[REAL_LT_HALF2;REAL_ARITH `&0 < &1`;top2;];
+  REP_BASIC_TAC;
+  TYPE_THEN `h'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  ASM_MESON_TAC[top2];
+  TYPE_THEN `IMAGE h' {x | &1/(&2) <= x /\ x <= &1} = IMAGE f' {x | tz <= x /\ x <= t'' }` SUBGOAL_TAC;
+  UND 53;  (* ZZZ *)
+  UND 54;
+  alpha_tac;
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  REWRITE_TAC[SUBSET];
+  UND 43;
+  UND 45;
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  (* reparam g [0,1/2] *)
+  (* rg *)
+  TYPE_THEN `?g'. ((g' (&0)) = x) /\ (g' (&1/(&2)) = g t') /\ INJ g' { x | &0 <= x /\ x <= &1/(&2) } (euclid 2) /\ continuous g' (top_of_metric(UNIV,d_real)) (top_of_metric(euclid 2,d_euclid)) /\ (IMAGE g' { x | &0 <= x /\ x <= &1/(&2) } = IMAGE g {x | &0 <= x /\ x <= t'}) ` SUBGOAL_TAC; (* was SUBSET Cg *)
+  ASSUME_TAC arc_reparameter_gen;
+  TYPEL_THEN [`g`;`&0`;`&1/(&2)`;`&0`;`t'`] (fun t-> FIRST_ASSUM (fun s-> (MP_TAC (ISPECL t s))));
+  KILL 53;   (* ZZZ *)
+  ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`;REAL_LT_HALF1;];
+  UND 30;
+  REWRITE_TAC[top2];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `INJ g {x | &0 <= x /\ x <= t'} (euclid 2)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x <= &1 }` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  UND 38;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REP_BASIC_TAC;
+  TYPE_THEN `g'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* deleted lines here *)
+  REP_BASIC_TAC;
+  TYPE_THEN `fm = joinf g' h (&1/(&2))` ABBREV_TAC ;
+  TYPE_THEN `Cm = IMAGE fm {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
+  TYPE_THEN `Cm` EXISTS_TAC;
+  (* final instantiation *)
+  (* fi *)
+  REPEAT (IMATCH_MP_TAC  (TAUT `A /\ B/\ C ==> (A /\ B) /\C`));
+  CONJ_TAC;
+  TYPE_THEN `fm` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  EXPAND_TAC "fm";
+  IMATCH_MP_TAC  joinf_cont;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1 }` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  GEN_TAC;
+  TYPE_THEN `&0 < &1/(&2) /\ (&1/(&2) < &1)` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2;REAL_ARITH `&0 < &1`];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  inj_split;
+  EXPAND_TAC "fm";
+  TYPE_THEN `{x | &0 <= x /\ x < &1/(&2)} SUBSET {x | x < &1/(&2)} /\ {x | &1/(&2) <= x /\ x <= &1} SUBSET {x | &1/(&2) <= x}` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  KILL 58;
+  ASM_SIMP_TAC[joinf_inj_above;joinf_inj_below;joinf_image_above;joinf_image_below];
+  DISCH_TAC;
+  (* cases *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_subset_domain;  (* L320 *)
+  (remark "LINE 320"; ALL_TAC);
+  TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2) }` EXISTS_TAC;
+  ASM_SIMP_TAC[GSYM  top_of_metric_unions;metric_euclid];
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  ASM_SIMP_TAC[GSYM  top_of_metric_unions;metric_euclid];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `IMAGE g' { x | &0 <= x /\ x <= &1/(&2)} INTER IMAGE h {x | &1/(&2) <= x /\ x <= &1} SUBSET {(g t')}` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `IMAGE g { x | &0 <= x /\ x <= t' } SUBSET Cg` SUBGOAL_TAC;
+  EXPAND_TAC "Cg";
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  REWRITE_TAC[SUBSET];
+  UND 38;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= t'} INTER Z` EXISTS_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "Z";
+  UND 48;
+  UND 60;
+  REWRITE_TAC[SUBSET;INTER];
+  (* MESON_TAC[]; *)
+  POP_ASSUM_LIST (fun t-> ALL_TAC);
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  (* LINE 350 *)
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_REWRITE_TAC[];
+  UND 36;
+  REWRITE_TAC[INTER;SUBSET;IMAGE];
+  UND 37;
+  POP_ASSUM_LIST (fun t-> ALL_TAC);
+  REP_BASIC_TAC;
+  REWRITE_TAC[INR IN_SING];
+  UND 0;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(x' = t') \/ (x' < t')` SUBGOAL_TAC;
+  UND 2;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 61 (REWRITE_RULE[EMPTY_EXISTS ]);
+  REP_BASIC_TAC;
+  TYPE_THEN `!B' B (u:num->real). (B' u /\ B' SUBSET B) ==> (B u)` SUBGOAL_TAC;
+  MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `{(g t')} u` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} INTER IMAGE h {x | &1 / &2 <= x /\ x <= &1})` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x <= &1 / &2} INTER IMAGE h {x | &1 / &2 <= x /\ x <= &1})` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[INTER;SUBSET;IMAGE];
+  MESON_TAC[REAL_ARITH `x < t ==> x <= t`];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INR IN_SING];
+  REP_BASIC_TAC;
+  UND 62;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INTER;IMAGE;DE_MORGAN_THM;];
+  DISJ1_TAC;
+  USE 56 SYM;
+  ASM_REWRITE_TAC[];
+  UND 55;
+  POP_ASSUM_LIST (fun t-> ALL_TAC);
+  REWRITE_TAC[INJ];
+  REP_BASIC_TAC;
+  USE 1(REWRITE_RULE [REAL_ARITH `(x < &1/(&2)) <=> (x <= &1/(&2) /\ ~(x = &1/(&2)))`]);
+  TYPEL_THEN [`x`;`&1/(&2)`] (USE 3 o ISPECL);
+  TYPE_THEN `&0 <= &1/ &2 /\ &1/ &2 <= &1/ (&2)` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_ARITH `x <= x`];
+  IMATCH_MP_TAC  REAL_LE_DIV;
+  REAL_ARITH_TAC;
+  ASM_MESON_TAC[];
+  (* Now E *)   (* L400 *)
+  (remark "LINE 400"; ALL_TAC);
+  (* ne *)
+  TYPE_THEN ` {x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1 }` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  GEN_TAC;
+  TYPE_THEN `&0 < &1/(&2) /\ (&1/(&2) < &1)` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2;REAL_ARITH `&0 < &1`];
+  REAL_ARITH_TAC;
+  EXPAND_TAC "Cm";
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[IMAGE_UNION];
+  TYPE_THEN `{x | &0 <= x /\ x < &1/(&2)} SUBSET {x | x < &1/(&2)} /\ {x | &1/(&2) <= x /\ x <= &1} SUBSET {x | &1/(&2) <= x}` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  EXPAND_TAC "fm";
+  KILL 58;
+  ASM_SIMP_TAC[joinf_image_above;joinf_image_below];
+  DISCH_TAC;
+  TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} UNION  IMAGE h {x | &1 / &2 <= x /\ x <= &1}) z` SUBGOAL_TAC;
+  UND 51;
+  REWRITE_TAC[UNION;IMAGE];
+  POP_ASSUM_LIST (fun t->ALL_TAC);
+  REP_BASIC_TAC;
+  DISJ2_TAC;
+  TYPE_THEN `&1` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_ARITH `&1 <= &1`];
+  IMATCH_MP_TAC  REAL_LE_LDIV;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `(IMAGE g' {x | &0 <= x /\ x < &1 / &2} UNION  IMAGE h {x | &1 / &2 <= x /\ x <= &1}) x` SUBGOAL_TAC;
+  UND 57;
+  REWRITE_TAC[UNION;IMAGE];
+  POP_ASSUM_LIST (fun t->ALL_TAC);
+  REP_BASIC_TAC;
+  DISJ1_TAC;
+  TYPE_THEN `&0` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_ARITH `&0 <= &0`];
+  REWRITE_TAC[REAL_LT_HALF1];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  (* gh *)
+  UND 48;
+  TYPE_THEN `IMAGE g' {x | &0 <= x /\ x < &1/ &2} SUBSET C` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Cg ` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  EXPAND_TAC "Cg";
+  TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= t'}` EXISTS_TAC;
+  CONJ_TAC;
+  USE 53 SYM;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE;SUBSET];
+  MESON_TAC[REAL_ARITH `x < t ==> x <= t`];
+  REWRITE_TAC[IMAGE;SUBSET];
+  UND 38;
+  MESON_TAC[REAL_ARITH `t' <= &1 ==> (x <= t' ==> x<= &1)`];
+  TYPE_THEN `GCG = IMAGE g' {x | &0 <= x /\ x < &1 / &2}` ABBREV_TAC ;
+  TYPE_THEN `HCH = IMAGE h {x | &1 / &2 <= x /\ x <= &1}` ABBREV_TAC ;
+  UND 11;
+  UND 2;
+  UND 4;
+  UND 5;
+  UND 13;
+  UND 14;
+  UND 12;
+  UND 3;
+  POP_ASSUM_LIST (fun t->ALL_TAC);
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  TYPE_THEN `E UNION E'` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[UNIONS_UNION];
+  REWRITE_TAC[union_subset];
+  CONJ_TAC;
+  UND 1;
+  UND 7;
+  REWRITE_TAC[UNION;SUBSET];  (* L480 *)
+  (remark "LINE 480"; ALL_TAC);
+  MESON_TAC[];
+  UND 0;
+  UND 5;
+  REWRITE_TAC[UNION;SUBSET];
+  MESON_TAC[];
+  CONJ_TAC;
+  ASM_REWRITE_TAC[FINITE_UNION];
+  UND 8;
+  UND 9;
+  REWRITE_TAC[hv_line;UNION;];
+  MESON_TAC[];
+  UND 1;
+  UND 0;
+  UND 2;
+  UND 3;
+  REWRITE_TAC[SUBSET;UNION;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION J *)
+(* ------------------------------------------------------------------ *)
+
+
+(* Conclusion of Jordan Curve, page 1 *)
+
+let v_simple_polygonal = prove_by_refinement(
+  `!x e. (euclid 2 x) /\ (~(e = &0)) ==>
+    (simple_polygonal_arc hv_line (mk_segment x (x + e *# e2)))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[simple_polygonal_arc;hv_line;simple_arc ];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  ASSUME_TAC mk_segment_inj_image;
+  TYPEL_THEN [`x`;`x + (e *# e2)`;`2`] (USE 2 o ISPECL);
+  TYPE_THEN `euclid 2 x /\ euclid 2 (euclid_plus x (e *# e2)) /\ ~(x = euclid_plus x (e *# e2))` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  euclid_add_closure;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  euclid_scale_closure;
+  REWRITE_TAC [e2;euclid_point];
+  REP_BASIC_TAC;
+  FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `1`));
+  REWRITE_TAC[euclid_plus;euclid_scale;e2;coord01];
+  UND 0;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  REWR 2;
+  REP_BASIC_TAC;
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SIMP_TAC  [GSYM top_of_metric_unions;metric_euclid];
+  ASM_REWRITE_TAC[];
+  (* E *)
+  USE 1 (MATCH_MP point_onto);
+  REP_BASIC_TAC;
+  TYPE_THEN `{(mk_line (point p) (point p + (e *# e2)))}` EXISTS_TAC;
+  REWRITE_TAC[INR IN_SING];
+  CONJ_TAC;
+  REWRITE_TAC[e2;ISUBSET;mk_segment;mk_line];
+  REP_BASIC_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[FINITE_SING];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p` EXISTS_TAC;
+  TYPE_THEN `(FST p , SND p + e)` EXISTS_TAC;
+  REWRITE_TAC[];
+  AP_TERM_TAC;
+  REWRITE_TAC[e2;point_scale];
+  REDUCE_TAC;
+  TYPE_THEN `euclid_plus (point p) (point (&0,e)) = euclid_plus (point (FST p,SND p)) (point (&0,e))` SUBGOAL_TAC;
+  REWRITE_TAC[];
+  DISCH_THEN (fun t-> PURE_ONCE_REWRITE_TAC[t]);
+  REWRITE_TAC[point_add];
+  REDUCE_TAC;
+  ]);;
+
+  (* }}} *)
+
+let p_conn_ball = prove_by_refinement(
+  `! x y r. (open_ball(euclid 2,d_euclid) x r y) ==>
+      (p_conn (open_ball(euclid 2,d_euclid) x r) x y)`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `open_ball (euclid 2,d_euclid) x r x` SUBGOAL_TAC;
+  SIMP_TAC [metric_euclid;INR open_ball_nonempty_center];
+  REWRITE_TAC[EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+
+  TYPE_THEN `euclid 2 x /\ euclid 2 y` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[open_ball]);
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  RULE_ASSUM_TAC  (fun t -> try (MATCH_MP point_onto t) with  Failure _ -> t);
+  REP_BASIC_TAC;
+
+  TYPE_THEN `y' = point(FST p,SND p')` ABBREV_TAC ;
+  TYPE_THEN `A = open_ball(euclid 2,d_euclid) x r` ABBREV_TAC ;
+
+  TYPE_THEN `y' = euclid_plus x ((SND  p' - SND  p) *# e2)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "y'";
+  REWRITE_TAC[e2];
+  REWRITE_TAC[point_add;point_scale;];
+  REDUCE_TAC;
+  PURE_ONCE_REWRITE_TAC [GSYM PAIR];
+  PURE_REWRITE_TAC [point_add];
+  REWRITE_TAC[];
+  REDUCE_TAC;
+  AP_TERM_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+
+  TYPE_THEN `A y'` SUBGOAL_TAC;
+  UND 0;
+  EXPAND_TAC "y'";
+  KILL 4;
+  EXPAND_TAC "A";
+  KILL 5;
+  ASM_REWRITE_TAC[open_ball;euclid_point;d_euclid_point;];
+  REWRITE_TAC[REAL_ARITH `(x - x = &0)`;POW_0;ARITH_RULE  `2 = SUC 1`];
+  IMATCH_MP_TAC  (REAL_ARITH `(x <= y) ==> (y < r ==> x < r)`);
+  IMATCH_MP_TAC  SQRT_MONO_LE;
+  REWRITE_TAC[REAL_ARITH `&0 + x = x`;ARITH_RULE `SUC 1 = 2`;REAL_PROP_NN_SQUARE];
+  IMATCH_MP_TAC  (REAL_ARITH `&0 <= x ==> (y <= x + y)`);
+  REWRITE_TAC[REAL_PROP_NN_SQUARE];
+  DISCH_TAC;
+
+  TYPE_THEN `p_conn A x y'` SUBGOAL_TAC;
+  TYPE_THEN `x = y'` ASM_CASES_TAC;
+  EXPAND_TAC "y'";
+  IMATCH_MP_TAC  pconn_refl;
+  REWRITE_TAC[p_conn];
+  CONJ_TAC;
+  EXPAND_TAC "A";
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  open_ball_open;
+  MESON_TAC[metric_euclid];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[p_conn];
+  TYPE_THEN `mk_segment x y'` EXISTS_TAC;
+  CONJ_TAC;
+  UND 6;
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  v_simple_polygonal;
+  ASM_REWRITE_TAC[euclid_point];
+  REWRITE_TAC[REAL_SUB_0];
+  DISCH_ALL_TAC;
+  UND 8;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "y'";
+  AP_TERM_TAC;
+  ASM_MESON_TAC[PAIR];
+  CONJ_TAC;
+  EXPAND_TAC "A";
+  IMATCH_MP_TAC  openball_mk_segment_end;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[mk_segment_end];
+  DISCH_TAC;
+
+  TYPE_THEN `y' = euclid_plus y ((FST   p - FST   p') *# e1)` SUBGOAL_TAC;
+  KILL 6;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "y'";
+  REWRITE_TAC[e1];
+  REWRITE_TAC[point_add;point_scale;];
+  REDUCE_TAC;
+  PURE_ONCE_REWRITE_TAC [GSYM PAIR];
+  PURE_REWRITE_TAC [point_add];
+  REWRITE_TAC[];
+  REDUCE_TAC;
+  AP_TERM_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+
+  TYPE_THEN `p_conn A y y'` SUBGOAL_TAC;
+  TYPE_THEN `y = y'` ASM_CASES_TAC;
+  EXPAND_TAC "y'";
+  IMATCH_MP_TAC  pconn_refl;
+  CONJ_TAC;
+  EXPAND_TAC "A";
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  open_ball_open;
+  MESON_TAC[metric_euclid];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[p_conn];
+  TYPE_THEN `mk_segment y y'` EXISTS_TAC;
+  CONJ_TAC;
+  UND 9;
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  h_simple_polygonal;
+  ASM_REWRITE_TAC[euclid_point];
+  REWRITE_TAC[REAL_SUB_0];
+  DISCH_ALL_TAC;
+  UND 10;
+  KILL 6;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "y'";
+  AP_TERM_TAC;
+  ASM_MESON_TAC[PAIR];
+  CONJ_TAC;
+  EXPAND_TAC "A";
+  IMATCH_MP_TAC  openball_mk_segment_end;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[mk_segment_end];
+  DISCH_TAC;
+  IMATCH_MP_TAC  pconn_trans;
+  TYPE_THEN `y'` EXISTS_TAC;
+  UND 8;
+  DISCH_THEN_REWRITE;
+  UND 10;
+  MESON_TAC[pconn_symm];
+  (* Wed Aug  4 10:40:05 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let p_conn_euclid = prove_by_refinement(
+  `!A x. p_conn A x SUBSET (euclid 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;p_conn;simple_polygonal_arc;simple_arc;];
+  REP_BASIC_TAC;
+  UND 0;
+  ASM_REWRITE_TAC[];
+  UND 6;
+  SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
+  REWRITE_TAC[INJ;IMAGE];
+  MESON_TAC[];
+  (* Wed Aug  4 10:55:53 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let p_connA = prove_by_refinement(
+  `!A x. p_conn A x SUBSET A`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[p_conn;SUBSET;];
+  ASM_MESON_TAC[];
+  (* Wed Aug  4 11:11:21 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let p_conn_open = prove_by_refinement(
+  `!A x. top2 A ==> (top2 (p_conn A x))`,
+  (* {{{ proof *)
+  [
+  (* Wed Aug  4 10:43:29 EDT 2004 *)
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[top2;top_of_metric_nbd;metric_euclid;p_conn_euclid];
+  REP_BASIC_TAC;
+
+  TYPE_THEN `A a` SUBGOAL_TAC;
+  ASM_MESON_TAC[p_connA;ISUBSET];
+  DISCH_TAC;
+
+  TYPE_THEN `?r. (&0 < r) /\ open_ball (euclid 2,d_euclid) a r SUBSET A` SUBGOAL_TAC;
+  ASM_MESON_TAC[metric_euclid;top2;open_ball_nbd;];
+  REP_BASIC_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET;];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  pconn_trans;
+  TYPE_THEN `a` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  p_conn_subset;
+  TYPE_THEN `open_ball (euclid 2,d_euclid) a r` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  p_conn_ball;
+  ASM_REWRITE_TAC[];
+  (* Wed Aug  4 11:21:18 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let p_conn_diff = prove_by_refinement(
+  `!A x.  top2 A ==> (top2 (A DIFF (p_conn A x)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  SIMP_TAC[top2;metric_euclid;top_of_metric_nbd];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `A` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_DIFF];
+  UND 0;
+  REWRITE_TAC[top2;];
+  DISCH_TAC;
+  FIRST_ASSUM (fun t-> ASSUME_TAC (MATCH_MP sub_union t));
+  UND 1;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[DIFF]);
+  REP_BASIC_TAC;
+
+  TYPE_THEN `?r. (&0 < r) /\ open_ball (euclid 2,d_euclid) a r SUBSET A` SUBGOAL_TAC;
+  ASM_MESON_TAC[metric_euclid;top2;open_ball_nbd;];
+  REP_BASIC_TAC;
+
+  TYPE_THEN `r` EXISTS_TAC;
+  ASM_REWRITE_TAC[DIFF_SUBSET];
+  PROOF_BY_CONTR_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS;INTER]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP  p_conn_ball t));
+  TYPE_THEN `p_conn A a u` SUBGOAL_TAC;
+  IMATCH_MP_TAC  p_conn_subset;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  UND 1;
+  REWRITE_TAC[];
+  IMATCH_MP_TAC  pconn_trans;
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_MESON_TAC[pconn_symm];
+  (* Wed Aug  4 12:00:13 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let p_conn_conn = prove_by_refinement(
+  `!A x y. (top2 A /\ connected top2 A /\ A x /\ A y) ==>
+     (p_conn A x y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[connected];
+  REP_BASIC_TAC;
+  TYPEL_THEN [`p_conn A x`;`A DIFF (p_conn A x)`] (USE 2 o ISPECL);
+  UND 2;
+  ASM_SIMP_TAC[p_conn_open;p_conn_diff];
+
+  TYPE_THEN `!(w:(num->real)->bool) z. (w INTER (z DIFF w) = EMPTY)` SUBGOAL_TAC;
+  SET_TAC[INTER;DIFF];
+  DISCH_THEN_REWRITE;
+
+  TYPE_THEN `!(x:(num->real)->bool) y. (x SUBSET (y UNION (x DIFF y)))` SUBGOAL_TAC;
+  SET_TAC[SUBSET;UNION;DIFF];
+  DISCH_THEN_REWRITE;
+
+  DISCH_THEN (DISJ_CASES_TAC);
+  ASM_MESON_TAC[ISUBSET];
+  UND 2;
+  REWRITE_TAC[SUBSET;DIFF];
+  ASM_MESON_TAC[pconn_refl];
+  (* Wed Aug  4 12:42:12 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let plane_graph = jordan_def
+  `plane_graph G <=>
+     graph_vertex G SUBSET (euclid 2) /\
+     graph G /\
+     graph_edge G SUBSET (simple_arc top2) /\
+     (!e. (graph_edge G e ==>
+        (graph_inc G e = e INTER (graph_vertex G)))) /\
+     (!e e'. (graph_edge G e /\ graph_edge G e' /\ ~(e = e')) ==>
+        (e INTER e' SUBSET (graph_vertex G)))`;;
+
+let graph_isomorphic = jordan_def
+  `graph_isomorphic (G:(A,B)graph_t) (H:(A',B')graph_t) <=>
+     ?f. (graph_iso f G H)`;;
+
+let I_BIJ = prove_by_refinement(
+  `!(x:A->bool). BIJ I x x`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[BIJ;INJ;SURJ;I_THM;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let graph_isomorphic_refl = prove_by_refinement(
+  `!(G:(A,B)graph_t). graph_isomorphic G G`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_isomorphic;graph_iso;];
+  REP_BASIC_TAC;
+  RIGHT_TAC  "f";
+  RIGHT_TAC  "f";
+  TYPE_THEN `I:A->A` EXISTS_TAC;
+  TYPE_THEN `I:B->B` EXISTS_TAC;
+  TYPE_THEN `(I:A->A,I:B->B)` EXISTS_TAC;
+  ASM_REWRITE_TAC[I_THM;IMAGE_I;I_BIJ];
+  (* Wed Aug  4 13:08:32 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let graph_inc_subset = prove_by_refinement(
+  `!(G:(A,B)graph_t) e. (graph G /\ graph_edge G e) ==>
+       (graph_inc G e SUBSET graph_vertex G)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph;IMAGE;SUBSET;];
+  NAME_CONFLICT_TAC;
+  REP_BASIC_TAC;
+  USE 2 (CONV_RULE (dropq_conv "x''"));
+  TSPEC  `e'` 2;
+  REWR 2;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let graph_isomorphic_symm = prove_by_refinement(
+  `!(G:(A,B)graph_t) (H:(A',B')graph_t).
+     graph G /\ graph_isomorphic G H ==> graph_isomorphic H G`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_isomorphic;graph_iso];
+  REP_BASIC_TAC;
+  RIGHT_TAC "f";
+  RIGHT_TAC "f";
+  TYPE_THEN `u' = INV u (graph_vertex G) (graph_vertex H)` ABBREV_TAC  ;
+  TYPE_THEN `v' = INV v (graph_edge G) (graph_edge H)` ABBREV_TAC ;
+  TYPE_THEN `u'` EXISTS_TAC;
+  TYPE_THEN `v'` EXISTS_TAC;
+  TYPE_THEN `(u',v')` EXISTS_TAC;
+  REWRITE_TAC[];
+  CONJ_TAC;
+  EXPAND_TAC "u'";
+  IMATCH_MP_TAC  INVERSE_BIJ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  EXPAND_TAC "v'";
+  IMATCH_MP_TAC  INVERSE_BIJ;
+  ASM_REWRITE_TAC[];
+  (* LAST step *)
+  REP_BASIC_TAC;
+  TYPE_THEN `e' = v' e` ABBREV_TAC ;
+
+  TYPE_THEN `e = v e'` SUBGOAL_TAC;
+  ASM_MESON_TAC [inv_comp_right];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+
+  TYPE_THEN `BIJ v' (graph_edge H) (graph_edge G)` SUBGOAL_TAC;
+  ASM_MESON_TAC[INVERSE_BIJ];
+  DISCH_TAC;
+
+  TYPE_THEN `graph_edge G e'` SUBGOAL_TAC;
+  EXPAND_TAC "e'";
+  UND 10;
+  REWRITE_TAC[BIJ;SURJ;];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_SIMP_TAC[];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  EXPAND_TAC "u'";
+  IMATCH_MP_TAC  image_inv_image;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  graph_inc_subset;
+  ASM_MESON_TAC[];
+  (* Wed Aug  4 13:53:24 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let graph_isomorphic_trans = prove_by_refinement(
+  `!(G:(A,B)graph_t) (H:(A',B')graph_t) (J:(A'',B'')graph_t).
+    graph_isomorphic G H /\ graph_isomorphic H J ==>
+     graph_isomorphic G J`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_isomorphic;graph_iso;];
+  REP_BASIC_TAC;
+  KILL 3;
+  KILL 7;
+  RIGHT_TAC "f";
+  RIGHT_TAC "f";
+  TYPE_THEN `u' o u` EXISTS_TAC;
+  TYPE_THEN `v' o v` EXISTS_TAC;
+  TYPE_THEN `(u' o u, v' o v)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[comp_comp];
+  IMATCH_MP_TAC  COMP_BIJ;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[comp_comp];
+  IMATCH_MP_TAC  COMP_BIJ;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE_o];
+  REWRITE_TAC[o_DEF];
+
+  TYPE_THEN `graph_edge H (v e)` SUBGOAL_TAC;
+  UND 5;
+  REWRITE_TAC[BIJ;SURJ];
+  UND 3;
+  MESON_TAC[];
+  ASM_SIMP_TAC[];
+  (* Wed Aug  4 14:13:25 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let graph_isomorphic_graph = prove_by_refinement(
+  `!(G:(A,B)graph_t) H.
+     graph G /\ graph_isomorphic G (H:(A',B')graph_t) ==> graph H`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `!z. (graph_edge G z ==> graph_inc G z SUBSET graph_vertex G)` SUBGOAL_TAC;
+  ASM_MESON_TAC[graph_inc_subset];
+  DISCH_TAC;
+  UND 0;
+  UND 1;
+  REWRITE_TAC[graph;graph_isomorphic;graph_iso];
+  REP_BASIC_TAC;
+  REWRITE_TAC[SUBSET;IMAGE;];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x''");
+  REP_BASIC_TAC;
+  TYPE_THEN `?y'. (graph_edge G y' /\ (v y' = x'))` SUBGOAL_TAC;
+  UND 1;
+  REWRITE_TAC[BIJ;SURJ];
+  UND 6;
+  MESON_TAC[];
+  REP_BASIC_TAC;
+
+  TYPE_THEN `graph_inc H x' = IMAGE u (graph_inc G y')` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+
+  TYPE_THEN `graph_inc G y' SUBSET graph_vertex G` SUBGOAL_TAC;
+  ASM_SIMP_TAC[];
+  DISCH_TAC;
+  KILL 2;
+
+  SUBCONJ_TAC;
+  ASM_REWRITE_TAC[IMAGE];
+  UND 10;
+  UND 3;
+  REWRITE_TAC[BIJ;SURJ];
+  MESON_TAC[ISUBSET];
+  DISCH_TAC;
+
+  (* has size *)
+  TYPE_THEN `(graph_inc G y') HAS_SIZE 2` SUBGOAL_TAC;
+  UND 5;
+  REWRITE_TAC[SUBSET;IMAGE];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x''");
+  UND 8;
+  MESON_TAC[];
+  DISCH_TAC;
+
+
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[HAS_SIZE];
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_MESON_TAC[HAS_SIZE];
+  DISCH_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[HAS_SIZE]);
+  REP_BASIC_TAC;
+  UND 11;
+  DISCH_THEN (fun t -> REWRITE_TAC[GSYM t]);
+  IMATCH_MP_TAC  CARD_IMAGE_INJ;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  UND 3;
+  REWRITE_TAC[BIJ;INJ];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  (* Wed Aug  4 15:18:06 EDT 2004 *)
+  ]);;
+
+  (* }}} *)
+
+let planar_graph = jordan_def
+  `planar_graph (G:(A,B)graph_t) <=>
+      (?H. (plane_graph H) /\ (graph_isomorphic H G))`;;
+
+let plane_planar = prove_by_refinement(
+  `!G. (plane_graph G) ==> (planar_graph G)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[planar_graph];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[graph_isomorphic_refl];
+  ]);;
+
+  (* }}} *)
+
+let planar_is_graph = prove_by_refinement(
+  `!(G:(A,B)graph_t). (planar_graph G ==> graph G)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[planar_graph;plane_graph];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[graph_isomorphic_graph];
+  ]);;
+
+  (* }}} *)
+
+let planar_iso = prove_by_refinement(
+  `!G H. (planar_graph (G:(A,B)graph_t)) /\ (graph_isomorphic G H) ==>
+    (planar_graph (H:(A',B')graph_t))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[planar_graph];
+  REP_BASIC_TAC;
+  TYPE_THEN `H'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  JOIN 1 0;
+  USE 0 (MATCH_MP graph_isomorphic_trans);
+  ASM_REWRITE_TAC[];
+  (* Wed Aug  4 15:41:05 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+(* almost the same ans num_MAX .  The minimization is num_WOP. *)
+let select_num_max = prove_by_refinement(
+  `!Y. FINITE Y /\ (~(Y= EMPTY)) ==>
+        (?z. (Y z /\ (!y. Y y ==> y <=| z)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `f = \ (t:num). --. (&. t)` ABBREV_TAC ;
+  TYPE_THEN `Z = IMAGE f Y` ABBREV_TAC ;
+  TYPE_THEN `FINITE Z /\ ~(Z = {})` SUBGOAL_TAC;
+  EXPAND_TAC "Z";
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  UND 0;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `f u` EXISTS_TAC;
+  REWRITE_TAC[IMAGE];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  USE 4 (MATCH_MP   min_finite);
+  REP_BASIC_TAC;
+  TYPE_THEN `?z. Y z /\ (f z = delta)` SUBGOAL_TAC;
+  UND 5;
+  EXPAND_TAC "Z";
+  REWRITE_TAC[IMAGE;SUBSET];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `z` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `(f z <= f y) ==> (y <=| z)` SUBGOAL_TAC;
+  EXPAND_TAC "f";
+  REDUCE_TAC;
+  DISCH_THEN IMATCH_MP_TAC ;
+  TYPE_THEN `Z (f y)` SUBGOAL_TAC;
+  EXPAND_TAC "Z";
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let select_image_num_max = prove_by_refinement(
+  `!(X:A->bool) f.  (?N. (!x. (X x ==> f x <| N))) /\ ~(X = EMPTY)  ==>
+      (?z. (X z /\ (!x. (X x ==> f x <=| f z))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `Y = IMAGE f X` ABBREV_TAC ;
+  TYPE_THEN `Y SUBSET {n | n <| N}` SUBGOAL_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[IMAGE;SUBSET;];
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `FINITE Y /\ (~(Y= EMPTY))` SUBGOAL_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `{n | n <| N}` EXISTS_TAC;
+  ASM_REWRITE_TAC[FINITE_NUMSEG_LT];
+  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
+  REWRITE_TAC[EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  TYPE_THEN `f u` EXISTS_TAC;
+  UND 2;
+  UND 0;
+  REWRITE_TAC[IMAGE;SUBSET];
+  DISCH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  USE 4 (MATCH_MP   select_num_max);
+  REP_BASIC_TAC;
+  TYPE_THEN `?r. X r /\ (f r = z)` SUBGOAL_TAC;
+  UND 5;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[IMAGE;SUBSET];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TSPEC `f x` 4;
+  TYPE_THEN `Y (f x)` SUBGOAL_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* Wed Aug  4 16:41:51 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let select_image_num_min = prove_by_refinement(
+  `!(X:A->bool) f. (~(X = EMPTY)) ==>
+     (?z. (X z  /\ (!x. (X x ==> f z <=| f x))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `Y = IMAGE f X` ABBREV_TAC ;
+  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  TYPE_THEN `(?n. Y n)` SUBGOAL_TAC;
+  TYPE_THEN `f u` EXISTS_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  RULE_ASSUM_TAC (ONCE_REWRITE_RULE[num_WOP]);
+  REP_BASIC_TAC;
+  TYPE_THEN `?z. (X z) /\ (f z = n)` SUBGOAL_TAC;
+  UND 3;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[IMAGE;SUBSET];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `z` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TSPEC `f x` 2;
+  IMATCH_MP_TAC  (ARITH_RULE `~(f x <| n) ==> (n <=| f x)`);
+  DISCH_ALL_TAC;
+  UND 2;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "Y";
+  KILL 1;
+  ASM_REWRITE_TAC[IMAGE;SUBSET];
+   ASM_MESON_TAC[];
+  (* Wed Aug  4 19:37:29 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let select_card_max = prove_by_refinement(
+  `!(X:(A->bool)->bool).  (~(X = EMPTY) /\ (FINITE (UNIONS X))) ==>
+    (?z. (X z /\ (!x. (X x ==> (CARD x <= CARD z)))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  select_image_num_max;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `SUC (CARD (UNIONS X))` EXISTS_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `x SUBSET (UNIONS X)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  sub_union;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+   REWRITE_TAC[ARITH_RULE `(a <| SUC b) <=> (a <=| b)`];
+  IMATCH_MP_TAC  CARD_SUBSET;
+  ASM_REWRITE_TAC[];
+  (* Thu Aug  5 10:50:37 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let select_card_min = prove_by_refinement(
+  `!(X:(A->bool)->bool).  ~(X = EMPTY) ==>
+    (?z. (X z /\ (!x. (X x ==> (CARD z <= CARD x)))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  select_image_num_min;
+  ASM_REWRITE_TAC[];
+  (* Thu Aug  5 10:52:02 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+(* D embeddings of planar graphs *)
+
+let induced_top_interval = prove_by_refinement(
+  `!a b. induced_top (top_of_metric(UNIV,d_real))
+       {x | a <= x /\ x <= b } =
+     top_of_metric ({x | a <= x /\ x <= b}, d_real)
+      `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  top_of_metric_induced;
+  ASM_REWRITE_TAC[SUBSET_UNIV;metric_real];
+  ]);;
+  (* }}} *)
+
+let continuous_interval = prove_by_refinement(
+  `!f a b. (continuous f (top_of_metric(UNIV,d_real)) top2) ==>
+     (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real)) top2)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[GSYM induced_top_interval];
+  IMATCH_MP_TAC  continuous_induced_domain;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV ];
+  ]);;
+  (* }}} *)
+
+let inj_image_subset  = prove_by_refinement(
+  `!(f:A->B) X Y. (INJ f X Y ==> IMAGE f X SUBSET Y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ;IMAGE;SUBSET];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let subset_contain = prove_by_refinement(
+  `!a b c d. (c <= a) /\ (b <= d) ==>
+        {x | a <= x /\ x <= b} SUBSET {x | c <= x /\ x <= d}`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let curve_restriction = prove_by_refinement(
+  `!C K K' a b.
+       simple_arc top2 C /\
+       closed_ top2 K /\ closed_ top2 K' /\
+       (C INTER K INTER K' = EMPTY) /\
+       ~(C INTER K = EMPTY) /\
+       ~(C INTER K' = EMPTY) /\
+        (a <. b) ==>
+       (?C' f. (C' = IMAGE f {x | a <= x /\ x <= b}) /\ (C' SUBSET C) /\
+            continuous f (top_of_metric(UNIV,d_real)) top2 /\
+            INJ f {x | a <= x /\ x <= b} (euclid 2) /\
+            (C' INTER K = {(f a)}) /\
+            (C' INTER K' = {(f b)})
+       )
+       `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc];
+  REP_BASIC_TAC;
+  ASSUME_TAC top2_unions;
+  (* K parameter *)
+  TYPE_THEN `?t. (&0 <= t /\ t <= &1) /\ (K (f t)) /\ (!s. (&0 <=s /\ s < t) ==> ~(K (f s)))` SUBGOAL_TAC;
+  ASSUME_TAC preimage_first ;
+  TYPEL_THEN [`K`;`2`] (USE 10 o ISPECL);
+  FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
+  KILL 10;
+  ASM_REWRITE_TAC[GSYM top2;];
+  ASM_SIMP_TAC[continuous_interval];
+  UND 2;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  REWR 6;
+  IMATCH_MP_TAC  inj_image_subset;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* K' parameter *)
+  TYPE_THEN `?t. (&0 <= t /\ t <= &1) /\ (K' (f t)) /\ (!s. (&0 <=s /\ s < t) ==> ~(K' (f s)))` SUBGOAL_TAC;
+  ASSUME_TAC preimage_first ;
+  TYPEL_THEN [`K'`;`2`] (USE 14 o ISPECL);
+  FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
+  KILL 14;
+  ASM_REWRITE_TAC[GSYM top2;];
+  ASM_SIMP_TAC[continuous_interval];
+  UND 1;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  REWR 6;
+  IMATCH_MP_TAC  inj_image_subset;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `(t < t' \/ t' < t)` SUBGOAL_TAC;
+  REWRITE_TAC[(REAL_ARITH `(t < t' \/ t' < t) <=> ~( t = t')`)];
+  DISCH_ALL_TAC;
+  UND 3;
+  REWRITE_TAC[EMPTY_EXISTS;INTER;];
+  TYPE_THEN `(f t)` EXISTS_TAC;
+  REWR 11;
+  REWRITE_TAC[IMAGE;SUBSET];
+  CONJ_TAC;
+  TYPE_THEN `t'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  (* main cases split [main] *)
+  ASSUME_TAC (REAL_ARITH `&0 < &1`);
+  DISCH_THEN (DISJ_CASES_TAC);
+  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) (top2) /\  INJ f {x | t <= x /\ x <= t'} (euclid 2) /\ (&0 < &1) /\ (t < t')  ` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
+  REWR 6;
+  ASM_REWRITE_TAC[SUBSET ];
+   UND 19;
+  UND 16;
+  UND 13;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
+  REP_BASIC_TAC;
+  TYPE_THEN `Ca = IMAGE g {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
+  TYPE_THEN `Ca INTER K' = {(g (&0))}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[INTER;SUBSET;INR IN_SING;];
+  KILL 26;
+  EXPAND_TAC "Ca";
+  REWRITE_TAC[IMAGE;SUBSET];
+  REP_BASIC_TAC;
+  TYPE_THEN `x' < t' \/ (x' = t')` SUBGOAL_TAC;
+  UND 28;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 26;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 29;
+  UND 13;
+  REAL_ARITH_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET;INTER;INR IN_SING;];
+  KILL 26;
+  EXPAND_TAC "Ca";
+  REWRITE_TAC[IMAGE;SUBSET];
+  NAME_CONFLICT_TAC;
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  TYPE_THEN `t'` EXISTS_TAC;
+  ASM_MESON_TAC[REAL_ARITH `(t < t' ==> t<= t') /\ (t' <= t')`];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~(Ca INTER K = EMPTY)` SUBGOAL_TAC;
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  TYPE_THEN `f t` EXISTS_TAC;
+  KILL 26;
+  EXPAND_TAC "Ca";
+  REWRITE_TAC[IMAGE;SUBSET;];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `t` EXISTS_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `t <= t`];
+  ASM_SIMP_TAC[REAL_ARITH `(t < t') ==> (t <= t')`];
+  DISCH_TAC;
+  KILL 21;
+  (* ADD Ca SUBSET C *)
+  TYPE_THEN `Ca SUBSET C` SUBGOAL_TAC;
+  KILL 26;
+  EXPAND_TAC "Ca";
+  KILL 20;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE;SUBSET];
+  NAME_CONFLICT_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 21;
+  UND 26;
+  UND 13;
+  UND 19;
+  UND 16;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* t'' parameter for g and K *)
+  TYPE_THEN `?t''. (&0 <= t'' /\ t'' <= &1) /\ (K (g t'')) /\ (!s. (&0 <=s /\ s < t'') ==> ~(K (g s)))` SUBGOAL_TAC;
+  ASSUME_TAC preimage_first ;
+  TYPEL_THEN [`K`;`2`] (USE 29 o ISPECL);
+  FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
+  KILL 29;
+  ASM_REWRITE_TAC[GSYM top2;];
+  ASM_SIMP_TAC[continuous_interval];
+  EXPAND_TAC "Ca";
+  IMATCH_MP_TAC  inj_image_subset;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* set up for arc_reparameter_rev *)
+  TYPE_THEN `continuous g (top_of_metric (UNIV,d_real)) (top2) /\  INJ g {x | &0 <= x /\ x <= t''} (euclid 2) /\ (a < b) /\ (&0 < t'')  ` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `&0 < t'' \/ (t'' = &0)` SUBGOAL_TAC;
+  UND 32;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET ];
+  UND 31;
+  REAL_ARITH_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 3;
+  REWRITE_TAC[EMPTY_EXISTS;INTER;];
+  TYPE_THEN `g (&0)` EXISTS_TAC;
+  TYPE_THEN `Ca (g (&0))` SUBGOAL_TAC;
+  TYPE_THEN `{(g (&0))} SUBSET Ca` SUBGOAL_TAC;
+  ASM_MESON_TAC[INTER_SUBSET];
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  MESON_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  UND 3;
+  UND 21;
+  MESON_TAC[ISUBSET];
+  REWR 30;
+  ASM_REWRITE_TAC[];
+  UND 15;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
+  REP_BASIC_TAC;
+  TYPE_THEN `C' =IMAGE g' {x | a <= x /\ x <= b}` ABBREV_TAC ;
+  (* now finally go after the goal in the FIRST case *)
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `g'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* now finish off the three conditions *)
+  KILL 34;
+  TYPE_THEN `C' SUBSET Ca` SUBGOAL_TAC;
+  KILL 43;
+  EXPAND_TAC "C'";
+  EXPAND_TAC "Ca";
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  IMATCH_MP_TAC subset_contain;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  CONJ_TAC; (* 1*)
+  ASM_REWRITE_TAC[];
+  USE 8 GSYM;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Ca` EXISTS_TAC ;
+  ASM_MESON_TAC[];
+  CONJ_TAC; (* 2 *)
+  KILL 43;
+  EXPAND_TAC "C'";
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[INTER;IMAGE;SUBSET];
+  NAME_CONFLICT_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[INR IN_SING];
+  TYPE_THEN `(x' < t'') \/ (x' = t'')` SUBGOAL_TAC;
+  UND 45;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  TSPEC `x'` 14;
+  UND 43;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET;IMAGE;INTER;IN_SING];
+  NAME_CONFLICT_TAC;
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `t''` EXISTS_TAC;
+  ASM_MESON_TAC[REAL_ARITH `t'' <= t''`];
+  ASM_MESON_TAC[];
+  (* 3 *)
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Ca INTER K'` EXISTS_TAC;
+  CONJ_TAC;
+  UND 34;
+  REWRITE_TAC[SUBSET;INTER];
+  MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  REWRITE_TAC[SUBSET;INTER;INR IN_SING ];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  EXPAND_TAC "C'";
+  REWRITE_TAC[IMAGE;SUBSET];
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 40;
+  REAL_ARITH_TAC;
+  ASM_MESON_TAC[];
+  (* sh *)
+  (*  *******************  START THE SECOND HALF ************  *)
+
+  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) (top2) /\  INJ f {x | t' <= x /\ x <= t} (euclid 2) /\ (&0 < &1) /\ (t' < t)  ` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
+  REWR 6;
+  ASM_REWRITE_TAC[SUBSET ];
+   UND 19;
+  UND 12;
+  UND 17;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
+  REP_BASIC_TAC;
+  TYPE_THEN `Ca = IMAGE g {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
+  TYPE_THEN `Ca INTER K = {(g (&0))}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[INTER;SUBSET;INR IN_SING;];
+  KILL 26;
+  EXPAND_TAC "Ca";
+  REWRITE_TAC[IMAGE;SUBSET];
+  REP_BASIC_TAC;
+  TYPE_THEN `x' < t \/ (x' = t)` SUBGOAL_TAC;
+  UND 28;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 26;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 29;
+  UND 17;
+  REAL_ARITH_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET;INTER;INR IN_SING;];
+  KILL 26;
+  EXPAND_TAC "Ca";
+  REWRITE_TAC[IMAGE;SUBSET];
+  NAME_CONFLICT_TAC;
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  ASM_MESON_TAC[REAL_ARITH `(t' < t ==> t'<= t) /\ (t <= t)`];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~(Ca INTER K' = EMPTY)` SUBGOAL_TAC;
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  TYPE_THEN `f t'` EXISTS_TAC;
+  KILL 26;
+  EXPAND_TAC "Ca";
+  REWRITE_TAC[IMAGE;SUBSET;];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `t'` EXISTS_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `t' <= t'`];
+  ASM_SIMP_TAC[REAL_ARITH `(t' < t) ==> (t' <= t)`];
+  DISCH_TAC;
+  KILL 21;
+  (* ADD Ca SUBSET C *)
+  TYPE_THEN `Ca SUBSET C` SUBGOAL_TAC;
+  KILL 26;
+  EXPAND_TAC "Ca";
+  KILL 20;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE;SUBSET];
+  NAME_CONFLICT_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 21;
+  UND 26;
+  UND 17;
+  UND 19;
+  UND 12;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* gK *)
+  (* t'' parameter for g and K *)
+  TYPE_THEN `?t''. (&0 <= t'' /\ t'' <= &1) /\ (K' (g t'')) /\ (!s. (&0 <=s /\ s < t'') ==> ~(K' (g s)))` SUBGOAL_TAC;
+  ASSUME_TAC preimage_first ;
+  TYPEL_THEN [`K'`;`2`] (USE 29 o ISPECL);
+  FIRST_ASSUM (fun t -> IMATCH_MP_TAC  t);
+  KILL 29;
+  ASM_REWRITE_TAC[GSYM top2;];
+  ASM_SIMP_TAC[continuous_interval];
+  EXPAND_TAC "Ca";
+  IMATCH_MP_TAC  inj_image_subset;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* set up for arc_reparameter_gen *)
+  TYPE_THEN `continuous g (top_of_metric (UNIV,d_real)) (top2) /\  INJ g {x | &0 <= x /\ x <= t''} (euclid 2) /\ (a < b) /\ (&0 < t'')  ` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `&0 < t'' \/ (t'' = &0)` SUBGOAL_TAC;
+  UND 32;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET ];
+  UND 31;
+  REAL_ARITH_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 3;
+  REWRITE_TAC[EMPTY_EXISTS;INTER;];
+  TYPE_THEN `g (&0)` EXISTS_TAC;
+  TYPE_THEN `Ca (g (&0))` SUBGOAL_TAC;
+  TYPE_THEN `{(g (&0))} SUBSET Ca` SUBGOAL_TAC;
+  ASM_MESON_TAC[INTER_SUBSET];
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  MESON_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  UND 3;
+  UND 21;
+  MESON_TAC[ISUBSET];
+  REWR 30;
+  ASM_REWRITE_TAC[];
+  UND 11;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  FIRST_ASSUM (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
+  REP_BASIC_TAC;
+  TYPE_THEN `C' =IMAGE g' {x | a <= x /\ x <= b}` ABBREV_TAC ;
+  (* now finally go after the goal in the FIRST case *)
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `g'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* nfo *)
+  (* now finish off the three conditions *)
+  KILL 34;
+  TYPE_THEN `C' SUBSET Ca` SUBGOAL_TAC;
+  KILL 43;
+  EXPAND_TAC "C'";
+  EXPAND_TAC "Ca";
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  IMATCH_MP_TAC subset_contain;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  CONJ_TAC; (* 1*)
+  ASM_REWRITE_TAC[];
+  USE 8 GSYM;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Ca` EXISTS_TAC ;
+  ASM_MESON_TAC[];
+  (* s2 *)
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  CONJ_TAC ; (* 2 *)
+  KILL 43;
+  EXPAND_TAC "C'";
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[INTER;IMAGE;SUBSET];
+  NAME_CONFLICT_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[INR IN_SING];
+  TYPE_THEN `(x' < t'') \/ (x' = t'')` SUBGOAL_TAC;
+  UND 45;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  TSPEC `x'` 14;
+  UND 43;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET;IMAGE;INTER;IN_SING];
+  NAME_CONFLICT_TAC;
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `t''` EXISTS_TAC;
+  ASM_MESON_TAC[REAL_ARITH `t'' <= t''`];
+  ASM_MESON_TAC[];
+  (* s3 *)
+  (* 3 *)
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Ca INTER K` EXISTS_TAC;
+  CONJ_TAC;
+  UND 34;
+  REWRITE_TAC[SUBSET;INTER];
+  MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  REWRITE_TAC[SUBSET;INTER;INR IN_SING ];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  EXPAND_TAC "C'";
+  REWRITE_TAC[IMAGE;SUBSET];
+  TYPE_THEN `a` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 40;
+  REAL_ARITH_TAC;
+  ASM_MESON_TAC[];
+  (* Thu Aug  5 08:09:38 EDT 2004  *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_end = jordan_def
+  `simple_arc_end C v v' <=>
+    (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1 }) /\
+       continuous f (top_of_metric(UNIV,d_real)) top2 /\
+       INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
+       (f (&0) = v) /\ (f(&1) = v'))`;;
+
+let good_plane_graph = jordan_def
+   `good_plane_graph G <=> plane_graph G /\
+      (!e v v'. (graph_edge G e /\ ~(v = v') /\
+           (graph_inc G e v) /\ (graph_inc G e v') ==>
+           (simple_arc_end e v v')))`;;
+
+let graph_edge_mod  = jordan_def
+  `graph_edge_mod (G:(A,B)graph_t) (f:B->B') =
+     mk_graph_t (graph_vertex G,IMAGE f (graph_edge G),
+       (\ e' v. (?e. graph_edge G e /\ graph_inc G e v /\ (f e = e'))))`;;
+
+let graph_edge_mod_v = prove_by_refinement(
+  `!(G:(A,B)graph_t) (f:B->B').
+     graph_vertex (graph_edge_mod G f) = graph_vertex G `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_edge_mod;graph_vertex;dest_graph_t;];
+  ]);;
+  (* }}} *)
+
+let graph_edge_mod_e = prove_by_refinement(
+  `!(G:(A,B)graph_t) (f:B->B').
+     graph_edge (graph_edge_mod G f) = IMAGE f (graph_edge G )`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_edge_mod;graph_edge;dest_graph_t;part1;drop0];
+  ]);;
+  (* }}} *)
+
+let graph_edge_mod_i = prove_by_refinement(
+  `!(G:(A,B)graph_t) (f:B->B') e v.
+     graph_inc (graph_edge_mod G f) e v <=>
+         (?e'. (graph_edge G e' /\ graph_inc G e' v /\ (f e' = e)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_edge_mod;graph_inc;dest_graph_t;part1;drop1];
+  ]);;
+  (* }}} *)
+
+let inj_bij = prove_by_refinement(
+  `!(f:A->B) X. (INJ f X UNIV) ==> (BIJ f X (IMAGE f X))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[BIJ];
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE_SURJ];
+  UND 0;
+  REWRITE_TAC[INJ;IMAGE;SUBSET];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let graph_edge_iso = prove_by_refinement(
+  `! f (G:(A,B)graph_t). (INJ (f:B->B') (graph_edge G) (UNIV)) ==>
+    (graph_isomorphic G (graph_edge_mod G f))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[graph_isomorphic;graph_iso];
+  REP_BASIC_TAC;
+  RIGHT_TAC "f";
+  RIGHT_TAC "f";
+  TYPE_THEN `I:A->A` EXISTS_TAC ;
+  TYPE_THEN `f` EXISTS_TAC;
+  NAME_CONFLICT_TAC;
+  EXISTS_TAC `(I:A->A,f:B->B')` ;
+  REWRITE_TAC[graph_edge_mod_v;graph_edge_mod_e];
+  CONJ_TAC;
+  REWRITE_TAC[I_DEF;BIJ;INJ;SURJ;];
+  MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_bij;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[graph_edge_mod_i;IMAGE_I;];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `e'' = e'` SUBGOAL_TAC;
+  RULE_ASSUM_TAC(REWRITE_RULE  [INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let graph_edge_graph = prove_by_refinement(
+  `!f (G:(A,B)graph_t). (graph G) /\
+      (INJ (f:B->B') (graph_edge G) (UNIV)) ==>
+    (graph (graph_edge_mod G f)) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC    graph_isomorphic_graph;
+  TYPE_THEN `G` EXISTS_TAC;
+  ASM_MESON_TAC[graph_edge_iso];
+  ]);;
+  (* }}} *)
+
+let plane_graph_mod = prove_by_refinement(
+  `!G f. (plane_graph G) /\ (INJ f (graph_edge G) UNIV) /\
+      (!e e'. (graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
+        (f e INTER f e' SUBSET e INTER e') )) /\
+      (!e. (graph_edge G e ==> (simple_arc top2 (f e)))) /\
+      (!e. (graph_edge G e) ==>
+         (e INTER graph_vertex G = (f e) INTER graph_vertex G)) ==>
+      (plane_graph (graph_edge_mod G f))
+  `,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[plane_graph];
+  REP_BASIC_TAC;
+  REWRITE_TAC[graph_edge_mod_v;graph_edge_mod_e;];
+  CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  ASM_MESON_TAC[graph_edge_graph];
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;SUBSET];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER];
+  REP_BASIC_TAC;
+  REWRITE_TAC[graph_edge_mod_i];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `e' = x` SUBGOAL_TAC;
+   RULE_ASSUM_TAC  (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TSPEC `e'` 5;
+  TSPEC `e'` 0;
+  UND 0;
+  UND 5;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  TYPE_THEN `(f x INTER graph_vertex G) x'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[INTER;SUBSET];
+  REP_BASIC_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TSPEC `x` 5;
+  TSPEC `x` 0;
+  UND 0;
+  REWR 5;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  ASM_SIMP_TAC[];
+  REWRITE_TAC[INTER;SUBSET];
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  UND 10;
+  REWRITE_TAC[IMAGE];
+  REP_BASIC_TAC;
+  UND 11;
+  REWRITE_TAC[IMAGE];
+  REP_BASIC_TAC;
+  TYPE_THEN `~(x = x')` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `x' INTER x` EXISTS_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* Thu Aug  5 10:17:38 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let compact_point = prove_by_refinement(
+  `!U (x:A). (UNIONS U x) ==> (compact U {x})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[compact];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC [single_subset];
+  REP_BASIC_TAC;
+  TYPE_THEN `?u. V u /\ u x` SUBGOAL_TAC;
+  UND 2;
+  REWRITE_TAC[SUBSET;UNIONS;INR IN_SING];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `{u}` EXISTS_TAC;
+  ASM_REWRITE_TAC [single_subset;FINITE_SING];
+  (* Thu Aug  5 12:02:40 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_select = prove_by_refinement(
+  `!C v v'. (simple_arc top2 C) /\ (C v) /\ (C v') /\ ~(v = v') ==>
+    (?C'. (C' SUBSET C) /\ (simple_arc_end C' v v'))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc_end];
+  REP_BASIC_TAC;
+  (* A *)
+  TYPE_THEN `!v. (C v) ==> (closed_ top2 {v})` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  compact_closed;
+  ASM_SIMP_TAC[top2_top;metric_hausdorff;top2;metric_euclid;compact_point];
+  IMATCH_MP_TAC  compact_point;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
+  UND 3;
+  REWRITE_TAC[simple_arc];
+  REP_BASIC_TAC;
+  TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  inj_image_subset;
+  RULE_ASSUM_TAC (REWRITE_RULE [top2_unions]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  (* B hypotheses of curve_restriction *)
+  TYPE_THEN `simple_arc top2 C /\ closed_ top2 {v} /\ closed_ top2 {v'} /\      (C INTER {v} INTER { v' } = EMPTY) /\ ~(C INTER {v} = EMPTY) /\       ~(C INTER {v'} = EMPTY) /\        (&0 < &1)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_ARITH `&0 < &1`];
+  REWRITE_TAC[INTER;INR IN_SING;EMPTY_EXISTS ];
+  REWRITE_TAC[EQ_EMPTY];
+  ASM_MESON_TAC[];
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP curve_restriction t));
+  REP_BASIC_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `!A u v. (A INTER {u} = {v}) ==> ( (v:num->real)=u)` SUBGOAL_TAC;
+  REWRITE_TAC[eq_sing;INTER;INR IN_SING;];
+  MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let graph_edge2 = prove_by_refinement(
+  `!(G:(A,B)graph_t) e.
+      (graph G /\ graph_edge G e) ==> (graph_inc G e HAS_SIZE 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph];
+  REWRITE_TAC[IMAGE;SUBSET];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_symm = prove_by_refinement(
+  `!C' v v'. (simple_arc_end C' v v' ==> simple_arc_end C' v' v)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc_end];
+  REP_BASIC_TAC;
+  TYPE_THEN `( continuous f (top_of_metric (UNIV,d_real)) (top2) /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\ (&0 < &1) /\ (&0 < &1))` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `&0 < &1`];
+  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_rev t));
+  REP_BASIC_TAC;
+  TYPE_THEN `g` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_plane_select = prove_by_refinement(
+  `!G e. (plane_graph G /\ graph_edge G e) ==> (?e'.
+     (e' SUBSET e /\
+     (!v v'. graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') ==>
+        simple_arc_end e' v v')))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE [plane_graph]);
+  IMATCH_MP_TAC graph_edge2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[has_size2];
+  REP_BASIC_TAC;
+  TYPE_THEN `(?e'. (e' SUBSET e) /\ (simple_arc_end e' a b))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_select;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC  (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  UND 5;
+  ASM_MESON_TAC [ISUBSET];
+  TYPE_THEN `graph_inc G e a /\ graph_inc G e b` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[in_pair];
+  KILL 3;
+  ASM_SIMP_TAC[];
+  REWRITE_TAC[INTER;SUBSET];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `e'` EXISTS_TAC;
+  ASM_REWRITE_TAC[in_pair];
+  REP_BASIC_TAC;
+  TYPE_THEN `((v = a) /\ (v' = b)) \/ ((v = b) /\ (v' =a ))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  (* Thu Aug  5 14:10:17 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let plane_graph_contain = prove_by_refinement(
+  `!G e e'. (plane_graph G /\ graph_edge G e /\ graph_edge G e' /\
+      (e SUBSET e') ==> (e = e'))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `e INTER e' SUBSET graph_vertex G` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `e INTER e' SUBSET e' INTER graph_vertex G` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET_INTER];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INTER;SUBSET];
+  MESON_TAC[];
+  TYPE_THEN `e' INTER graph_vertex G = graph_inc G e'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `graph_inc G e' HAS_SIZE 2` SUBGOAL_TAC;
+  ASM_MESON_TAC[graph_edge2];
+  TYPE_THEN `e INTER e' = e` SUBGOAL_TAC;
+  UND 0;
+  REWRITE_TAC[SUBSET_INTER_ABSORPTION];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[has_size2];
+  REP_BASIC_TAC;
+  REWR 10;
+  TYPE_THEN `simple_arc top2 e` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  REWRITE_TAC[simple_arc];
+  REP_BASIC_TAC;
+  TYPE_THEN `!x. (&0 <= x /\ x <= &1) ==> {a,b} (f x)` SUBGOAL_TAC;
+  REWR 10;
+  UND 10;
+  REWRITE_TAC[IMAGE;SUBSET];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  TYPE_THEN `(f (&0) = f(&1))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  two_exclusion;
+  TYPE_THEN `{a,b}` EXISTS_TAC;
+  TYPE_THEN `?t. (&0 < t /\ t < &1)` SUBGOAL_TAC;
+  TYPE_THEN `&1/ (&2)` EXISTS_TAC;
+  IMATCH_MP_TAC  half_pos;
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `f t` EXISTS_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[pair_size_2];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM  IMATCH_MP_TAC ;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM  IMATCH_MP_TAC ;
+  UND 18;
+  UND 19;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `~(&0 = t)` SUBGOAL_TAC;
+  UND 19;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWR 20;
+  ASM_REWRITE_TAC[];
+  UND 18;
+  UND 19;
+  REAL_ARITH_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `~(&1 = t)` SUBGOAL_TAC;
+  UND 18;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWR 20;
+  ASM_REWRITE_TAC[];
+  UND 18;
+  UND 19;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `~(&0 = &1)` SUBGOAL_TAC;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  (* Thu Aug  5 15:11:20 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let graph_edge_end_select = prove_by_refinement(
+  `!(G:(A,B)graph_t) e. (graph G /\ graph_edge G e ==>
+     (?v v'. graph_inc G e v /\ graph_inc G e v' /\ ~(v = v')))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
+  IMATCH_MP_TAC  graph_edge2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[has_size2];
+  REP_BASIC_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_REWRITE_TAC[in_pair];
+  (* Thu Aug  5 19:26:02 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* SECTION K *)
+(* ------------------------------------------------------------------ *)
+
+(* Thu Aug  5 21:17:36 EDT 2004 *)
+
+(* Tweaked slightly now that there is an "inf" constant. JRH, 4 Dec 2011 *)
+
+let inf =
+  let inf_def =
+    `inf (X:real->bool) =
+      @s. ((!x. X x ==> s <= x) /\ (!y. (!x. X x ==> y <= x) ==> (y <= s)))` in
+  let def =
+    subst [mk_var("inf",`:(real->bool)->real`),mk_const("inf",[])] inf_def in
+  jordan_def def;;
+
+let interval_closed = prove_by_refinement(
+  `!a b. closed_ (top_of_metric(UNIV,d_real)) {x | a <= x /\ x <= b}`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  compact_closed;
+  ASM_SIMP_TAC[interval_compact;top_of_metric_top;metric_real];
+  ASM_SIMP_TAC[metric_hausdorff;metric_real;];
+  ]);;
+  (* }}} *)
+
+let half_closed = prove_by_refinement(
+  `!a. closed_ (top_of_metric(UNIV,d_real)) {x | x <= a}`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closed];
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
+  TYPE_THEN `UNIV DIFF {x | x <= a } = {x | a < x}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[DIFF;UNIV];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC [open_DEF;half_open_above];
+  ]);;
+  (* }}} *)
+
+let half_closed_above = prove_by_refinement(
+  `!a. closed_ (top_of_metric(UNIV,d_real)) {x | a <= x}`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closed];
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
+  TYPE_THEN `UNIV DIFF {x | a <= x } = {x | x < a}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[DIFF;UNIV];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC [open_DEF;half_open];
+  ]);;
+  (* }}} *)
+
+let inf_LB = prove_by_refinement(
+  `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> t <= x))) ==>
+     (!x. X x ==> inf X <= x) /\
+          (!y. (!x. X x ==> y <= x) ==> (y <= inf X))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  TYPE_THEN `topology_ (top_of_metric(UNIV,d_real))` SUBGOAL_TAC;
+  ASM_SIMP_TAC[top_of_metric_top;metric_real];
+  DISCH_TAC;
+  (*  *)
+  TYPE_THEN `X SUBSET closure (top_of_metric(UNIV,d_real)) X` SUBGOAL_TAC;
+  ASM_SIMP_TAC[subset_closure];
+  DISCH_TAC;
+  (*  *)
+  REWRITE_TAC[EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  REWRITE_TAC[inf];
+  SELECT_TAC;
+  ASM_MESON_TAC[];
+  PROOF_BY_CONTR_TAC;
+  UND 4;
+  KILL 5;
+  REWRITE_TAC[];
+  TYPE_THEN `XC = closure (top_of_metric(UNIV,d_real)) X INTER {x | t <= x /\ x <= u}` ABBREV_TAC ;
+  TYPE_THEN `compact (top_of_metric(UNIV,d_real)) XC` SUBGOAL_TAC;
+  IMATCH_MP_TAC  closed_compact;
+  TYPE_THEN `{x | t <= x /\ x <= u}` EXISTS_TAC;
+  ASM_SIMP_TAC[interval_compact;top_of_metric_top;metric_real];
+  EXPAND_TAC "XC";
+  CONJ_TAC;
+  IMATCH_MP_TAC  closed_inter2;
+  ASM_SIMP_TAC[interval_closed;top_of_metric_top;metric_real];
+  IMATCH_MP_TAC  closure_closed;
+  ASM_SIMP_TAC[top_of_metric_top;metric_real;GSYM top_of_metric_unions;];
+  ASM_REWRITE_TAC[INTER_SUBSET];
+  DISCH_TAC;
+  (*   *)
+  TYPE_THEN `(?z. (XC z /\ (!y. XC y ==> z <= y)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  compact_inf;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `u` EXISTS_TAC;
+  EXPAND_TAC "XC";
+  REWRITE_TAC[INTER;SUBSET];
+  CONJ_TAC;
+  UND 1;
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[REAL_ARITH `u <= u`];
+  REP_BASIC_TAC;
+  TYPE_THEN `z` EXISTS_TAC;
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `(x <= u) \/ (u < x)` SUBGOAL_TAC;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `XC x` SUBGOAL_TAC;
+  EXPAND_TAC "XC";
+  REWRITE_TAC[INTER;SUBSET];
+  CONJ_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  UND 7;
+  EXPAND_TAC "XC";
+  REWRITE_TAC[INTER;SUBSET];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[REAL_ARITH `z <= u /\ u < x ==> z <= x`];
+  REP_BASIC_TAC;
+  TYPE_THEN `closed_ (top_of_metric (UNIV,d_real)) {x | y' <= x }` SUBGOAL_TAC;
+  REWRITE_TAC[half_closed_above];
+  DISCH_TAC;
+  TYPE_THEN `closure (top_of_metric (UNIV,d_real)) X SUBSET {x | y' <= x }` SUBGOAL_TAC;
+  IMATCH_MP_TAC  closure_subset;
+  ASM_REWRITE_TAC[SUBSET ];
+  DISCH_TAC;
+  TYPE_THEN `XC SUBSET {x | y' <= x}` SUBGOAL_TAC;
+  EXPAND_TAC "XC";
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `closure (top_of_metric (UNIV,d_real)) X ` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "XC";
+  REWRITE_TAC[INTER_SUBSET];
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  (* Fri Aug  6 05:51:24 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let inf_eps = prove_by_refinement(
+  `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> t <= x))) ==>
+       (!epsilon. (&0 < epsilon) ==> (?x. X x /\ (x < inf X + epsilon)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(!y. (!x. X x ==> y <= x) ==> (y <= inf X))` SUBGOAL_TAC;
+  ASM_MESON_TAC[inf_LB];
+  DISCH_TAC;
+  TSPEC `inf X + epsilon` 3;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `(!x. X x ==> inf X + epsilon <= x)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `~(v < u)  ==> u <= v`);
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[REAL_ARITH `(x + y <= x ==> ~(&0 < y))`];
+  ]);;
+  (* }}} *)
+
+let supm = jordan_def `supm (X:real->bool) =
+   --. (inf ({x | ?z. X z /\ (x = --. z)}))`;;
+
+let supm_UB = prove_by_refinement(
+  `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> x <= t))) ==>
+     (!x. X x ==> x <= supm X ) /\
+          (!y. (!x. X x ==> x <= y) ==> (supm X <= y))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[supm];
+  TYPE_THEN `Y = {x | ?z. X z /\ (x = --z)}` ABBREV_TAC ;
+  TYPE_THEN `!u. (Y u = X (-- u)) /\ (Y (--u ) = X u)` SUBGOAL_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  MESON_TAC[REAL_ARITH `(-- (-- u) = u)`];
+  DISCH_TAC;
+  TYPE_THEN `(~(Y = EMPTY) /\ (?t. !x. (Y x ==> t <= x)))` SUBGOAL_TAC;
+  UND 1;
+  REWRITE_TAC[EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  TYPE_THEN `-- u` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `-- t` EXISTS_TAC;
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[REAL_ARITH `--t <= x <=> (-- x <= t)`];
+  DISCH_THEN ( ASSUME_TAC o (MATCH_MP inf_LB));
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[REAL_ARITH `y <= --x <=> x <= --y`];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `--y <= inf Y ==> -- inf Y <= y`);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[ REAL_ARITH `--x <= y <=> --y <= x`];
+  (* Fri Aug  6 06:42:14 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let supm_eps = prove_by_refinement(
+  `!X. (~(X = EMPTY) /\ (?t. !x. (X x ==> x <= t))) ==>
+       (!epsilon.(&0 < epsilon) ==> (?x. X x /\ (supm X - epsilon < x)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(!y. (!x. X x ==> x <= y) ==> (supm X <= y))` SUBGOAL_TAC;
+  ASM_MESON_TAC[supm_UB];
+  DISCH_TAC;
+  TSPEC `supm X - epsilon` 3;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `(!x. X x ==> x <= supm X - epsilon)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `~(v < u)  ==> u <= v`);
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[REAL_ARITH `(x <= x - y  ==> ~(&0 < y))`];
+  (* Fri Aug  6 06:47:22 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let compact_subset = prove_by_refinement(
+  `!(X:A->bool) K d. (K SUBSET X /\ metric_space(X,d)) ==>
+        (compact(top_of_metric(X,d)) K = compact(top_of_metric(K,d))K) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[GSYM top_of_metric_induced];
+  ASM_MESON_TAC[induced_compact;top_of_metric_unions];
+  ]);;
+  (* }}} *)
+
+let exp_gt1 = prove_by_refinement(
+  `!n. (0 < n) ==> (1 < 2 **| n)`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `1 = 2 **| 0` SUBGOAL_TAC;
+  REWRITE_TAC[EXP];
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  REP_BASIC_TAC;
+  REWRITE_TAC[LT_EXP];
+  UND 0;
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let twopow_lt = prove_by_refinement(
+  `!a b. (a < b) ==> (twopow a < twopow b)`,
+  (* {{{ proof *)
+  [
+  ONCE_REWRITE_TAC [INT_ARITH `(a <: b) <=> (&:0 <: b -: a)`];
+  ASSUME_TAC twopow_pos;
+  ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> &1*x < y`];
+  ASM_SIMP_TAC[GSYM REAL_LT_RDIV_EQ];
+  REWRITE_TAC[real_div];
+  REWRITE_TAC[GSYM TWOPOW_INV;GSYM TWOPOW_ADD_INT;GSYM INT_SUB];
+  REP_GEN_TAC;
+  TYPE_THEN `C = b -: a` ABBREV_TAC ;
+  ASSUME_TAC INT_REP2 ;
+  TSPEC `C` 2;
+  REP_BASIC_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  UND 2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[TWOPOW_POS];
+  REDUCE_TAC;
+  REWRITE_TAC[INT_OF_NUM_LT;exp_gt1];
+  PROOF_BY_CONTR_TAC;
+  UND 2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INT_ARITH `(~(&:0 <: --: y) <=> (&:0 <=: y))`];
+  REWRITE_TAC[INT_OF_NUM_LE];
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let compact_distance = prove_by_refinement(
+  `!(X:A->bool) d K K'. (metric_space(X,d) /\
+   ~(K=EMPTY) /\ ~(K' = EMPTY) /\
+   (compact (top_of_metric(X,d)) K) /\ (compact(top_of_metric(X,d))K'))
+   ==> (?p p'. (K p /\ K' p' /\ (!q q'. (K q /\ K' q') ==>
+              (d p p' <= d q q'))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `UNIONS (top_of_metric(X,d)) = X` SUBGOAL_TAC;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  DISCH_TAC;
+  TYPE_THEN `K SUBSET X /\ K' SUBSET X` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[compact]);
+  REWR 0;
+  REWR 1;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `Y = { z | ?q q'. (K q /\ K' q' /\ (z = d q q'))}` ABBREV_TAC ;
+  TYPE_THEN `!y. (Y y) ==> (&0 <= y)` SUBGOAL_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
+  TYPEL_THEN [`q`;`q'`;`q'`] (USE 4 o ISPECL);
+  ASM_MESON_TAC[metric_space;ISUBSET];
+  REP_BASIC_TAC;
+  (*  *)
+  TYPE_THEN `~(Y= EMPTY)` SUBGOAL_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  UND 2;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `d u' u` EXISTS_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* inf Y *)
+  TYPE_THEN `(!epsilon. (&0 < epsilon) ==> (?x. Y x /\ (x < inf Y + epsilon)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  inf_eps;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  ASSUME_TAC twopow_pos;
+  TYPE_THEN `(!n. ?p. ?p'. K p /\ K' p' /\ (d p p' < inf Y + twopow( -- (&:n))))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `(?x. Y x /\ x < inf Y + twopow (--: (&:n)))` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  UND 14;
+  EXPAND_TAC "Y";
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  RIGHT 13 "n";
+  REP_BASIC_TAC;
+  (* compact,complete,totally bounded *)
+  TYPE_THEN `metric_space (K,d) /\ metric_space(K',d)` SUBGOAL_TAC;
+  ASM_MESON_TAC[metric_subspace];
+  REP_BASIC_TAC;
+  TYPE_THEN `compact (top_of_metric(K,d)) K /\ compact (top_of_metric(K',d)) K'` SUBGOAL_TAC;
+  ASM_MESON_TAC[compact_subset];
+  REP_BASIC_TAC;
+  TYPE_THEN `complete (K,d)  /\ complete (K',d) ` SUBGOAL_TAC;
+  ASM_MESON_TAC[compact_complete];
+  REP_BASIC_TAC;
+  TYPE_THEN `totally_bounded(K,d) /\ totally_bounded(K',d)` SUBGOAL_TAC;
+  ASM_MESON_TAC[compact_totally_bounded;];
+  REP_BASIC_TAC;
+  (* construct subseq of p *)
+  TYPE_THEN `(?ss. subseq ss /\ converge (K,d) (p o ss))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  convergent_subseq;
+  ASM_REWRITE_TAC[sequence;SUBSET;UNIV;IMAGE];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x''");
+  RIGHT 13 "p'";
+  ASM_MESON_TAC[];
+  REWRITE_TAC[converge];
+  REP_BASIC_TAC;
+  (* construct q *)
+  TYPE_THEN `!n. ?p'. K' p' /\ d x p' < inf Y + twopow(--: (&:n))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TSPEC `twopow (--: (&:(SUC(n))))` 22;
+  REP_BASIC_TAC;
+  REWR 22;
+  TSPEC  `SUC(n') + SUC (n)` 22;
+  RULE_ASSUM_TAC (REWRITE_RULE[ARITH_RULE `x <=| SUC x +| y`]);
+  TSPEC `ss (SUC n' +| SUC n)` 13;
+  REP_BASIC_TAC;
+  TYPE_THEN `twopow (--: (&:(ss(SUC n'+SUC n)))) < twopow(--: (&:(SUC n)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  twopow_lt;
+  REWRITE_TAC[INT_LT_NEG;INT_OF_NUM_LT;];
+  IMATCH_MP_TAC (ARITH_RULE `(?t. (a <= t /\ t <| b)) ==> (a <| b)`);
+  TYPE_THEN `ss (SUC n)` EXISTS_TAC;
+  ASM_SIMP_TAC[SEQ_SUBLE;subseq];
+  RULE_ASSUM_TAC (REWRITE_RULE[subseq]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `p'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC  (REWRITE_RULE[metric_space]);
+  REP_BASIC_TAC;
+  TYPEL_THEN [`x`;`p (ss (SUC n' +| SUC n))`;`p'`] (USE 4 o ISPECL);
+  REP_BASIC_TAC;
+  TYPE_THEN `X x /\ X (p (ss (SUC n' +| SUC n))) /\ X p'` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  REWR 4;
+  REP_BASIC_TAC;
+  TYPE_THEN `twopow( --: (&:(SUC n))) + twopow (--: (&:(SUC n))) = twopow (--: (&:n))` SUBGOAL_TAC;
+  REWRITE_TAC[GSYM REAL_MUL_2;ADD1;twopow_double];
+  UND 4;
+  UND 13;
+  UND 27;
+  UND 22;
+  REWRITE_TAC[o_DEF];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  RIGHT 25 "n" ;
+  REP_BASIC_TAC;
+  (* take subseq of p' *)
+  TYPE_THEN `(?ss'. subseq ss' /\ converge (K',d) (p' o ss'))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  convergent_subseq;
+  ASM_REWRITE_TAC[sequence;SUBSET;UNIV;IMAGE];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x''");
+  ASM_MESON_TAC[];
+  REWRITE_TAC[converge];
+  REP_BASIC_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* now go in for the KILL.  *)
+  (*   Show d x x' <= inf Y because d x x' < inf Y + eps *)
+  (* [K] *)
+  IMATCH_MP_TAC  (REAL_ARITH `(?t. (t <= y) /\ (x <= t)) ==> (x <= y)`);
+  TYPE_THEN `inf Y` EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `(!y. Y y ==> inf Y <= y)` SUBGOAL_TAC;
+  ASM_MESON_TAC[inf_LB];
+  DISCH_THEN IMATCH_MP_TAC ;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  TYPE_THEN `q` EXISTS_TAC;
+  TYPE_THEN `q'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SUBGOAL_TAC  `!x y. (!e. (&0 <e) ==> (x < y + e)) ==> (x <= y)`;
+  REP_GEN_TAC;
+  DISCH_THEN (fun t -> MP_TAC (SPEC `x'' - y` t));
+  REAL_ARITH_TAC;
+  DISCH_THEN IMATCH_MP_TAC ;
+  REP_BASIC_TAC;
+  KILL 15;
+  KILL 14;
+  KILL 17;
+  KILL 16;
+  KILL 18;
+  KILL 19;
+  KILL 20;
+  KILL 21;
+  KILL 2;
+  KILL 3;
+  KILL 0;
+  KILL 1;
+  KILL 8;
+  KILL 29;
+  KILL 30;
+  (* GEN needed inequalities *)
+  (* [L] *)
+  TYPE_THEN `?n. (&1)* twopow(--: (&:n)) < e` SUBGOAL_TAC;
+  ASM_MESON_TAC[twopow_eps;REAL_ARITH `&0 < &1`];
+  REDUCE_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `twopow( --: (&:(SUC n))) + twopow (--: (&:(SUC n))) = twopow (--: (&:n))` SUBGOAL_TAC;
+  REWRITE_TAC[GSYM REAL_MUL_2;ADD1;twopow_double];
+  REP_BASIC_TAC;
+  TSPEC `twopow(--: (&:(SUC n)))` 26;
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[twopow_pos]);
+
+  TSPEC `SUC (n) + SUC n'` 2;
+  USE 2(REWRITE_RULE[ARITH_RULE `a <=| b + SUC a`]);
+  TSPEC `ss' (SUC n + SUC n')` 25;
+  TYPE_THEN `twopow (--: (&:(ss' (SUC  n +| SUC n')))) < twopow (--: (&:(SUC n)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  twopow_lt;
+  REWRITE_TAC[INT_LT_NEG;INT_OF_NUM_LT ];
+  IMATCH_MP_TAC  (ARITH_RULE  `(?t. (a <=| t /\ (t <| b)))    ==> (a <| b)`);
+  TYPE_THEN `(ss' (SUC n) )` EXISTS_TAC;
+  ASM_SIMP_TAC[SEQ_SUBLE];
+  RULE_ASSUM_TAC (REWRITE_RULE[subseq]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ARITH_TAC;
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  (* metric space ineq *)
+  TYPE_THEN `X x /\ X x' /\ X (p' (ss' (SUC n +| SUC n')))` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[o_DEF]);
+  TYPE_THEN `r = p' (ss' (SUC n +| SUC n'))` ABBREV_TAC ;
+  TYPE_THEN `d x' r = d r x'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_symm;
+  ASM_MESON_TAC[];
+  TYPE_THEN `d x x' <= d x r + d r x'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_triangle;
+  ASM_MESON_TAC[];
+  UND 0;
+  UND 1;
+  UND 2;
+  UND 3;
+  UND 8;
+  REAL_ARITH_TAC;
+  (* Fri Aug  6 11:54:33 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let max_real_le = prove_by_refinement(
+  `!x y. x <= max_real x y  /\ y <= max_real x y `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[max_real];
+  REP_GEN_TAC;
+  COND_CASES_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let min_real_le = prove_by_refinement(
+  `!x y.  min_real x y <= x /\ min_real x y <= y`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[min_real];
+  REP_GEN_TAC;
+  COND_CASES_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let finite_UB = prove_by_refinement(
+  `!X. (FINITE X) ==> (?t. (!x. X x ==> x <=. t))`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `!n X. (X HAS_SIZE n) ==> (?t. (!x. X x ==> x <= t))` SUBGOAL_TAC;
+  INDUCT_TAC ;
+  REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY;];
+  MESON_TAC[];
+  REWRITE_TAC[HAS_SIZE_SUC];
+  REWRITE_TAC[EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  TSPEC `X DELETE u` 0;
+  TYPE_THEN `(?t. !x. (X DELETE u) x ==> x <= t)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `max_real t u` EXISTS_TAC;
+  GEN_TAC;
+  DISCH_TAC;
+  TYPE_THEN `x = u` ASM_CASES_TAC;
+  ASM_MESON_TAC[max_real_le];
+  TSPEC `x` 3;
+  RULE_ASSUM_TAC (REWRITE_RULE[DELETE]);
+  ASM_MESON_TAC[max_real_le;REAL_LE_TRANS];
+  REWRITE_TAC[HAS_SIZE];
+  ASM_MESON_TAC[];
+  (* Fri Aug  6 12:50:04 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let finite_LB = prove_by_refinement(
+  `!X. (FINITE X) ==> (?t. (!x. X x ==> t <=. x))`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `!n X. (X HAS_SIZE n) ==> (?t. (!x. X x ==> t <= x))` SUBGOAL_TAC;
+  INDUCT_TAC ;
+  REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY;];
+  MESON_TAC[];
+  REWRITE_TAC[HAS_SIZE_SUC];
+  REWRITE_TAC[EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  TSPEC `X DELETE u` 0;
+  TYPE_THEN `(?t. !x. (X DELETE u) x ==> t <= x)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `min_real t u` EXISTS_TAC;
+  GEN_TAC;
+  DISCH_TAC;
+  TYPE_THEN `x = u` ASM_CASES_TAC;
+  ASM_MESON_TAC[min_real_le];
+  TSPEC `x` 3;
+  RULE_ASSUM_TAC (REWRITE_RULE[DELETE]);
+  ASM_MESON_TAC[min_real_le;REAL_LE_TRANS];
+  REWRITE_TAC[HAS_SIZE];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let finite_compact = prove_by_refinement(
+  `!(X:A->bool) U. (FINITE X) /\ (X SUBSET UNIONS U) ==> (compact U X)`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `!n (X:A->bool) U. (X HAS_SIZE n) /\ (X SUBSET UNIONS U) ==> (compact U X)` SUBGOAL_TAC;
+  INDUCT_TAC;
+  REWRITE_TAC[HAS_SIZE_0];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[compact];
+  REP_BASIC_TAC;
+  TYPE_THEN `EMPTY:(A->bool)->bool` EXISTS_TAC;
+  REWRITE_TAC[FINITE_RULES];
+  REWRITE_TAC[HAS_SIZE_SUC;EMPTY_EXISTS;compact ;];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `X DELETE u HAS_SIZE n` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPEL_THEN [`X DELETE u`;`U`] (USE 0 o ISPECL);
+  REP_BASIC_TAC;
+  REWR 0;
+  TYPE_THEN `X DELETE u SUBSET UNIONS U` SUBGOAL_TAC;
+  UND 1;
+  REWRITE_TAC[SUBSET;DELETE];
+  MESON_TAC[];
+  DISCH_TAC;
+  REWR 0;
+  RULE_ASSUM_TAC (REWRITE_RULE[compact]);
+  REP_BASIC_TAC;
+  TSPEC `V` 0;
+  REWR 0;
+  TYPE_THEN `X DELETE u SUBSET UNIONS V` SUBGOAL_TAC;
+  UND 6;
+  REWRITE_TAC[SUBSET;DELETE];
+  MESON_TAC[];
+  DISCH_TAC;
+  REWR 0;
+  REP_BASIC_TAC;
+  USE 6 (REWRITE_RULE[SUBSET;UNIONS]);
+  TSPEC `u` 6;
+  REWR 6;
+  REP_BASIC_TAC;
+  TYPE_THEN `u' INSERT W` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[INSERT_SUBSET];
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[FINITE_INSERT];
+  REWRITE_TAC[UNIONS_INSERT];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `u' UNION (X DELETE u)` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;DELETE;UNION];
+  ASM_MESON_TAC[];
+  UND 0;
+  REWRITE_TAC[UNION;SUBSET];
+  MESON_TAC[];
+  REWRITE_TAC[HAS_SIZE];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let compact_supm = prove_by_refinement(
+  `!X. (compact(top_of_metric(UNIV,d_real)) X) /\ ~(X = EMPTY) ==>
+          X (supm X)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(?x. X x /\ (!y. X y ==> y <= x))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  compact_sup;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `(!x. X x ==> x <= supm X ) /\ (!y. (!x. X x ==> x <= y) ==> (supm X <= y))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  supm_UB;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `x = supm X` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `x <= supm X /\ supm X <= x ==> (x = supm X)`);
+  TSPEC `x` 4;
+  REWR 4;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+
+  ]);;
+  (* }}} *)
+
+let compact_infm = prove_by_refinement(
+  `!X. (compact(top_of_metric(UNIV,d_real)) X) /\ ~(X = EMPTY) ==>
+          X (inf X)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(?x. X x /\ (!y. X y ==> x <= y))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  compact_inf;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `(!x. X x ==> inf X <= x ) /\ (!y. (!x. X x ==> y <= x) ==> ( y <= inf X))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  inf_LB;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `x = inf X` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `x <= inf X /\ inf X <= x ==> (x = inf X)`);
+  TSPEC `x` 4;
+  REWR 4;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* Fri Aug  6 13:45:50 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let finite_supm = prove_by_refinement(
+  `!X. (FINITE X) /\ ~(X = EMPTY) ==> X (supm X)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  compact_supm;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  finite_compact;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV;];
+  ]);;
+  (* }}} *)
+
+let finite_inf = prove_by_refinement(
+  `!X. (FINITE X) /\ ~(X = EMPTY) ==> X (inf X)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  compact_infm;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  finite_compact;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real;SUBSET_UNIV;];
+  (* Fri Aug  6 13:49:38 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let finite_supm_max = prove_by_refinement(
+  `!X. (FINITE X) /\ ~(X = EMPTY) ==> (!x. X x ==> x <= supm X)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(?t. !x. (X x ==> x <= t))` SUBGOAL_TAC;
+  ASM_MESON_TAC[finite_UB];
+  ASM_MESON_TAC[supm_UB];
+  ]);;
+  (* }}} *)
+
+let finite_inf_min = prove_by_refinement(
+  `!X. (FINITE X) /\ ~(X = EMPTY) ==> (!x. X x ==> inf X <= x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(?t. !x. (X x ==> t <= x))` SUBGOAL_TAC;
+  ASM_MESON_TAC[finite_LB];
+  ASM_MESON_TAC[inf_LB];
+  ]);;
+  (* }}} *)
+
+let bij_inj_image = prove_by_refinement(
+  `!(f:A->B) X Y. (INJ f X Y /\ Y SUBSET IMAGE f X) ==>
+      (BIJ f X Y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ;BIJ;SURJ;SUBSET;IMAGE];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let suc_interval = prove_by_refinement(
+  `!n. {x | x <| SUC n} = {x | x <| n} UNION {n}`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[UNION;INR IN_SING;];
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let inj_domain_sub = prove_by_refinement(
+  `!(f:A->B) g X Y. (!x. (X x ==> (f x = g x))) ==> (INJ f X Y = INJ g X Y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let image_domain_sub = prove_by_refinement(
+  `!(f:A->B) g X . (!x. (X x ==> (f x = g x))) ==> (IMAGE f X  = IMAGE g X)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[IMAGE];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let real_finite_increase = prove_by_refinement(
+  `!X. ( (FINITE X) ==>
+     (? u. (BIJ u {x | x <| CARD X} X) /\
+        (!i j. (i <| CARD X /\ (j <| CARD X) /\ (i <| j) ==>
+         (u i <. u j)))))`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `!n X. ( (X HAS_SIZE  n) ==> (? u. (BIJ u {x | x <| CARD X} X) /\  (!i j. (i <| CARD X /\ (j <| CARD X) /\ (i <| j) ==> (u i <. u j)))))` SUBGOAL_TAC;
+  INDUCT_TAC;
+  REWRITE_TAC[HAS_SIZE_0];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[CARD_CLAUSES;BIJ;INJ;SURJ];
+  REWRITE_TAC[ARITH_RULE `~(j <| 0)`];
+  REP_BASIC_TAC;
+  COPY 1;
+  UND 1;
+  REWRITE_TAC[HAS_SIZE_SUC;];
+  REP_BASIC_TAC;
+  TYPE_THEN `X (supm X)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  finite_supm;
+  ASM_REWRITE_TAC[];
+  KILL 0;
+  USE 3(REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  TSPEC `u` 1;
+  ASM_MESON_TAC[FINITE_DELETE;HAS_SIZE;];
+  DISCH_TAC;
+  TSPEC `supm X` 1;
+  REWR 1;
+  TSPEC `X DELETE supm X` 0;
+  REWR 0;
+  REP_BASIC_TAC;
+  TYPE_THEN `v = (\j. if (j = n) then supm X else u j)` ABBREV_TAC ;
+  TYPE_THEN `v` EXISTS_TAC;
+  TYPE_THEN `CARD (X DELETE supm X) = n` SUBGOAL_TAC;
+  ASM_MESON_TAC[HAS_SIZE];
+  DISCH_TAC;
+  (* [th] *)
+  TYPE_THEN `!x. ({x | x <| n} x ==> (v x = u x))` SUBGOAL_TAC;
+  REWRITE_TAC[];
+  EXPAND_TAC "v";
+  GEN_TAC;
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[ARITH_RULE `~(n <| n)`];
+  REWRITE_TAC[];
+  DISCH_TAC;
+    TYPE_THEN `INJ v {x | x <| n} X = INJ u {x | x <| n} X` SUBGOAL_TAC;
+  IMATCH_MP_TAC  inj_domain_sub;
+  UND 8;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `v n = supm X` SUBGOAL_TAC;
+  EXPAND_TAC "v";
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+    TYPE_THEN `IMAGE v {x | x <| n} = IMAGE u {x | x <| n}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  image_domain_sub;
+  UND 8;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `IMAGE v {x | x <| n} = X DELETE supm X` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  UND 5;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[BIJ];
+  alpha_tac;
+  MESON_TAC[SURJ_IMAGE];
+  DISCH_TAC;
+  (* obligations *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  bij_inj_image;
+  CONJ_TAC;
+  TYPE_THEN `{x | x <| CARD X} = {x | x <| n} UNION {n}` SUBGOAL_TAC;
+  USE 2(REWRITE_RULE[HAS_SIZE]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[suc_interval];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  inj_split;
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;DELETE]);
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  UND 13;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INJ;SUBSET];
+  MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[INJ;SUBSET;INR IN_SING];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[EQ_EMPTY;INTER;image_sing;INR IN_SING;];
+  KILL 11;
+  ASM_REWRITE_TAC[DELETE;SUBSET;];
+  MESON_TAC[];
+  TYPE_THEN `X = supm X INSERT (X DELETE supm X)` SUBGOAL_TAC;
+  ASM_SIMP_TAC[INR INSERT_DELETE];
+  USE 2 (REWRITE_RULE[HAS_SIZE]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  REWRITE_TAC[INSERT_SUBSET];
+  KILL 11;
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `n` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `IMAGE v {x| x <| n}` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL];
+  USE 12 GSYM;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  REWRITE_TAC[SUBSET];
+  ARITH_TAC;
+  REP_GEN_TAC;
+  (* monotonicity [m] *)
+  USE 2 (REWRITE_RULE[HAS_SIZE]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(!x. X x ==> x <= supm X)` SUBGOAL_TAC;
+  ASM_MESON_TAC[finite_supm_max];
+  DISCH_TAC;
+  TYPE_THEN `j = n` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM  (fun t-> MP_TAC (AP_THM t `(v:num->real) i`));
+  REWRITE_TAC[IMAGE;DELETE;];
+  TSPEC  `(v i)` 13;
+  UND 13;
+  MESON_TAC[REAL_ARITH `a < b <=> (a<= b /\ ~(a = b))`];
+  KILL 3;
+  KILL 4;
+  KILL 5;
+  REP_BASIC_TAC;
+  TYPE_THEN `~(i = n)` SUBGOAL_TAC;
+  UND 2;
+  UND 3;
+  ARITH_TAC;
+  REWR 0;
+  DISCH_TAC;
+  TYPE_THEN `i <| n /\ j <| n` SUBGOAL_TAC;
+  UND 3;
+  UND 4;
+  UND 14;
+  UND 16;
+  ARITH_TAC;
+  REP_BASIC_TAC;
+  REWR 8;
+  ASM_SIMP_TAC[];
+  (* end *)
+  REWRITE_TAC[HAS_SIZE];
+  REP_BASIC_TAC;
+  RIGHT 1 "n" ;
+  TSPEC `X` 1;
+  TSPEC `CARD X` 1;
+  alpha_tac;
+  ASM_MESON_TAC[];
+  (* Fri Aug  6 19:51:16 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let connected_nogap = prove_by_refinement(
+  `!A a b. connected (top_of_metric(UNIV,d_real)) A /\
+          A a /\ A b ==>
+       {x | a <= x /\ x <= b } SUBSET A`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(a = b) \/ (b < a) \/ (a < b)` SUBGOAL_TAC;
+  REAL_ARITH_TAC;
+  REP_CASES_TAC;
+  ASM_REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[REAL_ARITH `b <= x /\ x <= b ==> (x = b)`];
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[REAL_ARITH `a <=x /\ x <= b ==> ~(b < a)`];
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `a < x` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `(a <= x /\ ~(a = x)) ==> a < x`);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `x < b` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `(x <= b /\ ~(b = x)) ==> x < b`);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[connected]);
+  REP_BASIC_TAC;
+  TYPEL_THEN [` {t | t < x}`;` {t | x < t}`] (USE 2 o SPECL);
+  UND 2;
+  REWRITE_TAC[half_open;half_open_above];
+  TYPE_THEN `({t | t < x} INTER {t | x < t} = {}) /\ A SUBSET {t | t < x} UNION {t | x < t}` SUBGOAL_TAC;
+  REWRITE_TAC[INTER;EQ_EMPTY;UNION;SUBSET;];
+  REWRITE_TAC[REAL_ARITH `x' < x \/ x < x' <=> ~(x' = x)`];
+  CONJ_TAC;
+  REAL_ARITH_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[SUBSET;];
+  ASM_MESON_TAC[REAL_ARITH `x < b ==> ~(b < x)`];
+  (* Fri Aug  6 20:24:45 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let connected_open = prove_by_refinement(
+  `!A a b. (connected (top_of_metric(UNIV,d_real)) A /\
+       (top_of_metric(UNIV,d_real) A) /\
+       (~(A = EMPTY)) /\
+       A SUBSET {x | a <= x /\ x <= b}) ==>
+         ( A = {x | inf A < x /\ x < supm A})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  TYPE_THEN `(!epsilon. &0 < epsilon ==> (?x. A x /\ supm A - epsilon < x))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  supm_eps;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(!epsilon. &0 < epsilon ==> (?x. A x /\ x < inf A + epsilon))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  inf_eps;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(!x. A x ==> x <= supm A)` SUBGOAL_TAC;
+  ASM_MESON_TAC[supm_UB];
+  DISCH_TAC;
+  TYPE_THEN `(!x. A x ==> inf A <= x)` SUBGOAL_TAC;
+  ASM_MESON_TAC[inf_LB];
+  DISCH_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  TYPE_THEN `!x. (A x  ==> ?e. &0 < e /\ open_ball(UNIV,d_real) x e SUBSET A)` SUBGOAL_TAC;
+  UND 2;
+  MP_TAC metric_real;
+  MESON_TAC[open_ball_nbd];
+  REWRITE_TAC[open_ball;d_real];
+  DISCH_TAC;
+  (*  *)
+  TYPE_THEN `!x. A x ==> (?y. A y /\ ~(x <= y))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TSPEC  `x` 8;
+  REWR 8;
+  REP_BASIC_TAC;
+  USE 8(REWRITE_RULE[SUBSET]);
+  TYPE_THEN `x - e/(&2)` EXISTS_TAC;
+  REWRITE_TAC[REAL_ARITH `~(x <= x - e/(&2)) <=> (&0 < e/(&2))`];
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[REAL_ARITH `(x - (x - t)) = t`];
+  TYPE_THEN `abs  (e/(&2)) = (e/(&2))` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_REFL];
+  IMATCH_MP_TAC  (REAL_ARITH `(a < b) ==> (a <= b)`);
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[REAL_LT_HALF2];
+  DISCH_TAC;
+  (*  *)
+  TYPE_THEN `!x. A x ==> (?y. A y /\ ~(y <= x))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TSPEC  `x` 8;
+  REWR 8;
+  REP_BASIC_TAC;
+  USE 8(REWRITE_RULE[SUBSET]);
+  TYPE_THEN `x + e/(&2)` EXISTS_TAC;
+  REWRITE_TAC[REAL_ARITH `~( x + e/(&2) <= x) <=> (&0 < e/(&2))`];
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[REAL_ARITH `(x - (x + t)) = --. t`];
+  TYPE_THEN `abs (--. (e/(&2))) = (e/(&2))` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_REFL;ABS_NEG;];
+  IMATCH_MP_TAC  (REAL_ARITH `(a < b) ==> (a <= b)`);
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[REAL_LT_HALF2];
+  DISCH_TAC;
+  (* FIRST direction *)
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  REWRITE_TAC[REAL_ARITH `u < v  <=> (u <= v /\ ~(u = v))`];
+  CONJ_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* 2 *)
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  TYPE_THEN `?a'. A a' /\ (a' < x)` SUBGOAL_TAC;
+  TSPEC `x - inf A` 5;
+  USE 5 (REWRITE_RULE[REAL_ARITH `&0 < x - y <=> (y < x)`;REAL_ARITH `t + x - t = x`]);
+  REWR 5;
+  DISCH_TAC;
+  TSPEC `supm A - x` 4;
+  USE 4(REWRITE_RULE[REAL_ARITH `&0 < y - x <=> (x < y)`;REAL_ARITH `t - (t -x) = x`]);
+  REWR 4;
+  REP_BASIC_TAC;
+  TYPE_THEN `{t | a' <= t /\ t <= x'} SUBSET A` SUBGOAL_TAC;
+  IMATCH_MP_TAC  connected_nogap;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_TAC;
+  TSPEC `x` 16;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 4;
+  UND 14;
+  REAL_ARITH_TAC;
+  (* Fri Aug  6 21:34:56 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let closure_real_set = prove_by_refinement(
+  `!Z a.
+     (closure(top_of_metric(UNIV,d_real)) Z a <=>
+       (!e. (&0 < e) ==> (?z. Z z /\ (abs  (a - z) <= e))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `metric_space (UNIV,d_real) /\ Z SUBSET UNIV` SUBGOAL_TAC;
+  REWRITE_TAC[metric_real;SUBSET_UNIV];
+  DISCH_THEN (fun t -> MP_TAC (MATCH_MP closure_open_ball t));
+  DISCH_THEN (fun t -> MP_TAC (AP_THM t `a:real`));
+  REWRITE_TAC[];
+  DISCH_THEN (fun t ->  REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[open_ball;d_real;];
+  EQ_TAC;
+  ASM_MESON_TAC[REAL_ARITH `a < b ==> a <= b`];
+  REP_BASIC_TAC;
+  TSPEC `r/(&2)` 1;
+  RULE_ASSUM_TAC (REWRITE_RULE[REAL_LT_HALF1]);
+  REWR 1;
+  REP_BASIC_TAC;
+  TYPE_THEN `z` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  (REAL_ARITH `(a <= b/(&2)) /\ (b/(&2) < b)   ==> (a < b)`);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[half_pos];
+  (* Sat Aug  7 08:14:28 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let real_div_assoc = prove_by_refinement(
+  `!a b c. (a*b)/c = a*(b/c)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[real_div;REAL_MUL_AC;];
+  ]);;
+  (* }}} *)
+
+let real_middle1_lt = prove_by_refinement(
+  `!a b. (a < b) ==> a < (a + b)/(&2) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(&2*a)/(&2) < (a+b)/(&2)` SUBGOAL_TAC;
+  ASM_SIMP_TAC[REAL_LT_DIV2_EQ;REAL_ARITH `&0 < &2`];
+  REWRITE_TAC[REAL_MUL_2];
+  UND 0;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[real_div_assoc];
+  ASM_SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&2 = &0)`];
+  ]);;
+  (* }}} *)
+
+let real_middle2_lt = prove_by_refinement(
+  `!a b. (a < b) ==>  (a + b)/(&2) < b `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN ` (a+b)/(&2) < (&2*b)/(&2)` SUBGOAL_TAC;
+  ASM_SIMP_TAC[REAL_LT_DIV2_EQ;REAL_ARITH `&0 < &2`];
+  REWRITE_TAC[REAL_MUL_2];
+  UND 0;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[real_div_assoc];
+  ASM_SIMP_TAC[REAL_DIV_LMUL;REAL_ARITH `~(&2 = &0)`];
+  ]);;
+  (* }}} *)
+
+let real_sub_half = prove_by_refinement(
+  `!a b. (a - (a + b)/(&2) = (a - b)/(&2))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `((&2*a)/(&2) - (a+b)/(&2) = (a - b)/(&2))` SUBGOAL_TAC;
+  REWRITE_TAC[real_div;GSYM REAL_SUB_RDISTRIB];
+  REWRITE_TAC[REAL_EQ_RMUL_IMP];
+  AP_THM_TAC;
+  AP_TERM_TAC;
+  REWRITE_TAC[REAL_MUL_2];
+  REAL_ARITH_TAC;
+  ASM_SIMP_TAC[REAL_ARITH `~(&2 = &0)`;REAL_DIV_LMUL;real_div_assoc];
+  ]);;
+  (* }}} *)
+
+let closure_open_interval = prove_by_refinement(
+  `!a b. (a < b) ==>
+      (closure (top_of_metric(UNIV,d_real)) {x | a < x /\ x < b} =
+       {x | a <= x /\ x <= b}) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  closure_subset;
+  ASM_SIMP_TAC[interval_closed;top_of_metric_top;metric_real];
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  (* 2 *)
+  TYPE_THEN `{x | a <= x /\ x <= b} = a INSERT (b INSERT {x | a < x /\ x < b})` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INSERT];
+  GEN_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[INSERT_SUBSET];
+  ASM_SIMP_TAC[top_of_metric_top;metric_real;subset_closure;];
+  (* USE closure_real_set *)
+  REWRITE_TAC[closure_real_set];
+  TYPE_THEN `!e. (&0 < e) ==> (a + e < b) \/ ((b - a)/(&2) < e)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  ASM_CASES_TAC `(a + e < b)`;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  (REAL_ARITH `(x <= y/(&2) /\ y/(&2) < y)  ==> (x < y)`);
+  ASM_SIMP_TAC [half_pos];
+  ASM_SIMP_TAC[REAL_LE_DIV2_EQ;REAL_ARITH `&0 < &2`];
+  UND 2;
+  REAL_ARITH_TAC;
+  DISCH_ALL_TAC;
+  (* 1 *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  TSPEC `e` 1;
+  REWR 1;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `a + e` EXISTS_TAC;
+  REWRITE_TAC[REAL_ARITH `(a < a + e <=> &0 < e) /\ (a - (a + e) = --. e)`];
+  ASM_REWRITE_TAC[ABS_NEG;];
+  IMATCH_MP_TAC  (REAL_ARITH `(x = y) ==> (x <= y)`);
+  REWRITE_TAC[REAL_ABS_REFL];
+  UND 2;
+  REAL_ARITH_TAC;
+  (* 2 *)
+  REP_BASIC_TAC;
+  TYPE_THEN `(a + b)/(&2)` EXISTS_TAC;
+  ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half];
+  UND 3;
+  UND 0;
+  REWRITE_TAC[real_div;ABS_MUL];
+  ASM_SIMP_TAC[REAL_ARITH `(a < b) ==> (abs(a - b) = (b-a))`];
+  TYPE_THEN `abs (inv(&2)) = inv(&2)` SUBGOAL_TAC;
+  REWRITE_TAC[ABS_REFL;REAL_LE_INV_EQ];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REAL_ARITH_TAC;
+  (* 3 *)
+  REP_BASIC_TAC;
+  TSPEC `e` 1;
+  REWR 1;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `b - e` EXISTS_TAC;
+  REWRITE_TAC[REAL_ARITH `(b - e < b <=> &0 < e) /\ (b - (b - e) =  e)`];
+  REWRITE_TAC[REAL_ARITH `(a < b - e) <=> (a + e < b)`];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  (REAL_ARITH `(x = y) ==> (x <= y)`);
+  REWRITE_TAC[REAL_ABS_REFL];
+  UND 2;
+  REAL_ARITH_TAC;
+  (* 4 *)
+  REP_BASIC_TAC;
+  TYPE_THEN `(b + a)/(&2)` EXISTS_TAC;
+  ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half];
+  ONCE_REWRITE_TAC [REAL_ARITH `(a + b) = (b + a)`];
+  ASM_SIMP_TAC[real_middle1_lt;real_middle2_lt;real_sub_half];
+  UND 3;
+  UND 0;
+  REWRITE_TAC[real_div;ABS_MUL];
+  ASM_SIMP_TAC[REAL_ARITH `(a < b) ==> (abs(b - a) = (b-a))`];
+  TYPE_THEN `abs (inv(&2)) = inv(&2)` SUBGOAL_TAC;
+  REWRITE_TAC[ABS_REFL;REAL_LE_INV_EQ];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REAL_ARITH_TAC;
+  (* Sat Aug  7 09:45:29 EDT 2004 *)
+  ]);;
+
+  (* }}} *)
+
+let interval_subset  = prove_by_refinement(
+  `!a b c d. {x | a <= x /\ x <= b} SUBSET  {x | c <= x /\ x <= d} <=>
+      (b < a) \/ ((c <= a ) /\ (b <= d))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET ];
+  REP_BASIC_TAC;
+  ASM_CASES_TAC `b < a` ;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  REAL_ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `a` (WITH 1 o SPEC);
+  TYPE_THEN `b` (USE 1 o SPEC);
+  UND 0;
+  UND 1;
+  UND 2;
+  REAL_ARITH_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let subset_antisym_eq = prove_by_refinement(
+  `!(A:A->bool) B. (A = B) <=> (A SUBSET B /\ B SUBSET A) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;FUN_EQ_THM ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let interval_eq = prove_by_refinement(
+(**** Parens added by JRH for real right associativity of =
+  `!a b c d. {x | a <= x /\ x <= b} =  {x | c <= x /\ x <= d} =
+      ((b < a) /\ (d < c)) \/ ((c = a ) /\ (b = d))`,
+ ****)
+  `!a b c d. ({x | a <= x /\ x <= b} =  {x | c <= x /\ x <= d}) <=>
+      ((b < a) /\ (d < c)) \/ ((c = a ) /\ (b = d))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[subset_antisym_eq;interval_subset;];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let connected_open_closure = prove_by_refinement(
+  `!A a b. (connected (top_of_metric(UNIV,d_real)) A /\
+       (top_of_metric(UNIV,d_real) A) /\
+    (closure (top_of_metric(UNIV,d_real)) A = {x | a <= x /\ x <= b}) ==>
+    (A = { x | a < x /\ x < b }))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  (* deal WITH emptyset *)
+  TYPE_THEN `A = EMPTY` ASM_CASES_TAC;
+  REWR 0;
+  UND 0;
+  ASM_SIMP_TAC[top_of_metric_top;metric_real;closure_empty;];
+  DISCH_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  GEN_TAC;
+  FIRST_ASSUM (fun t -> MP_TAC (AP_THM t `x:real`));
+  REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  (* deal WITH containment *)
+  TYPE_THEN `A SUBSET {x | a <= x /\ x <= b}` SUBGOAL_TAC;
+  USE 0 SYM;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_closure;
+  ASM_SIMP_TAC[top_of_metric_top;metric_real];
+  DISCH_TAC;
+  (* quote previous result *)
+  TYPE_THEN `( A = {x | inf A < x /\ x < supm A})` SUBGOAL_TAC;
+  IMATCH_MP_TAC  connected_open;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* now USE the closure of an open interval is the closed interval *)
+
+  PROOF_BY_CONTR_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  UND 3;
+  REWRITE_TAC[];
+  ASM ONCE_REWRITE_TAC [];
+  REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `inf A < supm A` SUBGOAL_TAC;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  USE 7(MATCH_MP closure_open_interval);
+  UND 6;
+  UND 0;
+  REWRITE_TAC[];
+  ASM ONCE_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  USE 0(REWRITE_RULE[interval_eq]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  UND 8;
+  UND 3;
+  UND 6;
+  REAL_ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  (* Sat Aug  7 10:38:12 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+(* Sat Aug  7 11:01:27 EDT 2004 *)
+
+let closed_ball_empty = prove_by_refinement(
+  `!n a r. (r < &0) ==> (closed_ball(euclid n,d_euclid) a r = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closed_ball;EQ_EMPTY;];
+  ASM_MESON_TAC[d_euclid_pos;REAL_ARITH `&0 <= d /\ d <= r ==> ~(r < &0)`];
+  ]);;
+  (* }}} *)
+
+let closed_ball_pt = prove_by_refinement(
+  `!n a. (closed_ball(euclid n,d_euclid) a (&0) SUBSET {a})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closed_ball;SUBSET;INR IN_SING;];
+  ASM_MESON_TAC [d_euclid_pos;d_euclid_zero;REAL_ARITH `(x <= &0 /\ &0 <= x) ==> (x = &0)`];
+  ]);;
+  (* }}} *)
+
+let closed_ball_subset_open = prove_by_refinement(
+  `!n a r. ?r'. closed_ball(euclid n,d_euclid) a r SUBSET
+      open_ball(euclid n,d_euclid) a r'`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[closed_ball;open_ball;SUBSET ];
+  TYPE_THEN `r + &1` EXISTS_TAC;
+  MESON_TAC[ REAL_ARITH `(u <= r) ==> (u < r + &1)`];
+  ]);;
+  (* }}} *)
+
+let closed_ball_compact = prove_by_refinement(
+  `!n a r.  (compact (top_of_metric(euclid n,d_euclid))
+        (closed_ball(euclid n,d_euclid) a r)) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `closed_ball(euclid n,d_euclid) a r SUBSET (euclid n)` SUBGOAL_TAC;
+  REWRITE_TAC[closed_ball;SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `open_ball(euclid n,d_euclid) a r SUBSET (euclid n)` SUBGOAL_TAC;
+  REWRITE_TAC[open_ball;SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  ASM_SIMP_TAC[compact_euclid;closed_ball_closed;metric_euclid;];
+  REWRITE_TAC[metric_bounded];
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `r + &1`EXISTS_TAC;
+  REWRITE_TAC[open_ball;SUBSET;];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  UND 2;
+  REWRITE_TAC[closed_ball];
+  REP_BASIC_TAC;
+  TYPE_THEN `d_euclid a a = &0` SUBGOAL_TAC;
+  ASM_MESON_TAC[d_euclid_zero];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[d_euclid_pos;REAL_ARITH `&0 <= d /\ d <= r ==> &0 <= r`;REAL_ARITH `u <= r ==> (u < r + &1)`];
+  (* Sat Aug  7 12:15:05 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let set_dist = jordan_def
+  `set_dist d (K:A->bool) (K':B->bool) =
+       inf { z | (?p p'. (K p /\ K' p' /\ (z = d p p')))}`;;
+
+let set_dist_inf = prove_by_refinement(
+  `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
+      (K' SUBSET X) ==>
+    (!p p'. (K p /\ K' p' ==> (set_dist d K K' <= d p p')))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[set_dist];
+  REP_BASIC_TAC;
+  TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ;
+  TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC;
+  GEN_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `Y (d p p')` SUBGOAL_TAC;
+
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+
+  TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `d p p'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_THEN (ASSUME_TAC o (MATCH_MP   inf_LB));
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let set_dist_nn = prove_by_refinement(
+  `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
+     ~(K = EMPTY) /\      ~(K' = EMPTY) /\
+      (K' SUBSET X) ==> (&0 <= set_dist d K K')`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[set_dist];
+  REP_BASIC_TAC;
+  TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ;
+  TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  UND 6;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `~(Y = {})` SUBGOAL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS];
+  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  TYPE_THEN `d u' u` EXISTS_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN (ASSUME_TAC o (MATCH_MP   inf_LB));
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let set_dist_eq = prove_by_refinement(
+  `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
+     ~(K = EMPTY) /\      ~(K' = EMPTY) /\
+    (compact (top_of_metric(X,d)) K) /\
+    (compact (top_of_metric (X,d)) K') /\
+      (K' SUBSET X) ==>
+    (?p p'. K p /\ K' p' /\ (set_dist d K K' = d p p'))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[set_dist];
+  REP_BASIC_TAC;
+  TYPE_THEN `Y = {z | ?p p'. K p /\ K' p' /\ (z = d p p')}` ABBREV_TAC ;
+  TYPE_THEN `!x. Y x ==> &0 <= x` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  UND 8;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[metric_space]);
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  TYPE_THEN `~(Y = {})` SUBGOAL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS];
+  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  TYPE_THEN `d u' u` EXISTS_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~(Y = {}) /\ (?t. !x. Y x ==> t <= x)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN (ASSUME_TAC o (MATCH_MP   inf_LB));
+  TYPE_THEN `(?p p'. K p /\ K' p' /\ (!q q'. K q /\ K' q' ==> d p p' <= d q q'))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  compact_distance;
+  TYPE_THEN `X` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `p` EXISTS_TAC;
+  TYPE_THEN `p'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* 1 *)
+  TYPE_THEN `Y (d p p')` SUBGOAL_TAC;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `a <= b /\ b <= a ==> (a = b)`);
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  EXPAND_TAC "Y";
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* Sat Aug  7 13:19:01 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION L *)
+(* ------------------------------------------------------------------ *)
+
+
+let simple_arc_compact = prove_by_refinement(
+  `!C. simple_arc top2 C ==> compact top2 C`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[simple_arc];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  image_compact;
+  TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[inj_image_subset;interval_compact;];
+  (* Sat Aug  7 12:24:22 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let simple_arc_nonempty = prove_by_refinement(
+  `!C. simple_arc top2 C ==> ~(C = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc;EMPTY_EXISTS;];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[IMAGE;];
+  TYPE_THEN `f (&0)` EXISTS_TAC;
+  TYPE_THEN `&0` EXISTS_TAC;
+  REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let graph_edge_compact = prove_by_refinement(
+  `!G e. (plane_graph G) /\ (graph_edge G e) ==>
+      (compact top2 e)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC [plane_graph];
+  REP_BASIC_TAC;
+  USE 3 (REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[simple_arc_compact];
+  ]);;
+  (* }}} *)
+
+let graph_vertex_exist = prove_by_refinement(
+  `!G. graph (G:(A,B)graph_t) /\ ~(graph_edge G = EMPTY) ==>
+   (?v. graph_vertex G v)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc G u SUBSET graph_vertex G` SUBGOAL_TAC;
+  ASM_SIMP_TAC[graph_inc_subset];
+  DISCH_TAC;
+  TYPE_THEN `graph_inc G u HAS_SIZE 2` SUBGOAL_TAC;
+  ASM_SIMP_TAC[graph_edge2;];
+  REWRITE_TAC[has_size2];
+  REP_BASIC_TAC;
+  REWR 2;
+  UND 2;
+  REWRITE_TAC[SUBSET ;INR in_pair ];
+  MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let graph_vertex_2 = prove_by_refinement(
+  `!G. graph (G:(A,B)graph_t) /\ ~(graph_edge G = EMPTY) ==>
+   (?v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v'))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[EMPTY_EXISTS];
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc G u SUBSET graph_vertex G` SUBGOAL_TAC;
+  ASM_SIMP_TAC[graph_inc_subset];
+  DISCH_TAC;
+  TYPE_THEN `graph_inc G u HAS_SIZE 2` SUBGOAL_TAC;
+  ASM_SIMP_TAC[graph_edge2;];
+  REWRITE_TAC[has_size2];
+  REP_BASIC_TAC;
+  REWR 2;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC ;
+  UND 2;
+  REWRITE_TAC[SUBSET ;INR in_pair ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let graph_disk_lemma1 = prove_by_refinement(
+  `!G. plane_graph G /\ FINITE (graph_vertex G) /\ FINITE (graph_edge G)
+       ==>
+    FINITE {z | (?e v. graph_edge G e /\ graph_vertex G v /\
+              ~(graph_inc G e v) /\ (z = (e,v)))}`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `Y = {z | (?e v. graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) /\ (z = (e,v)))}` ABBREV_TAC ;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `{(e,v) | graph_edge G e /\ graph_vertex G v}` EXISTS_TAC;
+  TYPEL_THEN [`graph_edge G `;`graph_vertex G `] (fun t -> ASSUME_TAC (ISPECL t FINITE_PRODUCT));
+  REWR 4;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "Y";
+  REWRITE_TAC[SUBSET];
+ MESON_TAC[];
+  (* Sat Aug  7 14:21:19 EDT 2004 *)
+
+    ]);;
+  (* }}} *)
+
+let image_empty = prove_by_refinement(
+  `!(A:A->bool) (f:A->B). (IMAGE f A = EMPTY) <=> (A = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[IMAGE;FUN_EQ_THM;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* not used *)
+let pair_apply = prove_by_refinement(
+  `!P. (!x. P x) <=> ! (u:A) (v:B) . P (u,v)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TSPEC `(u,v)` 0;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPEL_THEN [`FST x`;`SND x`] (USE 0 o ISPECL);
+  USE 0(REWRITE_RULE[]);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let set_dist_pos = prove_by_refinement(
+  `!(X:A->bool) d K K'. metric_space(X,d) /\ (K SUBSET X) /\
+     ~(K = EMPTY) /\      ~(K' = EMPTY) /\
+    (compact (top_of_metric(X,d)) K) /\
+    (compact (top_of_metric (X,d)) K') /\ (K INTER K' = EMPTY) /\
+      (K' SUBSET X) ==>
+    (&0 < (set_dist d K K' ))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH  `~(x = &0) /\ (&0 <= x) ==> (&0 < x)`);
+  CONJ_TAC;
+  TYPE_THEN `(?p p'. K p /\ K' p' /\ (set_dist d K K' = d p p'))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  set_dist_eq;
+  TYPE_THEN `X` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `p = p'` SUBGOAL_TAC;
+  REWR 9;
+  TYPE_THEN `X p /\ X p'` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  USE 9 SYM;
+  REP_BASIC_TAC;
+  UND 9;
+  ASM_MESON_TAC  [metric_space_zero2];
+  UND 1;
+  UND 10;
+  UND 11;
+  REWRITE_TAC[EQ_EMPTY;INTER;];
+  MESON_TAC[];
+  IMATCH_MP_TAC  set_dist_nn;
+  TYPE_THEN `X` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let closed_ball_inter = prove_by_refinement(
+  `!(x:A) y r r' X d. (metric_space(X,d) /\
+    ~(closed_ball(X,d) x r INTER closed_ball(X,d) y r' = EMPTY) ==>
+   (d x y <= r + r'))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[closed_ball;EMPTY_EXISTS;INTER];
+  REP_BASIC_TAC;
+  TYPE_THEN `d x y <= d x u + d u y` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_triangle;
+  ASM_MESON_TAC[];
+  TYPE_THEN `d u y = d y u` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_symm;
+  ASM_MESON_TAC[];
+  UND 0;
+  UND 3;
+  REAL_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let graph_disk = prove_by_refinement(
+  `!G. plane_graph G /\
+       FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
+     ~(graph_edge G = EMPTY)
+      ==> (?r. (&0 < r ) /\
+     (!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==>
+        (closed_ball (euclid 2,d_euclid) v r INTER
+            closed_ball (euclid 2,d_euclid) v' r = EMPTY)) /\
+     (!e v. (graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) ==>
+           (e INTER closed_ball (euclid 2,d_euclid) v r = EMPTY) )))`,
+  (* {{{ proof *)
+
+  [
+    REP_BASIC_TAC;
+  (* A' *)
+  TYPE_THEN `A = { (v,v') |  (graph_vertex G v) /\ graph_vertex G v' /\ ~(v = v') }` ABBREV_TAC ;
+  TYPE_THEN `FINITE A` SUBGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `{ (v,v') | (graph_vertex G v) /\ graph_vertex G v'}` EXISTS_TAC;
+  TYPEL_THEN  [`graph_vertex G`;`graph_vertex G`] (fun t-> ASSUME_TAC (ISPECL   t FINITE_PRODUCT));
+  REWR 5;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "A";
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `A' = IMAGE  (\ (v,v'). (d_euclid v v')/(&2)) A` ABBREV_TAC ;
+  TYPE_THEN `FINITE A'` SUBGOAL_TAC;
+  EXPAND_TAC "A'";
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* [B] *)
+  TYPE_THEN `B = { (e,v) | graph_edge G e /\ graph_vertex G v /\ ~(graph_inc G e v) }` ABBREV_TAC ;
+  TYPE_THEN `B' = IMAGE (\ (e,v). (set_dist d_euclid {v} e)) B`  ABBREV_TAC ;
+  TYPE_THEN `FINITE B'` SUBGOAL_TAC;
+  EXPAND_TAC "B'";
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  TYPE_THEN `B = {z | (?e v. graph_edge G e /\ graph_vertex G v /\ ~( graph_inc G e v) /\ (z = (e,v)))}` SUBGOAL_TAC;
+  EXPAND_TAC "B";
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  graph_disk_lemma1;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* [C] : A' B' C nonempty *)
+  TYPE_THEN `C' = A' UNION B'` ABBREV_TAC ;
+  TYPE_THEN `FINITE C' /\ ~(C' = EMPTY)` SUBGOAL_TAC;
+  EXPAND_TAC "C'";
+  ASM_REWRITE_TAC[FINITE_UNION];
+  EXPAND_TAC "C'";
+  REWRITE_TAC[EMPTY_EXISTS;UNION;];
+  TYPE_THEN `~(A' = EMPTY)` SUBGOAL_TAC;
+  EXPAND_TAC "A'";
+  REWRITE_TAC[image_empty; ];
+  TYPE_THEN `(?v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v'))` SUBGOAL_TAC;
+  IMATCH_MP_TAC graph_vertex_2;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[plane_graph];
+  REP_BASIC_TAC;
+  UND 12;
+  REWRITE_TAC[];
+  EXPAND_TAC "A";
+  REWRITE_TAC[EMPTY_EXISTS];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `v` EXISTS_TAC;
+  TYPE_THEN `v'` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  MESON_TAC[];
+  DISCH_TAC;
+  (* [D]:  C(inf C) *)
+  TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
+  UND 3;
+  REWRITE_TAC[plane_graph];
+  MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `C'(inf C')` SUBGOAL_TAC;
+  IMATCH_MP_TAC  finite_inf;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!x. C' x ==> (inf C' <= x)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  finite_inf_min;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!v. (graph_vertex G v ==> compact top2 {v})` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  compact_point;
+  UND 13;
+  REWRITE_TAC[SUBSET;top2_unions];
+  UND 12;
+  MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!e. (graph_edge G e ==> compact top2 e)` SUBGOAL_TAC;
+  ASM_MESON_TAC[graph_edge_compact];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!x. A' x <=> (?v' v''. graph_vertex G v' /\ graph_vertex G v'' /\  ~(v' = v'') /\ (x = d_euclid v' v'' / &2))` SUBGOAL_TAC;
+  EXPAND_TAC "A'";
+  EXPAND_TAC "A";
+  REWRITE_TAC[IMAGE];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x'");
+(*** Next steps removed by JRH: now paired beta-conversion automatic ***)
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!x. B' x <=> (?e' v'. graph_edge G e' /\ graph_vertex G v' /\  ~(graph_inc G e' v') /\ (x = set_dist d_euclid {  v' } e'))`
+  SUBGOAL_TAC;
+  EXPAND_TAC "B'";
+  EXPAND_TAC "B";
+  REWRITE_TAC[IMAGE];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x'");
+(*** Next steps removed by JRH: now paired beta-conversion automatic ***)
+  DISCH_TAC;
+  (* -- [temp] *)
+  TYPE_THEN `!x. C' x ==> (&0 < x)` SUBGOAL_TAC;
+  EXPAND_TAC "C'";
+  REWRITE_TAC[UNION];
+  GEN_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  UND 20;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  IMATCH_MP_TAC  (REAL_ARITH `(&0 <= y /\ ~(y = &0) ) ==> &0 < y `);
+  TYPE_THEN `euclid 2 v' /\ euclid 2 v''` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  UND 20;
+  ASM_MESON_TAC [d_euclid_pos;d_euclid_zero;];
+  (* -2-  *)
+  UND 20;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  set_dist_pos;
+  TYPE_THEN `euclid 2` EXISTS_TAC ;
+  REWRITE_TAC[metric_euclid;single_subset];
+  CONJ_TAC;
+  UND 13;
+  REWRITE_TAC[SUBSET];
+  UND 21;
+  MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[EMPTY_EXISTS;INR IN_SING;];
+  MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_nonempty;
+  UND 3;
+  UND 22;
+  REWRITE_TAC[plane_graph;SUBSET;];
+  MESON_TAC[];
+  REWRITE_TAC[GSYM top2];
+  ASM_SIMP_TAC[];
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  TSPEC `e'` 25;
+  REWR 25;
+  TYPE_THEN `v'` (fun u -> FIRST_ASSUM (fun t-> (MP_TAC (AP_THM t u))));
+  ASM_REWRITE_TAC[EQ_EMPTY;];
+  REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[INR IN_SING;];
+  MESON_TAC[];
+  UND 22;
+  UND 17;
+  REWRITE_TAC[compact;top2_unions];
+  MESON_TAC[];
+  DISCH_TAC;
+  (* [E] r good for A' *)
+  TYPE_THEN `?r. (&0 < r /\ r < inf C')` SUBGOAL_TAC;
+  TYPE_THEN `inf C' /(&2)` EXISTS_TAC;
+  IMATCH_MP_TAC  half_pos;
+  UND 20;
+  UND 14;
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `A' ((d_euclid v v')/(&2))` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* -2- *)
+  TYPE_THEN `r < ((d_euclid v v')/(&2))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `(?t . (r < t /\ t <= u)) ==> (r < u)`);
+  TYPE_THEN `inf C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  EXPAND_TAC "C'";
+  REWRITE_TAC[UNION];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWRITE_TAC[EQ_EMPTY ;INTER;];
+  REP_BASIC_TAC;
+  (* -2- triangle ineq *)
+  UND 29;
+  UND 30;
+  UND 28;
+  UND 21;
+  POP_ASSUM_LIST (fun t-> ALL_TAC);
+  REP_BASIC_TAC;
+  (* [* temp] *)
+  TYPE_THEN `d_euclid v v' <= r + r` SUBGOAL_TAC;
+  IMATCH_MP_TAC  closed_ball_inter;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  REWRITE_TAC[INTER;EMPTY_EXISTS ;metric_euclid;];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `d_euclid v v' < d_euclid v v'/(&2) + d_euclid v v'/(&2)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `(?t. (d <= t + t /\ t < u)) ==> (d < u + u)`);
+  TYPE_THEN `r` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_HALF_DOUBLE];
+  REAL_ARITH_TAC;
+  (* [F] good for B' *)
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 27(REWRITE_RULE[EMPTY_EXISTS;INTER;]);
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `B' (set_dist d_euclid {v} e)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `e` EXISTS_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `r < set_dist d_euclid {v} e` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `(?t. (r < t /\ t <= q)) ==> (r < q)`);
+  TYPE_THEN `inf C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  EXPAND_TAC "C'";
+  REWRITE_TAC[UNION];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `(!p p'. ({v} p /\ e p' ==> (set_dist d_euclid {v} e <= d_euclid p p')))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  set_dist_inf;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[metric_euclid;single_subset;];
+  CONJ_TAC;
+  UND 13;
+  UND 25;
+  MESON_TAC[ISUBSET];
+  UND 17;
+  UND 26;
+  REWRITE_TAC[compact;top2_unions;];
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `set_dist d_euclid {v} e <= d_euclid v u` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[INR IN_SING];
+  TYPE_THEN `d_euclid v u <= r` SUBGOAL_TAC;
+  UND 27;
+  REWRITE_TAC[closed_ball];
+  MESON_TAC[];
+  UND 30;
+  REAL_ARITH_TAC;
+  (* Sat Aug  7 21:33:13 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let norm2 = jordan_def `norm2 x = d_euclid x euclid0`;;
+
+let cis = jordan_def `cis x = point(cos(x),sin(x))`;;
+
+let norm2_cis = prove_by_refinement(
+  `!x. norm2(cis(x)) = &1`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point];
+  REDUCE_TAC;
+  ONCE_REWRITE_TAC [REAL_ARITH `(x + y) = (y + x)`];
+  REWRITE_TAC[SIN_CIRCLE;SQRT_1];
+  (* Sat Aug  7 21:47:16 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let norm2_nn = prove_by_refinement(
+  `!x . (euclid 2 x) ==> &0 <= norm2 x`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[norm2;euclid0_point];
+  ASM_MESON_TAC[d_euclid_pos;euclid_point];
+  (* Sat Aug  7 21:52:31 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let norm2_0 = prove_by_refinement(
+  `!x. (euclid 2 x) /\ (norm2 x = &0) <=> (x = euclid0)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  EQ_TAC;
+  REWRITE_TAC[norm2;euclid0_point;];
+  MESON_TAC[d_euclid_zero;euclid_point];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[euclid0_point;euclid_point;norm2;];
+  ASM_MESON_TAC[d_euclid_zero;euclid_point];
+  (* Sat Aug  7 21:59:11 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let cis_inj = prove_by_refinement(
+  `!t t'. (&0 <= t /\ t < &2*pi) /\ (&0 <= t' /\ t' < &2*pi) ==>
+      ((cis t = cis t') <=> (t = t'))`,
+  (* {{{ proof *)
+  [
+  (* A trivial direction *)
+  REP_BASIC_TAC;
+  REWRITE_TAC[cis;point_inj;PAIR_SPLIT ];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  EQ_TAC;
+  DISCH_THEN_REWRITE;
+  (* B  range of s *)
+  REP_BASIC_TAC;
+  TYPE_THEN `s = (\t. (if (t < pi) then t else ((&2)*pi - t)))` ABBREV_TAC ;
+  TYPE_THEN `!t. (&0 <= t /\ t < (&2 * pi)) ==> (&0 <= s t /\ s t <= pi)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  EXPAND_TAC "s";
+  COND_CASES_TAC;
+  UND 9;
+  UND 8;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  UND 7;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_MUL_2;];
+  UND 9;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* [C] : cos (s t) *)
+  TYPE_THEN `!t. cos (s t) = cos t` SUBGOAL_TAC;
+  EXPAND_TAC "s";
+  GEN_TAC;
+  COND_CASES_TAC;
+  REWRITE_TAC[];
+  REWRITE_TAC  [REAL_ARITH `x - t = (--. t + x)`;COS_PERIODIC;COS_NEG];
+  DISCH_TAC;
+  (* D : (s t) = (s t') *)
+  TYPE_THEN `(s t= s t') ==> ((t = t') \/ (t' = (&2 * pi - t)))` SUBGOAL_TAC;
+  EXPAND_TAC "s";
+  COND_CASES_TAC;
+  COND_CASES_TAC;
+  MESON_TAC[];
+  REAL_ARITH_TAC;
+  COND_CASES_TAC;
+  REAL_ARITH_TAC;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* E : show s t = s t' *)
+  USE 8 GSYM;
+  UND 5;
+  (ASM ONCE_REWRITE_TAC []);
+  DISCH_THEN (fun t -> MP_TAC (AP_TERM `acs` t));
+  DISCH_TAC;
+  TYPE_THEN `s t = s t'` SUBGOAL_TAC;
+  TYPE_THEN `acs (cos (s t)) = s t` SUBGOAL_TAC;
+  IMATCH_MP_TAC  COS_ACS;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `acs (cos (s t')) = s t'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  COS_ACS;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 9;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  UND 4;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[(REAL_ARITH `x - y = -- y + x`);SIN_PERIODIC ;SIN_NEG ;];
+  REWRITE_TAC [(REAL_ARITH `(x = --x) <=> (x = &0)`)];
+  REWRITE_TAC[SIN_ZERO_PI];
+  PROOF_BY_CONTR_TAC;
+  USE 4 (REWRITE_RULE[]);
+  (* now t is a MULT of pi, finish *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  REP_BASIC_TAC;
+  UND 2;
+  ASM_REWRITE_TAC[];
+  ASSUME_TAC PI_POS;
+  ASM_SIMP_TAC[REAL_LT_RMUL_EQ];
+  REWRITE_TAC  [REAL_LT];
+  REWRITE_TAC[ARITH_RULE  `n <| 2 <=> (n = 0) \/ (n =1)`];
+  DISCH_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  REWR 13;
+  REWR 11;
+  UND 0;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  UND 12;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  UND 3;
+  ASM_REWRITE_TAC[];
+  ASSUME_TAC PI_POS;
+  REWRITE_TAC[REAL_ARITH (` ~(&0 <= -- x) <=> (&0 <. x) `)];
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  ASM_REWRITE_TAC[REAL_LT ];
+  REWRITE_TAC[ARITH_RULE  `0 <| n <=> ~(n = 0)`];
+  DISCH_TAC;
+  UND 0;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  (* Sun Aug  8 08:42:13 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let norm2_scale_cis = prove_by_refinement(
+  `!x r. norm2(r *# cis(x)) = abs (r)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point;point_scale;];
+  REDUCE_TAC;
+  REWRITE_TAC[POW_MUL;GSYM REAL_LDISTRIB];
+  ONCE_REWRITE_TAC [REAL_ARITH `(x + y) = (y + x)`];
+  REWRITE_TAC[SIN_CIRCLE;REAL_MUL_RID;POW_2_SQRT_ABS];
+  (* Sun Aug  8 08:46:56 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let norm2_scale = prove_by_refinement(
+  `!x r. (euclid 2 x) ==> (norm2(r *# x) = abs (r)*norm2(x))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `?u v. (x = point(u,v))` SUBGOAL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  REP_BASIC_TAC;
+  TYPE_THEN `FST p` EXISTS_TAC;
+  TYPE_THEN `SND p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[norm2;cis;euclid0_point;d_euclid_point;point_scale;];
+  REDUCE_TAC;
+  REWRITE_TAC[POW_MUL;GSYM REAL_LDISTRIB];
+  REWRITE_TAC[GSYM POW_2_SQRT_ABS];
+  IMATCH_MP_TAC  SQRT_MUL;
+  REWRITE_TAC[REAL_LE_SQUARE_POW];
+  IMATCH_MP_TAC  (REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`);
+  REWRITE_TAC[REAL_LE_SQUARE_POW];
+
+  ]);;
+  (* }}} *)
+
+let polar_inj = prove_by_refinement(
+  `!x x' r r'. (&0 <= r) /\ (&0 <= r') /\ (&0 <= x) /\ (&0 <= x') /\
+     (x < &2 *pi) /\ (x' < &2 * pi) /\ (r *# cis(x) = r' *# cis(x')) ==>
+     ((r = &0) /\ (r' = &0)) \/ ((r = r') /\ (x = x'))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `abs  r = abs  r'` SUBGOAL_TAC;
+  FIRST_ASSUM (fun t -> MP_TAC (AP_TERM `norm2` t));
+  REWRITE_TAC[norm2_scale_cis];
+  DISCH_TAC;
+  TYPE_THEN `r' = r` SUBGOAL_TAC;
+  ASM_MESON_TAC[ABS_REFL];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_CASES_TAC `(r = &0)` ;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  REWR 0;
+  TYPE_THEN `cis x = cis x'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  euclid_scale_cancel;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[cis_inj];
+  ]);;
+
+  (* }}} *)
+
+let norm2_bounds = prove_by_refinement(
+  `!a b s t. (&0 < a) /\ (a < b) /\ (&0 <= t) /\ (t <= &1) ==>
+    (a <= norm2((a + t*(b-a))*# cis(s))) /\
+    ( norm2((a + t*(b-a))*# cis(s)) <= b) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[norm2_scale_cis];
+  TYPE_THEN `a <= a + t*(b - a)` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_ARITH `x <= x + y <=> (&0 <= y)`];
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  ASM_REWRITE_TAC[];
+  UND 2;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `&0 <= a + t*(b-a)` SUBGOAL_TAC;
+  UND 4;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `abs  (a + t*(b-a)) = a + t*(b-a)` SUBGOAL_TAC;
+  REWRITE_TAC[ABS_REFL];
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  ineq_le_tac `(a + t*(b-a)) + (&1 - t)*(b - a) = b`;
+  (* Sun Aug  8 09:12:18 EDT 2004  *)
+
+  ]);;
+  (* }}} *)
+
+let norm2_point = prove_by_refinement(
+  `!u v. norm2(point(u,v)) = sqrt(u pow 2 + v pow 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[norm2;euclid0_point;d_euclid_point;];
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let cis_exist_lemma = prove_by_refinement(
+  `!x. (euclid 2 x) /\ (norm2 x = &1) ==>
+    (? t. x =  cis(t))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `? u v. x = point (u,v)` SUBGOAL_TAC;
+  USE 1 (MATCH_MP point_onto);
+  REP_BASIC_TAC;
+  TYPE_THEN `FST p` EXISTS_TAC;
+  TYPE_THEN `SND p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REWR 0;
+  UND 0;
+  REWRITE_TAC[norm2_point];
+  DISCH_TAC;
+  USE 0 (fun t -> AP_TERM `\t. t pow 2` t);
+  UND 0;
+  BETA_TAC;
+  REDUCE_TAC;
+  TYPE_THEN `(sqrt (u pow 2 + v pow 2) pow 2 = u pow 2 + v pow 2)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SQRT_POW_2;
+  IMATCH_MP_TAC  (REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= x + y`);
+  ASM_REWRITE_TAC[REAL_LE_POW_2];
+  DISCH_THEN_REWRITE;
+  DISCH_THEN (fun t -> MP_TAC (MATCH_MP CIRCLE_SINCOS t));
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[cis];
+  MESON_TAC[];
+
+  ]);;
+  (* }}} *)
+
+let cos_period = prove_by_refinement(
+  `! j t. (cos (t + &j * &2 *pi) = cos(t))`,
+  (* {{{ proof *)
+  [
+  INDUCT_TAC;
+  REDUCE_TAC;
+  REWRITE_TAC[ADD1;GSYM REAL_ADD;REAL_ADD_RDISTRIB;REAL_ADD_ASSOC;];
+  REDUCE_TAC;
+  REWRITE_TAC[COS_PERIODIC];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let sin_period = prove_by_refinement(
+  `! j t. (sin (t + &j * &2 *pi) = sin(t))`,
+  (* {{{ proof *)
+  [
+  INDUCT_TAC;
+  REDUCE_TAC;
+  REWRITE_TAC[ADD1;GSYM REAL_ADD;REAL_ADD_RDISTRIB;REAL_ADD_ASSOC;];
+  REDUCE_TAC;
+  REWRITE_TAC[SIN_PERIODIC];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let cos_period_neg = prove_by_refinement(
+  `! j t. (cos (t - &j * &2 *pi) = cos(t))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASSUME_TAC cos_period;
+  TYPEL_THEN [`j`;`t - &j * &2 * pi`] (USE 0 o ISPECL);
+  RULE_ASSUM_TAC (REWRITE_RULE [REAL_ARITH `t - x + x = t`]);
+  USE 0 SYM;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let sin_period_neg = prove_by_refinement(
+  `! j t. (sin (t - &j * &2 *pi) = sin(t))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASSUME_TAC sin_period;
+  TYPEL_THEN [`j`;`t - &j * &2 * pi`] (USE 0 o ISPECL);
+  RULE_ASSUM_TAC (REWRITE_RULE [REAL_ARITH `t - x + x = t`]);
+  USE 0 SYM;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let cos_period_int = prove_by_refinement(
+  `!m t. (cos (t + real_of_int m * &2 *pi) = cos (t))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASSUME_TAC INT_REP2 ;
+  TSPEC `m` 0;
+  REP_BASIC_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[int_of_num_th;cos_period];
+  ASM_REWRITE_TAC[int_of_num_th;int_neg_th;cos_period_neg;GSYM real_sub;REAL_MUL_LNEG];
+  ]);;
+  (* }}} *)
+
+let sin_period_int = prove_by_refinement(
+  `!m t. (sin (t + real_of_int m * &2 *pi) = sin (t))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASSUME_TAC INT_REP2 ;
+  TSPEC `m` 0;
+  REP_BASIC_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[int_of_num_th;sin_period];
+  ASM_REWRITE_TAC[int_of_num_th;int_neg_th;sin_period_neg;GSYM real_sub;REAL_MUL_LNEG];
+  ]);;
+  (* }}} *)
+
+let cos_sin_reduce = prove_by_refinement(
+  `!t. ?t'. (cos t = cos t') /\
+      (sin t = sin t') /\ (&0 <= t') /\ (t' < &2 * pi)`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+    ASSUME_TAC floor_ineq;
+  TSPEC `t/(&2 *pi)` 0;
+  TYPE_THEN `f = floor (t/(&2 * pi))` ABBREV_TAC ;
+  REP_BASIC_TAC;
+  TYPE_THEN `t' = t - real_of_int(f)*(&2)*pi` ABBREV_TAC  ;
+  TYPE_THEN `t'` EXISTS_TAC;
+  TYPE_THEN `t' = t + real_of_int (--: f) *(&2)*pi` SUBGOAL_TAC;
+  EXPAND_TAC "t'";
+  REWRITE_TAC[REAL_ARITH `x -y = x + (-- y)`;REAL_ARITH `-- (x * y) = (-- x)*y`;GSYM int_neg_th];
+  DISCH_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[cos_period_int];
+  CONJ_TAC;
+  ASM_REWRITE_TAC[sin_period_int];
+  EXPAND_TAC "t'";
+  TYPE_THEN `&0 < (&2 *pi)` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_MUL_2];
+  MP_TAC PI_POS;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `~(&0 = &2* pi)` SUBGOAL_TAC;
+  UND 5;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `t = (t/(&2 *pi))*(&2 *pi)` SUBGOAL_TAC;
+  ASM_SIMP_TAC[REAL_DIV_RMUL];
+  DISCH_TAC;
+  USE 7 SYM ;
+  TYPE_THEN `&0 <= (t/(&2*pi))*(&2*pi) - real_of_int f * (&2*pi)` SUBGOAL_TAC;
+  REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  UND 2;
+  UND 5;
+  REAL_ARITH_TAC;
+    KILL 4;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  EXPAND_TAC "t'";
+  TYPE_THEN ` (t/(&2*pi))*(&2*pi) - real_of_int f * (&2*pi) < &1* &2*pi` SUBGOAL_TAC;
+  REWRITE_TAC[GSYM REAL_SUB_RDISTRIB];
+  IMATCH_MP_TAC  REAL_LT_RMUL;
+  UND 0;
+  UND 5;
+  REAL_ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  (* Tue Aug 10 09:57:36 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let cis_lemma = prove_by_refinement(
+  `!x. (euclid 2 x) /\ (norm2 x = &1) ==>
+    (?t. &0 <= t /\ t < &2 * pi /\ (x = cis t))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(?t. x = cis t)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cis_exist_lemma;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASSUME_TAC cos_sin_reduce;
+  TSPEC `t` 3;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[cis;point_inj;PAIR_SPLIT];
+  ASM_MESON_TAC[];
+  (* Tue Aug 10 10:01:55 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let polar_exist = prove_by_refinement(
+  `!x. (euclid 2 x) ==>
+    (?r t. (&0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = r *# cis(t))))`,
+  (* {{{ proof *)
+  [
+  (* A: trivial case of norm 0 *)
+  REP_BASIC_TAC;
+  ASM_CASES_TAC `norm2 x = &0` ;
+  TYPE_THEN `x = euclid0` SUBGOAL_TAC;
+  ASM_MESON_TAC[norm2_0];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `&0` EXISTS_TAC;
+  TYPE_THEN `&0` EXISTS_TAC;
+  REWRITE_TAC[euclid_scale0;REAL_MUL_2 ];
+  MP_TAC PI_POS;
+  REAL_ARITH_TAC;
+  (* B: rescale to 1 *)
+  TYPE_THEN `&0 < norm2 x` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `~(x = &0) /\ (&0 <= x) ==> (&0 < x)`);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  norm2_nn;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `r = norm2 x ` ABBREV_TAC ;
+  DISCH_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  TYPE_THEN `y = (&1/r)*# x` ABBREV_TAC ;
+  TYPE_THEN `x = r*# y` SUBGOAL_TAC;
+  EXPAND_TAC "y";
+  REWRITE_TAC[euclid_scale_act;GSYM real_div_assoc];
+  REDUCE_TAC;
+  ASM_SIMP_TAC[REAL_DIV_REFL; euclid_scale_one;];
+  DISCH_TAC;
+  REWR 2;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `euclid 2 y` SUBGOAL_TAC;
+  EXPAND_TAC "y";
+  IMATCH_MP_TAC  euclid_scale_closure;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  UND 2;
+  ASM_SIMP_TAC[norm2_scale];
+  TYPE_THEN `abs  r = r` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_ABS_REFL];
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  TYPE_THEN `norm2 y = &1` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_EQ_LCANCEL_IMP;
+  TYPE_THEN `r` EXISTS_TAC;
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* C: invoke norm2=1 case *)
+  TYPE_THEN `(?t. &0 <= t /\ t < &2 * pi /\ (y = cis t))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cis_lemma;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 3;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+(*
+vert r = hyperplane 2 e1 r
+horz r = hyperplane 2 e2 r
+cf. line2D_F..., line2D_S....
+*)
+
+let subset_union_pair = prove_by_refinement(
+  `!(A:A->bool) B A' B'. (A SUBSET A') /\ (B SUBSET B') ==>
+       (A UNION B) SUBSET (A' UNION B')`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let subset_inter_pair = prove_by_refinement(
+  `!(A:A->bool) B A' B'. (A SUBSET A') /\ (B SUBSET B') ==>
+       (A INTER B) SUBSET (A' INTER B')`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;INTER];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_simple = prove_by_refinement(
+  `!C v v'. simple_arc_end C v v' ==> simple_arc top2 C`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc_end;simple_arc];
+  REP_BASIC_TAC;
+  REWRITE_TAC[top2_unions];
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Tue Aug 10 10:33:30 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_restriction = prove_by_refinement(
+  `!C K K' . simple_arc top2 C /\ closed_ top2 K /\
+      closed_ top2 K' /\ (C INTER K INTER K' = EMPTY ) /\
+     ~(C INTER K = EMPTY ) /\ ~(C INTER K' = EMPTY) ==>
+    (?C' v v'.   C' SUBSET C /\ simple_arc_end C' v v' /\
+         (C' INTER K = {v}) /\ (C' INTER K' = {v'})) `,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(?C' f. (C' = IMAGE f {x | &0 <= x /\ x <= &1 }) /\ C' SUBSET C /\  continuous f (top_of_metric (UNIV,d_real)) top2 /\  INJ f {x | &0 <= x /\ x <= (&1)} (euclid 2) /\  (C' INTER K = {(f (&0))}) /\  (C' INTER K' = {(f (&1))}))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  curve_restriction;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `f(&0)` EXISTS_TAC;
+  TYPE_THEN `f(&1)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[simple_arc_end];
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let simple_arc_end_trans  = prove_by_refinement(
+  `!C C' v v' v'' . simple_arc_end C v v' /\ simple_arc_end C' v' v'' /\
+   ( C INTER C' = {v'}) ==>
+    simple_arc_end (C UNION C') v v''`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc_end];
+  REP_BASIC_TAC;
+  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\  &0 < &1/(&2) /\  &0 < &1` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
+  REP_BASIC_TAC;
+  KILL 12;
+  TYPE_THEN `continuous f' (top_of_metric (UNIV,d_real)) top2 /\ INJ f' {x | &0 <= x /\ x <= &1} (euclid 2) /\  &1/(&2) < &1 /\  &0 < &1` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_LT_HALF2];
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
+  REP_BASIC_TAC;
+  KILL 17;
+  TYPE_THEN `joinf g g' (&1/(&2))` EXISTS_TAC;
+  (* A: prelims *)
+  TYPE_THEN `&0 < &1/(&2) /\ &1/(&2) < &1` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_LT_HALF1;REAL_LT_HALF2];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM union_closed_interval);
+  UND 17;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `{x | &0 <= x /\ x < &1} SUBSET {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `{x | &0 <= x /\ x < &1 / &2} SUBSET {x | x < &1/(&2)}` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `{x | &1 / &2 <= x /\ x <= &1} SUBSET {x | &1/ (&2) <= x}` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)} = {x | &0 <= x /\ x < &1/(&2)} UNION {(&1 /(&2))}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;INR IN_SING ];
+  GEN_TAC;
+  UND 17;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `g (&1/(&2)) = g' (&1/(&2))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  (* [B]: IMAGE *)
+  SUBCONJ_TAC;
+  ASM_REWRITE_TAC[IMAGE_UNION];
+  ASM_SIMP_TAC[joinf_image_above;joinf_image_below];
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  CONJ_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET_UNION];
+   REWRITE_TAC[SUBSET;UNION];
+  REWRITE_TAC[IMAGE;INR IN_SING;];
+  NAME_CONFLICT_TAC;
+  ASM_REWRITE_TAC[];
+  CONV_TAC (dropq_conv "x''");
+  GEN_TAC;
+  DISCH_THEN_REWRITE;
+  UND 27;
+  DISCH_THEN_REWRITE;
+  DISJ2_TAC ;
+  TYPE_THEN `&1/(&2)` EXISTS_TAC;
+  REWRITE_TAC[];
+  UND 17;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[SUBSET_UNION];
+  (* --2-- *)
+  USE 26 SYM;
+  ASM_REWRITE_TAC[GSYM IMAGE_UNION];
+  REWRITE_TAC[union_subset];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  ASM_REWRITE_TAC[SUBSET;];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[SUBSET_UNION];
+  REWRITE_TAC[SUBSET_UNION];
+  DISCH_TAC;
+  (* [C]: cont,INJ *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  joinf_cont;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  inj_split;
+  ASM_SIMP_TAC[joinf_inj_above;joinf_inj_below];
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_UNION];
+  (* --2-- *)
+  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
+  ASM_SIMP_TAC[joinf_image_below];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x <= &1} = IMAGE g' {x | &1 / &2 <= x /\ x <= &1}` SUBGOAL_TAC;
+  ASM_SIMP_TAC[joinf_image_above];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1 / &2} INTER IMAGE g' {x | &1 / &2 <= x /\ x <= &1} SUBSET {v'}` SUBGOAL_TAC;
+  UND 0;
+  DISCH_THEN (fun t -> REWRITE_TAC[SYM t]);
+  USE 26 GSYM;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  ASM_REWRITE_TAC[SUBSET ];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1 /(&2)} INTER {v'} = EMPTY` SUBGOAL_TAC;
+  REWRITE_TAC[EQ_EMPTY];
+  GEN_TAC;
+  REWRITE_TAC[IMAGE;INTER;INR IN_SING;DE_MORGAN_THM;];
+  NAME_CONFLICT_TAC;
+  LEFT_TAC  "x'";
+  IMATCH_MP_TAC  (TAUT `(B ==> A)    ==> A \/ ~B`);
+  DISCH_THEN_REWRITE;
+  GEN_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `x' = &1/(&2)` SUBGOAL_TAC;
+  USE 15 (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  USE 27 GSYM;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `g x' = g(&1/(&2))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  UND 30;
+  UND 33;
+  REAL_ARITH_TAC;
+  UND 30;
+  REAL_ARITH_TAC;
+  UND 29;
+  REWRITE_TAC[SUBSET;EQ_EMPTY ;INTER;INR IN_SING;];
+  POP_ASSUM_LIST (fun t -> ALL_TAC);
+  REP_BASIC_TAC;
+  TSPEC  `x` 3;
+  REWR 3;
+  TSPEC `x` 2;
+  REWR 2;
+  (* [D] final touches *)
+  CONJ_TAC;
+  REWRITE_TAC[joinf];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[joinf];
+  ASM_SIMP_TAC [REAL_ARITH `&1/(&2) < &1 ==> (&1 < &1/ &2 <=> F)`];
+  ASM_MESON_TAC[];
+  (* Tue Aug 10 13:15:07 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let continuous_uninduced = prove_by_refinement(
+  `!(f:A->B) U V Y.
+     continuous f U (induced_top V Y) /\ IMAGE f (UNIONS U) SUBSET Y
+     ==> continuous f U V`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[continuous;];
+  REP_BASIC_TAC;
+  TSPEC `v INTER Y` 2;
+  TYPE_THEN `induced_top V Y (v INTER Y)` SUBGOAL_TAC;
+  REWRITE_TAC[induced_top;IMAGE;];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWR 2;
+  UND 2;
+  REWRITE_TAC [preimage;INTER];
+  TYPE_THEN `{x | UNIONS U x /\ v (f x) /\ Y (f x)} = {x | UNIONS U x /\ v (f x)}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  GEN_TAC;
+  TYPE_THEN `UNIONS U x ==> Y (f x)` SUBGOAL_TAC;
+  UND 1;
+  REWRITE_TAC[IMAGE;SUBSET];
+  MESON_TAC[];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  (* Tue Aug 10 19:11:27 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_homeo = prove_by_refinement(
+  `!X d (C:A->bool). (simple_arc (top_of_metric(X,d)) C) /\
+        (metric_space(X,d)) ==>
+    (?f. homeomorphism f
+   (top_of_metric({x | &0 <= x /\ x <= &1},d_real))
+            (top_of_metric(C,d)))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[simple_arc];
+  REP_BASIC_TAC;
+  TYPE_THEN `(UNIONS (top_of_metric(X,d)) = X) ` SUBGOAL_TAC;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  DISCH_TAC;
+  REWR 1;
+  (* -- *)
+  TYPE_THEN `C SUBSET X` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  inj_image_subset;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN ` (UNIONS (top_of_metric(C,d)) = C)` SUBGOAL_TAC;
+  KILL 3;
+  ASM_MESON_TAC [GSYM top_of_metric_unions;metric_subspace];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET_UNIV];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_subspace;
+  TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
+  ASM_REWRITE_TAC[metric_real];
+  DISCH_TAC;
+  (* -- *)
+  ASSUME_TAC metric_real;
+  (* -- *)
+  TYPE_THEN `compact (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
+  TYPEL_THEN [`UNIV:real->bool`;`{x| &0 <= x /\ x <= &1}`;`d_real`] (fun t-> ASSUME_TAC (ISPECL t compact_subset));
+  REWR 10;
+  USE 10 SYM;
+  ASM_REWRITE_TAC[interval_compact];
+  DISCH_TAC;
+  (* -- *)
+  USE 3 GSYM ;
+  (* -- *)
+  (* A: show homeomorphism *)
+  TYPE_THEN `f` EXISTS_TAC;
+    IMATCH_MP_TAC  hausdorff_homeomorphsim;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  ASM_SIMP_TAC[top_of_metric_top;metric_subspace];
+  (* -- *)
+    TYPE_THEN `metric_space (C,d)` SUBGOAL_TAC;
+  ASM_MESON_TAC [metric_subspace];
+  DISCH_TAC;
+  TYPE_THEN `IMAGE f {x| &0 <= x /\ x <= &1} SUBSET C` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL ];
+  DISCH_TAC;
+  TYPE_THEN `IMAGE f {x| &0 <= x /\ x <= &1} SUBSET X` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* B: final obligations *)
+  CONJ_TAC;
+  EXPAND_TAC "C";
+  IMATCH_MP_TAC  inj_bij;
+  UND 1;
+  REWRITE_TAC[INJ];
+  MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `induced_top (top_of_metric (UNIV,d_real)) {x| &0 <= x /\ x <= &1} {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
+  ASM_SIMP_TAC[top_of_metric_induced];
+  TYPE_THEN `topology_ (top_of_metric ({x | &0 <= x /\ x <= &1},d_real))` SUBGOAL_TAC;
+  ASM_SIMP_TAC[top_of_metric_top];
+  DISCH_THEN (fun t-> MP_TAC (MATCH_MP top_univ t));
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  DISCH_TAC;
+  TYPE_THEN `continuous f (induced_top (top_of_metric (UNIV,d_real)) {x | &0 <= x /\ x <= &1}) (top_of_metric(X,d))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  continuous_induced_domain;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
+  ASM_SIMP_TAC[metric_real;top_of_metric_induced];
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_subspace];
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  DISCH_THEN_REWRITE;
+  ASM_SIMP_TAC[top_of_metric_top];
+  IMATCH_MP_TAC  metric_hausdorff;
+  ASM_REWRITE_TAC[];
+  (* Tue Aug 10 20:34:30 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let continuous_metric_extend = prove_by_refinement(
+  `!(f:A->B) U C X d. (metric_space(X,d) /\
+      continuous f U (top_of_metric (C,d)) /\
+          IMAGE f (UNIONS U) SUBSET C /\ C SUBSET X ==>
+    continuous f U (top_of_metric(X,d)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `metric_space(C,d)` SUBGOAL_TAC;
+  IMATCH_MP_TAC metric_subspace;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `top_of_metric(C,d) = induced_top(top_of_metric(X,d)) C` SUBGOAL_TAC;
+  ASM_SIMP_TAC[top_of_metric_induced];
+  DISCH_TAC;
+  REWR 2;
+  IMATCH_MP_TAC  continuous_uninduced;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Tue Aug 10 20:47:53 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_distinct = prove_by_refinement(
+  `!C v v'. simple_arc_end C v v' ==> ~(v = v')`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc_end;INJ];
+  REP_BASIC_TAC;
+  TYPE_THEN `&0 = &1` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `f (&0)  = f(&1)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  REAL_ARITH_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let bij_imp_image = prove_by_refinement(
+  `!(f:A->B) X Y. BIJ f X Y ==> (IMAGE f X = Y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[BIJ;SURJ];
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let homeo_inj = prove_by_refinement(
+  `!(f:A->B) U C X d. (homeomorphism f U (top_of_metric(C,d))) /\
+     (C SUBSET X) /\ (metric_space (X,d)) ==>
+    ( continuous f U (top_of_metric(X,d)) /\ INJ f (UNIONS U) C /\
+      (IMAGE f (UNIONS U) = C))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[homeomorphism];
+  REP_BASIC_TAC;
+  TYPE_THEN`metric_space(C,d)` SUBGOAL_TAC;
+  ASM_MESON_TAC [metric_subspace];
+  DISCH_TAC;
+  (* -- *)
+  UND 4;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `IMAGE f (UNIONS U)= C` SUBGOAL_TAC;
+  IMATCH_MP_TAC  bij_imp_image ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  continuous_metric_extend;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL ];
+  (* Tue Aug 10 20:58:37 EDT 2004 *)
+
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_coord = prove_by_refinement(
+  `!X d (C:A->bool). (simple_arc (top_of_metric(X,d)) C) /\
+        (metric_space(X,d)) ==>
+    (?f.
+  (continuous f (top_of_metric(C,d)) (top_of_metric(UNIV,d_real))) /\
+  (INJ f C UNIV) /\
+  (IMAGE f C = {x | &0 <= x /\ x <= &1}))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `(UNIONS (top_of_metric(X,d)) = X) ` SUBGOAL_TAC;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `C SUBSET X` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[simple_arc]);
+  REP_BASIC_TAC;
+  USE 4 GSYM;
+  REWR 1;
+  EXPAND_TAC "C";
+  IMATCH_MP_TAC  inj_image_subset;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN ` (UNIONS (top_of_metric(C,d)) = C)` SUBGOAL_TAC;
+  ASM_MESON_TAC [GSYM top_of_metric_unions;metric_subspace];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET_UNIV];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_subspace;
+  TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
+  ASM_REWRITE_TAC[metric_real];
+  DISCH_TAC;
+  (* -- *)
+  ASSUME_TAC metric_real;
+  (* -- *)
+  TYPE_THEN `(?f. homeomorphism f (top_of_metric({x | &0 <= x /\ x <= &1},d_real)) (top_of_metric(C,d)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_homeo;
+  TYPE_THEN `X` EXISTS_TAC; (* // *)
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN ` g = (INV f  ({x | &0 <= x /\ x <= &1}) (C:A->bool))` ABBREV_TAC ;
+  TYPE_THEN `g = INV f  (UNIONS((top_of_metric({x | &0 <= x /\ x <= &1},d_real)))) (UNIONS((top_of_metric(C,d))))` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[GSYM  top_of_metric_unions;metric_subspace;];
+  DISCH_TAC;
+  (* A: *)
+  TYPE_THEN `g` EXISTS_TAC;
+  (* -- *)
+  (* TYPE_THEN `U = top_of_metric({x | &0 <= x /\ x <= &1},d_real)` ABBREV_TAC ; *)
+  TYPE_THEN `(homeomorphism g (top_of_metric(C,d)) (top_of_metric({x | &0 <= x /\ x <= &1},d_real))) /\ ({x | &0 <= x /\ x <= &1} SUBSET UNIV) /\ (metric_space (UNIV,d_real))` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  TYPEL_THEN [`f`;`(top_of_metric({x | &0 <= x /\ x <= &1},d_real))`;`top_of_metric(C,d)`] (fun t-> ASSUME_TAC (ISPECL t homeomorphism_inv));
+  REWR 11;
+  DISCH_TAC;
+    USE 11 (MATCH_MP homeo_inj);
+  REP_BASIC_TAC;
+  KILL 9;
+  KILL 10;
+  ASM_REWRITE_TAC[];
+  UND 11;
+  UND 12;
+  ASM_REWRITE_TAC[];
+  UND 5;
+  POP_ASSUM_LIST (fun t-> ALL_TAC);
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[INJ_UNIV];
+  (* Tue Aug 10 21:49:22 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+(* slow! *)
+let image_interval = prove_by_refinement(
+  `!a b f. (a < b) /\
+   (continuous f (top_of_metric(UNIV,d_real))
+        (top_of_metric( UNIV,d_real)))  /\
+    (INJ f {x | a <= x /\ x <= b} UNIV) ==>
+   (?c d. (c < d) /\ ({ c , d} = {(f a),(f b)}) /\
+    (IMAGE f {x | a <= x /\ x <= b} =
+       {x | c <= x /\ x <= d})
+     ) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  (* -- *)
+  ASSUME_TAC connect_real;
+  TYPE_THEN `!a b. connected (top_of_metric(UNIV,d_real)) (IMAGE f {x |  a<= x /\ x <= b})` SUBGOAL_TAC;
+  REP_GEN_TAC;
+  IMATCH_MP_TAC  connect_image;
+  TYPE_THEN `top_of_metric(UNIV,d_real)` EXISTS_TAC ;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_real];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `c = min_real (f a) (f b)` ABBREV_TAC ;
+  TYPE_THEN `d = max_real (f a) (f b)` ABBREV_TAC ;
+  TYPE_THEN `c`EXISTS_TAC;
+  TYPE_THEN `d` EXISTS_TAC;
+  TYPE_THEN `~(f a = f b)` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  TYPE_THEN `a = b` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 2;
+  REAL_ARITH_TAC;
+  UND 2;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* -- *)
+  SUBCONJ_TAC;
+  EXPAND_TAC "d";
+  EXPAND_TAC "c";
+  REWRITE_TAC[min_real;max_real];
+  TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC;
+  UND 7;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `~(f b < f a)` SUBGOAL_TAC;
+  UND 8;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `~(f a < f b)` SUBGOAL_TAC;
+  UND 8;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[in_pair];
+  EXPAND_TAC "d";
+  EXPAND_TAC "c";
+  REWRITE_TAC[max_real;min_real];
+  TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC;
+  UND 7;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `~(f b < f a)` SUBGOAL_TAC;
+  UND 9;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `~(f a < f b)` SUBGOAL_TAC;
+  UND 9;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  MESON_TAC[];
+  DISCH_TAC;
+  (* B *)
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  connected_nogap;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "c";
+  EXPAND_TAC "d";
+  REWRITE_TAC[max_real;min_real];
+  TYPE_THEN `f a < f b \/ f b < f a` SUBGOAL_TAC;
+  UND 7;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `~(f b < f a)` SUBGOAL_TAC;
+  UND 10;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_MESON_TAC[REAL_ARITH `a<= a`;REAL_ARITH `a < b ==> a <= b`];
+  TYPE_THEN `~(f a < f b)` SUBGOAL_TAC;
+  UND 10;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_MESON_TAC[REAL_ARITH `a<= a`;REAL_ARITH `a < b ==> a <= b`];
+  DISCH_TAC;
+  (* C set up cases *)
+  REWRITE_TAC[IMAGE;SUBSET;];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USE 14 (REWRITE_RULE[DE_MORGAN_THM]);
+  USE 9 (REWRITE_RULE[FUN_EQ_THM;in_pair ]);
+  TYPE_THEN `((c = f a) /\ (d = f b)) \/ ((c = f b) /\ (d = f a))` SUBGOAL_TAC;
+  UND 9;
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `f x' < c \/ d < f x'` SUBGOAL_TAC;
+  UND 14;
+  ARITH_TAC;
+  DISCH_TAC;
+  KILL 9;
+  KILL 14;
+  KILL 11;
+  (* D generic case *)
+  TYPE_THEN `!r s t. (a <= r /\ r <= b /\ a <= s /\ s <= b /\ a <= t /\ t <= b /\ (r < t) /\ (f r < f s) /\ (f s < f t) ==> (r < s /\ s < t))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPEL_THEN [`r`;`t`] (USE 4 o ISPECL);
+  USE 4(REWRITE_RULE[connected]);
+  REP_BASIC_TAC;
+  TYPE_THEN `IMAGE f {x | r <= x /\ x <= t} SUBSET {x | x < f s} \/ IMAGE f {x | r <= x /\ x <= t} SUBSET {x | f s < x}` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[half_open;half_open_above;EQ_EMPTY;INTER;];
+  CONJ_TAC;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;UNION;];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC (REAL_ARITH  `~(f x'' = f s) ==> (f x'' < f s \/ f s < f x'')` );
+  DISCH_TAC;
+  TYPE_THEN `x'' = s` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 26;
+  UND 27;
+  UND 22;
+  UND 17;
+  REAL_ARITH_TAC;
+  UND 9;
+  UND 11;
+  UND 23;
+  UND 26;
+  UND 27;
+  POP_ASSUM_LIST (fun t-> ALL_TAC);
+  REP_BASIC_TAC;
+  TYPE_THEN `~(r = s)` SUBGOAL_TAC;
+  ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
+  TYPE_THEN `~(s = t)` SUBGOAL_TAC;
+  ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
+  KILL 1;
+  KILL 2;
+  UND 0;
+  UND 3;
+  UND 4;
+  UND 5;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[DE_MORGAN_THM ];
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;];
+  LEFT_TAC "x";
+  TYPE_THEN `f t` EXISTS_TAC;
+  LEFT_TAC "x'";
+  REP_BASIC_TAC;
+  TSPEC `t` 25;
+  UND 25;
+  UND 9;
+  UND 14;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;];
+  LEFT_TAC "x";
+  TYPE_THEN `f r` EXISTS_TAC;
+  REP_BASIC_TAC;
+  LEFT 25 "x'" ;
+  TSPEC `r` 25;
+  UND 25;
+  UND 14;
+  UND 11;
+  REAL_ARITH_TAC;
+  (* D' generic case *)
+  TYPE_THEN `!r s t. (a <= r /\ r <= b /\ a <= s /\ s <= b /\ a <= t /\ t <= b /\ (t < r) /\ (f r < f s) /\ (f s < f t) ==> (t < s /\ s < r))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPEL_THEN [`t`;`r`] (USE 4 o ISPECL);
+  USE 4(REWRITE_RULE[connected]);
+  REP_BASIC_TAC;
+  TYPE_THEN `IMAGE f {x | t <= x /\ x <= r} SUBSET {x | x < f s} \/ IMAGE f {x | t <= x /\ x <= r} SUBSET {x | f s < x}` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[half_open;half_open_above;EQ_EMPTY;INTER;];
+  CONJ_TAC;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;UNION;];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC (REAL_ARITH  `~(f x'' = f s) ==> (f x'' < f s \/ f s < f x'')` );
+  DISCH_TAC;
+  TYPE_THEN `x'' = s` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 26;
+  UND 27;
+  UND 18;
+  UND 21;
+  REAL_ARITH_TAC;
+  UND 9;
+  UND 11;
+  UND 23;
+  UND 26;
+  UND 27;
+  POP_ASSUM_LIST (fun t-> ALL_TAC);
+  REP_BASIC_TAC;
+  TYPE_THEN `~(r = s)` SUBGOAL_TAC;
+  ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
+  TYPE_THEN `~(s = t)` SUBGOAL_TAC;
+  ASM_MESON_TAC[REAL_ARITH `a < b ==> ~(a=b)`];
+  KILL 1;
+  KILL 2;
+  UND 0;
+  UND 3;
+  UND 4;
+  UND 5;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[DE_MORGAN_THM ];
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;];
+  LEFT_TAC "x";
+  TYPE_THEN `f t` EXISTS_TAC;
+  LEFT_TAC "x'";
+  REP_BASIC_TAC;
+  TSPEC `t` 25;
+  UND 25;
+  UND 9;
+  UND 14;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;];
+  LEFT_TAC "x";
+  TYPE_THEN `f r` EXISTS_TAC;
+  REP_BASIC_TAC;
+  LEFT 25 "x'" ;
+  TSPEC `r` 25;
+  UND 25;
+  UND 14;
+  UND 11;
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  (* end generic  *)
+  KILL 4;
+  KILL 3;
+  KILL 0;
+  KILL 1;
+  KILL 10;
+  KILL 6;
+  KILL 5;
+  (* E: actual cases *)
+  UND 16;
+  UND 15;
+  REP_CASES_TAC;
+  (* --2a-- *)
+  KILL 11;
+  TYPEL_THEN[`x'`;`a`;`b`] (USE 9 o ISPECL);
+  TYPE_THEN `~(f x' = f b)` SUBGOAL_TAC;
+  REPEAT (POP_ASSUM MP_TAC);
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `~(x' = b)` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  REPEAT (POP_ASSUM MP_TAC);
+  REAL_ARITH_TAC;
+  (* --2b-- *)
+  KILL 11;
+  TYPEL_THEN [`a`;`b`;`x'`] (USE 9 o ISPECL);
+  TYPE_THEN `~(f a = f x')` SUBGOAL_TAC;
+  REPEAT (POP_ASSUM MP_TAC);
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `~(a = x')` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  REPEAT (POP_ASSUM MP_TAC);
+  REAL_ARITH_TAC;
+  (* --2c-- *)
+  KILL 9;
+  TYPEL_THEN [`x'`;`b`;`a`] (USE 11 o ISPECL);
+  TYPE_THEN `~(f x' = f a)` SUBGOAL_TAC;
+  REPEAT (POP_ASSUM MP_TAC);
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `~(a = x')` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  REPEAT (POP_ASSUM MP_TAC);
+  REAL_ARITH_TAC;
+  (* --2d-- *)
+  KILL 9;
+  TYPEL_THEN [`b`;`a`;`x'`] (USE 11 o ISPECL);
+  TYPE_THEN `~(f x' = f b)` SUBGOAL_TAC;
+  REPEAT (POP_ASSUM MP_TAC);
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `~(b = x')` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  REPEAT (POP_ASSUM MP_TAC);
+  REAL_ARITH_TAC;
+  (* Wed Aug 11 09:36:14 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let metric_continuous_range = prove_by_refinement(
+  `!(f:A->B) X dX Y dY Y'.
+   metric_continuous f (X,dX) (Y,dY) <=>
+   metric_continuous f (X,dX) (Y',dY)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  ]);;
+  (* }}} *)
+
+let continuous_range = prove_by_refinement(
+  `!(f:A->B) X dX Y dY Y'.
+   metric_space(X,dX) /\ metric_space(Y,dY) /\ metric_space(Y',dY) /\
+   continuous f (top_of_metric(X,dX)) (top_of_metric(Y,dY)) /\
+   IMAGE f X SUBSET Y /\ IMAGE f X SUBSET Y' ==>
+   continuous f (top_of_metric(X,dX)) (top_of_metric(Y',dY))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `continuous f (top_of_metric (X,dX)) (top_of_metric (Y',dY)) = metric_continuous f (X,dX) (Y',dY)`  SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_continuous_continuous;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `continuous f (top_of_metric (X,dX)) (top_of_metric (Y,dY)) = metric_continuous f (X,dX) (Y,dY)`  SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_continuous_continuous;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  REWR 2;
+  ASM_MESON_TAC[metric_continuous_range];
+  ]);;
+  (* }}} *)
+
+let metric_continuous_domain = prove_by_refinement(
+  `!(f:A->B) X dX Y dY Y' A.
+   metric_continuous f (X,dX) (Y,dY) /\ A SUBSET X ==>
+  metric_continuous f (A,dX) (Y',dY)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[metric_continuous;metric_continuous_pt;SUBSET];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let pair_order_endpoint = prove_by_refinement(
+  `!a b c d . (c < d) /\ ({c , d} = {a ,b}) ==>
+    (c = min_real a b) /\ (d = max_real a b)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  USE 0 (REWRITE_RULE[FUN_EQ_THM;in_pair]);
+  TYPE_THEN `((c = a) /\ (d = b)) \/ ((c = b) /\ (d = a))` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  REWR 1;
+  ASM_REWRITE_TAC[min_real;max_real];
+  ASM_SIMP_TAC[REAL_ARITH `a < b ==> ~(b < a)`];
+  ASM_REWRITE_TAC[];
+  REWR 1;
+  ASM_REWRITE_TAC[min_real;max_real];
+  ASM_SIMP_TAC[REAL_ARITH `a < b ==> ~(b < a)`];
+  ]);;
+  (* }}} *)
+
+let cont_extend_real_lemma = prove_by_refinement(
+  `!a b (f:real->A) Y dY. (a < b) /\
+   (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
+     (top_of_metric(Y,dY))) /\ (metric_space(Y,dY)) /\
+   IMAGE f {x | a <= x /\ x <= b} SUBSET Y ==>
+  (
+   ?g. (continuous g (top_of_metric(UNIV,d_real))
+   (top_of_metric(Y,dY))) /\
+     (!x. (a <= x /\ x <= b) ==> (f x = g x)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `?t. (a < t /\ t < b)` SUBGOAL_TAC;
+  TYPE_THEN `(a+b)/(&2)` EXISTS_TAC;
+  ASM_MESON_TAC[real_middle1_lt;real_middle2_lt];
+  REP_BASIC_TAC;
+  ASSUME_TAC metric_real;
+  TYPE_THEN `{x | a <= x /\ x <= b} SUBSET UNIV` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[SUBSET_UNIV];
+  DISCH_TAC;
+  TYPE_THEN `metric_space ({x | a <= x /\ x <= b},d_real)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_subspace;
+  TYPE_THEN `UNIV:real->bool` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `metric_continuous f ({x | a <= x /\ x <= b},d_real) (Y,dY)` SUBGOAL_TAC;
+  UND 2;
+  ASM_SIMP_TAC [metric_continuous_continuous];
+  DISCH_TAC;
+  TYPE_THEN `A = {x | x <= a}` ABBREV_TAC ;
+  TYPE_THEN `B = {x | b <= x}` ABBREV_TAC ;
+  TYPE_THEN `fA  = (\(t:real). f a)` ABBREV_TAC ;
+  TYPE_THEN `fB = (\(t:real). f b)` ABBREV_TAC ;
+  ASSUME_TAC half_closed;
+  ASSUME_TAC half_closed_above;
+  (* -- *)
+  TYPE_THEN `!r A. (Y r) ==> (metric_continuous (\t. r) (A,d_real) (Y,dY))` SUBGOAL_TAC;
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  REP_BASIC_TAC;
+  RIGHT_TAC "delta";
+  REP_BASIC_TAC;
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[metric_space_zero];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `metric_continuous (subf A fA fB) (A UNION B,d_real) (Y,dY)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  subf_cont;
+  TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "A";
+  EXPAND_TAC "B";
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "fA";
+  EXPAND_TAC "fB";
+  TYPE_THEN `!x. x <= a /\ b <= x <=> F` SUBGOAL_TAC;
+  UND 3;
+  REAL_ARITH_TAC ;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `Y (f a) /\ Y(f b)` SUBGOAL_TAC;
+  UND 0;
+  REWRITE_TAC[IMAGE;SUBSET];
+  TYPE_THEN `a <= a /\ a <= b /\ b <= b` SUBGOAL_TAC;
+  UND 3;
+  REAL_ARITH_TAC;
+  MESON_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `A' = A UNION B` ABBREV_TAC ;
+  TYPE_THEN `B' = {x | a <= x /\ x <= b}` ABBREV_TAC ;
+  TYPE_THEN `fA' = subf A fA fB` ABBREV_TAC ;
+  TYPE_THEN `metric_continuous (subf A' fA' f) (A' UNION B',d_real) (Y,dY)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  subf_cont;
+  TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "A'";
+  EXPAND_TAC "B'";
+  CONJ_TAC;
+  IMATCH_MP_TAC  closed_union;
+  EXPAND_TAC "A";
+  EXPAND_TAC "B";
+  ASM_SIMP_TAC[top_of_metric_top];
+  ASM_REWRITE_TAC[interval_closed];
+  EXPAND_TAC "fA'";
+  EXPAND_TAC "A'";
+  EXPAND_TAC "A";
+  EXPAND_TAC "B";
+  REWRITE_TAC[UNION];
+  GEN_TAC ;
+  DISCH_TAC;
+  TYPE_THEN `(x = a) \/ (x = b)` SUBGOAL_TAC;
+  UND 21;
+  REAL_ARITH_TAC;
+  EXPAND_TAC "fA";
+  EXPAND_TAC "fB";
+  DISCH_THEN DISJ_CASES_TAC;
+  UND 22;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[subf;REAL_ARITH `a <= a`];
+  UND 22;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[subf];
+  TYPE_THEN `~(b <= a)` SUBGOAL_TAC;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `A' UNION B' = UNIV` SUBGOAL_TAC;
+  EXPAND_TAC "A'";
+  EXPAND_TAC "A";
+  EXPAND_TAC "B";
+  EXPAND_TAC "B'";
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `g = subf A' fA' f` ABBREV_TAC  ;
+  TYPE_THEN `!x. A x ==> (g x = f a)` SUBGOAL_TAC;
+  EXPAND_TAC "g";
+  REWRITE_TAC[subf];
+  EXPAND_TAC "A'";
+  REWRITE_TAC[UNION];
+  GEN_TAC;
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "fA'";
+  REWRITE_TAC[subf];
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "fA";
+  REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!x. B x ==> (g x = f b)` SUBGOAL_TAC;
+  EXPAND_TAC "g";
+  REWRITE_TAC[subf];
+  EXPAND_TAC "A'";
+  REWRITE_TAC[UNION];
+  GEN_TAC;
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "fA'";
+  REWRITE_TAC[subf];
+  TYPE_THEN `~(A x)` SUBGOAL_TAC;
+  UND 25;
+  EXPAND_TAC "B";
+  EXPAND_TAC "A";
+  REWRITE_TAC[];
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  EXPAND_TAC "fB";
+  REWRITE_TAC[];
+  DISCH_TAC;
+  (* A  *)
+  TYPE_THEN `!x. B' x ==> (g x = f x)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `A x` ASM_CASES_TAC;
+  TYPE_THEN `A x /\ B' x ==> (x = a)` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  EXPAND_TAC "B'";
+  REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  ASM_MESON_TAC[];
+  (* --2-- *)
+  TYPE_THEN `B x` ASM_CASES_TAC;
+  TYPE_THEN `B x /\ B' x ==> (x = b)` SUBGOAL_TAC;
+  EXPAND_TAC "B";
+  EXPAND_TAC "B'";
+  REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `~(A' x)` SUBGOAL_TAC;
+  UND 27;
+  UND 28;
+  EXPAND_TAC "A'";
+  REWRITE_TAC[UNION];
+  MESON_TAC[];
+  EXPAND_TAC "g";
+  REWRITE_TAC[subf];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  (* B start on goal *)
+  TYPE_THEN `g` EXISTS_TAC;
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  CONJ_TAC;
+  UND 26;
+  EXPAND_TAC "B'";
+  REWRITE_TAC[];
+  MESON_TAC[];
+  TYPE_THEN `IMAGE g UNIV SUBSET Y /\ metric_space (UNIV,d_real) /\ metric_space (Y,dY)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  UND 22;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[IMAGE_UNION;union_subset];
+  CONJ_TAC;
+  EXPAND_TAC "A'";
+  REWRITE_TAC[IMAGE_UNION;union_subset];
+  UND 24;
+  UND 25;
+  REWRITE_TAC[IMAGE;SUBSET];
+    TYPE_THEN `Y (f a) /\ Y(f b)` SUBGOAL_TAC;
+  UND 0;
+  EXPAND_TAC "B'";
+  REWRITE_TAC[IMAGE;SUBSET];
+  TYPE_THEN `a <= a /\ a <= b /\ b <= b` SUBGOAL_TAC;
+  UND 3;
+  REAL_ARITH_TAC;
+  MESON_TAC[];
+  MESON_TAC[];
+  UND 26;
+  UND 0;
+  EXPAND_TAC "B'";
+  REWRITE_TAC[IMAGE;SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  COPY 27;
+  (* C final KILL *)
+  USE 28 (MATCH_MP metric_continuous_continuous);
+  ASM_REWRITE_TAC[];
+  REWR 21;
+  (* Wed Aug 11 12:37:40 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let image_interval2 = prove_by_refinement(
+  `!a b f. (a < b) /\
+   (continuous f (top_of_metric({x | a <= x /\ x <= b},d_real))
+        (top_of_metric( UNIV,d_real)))  /\
+    (INJ f {x | a <= x /\ x <= b} UNIV) ==>
+   (?c d. (c < d) /\ ({ c , d} = {(f a),(f b)}) /\
+    (IMAGE f {x | a <= x /\ x <= b} =
+       {x | c <= x /\ x <= d})
+     )`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `?g. (continuous g (top_of_metric(UNIV,d_real))  (top_of_metric(UNIV,d_real))) /\ (!x. (a <= x /\ x <= b) ==> (f x = g x))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cont_extend_real_lemma;
+  ASM_REWRITE_TAC[metric_real];
+  REP_BASIC_TAC;
+  TYPE_THEN `(a < b) /\ (continuous g (top_of_metric(UNIV,d_real))  (top_of_metric( UNIV,d_real)))  /\ (INJ g {x | a <= x /\ x <= b} UNIV)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `INJ g {x | a <= x /\ x <= b} UNIV= INJ f {x | a <= x /\ x <= b} UNIV` SUBGOAL_TAC;
+  IMATCH_MP_TAC  inj_domain_sub;
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP image_interval t));
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `c` EXISTS_TAC;
+  TYPE_THEN `d` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `(f a = g a) /\ (f b = g b)` SUBGOAL_TAC;
+  UND 3;
+  UND 2;
+  MESON_TAC[REAL_ARITH `(a < b) ==> (a<= a /\ a <= b /\ b <= b)`];
+  DISCH_THEN_REWRITE;
+  USE 5 SYM;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  image_domain_sub;
+  ASM_REWRITE_TAC[];
+  (* Wed Aug 11 12:51:52 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_euclid = prove_by_refinement(
+  `!C. (simple_arc top2 C ==> (C SUBSET (euclid 2)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  USE 0 (MATCH_MP simple_arc_compact);
+  RULE_ASSUM_TAC (REWRITE_RULE[compact;top2_unions]);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_inj = prove_by_refinement(
+  `!A B C v v'. (simple_arc_end A v v' /\ simple_arc_end B v v') /\
+     (simple_arc top2 C) /\ (A SUBSET C) /\ (B SUBSET C) ==>
+     (A = B)`,
+  (* {{{ proof *)
+  [
+  (* A: *)
+  REWRITE_TAC[simple_arc_end];
+  REP_BASIC_TAC;
+  TYPE_THEN `simple_arc (top_of_metric(euclid 2,d_euclid)) C /\ (metric_space(euclid 2,d_euclid))` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[GSYM top2;metric_euclid];
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP   simple_arc_coord t));
+  REP_BASIC_TAC;
+  (* push to reals *)
+  TYPE_THEN `(IMAGE f'' A = IMAGE f'' B) <=> (A = B)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  INJ_IMAGE ;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  (* -- *)
+  TYPE_THEN `C SUBSET (euclid 2)` SUBGOAL_TAC;
+  IMATCH_MP_TAC simple_arc_euclid;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `metric_space (C,d_euclid )` SUBGOAL_TAC;
+  ASM_MESON_TAC[metric_subspace;metric_euclid];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET_UNIV];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_subspace;
+  TYPE_THEN `UNIV:real->bool` EXISTS_TAC ;
+  ASM_REWRITE_TAC[metric_real];
+  DISCH_TAC;
+  (* -- *)
+  (* -- *)
+  TYPE_THEN `g = f'' o f` ABBREV_TAC ;
+  TYPE_THEN `g'= f'' o f'` ABBREV_TAC ;
+  TYPE_THEN `top_of_metric({x| &0 <= x /\ x <= &1},d_real) = induced_top(top_of_metric(UNIV,d_real)) {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM top_of_metric_induced);
+  ASM_REWRITE_TAC[metric_real];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `continuous f (top_of_metric({x| &0 <= x /\ x<= &1},d_real)) top2` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[top2 ];
+  IMATCH_MP_TAC  continuous_induced_domain;
+  ASM_SIMP_TAC [GSYM top2; GSYM top_of_metric_unions; metric_real];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `continuous f' (top_of_metric({x| &0 <= x /\ x<= &1},d_real)) top2` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[top2 ];
+  IMATCH_MP_TAC  continuous_induced_domain;
+  ASM_SIMP_TAC [GSYM top2; GSYM top_of_metric_unions; metric_real];
+  DISCH_TAC;
+  KILL 11;
+  KILL 6;
+  (* A *)
+  TYPE_THEN `(&0 < &1) /\ (continuous g (top_of_metric({x | &0 <= x /\ x <= &1},d_real))  (top_of_metric( UNIV,d_real)))  /\ (INJ g {x | &0 <= x /\ x <= &1} UNIV)` SUBGOAL_TAC;
+  CONJ_TAC;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  continuous_comp;
+  TYPE_THEN `top_of_metric(C,d_euclid)` EXISTS_TAC;
+  USE 22 GSYM;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  CONJ_TAC;
+  UND 1;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  continuous_range;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[GSYM top2];
+  ASM_SIMP_TAC[metric_euclid];
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  SUBCONJ_TAC;
+  UND 1;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* --2-- *)
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  (REWRITE_RULE[GSYM comp_comp] COMP_INJ);
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  inj_subset;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 1;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP image_interval2 t));
+  REP_BASIC_TAC;
+  (* -- *)
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[GSYM IMAGE_o];
+  ASM_REWRITE_TAC[];
+  (* B *)
+    TYPE_THEN `(&0 < &1) /\ (continuous g' (top_of_metric({x | &0 <= x /\ x <= &1},d_real))  (top_of_metric( UNIV,d_real)))  /\ (INJ g' {x | &0 <= x /\ x <= &1} UNIV)` SUBGOAL_TAC;
+  CONJ_TAC;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "g'";
+  IMATCH_MP_TAC  continuous_comp;
+  TYPE_THEN `top_of_metric(C,d_euclid)` EXISTS_TAC;
+  USE 22 GSYM;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  CONJ_TAC;
+  UND 0;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  continuous_range;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[GSYM top2];
+  ASM_SIMP_TAC[metric_euclid];
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  SUBCONJ_TAC;
+  UND 0;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* --2-- *)
+  EXPAND_TAC "g'";
+  IMATCH_MP_TAC  (REWRITE_RULE[GSYM comp_comp] COMP_INJ);
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  inj_subset;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t -> ASSUME_TAC (MATCH_MP image_interval2 t));
+  REP_BASIC_TAC;
+  (* C final steps *)
+  TYPE_THEN `(g (&0) = g'(&0)) /\ (g(&1) = g'(&1))` SUBGOAL_TAC;
+  EXPAND_TAC "g";
+  EXPAND_TAC "g'";
+  REWRITE_TAC[o_DEF ];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  UND 11;
+  ASM_REWRITE_TAC[];
+  (* temp *)
+  DISCH_TAC;
+  TYPE_THEN `(c = min_real (g'(&0)) (g'(&1))) /\ (d = max_real(g'(&0)) (g'(&1)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  pair_order_endpoint;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `(c' = min_real (g'(&0)) (g'(&1))) /\ (d' = max_real(g'(&0)) (g'(&1)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  pair_order_endpoint;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  (* Wed Aug 11 15:10:02 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_cut = prove_by_refinement(
+  `!C v v' v''. simple_arc_end C v v' /\ (C v'') /\ ~(v'' = v) /\
+    ~(v'' = v') ==>
+    (?C' C''. (simple_arc_end C' v v'') /\ (simple_arc_end C'' v'' v') /\
+     (C' INTER C'' = {v''}) /\ (C' UNION C'' = C))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc_end];
+  REP_BASIC_TAC;
+  (* -- INTER *)
+  TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f t = v''))` SUBGOAL_TAC;
+  UND 2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE];
+   MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t}` EXISTS_TAC;
+  TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1}` EXISTS_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {x | t <= x /\ x <= &1} = IMAGE f ({x | &0 <= x /\ x <= t} INTER  {x | t <= x /\ x <= &1})` SUBGOAL_TAC;
+  IMATCH_MP_TAC (GSYM inj_inter );
+  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  UND 9;
+  UND 10;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `{x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x <= &1} = {t}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR IN_SING];
+  UND 9;
+  UND 10;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[image_sing];
+  ASM_REWRITE_TAC[];
+  (* A UNION *)
+  REWRITE_TAC[GSYM IMAGE_UNION];
+  TYPE_THEN `{x | &0 <= x /\ x <= t} UNION {x | t <= x /\ x <= &1} = {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;];
+  UND 9;
+  UND 10;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  (* B FIRST piece *)
+  CONJ_TAC;
+  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | &0 <= x /\ x <= t} (euclid 2) /\ &0 < &1 /\ &0 < t` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  UND 9;
+  REAL_ARITH_TAC;
+  TYPE_THEN `~(&0 = t)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  REWR 11;
+  REWR 4;
+  UND 10;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
+  REP_BASIC_TAC;
+  TYPE_THEN `g` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  (* C LAST piece  *)
+  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\ INJ f {x | t <= x /\ x <= &1} (euclid 2) /\ &0 < &1 /\ t < &1` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x <= &1}` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  UND 10;
+  REAL_ARITH_TAC;
+  TYPE_THEN `~( &1 = t)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  REWR 11;
+  REWR 3;
+  UND 9;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
+  REP_BASIC_TAC;
+  TYPE_THEN `g` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  (* Wed Aug 11 15:54:37 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_closed_curve_pt = prove_by_refinement(
+  `!C  v. (simple_closed_curve top2 C /\ C v) ==>
+    (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\
+               continuous f (top_of_metric (UNIV,d_real)) top2 /\
+               INJ f {x | &0 <= x /\ x < &1} (UNIONS top2) /\
+               (f (&0) = v) /\
+               (f (&0) = f (&1)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_closed_curve];
+  REP_BASIC_TAC;
+  TYPE_THEN `f(&0) = v` ASM_CASES_TAC;
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f t = v))` SUBGOAL_TAC;
+  UND 0;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `~(t = &0)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  REWR 9;
+  REWR 6;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~(t = &1)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `{x | t <= x /\ x <= &1} = {x | t <= x /\ x < &1} UNION {(&1)}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;INR IN_SING];
+  UND 7;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `INJ f {x | t <= x /\ x <= &1} (euclid 2)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  inj_split;
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC ;
+  ASM_REWRITE_TAC[GSYM top2_unions];
+  REWRITE_TAC[SUBSET];
+  UND 8;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[INJ;INR IN_SING;];
+  USE 2 (REWRITE_RULE[top2_unions]);
+  TYPE_THEN `euclid 2 (f (&0))` SUBGOAL_TAC;
+  USE 2 (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REAL_ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  MESON_TAC[];
+  REWRITE_TAC[EQ_EMPTY;IMAGE;INTER;image_sing;INR IN_SING;];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "x''");
+  REP_GEN_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `x' = &0` SUBGOAL_TAC;
+  USE 2(REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 14;
+  UND 8;
+  REAL_ARITH_TAC;
+  UND 14;
+  UND 8;
+  UND 9;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* [A] reparameter 1st part *)
+  TYPE_THEN `(continuous f (top_of_metric (UNIV,d_real)) top2) /\   (INJ f {x | t <= x /\ x <= &1} (euclid 2)) /\   (&0 < &1/(&2)) /\  (t < &1)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  UND 7;
+  UND 10;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP  arc_reparameter_gen t));
+  REP_BASIC_TAC;
+  KILL 14;
+  (* B 2nd part *)
+  TYPE_THEN `(continuous f (top_of_metric (UNIV,d_real)) top2) /\   (INJ f {x | &0 <= x /\ x <= t} (euclid 2)) /\   (&1/(&2) < &1) /\  (&0 < t)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_LT_HALF2];
+  CONJ_TAC;
+  USE 2(REWRITE_RULE[top2_unions]);
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x < &1} ` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET];
+  UND 7;
+  UND 10;
+  REAL_ARITH_TAC;
+  UND 8;
+  UND 9;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP  arc_reparameter_gen t));
+  REP_BASIC_TAC;
+  KILL 19;
+  (* [C] JOIN functions *)
+  TYPE_THEN `joinf g g' (&1/(&2))` EXISTS_TAC;
+  TYPE_THEN `&0 < &1/(&2)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `&1/(&2) < &1` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_LT_HALF2];
+  REAL_ARITH_TAC ;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `joinf g g' (&1/(&2)) (&0) = v` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[joinf];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `joinf g g' (&1/(&2)) (&1) = v` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[joinf];
+  ASM_SIMP_TAC[REAL_ARITH `(&1/ &2 < &1) ==> ~(&1 < (&1/(&2)))`];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `continuous (joinf g g' (&1 / &2)) (top_of_metric (UNIV,d_real)) top2` SUBGOAL_TAC;
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  joinf_cont;
+  ASM_REWRITE_TAC[GSYM top2];
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  (* [D] INJ *)
+  TYPE_THEN `{x | &0 <= x /\ x < &1} = {x | &0 <= x /\ x < (&1/(&2))} UNION {x | (&1/(&2)) <= x /\ x < &1}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  ASM_REWRITE_TAC[UNION];
+  UND 24;
+  UND 19;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  (* -- *)
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  REWRITE_TAC[top2_unions];
+  RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_split;
+  TYPE_THEN `INJ (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = INJ g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  joinf_inj_below;
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `INJ (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x < &1} = INJ g' {x | &1 / &2 <= x /\ x < &1}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  joinf_inj_above;
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE ;
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x <= &1/(&2)}` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | &1/(&2) <= x /\ x <= &1}` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  (* --2-- E IMAGE *)
+  REWRITE_TAC[EQ_EMPTY];
+  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  joinf_image_below;
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x < &1} = IMAGE g' {x | &1 / &2 <= x /\ x < &1}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  joinf_image_above;
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[INTER];
+  GEN_TAC;
+  REWRITE_TAC[IMAGE;];
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  REWR 27;
+  KILL 30;
+  USE 13 (REWRITE_RULE[FUN_EQ_THM ]);
+  TSPEC `g x'` 13;
+  USE 13 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `(?x. (&0 <= x /\ x <= &1 / &2) /\ (g x' = g x))` SUBGOAL_TAC;
+  ASM_MESON_TAC[REAL_ARITH `x' < u ==> x' <= u`];
+  DISCH_TAC;
+  REWR 13;
+  KILL 30;
+  REP_BASIC_TAC;
+  USE 14 (REWRITE_RULE[FUN_EQ_THM;]);
+  TSPEC `g' x''` 14;
+  USE 14 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `(?x. (&1 / &2 <= x /\ x <= &1) /\ (g' x'' = g' x))` SUBGOAL_TAC;
+  ASM_MESON_TAC[REAL_ARITH `x' < u ==> x' <= u`];
+  DISCH_TAC;
+  REWR 14;
+  KILL 34;
+  REP_BASIC_TAC;
+  TYPE_THEN `(x = x''')` SUBGOAL_TAC;
+  USE 2 (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `~(x = &0)` SUBGOAL_TAC;
+  DISCH_TAC;
+  TYPE_THEN `g (&1/(&2)) = g (x')` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `&1/(&2) = x'` SUBGOAL_TAC;
+  USE 17(REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 31;
+  UND 24;
+  UND 19;
+  REAL_ARITH_TAC;
+  UND 31;
+  REAL_ARITH_TAC;
+  TYPE_THEN `~(x = &1)` SUBGOAL_TAC;
+  DISCH_TAC;
+  TYPE_THEN `g (&1/(&2)) = g (x')` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `&1/(&2) = x'` SUBGOAL_TAC;
+  USE 17(REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 31;
+  UND 24;
+  UND 19;
+  REAL_ARITH_TAC;
+  UND 31;
+  REAL_ARITH_TAC;
+  UND 34;
+  UND 7;
+  UND 10;
+  UND 33;
+  UND 8;
+  UND 9;
+  UND 30;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* --2-- *)
+  TYPE_THEN `x = t` SUBGOAL_TAC;
+  UND 36;
+  UND 35;
+  UND 34;
+  UND 33;
+  UND 30;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `g' (&1) = g'(x'')` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `&1 = x''` SUBGOAL_TAC;
+  USE 22(REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 28;
+  UND 24;
+  UND 19;
+  REAL_ARITH_TAC;
+  UND 28;
+  REAL_ARITH_TAC;
+  (* F IMAGE *)
+  TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1/(&2)} UNION {x | &1/(&2) <= x /\ x <= &1}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION ];
+  UND  24;
+  UND 19;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPEL_THEN [`joinf g g' (&1/(&2))`;`{x | &0 <= x /\ x < &1/(&2)}`;`{x | &1/(&2) <= x /\ x <= &1}`] (fun t-> ASSUME_TAC (ISPECL t IMAGE_UNION ));
+  ASM_REWRITE_TAC[];
+  USE 27 SYM;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &0 <= x /\ x < &1 / &2} = IMAGE g {x | &0 <= x /\ x < &1 / &2}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  joinf_image_below;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `IMAGE (joinf g g' (&1 / &2)) {x | &1 / &2 <= x /\ x <= &1} = IMAGE g' {x | &1 / &2 <= x /\ x <= &1}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  joinf_image_above;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  USE 14 GSYM ;
+  ASM_REWRITE_TAC[];
+  (* F final  *)
+  TYPE_THEN `{x | &0 <= x /\ x <= &1} = {x | &0 <= x /\ x < &1} UNION {(&1)}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;INR IN_SING];
+  REAL_ARITH_TAC;
+  DISCH_TAC ;
+  (* -- *)
+  TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= &1} = IMAGE f {x | &0 <= x /\ x < &1}` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE_UNION;image_sing; ];
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[union_subset;SUBSET_REFL];
+  REWRITE_TAC[SUBSET;INR IN_SING;];
+  GEN_TAC;
+  DISCH_THEN_REWRITE;
+  UND 1;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `&0` EXISTS_TAC;
+  REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[SUBSET_UNION];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `IMAGE g {x | &0 <= x /\ x < &1/(&2)} = IMAGE f {x | t <= x /\ x < &1}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1} DELETE (f (&1))` EXISTS_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[SUBSET_DELETE];
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;];
+  REP_BASIC_TAC;
+  TYPE_THEN `x = (&1/(&2))` SUBGOAL_TAC;
+  USE 17(REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 32;
+  UND 19;
+  REAL_ARITH_TAC;
+  UND 32;
+  REAL_ARITH_TAC;
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[DELETE;IMAGE;SUBSET;];
+  REWRITE_TAC[REAL_ARITH `x <= &1 <=> (x < &1 \/ (x = &1))`];
+  MESON_TAC[];
+  (* --2--*)
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `IMAGE g {x | &0 <= x /\ x <= &1/(&2)} DELETE (g (&1/(&2)))` EXISTS_TAC;
+  CONJ_TAC;
+  USE 13 GSYM;
+  USE 15 GSYM;
+  ASM_REWRITE_TAC[SUBSET_DELETE];
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;];
+  REP_BASIC_TAC;
+  TYPE_THEN `&1 = x` SUBGOAL_TAC;
+  USE 12(REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 32;
+  REAL_ARITH_TAC;
+  UND 32;
+  REAL_ARITH_TAC;
+  USE 11 SYM;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[DELETE;IMAGE;SUBSET;];
+  REWRITE_TAC[REAL_ARITH `x <= &1/(&2) <=> (x < &1/(&2) \/ (x = &1/(&2)))`];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  (* G *)
+  REWRITE_TAC[GSYM IMAGE_UNION];
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  UND 8;
+  UND 7;
+  UND 10;
+  REAL_ARITH_TAC;
+  (* -- World's worst proof *)
+  (* Thu Aug 12 07:44:29 EDT 2004 *)
+
+  ]);;
+
+
+  (* }}} *)
+
+let shift_inj = prove_by_refinement(
+  `!(f:real->A) X t. (INJ f {x | &0 <= x /\ x < &1} X) /\
+          (f (&0) = f(&1)) /\ (&0 < t) ==>
+     INJ f {x | t <= x /\ x <= &1} X`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `x < &1` ASM_CASES_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 5;
+  UND 0;
+  REAL_ARITH_TAC;
+  TYPE_THEN `x = &1` SUBGOAL_TAC;
+  UND 4;
+  UND 6;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  USE 1 GSYM;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `((x = &1) /\ (y = &1)) \/ ((x < &1) /\ (y = &1)) \/ ((x = &1) /\ (y < &1)) \/ ((x < &1) /\ (y < &1))` SUBGOAL_TAC;
+  UND 5;
+  UND 7;
+  REAL_ARITH_TAC;
+  REP_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  USE 1 SYM ;
+  REWR 4;
+  TYPE_THEN `x = &0` SUBGOAL_TAC;
+  FIRST_ASSUM  IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 8;
+  UND 0;
+  REAL_ARITH_TAC;
+  UND 8;
+  UND 0;
+  REAL_ARITH_TAC;
+  USE 1 SYM;
+  REWR 4;
+  TYPE_THEN `y = &0` SUBGOAL_TAC;
+  FIRST_ASSUM  IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 6;
+  UND 0;
+  REAL_ARITH_TAC;
+  UND 6;
+  UND 0;
+  REAL_ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 6;
+  UND 8;
+  UND 0;
+  REAL_ARITH_TAC;
+  (* Thu Aug 12 08:33:16 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_segment = prove_by_refinement(
+  `!f u v.
+          continuous f (top_of_metric (UNIV,d_real)) top2 /\
+              INJ f {x | &0 <= x /\ x < &1} (euclid 2) /\
+              (f (&0) = f (&1)) /\
+       (&0 <= u /\ u < v /\ v <= &1 /\ (&0 < u \/ v < &1)) ==>
+     simple_arc_end (IMAGE f {x | u <= x /\ x <= v}) (f u) (f v)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[simple_arc_end];
+  (* -- *)
+  TYPE_THEN `(&0 < u) ==> INJ f { x | u <= x /\ x <= &1} (euclid 2)` SUBGOAL_TAC ;
+  DISCH_TAC;
+  IMATCH_MP_TAC  shift_inj;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `INJ f { x | u <= x /\ x <= v } (euclid 2)`  SUBGOAL_TAC;
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC;
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | u <= x /\ x <= &1}` EXISTS_TAC;
+  REWR 7;
+  ASM_REWRITE_TAC[SUBSET ];
+  UND 1;
+  REAL_ARITH_TAC;
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  UND 0;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `continuous f (top_of_metric (UNIV,d_real)) top2 /\  INJ f {x | u <= x /\ x <= v} (euclid 2) /\  &0 < &1 /\  u < v` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP arc_reparameter_gen t));
+  REP_BASIC_TAC;
+  TYPE_THEN `g` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Thu Aug 12 08:55:11 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_closed_cut = prove_by_refinement(
+  `!C v v'. (simple_closed_curve top2 C /\ C v /\ C v' /\ ~(v = v')
+   ==> (?C' C''. simple_arc_end C' v v' /\ simple_arc_end C'' v v'
+      /\ (  C' UNION C'' = C) /\ (C' INTER C'' = {v,v'})))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `simple_closed_curve top2 C /\ C v` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_closed_curve_pt t));
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `?t. (&0 <= t /\ t <= &1 /\ (f(t) = v'))` SUBGOAL_TAC;
+  UND 1;
+  ASM_REWRITE_TAC[IMAGE];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `t < &1` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `~( t= &1) /\ (t <= &1) ==> (t  < &1)`);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWR 9;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `&0 < t` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `~(t = &0) /\ (&0 <= t) ==> (&0 < t)`);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWR 9;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `C' = IMAGE f {x | &0 <= x /\ x <= t}` ABBREV_TAC ;
+  TYPE_THEN `C'' = IMAGE f {x | t <= x /\ x <= &1}` ABBREV_TAC ;
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `C''` EXISTS_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "C'";
+  EXPAND_TAC "v";
+  EXPAND_TAC "v'";
+  IMATCH_MP_TAC simple_arc_segment;
+  RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[REAL_ARITH `x <= x`];
+  (* -- *)
+  CONJ_TAC;
+  USE 5 SYM;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "C''";
+  EXPAND_TAC "v'";
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  IMATCH_MP_TAC  simple_arc_segment;
+  RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  (* -- *)
+  CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "C'";
+  EXPAND_TAC "C''";
+  REWRITE_TAC[GSYM IMAGE_UNION];
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  UND 13;
+  UND 12;
+  REAL_ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `C'' = IMAGE f {x | t <= x /\ x < &1} UNION IMAGE f {(&1)}` SUBGOAL_TAC;
+  REWRITE_TAC[GSYM IMAGE_UNION];
+  EXPAND_TAC "C''";
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;INR IN_SING ];
+  UND 12;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  (* -- *)
+  REWRITE_TAC[UNION_OVER_INTER;image_sing];
+  EXPAND_TAC "C'";
+  TYPE_THEN `(IMAGE f ({x | &0 <= x /\ x <= t} INTER  {x | t <= x /\ x < &1})) = (IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {x | t <= x /\ x < &1})` SUBGOAL_TAC;
+  IMATCH_MP_TAC  inj_inter;
+  TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC;
+  TYPE_THEN `(UNIONS top2)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  UND 12;
+  UND 13;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  (* -- *)
+  TYPE_THEN `({x | &0 <= x /\ x <= t} INTER {x | t <= x /\ x < &1}) = {t}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR IN_SING];
+  UND 13;
+  UND 12;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `{(f (&1))} = IMAGE f {(&0)}` SUBGOAL_TAC;
+  REWRITE_TAC[image_sing];
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `(IMAGE f ({x | &0 <= x /\ x <= t} INTER  {(&0)})  ) = (IMAGE f {x | &0 <= x /\ x <= t} INTER IMAGE f {(&0)} )` SUBGOAL_TAC;
+  IMATCH_MP_TAC  inj_inter;
+  TYPE_THEN `{x | &0 <= x /\ x < &1}` EXISTS_TAC;
+  TYPE_THEN `UNIONS top2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  UND 12;
+  UND 13;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  (* -- *)
+  TYPE_THEN `({x | &0 <= x /\ x <= t} INTER {(&0)}) = {(&0)}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR IN_SING ];
+  UND 11;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[image_sing];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[in_pair];
+  REWRITE_TAC[UNION;INR IN_SING];
+  ASM_MESON_TAC[];
+  (* Thu Aug 12 09:35:48 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION M *)
+(* ------------------------------------------------------------------ *)
+
+
+let closed_point = prove_by_refinement(
+  `!x. (euclid 2 x) ==> (closed_ top2 {x})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  compact_closed;
+  REWRITE_TAC[top2_top];
+  ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid];
+  IMATCH_MP_TAC  compact_point;
+  ASM_REWRITE_TAC[GSYM top2;top2_unions];
+  (* Fri Aug 13 08:42:22 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_closed = prove_by_refinement(
+  `!C v v'. (simple_arc_end C v v' ==> closed_ top2 C) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  compact_closed;
+  REWRITE_TAC[top2_top];
+  ASM_SIMP_TAC[top2;metric_hausdorff;metric_euclid];
+  REWRITE_TAC [GSYM top2];
+  IMATCH_MP_TAC  simple_arc_compact;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  (* Fri Aug 13 09:33:35 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_end = prove_by_refinement(
+  `!C v v'. (simple_arc_end C v v' ==> C v)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc_end];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "v";
+  REWRITE_TAC[IMAGE;];
+  TYPE_THEN `&0` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  (* Fri Aug 13 09:40:59 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_end2 = prove_by_refinement(
+  `!C v v'. (simple_arc_end C v v' ==> C v')`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc_end];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "v'";
+  REWRITE_TAC[IMAGE;];
+  TYPE_THEN `&1` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  (* Fri Aug 13 09:42:07 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_end_closed = prove_by_refinement(
+  `!C v v'. simple_arc_end C v v' ==> closed_ top2 {v}`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  closed_point;
+  TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  TYPE_THEN `C v` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  MESON_TAC[ISUBSET];
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_end_closed2 = prove_by_refinement(
+  `!C v v'. simple_arc_end C v v' ==> closed_ top2 {v'}`,
+  (* {{{ proof *)
+
+  [
+  ASM_MESON_TAC[simple_arc_end_end_closed;simple_arc_end_symm;];
+  ]);;
+
+  (* }}} *)
+
+let simple_arc_sep3 = prove_by_refinement(
+  `!A C1 C2 C3 x p1 p2 p3.
+     (C1 UNION C2 UNION C3 SUBSET A) /\
+     (simple_arc_end C1 x p1) /\ ~(C1 p2) /\ ~(C1 p3) /\
+     (simple_arc_end C2 x p2) /\ ~(C2 p1) /\ ~(C2 p3) /\
+     (simple_arc_end C3 x p3) /\ ~(C3 p1) /\ ~(C3 p2) ==>
+     (?x' C1' C2' C3'.
+     (C1' UNION C2' UNION C3' SUBSET A) /\
+     (simple_arc_end C1' x' p1) /\
+     (simple_arc_end C2' x' p2) /\
+     (simple_arc_end C3' x' p3) /\
+     ~(C2' p3) /\ ~(C3' p2) /\
+     (C1' INTER C2' = {x'} ) /\
+     (C1' INTER C3' = {x'} ))
+     `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `K = C2 UNION C3` ABBREV_TAC ;
+  TYPE_THEN `~((C1 INTER K) = EMPTY)` SUBGOAL_TAC;
+  EXPAND_TAC "K";
+  REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  REWRITE_TAC[UNION];
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `closed_ top2 K` SUBGOAL_TAC;
+  EXPAND_TAC "K";
+  IMATCH_MP_TAC  closed_union;
+  ASM_MESON_TAC[simple_arc_end_closed;top2_top];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `~((C1 INTER {p1}) = EMPTY)` SUBGOAL_TAC;
+  REWRITE_TAC[INTER;EMPTY_EXISTS;INR IN_SING];
+  ASM_MESON_TAC[simple_arc_end_end2];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `(?C1' x' v'. C1' SUBSET C1 /\ simple_arc_end C1' x' v' /\ (C1' INTER K = {x'}) /\ (C1' INTER {p1} = {v'}))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_restriction;
+  ASM_REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING ];
+  CONJ_TAC;
+  ASM_MESON_TAC[simple_arc_end_simple];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end_closed2;
+  ASM_MESON_TAC[];
+  CONV_TAC (dropq_conv "x");
+  REWRITE_TAC[DE_MORGAN_THM];
+  DISJ2_TAC;
+  EXPAND_TAC "K";
+  REWRITE_TAC[UNION];
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `v' = p1` SUBGOAL_TAC;
+  USE 14 (REWRITE_RULE[FUN_EQ_THM]);
+  USE 14 (REWRITE_RULE[INTER;INR IN_SING]);
+  ASM_MESON_TAC[];
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  KILL 14;
+  (* -- *)
+  (* [A] case x' = x *)
+  TYPE_THEN `x' = x` ASM_CASES_TAC;
+  UND 14;
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  TYPE_THEN `x` EXISTS_TAC;
+  TYPE_THEN `C1` EXISTS_TAC;
+  TYPE_THEN `C2` EXISTS_TAC;
+  TYPE_THEN `C3` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `C1' = C1` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_inj;
+  TYPE_THEN `C1` EXISTS_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  TYPE_THEN `p1` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL ];
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  (* --2-- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INTER;INR IN_SING];
+  EQ_TAC;
+  USE 15 (REWRITE_RULE[FUN_EQ_THM;]);
+  USE 14 (REWRITE_RULE[INTER;INR IN_SING]);
+  UND 14;
+  EXPAND_TAC "K";
+  REWRITE_TAC[UNION];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[simple_arc_end_end];
+  (* --2'-- *)
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INTER;INR IN_SING];
+  EQ_TAC;
+  USE 15 (REWRITE_RULE[FUN_EQ_THM;]);
+  USE 14 (REWRITE_RULE[INTER;INR IN_SING]);
+  UND 14;
+  EXPAND_TAC "K";
+  REWRITE_TAC[UNION];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[simple_arc_end_end];
+  (* B cut C1 at- x'  *)
+  TYPE_THEN `~(x' = p1)` SUBGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_distinct];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `C1' x'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `simple_arc_end C1 x p1 /\ C1 x' /\ ~(x' = x) /\ ~(x' = p1)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  UND 17;
+  UND 19;
+  MESON_TAC[ISUBSET];
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `C'' = C1'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_inj;
+  TYPE_THEN `C1` EXISTS_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  TYPE_THEN `p1` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  UND 20;
+  SET_TAC[UNION;SUBSET];
+  DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  (* -- *)
+  TYPE_THEN `C1 x'` SUBGOAL_TAC;
+  UND 19;
+  UND 17;
+  MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  (* -- *)
+    TYPE_THEN `x'` EXISTS_TAC;
+  TYPE_THEN `C1'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[union_subset];
+  TYPE_THEN `C1' SUBSET A` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1 UNION K ` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_UNION];
+  DISCH_THEN_REWRITE;
+  (* [C] C2 x'  *)
+  (* ------- *)
+  TYPE_THEN `C2 x'` ASM_CASES_TAC;
+  TYPE_THEN `simple_arc_end C2 x p2 /\ C2 x' /\ ~(x' = x) /\ ~(x' = p2)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+    ASM_MESON_TAC[];
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
+  REP_BASIC_TAC;
+  TYPE_THEN `C2' = C''''` ABBREV_TAC ;
+  KILL 30;
+  (*---- *)
+  TYPE_THEN `C2'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `C2' SUBSET C2` SUBGOAL_TAC;
+  USE 26 ( (REWRITE_RULE[FUN_EQ_THM]));
+  USE 26 (REWRITE_RULE[UNION]);
+  UND 26;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~C2' p3` SUBGOAL_TAC;
+  UND 30;
+  UND 3;
+  MESON_TAC[ISUBSET];
+  DISCH_THEN_REWRITE;
+  ONCE_REWRITE_TAC [union_subset];
+  TYPE_THEN `C2' SUBSET A` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1 UNION K` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "K";
+  REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `C1' INTER C2' = {x'}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR IN_SING];
+  GEN_TAC;
+  EQ_TAC;
+  UND 15;
+  UND 30;
+  EXPAND_TAC "K";
+  REWRITE_TAC [eq_sing];
+  REWRITE_TAC[INTER;UNION;SUBSET];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_end];
+  DISCH_THEN_REWRITE;
+  (* --[C2]-- branch again for C3 x' -- *)
+  TYPE_THEN `C3 x'` ASM_CASES_TAC;
+  TYPE_THEN `simple_arc_end C3 x p3 /\ C3 x' /\ ~(x' = x) /\ ~(x' = p3)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
+  REP_BASIC_TAC;
+  TYPE_THEN `C3' = C''''''` ABBREV_TAC ;
+  KILL 36;
+  TYPE_THEN `C3'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `C3' SUBSET C3` SUBGOAL_TAC;
+  UND 32;
+  SET_TAC[UNION;SUBSET];
+  DISCH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1 UNION K` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "K";
+  UND 36;
+  REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  CONJ_TAC;
+  UND 36;
+  UND 0;
+  MESON_TAC[ISUBSET];
+  TYPE_THEN `C3' x'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING];
+  GEN_TAC;
+  EQ_TAC;
+  UND 15;
+  UND 36;
+  EXPAND_TAC "K";
+  REWRITE_TAC[eq_sing ];
+  REWRITE_TAC[UNION;SUBSET;INTER];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[];
+  (* --[C2']-- now C3 doesn't meet x'. This will be repeated for C2 *)
+  (* -- cut C' from {x'} to FIRST point on C3 -- *)
+  TYPEL_THEN [`C'`;`{x'}`;`C3`] (fun t->  MP_TAC  (ISPECL t simple_arc_end_restriction));
+  DISCH_THEN ANT_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end_closed;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_closed;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  UND 31;
+  REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING];
+  MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[EMPTY_EXISTS];
+  REWRITE_TAC[INTER;INR IN_SING];
+  USE 23 (MATCH_MP simple_arc_end_end2);
+  UND 23;
+  MESON_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  REWRITE_TAC[INTER;INR IN_SING];
+  USE 23 (MATCH_MP simple_arc_end_end);
+  UND 23;
+  USE 2 (MATCH_MP simple_arc_end_end);
+  UND 2;
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  (* ---[a] *)
+  TYPE_THEN `C3a = C'''''` ABBREV_TAC ;
+  KILL 36;
+  TYPE_THEN `v = x'` SUBGOAL_TAC;
+  USE 33(REWRITE_RULE[FUN_EQ_THM]);
+  USE 33(REWRITE_RULE[INTER;INR IN_SING]);
+  UND 33;
+  MESON_TAC[];
+  DISCH_THEN (fun t -> (RULE_ASSUM_TAC  (REWRITE_RULE[t])));
+  KILL 33;
+  TYPE_THEN `C3a SUBSET C1` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 20;
+  SET_TAC[UNION;SUBSET];
+  DISCH_TAC;
+  TYPE_THEN `C3a SUBSET A /\ simple_arc_end C3a x' v'' /\ ~(C3a p2) /\ (C1' INTER C3a = {(x')}) /\ (C3 INTER C3a = {(v'')}) /\ (~C3a p3)` SUBGOAL_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1 UNION K` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_UNION];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL ];
+  CONJ_TAC;
+  UND 7;
+  UND 33;
+  MESON_TAC[ISUBSET];
+  CONJ_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INR IN_SING];
+  EQ_TAC;
+  UND 21;
+  UND 35;
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[SUBSET;INTER];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_end];
+  (* --- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INR IN_SING];
+  EQ_TAC;
+  UND 32;
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[SUBSET;INTER];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[];
+  UND 32;
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  UND 35;
+  USE 20 (REWRITE_RULE[FUN_EQ_THM]);
+  USE 20 (REWRITE_RULE[UNION]);
+  UND 20;
+  UND 6;
+  MESON_TAC  [ISUBSET];
+  KILL 32;
+  KILL 33;
+  KILL 34;
+  KILL 31;
+  REP_BASIC_TAC;
+  (* --[b] *)
+  TYPE_THEN `(v'' = x)` ASM_CASES_TAC;
+  FIRST_ASSUM (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  TYPE_THEN `C3 UNION C3a` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  ONCE_REWRITE_TAC[union_subset];
+  ASM_REWRITE_TAC[];
+  UND 9;
+  EXPAND_TAC "K";
+  REWRITE_TAC[union_subset];
+  MESON_TAC[];
+  (* --- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  IMATCH_MP_TAC  simple_arc_end_trans;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[UNION;DE_MORGAN_THM];
+  ASM_REWRITE_TAC[];
+  (* --- *)
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;UNION;INR IN_SING];
+  GEN_TAC;
+  EQ_TAC ;
+  REWRITE_TAC[LEFT_AND_OVER_OR];
+  DISCH_THEN DISJ_CASES_TAC;
+  UND 39;
+  UND 15;
+  EXPAND_TAC "K";
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[INTER;UNION];
+  MESON_TAC[];
+  UND 39;
+  UND 33;
+  REWRITE_TAC[eq_sing ];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  UND 33;
+  REWRITE_TAC[eq_sing ];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  (* -- *)
+  (* --[c] cut off C3b at- v'' *)
+  TYPEL_THEN [`C3`;`x`;`p3`;`v''`] (fun t -> MP_TAC (ISPECL t simple_arc_end_cut));
+  DISCH_THEN ANT_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 32;
+  REWRITE_TAC[eq_sing ];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USE 39 (REWRITE_RULE[]);
+  FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  UND 31;
+  REWRITE_TAC[];
+  UND 32;
+  REWRITE_TAC[eq_sing ];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `C3b = C'''''''` ABBREV_TAC ;
+  KILL 43;
+  TYPE_THEN `C3b SUBSET C3` SUBGOAL_TAC;
+  UND 39;
+  SET_TAC[UNION;SUBSET];
+  DISCH_TAC;
+  (* -- [d] EXISTS_TAC *)
+  TYPE_THEN `C3a UNION C3b` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS ;
+  TYPE_THEN `C1 UNION K` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_union_pair;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 20;
+  SET_TAC[UNION;SUBSET];
+  EXPAND_TAC "K";
+  UND 43;
+  REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_trans;
+  (* IMATCH_MP_TAC  SUBSET_TRANS;    *)
+  TYPE_THEN `v''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 43;
+  UND 32;
+  UND 40;
+  REWRITE_TAC[eq_sing ];
+  REWRITE_TAC[INTER;SUBSET];
+  MESON_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[UNION;DE_MORGAN_THM];
+  ASM_REWRITE_TAC[];
+  UND 43;
+  UND 0;
+  MESON_TAC[ISUBSET];
+  IMATCH_MP_TAC  EQ_EXT ;
+  REWRITE_TAC[INTER;UNION;INR IN_SING;LEFT_AND_OVER_OR];
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  FIRST_ASSUM MP_TAC;
+  UND 21;
+  UND 33;
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  FIRST_ASSUM MP_TAC;
+  UND 43;
+  UND 15;
+  EXPAND_TAC "K";
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[INTER;UNION;SUBSET];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  DISJ1_TAC;
+  UND 36;
+  MESON_TAC[simple_arc_end_end];
+  (* D *)
+  TYPE_THEN `C3 x'` SUBGOAL_TAC;
+  UND 25;
+  UND 15;
+  REWRITE_TAC[eq_sing];
+  EXPAND_TAC "K";
+  REWRITE_TAC[INTER;UNION];
+  MESON_TAC[];
+  DISCH_TAC;
+  (* [E]  back to ONE goal *)
+  (* TYPE_THEN `C3 x'` ASM_CASES_TAC; *)
+  TYPE_THEN `simple_arc_end C3 x p3 /\ C3 x' /\ ~(x' = x) /\ ~(x' = p3)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+    ASM_MESON_TAC[];
+  DISCH_THEN (fun t-> ASSUME_TAC (MATCH_MP simple_arc_end_cut t));
+  REP_BASIC_TAC;
+  TYPE_THEN `C3' = C''''` ABBREV_TAC ;
+  KILL 31;
+  (*---- *)
+  LEFT_TAC "C3'";
+  USE 10 (ONCE_REWRITE_RULE[UNION_COMM]);
+  TYPE_THEN `C3'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `C3' SUBSET C3` SUBGOAL_TAC;
+  USE 27 ( (REWRITE_RULE[FUN_EQ_THM]));
+  USE 27 (REWRITE_RULE[UNION]);
+  UND 27;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~C3' p2` SUBGOAL_TAC;
+  UND 31;
+  UND 0;
+  MESON_TAC[ISUBSET];
+  DISCH_THEN_REWRITE;
+  ONCE_REWRITE_TAC [union_subset];
+  TYPE_THEN `C3' SUBSET A` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1 UNION K` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C3` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "K";
+  REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `C1' INTER C3' = {x'}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR IN_SING];
+  GEN_TAC;
+  EQ_TAC;
+  UND 15;
+  UND 31;
+  EXPAND_TAC "K";
+  REWRITE_TAC [eq_sing];
+  REWRITE_TAC[INTER;UNION;SUBSET];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_end];
+  DISCH_THEN_REWRITE;
+  (* --[XC2]-- now C2 doesn't meet x'. This is repeat. *)
+  (* -- cut C' from {x'} to FIRST point on C2 -- *)
+  TYPEL_THEN [`C'`;`{x'}`;`C2`] (fun t->  MP_TAC  (ISPECL t simple_arc_end_restriction));
+  DISCH_THEN ANT_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end_closed;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_closed;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  UND 25;
+  REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING];
+  MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[EMPTY_EXISTS];
+  REWRITE_TAC[INTER;INR IN_SING];
+  USE 23 (MATCH_MP simple_arc_end_end2);
+  UND 23;
+  MESON_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  REWRITE_TAC[INTER;INR IN_SING];
+  USE 23 (MATCH_MP simple_arc_end_end);
+  UND 23;
+  USE 5 (MATCH_MP simple_arc_end_end);
+  UND 5;
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  (* ---[Xa] *)
+  TYPE_THEN `C2a = C'''''` ABBREV_TAC ;
+  KILL 36;
+  TYPE_THEN `v = x'` SUBGOAL_TAC;
+  USE 33(REWRITE_RULE[FUN_EQ_THM]);
+  USE 33(REWRITE_RULE[INTER;INR IN_SING]);
+  UND 33;
+  MESON_TAC[];
+  DISCH_THEN (fun t -> (RULE_ASSUM_TAC  (REWRITE_RULE[t])));
+  KILL 33;
+  TYPE_THEN `C2a SUBSET C1` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 20;
+  SET_TAC[UNION;SUBSET];
+  DISCH_TAC;
+  TYPE_THEN `C2a SUBSET A /\ simple_arc_end C2a x' v'' /\ ~(C2a p3) /\ (C1' INTER C2a = {(x')}) /\ (C2 INTER C2a = {(v'')}) /\ (~C2a p2)` SUBGOAL_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1 UNION K` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_UNION];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL ];
+  CONJ_TAC;
+  UND 6;
+  UND 33;
+  MESON_TAC[ISUBSET];
+  CONJ_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INR IN_SING];
+  EQ_TAC;
+  UND 21;
+  UND 35;
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[SUBSET;INTER];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_end];
+  (* --- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INR IN_SING];
+  EQ_TAC;
+  UND 32;
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[SUBSET;INTER];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[];
+  UND 32;
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  UND 35;
+  USE 20 (REWRITE_RULE[FUN_EQ_THM]);
+  USE 20 (REWRITE_RULE[UNION]);
+  UND 20;
+  UND 7;
+  MESON_TAC  [ISUBSET];
+  KILL 32;
+  KILL 33;
+  KILL 34;
+  KILL 35;  (*  attention *)
+  REP_BASIC_TAC;
+  (* --[Xb] *)
+  TYPE_THEN `(v'' = x)` ASM_CASES_TAC;
+  FIRST_ASSUM (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  TYPE_THEN `C2 UNION C2a` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  ONCE_REWRITE_TAC[union_subset];
+  ASM_REWRITE_TAC[];
+  UND 9;
+  EXPAND_TAC "K";
+  REWRITE_TAC[union_subset];
+  MESON_TAC[];
+  (* --- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  IMATCH_MP_TAC  simple_arc_end_trans;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[UNION;DE_MORGAN_THM];
+  ASM_REWRITE_TAC[];
+  (* --- *)
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;UNION;INR IN_SING];
+  GEN_TAC;
+  EQ_TAC ;
+  REWRITE_TAC[LEFT_AND_OVER_OR];
+  DISCH_THEN DISJ_CASES_TAC;
+  UND 39;
+  UND 15;
+  EXPAND_TAC "K";
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[INTER;UNION];
+  MESON_TAC[];
+  UND 39;
+  UND 34;
+  REWRITE_TAC[eq_sing ];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  UND 34;
+  REWRITE_TAC[eq_sing ];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  (* -- *)
+  (* --[Xc] cut off C3b at- v'' *)
+  TYPEL_THEN [`C2`;`x`;`p2`;`v''`] (fun t -> MP_TAC (ISPECL t simple_arc_end_cut));
+  DISCH_THEN ANT_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 33;
+  REWRITE_TAC[eq_sing ];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USE 39 (REWRITE_RULE[]);
+  FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  UND 32;
+  REWRITE_TAC[];
+  UND 33;
+  REWRITE_TAC[eq_sing ];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `C2b = C''''''` ABBREV_TAC ;
+  KILL 43;
+  TYPE_THEN `C2b SUBSET C2` SUBGOAL_TAC;
+  UND 39;
+  SET_TAC[UNION;SUBSET];
+  DISCH_TAC;
+  (* -- [Xd] EXISTS_TAC *)
+  TYPE_THEN `C2a UNION C2b` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[union_subset ];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS ;
+  TYPE_THEN `C1 UNION K` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "K";
+  REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_trans;
+  TYPE_THEN `v''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 43;
+  UND 33;
+  UND 40;
+  REWRITE_TAC[eq_sing ];
+  REWRITE_TAC[INTER;SUBSET];
+  MESON_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[UNION;DE_MORGAN_THM];
+  ASM_REWRITE_TAC[];
+  UND 43;
+  UND 3;
+  MESON_TAC[ISUBSET];
+  IMATCH_MP_TAC  EQ_EXT ;
+  REWRITE_TAC[INTER;UNION;INR IN_SING;LEFT_AND_OVER_OR];
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  FIRST_ASSUM MP_TAC;
+  UND 21;
+  UND 34;
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  FIRST_ASSUM MP_TAC;
+  UND 43;
+  UND 15;
+  EXPAND_TAC "K";
+  REWRITE_TAC[eq_sing];
+  REWRITE_TAC[INTER;UNION;SUBSET];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  DISJ1_TAC;
+  UND 36;
+  MESON_TAC[simple_arc_end_end];
+  (* Fri Aug 13 17:43:15 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+
+let simple_arc_sep2 = prove_by_refinement(
+  `!A C1 C2 C3 x p1 p2 p3.
+     (
+     C1 UNION C2 UNION C3 SUBSET A /\
+     (simple_arc_end C1 x p1) /\
+     (simple_arc_end C2 x p2) /\
+     (simple_arc_end C3 x p3) /\
+     (C1 INTER C2 = {x}) /\
+     (C1 INTER C3 = {x}) /\
+     ~(C2 p3) /\ ~(C3 p2)) ==>
+     (?x' C1' C2' C3'.
+     (C1' UNION C2' UNION C3' SUBSET A) /\
+     (simple_arc_end C1' x' p1) /\
+     (simple_arc_end C2' x' p2) /\
+     (simple_arc_end C3' x' p3) /\
+     (C1' INTER C2' = {x'}) /\
+     (C2' INTER C3' = {x'}) /\
+     (C3' INTER C1' = {x'})
+     )`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPEL_THEN[`C2`;`C3`;`{p2}`] (fun t -> ANT_TAC (ISPECL t simple_arc_end_restriction));
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_closed;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end_closed;
+  TYPE_THEN `C2` EXISTS_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  REWRITE_TAC[EQ_EMPTY;INTER;INR IN_SING];
+  TYPE_THEN `C2 p2` SUBGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end2];
+  TYPE_THEN `C2 x` SUBGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end];
+  TYPE_THEN `C3 x` SUBGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end];
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `v' = p2` SUBGOAL_TAC;
+  UND 8;
+  REWRITE_TAC[eq_sing; INR IN_SING;];
+  REWRITE_TAC[INTER;INR IN_SING ];
+  MESON_TAC[];
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  KILL 8;
+  TYPE_THEN `v` EXISTS_TAC;
+  LEFT_TAC "C2'";
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* A easy case *)
+  TYPE_THEN `v = x` ASM_CASES_TAC;
+  FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN REWRITE_TAC[t]);
+  TYPE_THEN `C' = C2` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_inj;
+  TYPE_THEN `C2` EXISTS_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  TYPE_THEN `p2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET_REFL];
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN REWRITE_TAC[t]);
+  TYPE_THEN `C1` EXISTS_TAC;
+  TYPE_THEN `C3` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC [INTER_COMM];
+  ASM_REWRITE_TAC[];
+  (* [B] general case *)
+  TYPEL_THEN [`C3`;`x`;`p3`;`v`] (fun t-> ANT_TAC (ISPECL t simple_arc_end_cut));
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 9;
+  REWRITE_TAC[eq_sing;INTER];
+  MESON_TAC[];
+  DISCH_TAC;
+  FIRST_ASSUM (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  TYPE_THEN `C' p3` SUBGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end];
+  UND 1;
+  UND 11;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `C1 UNION C''` EXISTS_TAC;
+  TYPE_THEN `C'''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(C1 UNION C'') UNION C' UNION C''' = C1 UNION C' UNION (C'' UNION C''')` SUBGOAL_TAC;
+  SET_TAC[UNION];
+  DISCH_THEN_REWRITE;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C1 UNION C2 UNION C3` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC subset_union_pair ;
+  REWRITE_TAC[SUBSET_REFL];
+  IMATCH_MP_TAC  subset_union_pair ;
+  ASM_REWRITE_TAC[SUBSET_REFL];
+  (* -- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  IMATCH_MP_TAC  simple_arc_end_trans;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR IN_SING ];
+  GEN_TAC;
+  EQ_TAC ;
+  UND 2;
+  TYPE_THEN `C'' SUBSET C3` SUBGOAL_TAC;
+  UND 12;
+  SET_TAC [SUBSET;UNION];
+  REWRITE_TAC[eq_sing;INTER;SUBSET];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
+  (* --[a] *)
+  TYPE_THEN `(C1 UNION C'') v /\ (C' v) /\ (C''' v)` SUBGOAL_TAC;
+  REWRITE_TAC[UNION];
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  DISJ2_TAC;
+  ASM_MESON_TAC[simple_arc_end_end2];
+  ASM_MESON_TAC[simple_arc_end_end;];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `C''' SUBSET C3` SUBGOAL_TAC;
+  UND 12;
+  SET_TAC[UNION;SUBSET];
+  DISCH_TAC;
+  TYPE_THEN `C' INTER C''' = {v}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING];
+  GEN_TAC;
+  EQ_TAC;
+  UND 17;
+  UND 9;
+  REWRITE_TAC[eq_sing;SUBSET;INTER];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[INTER;];
+  DISCH_THEN_REWRITE;
+  (* -- *)
+  TYPEL_THEN [`C2`;`p2`;`x`;`v`] (fun t-> ANT_TAC(ISPECL t simple_arc_end_cut));
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 11;
+  REP_BASIC_TAC;
+  UND 11;
+  UND 18;
+  MESON_TAC[ISUBSET];
+  IMATCH_MP_TAC  simple_arc_end_distinct;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `C'''' = C'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_inj;
+  TYPE_THEN `C2` EXISTS_TAC;
+  TYPE_THEN `p2` EXISTS_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  UND 16;
+  SET_TAC[UNION;SUBSET];
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  (* -- *)
+  TYPE_THEN `~C' x` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  REWR 24;
+  TYPE_THEN `C''''' x` SUBGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end2];
+  UND 8;
+  UND 18;
+  UND 24;
+  REWRITE_TAC[eq_sing;INTER;];
+  MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  KILL 7;
+  KILL 6;
+  KILL 5;
+  KILL 4;
+  TYPE_THEN `C'' x` SUBGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end];
+  DISCH_TAC;
+  KILL 15;
+  KILL 14;
+  KILL 20;
+  KILL 19;
+  (* --[b] *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;INTER;INR IN_SING];
+  GEN_TAC;
+  EQ_TAC;
+  TYPE_THEN `C'' SUBSET C3` SUBGOAL_TAC;
+  UND 12;
+  SET_TAC[UNION;SUBSET];
+  UND 2;
+  UND 3;
+  UND 11;
+  UND 24;
+  UND 9;
+  REWRITE_TAC[SUBSET;INTER;eq_sing];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  UND 13;
+  REWRITE_TAC[eq_sing;INTER];
+  MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `~ (C''' x)` SUBGOAL_TAC;
+  DISCH_TAC;
+  UND 13;
+  UND 5;
+  UND 4;
+  UND 8;
+  REWRITE_TAC[eq_sing;INTER;];
+  MESON_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;UNION;INR IN_SING];
+  GEN_TAC;
+  EQ_TAC ;
+  UND 13;
+  UND 2;
+  UND 17;
+  UND 5;
+  REWRITE_TAC[SUBSET;INTER;eq_sing];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  UND 23;
+  REWRITE_TAC[UNION];
+  (* Fri Aug 13 20:36:09 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let simple_arc_sep = prove_by_refinement(
+  `!A C1 C2 C3 x p1 p2 p3.
+     (C1 UNION C2 UNION C3 SUBSET A) /\
+     (simple_arc_end C1 x p1) /\ ~(C1 p2) /\ ~(C1 p3) /\
+     (simple_arc_end C2 x p2) /\ ~(C2 p1) /\ ~(C2 p3) /\
+     (simple_arc_end C3 x p3) /\ ~(C3 p1) /\ ~(C3 p2) ==>
+  (?x' C1' C2' C3'.
+     (C1' UNION C2' UNION C3' SUBSET A) /\
+     (simple_arc_end C1' x' p1) /\
+     (simple_arc_end C2' x' p2) /\
+     (simple_arc_end C3' x' p3) /\
+     (C1' INTER C2' = {x'}) /\
+     (C2' INTER C3' = {x'}) /\
+     (C3' INTER C1' = {x'})
+     )`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  DISCH_TAC;
+  IMATCH_MP_TAC  simple_arc_sep2;
+  USE 0 (MATCH_MP simple_arc_sep3);
+  REP_BASIC_TAC;
+  TYPE_THEN `C1'` EXISTS_TAC;
+  TYPE_THEN `C2'` EXISTS_TAC;
+  TYPE_THEN `C3'` EXISTS_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION N *)
+(* ------------------------------------------------------------------ *)
+
+(*  K33 stuff *)
+
+let isthree = prove_by_refinement(
+  `?x. (\t. (t < 3)) x`,
+  (* {{{ proof *)
+
+  [
+  TYPE_THEN `0` EXISTS_TAC;
+  BETA_TAC;
+  ARITH_TAC;
+  (* Sat Aug 14 11:56:32 EDT 2004 *)
+  ]);;
+
+  (* }}} *)
+
+let three_t = new_type_definition "three_t" ("ABS3","REP3")
+  isthree;;
+
+let type_bij = prove_by_refinement(
+  `!X (fXY:A->B) gYX.
+     (!a. fXY (gYX a) = a)  /\ (!r. X r = (gYX (fXY r) = r)) ==>
+    (BIJ fXY X UNIV) /\ (BIJ gYX UNIV X)`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  bij_inj_image;
+  REWRITE_TAC[INJ;SUBSET;IMAGE ;];
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  USE 2 (AP_TERM `gYX:B->A` );
+  REWR 3;
+  REWR 4;
+  REWR 2;
+  (* -- *)
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  GEN_TAC;
+  TYPE_THEN `gYX x''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  IMATCH_MP_TAC  bij_inj_image;
+  REWRITE_TAC[INJ;SUBSET;IMAGE];
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  USE 2(AP_TERM `fXY:A->B`);
+  REWR 2;
+  REP_BASIC_TAC;
+  TYPE_THEN `fXY x` EXISTS_TAC;
+  REWR 2;
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let thr_bij  = prove_by_refinement(
+  `(BIJ ABS3 {x | x < 3} UNIV) /\ (BIJ REP3 UNIV {x | x < 3})`,
+  (* {{{ proof *)
+  [
+  IMATCH_MP_TAC  type_bij ;
+  ASSUME_TAC three_t;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[three_t];
+  REP_BASIC_TAC;
+  UND 0;
+  BETA_TAC;
+  DISCH_THEN_REWRITE;
+  ]);;
+  (* }}} *)
+
+let thr_finite = prove_by_refinement(
+  `(UNIV:three_t->bool) HAS_SIZE 3`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC [has_size_bij2];
+  TYPE_THEN `REP3` EXISTS_TAC;
+  ASM_REWRITE_TAC[thr_bij];
+  (* Sat Aug 14 12:28:58 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let has_size3_bij = prove_by_refinement(
+  `!(A:A->bool).  A HAS_SIZE 3 <=> (?f. BIJ f (UNIV:three_t->bool) A)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[has_size_bij];
+  REP_BASIC_TAC;
+  EQ_TAC;
+  REP_BASIC_TAC;
+  ASSUME_TAC thr_bij;
+  TYPE_THEN `compose f REP3` EXISTS_TAC;
+  IMATCH_MP_TAC  COMP_BIJ;
+  TYPE_THEN `{m | m < 3}` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  REP_BASIC_TAC;
+  TYPE_THEN `compose f ABS3` EXISTS_TAC;
+  IMATCH_MP_TAC  COMP_BIJ;
+  TYPE_THEN `UNIV:three_t->bool` EXISTS_TAC;
+  ASM_REWRITE_TAC[thr_bij];
+  (* Sat Aug 14 12:36:22 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let has_size3_bij2 = prove_by_refinement(
+  `!(A:A->bool). A HAS_SIZE 3 <=> (?f. BIJ f A (UNIV:three_t->bool) )`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[has_size_bij2];
+  GEN_TAC;
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `compose ABS3 f` EXISTS_TAC;
+  IMATCH_MP_TAC  COMP_BIJ;
+  TYPE_THEN `{m | m < 3}` EXISTS_TAC;
+  ASM_REWRITE_TAC[thr_bij];
+  (* -- *)
+  REP_BASIC_TAC;
+  TYPE_THEN `compose REP3 f` EXISTS_TAC;
+  IMATCH_MP_TAC  COMP_BIJ;
+  TYPE_THEN `UNIV:three_t ->bool` EXISTS_TAC;
+  ASM_REWRITE_TAC[thr_bij];
+  (* Sat Aug 14 12:40:48 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let cartesian = jordan_def
+  `cartesian (X:A->bool) (Y:B->bool) =
+       { (x,y) | X x /\ Y y}`;;
+
+let cartesian_pair = prove_by_refinement(
+  `!X Y (x:A) (y:B).  cartesian X Y (x,y) <=> (X x) /\ (Y y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cartesian;PAIR_SPLIT ;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let cartesian_el = prove_by_refinement(
+`!X Y (x:(A#B)).  cartesian X Y x  <=> (X (FST x)) /\ (Y (SND x))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[cartesian];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN`FST x` EXISTS_TAC;
+  TYPE_THEN `SND x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ignore earlier K33 def *)
+
+let k33_graph = jordan_def
+  `k33_graph = mk_graph_t (
+           cartesian (UNIV:three_t ->bool) UNIV,
+           cartesian UNIV UNIV,
+           (\e. { (FST e,T),  (SND e,F)} ) )`;;
+
+let graph_edge_mk_graph = prove_by_refinement(
+  `!(V:A->bool) (E:B->bool) C. graph_edge(mk_graph_t (V,E,C)) = E`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_edge;dest_graph_t;part1;drop0];
+  ]);;
+  (* }}} *)
+
+let graph_vertex_mk_graph = prove_by_refinement(
+ `!(V:A->bool) (E:B->bool) C. graph_vertex(mk_graph_t (V,E,C)) = V`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_vertex;dest_graph_t;];
+  ]);;
+  (* }}} *)
+
+let graph_inc_mk_graph = prove_by_refinement(
+ `!(V:A->bool) (E:B->bool) C. graph_inc(mk_graph_t (V,E,C)) = C`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_inc;dest_graph_t;drop1];
+  ]);;
+  (* }}} *)
+
+let k33_isgraph = prove_by_refinement(
+  `graph (k33_graph)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph;has_size2];
+  REWRITE_TAC[IMAGE;SUBSET;];
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[k33_graph;graph_inc_mk_graph;graph_edge_mk_graph;graph_vertex_mk_graph;in_pair;cartesian];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[in_pair];
+  CONJ_TAC;
+  GEN_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  TYPE_THEN `(x,T)` EXISTS_TAC;
+  TYPE_THEN `(y,F)` EXISTS_TAC;
+  REWRITE_TAC[];
+  REWRITE_TAC[PAIR_SPLIT];
+  (* Sat Aug 14 13:18:16 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let k33_iso = prove_by_refinement(
+  `!(A:A->bool) B (E:B->bool) f.
+      A HAS_SIZE 3 /\ B HAS_SIZE 3 /\ (A INTER B = EMPTY) /\
+      BIJ f E (cartesian A B) ==>
+    (graph_isomorphic k33_graph
+         (mk_graph_t
+             (A UNION B, E,( \ e. { (FST (f e)), (SND (f e)) }))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[graph_isomorphic;graph_iso;k33_graph;graph_edge_mk_graph;graph_vertex_mk_graph;graph_inc_mk_graph;];
+  RULE_ASSUM_TAC (REWRITE_RULE[has_size3_bij]);
+  REP_BASIC_TAC;
+  TYPE_THEN `u = ( \ t. (if (SND t) then (f'' (FST t)) else (f'(FST t))))` ABBREV_TAC ;
+  LEFT_TAC "u";
+  TYPE_THEN `u` EXISTS_TAC;
+  TYPE_THEN `g = INV f E (cartesian A B)` ABBREV_TAC ;
+  TYPE_THEN `v = ( \t . (g (f'' (FST t), f' (SND t))))` ABBREV_TAC ;
+  LEFT_TAC "v";
+  TYPE_THEN `v` EXISTS_TAC;
+  TYPE_THEN `(u,v)` EXISTS_TAC;
+  REWRITE_TAC[];
+  (* A  u *)
+  CONJ_TAC;
+  REWRITE_TAC[BIJ;SURJ;INJ];
+  SUBCONJ_TAC ;
+  CONJ_TAC;
+  EXPAND_TAC "u";
+  REWRITE_TAC[cartesian_el];
+  REWRITE_TAC[UNION;];
+  GEN_TAC;
+  COND_CASES_TAC;
+  UND 2;
+  REWRITE_TAC[BIJ;SURJ];
+  MESON_TAC[];
+  UND 3;
+  REWRITE_TAC[BIJ;SURJ];
+  MESON_TAC[];
+  REWRITE_TAC[cartesian_el;];
+  EXPAND_TAC "u";
+  REP_GEN_TAC ;
+  COND_CASES_TAC;
+  COND_CASES_TAC;
+  UND 2;
+  REWRITE_TAC[BIJ;INJ];
+  REP_BASIC_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 1;
+  REWRITE_TAC[EMPTY_EXISTS ];
+  TYPE_THEN `f'' (FST x)` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  ASM_MESON_TAC[];
+  COND_CASES_TAC;
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 1;
+  REWRITE_TAC[EMPTY_EXISTS ];
+  TYPE_THEN `f' (FST x)` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  ASM_MESON_TAC[];
+  REWRITE_TAC[PAIR_SPLIT];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  USE 3(REWRITE_RULE[BIJ;INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE ;
+  REWRITE_TAC[UNION];
+  GEN_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPE_THEN `( ((INV f'' UNIV A) x ), T )` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[cartesian_el];
+  EXPAND_TAC "u";
+  REWRITE_TAC[SND ];
+  IMATCH_MP_TAC  inv_comp_right;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `( ((INV f' UNIV B) x ), F )` EXISTS_TAC;
+  REWRITE_TAC[cartesian_el];
+  EXPAND_TAC "u";
+  REWRITE_TAC[SND ];
+  IMATCH_MP_TAC  inv_comp_right;
+  ASM_REWRITE_TAC[];
+  (* B graph_inc  *)
+  REWRITE_TAC[cartesian_el];
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  CONJ_TAC;
+  GEN_TAC;
+  EXPAND_TAC "u";
+  REWRITE_TAC[IMAGE_CLAUSES];
+  EXPAND_TAC "v";
+  EXPAND_TAC "g";
+  TYPE_THEN `cartesian A B (f'' (FST e), f' (SND e))` SUBGOAL_TAC;
+  REWRITE_TAC[cartesian_el];
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  ASM_MESON_TAC[];
+  ASM_SIMP_TAC[inv_comp_right];
+  (* C  BIJ v *)
+  TYPE_THEN `BIJ g (cartesian A B) E` SUBGOAL_TAC;
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  INVERSE_BIJ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  REWRITE_TAC[cartesian_el];
+  EXPAND_TAC "v";
+  CONJ_TAC;
+  (* --- *)
+  USE 7(REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[cartesian_el];
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `(f'' (FST x),f' (SND x)) = (f''(FST y),f' (SND y))` SUBGOAL_TAC;
+  USE 7(REWRITE_RULE[BIJ;INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC [cartesian_el];
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  ASM_MESON_TAC[];
+  REWRITE_TAC[PAIR_SPLIT];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  USE 2 (REWRITE_RULE[BIJ;INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  USE 3 (REWRITE_RULE[BIJ;INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  REWRITE_TAC[INJ;SURJ];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[cartesian_el];
+  EXPAND_TAC "v";
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `?u0. (f'' u0 = FST (f x))` SUBGOAL_TAC ;
+  USE 2 (REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 0 (REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC;
+  TSPEC `x` 11;
+  REWR 11;
+  USE 11(REWRITE_RULE[cartesian_el]);
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `?u1. (f' u1 = SND (f x))` SUBGOAL_TAC ;
+  USE 3 (REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 0 (REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC;
+  TSPEC `x` 12;
+  REWR 12;
+  USE 12(REWRITE_RULE[cartesian_el]);
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `(u0,u1)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  inv_comp_left;
+  ASM_REWRITE_TAC[];
+  (* Sat Aug 14 14:58:11 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+
+(* ********************************************************* *)
+
+let mk_segment_inj_image2 = prove_by_refinement(
+  `!x y n.
+    euclid n x /\ euclid n y /\ ~(x = y)
+          ==> (?f. continuous f (top_of_metric (UNIV,d_real))
+                   (top_of_metric (euclid n,d_euclid)) /\
+                   INJ f {x | &0 <= x /\ x <= &1} (euclid n) /\
+                   (f (&0) = x) /\ (f (&1) = y) /\
+                   (IMAGE f {t | &0 <= t /\ t <= &1} = mk_segment x y))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `(joinf (\u. x) (joinf (\t. euclid_plus (t *# y) ((&1 - t) *# x)) (\u. y) (&.1)) (&.0))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  cont_mk_segment;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[joinf;IMAGE ];
+  REWRITE_TAC[mk_segment];
+  (* new new *)
+  TYPE_THEN `((if &0 < &0   then x   else if &0 < &1 then euclid_plus (&0 *# y) ((&1 - &0) *# x) else y) =  x) /\ ((if &1 < &0   then x   else if &1 < &1 then euclid_plus (&1 *# y) ((&1 - &1) *# x) else y) =  y)` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_ARITH `~(&0 < &0) /\ ~(&1 < &0) /\ (&0 < &1) /\ ~(&1 < &1)`];
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale0; euclid_scale_one ; euclid_lzero];
+  DISCH_THEN_REWRITE;
+  (* end new new *)
+  CONJ_TAC;
+  (* new stuff *)
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
+  UND 4;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_CASES_TAC `x' < &1`;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  euclid_add_closure;
+  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  UND 3;
+  TYPE_THEN `~(x' < &0)` SUBGOAL_TAC;
+  UND 7;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `~(y' < &0)` SUBGOAL_TAC;
+  UND 5;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `(if (x' < &1) then (euclid_plus (x' *# y) ((&1 - x') *# x)) else y) = ( euclid_plus (x' *# y) ((&1 - x') *# x))` SUBGOAL_TAC;
+ TYPE_THEN `(x' < &1) \/ (x' = &1)` SUBGOAL_TAC;
+  UND 6;
+  REAL_ARITH_TAC;
+  DISCH_THEN   DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `~(x' < &1)` SUBGOAL_TAC;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
+  DISCH_THEN_REWRITE;
+
+  TYPE_THEN `(if (y' < &1) then (euclid_plus (y' *# y) ((&1 - y') *# x)) else y) = ( euclid_plus (y' *# y) ((&1 - y') *# x))` SUBGOAL_TAC;
+ TYPE_THEN `(y' < &1) \/ (y' = &1)` SUBGOAL_TAC;
+  UND 4;
+  REAL_ARITH_TAC;
+  DISCH_THEN   DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `~(y' < &1)` SUBGOAL_TAC;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale_one;euclid_scale0;euclid_rzero];
+  DISCH_THEN_REWRITE;
+  (* th *)
+  ONCE_REWRITE_TAC [euclid_eq_minus];
+  REWRITE_TAC[euclid_minus_scale;euclid_ldistrib;euclid_scale_act];
+  ONCE_REWRITE_TAC [euclid_plus_pair];
+  REWRITE_TAC[GSYM euclid_rdistrib];
+  REDUCE_TAC;
+  REWRITE_TAC[REAL_ARITH  `x' + -- &1 * y' = x' - y'`];
+  REWRITE_TAC[REAL_ARITH `&1 - x' - (&1 - y') = -- &1 *(x' - y')`];
+  REWRITE_TAC[GSYM euclid_scale_act;GSYM euclid_minus_scale;ONCE_REWRITE_RULE[EQ_SYM_EQ] euclid_eq_minus];
+  (* th1 *)
+  DISCH_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 2;
+  REWRITE_TAC[];
+  IMATCH_MP_TAC  euclid_scale_cancel;
+  TYPE_THEN `(x' - y')` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 8;
+  REAL_ARITH_TAC;
+  KILL 2;
+  (* old stuff *)
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  ASM_REWRITE_TAC[];
+  EQ_TAC;
+  DISCH_TAC;
+  CHO 2;
+  UND 2;
+  COND_CASES_TAC;
+  DISCH_ALL_TAC;
+  JOIN 3 2;
+  ASM_MESON_TAC[REAL_ARITH `~(&0 <=. x /\ x < &.0)`];
+  DISCH_ALL_TAC;
+  UND 5;
+  COND_CASES_TAC;
+  DISCH_TAC;
+  TYPE_THEN `&1 - x''` EXISTS_TAC;
+  SUBCONJ_TAC;
+  UND 5;
+  REAL_ARITH_TAC ;
+  DISCH_TAC;
+  CONJ_TAC;
+  UND 3;
+  REAL_ARITH_TAC ;
+  ONCE_REWRITE_TAC [euclid_add_comm];
+  REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `&0` EXISTS_TAC;
+  CONJ_TAC;
+  REAL_ARITH_TAC ;
+  CONJ_TAC;
+  REAL_ARITH_TAC ;
+  REWRITE_TAC[euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
+  (* 2nd half *)
+  DISCH_TAC;
+  CHO 2;
+  TYPE_THEN `&1 - a` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  AND 2;
+  AND 2;
+  UND 3;
+  UND 4;
+  REAL_ARITH_TAC ;
+  COND_CASES_TAC;
+  ASM_MESON_TAC[REAL_ARITH `&1 - a < &0 ==> ~(a <= &1)`];
+  COND_CASES_TAC;
+  REWRITE_TAC[REAL_ARITH `&1 - (&1 - a) = a`];
+  ASM_MESON_TAC [euclid_add_comm];
+  TYPE_THEN `a = &.0` SUBGOAL_TAC;
+  UND 4;
+  UND 3;
+  AND 2;
+  UND 3;
+  REAL_ARITH_TAC ;
+  DISCH_TAC;
+  REWR 2;
+  REWRITE_TAC [euclid_scale_one; euclid_scale0; euclid_lzero;REAL_ARITH `&1 - &0 = &1` ];
+   ]);;
+  (* }}} *)
+
+let mk_segment_simple_arc_end = prove_by_refinement(
+  `!x y.
+     (euclid 2 x) /\ (euclid 2 y) /\ ~(x = y) ==>
+       simple_arc_end (mk_segment x y) x y`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[simple_arc_end];
+  TYPEL_THEN [`x`;`y`;`2`] (fun t-> ANT_TAC (ISPECL t mk_segment_inj_image2));
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `f` EXISTS_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[GSYM top2 ]);
+  ASM_REWRITE_TAC[];
+  (* Tue Aug 17 10:10:00 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let cis0 = prove_by_refinement(
+  `cis (&0) = e1`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cis;COS_0;SIN_0;e1;];
+  ]);;
+  (* }}} *)
+
+let cispi2 = prove_by_refinement(
+  `cis (pi/(&2)) = e2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC [cis;COS_PI2;SIN_PI2;e2];
+  ]);;
+  (* }}} *)
+
+let neg_point = prove_by_refinement(
+  `!x y. -- (point (x,y)) = point (--x, --y)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[euclid_neg];
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  BETA_TAC;
+  MP_TAC (ARITH_RULE  `(x' = 0) \/ (x' = 1) \/ (2 <=| x')`);
+  REP_CASES_TAC ;
+  ASM_REWRITE_TAC[coord01];
+  ASM_REWRITE_TAC[coord01];
+  TYPE_THEN `euclid 2(point(x,y)) /\ euclid 2(point(--x,--y))` SUBGOAL_TAC;
+  ASM_MESON_TAC[euclid_point];
+  REWRITE_TAC[euclid];
+  REP_BASIC_TAC;
+  TSPEC `x'` 1;
+  TSPEC `x'` 2;
+  ASM_MESON_TAC[REAL_ARITH `-- &0 = &0`];
+  (* Tue Aug 17 10:27:14 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let cispi = prove_by_refinement(
+  `cis(pi) = -- e1`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cis;COS_PI ;SIN_PI;e1];
+  REWRITE_TAC[neg_point];
+  AP_TERM_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  REAL_ARITH_TAC;
+  (* Tue Aug 17 10:28:55 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let cis3pi2 = prove_by_refinement(
+  `cis(&3 *pi/(&2)) = -- e2`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `&3 *pi/(&2) = pi/(&2) + pi` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_ARITH `&3 = &1 + &1 + &1`];
+  REWRITE_TAC[REAL_ARITH `(x + y)*z = x*z + y*z`];
+  REDUCE_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[cis;COS_PERIODIC_PI;SIN_PERIODIC_PI;GSYM neg_point;];
+  AP_TERM_TAC;
+  REWRITE_TAC[GSYM cis;cispi2];
+  (* Tue Aug 17 10:34:32 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let closedball_convex = prove_by_refinement(
+  `!x e n. (convex (closed_ball (euclid n,d_euclid) x e))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[convex;closed_ball;SUBSET;mk_segment;];
+  REP_BASIC_TAC;
+  USE 0 SYM;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  EXPAND_TAC "x''";
+  IMATCH_MP_TAC  (euclid_add_closure);
+  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
+  DISCH_TAC;
+  TYPE_THEN `d_euclid x x'' = d_euclid (a *# x + (&1 - a) *# x) x''` SUBGOAL_TAC;
+  REWRITE_TAC[trivial_lin_combo];
+  DISCH_THEN_REWRITE;
+  EXPAND_TAC "x''";
+  (* special case *)
+  ASM_CASES_TAC `a = &0` ;
+  UND 10;
+  DISCH_THEN_REWRITE;
+  REDUCE_TAC;
+  ASM_REWRITE_TAC [euclid_scale0;euclid_scale_one;euclid_lzero;];
+  TYPE_THEN `(!d. (?u v. (d <= u + v) /\ (u <= a*e) /\ (v <= (&1- a)*e))  ==> (d <= e))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `u + v <= (a*e) + (&1 - a)*e` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LE_ADD2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1 * C = C )`];
+  UND 13;
+  REAL_ARITH_TAC ;
+  DISCH_THEN IMATCH_MP_TAC ;
+  TYPE_THEN `z = a *# x' + (&1 - a) *# x` ABBREV_TAC;
+  TYPE_THEN `d_euclid (a *# x + (&1 - a)*# x) z` EXISTS_TAC;
+  TYPE_THEN `d_euclid z x''` EXISTS_TAC;
+  TYPE_THEN `euclid n z` SUBGOAL_TAC;
+  EXPAND_TAC "z";
+  IMATCH_MP_TAC  (euclid_add_closure);
+  CONJ_TAC THEN (IMATCH_MP_TAC  euclid_scale_closure) THEN (ASM_REWRITE_TAC[]);
+  DISCH_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "x''";
+  IMATCH_MP_TAC  metric_space_triangle;
+  TYPE_THEN `euclid n` EXISTS_TAC;
+  REWRITE_TAC[metric_euclid];
+  ASM_REWRITE_TAC[trivial_lin_combo];
+  CONJ_TAC;
+  EXPAND_TAC "z";
+  TYPE_THEN `(d_euclid (euclid_plus (a *# x) ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# x))) = d_euclid  (a *# x) (a *# x') ` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_translate;
+  TYPE_THEN `n` EXISTS_TAC;
+  REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `d_euclid (a *# x) (a *# x')  = abs  (a) * d_euclid x x'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  norm_scale_vec;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `abs  a = a` SUBGOAL_TAC;
+  ASM_MESON_TAC[REAL_ABS_REFL];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
+  ASM_REWRITE_TAC[];
+
+  (* LAST case *)
+  EXPAND_TAC "z";
+  EXPAND_TAC "x''";
+  TYPE_THEN `d_euclid (euclid_plus (a *# x') ((&1 - a) *# x)) (euclid_plus (a *# x') ((&1 - a) *# y)) = d_euclid ((&1 - a) *# x) ((&1 - a) *# y)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_translate_LEFT;
+  TYPE_THEN `n` EXISTS_TAC;
+  REPEAT (CONJ_TAC THEN TRY (IMATCH_MP_TAC  euclid_scale_closure) THEN ASM_REWRITE_TAC[]);
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `!b. d_euclid (b *# x) (b *# y)  = abs  (b) * d_euclid x y` SUBGOAL_TAC;
+  GEN_TAC;
+  IMATCH_MP_TAC  norm_scale_vec;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `abs  (&1 - a) = (&1 - a)` SUBGOAL_TAC;
+  REWRITE_TAC [REAL_ABS_REFL];
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
+  ASM_REWRITE_TAC[];
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let closedball_mk_segment_end = prove_by_refinement(
+  `!x e n u v.
+     (closed_ball(euclid n,d_euclid) x e u) /\
+     (closed_ball(euclid n,d_euclid) x e v) ==>
+     (mk_segment u v SUBSET (closed_ball(euclid n,d_euclid) x e))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASSUME_TAC closedball_convex;
+  TYPEL_THEN [`x`;`e`;`n`] (USE 2 o ISPECL);
+  USE 2 (REWRITE_RULE[convex]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let euclid2_e12 = prove_by_refinement(
+  `euclid 2 e1 /\ euclid 2 e2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[e1;e2;euclid_point];
+  ]);;
+  (* }}} *)
+
+let in_union = prove_by_refinement(
+  `!X Y Z. (X:A->bool) SUBSET Y \/ (X SUBSET Z) ==> (X SUBSET Y UNION Z)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;UNION ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let mk_segment_hyperplane = prove_by_refinement(
+  `!p r i. (i < 4) /\ (&0 <r) /\ (euclid 2 p) ==>
+    (mk_segment p (p + r *# (cis(&i * pi/(&2))))) SUBSET
+     (hyperplane 2 e2 (p 1) UNION
+                     hyperplane 2 e1 (p 0))  `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `?x y. p = point (x,y)` SUBGOAL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  REP_BASIC_TAC;
+  TYPE_THEN `FST p'` EXISTS_TAC;
+  TYPE_THEN `SND p'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  UND 3;
+  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
+  REWRITE_TAC[coord01];
+  (* -- *)
+  TYPE_THEN `convex(hyperplane 2 e2 y)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  hyperplane_convex;
+  REWRITE_TAC[euclid2_e12];
+  TYPE_THEN `convex(hyperplane 2 e1 x)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  hyperplane_convex;
+  REWRITE_TAC[euclid2_e12];
+  REWRITE_TAC[convex];
+  REP_BASIC_TAC;
+  TYPE_THEN `hyperplane 2 e1 x (point(x,y)) /\ hyperplane 2 e2 y (point(x,y))` SUBGOAL_TAC;
+  REWRITE_TAC[e1;e2;GSYM line2D_S;GSYM  line2D_F];
+  CONJ_TAC;
+  TYPE_THEN `(x,y)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(x,y)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  USE 2 (MATCH_MP (ARITH_RULE (`(i < 4) ==> (i = 0) \/ (i = 1) \/ (i = 2) \/ (i = 3)`)));
+  (* -- *)
+  IMATCH_MP_TAC  in_union;
+  TYPE_THEN `z = (euclid_plus (point (x,y)) (r *# cis (&i * pi / &2)))` ABBREV_TAC ;
+  TYPE_THEN `hyperplane 2 e2 y z \/ hyperplane 2 e1 x z ==> mk_segment (point (x,y)) z SUBSET hyperplane 2 e2 y \/  mk_segment (point (x,y)) z SUBSET hyperplane 2 e1 x` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  (* -- *)
+  TYPE_THEN `( (cis (&i *pi/(&2))) 0 = &0) ==> (hyperplane 2 e1 x z)` SUBGOAL_TAC;
+  REWRITE_TAC[e1;GSYM line2D_F];
+  EXPAND_TAC "z";
+  REWRITE_TAC[cis;coord01];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[point_scale;point_add];
+  REDUCE_TAC;
+  TYPE_THEN `(x, y+ r*sin (&i *pi/(&2)))` EXISTS_TAC;
+  REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `( (cis (&i *pi/(&2))) 1 = &0) ==> (hyperplane 2 e2 y z)` SUBGOAL_TAC;
+  REWRITE_TAC[e2;GSYM line2D_S];
+  EXPAND_TAC "z";
+  REWRITE_TAC[cis;coord01];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[point_scale;point_add];
+  REDUCE_TAC;
+  TYPE_THEN `(x + r*cos(&i *pi/(&2)) , y)` EXISTS_TAC;
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `(cis (&i * pi / &2) 0 = &0) \/ (cis (&i * pi / &2) 1 = &0) ==> hyperplane 2 e2 y z \/ hyperplane 2 e1 x z` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN IMATCH_MP_TAC ;
+  UND 2;
+  POP_ASSUM_LIST (fun t-> ALL_TAC);
+  (* A -- *)
+  REP_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[cis0;e1;coord01];
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[cispi2;e2;coord01];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_MUL_2];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[cispi;e1;coord01;neg_point];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[cis3pi2;e2;coord01;neg_point];
+  REDUCE_TAC;
+  (* Tue Aug 17 11:46:56 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let d_euclid_mk_segment = prove_by_refinement(
+  `!n a p q . (&0 <= a) /\ (a <= &1) /\ (euclid n p) /\ (euclid n q) ==>
+      (d_euclid p (a*#p + (&1 - a)*#q) = (&1 - a)*(d_euclid p q))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `!z. d_euclid (a*# p + (&1 - a)*# p) z = d_euclid p z` SUBGOAL_TAC;
+  REWRITE_TAC[trivial_lin_combo];
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
+  TYPE_THEN `d_euclid (euclid_plus (a *# p) ((&1 - a) *# p)) (euclid_plus (a *# p) ((&1 - a) *# q)) = d_euclid ( ((&1 - a) *# p)) ( ((&1 - a) *# q))` SUBGOAL_TAC;
+  ASM_MESON_TAC [metric_translate_LEFT;euclid_scale_closure];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `d_euclid ((&1 - a) *# p) ((&1 - a) *# q) = abs  (&1- a) * d_euclid p q` SUBGOAL_TAC;
+  ASM_MESON_TAC[euclid_scale_closure;norm_scale_vec];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `abs  (&1 - a) = (&1 - a)` SUBGOAL_TAC;
+  UND 2;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[trivial_lin_combo];
+  (* Tue Aug 17 12:24:07 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let mk_segment_eq = prove_by_refinement(
+  `! a p x y. ((a*# p + (&1 - a)*# x) = (a *# p + (&1 - a)*# y)) ==>
+      (a = &1) \/ (x = y)`,
+  (* {{{ proof *)
+  [
+  ONCE_REWRITE_TAC[euclid_eq_minus];
+  REWRITE_TAC[euclid_minus;euclid_plus;euclid0;euclid_scale];
+  REP_BASIC_TAC;
+  USE 0 (REWRITE_RULE[FUN_EQ_THM]);
+  IMATCH_MP_TAC  (TAUT `(~A ==>B) ==> (A \/ B)`);
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  BETA_TAC;
+  USE 0 (SPEC `x':num` );
+  UND 0;
+  REWRITE_TAC[REAL_ARITH  `(a*b + r*c ) - (a*b + r*d) = r*c - r*d`];
+  REWRITE_TAC[REAL_ARITH `a*y - a*z = a*(y-z)`];
+  REWRITE_TAC[REAL_ENTIRE];
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let mk_segment_endpoint = prove_by_refinement(
+  `!p x y n . (d_euclid p x = d_euclid p y) /\ ~(x = y) /\
+       (euclid n x) /\ (euclid n y) /\ (euclid n p) ==>
+    (mk_segment p x INTER mk_segment p y = {p})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR IN_SING];
+  GEN_TAC;
+  (* A -- *)
+  EQ_TAC;
+  REWRITE_TAC[mk_segment];
+  REP_BASIC_TAC;
+  UND 5;
+  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `~(a' = &1)` SUBGOAL_TAC;
+  DISCH_TAC;
+  UND 11;
+  DISCH_THEN (fun t -> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  UND 5;
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_rzero];
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `(&1- a')*d_euclid p y = (&1- a)*d_euclid p x` SUBGOAL_TAC;
+  KILL 4;
+  ASM_MESON_TAC[d_euclid_mk_segment];
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  REWR 12;
+  (* -- *)
+  TYPE_THEN `d_euclid p y = &0` ASM_CASES_TAC;
+  TYPE_THEN `p = y` SUBGOAL_TAC;
+  ASM_MESON_TAC [d_euclid_zero];
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  ASM_MESON_TAC[d_euclid_zero];
+  USE 12 (REWRITE_RULE[REAL_EQ_MUL_RCANCEL]);
+  REWR 12;
+  TYPE_THEN `a' = a` SUBGOAL_TAC;
+  UND 12;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  USE 8 (MATCH_MP mk_segment_eq);
+  REWR 8;
+  (* -- *)
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[mk_segment_end];
+  (* Tue Aug 17 14:04:19 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let cases4 = prove_by_refinement(
+  `!i j.  (i < j) /\ (j < 4) ==> ((i=0) /\ (j=1))\/ ((i=0) /\ (j=2)) \/
+           ((i=0) /\ (j=3)) \/ ((i=1) /\ (j=2)) \/ ((i=1) /\ (j=3)) \/
+         ((i=2)/\ (j=3))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `!k. (k < 4) ==> (k = 0) \/ (k =1)\/ (k=2) \/ (k=3)` SUBGOAL_TAC;
+  ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `(j = 0) \/ (j = 1) \/ (j = 2) \/ (j = 3)` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~(j=0)` SUBGOAL_TAC;
+  UND 1;
+  ARITH_TAC;
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  TYPE_THEN `(i < 3)` SUBGOAL_TAC;
+  UND 0;
+  UND 1;
+  ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `(i=0) \/ (i = 1) \/ (i=2)` SUBGOAL_TAC;
+  UND 4;
+  ARITH_TAC;
+  DISCH_TAC;
+  JOIN 5 3;
+  USE 3 (REWRITE_RULE [RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR]);
+  TYPE_THEN `!k. ~((i = k) /\ (j = k))` SUBGOAL_TAC;
+  GEN_TAC;
+  UND 1;
+  ARITH_TAC;
+  DISCH_THEN (fun t-> USE 3 (REWRITE_RULE[t]));
+  TYPE_THEN `~((i=2) /\ (j = 1))` SUBGOAL_TAC;
+  UND 1;
+  ARITH_TAC ;
+  DISCH_THEN (fun t-> USE 3(REWRITE_RULE[t]));
+  ASM_REWRITE_TAC[];
+  UND 3;
+  REP_CASES_TAC THEN (ASM_REWRITE_TAC[]);
+  ]);;
+  (* }}} *)
+
+let cis_distinct = prove_by_refinement(
+  `!i j r p. (i < 4) /\ (j < 4) /\ ~(i = j) /\ (&0 < r) ==>
+        ~((p + r*# (cis(&i * pi/(&2)))) = (p + r*# (cis(&j * pi/(&2)))))`,
+  (* {{{ proof *)
+
+  [
+  TYPE_THEN `!i j r p. (i < 4) /\ (j < 4) /\ ~(i = j) /\ (i < j) /\ (&0 < r) ==> ~((p + r*# (cis(&i * pi/(&2)))) = (p + r*# (cis(&j * pi/(&2)))))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `!p x y. (euclid_plus p x = euclid_plus p y) ==> (x = y)` SUBGOAL_TAC;
+  REWRITE_TAC[euclid_plus];
+  REP_BASIC_TAC;
+  USE 6 (REWRITE_RULE[FUN_EQ_THM]);
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  TSPEC `x'` 6;
+  UND 6;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> USE 0 (MATCH_MP t));
+  USE 0 (AP_TERM `( *# ) (&1/r)`);
+  USE 0 (REWRITE_RULE [euclid_scale_act]);
+  TYPE_THEN `&1/r * r = &1` SUBGOAL_TAC;
+  ONCE_REWRITE_TAC [REAL_ARITH `x*y = y*x`];
+  ASM_MESON_TAC[REAL_DIV_LMUL;REAL_ARITH `&0 < r ==> ~(r = &0)`];
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  USE 0(REWRITE_RULE[euclid_scale_one]);
+  TYPE_THEN `((i=0) /\ (j=1))\/ ((i=0) /\ (j=2)) \/ ((i=0) /\ (j=3)) \/ ((i=1) /\ (j=2)) \/ ((i=1) /\ (j=3)) \/ ((i=2)/\ (j=3))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cases4;
+  ASM_REWRITE_TAC[];
+  REP_CASES_TAC THEN (FIRST_ASSUM MP_TAC) THEN (DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t;REAL_ARITH `(&1*x=x) /\ (&0*x= &0)`;e1;e2;cis0;cispi;cispi2;cis3pi2;neg_point;point_inj; PAIR_SPLIT; REAL_ARITH `~(&1 = &0) /\ ~(&0 = &1) /\ (-- &0 = &0) /\ ~(&1 = -- &1) /\ ~(-- &1 = &0) /\ ~(&0 = -- &1)`;REAL_MUL_2; REAL_HALF_DOUBLE ]))) THEN (ASM_REWRITE_TAC[]);
+  REP_BASIC_TAC;
+  TYPE_THEN `( i <| j) \/ (j <| i)` SUBGOAL_TAC;
+  UND 2;
+  ARITH_TAC;
+  REP_CASES_TAC;
+  TYPEL_THEN [`i`;`j`;`r`] (USE 5 o ISPECL);
+  ASM_MESON_TAC[];
+  TYPEL_THEN [`j`;`i`;`r`] (USE 5 o ISPECL);
+  ASM_MESON_TAC[];
+  (* Tue Aug 17 15:01:38 EDT 2004 *)
+
+
+
+
+  ]);;
+
+  (* }}} *)
+
+let cis_nz = prove_by_refinement(
+  `!t. ~(cis(t) = euclid0)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  USE 0 (AP_TERM `norm2`);
+  RULE_ASSUM_TAC (REWRITE_RULE[norm2_cis]);
+  ASM_MESON_TAC[REAL_ARITH `~(&1= &0)`;norm2_0;];
+  ]);;
+  (* }}} *)
+
+let polar_nz = prove_by_refinement(
+  `!r t. ~(r = &0) ==> ~(r *# cis(t) =euclid0)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  USE 0 (AP_TERM `norm2`);
+  RULE_ASSUM_TAC (REWRITE_RULE[norm2_scale_cis]);
+  ASM_MESON_TAC[REAL_ARITH `(abs  r = &0) ==> (r = &0)`;norm2_0];
+  ]);;
+  (* }}} *)
+
+let polar_euclid = prove_by_refinement(
+  `!r t. euclid 2 (r *# (cis t))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cis;point_scale;euclid_point];
+  ]);;
+  (* }}} *)
+
+let d_euclidpq = prove_by_refinement(
+  `!n p q . (euclid n p) /\ (euclid n q) ==> (d_euclid p (p+q) =
+      d_euclid q euclid0)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `!z. d_euclid p z = d_euclid (p + euclid0) z` SUBGOAL_TAC;
+  REWRITE_TAC[euclid_rzero];
+  DISCH_THEN (fun t->ONCE_REWRITE_TAC[t]);
+  TYPE_THEN `d_euclid (euclid_plus p euclid0) (euclid_plus p q) = d_euclid euclid0 q` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_translate_LEFT;
+  TYPE_THEN `n` EXISTS_TAC;
+  ASM_REWRITE_TAC[euclid_euclid0;polar_euclid;];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC metric_space_symm;
+  TYPE_THEN `euclid n` EXISTS_TAC ;
+  ASM_REWRITE_TAC[metric_euclid;euclid_euclid0;polar_euclid];
+  ]);;
+  (* }}} *)
+
+let degree4_vertex_hv = prove_by_refinement(
+  `!r p. (&0 < r) /\ (euclid 2 p) ==>
+    (?C.
+        (!i. (i< 4) ==>
+           simple_arc_end (C i) p (p + r*# (cis(&i * pi/(&2))))) /\
+        (!i. (i < 4) ==>
+           (C i = mk_segment p (p + r*# (cis(&i * pi/(&2)))))) /\
+        (!i j. (i < 4) /\ (j < 4) /\ (~(i=j)) ==>
+           (C i INTER C j = {p})) /\
+        (!i. (i < 4) ==>
+          (C i INTER {x | r <= d_euclid p x } =
+               { (p + r *# (cis(&i* pi/(&2)))) })) /\
+        (!i. (i< 4) ==>
+           C i SUBSET (closed_ball (euclid 2,d_euclid) p r)) /\
+        (!i. (i< 4) ==>
+           C i SUBSET (hyperplane 2 e2 (p 1) UNION
+                     hyperplane 2 e1 (p 0))))   `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(\i. mk_segment p (euclid_plus p (r *# cis (&i * pi / &2))))` EXISTS_TAC;
+  BETA_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `!i. ~(r *# cis (&i * pi/(&2)) = euclid0)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[polar_nz;REAL_ARITH `&0 < r ==> ~( r= &0)`];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!i . euclid 2 (r *# cis (&i * pi/(&2)))` SUBGOAL_TAC;
+  GEN_TAC;
+  REWRITE_TAC[polar_euclid];
+  DISCH_TAC;
+  (* -- *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC   mk_segment_simple_arc_end;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  ASM_SIMP_TAC[euclid_add_closure];
+  DISCH_TAC;
+  TSPEC `i` 2;
+  UND 2;
+  TYPE_THEN `z =r *# cis(&i *pi/(&2))` ABBREV_TAC ;
+  REWRITE_TAC[euclid0];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  USE 5 (REWRITE_RULE[FUN_EQ_THM ]);
+  TSPEC `x` 5;
+  UND 5;
+  REWRITE_TAC[euclid_plus];
+  REAL_ARITH_TAC;
+  (* -- *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  mk_segment_endpoint;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `!i. d_euclid p (euclid_plus p (r *# cis (&i * pi / &2))) = d_euclid (r *# cis (&i * pi / &2)) euclid0` SUBGOAL_TAC;
+  GEN_TAC;
+  IMATCH_MP_TAC  d_euclidpq;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_REWRITE_TAC[polar_euclid];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[GSYM norm2];
+  REWRITE_TAC[norm2_scale_cis];
+  CONJ_TAC;
+  IMATCH_MP_TAC  cis_distinct;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[polar_euclid;euclid_add_closure];
+  (* [B] *)
+  TYPE_THEN `!a q. (euclid 2 q) /\ (&0 <= a) /\ (a <= &1) ==> (d_euclid p (a*#p + (&1 - a)*#(p + q)) = (&1 - a)*(d_euclid p (p + q)))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  d_euclid_mk_segment;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[euclid_add_closure];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!a i. (&0 <= a) /\ (a <= &1) ==> (d_euclid p (a*#p + (&1 - a)*#(p + r *# (cis (&i * pi/(&2))))) = (&1 - a)*r)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `d_euclid p (p + r *# (cis (&i * pi/(&2)))) = norm2 ( r *# (cis (&i * pi/(&2))))` SUBGOAL_TAC;
+  REWRITE_TAC[norm2];
+  IMATCH_MP_TAC  d_euclidpq;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_REWRITE_TAC[polar_euclid];
+  REWRITE_TAC[norm2_scale_cis];
+  TYPE_THEN `abs  r = r` SUBGOAL_TAC;
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPEL_THEN [`2`;`a`;`p`;`p + (r *# cis (&i * pi / &2))`] (fun t-> ANT_TAC (ISPECL t d_euclid_mk_segment));
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[euclid_add_closure;polar_euclid];
+  DISCH_THEN_REWRITE;
+  DISCH_THEN_REWRITE;
+  REP_BASIC_TAC;
+  (* -- *)
+  CONJ_TAC;
+  REP_BASIC_TAC ;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[mk_segment;INTER;INR IN_SING];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  UND 8;
+  DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
+  TYPEL_THEN [`a`;`i`] (USE 5 o ISPECL);
+  REWR 5;
+  ASM_REWRITE_TAC[];
+  REWR 7;
+  TYPE_THEN `&1 * r <= (&1 - a) * r` SUBGOAL_TAC;
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[REAL_LE_RMUL_EQ];
+  DISCH_TAC;
+  TYPE_THEN `a = &0` SUBGOAL_TAC;
+  UND 10;
+  UND 8;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_lzero];
+  DISCH_THEN_REWRITE;
+  CONJ_TAC;
+  TYPE_THEN `&0` EXISTS_TAC;
+  REWRITE_TAC [REAL_ARITH `&0 <= &0 /\ &0 <= &1`];
+  REDUCE_TAC;
+  REWRITE_TAC[euclid_scale0;euclid_scale_one;euclid_lzero];
+  TYPE_THEN `d_euclid p (euclid_plus p (r *# cis (&i * pi / &2))) = d_euclid (r *# cis (&i * pi/(&2))) euclid0` SUBGOAL_TAC;
+  IMATCH_MP_TAC  d_euclidpq;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_REWRITE_TAC[polar_euclid];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[GSYM norm2;norm2_scale_cis];
+  UND 1;
+  REAL_ARITH_TAC;
+  (* C-- *)
+  CONJ_TAC;
+  REP_BASIC_TAC ;
+  REWRITE_TAC[SUBSET];
+  GEN_TAC;
+  REWRITE_TAC[mk_segment;closed_ball];
+  REP_BASIC_TAC;
+  UND 7;
+  DISCH_THEN (fun t->(REWRITE_TAC[t]) THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
+  TYPEL_THEN [`a`;`i`] (USE 5 o ISPECL);
+  REWR 5;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[euclid_add_closure;polar_euclid;euclid_scale_closure];
+  ONCE_REWRITE_TAC[REAL_ARITH `x <= y <=> x <= &1*y`];
+  IMATCH_MP_TAC  REAL_PROP_LE_RMUL;
+  UND 1;
+  UND 9;
+  REAL_ARITH_TAC;
+  (* D-- *)
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  mk_segment_hyperplane;
+  ASM_REWRITE_TAC[];
+  (* Tue Aug 17 17:02:28 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let diff_pow1 = prove_by_refinement(
+  `!t x. (( \ x. (t*x)) diffl t) x`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(\ x. (t * x)) = (\x. (t * (\u. (u pow 1)) x))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  BETA_TAC;
+  REWRITE_TAC[POW_1];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `((\x. (t * (\u. (u pow 1)) x)) diffl (t* &1)) x ` SUBGOAL_TAC;
+  IMATCH_MP_TAC  DIFF_CMUL;
+  TYPEL_THEN[`1`;`x`] (fun t-> ASSUME_TAC  (ISPECL t DIFF_POW));
+  UND 0;
+  REWRITE_TAC[ARITH_RULE `1-1 = 0`;pow];
+  REDUCE_TAC;
+  BETA_TAC;
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let pi_bounds = prove_by_refinement(
+  `&3 < pi /\ pi < &22/ (&7)`,
+  (* {{{ proof *)
+  let tpi = recompute_pi 12 in
+  let t3 = INTERVAL_OF_TERM 12 `&3` in
+  let t227 = INTERVAL_OF_TERM 12 `&22/(&7)` in
+  let th1 = INTERVAL_TO_LESS_CONV t3 tpi in
+  let th2 = INTERVAL_TO_LESS_CONV tpi t227 in
+  (
+  [
+  REP_BASIC_TAC;
+  ASSUME_TAC th2;
+  ASSUME_TAC th1;
+  ASM_REWRITE_TAC[];
+  ]));;
+  (* }}} *)
+
+let sinx_le_x = prove_by_refinement(
+  `!x. (&0 <=x) ==> (sin x <= x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `x = &0` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SIN_0;];
+  REAL_ARITH_TAC;
+  TYPE_THEN `&0 < x` SUBGOAL_TAC;
+  UND 0;
+  UND 1;
+  REAL_ARITH_TAC;
+  POP_ASSUM_LIST (fun t-> ALL_TAC);
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `f = ( \ t x. t * x - sin(x))` ABBREV_TAC ;
+  TYPE_THEN `!t. (&1 < t) ==> (!x. (&0 < x) ==> (&0 < f t x))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  (* --- *)
+  TYPE_THEN `!x. (f t diffl (t - cos x)) x` SUBGOAL_TAC;
+  EXPAND_TAC "f";
+  GEN_TAC;
+  IMATCH_MP_TAC  DIFF_SUB;
+  REWRITE_TAC[DIFF_SIN;diff_pow1;];
+  DISCH_TAC;
+  TYPEL_THEN [`f t`;`&0`;`x'`] (fun t-> ANT_TAC (ISPECL t MVT));
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[DIFF_CONT];
+  REWRITE_TAC[differentiable];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  UND 6;
+  TYPE_THEN `f t (&0) = &0` SUBGOAL_TAC;
+  EXPAND_TAC "f";
+  REWRITE_TAC[SIN_0];
+  REDUCE_TAC;
+  DISCH_THEN_REWRITE;
+  REDUCE_TAC;
+  DISCH_TAC;
+  UND 4;
+  REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  ASM_REWRITE_TAC[];
+  TSPEC `z` 5;
+  TYPE_THEN `l = t - cos z` SUBGOAL_TAC;
+  IMATCH_MP_TAC  DIFF_UNIQ;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  UND 3;
+  MP_TAC COS_BOUNDS;
+  DISCH_TAC;
+  TSPEC `z` 3;
+  REP_BASIC_TAC;
+  UND 5;
+  UND 3;
+  REAL_ARITH_TAC;
+  (* -- *)
+  DISCH_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH  `~(x < sin x) ==> (sin x <= x)`) ;
+  DISCH_TAC;
+  TYPE_THEN `&1 < sin x/x` SUBGOAL_TAC;
+  ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TSPEC  `(sin x)/x` 2;
+  REWR 2;
+  TSPEC `x` 2;
+  REWR 2;
+  UND 2;
+  EXPAND_TAC "f";
+  (* -- *)
+  ASM_SIMP_TAC[REAL_DIV_RMUL;REAL_ARITH `&0 < x ==> ~(x = &0)`];
+  REDUCE_TAC;
+  (* Tue Aug 17 19:35:13 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let abssinx_lemma = prove_by_refinement(
+  `!x. (&0 <= x) ==> ((abs  (sin x)) <= abs  x)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `abs  x = x` SUBGOAL_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `x <= pi` ASM_CASES_TAC;
+  TYPE_THEN `&0 <= sin x` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SIN_POS_PI_LE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `abs  (sin x) = sin x` SUBGOAL_TAC;
+  UND 2;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[sinx_le_x];
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `&1` EXISTS_TAC;
+  CONJ_TAC;
+  ASSUME_TAC SIN_BOUNDS;
+  TSPEC `x` 2;
+  UND 2;
+  REAL_ARITH_TAC;
+  UND 1;
+  TYPE_THEN `&3 < pi` SUBGOAL_TAC;
+  REWRITE_TAC[pi_bounds];
+  REAL_ARITH_TAC;
+  (* Tue Aug 17 22:54:49 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let abssinx_le = prove_by_refinement(
+  `!x. abs  (sin x) <= abs  x`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  TYPE_THEN `(&0 <= x) \/ (&0 <= -- x)` SUBGOAL_TAC;
+  REAL_ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_MESON_TAC[abssinx_lemma];
+  TYPE_THEN `y = --x` ABBREV_TAC ;
+  TYPE_THEN `x = --y` SUBGOAL_TAC;
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
+  REWRITE_TAC[SIN_NEG;REAL_ABS_NEG];
+  ASM_MESON_TAC[abssinx_lemma];
+  (* Tue Aug 17 22:59:20 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let cos_double2 = prove_by_refinement(
+  `!x. cos (&2 * x) = &1 - &2 * (sin x pow 2)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[COS_DOUBLE;GSYM SIN_CIRCLE ];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let sin_half = prove_by_refinement(
+  `!x. &2 * (sin (x/(&2)) pow 2) = &1 - cos (x)`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  ASSUME_TAC cos_double2;
+  TSPEC `x/ &2` 0;
+  TYPE_THEN `&2 *(x/(&2)) = x` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_MUL_2;];
+  REDUCE_TAC;
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let x_diff_y2 = prove_by_refinement(
+  `!x y. (x - y) pow 2 = x*x - &2*x*y + y*y`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[REAL_POW_2];
+  real_poly_tac;
+  ]);;
+  (* }}} *)
+
+let cosdiff2 = prove_by_refinement(
+  `!x y. (cos x - cos y) pow 2 + (sin x - sin y) pow 2 =
+         (&2 * sin ((x - y)/(&2))) pow 2`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[POW_MUL];
+  TYPE_THEN  `!z. &2 pow 2 * z = &2 *(&2 *z)` SUBGOAL_TAC ;
+  REWRITE_TAC[POW_2];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[sin_half];
+
+  TYPE_THEN `cos (x - y) = cos (x + (--y))` SUBGOAL_TAC;
+  AP_TERM_TAC;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[COS_ADD ];
+  REWRITE_TAC[SIN_NEG;COS_NEG;REAL_ARITH `x - u*(-- v) = x + u*v`];
+  REWRITE_TAC[x_diff_y2];
+  REWRITE_TAC[POW_2];
+  TYPE_THEN `a = cos x` ABBREV_TAC ;
+  TYPE_THEN `b = sin x` ABBREV_TAC ;
+  TYPE_THEN `a' = cos y` ABBREV_TAC ;
+  TYPE_THEN `b' = sin y` ABBREV_TAC ;
+  REWRITE_TAC[REAL_ARITH `x*(y-z) = x*y - x*z`];
+  TYPE_THEN `&2 * &1 = ((b pow 2) + (a pow 2)) + ((b' pow 2) + (a' pow 2))` SUBGOAL_TAC;
+  EXPAND_TAC "a";
+  EXPAND_TAC "b";
+  EXPAND_TAC "a'";
+  EXPAND_TAC "b'";
+  REWRITE_TAC[SIN_CIRCLE];
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[POW_2];
+  real_poly_tac;
+  (* Tue Aug 17 23:38:27 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let d_euclid_cis = prove_by_refinement(
+  `!x y. d_euclid (cis x) (cis y) = &2 * (abs  (sin ((x-y)/(&2))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[cis;d_euclid_point;cosdiff2;POW_2_SQRT_ABS;ABS_MUL;];
+  REWRITE_TAC[REAL_ARITH `abs  (&2) = &2`];
+  (* Tue Aug 17 23:41:30 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let d_euclid_cis_ineq = prove_by_refinement(
+  `!x y. d_euclid (cis x) (cis y) <= abs  (x - y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[d_euclid_cis];
+  REP_GEN_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `&2 * (abs  ((x-y)/(&2)))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
+  ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`;abssinx_le];
+  REWRITE_TAC[REAL_ARITH `!z. &2*(abs  z) = abs  (&2 *z)`];
+  TYPE_THEN `&2 * ((x - y)/(&2)) = (x - y)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REAL_ARITH_TAC;
+  (* Wed Aug 18 06:42:28 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let polar_fg_inj = prove_by_refinement(
+  `!f g p. (INJ f {x | &0 <= x /\ x <= &1} UNIV) /\
+    (!x. (&0 <= x /\ x <= &1) ==> (&0 <= f x)) /\ (euclid 2 p) ==>
+   INJ (\t. p + (f t)*# (cis (g t))) {x | &0 <= x /\ x <= &1} (euclid 2)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[INJ;polar_euclid];
+  ASM_SIMP_TAC[euclid_add_closure;polar_euclid];
+  REP_BASIC_TAC;
+  (* INSERT *)
+  TYPE_THEN `(f x *# cis (g x)) = (f y *# cis (g y))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  USE 3 (REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x'` 3;
+  USE 3(REWRITE_RULE[euclid_plus]);
+  UND 3;
+  REAL_ARITH_TAC;
+  KILL 3;
+  DISCH_TAC;
+  (* end ins *)
+  USE 3 (AP_TERM `norm2`);
+  USE 3 (REWRITE_RULE[norm2_scale_cis]);
+  TYPE_THEN `&0 <= f x /\ &0 <= f y` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[GSYM REAL_ABS_REFL]);
+  REWR 3;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+
+  ]);;
+  (* }}} *)
+
+let polar_distinct = prove_by_refinement(
+  `!f g g'. (INJ f {x | &0 <= x /\ x <= &1} UNIV) /\
+    (!x. (&0 <= x /\ x <= &1) ==> (&0 < f x)) /\
+    (!x. (&0 <= x /\ x <= &1) ==> (&0 <= g x /\ g x < &2 * pi)) /\
+    (!x. (&0 <= x /\ x <= &1) ==> (&0 <= g' x /\ g' x < &2 * pi))
+    ==>
+    (!x y. (&0 <= x /\ x <= &1 /\ &0 <= y /\ y <= &1 /\
+      ((f x)*# (cis (g x)) = (f y)*# (cis (g' y)))) ==>
+      (x = y) /\ (g x = g' y)) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  COPY 0;
+  USE 0 (AP_TERM `norm2`);
+  USE 0 (REWRITE_RULE[norm2_scale_cis]);
+  TYPE_THEN `&0 < f x /\ &0 < f y` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `f x = f y` SUBGOAL_TAC;
+  UND 0;
+  UND 10;
+  UND 11;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* -- *)
+  SUBCONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE [INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN  (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
+  TYPEL_THEN [`g y`;`g' y`;`f y`;`f y`] (fun t-> ANT_TAC (ISPECL t polar_inj));
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[REAL_ARITH `&0 < t ==> &0 <= t`];
+  DISCH_THEN DISJ_CASES_TAC;
+  PROOF_BY_CONTR_TAC;
+  REP_BASIC_TAC;
+  UND 13;
+  UND 10;
+  REAL_ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  (* Wed Aug 18 07:42:54 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let d_euclid_eq_arg = prove_by_refinement(
+  `!r r' x. (d_euclid (r *# (cis x)) (r' *# (cis x)) = abs  (r - r'))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[cis;point_scale;d_euclid_point];
+  REWRITE_TAC[GSYM REAL_SUB_RDISTRIB;POW_MUL;GSYM REAL_ADD_LDISTRIB];
+  ONCE_REWRITE_TAC [REAL_ARITH `x + y = y + x`];
+  REWRITE_TAC[SIN_CIRCLE];
+  REDUCE_TAC;
+  REWRITE_TAC[POW_2_SQRT_ABS];
+  (* Wed Aug 18 08:15:39 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+(* not used *)
+let one_over_plus1 = prove_by_refinement(
+  `!t. (&0 <= t) ==> (t / (&1 + t) <= &1)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  REAL_LE_LDIV;
+  UND 0;
+  REAL_ARITH_TAC;
+  (* Wed Aug 18 08:17:46 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let polar_cont = prove_by_refinement(
+  `!p f g. continuous f (top_of_metric(UNIV,d_real))
+        (top_of_metric(UNIV,d_real)) /\
+     continuous g (top_of_metric(UNIV,d_real))
+        (top_of_metric(UNIV,d_real)) /\ (euclid 2 p)  ==>
+     continuous (\t. p + (f t) *# cis(g t)) (top_of_metric(UNIV,d_real))
+        (top2)`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  DISCH_TAC;
+  TYPE_THEN `IMAGE (\t. p + (f t) *# cis(g t)) UNIV SUBSET (euclid 2)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;IMAGE ];
+  ASM_MESON_TAC[euclid_add_closure;polar_euclid];
+  REWRITE_TAC[top2];
+  UND 0;
+  ASM_SIMP_TAC[SUBSET_UNIV;metric_continuous_continuous;metric_euclid;metric_real];
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  REP_BASIC_TAC;
+  RIGHT_TAC "delta";
+  DISCH_TAC;
+  TYPEL_THEN [`x`;`epsilon/(&2)`] (USE 3 o ISPECL);
+  TYPEL_THEN [`x`;`(&1/(&1 + abs  (f x)))*(epsilon/(&2))`] (USE 2 o ISPECL);
+  REP_BASIC_TAC;
+  TYPE_THEN `&0 < epsilon/(&2)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  DISCH_TAC;
+  TYPE_THEN `&0 < &1 / (&1 + abs (f x)) * epsilon / &2` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  REWR 3;
+  REWR 2;
+  REP_BASIC_TAC;
+  TYPE_THEN `min_real delta delta'` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[min_real];
+  UND 3;
+  UND 8;
+  COND_CASES_TAC;
+  REAL_ARITH_TAC;
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `d_real x y < delta /\ d_real x y < delta'` SUBGOAL_TAC ;
+  UND 9;
+  REWRITE_TAC[min_real];
+  COND_CASES_TAC;
+  UND 9;
+  REAL_ARITH_TAC;
+  UND 9;
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  TSPEC `y` 2;
+  TSPEC `y` 7;
+  REWR 2;
+  REWR 7;
+  (* A-- *)
+  IMATCH_MP_TAC  REAL_LET_TRANS;
+  TYPE_THEN `d_euclid (p + f x *# cis(g x)) (p + f x *# cis(g y)) + d_euclid (p + f x *# cis(g y)) (p + f y *# cis(g y))` EXISTS_TAC;
+  TYPE_THEN `!z r x r' x'. d_euclid (p + r *# (cis x)) (p + r' *# (cis x')) = d_euclid (r*# (cis x)) (r' *# (cis x'))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  metric_translate_LEFT;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_REWRITE_TAC[polar_euclid];
+  DISCH_THEN_REWRITE;
+  (* end of add-on *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  metric_space_triangle;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_SIMP_TAC[polar_euclid;metric_euclid];
+  REWRITE_TAC[d_euclid_eq_arg];
+  TYPEL_THEN[`2`;`f x`;`cis (g x)`;`cis (g y)`] (fun t-> ANT_TAC (ISPECL t norm_scale_vec));
+  REWRITE_TAC[cis;euclid_point];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `!x y z. (x <= z/ &2 /\ y < z/ &2 ==> x + y < z/ &2 + z/ &2)` SUBGOAL_TAC;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_HALF_DOUBLE];
+  DISCH_THEN IMATCH_MP_TAC ;
+  USE 2 (REWRITE_RULE[d_real]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `abs  (f x) * (&1 / (&1 + abs (f x)) * epsilon / &2)` EXISTS_TAC;
+  (* B-- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
+  REWRITE_TAC[REAL_MK_NN_ABS];
+  IMATCH_MP_TAC (REAL_ARITH `!y. (x <= y /\ y < z) ==> (x <= z)`);
+  TYPE_THEN `abs  (g x - g y)` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[d_euclid_cis_ineq];
+  USE 7 (REWRITE_RULE[d_real]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_ARITH `(x*y*z <= z) <=> ((x*y)*(z) <= &1 * (z))`];
+  IMATCH_MP_TAC  REAL_PROP_LE_RMUL;
+  CONJ_TAC;
+  REWRITE_TAC[real_div];
+  REDUCE_TAC;
+  REWRITE_TAC[GSYM real_div];
+  IMATCH_MP_TAC  REAL_LE_LDIV;
+  REAL_ARITH_TAC;
+  UND 5;
+  REAL_ARITH_TAC;
+
+  ]);;
+  (* }}} *)
+
+let lc_bounds = prove_by_refinement(
+  `!a b x. (&0 <= x /\ x <= &1) ==> (min_real a b <= x*a + (&1- x)*b) /\
+       (x*a + (&1 - x)*b <= max_real a b)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[min_real];
+  COND_CASES_TAC;
+  ineq_le_tac `a + (&1 - x)*(b - a) = (x*a + (&1- x)*b)`;
+  ineq_le_tac `b + x*(a - b) = x*a + (&1- x)*b`;
+  REWRITE_TAC[max_real];
+  COND_CASES_TAC;
+  ineq_le_tac `(x*a + (&1 - x)*b) + (&1 - x)*(a - b) = a`;
+  ineq_le_tac `(x*a + (&1 - x)*b) + (x*(b - a)) = b`;
+  (* Wed Aug 18 11:52:54 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let min_real_symm = prove_by_refinement(
+  `!a b. min_real a b = min_real b a`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[min_real];
+  COND_CASES_TAC;
+  USE 0 (MATCH_MP (REAL_ARITH `a < b ==> ~(b < a)`));
+  ASM_REWRITE_TAC[];
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let max_real_symm = prove_by_refinement(
+  `!a b. max_real a b = max_real b a`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[max_real];
+  COND_CASES_TAC;
+  USE 0 (MATCH_MP (REAL_ARITH `a < b ==> ~(b < a)`));
+  ASM_REWRITE_TAC[];
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let curve_annulus_lemma = prove_by_refinement(
+  `!r g p. (&0 < r) /\ (euclid 2 p) ==>
+      (IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))
+           {x | &0 <= x /\ x <= &1})
+         SUBSET ({ x | (r/(&2) <= d_euclid p x /\
+                             d_euclid p x <= r)} )`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE;SUBSET];
+  REP_BASIC_TAC;
+  UND 2;
+  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC  (REWRITE_RULE[t])));
+  TYPE_THEN `d_euclid p (euclid_plus p ((x' * r + (&1 - x') * r / &2) *# cis (g x'))) = d_euclid ((x' * r + (&1 - x') * r / &2) *# cis (g x')) euclid0` SUBGOAL_TAC;
+  IMATCH_MP_TAC  d_euclidpq;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_REWRITE_TAC[polar_euclid];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[GSYM norm2;norm2_scale_cis];
+  TYPE_THEN `r/(&2) < r` SUBGOAL_TAC;
+  ASM_MESON_TAC[half_pos];
+  DISCH_TAC;
+  TYPE_THEN `(min_real (r/(&2)) r = (r/(&2))) /\ (max_real (r/(&2)) r = r)` SUBGOAL_TAC;
+  REWRITE_TAC[min_real;max_real];
+  ASM_REWRITE_TAC[];
+  COND_CASES_TAC;
+  UND 2;
+  UND 5;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `&0 <= (x' *r + (&1 - x')*(r/(&2)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `min_real (r/ &2) r` EXISTS_TAC ;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  (REAL_ARITH `&0 < x ==> &0 <= x`);
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  ONCE_REWRITE_TAC [min_real_symm];
+  ASM_MESON_TAC[lc_bounds];
+  REWRITE_TAC[GSYM ABS_REFL];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[lc_bounds;min_real_symm;max_real_symm];
+  (* Wed Aug 18 12:13:50 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let curve_circle_lemma = prove_by_refinement(
+  `!r g p. (&0 < r) /\ (euclid 2 p) ==>
+      (((IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))
+           {x | &0 <= x /\ x <= &1})
+     INTER ({ x |  d_euclid p x <= (r/(&2))})) =
+                          { ( p + (r/(&2)) *# (cis (g (&0) ))) })
+     `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;INTER;];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  GEN_TAC;
+  (* A *)
+  EQ_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  TYPE_THEN `&0` EXISTS_TAC;
+  REDUCE_TAC;
+  TYPEL_THEN [`2`;`p`;`(r / &2 *# cis (g (&0)))`] (fun t-> ANT_TAC (ISPECL t d_euclidpq));
+  ASM_REWRITE_TAC[polar_euclid];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[GSYM norm2;norm2_scale_cis;];
+  IMATCH_MP_TAC  (REAL_ARITH `(x = y) ==> (x <= y)`);
+  REWRITE_TAC[ABS_REFL];
+  IMATCH_MP_TAC  (REAL_ARITH `(&0 < x) ==> (&0 <= x)`);
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  REP_BASIC_TAC;
+  (* B other direction *)
+  UND 3;
+  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
+  PROOF_BY_CONTR_TAC;
+  UND 2;
+  TYPE_THEN `d_euclid p (euclid_plus p ((x' * r + (&1 - x') * r / &2) *# cis (g x'))) = d_euclid ((x' * r + (&1 - x') * r / &2) *# cis (g x')) euclid0` SUBGOAL_TAC;
+  IMATCH_MP_TAC  d_euclidpq;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_REWRITE_TAC[polar_euclid];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[GSYM norm2;norm2_scale_cis];
+  TYPE_THEN `r/(&2) < r` SUBGOAL_TAC;
+  ASM_MESON_TAC[half_pos];
+  DISCH_TAC;
+  TYPE_THEN `(min_real (r/(&2)) r = (r/(&2))) /\ (max_real (r/(&2)) r = r)` SUBGOAL_TAC;
+  REWRITE_TAC[min_real;max_real];
+  ASM_REWRITE_TAC[];
+  COND_CASES_TAC;
+  UND 2;
+  UND 6;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `&0 <= (x' *r + (&1 - x')*(r/(&2)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `min_real (r/ &2) r` EXISTS_TAC ;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  (REAL_ARITH `&0 < x ==> &0 <= x`);
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  ONCE_REWRITE_TAC [min_real_symm];
+  ASM_MESON_TAC[lc_bounds];
+  REWRITE_TAC[GSYM ABS_REFL];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `~(x'  = &0)` SUBGOAL_TAC;
+  DISCH_TAC;
+  UND 7;
+  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
+  UND 3;
+  REDUCE_TAC;
+  DISCH_TAC;
+  TYPE_THEN `&0 < x'` SUBGOAL_TAC;
+  UND 7;
+  UND 5;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `a < b ==> ~(b <= a)`);
+  ineq_lt_tac `(r/ &2) + x'* (r - (r/(&2))) = (x' * r + (&1 - x') * r / &2)`;
+  (* Wed Aug 18 12:41:16 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let curve_simple_lemma = prove_by_refinement(
+  `!r g p. (&0 < r) /\ (euclid 2 p) /\
+    (continuous g (top_of_metric(UNIV,d_real))
+       (top_of_metric(UNIV,d_real))) ==>
+   (simple_arc_end
+      (IMAGE (\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))
+           {x | &0 <= x /\ x <= &1}) (p + (r/(&2))*# (cis (g (&0))))
+             (p + (r)*# (cis (g (&1)))))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc_end];
+  REP_BASIC_TAC;
+  TYPE_THEN `(\t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (g t)))` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  polar_cont;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_real;SUBSET_UNIV];
+  REWRITE_TAC[linear_cont];
+  IMATCH_MP_TAC  polar_fg_inj;
+  ASM_REWRITE_TAC[INJ;SUBSET_UNIV ];
+  (* -- *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  USE 3 (ONCE_REWRITE_RULE[REAL_ARITH `( x = y) <=> (x - y = &0)`]);
+  TYPE_THEN `(x * r + (&1 - x) * r / &2) - (y * r + (&1 - y) * r / &2) = (x - y)*(r - r/(&2)) ` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_TAC;
+  REWR 3;
+  USE 3(REWRITE_RULE[REAL_ENTIRE]);
+  UND 3;
+  DISCH_THEN DISJ_CASES_TAC;
+  UND 3;
+  REAL_ARITH_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 3;
+  TYPE_THEN `r - r/(&2) = (r/ &2 + r/ &2) - r/ &2` SUBGOAL_TAC;
+  REWRITE_TAC[REAL_HALF_DOUBLE];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[REAL_ARITH `(x + x) - x = x`];
+  USE 2 (ONCE_REWRITE_RULE  [GSYM REAL_HALF_DOUBLE]);
+  USE 2 (REWRITE_RULE[REAL_DIV_LZERO]);
+  UND 2;
+  REAL_ARITH_TAC;
+  (* -- *)
+  GEN_TAC;
+  DISCH_TAC;
+  WITH 3 (MATCH_MP lc_bounds);
+  TYPEL_THEN [`r`;`r/ &2`] (USE 4 o ISPECL);
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `min_real r (r/ &2)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `r / &2 < r` SUBGOAL_TAC;
+  UND 2;
+  MESON_TAC [half_pos];
+  TYPE_THEN `&0 < r/ (&2)` SUBGOAL_TAC;
+  ASM_MESON_TAC[half_pos];
+  TYPE_THEN `a = r/ &2` ABBREV_TAC ;
+  REWRITE_TAC[min_real];
+  COND_CASES_TAC;
+  REAL_ARITH_TAC;
+  REAL_ARITH_TAC;
+  (* Wed Aug 18 14:02:54 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let segpath = jordan_def
+  `segpath x y t = t* x + (&1 - t)*y` ;;
+
+let segpathxy = prove_by_refinement(
+  `!x y. segpath x y = (\ t. t*x + (&1 - t)*y)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[segpath];
+  ]);;
+  (* }}} *)
+
+let segpath_lemma = prove_by_refinement(
+  `(!x y . (continuous (segpath x y) (top_of_metric(UNIV,d_real))
+       (top_of_metric(UNIV,d_real)))) /\
+   (!x y b. (&0 <= x /\ x < b /\ &0 <= y /\ y < b ==>
+     (!t. &0 <= t /\ t <= &1 ==> &0 <= segpath x y t /\
+       segpath x y t < b))) /\
+   (!x y x' y' t. (x < x' /\ y < y' /\ &0 <= t /\ t <= &1)
+        ==> ~(segpath x y t = segpath x' y' t))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[SUBSET_UNIV;metric_continuous_continuous;metric_real];
+  REWRITE_TAC[segpathxy;linear_cont];
+  (* -- *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[segpath];
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `min_real x y` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[min_real];
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[lc_bounds];
+  IMATCH_MP_TAC  REAL_LET_TRANS;
+  TYPE_THEN `max_real x y` EXISTS_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[lc_bounds];
+  REWRITE_TAC[max_real];
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  REWRITE_TAC[segpath];
+  REP_BASIC_TAC;
+  UND 0;
+  REWRITE_TAC[REAL_ARITH `(u + v = u' + v') <=> ((u' - u) + (v' - v) = &0)`];
+  REWRITE_TAC[GSYM REAL_SUB_LDISTRIB];
+  TYPE_THEN `t = &0` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  UND 3;
+  REAL_ARITH_TAC;
+  TYPE_THEN `t = &1` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  UND 4;
+  REAL_ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `&0 < t * (x' - x) + (&1 - t)*(y' - y)` SUBGOAL_TAC;
+  ineq_lt_tac `&0 + t * (x' - x) + (&1 - t)*(y' - y) = (t*(x' - x) + (&1- t)*(y' - y))` ;
+  UND 5;
+  UND 1;
+  REAL_ARITH_TAC;
+  REAL_ARITH_TAC;
+  (* Wed Aug 18 14:48:37 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let segpath_end = prove_by_refinement(
+  `!x y. ( segpath x y (&0) = y) /\ (segpath x y (&1) = x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[segpath];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let segpath_inj = prove_by_refinement(
+  `!x y. ~(x = y) ==> INJ (segpath x y) {t | &0 <= t /\ t <= &1} UNIV`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[segpath;INJ;SUBSET_UNIV];
+  REP_BASIC_TAC;
+  USE 0 (ONCE_REWRITE_RULE[REAL_ARITH `( x = y) <=> (x - y = &0)`]);
+  TYPE_THEN `(x' * x + (&1 - x') * y) - (y' * x + (&1 - y') * y) = (x' - y')*(x - y) ` SUBGOAL_TAC;
+  real_poly_tac;
+  DISCH_TAC;
+  REWR 0;
+  USE 0(REWRITE_RULE[REAL_ENTIRE]);
+  UND 0;
+  DISCH_THEN DISJ_CASES_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 0;
+  UND 5;
+  REAL_ARITH_TAC;
+  (* Wed Aug 18 15:15:11 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let degree_vertex_annulus = prove_by_refinement(
+  `!n r p xx zz. (&0 < r) /\ (euclid 2 p) /\
+    (!j. j < n ==> (&0 <= xx j /\ xx j < &2 * pi)) /\
+   (!j. j < n ==> (&0 <= zz j /\ zz j < &2 * pi)) /\
+    (!i j. (i < j) /\ (j <| n) ==> (xx i < xx j)) /\
+       (!i j. (i < j) /\ (j < n) ==> (zz i < zz j))  ==>
+    (?C.
+       (!i. (i < n) ==>
+          simple_arc_end (C i ) (p + (r/ &2)*# (cis(zz i)))
+                                (p + r*# (cis(xx i)))) /\
+       (!i j. (i < n) /\ (j < n) /\ (~(i=j)) ==>
+           (C i INTER C j = EMPTY )) /\
+       (!i. (i< n) ==>
+           C i SUBSET ({ x | (r/(&2) <= d_euclid p x /\
+                             d_euclid p x <= r)} )) /\
+       (!i. (i< n) ==>
+           (C i INTER  ({ x |  d_euclid p x <= (r/(&2))}) =
+                          { ( p + (r/(&2)) *# (cis (zz i ))) }))
+       )
+    `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `C = ( \ i. IMAGE ( \ t. p + (t*r + (&1 - t)*(r/(&2)))*# (cis (segpath (xx i) (zz i)  t))) {t | &0 <= t /\ t <= &1})` ABBREV_TAC ;
+  TYPE_THEN `C` EXISTS_TAC;
+  (* -- *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  EXPAND_TAC "C";
+  TYPEL_THEN [`r`;`segpath (xx i) (zz i)`;`p`] (fun t-> (ANT_TAC(ISPECL t curve_simple_lemma)));
+  ASM_REWRITE_TAC[segpath_lemma];
+  REWRITE_TAC[segpath_end];
+  (* -- *)
+  TYPE_THEN `&0 < r/ &2 /\ r / &2 < r` SUBGOAL_TAC;
+  IMATCH_MP_TAC  half_pos;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  TYPEL_THEN [`( \ t. t * r + (&1 - t) * r / &2)`;`segpath (xx i) (zz i)`;`segpath (xx j) (zz j)`] (fun t-> ANT_TAC (ISPECL t polar_distinct));
+  ASM_REWRITE_TAC[];
+  (* --- *)
+  CONJ_TAC;
+  TYPEL_THEN [`r`;`r / &2`] (fun t-> ANT_TAC(ISPECL t segpath_inj));
+  UND 10;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[segpathxy];
+  (* --- *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  ineq_lt_tac `&0 + (x* (r - r/(&2))) + (r/ &2) = x*r + (&1 - x)*(r/ &2)`;
+  (* --- *)
+  ASM_MESON_TAC[segpath_lemma];
+  (* -- *)
+  DISCH_TAC;
+  EXPAND_TAC "C";
+  REWRITE_TAC[EQ_EMPTY];
+  GEN_TAC;
+  REWRITE_TAC[IMAGE;INTER];
+  REP_BASIC_TAC;
+  UND 13;
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN (REWRITE_TAC [t]));
+  TYPEL_THEN[`x'`;`x''`] (USE 12 o ISPECL);
+  REWR 12;
+  TYPE_THEN `((x'' * r + (&1 - x'') * r / &2) *# cis (segpath (xx j) (zz j) x'')) = ((x' * r + (&1 - x') * r / &2) *# cis (segpath (xx i) (zz i) x'))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  USE 16 ( (REWRITE_RULE[FUN_EQ_THM]));
+  TSPEC `x'''` 13;
+  UND 13;
+  REWRITE_TAC[euclid_plus];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  KILL 16;
+  USE 13 (ONCE_REWRITE_RULE [EQ_SYM_EQ]);
+  REWR 12;
+  REP_BASIC_TAC;
+  USE 16 GSYM;
+  UND 16;
+    DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]) THEN (REWRITE_TAC [t]));
+  TYPE_THEN `(i <| j) \/ (j < i)` SUBGOAL_TAC;
+  UND 7;
+  ARITH_TAC;
+  (* ---- *)
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPEL_THEN [`i`;`j`] (USE 0 o ISPECL);
+  TYPEL_THEN [`i`;`j`] (USE 1 o ISPECL);
+  KILL  2;
+  KILL  3;
+  KILL 6;
+  KILL 13;
+  ASM_MESON_TAC[CONJUNCT2 (CONJUNCT2 segpath_lemma)];
+  TYPEL_THEN [`j`;`i`] (USE 0 o ISPECL);
+  TYPEL_THEN [`j`;`i`] (USE 1 o ISPECL);
+  KILL  2;
+  KILL  3;
+  KILL 6;
+  KILL 13;
+  ASM_MESON_TAC[CONJUNCT2 (CONJUNCT2 segpath_lemma)];
+  (* B-- *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  EXPAND_TAC "C";
+  IMATCH_MP_TAC  curve_annulus_lemma;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  REP_BASIC_TAC;
+  EXPAND_TAC "C";
+  TYPEL_THEN[`r`;`segpath (xx i) (zz i)`;`p`] (fun t-> ANT_TAC(ISPECL t curve_circle_lemma));
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[segpath_end];
+  (* Wed Aug 18 15:57:53 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let closed_ball2_center = prove_by_refinement(
+  `!p r. closed_ball (euclid 2,d_euclid) p r p <=> (euclid 2 p) /\ (&0 <= r)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closed_ball];
+  TYPE_THEN `!p. (euclid 2 p) ==> (d_euclid p p = &0)` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  metric_space_zero;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[metric_euclid];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let degree_vertex_disk = prove_by_refinement(
+  `!r p xx . (&0 < r) /\ (euclid 2 p) /\
+  (!j. j < 4 ==> (&0 <= xx j /\ xx j < &2 * pi)) /\
+    (!i j. (i < j) /\ (j < 4) ==> (xx i < xx j))
+  ==>
+      (?C.
+       (!i. (i< 4) ==> (?C' C'' v.
+           simple_arc_end C' p v /\
+           simple_arc_end C'' v (p + r*# (cis(xx i )))  /\
+           C' SUBSET closed_ball(euclid 2,d_euclid) p (r/ &2) /\
+           (C' INTER C'' = {v}) /\
+           (C' UNION C'' = C i )) /\
+          simple_arc_end (C i ) p  (p + r*# (cis(xx i))) /\
+           C i SUBSET (closed_ball(euclid 2,d_euclid) p r) /\
+           C i  INTER (closed_ball(euclid 2,d_euclid) p (r / &2))
+           SUBSET (hyperplane 2 e2 (p 1) UNION
+                     hyperplane 2 e1 (p 0))) /\
+       (!i j. (i < 4) /\ (j < 4) /\ (~(i=j)) ==>
+           (C i INTER C j = {p} )))
+       `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(&0 < (r /(&2))) /\ (euclid 2 p)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  DISCH_THEN (fun t-> MP_TAC (MATCH_MP   degree4_vertex_hv t));
+  REP_BASIC_TAC;
+  TYPE_THEN `C' = C` ABBREV_TAC ;
+  KILL 10;
+  TYPE_THEN `zz = (\j. (&j) * pi/(&2))` ABBREV_TAC ;
+  TYPE_THEN `(&0 < r) /\ (euclid 2 p) /\  (!j. j < 4 ==> (&0 <= xx j /\ xx j < &2 * pi)) /\  (!j. j < 4 ==> (&0 <= zz j /\ zz j < &2 * pi)) /\  (!i j. (i < j) /\ (j < 4) ==> (xx i < xx j)) /\ (!i j. (i < j) /\ (j < 4) ==> (zz i < zz j))` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  EXPAND_TAC "zz";
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  CONJ_TAC;
+  REDUCE_TAC;
+  IMATCH_MP_TAC  REAL_LE_DIV;
+  MP_TAC PI_POS;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[real_div;REAL_ARITH `pi*x = x*pi`];
+  REWRITE_TAC[REAL_ARITH `x*y*z = (x*y)*z`];
+  IMATCH_MP_TAC  REAL_PROP_LT_RMUL;
+  ASM_REWRITE_TAC[PI_POS;GSYM real_div;];
+  ASM_SIMP_TAC[REAL_LT_LDIV_EQ;REAL_ARITH `&0 < &2`];
+  REDUCE_TAC;
+  UND 11;
+  ARITH_TAC;
+  REP_BASIC_TAC;
+  EXPAND_TAC "zz";
+  ONCE_REWRITE_TAC [REAL_ARITH `x < y <=> (&0 < y - x)`];
+  REWRITE_TAC[REAL_ARITH `x*y - z*y = (x - z)*y`];
+  IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
+  REWRITE_TAC[PI2_BOUNDS];
+  REDUCE_TAC;
+  UND 12;
+  REWRITE_TAC[REAL_ARITH `&0 < &j - &i <=> &i < &j`];
+  REDUCE_TAC;
+  DISCH_THEN (fun t-> MP_TAC (MATCH_MP degree_vertex_annulus t));
+  REP_BASIC_TAC;
+  (* A *)
+  TYPE_THEN `(\j. C' j UNION C'' j)` EXISTS_TAC;
+  BETA_TAC;
+  (* B 1st conjunct *)
+  TYPE_THEN `!i. (i<| 4) ==> (simple_arc_end (C' i ) p (p + ((r/ &2) *# (cis (&i * pi/(&2))))) /\   simple_arc_end (C'' i) (p + ((r/ &2) *# (cis (&i * pi/(&2))))) (euclid_plus p (r *# cis (xx i))) /\ (C' i) SUBSET closed_ball (euclid 2,d_euclid) p (r / &2) /\  ((C' i) INTER (C'' i) = {(p + ((r/ &2) *# (cis (&i * pi/(&2)))))})) ` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  SUBCONJ_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  SUBCONJ_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  SUBCONJ_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INR IN_SING;INTER ];
+  EQ_TAC;
+  DISCH_TAC;
+  TYPE_THEN `closed_ball (euclid 2,d_euclid) p (r / &2) x` SUBGOAL_TAC;
+  UND 18;
+  REWRITE_TAC[SUBSET];
+  UND 19;
+  MESON_TAC[];
+  TSPEC `i` 11;
+  REWR 11;
+  REWRITE_TAC[closed_ball];
+  FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`));
+  UND 19;
+  REWRITE_TAC[INTER;INR IN_SING;];
+  DISCH_THEN_REWRITE;
+  DISCH_THEN_REWRITE;
+  EXPAND_TAC "zz";
+  DISCH_THEN_REWRITE;
+  DISCH_THEN_REWRITE;
+  UND 17;
+  UND 16;
+  MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  (* [C] 1nd conjunct. simple-arc-end; *)
+  TYPE_THEN `D = closed_ball (euclid 2,d_euclid) p (r /(&2))` ABBREV_TAC ;
+  TYPE_THEN `!i x. (i <| 4) /\ (D x) ==> ((C' i UNION C'' i) x = C' i x)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[UNION];
+  IMATCH_MP_TAC  (TAUT `(b ==> a) ==> (a \/ b <=> a)`);
+  TSPEC `i` 11;
+  REWR 11;
+  FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`));
+  UND 17;
+  EXPAND_TAC"D";
+  REWRITE_TAC[closed_ball];
+  REWRITE_TAC[INTER;INR IN_SING];
+  DISCH_THEN_REWRITE;
+  DISCH_THEN_REWRITE;
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[simple_arc_end_end2];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!i x. (i <| 4) /\ ~(D x) ==> ((C' i UNION C'' i) x = C'' i x)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[UNION];
+  IMATCH_MP_TAC  (TAUT `(a ==> b) ==> (a \/ b <=> b)`);
+  TSPEC `i` 5;
+  REWR 5;
+  USE 5 (REWRITE_RULE[SUBSET]);
+  TSPEC `x` 5;
+  UND 5;
+  UND 18;
+  MESON_TAC[];
+  DISCH_TAC;
+  ONCE_REWRITE_TAC [TAUT `(x /\ y) <=> (y /\ x)`];
+  (* D-- *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INTER;INR IN_SING];
+  TYPE_THEN `D x` ASM_CASES_TAC;
+  TYPEL_THEN [`i`;`x`] (WITH 17 o ISPECL);
+  TYPEL_THEN [`j`;`x`] (WITH 17 o ISPECL);
+  UND 23;
+  UND 24;
+  KILL 17;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  DISCH_THEN_REWRITE;
+  TYPEL_THEN [`i`;`j`;] (USE 7 o ISPECL);
+  REWR 7;
+  FIRST_ASSUM (fun t-> MP_TAC (AP_THM t `x:num->real`));
+  REWRITE_TAC[INTER;INR IN_SING];
+  (* --2-- *)
+  TYPEL_THEN [`i`;`x`] (WITH 18 o ISPECL);
+  TYPEL_THEN [`j`;`x`] (WITH 18 o ISPECL);
+  UND 23;
+  UND 24;
+  KILL 18;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  DISCH_THEN_REWRITE;
+  TYPEL_THEN [`i`;`j`;] (USE 13 o ISPECL);
+  REWR 13;
+  USE 13 (REWRITE_RULE[EQ_EMPTY;INTER ]);
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USE 18(REWRITE_RULE[]);
+  UND 18;
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[t]));
+  UND 22;
+  REWRITE_TAC[];
+  EXPAND_TAC "D";
+  REWRITE_TAC[closed_ball2_center];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  (REAL_ARITH `&0 <x ==> &0 <= x`);
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  (* E *)
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  TYPE_THEN `C' i` EXISTS_TAC;
+  TYPE_THEN `C'' i` EXISTS_TAC;
+  TYPE_THEN `p + (r / &2 *# cis (&i * pi / &2))` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_trans;
+  ASM_MESON_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  CONJ_TAC;
+  TSPEC `i` 5;
+  UND 5;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "D";
+  REWRITE_TAC[SUBSET;closed_ball;];
+  TYPE_THEN `r / &2 < r` SUBGOAL_TAC;
+  UND 3;
+  MESON_TAC[half_pos];
+  MESON_TAC[REAL_ARITH `(x <= y) /\ (y < z) ==> (x <= z)`];
+  TSPEC `i` 12;
+  UND 12;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET;closed_ball];
+  ASM_REWRITE_TAC[];
+  TSPEC `i` 14;
+  REWR 12;
+  TYPE_THEN `C'' i SUBSET (euclid 2)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  UND 12;
+  MESON_TAC[];
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  (* -- *)
+  KILL 15;
+  KILL 9;
+  KILL 8;
+  KILL 11;
+  KILL 12;
+  TYPE_THEN `(C' i UNION C'' i) INTER D = (C' i INTER D)` SUBGOAL_TAC;
+  REWRITE_TAC[INTER];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  UND 17;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TSPEC `i` 4;
+  REWR 4;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C' i` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INTER;SUBSET];
+  MESON_TAC[];
+  (* Thu Aug 19 07:36:47 EDT 2004 *)
+
+   ]);;
+  (* }}} *)
+
+let euclid_cancel1 = prove_by_refinement(
+  `!x y z. (x = euclid_plus y z) <=> (x - y = z)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  EQ_TAC;
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[euclid_plus;euclid_minus];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  USE 0 SYM;
+  ASM_REWRITE_TAC[];
+    IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[euclid_plus;euclid_minus];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let infinite_subset = prove_by_refinement(
+  `!(X:A->bool) Y. INFINITE X /\ X SUBSET Y ==> INFINITE Y`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INFINITE];
+  MESON_TAC[FINITE_SUBSET];
+  ]);;
+  (* }}} *)
+
+let EXPinj = prove_by_refinement(
+  `!x y n. (1 < n) /\ (n **| x = n **| y) ==> (x = y)`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `! x y n. (x <| y) /\ (n **| x = n **| y) ==> ~(1 <| n)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `n **| y <= n **| x` SUBGOAL_TAC;
+  UND 1;
+  ARITH_TAC;
+  REWRITE_TAC[LE_EXP];
+  TYPE_THEN `~(n = 0)` SUBGOAL_TAC;
+  UND 0;
+  ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[DE_MORGAN_THM];
+  CONJ_TAC;
+  UND 0;
+  ARITH_TAC;
+  UND 2;
+  ARITH_TAC;
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `x < y \/ y <| x` SUBGOAL_TAC;
+  UND 3;
+  ARITH_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPEL_THEN[`x`;`y`;`n`] (USE 0 o ISPECL);
+  ASM_MESON_TAC[];
+  TYPEL_THEN[`y`;`x`;`n`] (USE 0 o ISPECL);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let infinite_interval = prove_by_refinement(
+  `!a b. a < b ==> (INFINITE {x | a < x /\ x < b})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  infinite_subset;
+  TYPE_THEN `f = (\ n. a + (b-a)/((&2) pow (SUC n)))` ABBREV_TAC ;
+  TYPE_THEN `IMAGE f  UNIV` EXISTS_TAC ;
+  CONJ_TAC;
+  TYPE_THEN `(! x y. (f x = f y) ==> (x = y))` SUBGOAL_TAC;
+  EXPAND_TAC "f";
+  REP_BASIC_TAC;
+  USE 2 (REWRITE_RULE[REAL_ARITH `(a + d = a + d') <=> (d = d')`;real_div;REAL_PROP_EQ_RMUL_';]);
+  TYPE_THEN `~(b - a = &0)` SUBGOAL_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  REWR 2;
+  USE 2 (REWRITE_RULE[GSYM REAL_EQ_INV]);
+  UND 2;
+  REDUCE_TAC;
+  DISCH_TAC;
+  ONCE_REWRITE_TAC[GSYM SUC_INJ];
+  IMATCH_MP_TAC  EXPinj;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `INFINITE (UNIV:num->bool) ==> INFINITE (IMAGE f UNIV)` SUBGOAL_TAC;
+  ASM_MESON_TAC[INFINITE_IMAGE_INJ];
+  REWRITE_TAC[num_INFINITE];
+  (* -- *)
+  REWRITE_TAC[IMAGE;SUBSET];
+  GEN_TAC;
+  REP_BASIC_TAC;
+  UND 2;
+  DISCH_THEN_REWRITE;
+  EXPAND_TAC "f";
+  CONJ_TAC;
+  ONCE_REWRITE_TAC[REAL_ARITH `a < a + x <=> &0 < x`];
+  REWRITE_TAC[real_div];
+  IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
+  CONJ_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  IMATCH_MP_TAC  REAL_PROP_POS_INV;
+  REDUCE_TAC;
+  ARITH_TAC;
+  ONCE_REWRITE_TAC [REAL_ARITH `a + x < b <=> x < (b - a)*(&1)`];
+  REWRITE_TAC[real_div];
+  IMATCH_MP_TAC  REAL_PROP_LT_LMUL;
+  CONJ_TAC;
+  UND 0;
+  REAL_ARITH_TAC;
+  ONCE_REWRITE_TAC[GSYM REAL_INV_1];
+  IMATCH_MP_TAC  REAL_LT_INV2;
+  REDUCE_TAC;
+  IMATCH_MP_TAC  exp_gt1;
+  ARITH_TAC;
+  (* Thu Aug 19 14:59:58 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let finite_augment1 = prove_by_refinement(
+  `!n (X:A->bool) . (INFINITE X) ==> (?Z. Z SUBSET X /\ Z HAS_SIZE n)`,
+  (* {{{ proof *)
+  [
+  INDUCT_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `EMPTY:A->bool` EXISTS_TAC  ;
+  REWRITE_TAC[HAS_SIZE_0];
+  REP_BASIC_TAC;
+  TSPEC `X` 0;
+  REWR 0;
+  REP_BASIC_TAC;
+  TYPE_THEN `INFINITE (X DIFF Z)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  INFINITE_DIFF_FINITE;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[HAS_SIZE];
+  DISCH_TAC;
+  USE 3 (MATCH_MP INFINITE_NONEMPTY);
+  USE 3 (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  TYPE_THEN `u INSERT Z` EXISTS_TAC;
+  CONJ_TAC;
+  UND 2;
+  UND 3;
+  REWRITE_TAC[DIFF;SUBSET;INSERT];
+  ASM_MESON_TAC[];
+  (* -- *)
+  USE 0 (REWRITE_RULE[HAS_SIZE]);
+  ASM_SIMP_TAC [HAS_SIZE;FINITE_INSERT;CARD_CLAUSES;];
+  UND 3;
+  REWRITE_TAC[DIFF];
+  DISCH_THEN_REWRITE;
+  ]);;
+  (* }}} *)
+
+let finite_augment = prove_by_refinement(
+  `!(X:A->bool) Y n m . (n <= m) /\ (X HAS_SIZE n) /\ (INFINITE Y) /\
+   (X SUBSET Y) ==> (?Z. (X SUBSET Z /\ Z SUBSET Y /\ Z HAS_SIZE m))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `INFINITE (Y DIFF X)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  INFINITE_DIFF_FINITE;
+  ASM_MESON_TAC[HAS_SIZE];
+  DISCH_TAC;
+  USE 4(MATCH_MP finite_augment1);
+  USE 3(REWRITE_RULE[LE_EXISTS]);
+  REP_BASIC_TAC;
+  TSPEC `d` 4;
+  REP_BASIC_TAC;
+  TYPE_THEN `X UNION Z` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  REWRITE_TAC[union_subset];
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 5;
+  SET_TAC[SUBSET;DIFF];
+  REWRITE_TAC[HAS_SIZE];
+  CONJ_TAC;
+  ASM_REWRITE_TAC[FINITE_UNION];
+  ASM_MESON_TAC[HAS_SIZE];
+  RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
+  REP_BASIC_TAC;
+  EXPAND_TAC "d";
+  EXPAND_TAC "n";
+  IMATCH_MP_TAC  CARD_UNION;
+  ASM_REWRITE_TAC[];
+  UND 5;
+  REWRITE_TAC[SUBSET;DIFF;INTER;EQ_EMPTY ];
+  MESON_TAC[];
+  (* Thu Aug 19 15:29:05 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let euclid_add_cancel = prove_by_refinement(
+  `!p q q'. (euclid_plus p q = euclid_plus p q') <=> (q = q')`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[FUN_EQ_THM];
+  REWRITE_TAC [euclid_plus;];
+  REWRITE_TAC[REAL_ARITH `(x + a = x + b) <=> (a = b)`];
+  ]);;
+  (* }}} *)
+
+
+let degree_vertex_disk_ver2 = prove_by_refinement(
+  `!r p X. (&0 < r) /\ (euclid 2 p) /\ (FINITE X) /\ (CARD X <= 4) /\
+     (X SUBSET {x | (euclid 2 x) /\ (d_euclid p x = r)}) ==>
+    (?C. (!i. (X i) ==> (?C' C'' v.
+           simple_arc_end C' p v /\
+           simple_arc_end C'' v i  /\
+           C' SUBSET closed_ball(euclid 2,d_euclid) p (r/ &2) /\
+           (C' INTER C'' = {v}) /\
+           (C' UNION C'' = C i )) /\
+          simple_arc_end (C i ) p  i /\
+           C i SUBSET (closed_ball(euclid 2,d_euclid) p r) /\
+           C i  INTER (closed_ball(euclid 2,d_euclid) p (r / &2))
+           SUBSET (hyperplane 2 e2 (p 1) UNION
+                     hyperplane 2 e1 (p 0))) /\
+       (!i j. (X i ) /\ (X j) /\ (~(i=j)) ==>
+           (C i INTER C j = {p} )))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `!x. (X x) ==> (?r t. &0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = p + r *# cis t))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[euclid_cancel1];
+  IMATCH_MP_TAC  polar_exist;
+  USE 0(REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[euclid_sub_closure];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!x. (X x) ==> (?t. &0 <= t /\ t < &2 * pi /\ &0 <= r /\ (x = p + r *# cis t))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TSPEC `x` 5;
+  REWR 5;
+  REP_BASIC_TAC;
+  UND 5;
+  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])));
+  TYPE_THEN `t` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 4;
+  REAL_ARITH_TAC;
+  USE 0 (REWRITE_RULE[SUBSET]);
+  TSPEC `euclid_plus p (r' *# cis t)` 0;
+  REWR 0;
+  REP_BASIC_TAC;
+  UND 0;
+  TYPEL_THEN[`2`;`p`;`r' *# cis t`] (fun t-> ANT_TAC (ISPECL t d_euclidpq));
+  ASM_REWRITE_TAC[polar_euclid];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[GSYM norm2;norm2_scale_cis];
+  DISCH_TAC;
+  TYPE_THEN `abs  r' = r'` SUBGOAL_TAC;
+  UND 7;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  REWR 0;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  KILL 5;
+  (* -- *)
+  TYPE_THEN `TX = {t | (&0 <= t /\ t < &2 *pi /\ (X( p + (r *# (cis t))))) }` ABBREV_TAC ;
+  TYPE_THEN `BIJ ( \ t. p + r *# cis t) TX X` SUBGOAL_TAC;
+  REWRITE_TAC[BIJ;INJ;SURJ];
+  SUBCONJ_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "TX";
+  REWRITE_TAC[];
+  MESON_TAC[];
+  EXPAND_TAC "TX";
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  USE 7 (REWRITE_RULE[euclid_add_cancel]);
+  PROOF_BY_CONTR_TAC;
+  TYPEL_THEN[`x`;`y`;`r`;`r`] (fun t-> ANT_TAC(ISPECL t polar_inj));
+  ASM_REWRITE_TAC[];
+  UND 4;
+  REAL_ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  UND 4;
+  REAL_ARITH_TAC;
+  DISCH_THEN_REWRITE;
+  REP_BASIC_TAC;
+  EXPAND_TAC "TX";
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `INFINITE {x | &0 <= x /\ x < &2* pi}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  infinite_subset;
+  TYPE_THEN `{x | &0 < x /\ x < &2 * pi}` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  infinite_interval;
+  IMATCH_MP_TAC  REAL_PROP_POS_MUL2;
+  REWRITE_TAC[PI_POS];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[REAL_ARITH `&0 < x ==> &0 <= x`];
+  DISCH_TAC;
+  (* A -- *)
+  TYPE_THEN `TX HAS_SIZE CARD X` SUBGOAL_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  SUBCONJ_TAC;
+  COPY 7;
+  JOIN 2 7;
+  USE 2 (MATCH_MP FINITE_BIJ2);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  IMATCH_MP_TAC BIJ_CARD;
+  ASM_REWRITE_TAC [];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `(?Z. (TX SUBSET Z /\ Z SUBSET {x | &0 <= x /\ x < &2 *pi}  /\ Z HAS_SIZE 4))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  finite_augment;
+  TYPE_THEN `CARD X` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC"TX";
+  REWRITE_TAC[SUBSET];
+  REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  (* B -- order points *)
+  TYPE_THEN `FINITE Z` SUBGOAL_TAC;
+  ASM_MESON_TAC[HAS_SIZE];
+  DISCH_TAC;
+  USE 13 (MATCH_MP real_finite_increase);
+  REP_BASIC_TAC;
+  USE 10(REWRITE_RULE[HAS_SIZE]);
+  REP_BASIC_TAC;
+  REWR 13;
+  REWR 14;
+  (* -- *)
+  TYPEL_THEN [`r`;`p`;`u`] (fun t-> ANT_TAC (ISPECL t degree_vertex_disk));
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 14;
+  REWRITE_TAC[BIJ;SURJ];
+  REP_BASIC_TAC;
+  USE 11(REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 16;
+  UND 17;
+  ARITH_TAC;
+  REP_BASIC_TAC;
+  (* [C] -- create C *)
+  TYPE_THEN `f = (\t. euclid_plus p (r *# cis t))` ABBREV_TAC ;
+  TYPE_THEN `g = INV f TX X` ABBREV_TAC ;
+  TYPE_THEN `u' = INV u {x | x <| 4} Z` ABBREV_TAC ;
+  TYPE_THEN `BIJ g X TX` SUBGOAL_TAC;
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  INVERSE_BIJ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `BIJ u' Z {x | x <| 4}` SUBGOAL_TAC;
+  EXPAND_TAC "u'";
+  IMATCH_MP_TAC  INVERSE_BIJ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `INJ (compose u'  g) X { x | x <| 4}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  COMP_INJ;
+  TYPE_THEN `TX` EXISTS_TAC;
+  CONJ_TAC;
+  UND 21;
+  REWRITE_TAC[BIJ];
+  MESON_TAC[];
+  IMATCH_MP_TAC  inj_subset_domain;
+  TYPE_THEN `Z` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 22;
+  REWRITE_TAC [BIJ];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  TYPE_THEN `(\ j. C ((compose u' g) j))` EXISTS_TAC;
+  REWRITE_TAC[];
+  (* D -- check properties *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN   `j = compose u' g i` ABBREV_TAC ;
+  TSPEC `j` 17;
+  TYPE_THEN `j <| 4` SUBGOAL_TAC;
+  USE 23 (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  EXPAND_TAC "j";
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWR 17;
+  ASM_REWRITE_TAC[];
+  (* --2-- *)
+  TYPE_THEN `i = f (u j)` SUBGOAL_TAC;
+  EXPAND_TAC "j";
+  EXPAND_TAC "f";
+  EXPAND_TAC "u'";
+  REWRITE_TAC[compose];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  TYPE_THEN `u (INV u {x | x <| 4} Z (g i)) = (g i)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  inv_comp_right;
+  ASM_REWRITE_TAC[];
+  UND 21;
+  UND 12;
+  REWRITE_TAC[SUBSET;BIJ;SURJ;];
+  UND 24;
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `f (g i) = i` SUBGOAL_TAC;
+  EXPAND_TAC "g";
+  IMATCH_MP_TAC  inv_comp_right;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "f";
+  DISCH_THEN_REWRITE;
+  EXPAND_TAC "f";
+  DISCH_THEN (fun t-> RULE_ASSUM_TAC (REWRITE_RULE[GSYM t]));
+  ASM_REWRITE_TAC[];
+  (* E *)
+  REP_BASIC_TAC;
+  TYPE_THEN `i' = compose u' g i` ABBREV_TAC ;
+  TYPE_THEN `j' = compose u' g j` ABBREV_TAC ;
+  KILL 17;
+  TYPE_THEN `~(i' = j')` SUBGOAL_TAC;
+  DISCH_TAC;
+  UND 24;
+  REWRITE_TAC[];
+  USE 23 (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(i' <| 4) /\ (j' <| 4) ` SUBGOAL_TAC;
+  EXPAND_TAC "i'";
+  EXPAND_TAC "j'";
+  USE 23 (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPEL_THEN [`i'`;`j'`] (USE 16 o ISPECL);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* Thu Aug 19 18:06:33 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION O *)
+(* ------------------------------------------------------------------ *)
+
+
+let simple_arc_connected = prove_by_refinement(
+  `!C. simple_arc top2 C ==> connected top2 C`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[simple_arc;];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  connect_image;
+  TYPE_THEN `(top_of_metric(UNIV,d_real))` EXISTS_TAC;
+  ASM_REWRITE_TAC[connect_real];
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REWRITE_TAC[IMAGE;SUBSET];
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[];
+  (* Fri Aug 20 08:32:31 EDT 2004 *)
+  ]);;
+
+  (* }}} *)
+
+let disk_endpoint = prove_by_refinement(
+  `!C r p v v'. simple_arc_end C v v' /\ (&0 < r) /\ (euclid 2 p) /\
+       (C INTER (closed_ball(euclid 2,d_euclid) p r) = {v}) ==>
+      (d_euclid p v = r)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `connected top2 C` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_connected;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `A = euclid 2 DIFF (closed_ball (euclid 2, d_euclid) p r)` ABBREV_TAC ;
+  TYPE_THEN `B = closed_ball(euclid 2, d_euclid) p r` ABBREV_TAC ;
+  TYPE_THEN `closed_ top2 B` SUBGOAL_TAC;
+  EXPAND_TAC "B";
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  closed_ball_closed;
+  REWRITE_TAC[metric_euclid];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `top2 A` SUBGOAL_TAC;
+  UND 8;
+  EXPAND_TAC "A";
+  EXPAND_TAC "B";
+  REWRITE_TAC[closed;top2_unions;open_DEF ;];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `B' = open_ball(euclid 2,d_euclid) p r` ABBREV_TAC ;
+  TYPE_THEN `C SUBSET B' UNION A` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  EXPAND_TAC "B'";
+  EXPAND_TAC "B";
+  REWRITE_TAC[open_ball;SUBSET;DIFF;closed_ball;UNION];
+  USE 10 (REWRITE_RULE[SUBSET]);
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TSPEC `x` 10;
+  REWR 10;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USE 13 (REWRITE_RULE[DE_MORGAN_THM]);
+  REP_BASIC_TAC;
+  TYPE_THEN `B x` SUBGOAL_TAC;
+  EXPAND_TAC "B";
+  REWRITE_TAC[closed_ball];
+  ASM_REWRITE_TAC[];
+  USE 0 (REWRITE_RULE[FUN_EQ_THM]);
+  USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
+  ASM_MESON_TAC[REAL_ARITH `u <= v /\ ~(u = v) ==> (u < v)`];
+  (* - *)
+  USE 5 (REWRITE_RULE[connected;top2_unions]);
+  REP_BASIC_TAC;
+  TYPEL_THEN[`B'`;`A`] (USE 12 o ISPECL);
+  REWR 12;
+  TYPE_THEN `top2 B'` SUBGOAL_TAC;
+  EXPAND_TAC "B'";
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  open_ball_open;
+  REWRITE_TAC[metric_euclid];
+  DISCH_THEN_FULL_REWRITE;
+  (* - *)
+  TYPE_THEN `B' INTER A = EMPTY` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  EXPAND_TAC "B'";
+  EXPAND_TAC "B";
+  REWRITE_TAC[open_ball;closed_ball;DIFF;EQ_EMPTY;INTER;];
+  REP_BASIC_TAC;
+  UND 14;
+  ASM_REWRITE_TAC[];
+  UND 16;
+  REAL_ARITH_TAC;
+  DISCH_THEN_FULL_REWRITE;
+  (* - *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `C SUBSET B` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `B'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "B";
+  EXPAND_TAC "B'";
+  REWRITE_TAC[SUBSET;open_ball;closed_ball];
+  MESON_TAC[REAL_ARITH `x < y ==> x <= y`];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `~(v = v')` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_distinct;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[];
+  TYPE_THEN `C v'` SUBGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end2];
+  DISCH_TAC;
+  TYPE_THEN `B v'` SUBGOAL_TAC;
+  UND 15;
+  UND 16;
+  MESON_TAC[ISUBSET];
+  UND 16;
+  UND 0;
+  REWRITE_TAC[INTER;eq_sing];
+  MESON_TAC[];
+  (* - *)
+  TYPE_THEN `C v` SUBGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end];
+  DISCH_TAC;
+  TYPE_THEN `A v` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  TYPE_THEN `B v` SUBGOAL_TAC;
+  UND 0;
+  REWRITE_TAC[INTER;eq_sing];
+  DISCH_THEN_REWRITE;
+  EXPAND_TAC "A";
+  REWRITE_TAC[DIFF];
+  DISCH_THEN_REWRITE;
+  (* Fri Aug 20 09:12:44 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let disk_endpoint_gen = prove_by_refinement(
+  `!C B' B v v'. simple_arc_end C v v'  /\
+      (top2 B') /\ (closed_ top2 B) /\ (B' SUBSET B) /\
+       (C INTER B = {v}) ==>
+      (~(B' v))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `connected top2 C` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_connected;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `A = euclid 2 DIFF B` ABBREV_TAC ;
+  (* - *)
+  TYPE_THEN `top2 A` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  UND 3;
+  REWRITE_TAC[closed;top2_unions;open_DEF ;];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `C SUBSET euclid 2` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `C SUBSET B' UNION A` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  REWRITE_TAC[open_ball;SUBSET;DIFF;closed_ball;UNION];
+  USE 9 (REWRITE_RULE[SUBSET]);
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `B x` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  USE 1(REWRITE_RULE[INTER;eq_sing]);
+  REP_BASIC_TAC;
+  TYPE_THEN `(x = v)` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  DISJ2_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  DISCH_TAC;
+  USE 6 (REWRITE_RULE[connected;top2_unions]);
+  REP_BASIC_TAC;
+  TYPEL_THEN[`B'`;`A`] (USE 6 o ISPECL);
+  REWR 6;
+  (* - *)
+  TYPE_THEN `B' INTER A = EMPTY` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  REWRITE_TAC[open_ball;closed_ball;DIFF;EQ_EMPTY;INTER;];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  (* - *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `C SUBSET B` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `B'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `~(v = v')` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_distinct;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[];
+  TYPE_THEN `C v'` SUBGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end2];
+  DISCH_TAC;
+  TYPE_THEN `B v'` SUBGOAL_TAC;
+  UND 13;
+  UND 14;
+  MESON_TAC[ISUBSET];
+  UND 14;
+  UND 1;
+  REWRITE_TAC[INTER;eq_sing];
+  MESON_TAC[];
+  (* - *)
+  TYPE_THEN `C v` SUBGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end];
+  DISCH_TAC;
+  TYPE_THEN `A v` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  TYPE_THEN `B v` SUBGOAL_TAC;
+  UND 1;
+  REWRITE_TAC[INTER;eq_sing];
+  DISCH_THEN_REWRITE;
+  EXPAND_TAC "A";
+  REWRITE_TAC[DIFF];
+  DISCH_THEN_REWRITE;
+  ]);;
+  (* }}} *)
+
+let disk_endpoint_outer = prove_by_refinement(
+  `!C r p v v'. simple_arc_end C v v'  /\ (&0 < r) /\ (euclid 2 p) /\
+      (C INTER (euclid 2 DIFF (open_ball(euclid 2,d_euclid) p r)) = {v})
+     ==>
+      (d_euclid p v = r)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `B = (euclid 2 DIFF (open_ball(euclid 2,d_euclid) p r))` ABBREV_TAC ;
+  TYPE_THEN `B' = (euclid 2 DIFF (closed_ball(euclid 2,d_euclid) p r))` ABBREV_TAC ;
+  (* - *)
+  TYPE_THEN `B' SUBSET B` SUBGOAL_TAC;
+  EXPAND_TAC "B'";
+  EXPAND_TAC "B";
+  REWRITE_TAC[closed_ball;open_ball;SUBSET;DIFF];
+  MESON_TAC[REAL_ARITH `x < u ==> x <= u`];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `closed_ top2 B` SUBGOAL_TAC;
+  EXPAND_TAC "B";
+  REWRITE_TAC[closed;top2_unions;open_DEF ;SUBSET_DIFF];
+  TYPE_THEN `open_ball (euclid 2,d_euclid) p r SUBSET (euclid 2)` SUBGOAL_TAC;
+  REWRITE_TAC[open_ball;SUBSET];
+  MESON_TAC[];
+  ASM_SIMP_TAC[DIFF_DIFF2];
+  ASM_SIMP_TAC [open_ball_open;top2;metric_euclid];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `top2 B'` SUBGOAL_TAC;
+  EXPAND_TAC "B'";
+  TH_INTRO_TAC [`top2`;`closed_ball (euclid 2,d_euclid) p r`] closed_open;
+  REWRITE_TAC[metric_euclid;top2];
+  IMATCH_MP_TAC  closed_ball_closed;
+  REWRITE_TAC[metric_euclid];
+  REWRITE_TAC[open_DEF;top2_unions;];
+  DISCH_TAC;
+  (* - *)
+  TH_INTRO_TAC [`C`;`B'`;`B`;`v`;`v'`] disk_endpoint_gen;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `B v` SUBGOAL_TAC;
+  UND 0;
+  REWRITE_TAC[INTER;eq_sing];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `B v /\ ~B' v ==> (d_euclid p v = r)` SUBGOAL_TAC;
+  EXPAND_TAC "B";
+  EXPAND_TAC "B'";
+  REWRITE_TAC[DIFF;open_ball;closed_ball;];
+  MESON_TAC[REAL_ARITH `x <= y /\ ~(x < y) ==> (x = y)`];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let graph_edge_around = jordan_def
+  `graph_edge_around (G:(A,B)graph_t) v =
+   { e | graph_edge G e /\ graph_inc G e v}`;;
+
+let graph_edge_around_empty = prove_by_refinement(
+  `!(G:(A,B)graph_t) v. (graph G) /\ ~(graph_vertex G v) ==>
+      (graph_edge_around G v = EMPTY)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[graph_edge_around;EQ_EMPTY;];
+  REP_BASIC_TAC;
+  TH_INTRO_TAC [`G`;`x`] graph_inc_subset;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  (* Fri Aug 20 09:25:57 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let graph_disk_hv_preliminaries = prove_by_refinement(
+  `!G. plane_graph G /\
+      FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
+      ~(graph_edge G = EMPTY) /\
+     (!v. (CARD (graph_edge_around G v) <=| 4))
+   ==>
+  (?NC D short_end hyper r d f. ((!e p. graph_edge G e /\ (!v. ~D v p) ==> (f e p = d e p)) /\
+  (!e v p.
+           graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v /\ D v p
+           ==> ~f e p) /\
+  (!e v p.
+           (graph_edge G e /\ graph_inc G e v) /\ D v p
+           ==> (f e p = NC e v p)) /\
+  (!e. f e = {x | d e x \/ (?v. graph_inc G e v /\ NC e v x)}) /\
+  (!v e e'.
+           graph_edge G e /\
+           graph_edge G e' /\
+           graph_inc G e v /\
+           graph_inc G e' v /\
+           ~(e = e')
+           ==> (NC e v INTER NC e' v = {v})) /\
+  (!e v. graph_edge G e /\ graph_inc G e v ==> d e (short_end e v)) /\
+  (!e e'.
+           graph_edge G e /\ graph_edge G e' /\ ~(e = e')
+           ==> (d e INTER d e' = {})) /\
+  (!e v.
+           graph_edge G e /\ graph_inc G e v
+           ==> ~graph_vertex G (short_end e v)) /\
+  (!v v'.
+           graph_vertex G v /\ graph_vertex G v' /\ ~(v = v')
+           ==> (D v INTER D v' = {})) /\
+  (!e v.
+           graph_edge G e /\ graph_inc G e v
+           ==> simple_arc_end (NC e v) v (short_end e v) /\
+               NC e v SUBSET D v /\
+               hyper (NC e v) v) /\
+  ((\ B v.
+            B INTER closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET
+            hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)) =
+       hyper) /\
+  (!e v. graph_edge G e /\ graph_inc G e v ==> graph_vertex G v) /\
+  (!e v.
+           graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v
+           ==> (d e INTER D v = {})) /\
+  (!e. graph_edge G e ==> d e SUBSET e) /\
+  (!e v.
+           graph_edge G e /\ graph_inc G e v
+           ==> (d e INTER D v = {(short_end e v)}) /\
+               (d_euclid v (short_end e v) = r) /\
+               (!v'. graph_inc G e v' /\ ~(v = v')
+                     ==> simple_arc_end (d e) (short_end e v)
+                         (short_end e v'))) /\
+  (!v. euclid 2 v ==> D v v) /\
+  (!u. closed_ top2 (D u)) /\
+  (( \ u. closed_ball (euclid 2,d_euclid) u r) = D) /\
+  (&0 < r) /\
+  (plane_graph G)))
+     `,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TH_INTRO_TAC [`G`] graph_disk;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* TYPE_THEN `r /(&2)` EXISTS_TAC; *)
+  (* - *)
+  TYPE_THEN `D = (\u. (closed_ball (euclid 2,d_euclid ) u r))` ABBREV_TAC ;
+  TYPE_THEN `!u. closed_ top2 (D u)` SUBGOAL_TAC;
+  EXPAND_TAC "D";
+  GEN_TAC;
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  closed_ball_closed;
+  REWRITE_TAC[metric_euclid];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `!v. (euclid 2 v) ==> D v v` SUBGOAL_TAC;
+  EXPAND_TAC "D";
+  REWRITE_TAC[closed_ball2_center];
+  GEN_TAC;
+  DISCH_THEN_REWRITE;
+  UND 7;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* - *)
+  (* [A]- Pick middle arcs *)
+  (* {{{ *)
+
+  TYPE_THEN `!e. ?d. (graph_edge G e) ==> (?u u' v v'.  simple_arc_end d u u' /\ graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') /\  (d INTER (D v) = {u}) /\ (d INTER (D v') = {u'}) /\ (d SUBSET e) /\ (d_euclid v u = r) /\ (d_euclid v' u' = r))` SUBGOAL_TAC ;
+  GEN_TAC;
+  RIGHT_TAC "d";
+  DISCH_TAC;
+  TH_INTRO_TAC [`G`;`e`] graph_edge_end_select;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);  (* -xx- *)
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TH_INTRO_TAC [`e`;`D v`;`D v'`] simple_arc_end_restriction;
+  ASM_REWRITE_TAC[GSYM top2];
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  USE 16 (REWRITE_RULE[SUBSET ]);
+  ASM_MESON_TAC[];
+  UND 6;
+  DISCH_THEN (TH_INTRO_TAC [`v`;`v'`] );
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE [plane_graph;]);
+  ASM_MESON_TAC[REWRITE_RULE[SUBSET] graph_inc_subset];
+  DISCH_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "D";
+  UND 6;
+  REWRITE_TAC[INTER;EQ_EMPTY];
+  MESON_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS ];
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  TSPEC `e` 15;
+  REWR 15;
+  REWR 13;
+  REWR 14;
+  UND 18;
+  REWRITE_TAC[SUBSET];
+  UND 13;
+  UND 14;
+  REWRITE_TAC[INTER];
+  UND 10;
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `v''` EXISTS_TAC;
+  TYPE_THEN `v'''` EXISTS_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  TYPE_THEN `v'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  disk_endpoint;
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `v'''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 16;
+  EXPAND_TAC "D";
+  DISCH_THEN_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  USE 21 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] graph_inc_subset];
+  (* -- *)
+  IMATCH_MP_TAC  disk_endpoint;
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `v''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 15;
+  EXPAND_TAC "D";
+  DISCH_THEN_REWRITE;
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  USE 21 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[REWRITE_RULE[ISUBSET] graph_inc_subset];
+  DISCH_TAC;
+  RIGHT  11 "e";
+  REP_BASIC_TAC;
+  (* B-  short_end *)
+  TYPE_THEN `short_end = ( \ e v. @s. (d e INTER (D v)) s)` ABBREV_TAC ;
+  TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v) ==> (d e INTER (D v) = {(short_end e v)}) /\ (d_euclid v (short_end e v) = r) /\ (!v'. (graph_inc G e v' /\ ~(v = v') ==> (simple_arc_end (d e) (short_end e v) (short_end e v'))))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TSPEC `e` 11;
+  REWR 11;
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
+  IMATCH_MP_TAC graph_edge2;
+  UND 4;
+  REWRITE_TAC[plane_graph];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `!u. graph_inc G e u ==> (u = v') \/ (u = v'')` SUBGOAL_TAC;
+  ASM_MESON_TAC[two_exclusion];
+  DISCH_TAC;
+  TYPE_THEN `?s. (d e INTER D v) s` SUBGOAL_TAC;
+  TSPEC `v` 24;
+  REWR 24;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[INR IN_SING ];
+  MESON_TAC[];
+  ASM_REWRITE_TAC[INR IN_SING ];
+  MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `(d e INTER D v) (short_end e v)` SUBGOAL_TAC;
+  EXPAND_TAC "short_end";
+  SELECT_TAC;
+  DISCH_THEN_REWRITE ;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  LEFT_TAC "v'";
+  LEFT_TAC "v'";
+  GEN_TAC;
+  TYPE_THEN `(v = v') \/ (v = v'')` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(graph_inc G e v''') ==> (v''' = v') \/ (v''' = v'')` SUBGOAL_TAC;
+  DISCH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* --- *)
+  DISCH_THEN DISJ_CASES_TAC;
+  FIRST_ASSUM MP_TAC;
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `short_end e v' = u` SUBGOAL_TAC;
+  REWR 26;
+  USE 26 (REWRITE_RULE[INR IN_SING]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  KILL 24;
+  REWR 27;
+  UND 24;
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `short_end e v'' = u'` SUBGOAL_TAC;
+  TYPE_THEN `?s. (d e INTER D v'') s` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[INR IN_SING ];
+  MESON_TAC[];
+  EXPAND_TAC "short_end";
+  SELECT_TAC;
+  ASM_REWRITE_TAC[INR IN_SING ];
+  DISCH_THEN_REWRITE;
+  UND 24;
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  FIRST_ASSUM MP_TAC;
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `short_end e v'' = u'` SUBGOAL_TAC;
+  REWR 26;
+  USE 26 (REWRITE_RULE[INR IN_SING]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  KILL 24;
+  REWR 27;
+  UND 24;
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `short_end e v' = u` SUBGOAL_TAC;
+  TYPE_THEN `?s. (d e INTER D v') s` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[INR IN_SING ];
+  MESON_TAC[];
+  EXPAND_TAC "short_end";
+  SELECT_TAC;
+  ASM_REWRITE_TAC[INR IN_SING ];
+  DISCH_THEN_REWRITE;
+  UND 24;
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+
+  (* }}} *)
+  (* [C]- *)
+  TYPE_THEN `X = (\ v. (IMAGE (\ e. short_end e v) (graph_edge_around G v)))` ABBREV_TAC ;
+  TYPE_THEN `!v. FINITE (graph_edge_around G v)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[graph_edge_around];
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `graph_edge G ` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `!v. graph_vertex G v ==> (FINITE (X v) /\ (CARD (X v) <=| 4) /\ ((X v) SUBSET {x | euclid 2 x /\ (d_euclid v x = r)}))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  EXPAND_TAC "X";
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  LE_TRANS;
+  TYPE_THEN `CARD (graph_edge_around G v)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  CARD_IMAGE_LE;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET;IMAGE];
+  REP_BASIC_TAC;
+  UND 18;
+  DISCH_THEN_FULL_REWRITE;
+  USE 19 (REWRITE_RULE[graph_edge_around]);
+  TSPEC `x'` 13;
+  TSPEC `v` 13;
+  REWR 13;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  UND 19;
+  EXPAND_TAC "D";
+  REWRITE_TAC[INTER;eq_sing;closed_ball];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  (* -D now generate curves C in disk.  *)
+  TYPE_THEN `!v. (graph_vertex G v) ==> (?C. (!i. X v i                       ==> (?C' C'' v'.                                simple_arc_end C' v v' /\                                simple_arc_end C'' v' i /\                                C' SUBSET                                closed_ball (euclid 2,d_euclid) v (r / &2) /\                                (C' INTER C'' = {v'}) /\                                (C' UNION C'' = C i)) /\                           simple_arc_end (C i) v i /\                           C i SUBSET closed_ball (euclid 2,d_euclid) v r /\                           C i INTER                           closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET                           hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)) /\                  (!i j. X v i /\ X v j /\ ~(i = j) ==> (C i INTER C j = {v})))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  degree_vertex_disk_ver2;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(\j. X v j) = X v` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  BETA_TAC;
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  TSPEC `v` 16;
+  REWR 16;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  LEFT 17 "C";
+  LEFT 17 "C";
+  REP_BASIC_TAC;
+  TYPE_THEN `f = (\ e. { x | d e x \/ (?v. graph_inc G e v /\ C v (short_end e v) x)})` ABBREV_TAC ;
+  (* -[E] lets try to flatten some hypotheses *)
+  TYPE_THEN `NC  = (\ e v. (C v (short_end e v)))` ABBREV_TAC ;
+  KILL 1;
+  KILL 2;
+  KILL 3;
+  KILL 0;
+  (* rework 5 *)
+  TYPE_THEN `!e . graph_edge G e ==> (d e SUBSET e)` SUBGOAL_TAC;
+  UND 11;
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `!e v. graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v ==> (d e INTER (D v) = EMPTY)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL);
+  REWR 5;
+  UND 5;
+  UND 0;
+  REWRITE_TAC[SUBSET;EQ_EMPTY];
+  UND 3;
+  EXPAND_TAC "D";
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  DISCH_TAC;
+  KILL 5;
+  KILL 11;
+  KILL 12;
+  (* rework 16 *)
+  TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> graph_vertex G v` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  TH_INTRO_TAC  [`G`;`e`] graph_inc_subset;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v ==> X v (short_end e v))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  EXPAND_TAC "X";
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[graph_edge_around];
+  DISCH_TAC;
+  KILL 16;
+  KILL 14;
+  (* rework 17 *)
+  TYPE_THEN `hyper = (\ B v. (B INTER closed_ball (euclid 2,d_euclid) v (r / &2) SUBSET hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0)))` ABBREV_TAC ;
+  TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> (simple_arc_end (NC e v) v (short_end e v)) /\ (NC e v SUBSET D v) /\ (hyper (NC e v) v)` SUBGOAL_TAC;
+  EXPAND_TAC "hyper";
+  EXPAND_TAC "NC";
+  REP_BASIC_TAC;
+  TSPEC `v` 17;
+  TYPE_THEN `graph_vertex G v` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  REP_BASIC_TAC;
+  TSPEC `short_end e v` 16;
+  TYPE_THEN `X v (short_end e v)` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "D";
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* F- continue simplification *)
+  TYPE_THEN `!v v'. graph_vertex G v /\ graph_vertex G v' /\ ~(v = v') ==> (D v INTER D v' = EMPTY)` SUBGOAL_TAC;
+  EXPAND_TAC "D";
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  KILL 6;
+  (* - *)
+  TYPE_THEN `!e v. (graph_edge G e /\ graph_inc G e v ==> ~(graph_vertex G (short_end e v)))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL);
+  REWR 13;
+  REP_BASIC_TAC;
+  USE 21 (REWRITE_RULE[eq_sing;INTER]);
+  REP_BASIC_TAC;
+  TYPE_THEN `D (short_end e v) (short_end e v)` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  RULE_ASSUM_TAC (REWRITE_RULE [plane_graph]);
+  REP_BASIC_TAC;
+  USE 27 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~(D (short_end e v) INTER D v = EMPTY)` SUBGOAL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `short_end e v` EXISTS_TAC;
+  ASM_REWRITE_TAC[INTER];
+  REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USE 25 (REWRITE_RULE[]);
+  UND 25;
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_zero;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[metric_euclid];
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  USE 28 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  UND 20;
+  UND 7;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (d e INTER d e' = EMPTY)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 21 (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  TYPEL_THEN [`e`;`e'`] (USE 4 o ISPECL);
+  REWR 4;
+  TYPE_THEN `d e INTER d e' SUBSET graph_vertex G` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `e INTER e'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_inter_pair;
+  UND 0;
+  UND 20;
+  UND 16;
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `graph_vertex G u` SUBGOAL_TAC;
+  USE 26 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  USE 21(REWRITE_RULE[INTER]);
+  TYPE_THEN `graph_inc G e u` ASM_CASES_TAC;
+  TYPEL_THEN [`e`;`u`] (USE 13 o ISPECL);
+  REWR 13;
+  TYPE_THEN `(d e INTER D u) u` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  USE 28 GSYM;
+  ASM_REWRITE_TAC[INTER];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 25 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  USE 28 GSYM;
+  REWR 28;
+  USE 28 (REWRITE_RULE[INR IN_SING]);
+  UND 28;
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `d e INTER D u = EMPTY ` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC [];
+  USE 26 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[INTER];
+  DISCH_TAC;
+  USE 28(REWRITE_RULE[EQ_EMPTY]);
+  TSPEC `u` 28;
+  DISCH_TAC;
+  USE 28(REWRITE_RULE[INTER]);
+  UND 28;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 25 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -G continue to simplify *)
+  TYPE_THEN `!e v. graph_edge G e /\ graph_inc G e v ==> d e (short_end e v)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL);
+  REWR 13;
+  REP_BASIC_TAC;
+  USE 22(REWRITE_RULE[eq_sing;INTER]);
+  ASM_REWRITE_TAC[];
+ DISCH_TAC;
+  (* - *)
+  TYPE_THEN `! v e e'. graph_edge G e /\ graph_edge G e' /\ graph_inc G e v /\ graph_inc G e' v /\ ~(e = e') ==> (NC e v INTER NC e' v = {v})` SUBGOAL_TAC;
+  EXPAND_TAC "NC";
+  REP_BASIC_TAC;
+  TSPEC `v` 17;
+  TYPE_THEN `graph_vertex G v` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  REP_BASIC_TAC;
+  TYPEL_THEN  [`short_end e v`;`short_end e' v`](USE 17 o ISPECL);
+  KILL 25;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  KILL 17;
+  DISCH_TAC;
+  TYPE_THEN `d e (short_end e v)` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `d e' (short_end e' v)` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `d e INTER d e' = EMPTY ` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EQ_EMPTY;INTER];
+  UND 17;
+  MESON_TAC[];
+  DISCH_TAC;
+  KILL 17;
+  KILL 3;
+  KILL 15;
+  (* H- *)
+  TYPE_THEN `!e. f e = {x | d e x \/ (?v. graph_inc G e v /\ NC e v x)}` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  EXPAND_TAC "f";
+  EXPAND_TAC "NC";
+  REWRITE_TAC[];
+  DISCH_TAC;
+  KILL 18;
+  KILL 19;
+  TYPE_THEN `!e v p. (graph_edge G e /\ graph_inc G e v) /\ (D v p) ==> (f e p = NC e v  p)` SUBGOAL_TAC  ;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  EQ_TAC;
+  UND 17;
+  MESON_TAC[];
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPEL_THEN [`e`;`v`] (USE 13 o ISPECL);
+  REWR 13;
+  REP_BASIC_TAC;
+  USE 22 (REWRITE_RULE[eq_sing;INTER ]);
+  REP_BASIC_TAC;
+  TSPEC `p` 22;
+  REWR 22;
+  UND 22;
+  DISCH_THEN_FULL_REWRITE;
+  TYPEL_THEN [`e`;`v`] (USE 11 o ISPECL);
+  REWR 11;
+  REP_BASIC_TAC;
+  UND 25;
+  MESON_TAC[simple_arc_end_end2];
+  REP_BASIC_TAC;
+  TYPE_THEN `v' = v` ASM_CASES_TAC;
+  UND 19;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `p` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[];
+  TYPEL_THEN[`e`;`v'`] (USE 11 o ISPECL);
+  REWR 11;
+  REP_BASIC_TAC;
+  USE 24 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `!e v p. (graph_edge G e /\ (graph_vertex G v) /\ ~(graph_inc G e v) /\ (D v p)  ==> ~(f e p))` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[DE_MORGAN_THM ];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  DISCH_TAC;
+  TYPE_THEN `d e INTER D v = EMPTY` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS;INTER  ];
+  TYPE_THEN `p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  LEFT_TAC "v";
+  GEN_TAC;
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `~(v = v')` SUBGOAL_TAC;
+  DISCH_TAC;
+  UND 23;
+  UND 18;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPEL_THEN [`e`;`v'`] (USE 11 o ISPECL);
+  REP_BASIC_TAC;
+  REWR 11;
+  REP_BASIC_TAC;
+  USE 25 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `!e p.  graph_edge G e /\ (!v. ~(D v p)) ==> (f e p = d e p)` SUBGOAL_TAC ;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  (TAUT `~B ==> (A \/ B <=> A)`);
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  TSPEC `v` 18;
+  UND 18;
+  REWRITE_TAC[];
+  TYPEL_THEN [`e`;`v`] (USE 11 o ISPECL);
+  REWR 11;
+  REP_BASIC_TAC;
+  USE 18(REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* I- *)
+  TYPE_THEN `NC` EXISTS_TAC;
+  TYPE_THEN `D` EXISTS_TAC;
+  TYPE_THEN `short_end` EXISTS_TAC;
+  TYPE_THEN `hyper` EXISTS_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  TYPE_THEN `d` EXISTS_TAC;
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Sat Aug 21 08:06:22 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+
+let graph_vertex_exhaust = prove_by_refinement(
+  `!(G:(A,B)graph_t) e v v'.
+  (graph G /\ (graph_edge G e) /\ (graph_inc G e v) /\
+     (graph_inc G e v') /\ ~(v = v') ==> (graph_inc G e = {v,v'}))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
+  IMATCH_MP_TAC  graph_edge2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[has_size2];
+  REP_BASIC_TAC;
+  UND 6;
+  DISCH_THEN_FULL_REWRITE;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[in_pair];
+  KILL 3;
+  KILL 4;
+  RULE_ASSUM_TAC (REWRITE_RULE[in_pair]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+let graph_disk_hv = prove_by_refinement(
+  `!G. plane_graph G /\
+      FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
+      ~(graph_edge G = EMPTY) /\
+     (!v. (CARD (graph_edge_around G v) <=| 4))
+   ==>
+    (?r H . graph_isomorphic G H /\ good_plane_graph H /\
+      (&0 < r) /\
+      (!v v'.
+         graph_vertex H v /\ graph_vertex H v' /\ ~(v = v')
+         ==> (closed_ball (euclid 2,d_euclid) v r INTER
+                closed_ball (euclid 2,d_euclid) v' r =
+                {})) /\
+      (!e v.
+         graph_edge H e /\ graph_vertex H v /\ ~graph_inc H e v
+         ==> (e INTER closed_ball (euclid 2,d_euclid) v r = {})) /\
+      (!e v.
+         graph_edge H e /\  graph_inc H e v
+         ==> (e INTER closed_ball (euclid 2, d_euclid) v r SUBSET
+            (hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0))))
+    )`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TH_INTRO_TAC [`G`] graph_disk_hv_preliminaries;
+  ASM_REWRITE_TAC[];
+  POP_ASSUM_LIST (fun t-> ALL_TAC);
+  REP_BASIC_TAC;
+  (* - *) (* redo 19 *)
+  TYPE_THEN `!e p. graph_edge G e /\ (!v. graph_inc G e v ==> ~(D v p)) ==> (f e p = d e p)` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  (TAUT  `~B ==> (A \/ B <=> A)`);
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  TSPEC `v` 20;
+  UND 20;
+  ASM_REWRITE_TAC[];
+  TYPEL_THEN[`e`;`v`] (USE 10 o ISPECL);
+  REWR 10;
+  REP_BASIC_TAC;
+  USE 20 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  KILL 19;
+  (* - *)
+  TYPE_THEN `!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==> (f e INTER f e' SUBSET e INTER e')` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[SUBSET;INTER ];
+  REP_BASIC_TAC;
+  TYPE_THEN `?v. (graph_inc G e v /\ D v x)` ASM_CASES_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `f e x = NC e v x` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `graph_inc G e' v` ASM_CASES_TAC;
+  TYPE_THEN `f e' x = NC e' v x` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `(NC e v INTER NC e' v = {v})` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[FUN_EQ_THM];
+  REWRITE_TAC[INR IN_SING;INTER];
+  DISCH_TAC;
+  TSPEC `x` 28;
+  REWR 28;
+  UND 28;
+  DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  TYPE_THEN `e` (WITH 28 o ISPEC);
+  TSPEC `e'` 28;
+  UND 28;
+  UND 32;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  DISCH_THEN_FULL_REWRITE;
+  UND 26;
+  UND 27;
+  REWRITE_TAC[INTER];
+  DISCH_THEN_REWRITE;
+  PROOF_BY_CONTR_TAC;
+  UND 23;
+  REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `(f e x = d e x)` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  UND 25;
+  MESON_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `(?v. graph_inc G e' v /\ D v x)` ASM_CASES_TAC;
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `d e INTER D v = {}` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  LEFT 25 "v";
+  TSPEC `v` 25;
+  UND 25;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `f e' x = d e' x` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  UND 26;
+  MESON_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `d e INTER d e' = EMPTY` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS ;INTER];
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* A injective *)
+  TYPE_THEN `INJ f (graph_edge G) UNIV` SUBGOAL_TAC;
+  REWRITE_TAC[INJ];
+  REP_BASIC_TAC;
+  TYPE_THEN ` (graph_inc G x ) HAS_SIZE 2` SUBGOAL_TAC;
+  IMATCH_MP_TAC  graph_edge2;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[has_size2];
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc G x a` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[in_pair];
+  DISCH_TAC;
+  TYPE_THEN `d x SUBSET f x` SUBGOAL_TAC;
+  KILL 21;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `d x (short_end x a)` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `f x (short_end x a)` SUBGOAL_TAC;
+  UND 28;
+  UND 27;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `f x INTER f y SUBSET  x INTER y` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `(x INTER y) (short_end x a)` SUBGOAL_TAC;
+  USE 31 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 21 GSYM;
+  KILL 16;
+  ASM_REWRITE_TAC[INTER_IDEMPOT];
+  TYPE_THEN `(x INTER y) SUBSET (graph_vertex G)` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `(graph_vertex G (short_end x a))` SUBGOAL_TAC;
+  USE 33(REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* B now simple arc -- ugh *)
+  TYPE_THEN `(!e v v'. (graph_edge G e /\ graph_inc G e v /\ graph_inc G e v' /\ ~(v = v') ==> (simple_arc_end (f e) v v')))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `f e = (NC e v UNION d e) UNION NC e v'` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[UNION];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ;];
+  REWRITE_TAC[GSYM DISJ_ASSOC];
+  EQ_TAC;
+  REP_CASES_TAC;
+  DISJ2_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  DISJ2_TAC;
+  TYPE_THEN `v'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc G e = {v , v'}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  graph_vertex_exhaust;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWR 27;
+  USE 27 (REWRITE_RULE[in_pair]);
+  UND 27;
+  REP_CASES_TAC;
+  UND 27;
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  UND 27;
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])) THEN ASSUME_TAC t);
+  (* -- *)
+  TYPE_THEN `simple_arc_end (NC e v UNION d e) v (short_end e v')` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_trans;
+  TYPE_THEN `short_end e v` EXISTS_TAC;
+  CONJ_TAC;
+  TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
+  REWR 10;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL);
+  REWR 5;
+  REP_BASIC_TAC;
+  TSPEC `v'` 5;
+  REWR 5;
+  (* --- *)
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING;INTER ];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_THEN_FULL_REWRITE;
+  CONJ_TAC;
+  TYPE_THEN `simple_arc_end (NC e v) v (short_end e v)` SUBGOAL_TAC;
+  TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
+  REWR 10;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  MESON_TAC[simple_arc_end_end2];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* --- *)
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `D v x` SUBGOAL_TAC;
+  TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
+  REWR 10;
+  REP_BASIC_TAC;
+  USE 29 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `d e INTER D v = {(short_end e v)}` SUBGOAL_TAC;
+  TYPEL_THEN [`e`;`v`] (USE 5 o ISPECL);
+  REWR 5;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[eq_sing];
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  IMATCH_MP_TAC  simple_arc_end_trans;
+  TYPE_THEN `(short_end e v')` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL);
+  REWR 10;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INTER];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING];
+  GEN_TAC;
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  EQ_TAC;
+  DISCH_THEN_FULL_REWRITE;
+  CONJ_TAC;
+  UND 27;
+  MESON_TAC[simple_arc_end_end2];
+  TYPEL_THEN[`e`;`v'`] (USE 10 o ISPECL);
+  REWR 10;
+  REP_BASIC_TAC;
+  UND 29;
+  MESON_TAC[simple_arc_end_end2];
+  REP_BASIC_TAC;
+  UND 29;
+  REWRITE_TAC[UNION];
+  REP_CASES_TAC ;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `D v INTER D v' = {}` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `x` EXISTS_TAC;
+  CONJ_TAC;
+  TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
+  REWR 10;
+  REP_BASIC_TAC;
+  USE 31 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL);
+  REWR 10;
+  REP_BASIC_TAC;
+  USE 31 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `D v' x` SUBGOAL_TAC;
+  TYPEL_THEN [`e`;`v'`] (USE 10 o ISPECL);
+  REWR 10;
+  REP_BASIC_TAC;
+  USE 30 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `d e INTER D v' = {(short_end e v')}` SUBGOAL_TAC;
+  TYPEL_THEN [`e`;`v'`] (USE 5 o ISPECL);
+  REWR 5;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INTER;eq_sing];
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* C - *)
+  TYPE_THEN `!e v. (graph_edge G e) ==> ( e INTER graph_vertex G = (f e) INTER (graph_vertex G))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER];
+  GEN_TAC;
+  IMATCH_MP_TAC  (TAUT `(A ==> (B <=> C)) ==> (B /\ A <=> C /\ A)`);
+  DISCH_TAC;
+  TYPE_THEN `D x x` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph;SUBSET ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `graph_inc G e x` ASM_CASES_TAC;
+  TYPE_THEN `f e x = NC e x x` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `NC e x x` SUBGOAL_TAC;
+  TYPEL_THEN[`e`;`x`] (USE 10 o ISPECL);
+  REWR 10;
+  REP_BASIC_TAC;
+  UND 28;
+  MESON_TAC[simple_arc_end_end];
+  DISCH_THEN_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  TSPEC `e` 27;
+  REWR 27;
+  REWR 26;
+  UND 26;
+  REWRITE_TAC[INTER];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `~f e x` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  UND 26;
+  REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  TSPEC `e` 26;
+  REWR 26;
+  ASM_REWRITE_TAC[INTER];
+  DISCH_TAC;
+  (* D start on graph and goal *)
+  TYPE_THEN `r /(&2)` EXISTS_TAC;
+  TYPE_THEN `graph_edge_mod G f` EXISTS_TAC;
+  REWRITE_TAC[good_plane_graph];
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  CONJ_TAC;
+  IMATCH_MP_TAC  graph_edge_iso;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[TAUT `(A /\ B) /\ C <=> (A /\ (B /\ C))`];
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  plane_graph_mod;
+  USE 16 GSYM;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  TH_INTRO_TAC [`G`;`e`] graph_edge_end_select;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);  (* --x-- *)
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  TYPE_THEN `v'` EXISTS_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_e;graph_edge_mod_i]);
+  REP_BASIC_TAC;
+  USE 29 GSYM;
+  UND 29;
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `e'' =e'` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!v. closed_ball (euclid 2, d_euclid) v (r/(&2)) SUBSET D v` SUBGOAL_TAC;
+  GEN_TAC;
+  EXPAND_TAC "D";
+  REWRITE_TAC[closed_ball;SUBSET];
+  TYPE_THEN `r /(&2) < r` SUBGOAL_TAC;
+  UND 1;
+  MESON_TAC[  half_pos];
+  MESON_TAC[REAL_ARITH `x <= u /\ u < v ==> x <= v`];
+  DISCH_TAC;
+  (* - *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `D v INTER D v'` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_v]);
+  TYPE_THEN `(D v INTER D v' = EMPTY)` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[];
+  (* E - down to 2 *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_v;graph_edge_mod_i;graph_edge_mod_e]);
+  USE 27 (REWRITE_RULE[IMAGE]);
+  REP_BASIC_TAC;
+  UND 27;
+  DISCH_THEN_FULL_REWRITE;
+  LEFT 25 "e'";
+  TSPEC `x` 25;
+  PROOF_BY_CONTR_TAC;
+  USE 27(REWRITE_RULE[EMPTY_EXISTS;INTER]);
+  REP_BASIC_TAC;
+  TYPE_THEN `D v u` SUBGOAL_TAC;
+  USE 24 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `~f x u` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 25;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - final *)
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_i;graph_edge_mod_e]);
+  USE 26 (REWRITE_RULE[IMAGE]);
+  REP_BASIC_TAC;
+  UND 28;
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `e' = x` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  (* - *)
+  TYPE_THEN `f x INTER D v = NC x v INTER D v` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INTER];
+  IMATCH_MP_TAC  (TAUT `(A ==> (B <=> C)) ==> (B /\ A <=> C /\ A)`);
+  DISCH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `f x INTER (closed_ball (euclid 2,d_euclid) v (r/(&2))) = NC x v INTER (closed_ball(euclid 2, d_euclid) v (r/(&2)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INTER];
+  USE 28 (REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x'` 28;
+  UND 28;
+  UND 24;
+  REWRITE_TAC[SUBSET;INTER];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPEL_THEN[`x`;`v`] (USE 10 o ISPECL);
+  REWR 10;
+  REP_BASIC_TAC;
+  UND 10;
+  EXPAND_TAC "hyper";
+  DISCH_THEN_REWRITE;
+  (* Sat Aug 21 14:12:41 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let hv_finite = jordan_def `hv_finite C <=>
+   (?E. C SUBSET UNIONS E /\ FINITE E /\ hv_line E)`;;
+
+let hv_finite_subset = prove_by_refinement(
+  `!A B. hv_finite B /\ A SUBSET B ==> hv_finite A`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[hv_finite];
+  REP_BASIC_TAC;
+  TYPE_THEN `E` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `B` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let mk_line_hyper2_e1 = prove_by_refinement(
+  `!z. mk_line (point (z, &0)) (point(z, &1)) = hyperplane 2 e1 z`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM line2D_F;e1;mk_line;];
+  GEN_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[point_scale;point_add];
+  GEN_TAC;
+  REDUCE_TAC;
+  TYPE_THEN `!t. t * z + (&1 - t) * z = z` SUBGOAL_TAC;
+  GEN_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  EQ_TAC;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  TYPE_THEN `(z, &1 - t)` EXISTS_TAC;
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  TYPE_THEN `&1 - (SND p)` EXISTS_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let mk_line_hyper2_e2 = prove_by_refinement(
+  `!z. mk_line (point (&0, z)) (point(&1, z)) = hyperplane 2 e2 z`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM line2D_S;e2;mk_line;];
+  GEN_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[point_scale;point_add];
+  GEN_TAC;
+  REDUCE_TAC;
+  TYPE_THEN `!t. t * z + (&1 - t) * z = z` SUBGOAL_TAC;
+  GEN_TAC;
+  real_poly_tac;
+  DISCH_THEN_REWRITE;
+  EQ_TAC;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  TYPE_THEN `( &1 - t, z)` EXISTS_TAC;
+  REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  TYPE_THEN `&1 - (FST  p)` EXISTS_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let hv_finite_hyper = prove_by_refinement(
+  `!C.
+  (?v. C SUBSET (hyperplane 2 e2 (v 1) UNION hyperplane 2 e1 (v 0))) ==>
+   (hv_finite C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[hv_finite];
+  TYPE_THEN `{(hyperplane 2 e2 (v 1)), (hyperplane 2 e1 (v 0))}` EXISTS_TAC ;
+  ASM_REWRITE_TAC[UNIONS_2;FINITE_INSERT;FINITE_SING;FINITE_RULES; ];
+  REWRITE_TAC[hv_line;in_pair;GSYM mk_line_hyper2_e2;GSYM mk_line_hyper2_e1];
+  GEN_TAC;
+  REP_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(v 0, &0)` EXISTS_TAC;
+  TYPE_THEN `(v 0, &1)` EXISTS_TAC;
+  REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(&0, v 1)` EXISTS_TAC;
+  TYPE_THEN `(&1, v 1)` EXISTS_TAC;
+  REWRITE_TAC[];
+  ]);;
+
+   (* }}} *)
+
+let graph_hv_finite_radius = jordan_def
+  `graph_hv_finite_radius G r <=> (good_plane_graph G /\
+      (&0 < r) /\
+      (!v v'.
+         graph_vertex G v /\ graph_vertex G v' /\ ~(v = v')
+         ==> (closed_ball (euclid 2,d_euclid) v r INTER
+                closed_ball (euclid 2,d_euclid) v' r =
+                {})) /\
+      (!e v.
+         graph_edge G e /\ graph_vertex G v /\ ~graph_inc G e v
+         ==> (e INTER closed_ball (euclid 2,d_euclid) v r = {})) /\
+      (!e v.
+         graph_edge G e /\  graph_inc G e v
+         ==> (hv_finite (e INTER closed_ball (euclid 2, d_euclid) v r))))
+    `;;
+
+let p_conn_hv_finite = prove_by_refinement(
+  `!A x y. ~(x = y) ==>
+     (p_conn A x y <=> (?C. (hv_finite C) /\ (C SUBSET A) /\
+    (simple_arc_end C x y)))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[p_conn;simple_polygonal_arc];
+  (* - *)
+  EQ_TAC;
+  REP_BASIC_TAC;
+  TH_INTRO_TAC [`C`;`x`;`y`] simple_arc_end_select;
+  ASM_REWRITE_TAC[top2];
+  REP_BASIC_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  REWRITE_TAC[hv_finite];
+  CONJ_TAC;
+  TYPE_THEN `E` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[hv_finite]);
+  REP_BASIC_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  CONJ_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[GSYM top2];
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
+  ]);;
+
+  (* }}} *)
+
+
+let graph_iso_around = prove_by_refinement(
+  `!(G:(A,B)graph_t) (H:(A',B')graph_t) f v. (graph G) /\
+     graph_iso f G H /\ (graph_vertex G v) ==>
+        (graph_edge_around H (FST  f v) =
+            (IMAGE (SND f) (graph_edge_around G v)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_iso;graph_edge_around];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REP_BASIC_TAC;
+  REWRITE_TAC[];
+  EQ_TAC ;
+  REP_BASIC_TAC;
+  TYPE_THEN `(?y. graph_edge G y /\ (v' y = x))` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  USE 8 GSYM;
+  UND 8;
+  DISCH_THEN_FULL_REWRITE;
+  TSPEC `y` 1;
+  REWR 1;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `y` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWR 6;
+  USE 6 (REWRITE_RULE[IMAGE]);
+  REP_BASIC_TAC;
+  TYPE_THEN `v = x'` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TH_INTRO_TAC [`G`;`y`] graph_inc_subset;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_THEN IMATCH_MP_TAC  ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE];
+  REP_BASIC_TAC;
+  REWR 6;
+  UND 6;
+  DISCH_THEN_FULL_REWRITE;
+  SUBCONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ASM_SIMP_TAC[];
+  REWRITE_TAC[IMAGE];
+  REP_BASIC_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Sat Aug 21 16:49:58 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let graph_radius_exists = prove_by_refinement(
+  `!G. planar_graph (G:(A,B) graph_t) /\
+      FINITE (graph_edge G) /\ FINITE (graph_vertex G) /\
+      ~(graph_edge G = EMPTY) /\
+     (!v. (CARD (graph_edge_around G v) <=| 4)) ==>
+   (?r H.
+       (graph_isomorphic G H /\ graph_hv_finite_radius H r))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[planar_graph]);
+  REP_BASIC_TAC;
+  TYPE_THEN `FINITE (graph_edge H) /\ FINITE (graph_vertex H) /\ ~(graph_edge H = EMPTY) /\  (!v. (CARD (graph_edge_around H v) <=| 4))` SUBGOAL_TAC;
+  WITH 4 (REWRITE_RULE[graph_isomorphic]);
+  REP_BASIC_TAC;
+  SUBCONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]);
+  REP_BASIC_TAC;
+  TH_INTRO_TAC [`graph_edge H`;`graph_edge G`;`v`] FINITE_BIJ2;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  (* -- *)
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]);
+  REP_BASIC_TAC;
+  TH_INTRO_TAC [`graph_vertex H`;`graph_vertex G`;`u`] FINITE_BIJ2;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  CONJ_TAC;
+  REWRITE_TAC[EMPTY_EXISTS];
+  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
+  REP_BASIC_TAC;
+   RULE_ASSUM_TAC (REWRITE_RULE[graph_iso;BIJ;SURJ]);
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  GEN_TAC;
+  (* -- *)
+  TYPE_THEN `graph_vertex H v` ASM_CASES_TAC;
+  TH_INTRO_TAC [`H`;`G`;`f`;`v`] graph_iso_around;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_iso]);
+  REP_BASIC_TAC;
+  UND 12;
+  DISCH_THEN_FULL_REWRITE;
+  TSPEC `u v` 0;
+  REWR 0;
+  TH_INTRO_TAC [`v'`;`graph_edge_around H v`] CARD_IMAGE_INJ;
+  REWRITE_TAC[];
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ;BIJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_around]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `graph_edge H` EXISTS_TAC ;
+  ASM_REWRITE_TAC[SUBSET;graph_edge_around];
+  MESON_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  TH_INTRO_TAC [`H`;`v`] graph_edge_around_empty;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[CARD_CLAUSES];
+  ARITH_TAC;
+  REP_BASIC_TAC;
+  (* - *)
+  TH_INTRO_TAC [`H`] graph_disk_hv;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  TYPE_THEN `H'` EXISTS_TAC;
+  REWRITE_TAC[graph_hv_finite_radius];
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TH_INTRO_TAC [`G`;`H`;`H'`] graph_isomorphic_trans;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  graph_isomorphic_symm;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  (* - *)
+  REP_BASIC_TAC;
+  TYPEL_THEN [`e`;`v`] (USE 10 o ISPECL);
+  REWR 10;
+  IMATCH_MP_TAC  hv_finite_hyper;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Sat Aug 21 17:28:09 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let replace = jordan_def `replace (x:A) y =
+    (\ z. (if (z  = x) then y else z))`;;
+
+let replace_x = prove_by_refinement(
+  `!(x:A) y. replace x y x = y`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[replace];
+  (* Sun Aug 22 09:01:27 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let graph_replace = jordan_def
+   `graph_replace (G:(A,B)graph_t) e e' =
+     graph_edge_mod G (replace e e')`;;
+
+let replace_inj = prove_by_refinement(
+  `!(x:A) y Z. ~(Z y) ==> INJ (replace x y) Z UNIV`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ;replace];
+  REP_BASIC_TAC;
+  MP_TAC (TAUT  `((x' = (x:A)) \/ ~(x' = x)) /\ ((y' = x) \/ ~(y' = x))`);
+  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
+  REP_CASES_TAC THEN (REWR 0);
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let graph_replace_iso = prove_by_refinement(
+  `!(G:(A,B)graph_t) e e'.
+      ~(graph_edge G e') ==> graph_isomorphic G (graph_replace G e e')`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_replace];
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  graph_edge_iso;
+  IMATCH_MP_TAC  replace_inj;
+  ASM_REWRITE_TAC[];
+  (* Sun Aug 22 09:30:14 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let graph_replace_plane = prove_by_refinement(
+  `!G e e'. plane_graph G /\ ~(graph_edge G e') /\
+      (graph_edge G e) /\
+      (!e''. graph_edge G e'' /\ ~(e'' = e) ==>
+           (e' INTER e'' SUBSET  e INTER e'')) /\
+      (simple_arc top2 e') /\
+      (e INTER graph_vertex G = e' INTER graph_vertex G) ==>
+      plane_graph (graph_replace G e e')`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[graph_replace];
+  IMATCH_MP_TAC  plane_graph_mod;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  replace_inj;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[replace];
+  TYPE_THEN `((e'' = e) \/ ~(e'' = e)) /\ ((e''' = e) \/ ~(e''' = e))` (fun t-> MP_TAC (TAUT t));
+  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
+  REP_CASES_TAC THEN (FIRST_ASSUM (fun t-> REWRITE_TAC[t] THEN (RULE_ASSUM_TAC (REWRITE_RULE[t])) THEN (ASSUME_TAC t)));
+  ASM_MESON_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC [INTER_COMM];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET_REFL];
+  (* - *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[replace];
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph;SUBSET ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  REP_BASIC_TAC;
+  REWRITE_TAC[replace];
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[];
+  (* Sun Aug 22 10:28:15 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let good_replace = prove_by_refinement(
+  `!G e e'. (good_plane_graph G) /\ plane_graph (graph_replace G e e') /\
+      ~(graph_edge G e') /\
+   ( e INTER (graph_vertex G) = e' INTER (graph_vertex G)) /\
+      (!v v'. (graph_vertex G v) /\ (graph_vertex G v') /\
+            ~(v = v') /\ e' v /\  e' v' ==> simple_arc_end e' v v')
+    ==> (good_plane_graph (graph_replace G e e'))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[good_plane_graph;graph_replace];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_edge_mod_e;graph_edge_mod_i ;IMAGE ]);
+  REP_BASIC_TAC;
+  UND 6;
+  DISCH_THEN_FULL_REWRITE;
+  TH_INTRO_TAC [`e`;`e'`;`graph_edge G`] replace_inj;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `e'''' = x` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `e''' = x` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  (* - *)
+  REWRITE_TAC[replace];
+  COND_CASES_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UNDF `x`;
+  DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc G e = e INTER graph_vertex G` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  UNDF `e INTER u = e' INTER u`;
+  DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[INTER;]);
+  ASM_REWRITE_TAC[];
+  (* - *)
+  KILL 0;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* Sun Aug 22 10:59:34 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let graph_replace_hv_finite_radius = prove_by_refinement(
+  `!G r e e'. graph_hv_finite_radius G r /\ ~(graph_edge G e') /\
+     good_plane_graph (graph_replace G e e') /\
+    (e INTER (graph_vertex G) = e' INTER (graph_vertex G)) /\
+    (!v. graph_vertex G v /\ ~(e' v) ==>
+        ((e' INTER closed_ball (euclid 2,d_euclid) v r = {}))) /\
+    (hv_finite e')
+    ==> graph_hv_finite_radius (graph_replace G e e') r`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_hv_finite_radius];
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  UND 7;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_replace ;graph_edge_mod_v]);
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_replace;graph_edge_mod_v;IMAGE;graph_edge_mod_i;graph_edge_mod_e]);
+  REP_BASIC_TAC;
+  UNDF `e''`;
+  DISCH_THEN_FULL_REWRITE;
+  REWRITE_TAC[replace];
+  COND_CASES_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWR 13;
+  DISCH_TAC;
+  LEFT 10 "e'''";
+  TSPEC `e` 10;
+  UND 10;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc G e = e INTER graph_vertex G` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[INTER];
+  KILL 1;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  LEFT 10 "e'''";
+  TSPEC `x` 1;
+  REWR 1;
+  (* - *)
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[graph_replace;graph_edge_mod_v;IMAGE;graph_edge_mod_i;graph_edge_mod_e]);
+  REP_BASIC_TAC;
+  UNDF `e''`;
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `e''' = x` SUBGOAL_TAC;
+  TH_INTRO_TAC [`e`;`e'`;`graph_edge G`] replace_inj;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INJ];
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  (* - *)
+  REWRITE_TAC[replace];
+  COND_CASES_TAC ;
+  UNDF `x`;
+  DISCH_THEN_FULL_REWRITE;
+  IMATCH_MP_TAC  hv_finite_subset;
+  TYPE_THEN `e'` EXISTS_TAC;
+  ASM_REWRITE_TAC[INTER;SUBSET;];
+  MESON_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* Sun Aug 22 12:09:03 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let card_suc_insert = prove_by_refinement(
+  `!(x:A) s. FINITE s /\ (~(s x)) ==> (SUC (CARD s) = CARD(x INSERT s))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC [CARD_CLAUSES];
+  ]);;
+  (* }}} *)
+
+let graph_replace_card = prove_by_refinement(
+  `!G e e'.
+    (FINITE (graph_edge (G:(A,(num->real)->bool)graph_t))) /\
+      (graph_edge G e) /\ ~(graph_edge G e') /\
+     ~(hv_finite e) /\ (hv_finite e') ==>
+   (CARD {x | graph_edge (graph_replace G e e') x /\ ~(hv_finite x)} <
+      CARD{ x | graph_edge G x /\ ~hv_finite x})
+                                                `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `(SUC x = y) ==> (x <| y)`);
+  (* - *)
+  TYPE_THEN `FINITE (graph_edge (graph_replace G e e'))` SUBGOAL_TAC;
+  REWRITE_TAC[graph_edge_mod_e;graph_replace];
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `A = {x | graph_edge (graph_replace G e e') x /\ ~hv_finite x}` ABBREV_TAC ;
+  TYPE_THEN `FINITE A` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `graph_edge (graph_replace G e e')` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "A";
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `~A e` SUBGOAL_TAC;
+  EXPAND_TAC"A";
+  REWRITE_TAC[];
+  ASM_REWRITE_TAC[graph_replace;graph_edge_mod_e;IMAGE];
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[replace]);
+  UND 8;
+  COND_CASES_TAC;
+  ASM_MESON_TAC[];
+  UND 8;
+  REWRITE_TAC[];
+  MESON_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `SUC (CARD A) = CARD(e INSERT A)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  card_suc_insert;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  (* - *)
+  AP_TERM_TAC;
+  EXPAND_TAC "A";
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[INSERT;graph_replace;graph_edge_mod_e;IMAGE;replace; ];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  REP_BASIC_TAC;
+  UNDF `x = u`;
+  DISCH_THEN_FULL_REWRITE;
+  COND_CASES_TAC;
+  UNDF `x' = e`;
+  DISCH_THEN_FULL_REWRITE;
+  ASM_MESON_TAC[];
+  REWR 10;
+  UNDF `x = e`;
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  REP_BASIC_TAC;
+  TYPE_THEN `x = e` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let graph_edge_end_select_other = prove_by_refinement(
+  `!(G:(A,B)graph_t) e v. (graph G /\ graph_edge G e /\
+         (graph_inc G e v) ==>
+    (?v'. (graph_inc G e v' /\ ~(v = v'))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TH_INTRO_TAC [`G`;`e`] graph_edge_end_select;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
+  IMATCH_MP_TAC  graph_edge2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[has_size2];
+  REP_BASIC_TAC;
+  UND 7;
+  DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[in_pair]);
+  REWRITE_TAC[in_pair];
+  TYPE_THEN `(v'' = b)` ASM_CASES_TAC;
+  UNDF `v''`;
+  DISCH_THEN_FULL_REWRITE;
+  REWR 5;
+  UNDF`v'`;
+  DISCH_THEN_FULL_REWRITE;
+  ASM_MESON_TAC[];
+  REWR 4;
+  UNDF`v''`;
+  DISCH_THEN_FULL_REWRITE;
+  REWR 5;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let graph_rad_pt_select = prove_by_refinement(
+  `!G r e v. graph_hv_finite_radius G r /\ graph_inc G e v  /\
+     graph_edge G e ==>
+     (?C u. (hv_finite C) /\ (simple_arc_end C v u) /\ (euclid 2 u) /\
+        (d_euclid v u = r) /\ (C SUBSET e) /\ (C SUBSET (closed_ball(euclid 2,d_euclid) v r)))   `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_hv_finite_radius];
+  REP_BASIC_TAC;
+  (* - *)
+  TH_INTRO_TAC [`e`;`{v}`;`(euclid 2 DIFF (open_ball(euclid 2,d_euclid) v r))`] simple_arc_end_restriction;
+  (* -- *)
+    CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE [good_plane_graph;plane_graph;SUBSET ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  TH_INTRO_TAC[`G`;`e`;`v`] graph_edge_end_select_other;
+  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* -- *)
+  CONJ_TAC;
+  RULE_ASSUM_TAC  (REWRITE_RULE[good_plane_graph;plane_graph]);
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC simple_arc_end_end_closed;
+  TYPE_THEN `e` EXISTS_TAC;
+  TYPE_THEN `v'` EXISTS_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  TH_INTRO_TAC [`top2`;`open_ball(euclid 2,d_euclid) v r`] open_closed;
+  REWRITE_TAC[top2_top];
+  ASM_SIMP_TAC [top2;open_ball_open;metric_euclid;open_DEF ];
+  REWRITE_TAC[top2_unions];
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[INTER;DIFF;EQ_EMPTY;open_ball;INR IN_SING ];
+  REP_BASIC_TAC;
+  UNDF  `x = v`;
+  DISCH_THEN_FULL_REWRITE;
+  UNDF `x < r`;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_zero;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[metric_euclid];
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `v` EXISTS_TAC;
+  REWRITE_TAC[INTER;INR IN_SING];
+  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
+  REP_BASIC_TAC;
+  UNDF `graph_inc G e = y`;
+  DISCH_THEN (TH_INTRO_TAC [`e`]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `v'` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
+  REP_BASIC_TAC;
+  UNDF `graph_inc G e = y`;
+  DISCH_THEN (TH_INTRO_TAC [`e`]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  REWRITE_TAC[DIFF];
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TH_INTRO_TAC [`G`;`e`] graph_inc_subset;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[open_ball;DE_MORGAN_THM ];
+  DISJ2_TAC;
+  DISJ2_TAC;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!v. graph_inc G e v ==> graph_vertex G v` SUBGOAL_TAC;
+  TH_INTRO_TAC [`G`;`e`] graph_inc_subset;
+  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `!v. graph_inc G e v ==> euclid 2 v` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  UND 4;
+  DISCH_THEN (  TH_INTRO_TAC [`v`;`v'`] );
+  ASM_MESON_TAC [];
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  TYPE_THEN `v` EXISTS_TAC;
+  REWRITE_TAC[closed_ball];
+  TYPE_THEN `euclid 2 v` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `euclid 2 v'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `d_euclid v v = &0` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_zero;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_MESON_TAC[metric_euclid];
+  DISCH_THEN_REWRITE;
+  UND 5;
+  UND 9;
+  TYPE_THEN `d_euclid v v' = d_euclid v' v` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_symm;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_MESON_TAC[metric_euclid];
+  DISCH_THEN_REWRITE;
+  REAL_ARITH_TAC;
+  (* A- *)
+  REP_BASIC_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `v''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `v' = v` SUBGOAL_TAC;
+  UND 8;
+  REWRITE_TAC[INTER;eq_sing;INR IN_SING ];
+  MESON_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `euclid 2 v''` SUBGOAL_TAC;
+  FIRST_ASSUM MP_TAC;
+  REWRITE_TAC[INTER;DIFF;eq_sing;];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `d_euclid v v'' = r` SUBGOAL_TAC;
+  IMATCH_MP_TAC  disk_endpoint_outer;
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  TH_INTRO_TAC [`C'`] simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_THEN IMATCH_MP_TAC ;
+  UND 9;
+  MESON_TAC[simple_arc_end_end];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  (* B- *)
+  TYPE_THEN `C' SUBSET closed_ball(euclid 2,d_euclid) v r` SUBGOAL_TAC;
+  UND 7;
+  REWRITE_TAC[SUBSET;closed_ball;INTER;open_ball;DIFF;eq_sing;INR IN_SING];
+  REP_BASIC_TAC;
+  TYPE_THEN `!x. C' x ==> euclid 2 x` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TH_INTRO_TAC[`C'`] simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `C' v` SUBGOAL_TAC;
+  UND 8;
+  REWRITE_TAC[INTER;INR IN_SING;eq_sing;];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `x = v''` ASM_CASES_TAC;
+  UNDF `x = v''`;
+  DISCH_THEN_FULL_REWRITE;
+  UND 12;
+  REAL_ARITH_TAC;
+  TSPEC `x` 13;
+  PROOF_BY_CONTR_TAC;
+  UND 19;
+  REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[DE_MORGAN_THM];
+  DISJ2_TAC;
+  UND 20;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  hv_finite_subset;
+  TYPE_THEN `e INTER (closed_ball(euclid 2,d_euclid) v r)` EXISTS_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET_INTER];
+  ASM_REWRITE_TAC[];
+  (* Sun Aug 22 15:50:58 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+(* not needed here *)
+let top_union = prove_by_refinement(
+  `!A B U. topology_ U /\ U A /\ U (B:A->bool) ==> U(A UNION B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[GSYM UNIONS_2];
+  IMATCH_MP_TAC  top_unions;
+  ASM_REWRITE_TAC[in_pair; SUBSET;];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let top_closed_unions = prove_by_refinement(
+  `!(B:(A->bool)->bool) U.
+     topology_ U /\ FINITE B /\ B SUBSET (closed_ U) ==>
+            closed_ U(UNIONS B)`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `!n (B:(A->bool)->bool) U. (CARD B = n) /\  topology_ U /\ FINITE B /\ B SUBSET (closed_ U) ==> closed_ U(UNIONS B)` SUBGOAL_TAC;
+  INDUCT_TAC;
+  REP_BASIC_TAC;
+  TYPE_THEN `B HAS_SIZE 0` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[HAS_SIZE];
+  REWRITE_TAC[HAS_SIZE_0];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  empty_closed;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* -- *)
+  TYPE_THEN `~(B = EMPTY)` SUBGOAL_TAC;
+  DISCH_TAC;
+  UNDF `EMPTY`;
+  DISCH_THEN_FULL_REWRITE;
+  UNDF `SUC`;
+  REWRITE_TAC[CARD_CLAUSES];
+  ARITH_TAC;
+  DISCH_TAC;
+  (* -- *)
+  TH_INTRO_TAC [`B`] CARD_DELETE_CHOICE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  USEF `SUC` SYM;
+  REWR 4;
+  RULE_ASSUM_TAC (REWRITE_RULE[SUC_INJ]);
+  TYPEL_THEN [`(B DELETE CHOICE B)`;`U`] (USE 0 o ISPECL);
+  UNDF `n`;
+  DISCH_THEN (TH_INTRO_TAC []);
+  ASM_REWRITE_TAC[FINITE_DELETE];
+  UNDF `(SUBSET)`;
+  REWRITE_TAC[SUBSET;DELETE];
+  MESON_TAC[];
+  (* -- *)
+  DISCH_TAC;
+  TYPE_THEN `closed_ U( UNIONS (B DELETE CHOICE B) UNION (CHOICE B))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  closed_union;
+  ASM_REWRITE_TAC[];
+  UND 1;
+  REWRITE_TAC[SUBSET];
+  USEF `(~)` (MATCH_MP CHOICE_DEF);
+  UNDF  `(IN)`;
+  REWRITE_TAC[];
+  MESON_TAC[];
+  ASM_MESON_TAC[unions_delete_choice];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let euclid2_d0 = prove_by_refinement(
+  `!x. (euclid 2 x) ==> (d_euclid x x = &0)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  metric_space_zero;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[metric_euclid];
+  ]);;
+  (* }}} *)
+
+let union_imp_subset = prove_by_refinement(
+  `!(Z1:A->bool) Z2 A. (Z1 UNION Z2 = A) ==>
+         (Z1 SUBSET A /\ Z2 SUBSET A)`,
+  (* {{{ proof *)
+  [
+  SET_TAC[UNION;SUBSET];
+  ]);;
+  (* }}} *)
+
+let loc_path_conn_top2 = prove_by_refinement(
+  `loc_path_conn top2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  loc_path_conn_euclid;
+  TYPE_THEN `2` EXISTS_TAC;
+  MESON_TAC[metric_euclid;top_of_metric_top;top_of_metric_unions;top_univ];
+  ]);;
+  (* }}} *)
+
+let connected_empty = prove_by_refinement(
+  `!U. connected (U:(A->bool)->bool) EMPTY `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[connected];
+  ]);;
+  (* }}} *)
+
+let component_imp_connected = prove_by_refinement(
+  `!U (x:A). (topology_ U) ==> (connected U (component U x))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `~(UNIONS U x)` ASM_CASES_TAC;
+  UND 1;
+  ASM_SIMP_TAC[GSYM component_empty];
+  REWRITE_TAC[connected_empty];
+  REWR 1;
+  (* - *)
+  REWRITE_TAC[connected];
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;connected;component];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `component U x x` SUBGOAL_TAC;
+  ASM_MESON_TAC[component_refl];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `A x \/ B x` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET;UNION]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!A B. component U x SUBSET A UNION B /\ (A INTER B = EMPTY) /\ U B /\ U A /\ A x ==> component U x SUBSET A` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `B' x'` SUBGOAL_TAC;
+  USE 11 (REWRITE_RULE[SUBSET;UNION]);
+  TSPEC `x'` 11;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  USE 12 (REWRITE_RULE[component]);
+  REP_BASIC_TAC;
+  TYPE_THEN `Z SUBSET (component U x)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  connected_component;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  USE 16 (REWRITE_RULE[connected]);
+  REP_BASIC_TAC;
+  TYPEL_THEN[`A'`;`B'`] (USE 16 o ISPECL);
+  UND 16;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Z SUBSET A' UNION B'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `component U x` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  REWRITE_TAC[DE_MORGAN_THM];
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  USE 10 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* - *)
+  DISCH_THEN DISJ_CASES_TAC;
+  TYPEL_THEN[`A`;`B`] (USE 7 o ISPECL);
+  ASM_MESON_TAC[];
+  TYPEL_THEN [`B`;`A`] (USE 7 o ISPECL);
+  REWR 7;
+  DISJ2_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ONCE_REWRITE_TAC[INTER_COMM];
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[UNION_COMM];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let open_induced = prove_by_refinement(
+  `!U (A:A->bool). (topology_ U) /\ U A ==>
+          (induced_top U A = { B | U B /\ B SUBSET A })`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[induced_top;IMAGE;];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[];
+  GEN_TAC;
+  EQ_TAC;
+  REP_BASIC_TAC;
+  FIRST_ASSUM MP_TAC ;
+  DISCH_THEN_FULL_REWRITE;
+  CONJ_TAC;
+  IMATCH_MP_TAC  top_inter;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INTER;SUBSET];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 2;
+  SET_TAC [INTER;SUBSET];
+  ]);;
+  (* }}} *)
+
+let connected_induced = prove_by_refinement(
+  `!U (C:A->bool) . (topology_ U /\ U C ) ==>
+           (connected U C = connected (induced_top U C) C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[connected];
+  ASM_SIMP_TAC[open_induced];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  sub_union;
+  ASM_REWRITE_TAC[SUBSET_REFL ];
+  REP_BASIC_TAC;
+  TYPEL_THEN [`A`;`B`] (USE 2 o ISPECL);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `UNIONS {B | U B /\ B SUBSET C}` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  UNIONS_UNIONS;
+  ONCE_REWRITE_TAC[SUBSET];
+  REWRITE_TAC[];
+  MESON_TAC[];
+  (* - *)
+  REP_BASIC_TAC;
+  TYPEL_THEN[`A INTER C`;`B INTER C`] (USE 2 o ISPECL);
+  REWR 2;
+  UND 2;
+  DISCH_THEN  (TH_INTRO_TAC []);
+  TYPE_THEN `!A'. (U A' ==> U (A' INTER C))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC top_inter;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWRITE_TAC[GSYM CONJ_ASSOC];
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[INTER_SUBSET];
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  UND 5;
+  SET_TAC[INTER];
+  UND 4;
+  SET_TAC[SUBSET;UNION;INTER];
+  SET_TAC[INTER;SUBSET];
+  ]);;
+  (* }}} *)
+
+let connected_induced2 = prove_by_refinement(
+  `!U (C:A->bool) Z. (topology_ U /\ U C /\ Z SUBSET (UNIONS U))  ==>
+        (connected (induced_top U C) Z <=> (Z SUBSET C) /\ (connected U Z))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[connected];
+  ASM_SIMP_TAC[open_induced];
+  EQ_TAC;
+  REP_BASIC_TAC;
+  SUBCONJ_TAC;
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  USE 4(REWRITE_RULE[SUBSET;UNIONS]);
+  TSPEC `x` 4;
+  REWR 4;
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  TYPEL_THEN [`A INTER C`;`B INTER C`] (USE 3 o ISPECL);
+  REWR 3;
+  UND 3;
+  DISCH_THEN  (TH_INTRO_TAC []);
+  TYPE_THEN `!A'. (U A' ==> U (A' INTER C))` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC top_inter;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWRITE_TAC[GSYM CONJ_ASSOC];
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[INTER_SUBSET];
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  UND 7;
+  SET_TAC[INTER];
+  UND 6;
+  UND 5;
+  SET_TAC[INTER;SUBSET;UNION];
+  UND 5;
+  SET_TAC[INTER;SUBSET;UNION];
+  REP_BASIC_TAC;
+  (* - *)
+  CONJ_TAC;
+  UND 0;
+  REWRITE_TAC[SUBSET;UNIONS];
+  REP_BASIC_TAC;
+  TSPEC `x` 5;
+  REWR 5;
+  REP_BASIC_TAC;
+  TYPE_THEN `u INTER C` EXISTS_TAC;
+  REWRITE_TAC[GSYM CONJ_ASSOC];
+  CONJ_TAC;
+  IMATCH_MP_TAC  top_inter;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INTER];
+  ASM_MESON_TAC[ISUBSET ];
+  (* - *)
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let connected_metric = prove_by_refinement(
+  `!X d (C:A->bool). metric_space (X,d) /\ C SUBSET X /\
+    (top_of_metric(X,d)C) ==>
+     (connected(top_of_metric(X,d))C <=> connected(top_of_metric(C,d))C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `top_of_metric(C,d) = induced_top(top_of_metric(X,d))C` SUBGOAL_TAC;
+  ASM_MESON_TAC[top_of_metric_induced];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  connected_induced;
+  ASM_MESON_TAC[top_of_metric_top];
+  ]);;
+  (* }}} *)
+
+let connected_metric_pair = prove_by_refinement(
+  `!(X:A->bool) Y Z d. metric_space (X,d) /\
+     top_of_metric(X,d) Y /\ top_of_metric(X,d) Z /\
+       Z SUBSET Y  ==>
+   (connected (top_of_metric(X,d)) Z = connected (top_of_metric(Y,d)) Z)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  (* - *)
+  TYPE_THEN `Y SUBSET X` SUBGOAL_TAC;
+  USE 2(MATCH_MP sub_union);
+  UND 2;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `Z SUBSET X` SUBGOAL_TAC ;
+  ASM_MESON_TAC[SUBSET_TRANS];
+  DISCH_TAC;
+  ASM_SIMP_TAC[connected_metric];
+  (* - *)
+  TYPE_THEN `metric_space (Y,d)` SUBGOAL_TAC;
+  ASM_MESON_TAC[metric_subspace];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `top_of_metric(Y,d)  = induced_top(top_of_metric(X,d)) Y` SUBGOAL_TAC;
+  ASM_MESON_TAC[top_of_metric_induced];
+  DISCH_TAC;
+  TYPE_THEN `top_of_metric(Y,d) Z` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[open_induced;top_of_metric_top];
+  DISCH_TAC;
+  ASM_SIMP_TAC[connected_metric];
+  ]);;
+  (* }}} *)
+
+let construct_hv_finite = prove_by_refinement(
+  `!A C v v'. (top2 A) /\ (C SUBSET A) /\ (simple_arc_end C v v') ==>
+    (?C'. C' SUBSET A /\ simple_arc_end C' v v' /\ hv_finite C')`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `A' = path_component(top_of_metric(A,d_euclid)) v` ABBREV_TAC ;
+  TYPE_THEN `A' = component (top_of_metric(A,d_euclid)) v` SUBGOAL_TAC;
+  EXPAND_TAC "A'";
+  AP_THM_TAC;
+  IMATCH_MP_TAC  loc_path_euclid_cor ;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_REWRITE_TAC[GSYM top2];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `A SUBSET (euclid 2)` SUBGOAL_TAC;
+  USEF `top2`  (MATCH_MP sub_union );
+  RULE_ASSUM_TAC (REWRITE_RULE[top2_unions]);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN`UNIONS (top_of_metric(A,d_euclid)) = A` SUBGOAL_TAC;
+  ASM_MESON_TAC [GSYM top_of_metric_unions;metric_euclid;metric_subspace];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `A' SUBSET (UNIONS (top_of_metric(A,d_euclid)))` SUBGOAL_TAC;
+  ASM_MESON_TAC[component_unions];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `A' SUBSET (euclid 2)`  SUBGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `A` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  ASSUME_TAC  loc_path_conn_top2 ;
+  (* - *)
+  TYPE_THEN `A v` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
+  UND 1;
+  DISCH_THEN IMATCH_MP_TAC ;
+  UND 0;
+  MESON_TAC[simple_arc_end_end];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `top_of_metric(A,d_euclid) = induced_top top2 A` SUBGOAL_TAC;
+  REWRITE_TAC[top2];
+  UND 5;
+  SIMP_TAC [metric_euclid;top_of_metric_induced ];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `top2 A'` SUBGOAL_TAC;
+  EXPAND_TAC "A'";
+  UND 11;
+  DISCH_THEN_REWRITE;
+  USE 9 (REWRITE_RULE[ loc_path_conn]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `~(v  = v')` SUBGOAL_TAC;
+  UND 0;
+  ASM_MESON_TAC[simple_arc_end_distinct];
+  DISCH_TAC;
+  (* A' - *)
+  TYPE_THEN `connected (top_of_metric(A,d_euclid)) A'` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  component_imp_connected;
+  ASM_MESON_TAC[top_of_metric_top;metric_subspace;metric_euclid];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) A'` SUBGOAL_TAC;
+  TH_INTRO_TAC [`euclid 2`;`A`;`A'`;`d_euclid`] connected_metric_pair;
+  ASM_MESON_TAC [metric_euclid;GSYM top2];
+  DISCH_THEN_REWRITE;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[GSYM top2];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `connected top2 C` SUBGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_connected;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `C SUBSET A'` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  connected_component;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\a`);
+  CONJ_TAC;
+  UND 0;
+  MESON_TAC[simple_arc_end_end];
+  TH_INTRO_TAC[`top2`;`A`;`C`] connected_induced2;
+  REWRITE_TAC[top2_top;top2_unions];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[SUBSET_TRANS];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `C v /\ C v'` SUBGOAL_TAC;
+  UND 0;
+  MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
+  DISCH_TAC;
+  TYPE_THEN `A' v /\ A' v'` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  (* - *)
+  TH_INTRO_TAC[`A'`;`v`;`v'`] p_conn_conn;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TH_INTRO_TAC[`A'`;`v`;`v'`] p_conn_hv_finite;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  REP_BASIC_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `A'` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let graph_rad_pt_center_piece = prove_by_refinement(
+  `!G r e v v'.
+     graph_hv_finite_radius G r /\ graph_inc G e v /\
+     FINITE(graph_edge G) /\ FINITE(graph_vertex G) /\
+    graph_edge G e /\ graph_inc G e v' /\ ~(v = v') ==>
+   (? Cv u Cv' u' C''.
+        (hv_finite Cv /\ hv_finite Cv' /\  (hv_finite C'') /\
+        ~(graph_vertex G u) /\
+        ~(graph_vertex G u') /\
+        simple_arc_end Cv v u /\
+        simple_arc_end Cv' v' u' /\
+        simple_arc_end C'' u u' /\
+         ~C'' v /\ ~C'' v' /\
+        (euclid 2 u)  /\ (euclid 2 u') /\
+        (d_euclid v u = r) /\ (d_euclid v' u' = r) /\
+        (Cv SUBSET e) /\ (Cv' SUBSET e) /\
+        (Cv SUBSET  (closed_ball(euclid 2,d_euclid) v r)) /\
+        (Cv' SUBSET (closed_ball(euclid 2,d_euclid) v' r)) /\
+   (!e'. (graph_edge G e') /\ ~(e = e') ==> (C'' INTER e' = EMPTY)) /\
+   (!v''. graph_vertex G v'' /\ ~(graph_inc G e v'') ==>
+        (C'' INTER (closed_ball(euclid 2,d_euclid) v'' r) = EMPTY))
+     ))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TH_INTRO_TAC [`G`;`r`;`e`;`v`] graph_rad_pt_select;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `Cv = C` ABBREV_TAC ;
+  KILL 13;
+  TYPE_THEN `Cv` EXISTS_TAC;
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TH_INTRO_TAC [`G`;`r`;`e`;`v'`] graph_rad_pt_select;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `Cv' = C'` ABBREV_TAC ;
+  KILL 19;
+  TYPE_THEN `Cv'` EXISTS_TAC;
+  TYPE_THEN `u'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* A' *)
+  TYPE_THEN `!v''. graph_vertex G v'' ==> (euclid 2 v'')` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;SUBSET ]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `!v''. graph_inc G e v'' ==> graph_vertex G v''`  SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TH_INTRO_TAC [`G`;`e`] graph_inc_subset;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;]);
+  ASM_REWRITE_TAC[SUBSET ];
+  FIRST_ASSUM MP_TAC;
+  MESON_TAC[ISUBSET];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `D = (\ v. (closed_ball(euclid 2,d_euclid) v r))` ABBREV_TAC ;
+  TYPE_THEN `B  = (UNIONS { e' | graph_edge G e' /\ ~(e' = e)})` ABBREV_TAC ;
+  TYPE_THEN `B' = (UNIONS { DD | ?v''. (graph_vertex G v'' /\ (DD = D v'') /\ ~(graph_inc G e v''))})` ABBREV_TAC ;
+  TYPE_THEN `B'' = {v, v'}` ABBREV_TAC ;
+  TYPE_THEN `A = (euclid 2 DIFF (B UNION B' UNION B''))` ABBREV_TAC ;
+  TYPE_THEN `top2 A` SUBGOAL_TAC;
+  TH_INTRO_TAC [`top2`;`B UNION B' UNION B''`] closed_open;
+  IMATCH_MP_TAC  closed_union;
+  REWRITE_TAC[top2_top];
+  EXPAND_TAC "B";
+  EXPAND_TAC "B'";
+  EXPAND_TAC "B''";
+  CONJ_TAC;
+  IMATCH_MP_TAC  top_closed_unions;
+  REWRITE_TAC[top2_top;SUBSET;];
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `graph_edge G` EXISTS_TAC ;
+  ASM_REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph;]);
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  simple_arc_end_closed;
+  TH_INTRO_TAC [`G`;`x`] graph_edge_end_select;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  (* --- *)
+  IMATCH_MP_TAC  closed_union;
+  REWRITE_TAC[top2_top];
+  CONJ_TAC;
+  IMATCH_MP_TAC  top_closed_unions;
+  REWRITE_TAC[top2_top];
+  CONJ_TAC;
+  TYPE_THEN `{DD | ?v''. graph_vertex G v'' /\ (DD = D v'') /\ ~graph_inc G e v''} = IMAGE D { v'' | graph_vertex G v'' /\ ~graph_inc G e v''}` SUBGOAL_TAC;
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `graph_vertex G` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET ];
+  MESON_TAC[];
+  REWRITE_TAC[SUBSET];
+  REP_BASIC_TAC;
+  UNDF `x = D v''`;
+  DISCH_THEN_FULL_REWRITE;
+  EXPAND_TAC "D";
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  closed_ball_closed;
+  REWRITE_TAC[metric_euclid];
+  (* --- *)
+  TYPE_THEN `{v,v'} = {v} UNION {v'}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[in_pair;UNION;INR IN_SING];
+  MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  IMATCH_MP_TAC  closed_union;
+  REWRITE_TAC[top2_top];
+  TYPE_THEN `graph_inc G e v` (FIND_ASSUM MP_TAC);
+  TYPE_THEN `graph_inc G e v'` (FIND_ASSUM MP_TAC);
+  ASM_MESON_TAC[closed_point];
+  REWRITE_TAC[open_DEF;top2_unions];
+  EXPAND_TAC "A";
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  (* B' *)
+  TYPE_THEN `!u'' v''. graph_vertex G v'' /\ (d_euclid v'' u'' = r) ==> ~(graph_vertex G u'')` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  REP_BASIC_TAC;
+  TYPEL_THEN [`u''`;`v''`] (USE 31 o ISPECL);
+  TYPE_THEN `~(u'' = v'')` SUBGOAL_TAC;
+  DISCH_TAC;
+  POP_ASSUM MP_TAC;
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `d_euclid v'' v'' = &0` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_zero;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[metric_euclid];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  UNDF `&0 = r`;
+  UNDF   `&0 < r`;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  UNDF `(graph_vertex)`;
+  ASM_REWRITE_TAC[EMPTY_EXISTS ;INTER ;closed_ball ;];
+  TYPE_THEN `u''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `d_euclid u'' u'' = &0` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_zero;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  ASM_REWRITE_TAC[metric_euclid];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `euclid 2 u'' ` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `euclid 2 v'' ` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  UNDF `&0 < r`;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* B1'- *)
+  TYPE_THEN `~graph_vertex G u` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~graph_vertex G u'` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `v'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  (* C' *)
+  TYPE_THEN `!(X:A->bool) Y Z. (X UNION Y = Z) ==> (X SUBSET Z)` SUBGOAL_TAC;
+  SET_TAC[UNION;SUBSET];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `simple_arc_end e v v'` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE [graph_hv_finite_radius;good_plane_graph]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `graph_vertex G v` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `graph_vertex G v'` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `~D v u'` SUBGOAL_TAC;
+  EXPAND_TAC "D";
+  PROOF_BY_CONTR_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;]);
+  REP_BASIC_TAC;
+  GRABF `~(v = v')` (TH_INTRO_TAC [`v`;`v'`]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `u'` EXISTS_TAC;
+  ASM_REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[closed_ball];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* C1'- *)
+  TYPE_THEN `~(v = u) /\ ~(v = u')` SUBGOAL_TAC;
+  CONJ_TAC;
+  DISCH_TAC;
+  POP_ASSUM MP_TAC;
+  DISCH_THEN_FULL_REWRITE;
+  TH_INTRO_TAC[`u`] euclid2_d0;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  REP_BASIC_TAC;
+  UNDF `&0 < r`;
+  UNDF `&0 = r`;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  POP_ASSUM MP_TAC;
+  DISCH_THEN_FULL_REWRITE;
+  POP_ASSUM MP_TAC;
+  EXPAND_TAC "D";
+  REWRITE_TAC[closed_ball];
+  ASM_REWRITE_TAC[];
+  TH_INTRO_TAC [`u'`] euclid2_d0;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  REP_BASIC_TAC;
+  UNDF `&0 < r`;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `~(v' = u') ` SUBGOAL_TAC;
+  DISCH_TAC;
+  POP_ASSUM MP_TAC;
+  DISCH_THEN_FULL_REWRITE;
+  TH_INTRO_TAC[`u'`] euclid2_d0;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  REP_BASIC_TAC;
+  UNDF `&0 < r`;
+  UNDF `&0 = r`;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* - *)
+  TH_INTRO_TAC [`e`;`v`;`v'`;`u'`] simple_arc_end_cut;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Cv' u'` SUBGOAL_TAC;
+  TYPE_THEN `simple_arc_end Cv' v' u'` (FIND_ASSUM  MP_TAC );
+  MESON_TAC[simple_arc_end_end2];
+  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `Cvu' = C''` ABBREV_TAC ;
+  POP_ASSUM (fun t-> ALL_TAC);
+  TYPE_THEN `Cu'v' = C'''` ABBREV_TAC ;
+  POP_ASSUM (fun t -> ALL_TAC);
+  TYPE_THEN `Cu'v' v'` SUBGOAL_TAC;
+  TYPE_THEN `simple_arc_end Cu'v' u' v'` (FIND_ASSUM  MP_TAC );
+  MESON_TAC[simple_arc_end_end2];
+  DISCH_TAC;
+  TYPE_THEN `~Cvu' v'` SUBGOAL_TAC;
+  DISCH_TAC;
+  USEF `(INTER)` (REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `v'` 37;
+  RULE_ASSUM_TAC (REWRITE_RULE[INTER;eq_sing ;INR IN_SING]);
+  UND 37;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `~D v' u` SUBGOAL_TAC;
+  EXPAND_TAC "D";
+  DISCH_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;]);
+  REP_BASIC_TAC;
+  GRABF `~(v' = v)` (TH_INTRO_TAC [`v'`;`v`]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[closed_ball];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* D'- *)
+  TYPE_THEN `Cvu' u \/ Cu'v' u` SUBGOAL_TAC;
+  USE 35 (REWRITE_RULE[FUN_EQ_THM;]);
+  TSPEC  `u` 35 ;
+  USE 35 (REWRITE_RULE[UNION]);
+  ASM_REWRITE_TAC[];
+  USE 8(REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 11;
+  MESON_TAC[simple_arc_end_end2];
+  DISCH_TAC;
+  (* - *)
+  USE 35 (MATCH_MP   union_imp_subset);
+  TYPE_THEN `Cu'v' = Cv'` SUBGOAL_TAC;
+  TH_INTRO_TAC [`Cu'v'`;`Cv'`;`e`;`v'`;`u'`] simple_arc_end_inj;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  DISCH_THEN_FULL_REWRITE;
+  (* - *)
+  TYPE_THEN `~Cv' u` SUBGOAL_TAC;
+  DISCH_TAC;
+  UNDF `~D v' u` ;
+  REWRITE_TAC[];
+  EXPAND_TAC "D";
+  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWR 45;
+  (* - *)
+  TYPE_THEN `~(u = u')` SUBGOAL_TAC;
+  DISCH_TAC;
+  UND 47;
+  DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  REP_BASIC_TAC;
+  GRABF `~(v=v')` (TH_INTRO_TAC[`v`;`v'`]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `u'` EXISTS_TAC;
+  REWRITE_TAC[INTER;closed_ball];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_ARITH `r <= r`];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TH_INTRO_TAC[`Cvu'`;`v`;`u'`;`u`] simple_arc_end_cut;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `CC = C'''''` ABBREV_TAC ;
+  POP_ASSUM (fun t->ALL_TAC);
+  (* E' *)
+  TYPE_THEN `~CC v` SUBGOAL_TAC;
+  DISCH_TAC;
+  TYPE_THEN `C'''' v` SUBGOAL_TAC;
+  UND 50;
+  MESON_TAC[simple_arc_end_end];
+  DISCH_TAC;
+  TYPE_THEN `v = u` SUBGOAL_TAC;
+  UND 48;
+   REWRITE_TAC[INTER;eq_sing;INR IN_SING];
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_FULL_REWRITE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `~CC v'` SUBGOAL_TAC;
+  DISCH_TAC;
+  USE 35 (MATCH_MP union_imp_subset);
+  UND 43;
+  REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `CC SUBSET A` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  REWRITE_TAC[DIFF_SUBSET];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  UND 49;
+  MESON_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USE 55 (MATCH_MP inter_union);
+  FIRST_ASSUM MP_TAC;
+  REWRITE_TAC[];
+  REWRITE_TAC[DE_MORGAN_THM];
+  TYPE_THEN `CC SUBSET e` SUBGOAL_TAC;
+  USE 35 (MATCH_MP union_imp_subset);
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Cvu'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_TAC;
+  (* -- *)
+  CONJ_TAC;
+  EXPAND_TAC"B";
+  REWRITE_TAC[INTER;UNIONS;EQ_EMPTY ];
+  REP_BASIC_TAC;
+  TYPE_THEN `e x` SUBGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
+  REP_BASIC_TAC  ; (* we are up to 69 in the hypothesis stack *)
+  TYPEL_THEN  [`e`;`u''`] (USE 66 o ISPECL);
+  REWR 66;
+  TYPE_THEN `graph_vertex G x` SUBGOAL_TAC;
+  USE 66 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[INTER];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* --- *)
+  TYPE_THEN `graph_inc G e HAS_SIZE 2` SUBGOAL_TAC;
+  IMATCH_MP_TAC  graph_edge2;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `graph_inc G e x` SUBGOAL_TAC;
+  ASM_SIMP_TAC[];
+  ASM_REWRITE_TAC[INTER];
+  REP_BASIC_TAC;
+  TH_INTRO_TAC [`graph_inc G e`;`v`;`x`;`v'`] two_exclusion;
+  ASM_REWRITE_TAC[];
+   UND 60;
+  UND 54;
+  MESON_TAC[];
+  UND 60;
+  UND 53;
+  MESON_TAC[];
+  (* -- *)
+  PROOF_BY_CONTR_TAC;
+  USE 57 (MATCH_MP inter_union);
+  UND 57;
+  REWRITE_TAC[DE_MORGAN_THM];
+  CONJ_TAC;
+  EXPAND_TAC "B'";
+  REWRITE_TAC[INTER;UNIONS;];
+  REWRITE_TAC [EQ_EMPTY];
+  REP_BASIC_TAC;
+  UNDF `u''' = D v''` ;
+  DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  REP_BASIC_TAC;
+  TYPEL_THEN [`e`;`v''`] (USE 59 o ISPECL);
+  REWR 59;
+  UND 59;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `x` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 57;
+  EXPAND_TAC "D";
+  DISCH_THEN_REWRITE;
+  (* -- *)
+  EXPAND_TAC "B''";
+  REWRITE_TAC[INTER;EQ_EMPTY;in_pair];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* F' *)
+  TH_INTRO_TAC[`A`;`CC`;`u`;`u'`] construct_hv_finite;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `Chv = C''''''` ABBREV_TAC ;
+  KILL 59;
+  TYPE_THEN `Chv` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~(A v) /\ ~(A v')` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  EXPAND_TAC "B''";
+  REWRITE_TAC[DIFF;UNION;in_pair];
+  DISCH_TAC;
+  TYPE_THEN `~(Chv v) /\ ~(Chv v')` SUBGOAL_TAC;
+  UND 59;
+  UND 58;
+  MESON_TAC[ISUBSET];
+  DISCH_THEN_REWRITE;
+  (* - *)
+  TYPE_THEN `(!e'. ~(e = e') /\ (graph_edge G e') ==> (A INTER e' = {}))` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  EXPAND_TAC "B";
+  REP_BASIC_TAC;
+  REWRITE_TAC[EQ_EMPTY;INTER;DIFF;UNION;UNIONS ];
+  REP_BASIC_TAC;
+  LEFT 64 "u";
+  LEFT 64 "u";
+  TSPEC `e'` 64;
+  UND 64;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  TSPEC `e'` 60;
+  REWR 60;
+  UND 60;
+  UND 58;
+  REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;];
+  MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!v''. graph_vertex G v'' /\ ~graph_inc G e v'' ==> (A INTER closed_ball (euclid 2,d_euclid) v'' r = {})` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  EXPAND_TAC "A";
+  EXPAND_TAC "B'";
+  REP_BASIC_TAC;
+  REWRITE_TAC[EQ_EMPTY;INTER;DIFF;UNION;UNIONS;];
+  EXPAND_TAC "D";
+  REP_BASIC_TAC;
+  UND 65;
+  REWRITE_TAC[];
+  DISJ2_TAC;
+  DISJ1_TAC;
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `v''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TSPEC `v''` 62;
+  REWR 62;
+  UND 62;
+  UND 58;
+  REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;];
+  MESON_TAC[];
+  (* Wed Aug 25 14:58:37 EDT 2004 *)
+
+
+  ]);;
+  (* }}} *)
+
+let planar_graph_hv = prove_by_refinement(
+  `!(G:(A,B)graph_t). (planar_graph G) /\
+         FINITE (graph_edge G) /\
+         FINITE (graph_vertex G) /\
+         ~(graph_edge G = {}) /\
+         (!v. CARD (graph_edge_around G v) <=| 4)
+         ==> (?H. graph_isomorphic G H /\
+              good_plane_graph H /\ (!e. graph_edge H e ==>
+           hv_finite e))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TH_INTRO_TAC[`G`] graph_radius_exists;
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  (* - *)
+  TYPE_THEN `X = { K | graph_isomorphic H K /\ graph_hv_finite_radius K r}` ABBREV_TAC  ;
+  TYPE_THEN `c = (\ (K:(num->real,(num->real)->bool)graph_t). CARD {x | graph_edge K x /\ ~hv_finite x})` ABBREV_TAC ;
+  TYPE_THEN `D = (\ v. (closed_ball(euclid 2,d_euclid) v r))` ABBREV_TAC ;
+  TH_INTRO_TAC[`X`;`c`] select_image_num_min;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `H` EXISTS_TAC;
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  ASM_REWRITE_TAC[graph_isomorphic_refl];
+  REP_BASIC_TAC;
+  TYPE_THEN `K = z` ABBREV_TAC ;
+  KILL 12;
+  TYPE_THEN `K` EXISTS_TAC;
+  CONJ_TAC;
+  UND 11;
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  ASM_MESON_TAC[graph_isomorphic_trans];
+  (* - *)
+  TYPE_THEN `graph_hv_finite_radius K r` SUBGOAL_TAC;
+  UND 11;
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  (* - *)
+  CONJ_TAC;
+  UND 12;
+  REWRITE_TAC[graph_hv_finite_radius];
+  DISCH_THEN_REWRITE;
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  (* - *)
+  TH_INTRO_TAC[`K`;`e`] graph_edge_end_select;
+  ASM_REWRITE_TAC[];
+  UND 12;
+  REWRITE_TAC[graph_hv_finite_radius;good_plane_graph;plane_graph];
+  DISCH_THEN_REWRITE;
+  REP_BASIC_TAC;
+  (* A *)
+  TYPE_THEN `graph_isomorphic G K` SUBGOAL_TAC;
+  TH_INTRO_TAC[`G`;`H`;`K`] graph_isomorphic_trans;
+  ASM_REWRITE_TAC[];
+  UND 11;
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `FINITE (graph_edge K)` SUBGOAL_TAC;
+  USE 18(REWRITE_RULE[graph_isomorphic;graph_iso]);
+  REP_BASIC_TAC;
+  UND 19;
+  UND 3;
+  MESON_TAC[FINITE_BIJ];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `~(? e' . (~graph_edge K e') /\ hv_finite e' /\ simple_arc_end e' v v' /\ (e INTER (graph_vertex K) = (e' INTER (graph_vertex K))) /\ (!v. graph_vertex K v /\ ~e' v  ==> (e' INTER closed_ball (euclid 2,d_euclid) v r = {})) /\ (!e''. graph_edge K e'' /\ ~(e'' = e)  ==> e' INTER e'' SUBSET e INTER e''))` SUBGOAL_TAC;
+  DISCH_TAC;
+  REP_BASIC_TAC;
+  (* -- *)
+  TH_INTRO_TAC[`K`;`e`;`e'`] graph_replace_card;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `K' = graph_replace K e e'` ABBREV_TAC ;
+  DISCH_TAC;
+  TYPE_THEN `graph_isomorphic H K'` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  EXPAND_TAC "K'";
+  REWRITE_TAC[];
+  TH_INTRO_TAC[`H`;`K`;`K'`] graph_isomorphic_trans;
+  ASM_REWRITE_TAC[];
+  UND 11;
+  EXPAND_TAC "X";
+  REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  EXPAND_TAC "K'";
+  IMATCH_MP_TAC  graph_replace_iso;
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "K'";
+  DISCH_THEN_REWRITE;
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `plane_graph K'` SUBGOAL_TAC;
+  EXPAND_TAC "K'";
+  IMATCH_MP_TAC  graph_replace_plane;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `good_plane_graph K'` SUBGOAL_TAC;
+  EXPAND_TAC "K'";
+  IMATCH_MP_TAC  good_replace;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `e v'' /\ e v'''` SUBGOAL_TAC;
+  USE 22 (REWRITE_RULE[FUN_EQ_THM]);
+  TYPE_THEN  `v''` (WITH 22 o ISPEC);
+  TYPE_THEN `v'''` (USE 22 o ISPEC);
+  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
+  UND 22;
+  UND 35;
+  UND 33;
+  UND 34;
+  DISCH_THEN_REWRITE;
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  MESON_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc K e = {v,v'}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  graph_vertex_exhaust;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `graph_inc K e = {v'',v'''}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  graph_vertex_exhaust;
+  USE 37 (SYM);
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  TSPEC `e` 46;
+  REWR 46;
+  ASM_REWRITE_TAC[INTER];
+  DISCH_THEN_FULL_REWRITE;
+  TYPE_THEN `((v'' = v) /\ (v''' = v')) \/ ((v'' = v') /\ (v''' = v))` SUBGOAL_TAC;
+  USE 37 (REWRITE_RULE[FUN_EQ_THM]);
+  TYPE_THEN `v''` (WITH 37 o ISPEC);
+  TYPE_THEN `v'''` (USE 37 o ISPEC);
+  UND 37;
+  UND 38;
+  REWRITE_TAC[in_pair];
+  UND 32;
+  UND 15;
+  MESON_TAC[];
+  DISCH_THEN DISJ_CASES_TAC;
+  REP_BASIC_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  TYPE_THEN `graph_hv_finite_radius K' r` SUBGOAL_TAC;
+  EXPAND_TAC "K'";
+  IMATCH_MP_TAC  graph_replace_hv_finite_radius;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `X K'` SUBGOAL_TAC;
+  EXPAND_TAC "X";
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TSPEC `K'` 10;
+  REWR 10;
+  UND 10;
+  EXPAND_TAC "c";
+  UND 27;
+(**** Changed by JRH; the new ARITH_TAC doesn't accept alpha-equivs (maybe)
+  ARITH_TAC;
+ ****)
+  REWRITE_TAC[NOT_IMP; NOT_LE];
+  REWRITE_TAC[];
+  (* B *)
+  TH_INTRO_TAC [`K`;`r`;`e`;`v`;`v'`] graph_rad_pt_center_piece;
+  ASM_REWRITE_TAC[];
+  USE 18 (REWRITE_RULE[graph_isomorphic;graph_iso]);
+  REP_BASIC_TAC;
+  UND 21;
+  UND 2;
+  MESON_TAC[FINITE_BIJ];
+  REP_BASIC_TAC;
+  KILL 4;
+  KILL 3;
+  KILL 2;
+  KILL 1;
+  KILL 0;
+  KILL 6;
+  KILL 5;
+  KILL 7;
+  KILL 8;
+  KILL 11;
+  KILL 10;
+  KILL 18;
+  KILL 19;
+  TYPE_THEN `graph_inc K e  = {v,v'}` SUBGOAL_TAC;
+  IMATCH_MP_TAC  graph_vertex_exhaust;
+  ASM_REWRITE_TAC[];
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `e INTER graph_vertex K = {v,v'}` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
+  REP_BASIC_TAC;
+  TSPEC `e` 7;
+  REWR 7;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN_REWRITE;
+  (* C- *)
+  TYPE_THEN `!e v. graph_edge K e /\ graph_inc K e v ==> graph_vertex K v` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TH_INTRO_TAC[`K`;`e'`] graph_inc_subset;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `p_conn (Cv UNION Cv' UNION C'') v v'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  pconn_trans;
+  TYPE_THEN `u` EXISTS_TAC;
+  CONJ_TAC;
+  TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`v`;`u`] p_conn_hv_finite;
+  IMATCH_MP_TAC  simple_arc_end_distinct;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `Cv` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  IMATCH_MP_TAC  pconn_trans;
+  TYPE_THEN `u'` EXISTS_TAC;
+  CONJ_TAC;
+  TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`u`;`u'`] p_conn_hv_finite;
+  IMATCH_MP_TAC  simple_arc_end_distinct;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `C''` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`u'`;`v'`] p_conn_hv_finite;
+  IMATCH_MP_TAC  simple_arc_end_distinct;
+  TYPE_THEN `Cv'` EXISTS_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_MESON_TAC[];
+  DISCH_THEN_REWRITE;
+  TYPE_THEN `Cv'` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET;UNION];
+  CONJ_TAC;
+  MESON_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TH_INTRO_TAC[`Cv UNION Cv' UNION C''`;`v`;`v'`] p_conn_hv_finite;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* D final constraints *)
+  TYPE_THEN`graph K` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  TYPE_THEN `!e v. graph_edge K e /\ graph_inc K e v ==> graph_vertex K v` SUBGOAL_TAC;
+  REP_BASIC_TAC;
+  TH_INTRO_TAC[`K`;`e'`]graph_inc_subset;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* - *)
+  CONJ_TAC;
+  DISCH_TAC;
+  TYPE_THEN `C = e` ASM_CASES_TAC;
+  ASM_MESON_TAC[];
+  TSPEC `C` 21;
+  REWR 11;
+  TYPE_THEN `C SUBSET Cv UNION Cv'` SUBGOAL_TAC;
+  UND 11;
+  UND 4;
+  REWRITE_TAC[SUBSET;UNION;EQ_EMPTY;INTER ];
+  MESON_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `D v INTER D v' = EMPTY ` SUBGOAL_TAC;
+  EXPAND_TAC "D";
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  REP_BASIC_TAC;
+  UND 21;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  (* -- *)
+  UND 10;
+  REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_inj;
+  TYPE_THEN `e` EXISTS_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  TYPE_THEN `v'` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL];
+  SUBCONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph]);
+  REP_BASIC_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Cv UNION Cv'` EXISTS_TAC;
+  ASM_REWRITE_TAC[union_subset ];
+  (* E *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[in_pair;INTER ];
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_THEN DISJ_CASES_TAC;
+  UND 8;
+  DISCH_THEN_FULL_REWRITE;
+  CONJ_TAC;
+  UND 3;
+  MESON_TAC[simple_arc_end_end2];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  UND 8;
+  DISCH_THEN_FULL_REWRITE;
+  CONJ_TAC;
+  UND 3;
+  MESON_TAC[simple_arc_end_end];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `graph_inc K e x` ASM_CASES_TAC;
+  REWR 8;
+  RULE_ASSUM_TAC (REWRITE_RULE[in_pair]);
+  ASM_REWRITE_TAC[];
+  USE 4 (REWRITE_RULE[SUBSET ]);
+  REP_BASIC_TAC;
+  TSPEC `x` 4;
+  REWR 4;
+  USE 4(REWRITE_RULE[UNION]);
+  UND 4;
+  REP_CASES_TAC;
+  DISJ2_TAC;
+  PROOF_BY_CONTR_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  REP_BASIC_TAC;
+  UND 40;
+  DISCH_THEN (TH_INTRO_TAC[`v`;`x`]);
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `x` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  CONJ_TAC;
+  UND 4;
+  UND 23;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  REWRITE_TAC[closed_ball2_center];
+  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UNDF `&0 < r`;
+  REAL_ARITH_TAC;
+  (* --- *)
+  DISJ1_TAC;
+  PROOF_BY_CONTR_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  REP_BASIC_TAC;
+  UNDF `~(v = v')`;
+  DISCH_THEN (TH_INTRO_TAC[`v'`;`x`]);
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `x` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  CONJ_TAC;
+  UND 4;
+  UND 22;
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[];
+  REWRITE_TAC[closed_ball2_center];
+  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph]);
+  REP_BASIC_TAC;
+  CONJ_TAC;
+  USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UNDF `&0 < r`;
+  REAL_ARITH_TAC;
+ (* -- *)
+  TYPE_THEN `graph_inc K e x` ASM_CASES_TAC;
+  REWR 18;
+  TSPEC `x` 20;
+  REWR 19;
+  PROOF_BY_CONTR_TAC;
+  UND 19;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[INTER;closed_ball2_center];
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius;good_plane_graph;plane_graph]);
+  REP_BASIC_TAC;
+  USEF `X SUBSET euclid 2` (REWRITE_RULE[SUBSET]);
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UNDF `&0 < r`;
+  REAL_ARITH_TAC;
+  (* F *)
+  KILL 14;
+  KILL 39;
+  KILL 38;
+  KILL 37;
+  KILL 36;
+  KILL 35;
+  KILL 34;
+  KILL 33;
+  KILL 32;
+  KILL 29;
+  KILL 28;
+  KILL 27;
+  KILL 26;
+  KILL 5;
+  KILL 2;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[SUBSET;INTER];
+  REP_BASIC_TAC;
+  USEF `(SUBSET)` (REWRITE_RULE[SUBSET]);
+  TSPEC `x` 4;
+  REWR 4;
+  UND 4;
+  REWRITE_TAC[UNION];
+  REP_CASES_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  ASM_MESON_TAC[ISUBSET];
+  PROOF_BY_CONTR_TAC;
+  UND 21;
+  DISCH_THEN (TH_INTRO_TAC[`e''`]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[INTER];
+  (* G *)
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_inc K e v''` ASM_CASES_TAC;
+  REWR 8;
+  UND 8;
+  REWRITE_TAC[in_pair];
+  REP_CASES_TAC;
+  UND 8;
+  DISCH_THEN_FULL_REWRITE;
+  PROOF_BY_CONTR_TAC;
+  UND 2;
+  UND 3;
+  MESON_TAC[simple_arc_end_end2];
+  UND 8;
+  DISCH_THEN_FULL_REWRITE;
+  PROOF_BY_CONTR_TAC;
+  UND 2;
+  UND 3;
+  MESON_TAC[simple_arc_end_end];
+  (* - *)
+  TYPE_THEN `C SUBSET D v UNION D v' UNION C''` SUBGOAL_TAC;
+  EXPAND_TAC "D";
+  UND 4;
+  UND 22;
+  UND 23;
+  REWRITE_TAC[SUBSET;UNION];
+  MESON_TAC[];
+  REWRITE_TAC[SUBSET];
+  DISCH_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 11 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
+  REP_BASIC_TAC;
+  TSPEC `u` 10;
+  REWR 10;
+  USE 10 (REWRITE_RULE[UNION]);
+  UND 10;
+  REP_CASES_TAC ;
+  (* -- *)
+  UND 8;
+  ASM_REWRITE_TAC[in_pair];
+  PROOF_BY_CONTR_TAC;
+  USE 8 (REWRITE_RULE[DE_MORGAN_THM]);
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  REP_BASIC_TAC;
+  UND 26;
+  DISCH_THEN (TH_INTRO_TAC[`v`;`v''`]);
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  TYPE_THEN `u` EXISTS_TAC;
+  UND 10;
+  EXPAND_TAC "D";
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  UND 8;
+  ASM_REWRITE_TAC[in_pair];
+  PROOF_BY_CONTR_TAC;
+  USE 8 (REWRITE_RULE[DE_MORGAN_THM]);
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[graph_hv_finite_radius]);
+  REP_BASIC_TAC;
+  UND 26;
+  DISCH_THEN (TH_INTRO_TAC[`v'`;`v''`]);
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  TYPE_THEN `u` EXISTS_TAC;
+  UND 10;
+  EXPAND_TAC "D";
+  DISCH_THEN_REWRITE;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  UND 20;
+  DISCH_THEN (TH_INTRO_TAC[`v''`]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS;INTER];
+  ASM_MESON_TAC[];
+  (* Thu Aug 26 08:46:13 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION P *)
+(* ------------------------------------------------------------------ *)
+
+
+let (UNDISCHQ_TAC:(term->bool) -> tactic) =
+  fun cond (asl,w) ->
+  let cond' x = try (cond x) with failure -> false in
+  let asl' = (fst(partition cond' (map (concl o snd) asl))) in
+  EVERY (map (TRY o UNDISCH_TAC ) asl') (asl,w);;
+
+let UNABBREV_TAC tm  =
+  FIRST[ UNDISCHQ_TAC ( ((=) tm o rhs))
+      THEN (DISCH_THEN (MP_TAC o SYM))  ;
+      UNDISCHQ_TAC ( ((=) tm o lhs)) ]
+  THEN DISCH_THEN_FULL_REWRITE;;
+
+let set_simp_rewrites,extend_simp_rewrites,simp_rewrites,simp_net =
+  let rewrites = ref (basic_rewrites())
+  and conv_net = ref (basic_net()) in
+  let set_simp_rewrites thl =
+    let canon_thl = itlist (mk_rewrites false) thl ([]:thm list) in
+    (rewrites := canon_thl;
+     conv_net := itlist (net_of_thm true) canon_thl empty_net) in
+  let extend_simp_rewrites thl =
+    (* is false in simp.ml .  Important change.  *)
+    let canon_thl = itlist (mk_rewrites true) thl ([]:thm list) in
+     (rewrites := canon_thl @ !rewrites;
+      conv_net := itlist (net_of_thm true) canon_thl (!conv_net)) in
+  let simp_rewrites() = !rewrites in
+  let simp_net() = !conv_net in
+  set_simp_rewrites,extend_simp_rewrites,simp_rewrites,simp_net;;
+
+let simp_ss =
+  let rewmaker = mk_rewrites true in
+  fun thl ->
+    let cthms = itlist rewmaker thl ([]:thm list) in
+    let net' = itlist (net_of_thm true) cthms (simp_net()) in
+    let net'' = itlist net_of_cong (basic_congs()) net' in
+  Simpset(net'',basic_prover,([]:prover list),rewmaker);;
+
+let RSIMP_CONV thl = ONCE_SIMPLIFY_CONV (simp_ss ([]:thm list)) thl;;
+
+let (RSIMP_TAC:thm list -> tactic) = fun (thl:thm list) -> CONV_TAC(RSIMP_CONV thl);;
+
+let ASM_RSIMP_TAC = ASM RSIMP_TAC;;
+
+EVERY_STEP_TAC :=
+     (RSIMP_TAC[]) THEN
+     REP_BASIC_TAC THEN (DROP_ALL_ANT_TAC) THEN
+     (ASM_RSIMP_TAC[]) THEN
+     (REWRITE_TAC[]) ;;
+
+let SUBAGOAL_TAC t = SUBGOAL_THEN t ASSUME_TAC;;
+
+(* EVERY_STEP_TAC := ALL_TAC *)
+
+let subset_imp = prove_by_refinement(
+  `!A B (x:A). A x /\ A SUBSET B ==> B x`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[ISUBSET];
+  ]);;
+  (* }}} *)
+
+(*
+extend_simp_rewrites[subset_imp]
+*)
+
+(* ------------------------------------------------------------------ *)
+(* ------------------------------------------------------------------ *)
+
+
+let plane_graph_image = jordan_def
+  `plane_graph_image (f:(num->real)->(num->real)) G =
+     mk_graph_t
+       (IMAGE f (graph_vertex G),
+        IMAGE2 f (graph_edge G),
+        ( \ e v. (?e' v'. (graph_edge G e') /\
+             (IMAGE f e' = e) /\ (f v' = v) /\
+            (graph_inc G e' v'))))`;;
+
+let plane_graph_image_e = prove_by_refinement(
+  `!f G. (graph_edge (plane_graph_image f G)) =
+         IMAGE2 f (graph_edge G)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[plane_graph_image;graph_edge;part1;drop0;dest_graph_t];
+  (* Thu Aug 26 10:16:26 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let plane_graph_image_v = prove_by_refinement(
+  `!f G. (graph_vertex (plane_graph_image f G)) =
+          IMAGE f (graph_vertex G)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[plane_graph_image;dest_graph_t;graph_vertex;];
+  (*     Thu Aug 26 10:17:56 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let plane_graph_image_i = prove_by_refinement(
+  `!f G. (graph_inc (plane_graph_image f G)) =
+     ( \ e v. (?e' v'. (graph_edge G e') /\
+             (IMAGE f e' = e) /\ (f v' = v) /\
+            (graph_inc G e' v')))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[plane_graph_image ;graph_inc;dest_graph_t;drop1];
+  (* Thu Aug 26 10:20:07 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let plane_graph_image_bij = prove_by_refinement(
+  `!f G. homeomorphism f top2 top2 /\ plane_graph G ==>
+   BIJ f (graph_vertex G) (IMAGE f (graph_vertex G)) /\
+   BIJ (IMAGE f) (graph_edge G) (IMAGE2 f (graph_edge G))`,
+  (* {{{ proof *)
+  [
+  ALL_TAC ;
+  (* - *)
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions]);
+  TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_bij;
+  REWRITE_TAC[INJ];
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  USE 3 (MATCH_MP image_powerset);
+  REWRITE_TAC[IMAGE2];
+  IMATCH_MP_TAC  inj_bij;
+  REWRITE_TAC[INJ];
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* ASM_MESON_TAC[ISUBSET]; *)
+  ]);;
+  (* }}} *)
+
+let plane_graph_image_iso = prove_by_refinement(
+  `!f G. (homeomorphism f top2 top2 /\ plane_graph G ==>
+      graph_isomorphic G (plane_graph_image f G))`,
+  (* {{{ proof *)
+  [
+  ALL_TAC;
+  REWRITE_TAC[graph_isomorphic;graph_iso;];
+  LEFT_TAC "u";
+  TYPE_THEN `f` EXISTS_TAC;
+  LEFT_TAC "v";
+  TYPE_THEN `IMAGE f` EXISTS_TAC;
+  TYPE_THEN `f,IMAGE f` EXISTS_TAC;
+  REWRITE_TAC[plane_graph_image_e;plane_graph_image_v;plane_graph_image_i];
+  (* - *)
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;top2_unions]);
+  TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  (* - *)
+  TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_bij;
+  REWRITE_TAC[INJ];
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[ISUBSET];
+  (* - *)
+  SUBCONJ_TAC;
+  USE 3 (MATCH_MP image_powerset);
+  REWRITE_TAC[IMAGE2];
+  IMATCH_MP_TAC  inj_bij;
+  REWRITE_TAC[INJ];
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* A- *)
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  EQ_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `e' = e` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE2;BIJ;INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* ---- *)
+  TYPE_THEN `e'`  UNABBREV_TAC ;
+  REWRITE_TAC[IMAGE];
+  USE 5 GSYM;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  USE 8(REWRITE_RULE[IMAGE]);
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Thu Aug 26 10:49:22 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+extend_simp_rewrites [(REAL_ARITH `&0 < &1`)];;
+
+extend_simp_rewrites [prove_by_refinement(
+  `metric_space(euclid 2,d_euclid)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[metric_euclid];
+  ])];;
+  (* }}} *)
+
+extend_simp_rewrites [prove_by_refinement(
+  `!G. plane_graph G ==> graph_vertex G SUBSET (euclid 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[plane_graph];
+  ])];;
+  (* }}} *)
+
+let simple_arc_end_cont = prove_by_refinement(
+  `!C v v'. simple_arc_end C v v' <=>
+       (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\
+        continuous f
+           (top_of_metric ({x | &0 <= x /\ x <= &1},d_real)) top2 /\
+              INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
+              (f (&0) = v) /\
+              (f (&1) = v'))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc_end];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  EQ_TAC;
+  TH_INTRO_TAC [`&0`;`&1`;`f`;`euclid 2`;`d_euclid`] cont_extend_real_lemma;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[GSYM top2];
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REWRITE_TAC[IMAGE;SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `g` EXISTS_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  EQ_TAC;
+  UNIFY_EXISTS_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNIFY_EXISTS_TAC;
+  ASM_MESON_TAC[];
+  (* -- *)
+  ASM_REWRITE_TAC[top2];
+  CONJ_TAC;
+  REWRITE_TAC[INJ];
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[REAL_ARITH `x <=. x `;REAL_ARITH `&0 <=. &1`];
+  (* - *)
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  continuous_interval;
+  (* Thu Aug 26 12:57:09 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let graph_edge_euclid =  prove_by_refinement(
+  `!G e. (plane_graph G /\ graph_edge G e) ==> (e SUBSET (euclid 2))`,
+  (* {{{ proof *)
+  [
+  ALL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+let plane_graph_image_plane = prove_by_refinement(
+  `!f G. (homeomorphism f top2 top2 /\ good_plane_graph G ==>
+     good_plane_graph(plane_graph_image f G))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[good_plane_graph];
+  TH_INTRO_TAC[`G`;`plane_graph_image f G`] graph_isomorphic_graph;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  plane_graph_image_iso;
+  ASM_REWRITE_TAC[plane_graph];
+  (* - *)
+  TYPE_THEN `graph_vertex G SUBSET (euclid 2)` SUBGOAL_TAC;
+  (* - *)
+  TYPE_THEN `!e. graph_edge G e ==> (e SUBSET (euclid 2))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  graph_edge_euclid;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  TH_INTRO_TAC[`f`;`G`] plane_graph_image_bij;
+  (* A- *)
+  ASM_REWRITE_TAC[plane_graph;GSYM CONJ_ASSOC;];
+  TYPE_THEN `(!e v v'.  graph_edge (plane_graph_image f G) e /\  ~(v = v') /\  graph_inc (plane_graph_image f G) e v /\  graph_inc (plane_graph_image f G) e v' ==> simple_arc_end e v v')` SUBGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph_image_e;plane_graph_image_v;plane_graph_image_i]);
+  TYPE_THEN `v` UNABBREV_TAC;
+  TYPE_THEN `v'` UNABBREV_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  TYPE_THEN `e' = e''` SUBGOAL_TAC ;
+  USE 6 (REWRITE_RULE[BIJ;INJ;IMAGE2]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `e''` UNABBREV_TAC;
+  UND 0 THEN (DISCH_THEN (TH_INTRO_TAC [`e'`;`v'''`;`v''`]));
+  DISCH_TAC;
+  TYPE_THEN `v'''` UNABBREV_TAC;
+  USE 0 (REWRITE_RULE[simple_arc_end_cont]);
+  REWRITE_TAC[simple_arc_end_cont];
+  TYPE_THEN `f o f'` EXISTS_TAC;
+  REWRITE_TAC[IMAGE_o];
+  (* -- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  continuous_comp;
+  TYPE_THEN `top2` EXISTS_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism]);
+  ASM_REWRITE_TAC[top2_unions];
+  TYPE_THEN `UNIONS (top_of_metric ({x | &0 <= x /\ x <= &1},d_real)) = {x | &0 <= x /\ x <= &1}` SUBGOAL_TAC;
+  TH_INTRO_TAC[`{x | &0 <= x /\ x <= &1}`;`d_real`] top_of_metric_unions;
+  TYPE_THEN `{x | &0 <= x /\ x <= &1} SUBSET UNIV ` SUBAGOAL_TAC;
+  alpha_tac;
+  IMATCH_MP_TAC  metric_subspace;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC [metric_real;];
+  UND 21 THEN   DISCH_THEN (fun t->ONCE_REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[];
+  USE 15 (REWRITE_RULE[INJ]);
+  REWRITE_TAC[IMAGE;SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[comp_comp];
+  IMATCH_MP_TAC  COMP_INJ;
+  UNIFY_EXISTS_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions]);
+  REWRITE_TAC[o_DEF];
+  (* B- *)
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `graph_edge (plane_graph_image f G) SUBSET simple_arc top2` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET];
+  TH_INTRO_TAC[`plane_graph_image f G`;`x`] graph_edge_end_select;
+  UND 8 THEN DISCH_THEN (TH_INTRO_TAC[`x`;`v`;`v'`]);
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  UNIFY_EXISTS_TAC;
+  KILL 8;
+  (* - *)
+  CONJ_TAC;
+  MP_TAC plane_graph_image_v THEN DISCH_THEN_FULL_REWRITE;
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;INJ;]);
+  USE 16 (REWRITE_RULE[top2_unions]);
+  REWRITE_TAC[IMAGE;SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  CONJ_TAC;
+  (fun t-> (RULE_ASSUM_TAC (REWRITE_RULE t) THEN REWRITE_TAC t ))  [plane_graph_image_e;plane_graph_image_v;plane_graph_image_i];
+  IMATCH_MP_TAC  EQ_EXT;
+  EQ_TAC;
+  TYPE_THEN `x`  UNABBREV_TAC ;
+  TYPE_THEN `e` UNABBREV_TAC;
+  REWRITE_TAC[INTER];
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  TSPEC `e'` 11;
+  REWR 10;
+  USE 10 (REWRITE_RULE[INTER]);
+  REWRITE_TAC[IMAGE];
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `v'` EXISTS_TAC;
+  TH_INTRO_TAC [`G`;`e'`] graph_inc_subset;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  USE 8 (REWRITE_RULE[IMAGE2]);
+  TYPE_THEN `FF = IMAGE f` ABBREV_TAC ;
+  USE 8 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `x'` EXISTS_TAC;
+  USE 10 (REWRITE_RULE[INTER]);
+  TYPE_THEN `FF`  UNABBREV_TAC;
+  USE 10 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `x''` EXISTS_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  REWRITE_TAC[INTER];
+  USE 13 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `x''  =x` SUBAGOAL_TAC;
+  USE 2(REWRITE_RULE[homeomorphism;BIJ;INJ;top2_unions]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  TSPEC `x'` 5;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* C- *)
+  (fun t-> (RULE_ASSUM_TAC (REWRITE_RULE t) THEN REWRITE_TAC t ))  [plane_graph_image_e;plane_graph_image_v;plane_graph_image_i];
+  USE 10 (REWRITE_RULE[IMAGE2]);
+  USE 11 (REWRITE_RULE[IMAGE2]);
+  TYPE_THEN `FF = IMAGE f` ABBREV_TAC ;
+  USE 10 (REWRITE_RULE[IMAGE]);
+  USE 11 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `e` UNABBREV_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  TH_INTRO_TAC [`f`;`euclid 2`;`euclid 2`;`x'`;`x`] (GSYM inj_inter);
+  RULE_ASSUM_TAC (REWRITE_RULE[homeomorphism;BIJ;top2_unions]);
+  TYPE_THEN `FF` UNABBREV_TAC;
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  RULE_ASSUM_TAC (REWRITE_RULE[plane_graph]);
+  TYPEL_THEN [`x'`;`x`] (fun t-> UND 1 THEN DISCH_THEN (TH_INTRO_TAC t));
+  DISCH_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  ]);;
+  (* }}} *)
+
+(* state MP *)
+
+let h_compat = jordan_def `h_compat f <=> !x y. (SND x = SND y) ==>
+   (IMAGE f (mk_line (point x) (point y)) =
+          mk_line (f (point x)) (f (point y)))`;;
+
+let v_compat = jordan_def `v_compat f <=> !x y. (FST x = FST y) ==>
+   (IMAGE f (mk_line (point x) (point y)) =
+          mk_line (f (point x)) (f (point y)))`;;
+
+let h_translate = jordan_def `h_translate r p = p + r *# e1`;;
+
+let v_translate = jordan_def `v_translate r p = p + r *# e2`;;
+
+let r_scale = jordan_def `r_scale r p =
+        if ( &.0 < p 0) then (point (r * p 0, p 1)) else p`;;
+
+let u_scale = jordan_def `u_scale r p =
+        if ( &.0 < p 1) then (point ( p 0, r * p 1)) else p`;;
+
+let cont_domain = prove_by_refinement(
+  `!(f:A->B) g U V. (continuous f U V) /\ (!x. UNIONS U x ==> (f x = g x))
+    ==> (continuous g U V)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[preimage;continuous;];
+  TYPE_THEN `{x | UNIONS U x /\ v (g x)} = {x | UNIONS U x /\ v (f x)}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  IMATCH_MP_TAC  (TAUT `(A ==> (B <=> C)) ==> (A /\ B <=> A /\ C)`);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ]);;
+  (* }}} *)
+
+let h_translate_bij = prove_by_refinement(
+  `!r. BIJ (h_translate r) (euclid 2) (euclid 2)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[BIJ;INJ;h_translate];
+  SUBCONJ_TAC;
+  CONJ_TAC;
+  ASM_SIMP_TAC[euclid_add_closure;e1;point_scale;euclid_point];
+  RULE_ASSUM_TAC (REWRITE_RULE[euclid_plus;euclid_scale;e1]);
+  IMATCH_MP_TAC  EQ_EXT;
+  USE 0 (REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x'` 0;
+  UND 0 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[SURJ;h_translate];
+  REP_BASIC_TAC;
+  TYPE_THEN `x - (r *# e1)` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[point_scale;e1];
+  ASM_SIMP_TAC[euclid_sub_closure;euclid_point];
+  REWRITE_TAC[euclid_plus;euclid_minus;euclid_scale];
+  IMATCH_MP_TAC  EQ_EXT;
+  REAL_ARITH_TAC;
+  (* Tue Sep  7 10:15:46 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let v_translate_bij = prove_by_refinement(
+  `!r. BIJ (v_translate r) (euclid 2) (euclid 2)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[BIJ;INJ;v_translate];
+  SUBCONJ_TAC;
+  CONJ_TAC;
+  ASM_SIMP_TAC[euclid_add_closure;e2;point_scale;euclid_point];
+  RULE_ASSUM_TAC (REWRITE_RULE[euclid_plus;euclid_scale;e2]);
+  IMATCH_MP_TAC  EQ_EXT;
+  USE 0 (REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x'` 0;
+  UND 0 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[SURJ;v_translate];
+  REP_BASIC_TAC;
+  TYPE_THEN `x - (r *# e2)` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[point_scale;e2];
+  ASM_SIMP_TAC[euclid_sub_closure;euclid_point];
+  REWRITE_TAC[euclid_plus;euclid_minus;euclid_scale];
+  IMATCH_MP_TAC  EQ_EXT;
+  REAL_ARITH_TAC;
+  (* Tue Sep  7 10:16:38 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+extend_simp_rewrites [euclid_point];;
+extend_simp_rewrites [coord01];;
+
+let r_scale_bij = prove_by_refinement(
+  `!r. (&0 < r) ==> BIJ (r_scale r) (euclid 2) (euclid 2)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[BIJ;INJ;r_scale;];
+  SUBCONJ_TAC;
+  CONJ_TAC;
+  COND_CASES_TAC;
+  REWRITE_TAC[euclid_point];
+  USE 2 (MATCH_MP   point_onto);
+  USE 3 (MATCH_MP   point_onto);
+  REWRITE_TAC[point_inj];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `y` UNABBREV_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
+  UND 1 THEN COND_CASES_TAC;
+  UND 1 THEN COND_CASES_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
+  RULE_ASSUM_TAC (REWRITE_RULE[REAL_EQ_LMUL]);
+  UND 4 THEN UND 0 THEN REAL_ARITH_TAC ;
+  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
+  TYPE_THEN `FST p` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 3 THEN REWRITE_TAC[];
+  REWRITE_TAC[real_gt];
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  UND 1 THEN COND_CASES_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT ]);
+  TYPE_THEN `FST p'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 2 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
+  KILL 1;
+  REWRITE_TAC[SURJ;r_scale];
+  KILL 2;
+  USE 1 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `&0 < FST p` ASM_CASES_TAC;
+  TYPE_THEN `point ((&1/r)* FST p, SND p)` EXISTS_TAC;
+  TYPE_THEN `&0 < &1/ r  * FST p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  ASM_REWRITE_TAC[];
+  AP_TERM_TAC;
+  REWRITE_TAC[PAIR_SPLIT;REAL_MUL_ASSOC];
+  TYPE_THEN `(r * &1/r) * FST p = &1 * FST p` SUBAGOAL_TAC;
+  AP_THM_TAC;
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
+  REDUCE_TAC;
+  TYPE_THEN `point p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Tue Sep  7 10:55:54 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let u_scale_bij = prove_by_refinement(
+  `!r. (&0 < r) ==> BIJ (u_scale r) (euclid 2) (euclid 2)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[BIJ;INJ;u_scale;];
+  SUBCONJ_TAC;
+  CONJ_TAC;
+  COND_CASES_TAC;
+  USE 2 (MATCH_MP   point_onto);
+  USE 3 (MATCH_MP   point_onto);
+  REWRITE_TAC[point_inj];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `y` UNABBREV_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
+  UND 1 THEN COND_CASES_TAC;
+  UND 1 THEN COND_CASES_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
+  RULE_ASSUM_TAC (REWRITE_RULE[REAL_EQ_LMUL]);
+  UND 1 THEN UND 0 THEN REAL_ARITH_TAC ;
+  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT]);
+  TYPE_THEN `SND p` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 3 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  UND 1 THEN COND_CASES_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[point_inj;PAIR_SPLIT ]);
+  TYPE_THEN `SND p'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 2 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
+  KILL 1;
+  REWRITE_TAC[SURJ;u_scale];
+  KILL 2;
+  USE 1 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `&0 < SND  p` ASM_CASES_TAC;
+  TYPE_THEN `point (FST p, (&1/r)* SND  p)` EXISTS_TAC;
+  TYPE_THEN `&0 < &1/ r  * SND  p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  ASM_REWRITE_TAC[];
+  AP_TERM_TAC;
+  REWRITE_TAC[PAIR_SPLIT;REAL_MUL_ASSOC];
+  TYPE_THEN `(r * &1/r) * SND  p = &1 * SND  p` SUBAGOAL_TAC;
+  AP_THM_TAC;
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
+  REDUCE_TAC;
+  TYPE_THEN `point p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Tue Sep  7 11:01:53 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let h_translate_inv = prove_by_refinement(
+  `!r x. (euclid 2 x) ==>
+   (h_translate (--. r) x = INV (h_translate r) (euclid 2) (euclid 2) x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_SYM;
+  TH_INTRO_TAC[`h_translate r`;`euclid 2`;`euclid 2`;`h_translate (--. r) x`;`x`] INVERSE_XY;
+  ASM_REWRITE_TAC[h_translate_bij;h_translate;e1;point_scale];
+  ASM_SIMP_TAC[euclid_add_closure;euclid_point];
+  REWRITE_TAC[h_translate;euclid_plus;e1;euclid_scale];
+  IMATCH_MP_TAC  EQ_EXT;
+  REAL_ARITH_TAC;
+  (* Tue Sep  7 11:11:17 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let v_translate_inv = prove_by_refinement(
+  `!r x. (euclid 2 x) ==>
+   (v_translate (--. r) x = INV (v_translate r) (euclid 2) (euclid 2) x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_SYM;
+  TH_INTRO_TAC[`v_translate r`;`euclid 2`;`euclid 2`;`v_translate (--. r) x`;`x`] INVERSE_XY;
+  ASM_REWRITE_TAC[v_translate_bij;v_translate;e2;point_scale];
+  ASM_SIMP_TAC[euclid_add_closure;euclid_point];
+  REWRITE_TAC[v_translate;euclid_plus;e2;euclid_scale];
+  IMATCH_MP_TAC  EQ_EXT;
+  REAL_ARITH_TAC;
+  (* Tue Sep  7 11:12:42 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+extend_simp_rewrites[prove_by_refinement(
+  `!x r. (&0 < r) ==> (r * (&1/r) * x = x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC [REAL_MUL_ASSOC];
+  TYPE_THEN `(r * &1/r) * x = &1 * x` SUBAGOAL_TAC;
+  AP_THM_TAC;
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  UND 1 THEN UND 0 THEN REAL_ARITH_TAC;
+  REDUCE_TAC;
+  ])];;
+  (* }}} *)
+
+extend_simp_rewrites[ prove_by_refinement(
+  `!r. (&0 < r) ==> (&0 < &1 / r)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  ])];;
+  (* }}} *)
+
+extend_simp_rewrites[ REAL_LE_POW_2];;
+
+extend_simp_rewrites[ prove_by_refinement(
+  `!x y. &0 <= x pow 2 + y pow 2`,
+  (* {{{ proof *)
+  [
+  ALL_TAC;
+  IMATCH_MP_TAC  REAL_LE_ADD;
+  ])];;
+  (* }}} *)
+
+let r_scale_inv = prove_by_refinement(
+  `!r x. (&0 < r) /\ (euclid 2 x) ==>
+   (r_scale (&1/r) x = INV (r_scale r) (euclid 2) (euclid 2) x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_SYM;
+  TH_INTRO_TAC[`r_scale r`;`euclid 2`;`euclid 2`;`r_scale (&1/r) x`;`x`] INVERSE_XY;
+  ASM_SIMP_TAC [r_scale_bij];
+  TH_INTRO_TAC[`&1/r`] r_scale_bij;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  REWRITE_TAC[r_scale];
+  USE 0 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `&0 < FST p` ASM_CASES_TAC;
+  REWRITE_TAC[coord01];
+  TYPE_THEN `&0 < (&1 / r) * FST p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* Tue Sep  7 11:40:41 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let u_scale_inv = prove_by_refinement(
+  `!r x. (&0 < r) /\ (euclid 2 x) ==>
+   (u_scale (&1/r) x = INV (u_scale r) (euclid 2) (euclid 2) x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_SYM;
+  TH_INTRO_TAC[`u_scale r`;`euclid 2`;`euclid 2`;`u_scale (&1/r) x`;`x`] INVERSE_XY;
+  ASM_SIMP_TAC [u_scale_bij];
+  TH_INTRO_TAC[`&1/r`] u_scale_bij;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  REWRITE_TAC[u_scale];
+  USE 0 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `&0 < SND p` ASM_CASES_TAC;
+  REWRITE_TAC[coord01];
+  TYPE_THEN `&0 < (&1 / r) * SND  p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* Tue Sep  7 11:56:05 EDT 2004 *)
+
+
+  ]);;
+  (* }}} *)
+
+let metric_continuous_continuous_top2 = prove_by_refinement(
+  `!f. (IMAGE f (euclid 2) SUBSET (euclid 2) ==>
+     (continuous f top2 top2 =
+         metric_continuous f (euclid 2,d_euclid) (euclid 2,d_euclid)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  metric_continuous_continuous;
+  ]);;
+  (* }}} *)
+
+let h_translate_cont = prove_by_refinement(
+  `!r. continuous (h_translate r) (top2) (top2)`,
+  (* {{{ proof *)
+  [
+  ALL_TAC;
+  TH_INTRO_TAC [`h_translate r`] metric_continuous_continuous_top2;
+  ASSUME_TAC h_translate_bij;
+  TSPEC `r` 0;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  REWRITE_TAC[IMAGE;SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[h_translate];
+  TH_INTRO_TAC[`2`;`x`;`y`;`r *# e1`] metric_translate;
+  REWRITE_TAC[e1;point_scale];
+  (* Tue Sep  7 12:09:30 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let v_translate_cont = prove_by_refinement(
+  `!r. continuous (v_translate r) (top2) (top2)`,
+  (* {{{ proof *)
+  [
+  ALL_TAC;
+  TH_INTRO_TAC [`v_translate r`] metric_continuous_continuous_top2;
+  ASSUME_TAC v_translate_bij;
+  TSPEC `r` 0;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  REWRITE_TAC[IMAGE;SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  REP_BASIC_TAC;
+  REWRITE_TAC[v_translate];
+  TH_INTRO_TAC[`2`;`x`;`y`;`r *# e2`] metric_translate;
+  REWRITE_TAC[e2;point_scale];
+  (* Tue Sep  7 12:10:54 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let r_scale_cont = prove_by_refinement(
+  `!r. (&0 < r) ==> (continuous (r_scale r) top2 top2)`,
+  (* {{{ proof *)
+  [
+  ALL_TAC;
+  TYPE_THEN `&0 < (&1 + r)` SUBAGOAL_TAC;
+  UND 0 THEN REAL_ARITH_TAC;
+  TH_INTRO_TAC[`r_scale r`] metric_continuous_continuous_top2;
+  ASSUME_TAC r_scale_bij;
+  TSPEC `r` 2;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  REWRITE_TAC[IMAGE;SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  TYPE_THEN `&1/(&1 + r)*epsilon` EXISTS_TAC;
+  TYPE_THEN `epsilon' = &1/(&1+r)*epsilon` ABBREV_TAC ;
+  TYPE_THEN `epsilon = (&1 + r)*epsilon'` SUBAGOAL_TAC;
+  TYPE_THEN `epsilon'` UNABBREV_TAC;
+  TYPE_THEN `epsilon` UNABBREV_TAC;
+  KILL 4;
+  SUBCONJ_TAC;
+  ASM_MESON_TAC[REAL_PROP_POS_LMUL];
+  USE 5(MATCH_MP point_onto);
+  TYPE_THEN `y` UNABBREV_TAC;
+  USE 6(MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `!x y. (r*x - r*y) pow 2 <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
+  REWRITE_TAC[GSYM REAL_SUB_LDISTRIB;REAL_POW_MUL ];
+  IMATCH_MP_TAC  REAL_LE_RMUL;
+  REWRITE_TAC[REAL_POW_2];
+  IMATCH_MP_TAC  ABS_SQUARE_LE;
+  UND 0 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[GSYM REAL_POW_MUL];
+  (* - *)
+  TYPE_THEN `!x y. (&1 pow 2) *((x - y) pow 2) <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LE_RMUL;
+  REWRITE_TAC[REAL_POW_2];
+  IMATCH_MP_TAC  ABS_SQUARE_LE;
+  UND 0 THEN  REAL_ARITH_TAC;
+  UND 6 THEN REDUCE_TAC;
+  (* - *)
+  TYPE_THEN `!x y. (&0 <= x) /\ (&0 <= y) ==> ((r*x + y) pow 2 <= ((&1 + r) pow 2) * ((x + y) pow 2))` SUBAGOAL_TAC;
+  REWRITE_TAC[GSYM REAL_POW_MUL];
+  REWRITE_TAC[REAL_POW_2];
+  IMATCH_MP_TAC  ABS_SQUARE_LE;
+  TYPE_THEN `abs  (r*x' + y') = r*x' + y'` SUBAGOAL_TAC;
+  REWRITE_TAC[ABS_REFL];
+  IMATCH_MP_TAC  REAL_LE_ADD;
+  ASM_MESON_TAC[REAL_LE_MUL;REAL_ARITH `&0 < x==> &0 <= x`];
+  ineq_le_tac `(r*x' + y') + x' + r*y'  = (&1 + r)*(x' + y')` ;
+  (* A - *)
+  TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2)) < (&1 + r) * epsilon'` SUBAGOAL_TAC;
+  TYPE_THEN `sqrt (((&1 + r)*epsilon') pow 2) = (&1 + r)*epsilon'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  POW_2_SQRT;
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  UND 7 THEN UND 1 THEN REAL_ARITH_TAC;
+  UND 9 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]);
+  IMATCH_MP_TAC SQRT_MONO_LT;
+  REWRITE_TAC[GSYM REAL_POW_MUL;REAL_ADD_LDISTRIB ];
+  REWRITE_TAC[REAL_POW_MUL;GSYM REAL_ADD_LDISTRIB ];
+  IMATCH_MP_TAC  REAL_LT_LMUL;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_PROP_POS_POW;
+  TH_INTRO_TAC [`(FST p' - FST p) pow 2 + (SND p' - SND p) pow 2`;`epsilon' pow 2`] (GSYM REAL_PROP_LT_SQRT);
+  TYPE_THEN `sqrt(epsilon' pow 2) = epsilon'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  POW_2_SQRT;
+  UND 7 THEN REAL_ARITH_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[d_euclid_point]);
+  (* - *)
+  IMATCH_MP_TAC  REAL_LET_TRANS;
+  TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2))` EXISTS_TAC;
+  (* B- *)
+  REWRITE_TAC[r_scale];
+  COND_CASES_TAC THEN COND_CASES_TAC;
+  UND 4 THEN  REWRITE_TAC[d_euclid_point];
+  IMATCH_MP_TAC  SQRT_MONO_LE;
+  (*  IMATCH_MP_TAC  REAL_LET_TRANS; *)
+  REWRITE_TAC[REAL_LDISTRIB];
+  IMATCH_MP_TAC  REAL_LE_ADD2;
+  (* 3 LEFT *)
+  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
+  TYPE_THEN `u = --. (FST p)` ABBREV_TAC ;
+  TYPE_THEN `FST p = -- u` SUBAGOAL_TAC;
+  UND 12 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_ARITH `x - --. y = x + y`];
+  IMATCH_MP_TAC  SQRT_MONO_LE;
+  REWRITE_TAC[REAL_LDISTRIB];
+  IMATCH_MP_TAC  REAL_LE_ADD2;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
+  (* 2 LEFT *)
+  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
+  TYPE_THEN `u = --. (FST p')` ABBREV_TAC ;
+  TYPE_THEN `FST p' = -- u` SUBAGOAL_TAC;
+  UND 12 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_ARITH `-- x -  v = -- (v + x)`;REAL_POW_NEG;EVEN2 ];
+  IMATCH_MP_TAC  SQRT_MONO_LE;
+  REWRITE_TAC[REAL_LDISTRIB];
+  IMATCH_MP_TAC  REAL_LE_ADD2;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
+  (* 1 LEFT *)
+  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
+  IMATCH_MP_TAC  SQRT_MONO_LE;
+  REWRITE_TAC[REAL_LDISTRIB];
+  IMATCH_MP_TAC  REAL_LE_ADD2;
+  (* Tue Sep  7 15:33:59 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let u_scale_cont = prove_by_refinement(
+  `!r. (&0 < r) ==> (continuous (u_scale r) top2 top2)`,
+  (* {{{ proof *)
+  [
+  ALL_TAC;
+  TYPE_THEN `&0 < (&1 + r)` SUBAGOAL_TAC;
+  UND 0 THEN REAL_ARITH_TAC;
+  TH_INTRO_TAC[`u_scale r`] metric_continuous_continuous_top2;
+  ASSUME_TAC u_scale_bij;
+  TSPEC `r` 2;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  REWRITE_TAC[IMAGE;SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  TYPE_THEN `&1/(&1 + r)*epsilon` EXISTS_TAC;
+  TYPE_THEN `epsilon' = &1/(&1+r)*epsilon` ABBREV_TAC ;
+  TYPE_THEN `epsilon = (&1 + r)*epsilon'` SUBAGOAL_TAC;
+  TYPE_THEN `epsilon'` UNABBREV_TAC;
+  TYPE_THEN `epsilon` UNABBREV_TAC;
+  KILL 4;
+  SUBCONJ_TAC;
+  ASM_MESON_TAC[REAL_PROP_POS_LMUL];
+  USE 5(MATCH_MP point_onto);
+  TYPE_THEN `y` UNABBREV_TAC;
+  USE 6(MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `!x y. (r*x - r*y) pow 2 <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
+  REWRITE_TAC[GSYM REAL_SUB_LDISTRIB;REAL_POW_MUL ];
+  IMATCH_MP_TAC  REAL_LE_RMUL;
+  REWRITE_TAC[REAL_POW_2];
+  IMATCH_MP_TAC  ABS_SQUARE_LE;
+  UND 0 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[GSYM REAL_POW_MUL];
+  (* - *)
+  TYPE_THEN `!x y. (&1 pow 2) *((x - y) pow 2) <= ((&1 + r) pow 2 ) * ((x - y) pow 2)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LE_RMUL;
+  REWRITE_TAC[REAL_POW_2];
+  IMATCH_MP_TAC  ABS_SQUARE_LE;
+  UND 0 THEN  REAL_ARITH_TAC;
+  UND 6 THEN REDUCE_TAC;
+  (* - *)
+  TYPE_THEN `!x y. (&0 <= x) /\ (&0 <= y) ==> ((r*x + y) pow 2 <= ((&1 + r) pow 2) * ((x + y) pow 2))` SUBAGOAL_TAC;
+  REWRITE_TAC[GSYM REAL_POW_MUL];
+  REWRITE_TAC[REAL_POW_2];
+  IMATCH_MP_TAC  ABS_SQUARE_LE;
+  TYPE_THEN `abs  (r*x' + y') = r*x' + y'` SUBAGOAL_TAC;
+  REWRITE_TAC[ABS_REFL];
+  IMATCH_MP_TAC  REAL_LE_ADD;
+  ASM_MESON_TAC[REAL_LE_MUL;REAL_ARITH `&0 < x==> &0 <= x`];
+  ineq_le_tac `(r*x' + y') + x' + r*y'  = (&1 + r)*(x' + y')` ;
+  (* A - *)
+  TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2)) < (&1 + r) * epsilon'` SUBAGOAL_TAC;
+  TYPE_THEN `sqrt (((&1 + r)*epsilon') pow 2) = (&1 + r)*epsilon'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  POW_2_SQRT;
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  UND 7 THEN UND 1 THEN REAL_ARITH_TAC;
+  UND 9 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]);
+  IMATCH_MP_TAC SQRT_MONO_LT;
+  REWRITE_TAC[GSYM REAL_POW_MUL;REAL_ADD_LDISTRIB ];
+  REWRITE_TAC[REAL_POW_MUL;GSYM REAL_ADD_LDISTRIB ];
+  IMATCH_MP_TAC  REAL_LT_LMUL;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_PROP_POS_POW;
+  TH_INTRO_TAC [`(FST p' - FST p) pow 2 + (SND p' - SND p) pow 2`;`epsilon' pow 2`] (GSYM REAL_PROP_LT_SQRT);
+  TYPE_THEN `sqrt(epsilon' pow 2) = epsilon'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  POW_2_SQRT;
+  UND 7 THEN REAL_ARITH_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[d_euclid_point]);
+  (* - *)
+  IMATCH_MP_TAC  REAL_LET_TRANS;
+  TYPE_THEN `sqrt ((&1 + r) pow 2 * ((FST p' - FST p) pow 2 + (SND p' - SND p) pow 2))` EXISTS_TAC;
+  (* B- *)
+  REWRITE_TAC[u_scale];
+  COND_CASES_TAC THEN COND_CASES_TAC;
+  UND 4 THEN  REWRITE_TAC[d_euclid_point];
+  IMATCH_MP_TAC  SQRT_MONO_LE;
+  (*  IMATCH_MP_TAC  REAL_LET_TRANS; *)
+  REWRITE_TAC[REAL_LDISTRIB];
+  IMATCH_MP_TAC  REAL_LE_ADD2;
+  (* 3 LEFT *)
+  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
+  TYPE_THEN `u = --. (SND p)` ABBREV_TAC ;
+  TYPE_THEN `SND p = -- u` SUBAGOAL_TAC;
+  UND 12 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_ARITH `x - --. y = x + y`];
+  IMATCH_MP_TAC  SQRT_MONO_LE;
+  REWRITE_TAC[REAL_LDISTRIB];
+  IMATCH_MP_TAC  REAL_LE_ADD2;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
+  (* 2 LEFT *)
+  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
+  TYPE_THEN `u = --. (SND p')` ABBREV_TAC ;
+  TYPE_THEN `SND p' = -- u` SUBAGOAL_TAC;
+  UND 12 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_ARITH `-- x -  v = -- (v + x)`;REAL_POW_NEG;EVEN2 ];
+  IMATCH_MP_TAC  SQRT_MONO_LE;
+  REWRITE_TAC[REAL_LDISTRIB];
+  IMATCH_MP_TAC  REAL_LE_ADD2;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 10 THEN UND 13 THEN UND 11 THEN REAL_ARITH_TAC;
+  (* 1 LEFT *)
+  UND 4 THEN (REWRITE_TAC [d_euclid_point]);
+  IMATCH_MP_TAC  SQRT_MONO_LE;
+  REWRITE_TAC[REAL_LDISTRIB];
+  IMATCH_MP_TAC  REAL_LE_ADD2;
+  (* Tue Sep  7 15:40:34 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let h_translate_hom = prove_by_refinement(
+  `!r. (homeomorphism (h_translate r) top2 top2)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  bicont_homeomorphism;
+  REWRITE_TAC[top2_unions;h_translate_bij;h_translate_cont];
+  IMATCH_MP_TAC  cont_domain;
+  REWRITE_TAC[top2_unions];
+  TYPE_THEN `h_translate (-- r)` EXISTS_TAC;
+  REWRITE_TAC[h_translate_inv;h_translate_cont];
+  (* Tue Sep  7 15:56:20 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let v_translate_hom = prove_by_refinement(
+  `!r. (homeomorphism (v_translate r) top2 top2)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  bicont_homeomorphism;
+  REWRITE_TAC[top2_unions;v_translate_bij;v_translate_cont];
+  IMATCH_MP_TAC  cont_domain;
+  REWRITE_TAC[top2_unions];
+  TYPE_THEN `v_translate (-- r)` EXISTS_TAC;
+  REWRITE_TAC[v_translate_inv;v_translate_cont];
+  (* Tue Sep  7 15:57:06 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let r_scale_hom = prove_by_refinement(
+  `!r. (&0 < r) ==> (homeomorphism (r_scale r) top2 top2)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  bicont_homeomorphism;
+  ASM_SIMP_TAC [top2_unions;r_scale_bij;r_scale_cont];
+  IMATCH_MP_TAC  cont_domain;
+  REWRITE_TAC[top2_unions];
+  TYPE_THEN `r_scale (&1/r)` EXISTS_TAC;
+  TYPE_THEN `&0 < &1/r` SUBAGOAL_TAC;
+  ASM_SIMP_TAC [r_scale_inv;r_scale_cont];
+  (* Tue Sep  7 16:00:14 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let u_scale_hom = prove_by_refinement(
+  `!r. (&0 < r) ==> (homeomorphism (u_scale r) top2 top2)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  bicont_homeomorphism;
+  ASM_SIMP_TAC [top2_unions;u_scale_bij;u_scale_cont];
+  IMATCH_MP_TAC  cont_domain;
+  REWRITE_TAC[top2_unions];
+  TYPE_THEN `u_scale (&1/r)` EXISTS_TAC;
+  TYPE_THEN `&0 < &1/r` SUBAGOAL_TAC;
+  ASM_SIMP_TAC [u_scale_inv;u_scale_cont];
+  (* Tue Sep  7 16:01:04 EDT 2004 *)
+
+
+  ]);;
+  (* }}} *)
+
+let h_translate_h = prove_by_refinement(
+  `!r. (h_compat (h_translate r))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[h_compat;h_translate;e1;point_scale;mk_line;IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  EQ_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  REDUCE_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
+  REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  REAL_ARITH_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  CONV_TAC (dropq_conv "x");
+  CONV_TAC (dropq_conv "x''");
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
+  REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  REAL_ARITH_TAC;
+  (* Tue Sep  7 16:13:50 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let v_translate_v = prove_by_refinement(
+  `!r. (v_compat (v_translate r))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[v_compat;v_translate;e2;point_scale;mk_line;IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  EQ_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  REDUCE_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
+  REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  REAL_ARITH_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  CONV_TAC (dropq_conv "x");
+  CONV_TAC (dropq_conv "x''");
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
+  REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  REAL_ARITH_TAC;
+  (* Tue Sep  7 16:15:33 EDT 2004 *)
+
+
+  ]);;
+  (* }}} *)
+
+let h_translate_v = prove_by_refinement(
+  `!r. (v_compat (h_translate r))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[v_compat;h_translate;e1;point_scale;mk_line;IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  EQ_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  REDUCE_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
+  REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  REAL_ARITH_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  CONV_TAC (dropq_conv "x");
+  CONV_TAC (dropq_conv "x''");
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
+  REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  REAL_ARITH_TAC;
+  (* Tue Sep  7 16:17:13 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let v_translate_h = prove_by_refinement(
+  `!r. (h_compat (v_translate r))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[h_compat;v_translate;e2;point_scale;mk_line;IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  EQ_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  REDUCE_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
+  REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  REAL_ARITH_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  CONV_TAC (dropq_conv "x");
+  CONV_TAC (dropq_conv "x''");
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
+  REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  REAL_ARITH_TAC;
+  (* Tue Sep  7 16:18:12 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let lin_solve_x = prove_by_refinement(
+  `!a  c. ~(c = &0) ==> (?t. c*t = a)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `a/c` EXISTS_TAC;
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let mk_line_pt = prove_by_refinement(
+  `!x. mk_line x x = {x}`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[mk_line;trivial_lin_combo];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING];
+  ]);;
+  (* }}} *)
+
+let h_compat_bij = prove_by_refinement(
+  `!f t. (BIJ f (euclid 2) (euclid 2) /\
+          (!x. f (point x) 1 = t + SND x) ==>
+    h_compat f)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[BIJ;h_compat];
+  TYPE_THEN `x = y` ASM_CASES_TAC;
+  REWRITE_TAC[mk_line_pt];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IMAGE;INR IN_SING];
+  EQ_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN`point y` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `!x. f (point x) = (point ( (f (point x)) 0, t + SND x ))` SUBAGOAL_TAC;
+  TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
+  USE 5 (MATCH_MP point_onto);
+  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
+  TSPEC `x'` 1;
+  REWR 1;
+  UND 1 THEN REWRITE_TAC[coord01];
+  (* A- *)
+  UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t));
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;];
+  TYPE_THEN `x'` UNABBREV_TAC;
+  UND 7 THEN REWRITE_TAC[mk_line];
+  TYPE_THEN `x''` UNABBREV_TAC;
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
+  TYPE_THEN `x' = (t' * FST x + (&1 - t') * FST y,t' * SND y + (&1 - t') * SND y)` ABBREV_TAC ;
+  TYPE_THEN `SND x' = SND y` SUBAGOAL_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  REAL_ARITH_TAC;
+  KILL 8;
+  COPY 5;
+  TSPEC `x'` 5;
+  UND 5 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
+  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
+  TH_INTRO_TAC[`f (point x') 0 - f(point y) 0`;`f (point x) 0 - f (point y) 0`] lin_solve_x;
+  TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC;
+  UND 8 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
+  REWRITE_TAC[point_inj ;PAIR_SPLIT ];
+  UND 5 THEN REAL_ARITH_TAC;
+  UND 4 THEN REWRITE_TAC[];
+  ONCE_REWRITE_TAC[GSYM point_inj];
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `t'` EXISTS_TAC;
+  CONJ_TAC;
+  UND 5 THEN REAL_ARITH_TAC;
+  REAL_ARITH_TAC;
+  (* - *)
+  REWRITE_TAC[mk_line;SUBSET;IMAGE];
+  CONV_TAC (dropq_conv "x''");
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `?u. (euclid_plus (t' *# point (f (point x) 0,t + SND y))  ((&1 - t') *# point (f (point y) 0,t + SND y))) = point (u , t + SND y)` SUBAGOAL_TAC;
+  REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;];
+  CONV_TAC (dropq_conv "u");
+  REAL_ARITH_TAC;
+  KILL 6;
+  (* - *)
+  TYPE_THEN `?x'. point(u, t + SND y) = f (point x')` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
+  TSPEC `point (u,t + SND y)` 2;
+  RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]);
+  USE 7 (MATCH_MP point_onto);
+  TYPE_THEN `y'` UNABBREV_TAC;
+  TYPE_THEN `p` EXISTS_TAC;
+  (* - *)
+  TH_INTRO_TAC[`FST x' - FST y`;`FST x - FST y`] lin_solve_x;
+  UND 4 THEN REWRITE_TAC[PAIR_SPLIT ];
+  UND 7 THEN REAL_ARITH_TAC;
+  TYPE_THEN `t'` EXISTS_TAC;
+  AP_TERM_TAC;
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;];
+  CONJ_TAC;
+  UND 7 THEN REAL_ARITH_TAC;
+  (* - *)
+  TSPEC `x'` 5;
+  TYPE_THEN `f (point x')` UNABBREV_TAC;
+  USE 5 (REWRITE_RULE[point_inj;PAIR_SPLIT;]);
+  UND 5 THEN REAL_ARITH_TAC;
+  (* Tue Sep  7 22:08:48 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let r_scale_h = prove_by_refinement(
+  `!r. (&0 < r) ==> (h_compat (r_scale r))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  h_compat_bij;
+  TYPE_THEN `&0` EXISTS_TAC;
+  REDUCE_TAC;
+  ASM_SIMP_TAC [r_scale_bij];
+  REWRITE_TAC[r_scale];
+  COND_CASES_TAC;
+  (* Tue Sep  7 22:11:42 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let h_compat_bij2 = prove_by_refinement(
+  `!f s. (BIJ f (euclid 2) (euclid 2) /\
+          (!x. f (point x) 1 = s(SND x)) /\ (INJ s UNIV UNIV) ==>
+    h_compat f)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[BIJ;h_compat];
+  TYPE_THEN `x = y` ASM_CASES_TAC;
+  REWRITE_TAC[mk_line_pt];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IMAGE;INR IN_SING];
+  EQ_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN`point y` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `!x. f (point x) = (point ( (f (point x)) 0, s(SND x) ))` SUBAGOAL_TAC;
+  TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
+  USE 6 (MATCH_MP point_onto);
+  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
+  TSPEC `x'` 2;
+  REWR 2;
+  UND 2 THEN REWRITE_TAC[coord01];
+  (* A- *)
+  UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t));
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;];
+  TYPE_THEN `x'` UNABBREV_TAC;
+  UND 8 THEN REWRITE_TAC[mk_line];
+  TYPE_THEN `x''` UNABBREV_TAC;
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
+  TYPE_THEN `x' = (t * FST x + (&1 - t) * FST y,t * SND y + (&1 - t) * SND y)` ABBREV_TAC ;
+  TYPE_THEN `SND x' = SND y` SUBAGOAL_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  REAL_ARITH_TAC;
+  KILL 9;
+  COPY 6;
+  TSPEC `x'` 6;
+  UND 6 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
+  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
+  TH_INTRO_TAC[`f (point x') 0 - f(point y) 0`;`f (point x) 0 - f (point y) 0`] lin_solve_x;
+  TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC;
+  UND 9 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
+  REWRITE_TAC[point_inj ;PAIR_SPLIT ];
+  UND 6 THEN REAL_ARITH_TAC;
+  UND 5 THEN REWRITE_TAC[];
+  ONCE_REWRITE_TAC[GSYM point_inj];
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `t` EXISTS_TAC;
+  CONJ_TAC;
+  UND 6 THEN REAL_ARITH_TAC;
+  REAL_ARITH_TAC;
+  (* - *)
+  REWRITE_TAC[mk_line;SUBSET;IMAGE];
+  CONV_TAC (dropq_conv "x''");
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `?u. (euclid_plus (t *# point (f (point x) 0,s(SND y)))  ((&1 - t) *# point (f (point y) 0,s(SND y)))) = point (u , s(SND y))` SUBAGOAL_TAC;
+  REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;];
+  CONV_TAC (dropq_conv "u");
+  REAL_ARITH_TAC;
+  ONCE_ASM_REWRITE_TAC [];
+  UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  (* - *)
+  TYPE_THEN `?x'. point(u, s(SND y)) = f (point x')` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
+  TSPEC `point (u,s(SND y))` 3;
+  RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]);
+  USE 8 (MATCH_MP point_onto);
+  TYPE_THEN `y'` UNABBREV_TAC;
+  TYPE_THEN `p` EXISTS_TAC;
+  (* B- *)
+  TH_INTRO_TAC[`FST x' - FST y`;`FST x - FST y`] lin_solve_x;
+  UND 5 THEN REWRITE_TAC[PAIR_SPLIT ];
+  UND 8 THEN REAL_ARITH_TAC;
+
+  TYPE_THEN `t` EXISTS_TAC;
+  AP_TERM_TAC;
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;];
+  CONJ_TAC;
+  UND 8 THEN REAL_ARITH_TAC;
+  (* - *)
+  TSPEC `x'` 6;
+  TYPE_THEN `f (point x')` UNABBREV_TAC;
+  USE 6 (REWRITE_RULE[point_inj;PAIR_SPLIT;]);
+  TYPE_THEN `SND y = SND x'` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 12 THEN REAL_ARITH_TAC;
+  (* Wed Sep  8 20:04:34 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let u_scale_h = prove_by_refinement(
+  `!r. (&0 < r) ==> (h_compat (u_scale r))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  h_compat_bij2;
+  TYPE_THEN `(\ z. if (&0 < z) then (r*z) else z)` EXISTS_TAC;
+  ASM_SIMP_TAC[u_scale_bij];
+  CONJ_TAC;
+  REWRITE_TAC[u_scale];
+  TYPE_THEN `&0 < SND x` ASM_CASES_TAC;
+  REWRITE_TAC[coord01];
+  TYPE_THEN `x = FST x, SND x` SUBAGOAL_TAC;
+  REWRITE_TAC[INJ];
+  UND 1 THEN COND_CASES_TAC THEN COND_CASES_TAC;
+  IMATCH_MP_TAC  REAL_EQ_LMUL_IMP;
+  UNIFY_EXISTS_TAC;
+  UND 0 THEN REAL_ARITH_TAC;
+  TYPE_THEN `y` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 2 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC REAL_PROP_POS_MUL2;
+  TYPE_THEN `x` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 3 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC REAL_PROP_POS_MUL2;
+  ]);;
+  (* }}} *)
+
+let v_compat_bij2 = prove_by_refinement(
+  `!f s. (BIJ f (euclid 2) (euclid 2) /\
+          (!x. f (point x) 0 = s(FST  x)) /\ (INJ s UNIV UNIV) ==>
+    v_compat f)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[BIJ;v_compat];
+  TYPE_THEN `x = y` ASM_CASES_TAC;
+  REWRITE_TAC[mk_line_pt];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IMAGE;INR IN_SING];
+  EQ_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN`point y` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `!x. f (point x) = point(s(FST x),  (f (point x)) 1 )` SUBAGOAL_TAC;
+  TYPE_THEN `euclid 2 (f (point x'))` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
+  USE 6 (MATCH_MP point_onto);
+  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
+  TSPEC `x'` 2;
+  REWR 2;
+  UND 2 THEN REWRITE_TAC[coord01];
+  (* A- *)
+  UND 5 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t] THEN (ASSUME_TAC t));
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;];
+  TYPE_THEN `x'` UNABBREV_TAC;
+  UND 8 THEN REWRITE_TAC[mk_line];
+  TYPE_THEN `x''` UNABBREV_TAC;
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add];
+  TYPE_THEN `x' = (t * FST y + (&1 - t) * FST y,t * SND x + (&1 - t) * SND y)` ABBREV_TAC ;
+  TYPE_THEN `FST  x' = FST  y` SUBAGOAL_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  REAL_ARITH_TAC;
+  KILL 9;
+  COPY 6;
+  TSPEC `x'` 6;
+  UND 6 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
+  REWRITE_TAC[point_inj ;PAIR_SPLIT;];
+  TH_INTRO_TAC[`f (point x') 1 - f(point y) 1`;`f (point x) 1 - f (point y) 1`] lin_solve_x;
+  TYPE_THEN `f (point x) = f (point y)` SUBAGOAL_TAC;
+  UND 9 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]));
+  REWRITE_TAC[point_inj ;PAIR_SPLIT ];
+  UND 6 THEN REAL_ARITH_TAC;
+  UND 5 THEN REWRITE_TAC[];
+  ONCE_REWRITE_TAC[GSYM point_inj];
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `t` EXISTS_TAC;
+  CONJ_TAC;
+  UND 6 THEN REAL_ARITH_TAC;
+  UND 6 THEN REAL_ARITH_TAC;
+  (* - *)
+  REWRITE_TAC[mk_line;SUBSET;IMAGE];
+  CONV_TAC (dropq_conv "x''");
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `?u. (euclid_plus (t *# (f (point x)))  ((&1 - t) *# (f (point y)))) = point ( s(FST  y), u)` SUBAGOAL_TAC;
+  ONCE_ASM_REWRITE_TAC[];
+  REWRITE_TAC[point_scale;point_add ;point_inj ; PAIR_SPLIT ;];
+  CONV_TAC (dropq_conv "u");
+    REAL_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `?x'. point( s(FST  y),u) = f (point x')` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SURJ]);
+  TSPEC `point (s(FST  y),u)` 3;
+  RULE_ASSUM_TAC (REWRITE_RULE[euclid_point]);
+  USE 9 (MATCH_MP point_onto);
+  TYPE_THEN `y'` UNABBREV_TAC;
+  TYPE_THEN `p` EXISTS_TAC;
+  (* B- *)
+  TH_INTRO_TAC[`SND  x' - SND  y`;`SND  x - SND  y`] lin_solve_x;
+  UND 5 THEN REWRITE_TAC[PAIR_SPLIT ];
+  UND 9 THEN REAL_ARITH_TAC;
+  TYPE_THEN `t'` EXISTS_TAC;
+  AP_TERM_TAC;
+  TYPE_THEN `x = FST x,SND x` SUBAGOAL_TAC;
+  TYPE_THEN `y = FST y,SND y` SUBAGOAL_TAC;
+  TYPE_THEN `x' = FST x',SND x'` SUBAGOAL_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN PURE_REWRITE_TAC[point_scale;point_add;point_inj;PAIR_SPLIT;];
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  CONJ_TAC;
+  UND 9 THEN REAL_ARITH_TAC;
+  (* - *)
+  TSPEC `x'` 6;
+  TYPE_THEN `f (point x')` UNABBREV_TAC;
+  USE 6 (REWRITE_RULE[point_inj;PAIR_SPLIT;]);
+  TYPE_THEN `FST  y = FST  x'` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 13 THEN REAL_ARITH_TAC;
+  (* Wed Sep  8 21:10:34 EDT 2004 *)
+
+
+  ]);;
+  (* }}} *)
+
+let r_scale_v = prove_by_refinement(
+  `!r. (&0 < r) ==> (v_compat (r_scale r))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  v_compat_bij2;
+  TYPE_THEN `(\ z. if (&0 < z) then (r*z) else z)` EXISTS_TAC;
+  ASM_SIMP_TAC[r_scale_bij];
+  CONJ_TAC;
+  REWRITE_TAC[r_scale];
+  TYPE_THEN `&0 < FST  x` ASM_CASES_TAC;
+  REWRITE_TAC[coord01];
+  TYPE_THEN `x = FST x, SND x` SUBAGOAL_TAC;
+  REWRITE_TAC[INJ];
+  UND 1 THEN COND_CASES_TAC THEN COND_CASES_TAC;
+  IMATCH_MP_TAC  REAL_EQ_LMUL_IMP;
+  UNIFY_EXISTS_TAC;
+  UND 0 THEN REAL_ARITH_TAC;
+  TYPE_THEN `y` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 2 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC REAL_PROP_POS_MUL2;
+  TYPE_THEN `x` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 3 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC REAL_PROP_POS_MUL2;
+  ]);;
+  (* }}} *)
+
+let u_scale_v = prove_by_refinement(
+  `!r. (&0 < r) ==> (v_compat (u_scale r))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  v_compat_bij2;
+  TYPE_THEN `(\ z.  &0 + z)` EXISTS_TAC;
+  ASM_SIMP_TAC[u_scale_bij];
+  REDUCE_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[u_scale];
+  COND_CASES_TAC;
+  REWRITE_TAC[INJ];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* SECTION Q *)
+(* ------------------------------------------------------------------ *)
+
+let mk_line_hyper2_fst = prove_by_refinement(
+  `!x y. (FST x = FST y) ==> (mk_line (point x) (point y) SUBSET
+    hyperplane 2 e1 (FST x))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[];
+  TYPE_THEN `x = y` ASM_CASES_TAC;
+  REWRITE_TAC[mk_line_pt;SUBSET;INR IN_SING ];
+  REWRITE_TAC[e1;GSYM line2D_F;SUBSET;mk_line;];
+  TYPE_THEN `y` EXISTS_TAC;
+  (* - *)
+  IMATCH_MP_TAC  (prove_by_refinement( `!A B. (A = B) ==> (A SUBSET (B:A->bool))`,[MESON_TAC[SUBSET_REFL]]));
+  REWRITE_TAC[GSYM mk_line_hyper2_e1];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  IMATCH_MP_TAC  mk_line_2;
+  REWRITE_TAC[mk_line_hyper2_e1;];
+  REWRITE_TAC[e1;GSYM line2D_F;point_inj;PAIR_SPLIT];
+  CONJ_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `y` EXISTS_TAC;
+  UND 1 THEN ASM_REWRITE_TAC[PAIR_SPLIT];
+  (* Thu Sep  9 10:13:23 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let mk_line_hyper2_snd = prove_by_refinement(
+  `!x y. (SND x = SND y) ==> (mk_line (point x) (point y) SUBSET
+    hyperplane 2 e2 (SND x))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[];
+  TYPE_THEN `x = y` ASM_CASES_TAC;
+  REWRITE_TAC[mk_line_pt;SUBSET;INR IN_SING ];
+  REWRITE_TAC[e2;GSYM line2D_S;SUBSET;mk_line;];
+  TYPE_THEN `y` EXISTS_TAC;
+  (* - *)
+  IMATCH_MP_TAC  (prove_by_refinement( `!A B. (A = B) ==> (A SUBSET (B:A->bool))`,[MESON_TAC[SUBSET_REFL]]));
+  REWRITE_TAC[GSYM mk_line_hyper2_e2];
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  IMATCH_MP_TAC  mk_line_2;
+  REWRITE_TAC[mk_line_hyper2_e2;];
+  REWRITE_TAC[e2;GSYM line2D_S;point_inj;PAIR_SPLIT];
+  CONJ_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `y` EXISTS_TAC;
+  UND 1 THEN ASM_REWRITE_TAC[PAIR_SPLIT];
+  (* Thu Sep  9 10:16:19 EDT 2004 *)
+  ]);;
+  (* }}} *)
+
+let hv_line_hyper = prove_by_refinement(
+  `!E e. hv_line E /\ E e ==> (?z.
+     (e SUBSET hyperplane 2 e1 z) \/ (e SUBSET  hyperplane 2 e2 z))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[hv_line];
+  TSPEC `e` 1;
+  REP_BASIC_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `FST y` EXISTS_TAC;
+  DISJ1_TAC;
+  USE 3 SYM;
+  IMATCH_MP_TAC  mk_line_hyper2_fst;
+  TYPE_THEN `SND x` EXISTS_TAC;
+  USE 3 SYM;
+  DISJ2_TAC;
+  IMATCH_MP_TAC  mk_line_hyper2_snd;
+  (* Thu Sep  9 10:20:05 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let hv_line_hyper2 = prove_by_refinement(
+  `!E. hv_line E /\ FINITE E ==> (?E'.
+   (UNIONS E SUBSET UNIONS E') /\ (FINITE E') /\
+   (!e. E' e ==>
+     (?z. (e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `!e. ?h. (E e ==> (e SUBSET h /\ (?z. (h = hyperplane 2 e1 z) \/ (h =  hyperplane 2 e2 z))))` SUBAGOAL_TAC;
+  RIGHT_TAC "h";
+  TH_INTRO_TAC[`E`;`e`] hv_line_hyper;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `z` EXISTS_TAC;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `z` EXISTS_TAC;
+  LEFT 2 "h";
+  TYPE_THEN `IMAGE h E` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[UNIONS;SUBSET;IMAGE];
+  CONV_TAC (dropq_conv "u");
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE]);
+  ASM_MESON_TAC[];
+  (* Thu Sep  9 10:32:28 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let finite_graph_edge = prove_by_refinement(
+  `!(G:(A,B)graph_t) (H:(A',B')graph_t). FINITE(graph_edge G) /\
+    graph_isomorphic G H ==> FINITE (graph_edge H)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_isomorphic;graph_iso];
+  ASM_MESON_TAC[FINITE_BIJ];
+  ]);;
+  (* }}} *)
+
+let finite_graph_vertex = prove_by_refinement(
+  `!(G:(A,B)graph_t) (H:(A',B')graph_t). FINITE(graph_vertex G) /\
+    graph_isomorphic G H ==> FINITE (graph_vertex H)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_isomorphic;graph_iso];
+  ASM_MESON_TAC[FINITE_BIJ];
+  ]);;
+  (* }}} *)
+
+let graph_edge_nonempty = prove_by_refinement(
+  `!(G:(A,B)graph_t) (H:(A',B')graph_t). ~(graph_edge G = EMPTY ) /\
+    graph_isomorphic G H ==> ~(graph_edge H  = EMPTY )`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_isomorphic;graph_iso];
+  USE 5 (REWRITE_RULE[EMPTY_EXISTS]);
+  UND 0 THEN (REWRITE_TAC [EMPTY_EXISTS]);
+  TYPE_THEN `v u'` EXISTS_TAC ;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  ]);;
+  (* }}} *)
+
+let graph_edge_around_finite = prove_by_refinement(
+  `!(G:(A,B)graph_t) v.
+        (FINITE (graph_edge G)) ==> (FINITE (graph_edge_around G v))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_edge_around];
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC[SUBSET];
+  ]);;
+  (* }}} *)
+
+let graph_edge_around4 = prove_by_refinement(
+  `!(G:(A,B)graph_t) (H:(A',B')graph_t). (graph G) /\
+        (FINITE (graph_edge G)) /\
+        (!v. CARD (graph_edge_around G v) <=| 4)  /\
+    graph_isomorphic G H ==> (!v. CARD (graph_edge_around H v) <=| 4)`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `graph_vertex H v` ASM_CASES_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE [graph_isomorphic]);
+  TYPE_THEN `?v'. (graph_vertex G v' /\ ((FST f) v' = v))` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT ;graph_iso]);
+  USE 6 (REWRITE_RULE[BIJ;SURJ]);
+  TYPE_THEN `v` UNABBREV_TAC;
+  TH_INTRO_TAC[`G`;`H`;`f`;`v'`] graph_iso_around;
+  TH_INTRO_TAC[`SND f`; `(graph_edge_around G v')`] CARD_IMAGE_LE;
+  IMATCH_MP_TAC  graph_edge_around_finite;
+  IMATCH_MP_TAC  LE_TRANS;
+  UNIFY_EXISTS_TAC;
+  ASM_MESON_TAC [ARITH_RULE `0 <=| 4`; CARD_CLAUSES;graph_isomorphic_graph;graph_edge_around_empty];
+  (* Thu Sep  9 11:49:01 EDT 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let graph_near_support = prove_by_refinement(
+  `!(G:(A,B)graph_t). (planar_graph G) /\
+         FINITE (graph_edge G) /\
+         FINITE (graph_vertex G) /\
+         ~(graph_edge G = {}) /\
+         (!v. CARD (graph_edge_around G v) <=| 4)
+         ==> (?H E. graph_isomorphic G H /\
+           (FINITE E) /\ (good_plane_graph H) /\
+        (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\
+        (!v. (graph_vertex H v ==>
+         E (hyperplane 2 e1 (v 0)) /\ E (hyperplane 2 e2 (v 1)))) /\
+         (!e. (E e ==>
+            (?z. (e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z)))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TH_INTRO_TAC[`G`] planar_graph_hv;
+  TYPE_THEN `H` EXISTS_TAC;
+  TYPE_THEN `A = IMAGE (\ v. hyperplane 2 e1 (v 0)) (graph_vertex H)` ABBREV_TAC ;
+  TYPE_THEN `B = IMAGE (\ v. hyperplane 2 e2 (v 1)) (graph_vertex H)` ABBREV_TAC ;
+  RULE_ASSUM_TAC (REWRITE_RULE[hv_finite]);
+  LEFT 5 "E";
+  LEFT 5 "E";
+  TYPE_THEN `?E'. !e. (graph_edge H e ==> (e SUBSET UNIONS (E' e)) /\ (FINITE (E' e)) /\ (!e'. E' e e' ==> (?z. (e' = hyperplane 2 e1 z) \/ (e' = hyperplane 2 e2 z))))` SUBAGOAL_TAC;
+  LEFT_TAC "e";
+  RIGHT_TAC "E'";
+  TSPEC `e` 5;
+  TH_INTRO_TAC[`E e`] hv_line_hyper2;
+  TYPE_THEN `E'` EXISTS_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `C = UNIONS (IMAGE E' (graph_edge H))` ABBREV_TAC ;
+  TYPE_THEN `A UNION B UNION C` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[FINITE_UNION];
+  CONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  IMATCH_MP_TAC  finite_graph_vertex;
+  UNIFY_EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  IMATCH_MP_TAC  finite_graph_vertex;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  TH_INTRO_TAC[`IMAGE E' (graph_edge H)`] FINITE_FINITE_UNIONS;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  IMATCH_MP_TAC  finite_graph_edge;
+  UNIFY_EXISTS_TAC;
+  USE 11 (REWRITE_RULE[IMAGE]);
+  ASM_MESON_TAC[];
+  (* - *)
+  CONJ_TAC;
+  REWRITE_TAC[UNIONS_UNION];
+  IMATCH_MP_TAC  in_union;
+  DISJ2_TAC;
+  IMATCH_MP_TAC  in_union;
+  DISJ2_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  TSPEC `e` 10;
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  UNIFY_EXISTS_TAC;
+  IMATCH_MP_TAC  UNIONS_UNIONS;
+  REWRITE_TAC[SUBSET;UNIONS;IMAGE;];
+  CONV_TAC (dropq_conv "u");
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  CONJ_TAC;
+  REWRITE_TAC[UNION];
+  TYPE_THEN  `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  CONJ_TAC;
+  DISJ1_TAC;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISJ2_TAC;
+  DISJ1_TAC;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  USE 12 (REWRITE_RULE[UNION]);
+  UND 12 THEN REP_CASES_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  USE 12 (REWRITE_RULE[IMAGE]);
+  MESON_TAC[];
+  TYPE_THEN `B` UNABBREV_TAC;
+  USE 12 (REWRITE_RULE[IMAGE]);
+  MESON_TAC[];
+  TYPE_THEN `C` UNABBREV_TAC;
+  USE 12 (REWRITE_RULE[IMAGE;UNIONS]);
+  TYPE_THEN `u` UNABBREV_TAC;
+  TSPEC `x` 10;
+  (* Thu Sep  9 12:12:51 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let h_translate_point = prove_by_refinement(
+  `!u v r. (h_translate r (point (u,v)) = point (u+r,v))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[h_translate;e1;point_scale;point_add];
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let v_translate_point = prove_by_refinement(
+  `!u v r. (v_translate r (point (u,v)) = point (u,v + r))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[v_translate;e2;point_scale;point_add];
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let hyperplane1_h_translate = prove_by_refinement(
+  `!z r. (IMAGE (h_translate r) (hyperplane 2 e1 z) =
+            (hyperplane 2 e1 (z + r)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM mk_line_hyper2_e1];
+  ASSUME_TAC v_compat;
+  TSPEC `(h_translate r)` 0;
+  RULE_ASSUM_TAC (REWRITE_RULE[h_translate_v]);
+  UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[`z, &0`;`z, &1`]));
+  REWRITE_TAC[h_translate_point];
+  ]);;
+  (* }}} *)
+
+let hyperplane2_h_translate = prove_by_refinement(
+  `!z r. (IMAGE (h_translate r) (hyperplane 2 e2 z) =
+            (hyperplane 2 e2 z))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM mk_line_hyper2_e2];
+  ASSUME_TAC h_compat;
+  TSPEC `(h_translate r)` 0;
+  RULE_ASSUM_TAC (REWRITE_RULE[h_translate_h]);
+  UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[` &0,z`;` &1,z`]));
+  REWRITE_TAC[h_translate_point];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  mk_line_2;
+  REWRITE_TAC[mk_line_hyper2_e2;];
+  REWRITE_TAC[GSYM line2D_S;e2;point_inj ];
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "p");
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "p");
+   RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT]);
+  UND 1 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let hyperplane2_v_translate = prove_by_refinement(
+  `!z r. (IMAGE (v_translate r) (hyperplane 2 e2 z) =
+            (hyperplane 2 e2 (z + r)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM mk_line_hyper2_e2];
+  ASSUME_TAC h_compat;
+  TSPEC `(v_translate r)` 0;
+  RULE_ASSUM_TAC (REWRITE_RULE[v_translate_h]);
+  UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[`&0,z`;`&1,z`]));
+  REWRITE_TAC[v_translate_point];
+  ]);;
+  (* }}} *)
+
+let hyperplane1_v_translate = prove_by_refinement(
+  `!z r. (IMAGE (v_translate r) (hyperplane 2 e1 z) =
+            (hyperplane 2 e1 z))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM mk_line_hyper2_e1];
+  ASSUME_TAC v_compat;
+  TSPEC `(v_translate r)` 0;
+  RULE_ASSUM_TAC (REWRITE_RULE[v_translate_v]);
+  UND 0 THEN (DISCH_THEN (TH_INTRO_TAC[` z,&0`;`z,&1`]));
+  REWRITE_TAC[v_translate_point];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  mk_line_2;
+  REWRITE_TAC[mk_line_hyper2_e1;];
+  REWRITE_TAC[GSYM line2D_F;e1;point_inj ];
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "p");
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "p");
+   RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT]);
+  UND 1 THEN REAL_ARITH_TAC;
+  (* Thu Sep  9 13:43:45 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let r_scale_point = prove_by_refinement(
+  `!r u v. (r_scale r (point (u,v))) =
+  point ((if (&0 < u) then r*u else u),v)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[r_scale];
+  TYPE_THEN `&0  < u` ASM_CASES_TAC;
+  ]);;
+  (* }}} *)
+
+let u_scale_point = prove_by_refinement(
+  `!r u v. (u_scale r (point (u,v))) =
+  point (u,(if (&0 < v) then r*v else v))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[u_scale];
+  TYPE_THEN `&0  < v` ASM_CASES_TAC;
+  ]);;
+  (* }}} *)
+
+let hyperplane2_r_scale = prove_by_refinement(
+  `!z r. (&0 < r) ==> (IMAGE (r_scale r) (hyperplane 2 e2 z) =
+             (hyperplane 2 e2 z))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM mk_line_hyper2_e2];
+  ASSUME_TAC h_compat;
+  TSPEC `(r_scale r)` 1;
+  TYPE_THEN `h_compat(r_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[r_scale_h];ALL_TAC];
+  REWR 1;
+  UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[` &0,z`;`&1,z`]));
+  REWRITE_TAC[r_scale_point];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  mk_line_2;
+  REWRITE_TAC[REAL_ARITH `~(&0 < &0)`];
+  REWRITE_TAC[mk_line_hyper2_e2;];
+  REWRITE_TAC[GSYM line2D_S;e2;point_inj ];
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "p");
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "p");
+  RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;REAL_ARITH `r * &1 = r`]);
+  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let hyperplane1_r_scale = prove_by_refinement(
+  `!z r. (&0 < r) ==> (IMAGE (r_scale r) (hyperplane 2 e1 z) =
+             (hyperplane 2 e1 (if &0 < z then r*z else z)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM mk_line_hyper2_e1];
+  ASSUME_TAC v_compat;
+  TSPEC `(r_scale r)` 1;
+  TYPE_THEN `v_compat(r_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[r_scale_v];ALL_TAC];
+  REWR 1;
+  UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[`z,&0`;`z,&1`]));
+  REWRITE_TAC[r_scale_point];
+  ]);;
+  (* }}} *)
+
+let hyperplane1_u_scale = prove_by_refinement(
+  `!z r. (&0 < r) ==> (IMAGE (u_scale r) (hyperplane 2 e1 z) =
+             (hyperplane 2 e1 z))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM mk_line_hyper2_e1];
+  ASSUME_TAC v_compat;
+  TSPEC `(u_scale r)` 1;
+  TYPE_THEN `v_compat(u_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[u_scale_v];ALL_TAC];
+  REWR 1;
+  UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[` z,&0`;`z,&1`]));
+  REWRITE_TAC[u_scale_point];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  mk_line_2;
+  REWRITE_TAC[REAL_ARITH `~(&0 < &0)`];
+  REWRITE_TAC[mk_line_hyper2_e1;];
+  REWRITE_TAC[GSYM line2D_F;e1;point_inj ];
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "p");
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "p");
+  RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;REAL_ARITH `r * &1 = r`]);
+  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let hyperplane2_u_scale = prove_by_refinement(
+  `!z r. (&0 < r) ==> (IMAGE (u_scale r) (hyperplane 2 e2 z) =
+             (hyperplane 2 e2 (if &0 < z then r*z else z)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM mk_line_hyper2_e2];
+  ASSUME_TAC h_compat;
+  TSPEC `(u_scale r)` 1;
+  TYPE_THEN `h_compat(u_scale r)` SUBAGOAL_TAC THENL [ASM_MESON_TAC[u_scale_h];ALL_TAC];
+  REWR 1;
+  UND 1 THEN (DISCH_THEN (TH_INTRO_TAC[`&0,z`;`&1,z`]));
+  REWRITE_TAC[u_scale_point];
+  (* Thu Sep  9 14:04:58 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let homeomorphism_compose = prove_by_refinement(
+  `!U V W (f:A->B) (g:B->C). homeomorphism f U V /\ homeomorphism g V W
+   ==>
+   homeomorphism (g o f) U W`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[homeomorphism];
+  SUBCONJ_TAC;
+  REWRITE_TAC[comp_comp];
+  IMATCH_MP_TAC  COMP_BIJ;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  continuous_comp;
+  UNIFY_EXISTS_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ;SURJ]);
+  REWRITE_TAC[IMAGE;SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  REWRITE_TAC[IMAGE_o];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ]);;
+  (* }}} *)
+
+let hyperplane1_inj = prove_by_refinement(
+  `!z w. (hyperplane 2 e1 z = hyperplane 2 e1 w) ==> (z = w)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[e1; GSYM line2D_F];
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 0 (REWRITE_RULE[]);
+  TSPEC `point(z,&0)` 0;
+  RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
+  USE 0 SYM;
+  TYPE_THEN `(?p. (z,&0 = p) /\ (FST p = z))` SUBAGOAL_TAC;
+  CONV_TAC (dropq_conv "p");
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let hyperplane2_inj = prove_by_refinement(
+  `!z w. (hyperplane 2 e2 z = hyperplane 2 e2 w) ==> (z = w)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[e2; GSYM line2D_S];
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 0 (REWRITE_RULE[]);
+  TSPEC `point(z,z)` 0;
+  RULE_ASSUM_TAC (REWRITE_RULE[point_inj]);
+  USE 0 SYM;
+  TYPE_THEN `(?p. (z,z = p) /\ (SND p = z))` SUBAGOAL_TAC;
+  CONV_TAC (dropq_conv "p");
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let graph_support_init = prove_by_refinement(
+  `!(G:(A,B)graph_t). (planar_graph G) /\
+         FINITE (graph_edge G) /\
+         FINITE (graph_vertex G) /\
+         ~(graph_edge G = {}) /\
+         (!v. CARD (graph_edge_around G v) <=| 4)
+         ==> (?H E. graph_isomorphic G H /\
+           (FINITE E) /\ (good_plane_graph H) /\
+        (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\
+        (!v. (graph_vertex H v ==>
+         E (hyperplane 2 e1 (v 0)) /\ E (hyperplane 2 e2 (v 1)))) /\
+         (!e. (E e ==>
+            (?z. (&0 < z) /\
+               ((e = hyperplane 2 e1 z) \/ (e = hyperplane 2 e2 z))))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TH_INTRO_TAC[`G`] graph_near_support;
+  TYPE_THEN `EH = E INTER { h | ?z. (h = hyperplane 2 e1 z) }` ABBREV_TAC ;
+  TYPE_THEN `EV = E INTER {h | ?z. (h = hyperplane 2 e2 z) }` ABBREV_TAC ;
+  TYPE_THEN `E = EH UNION EV` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `EH` UNABBREV_TAC;
+  TYPE_THEN `EV` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;INTER;UNION];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[UNION;SUBSET];
+  TYPE_THEN `EH` UNABBREV_TAC;
+  TYPE_THEN `EV` UNABBREV_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INTER;GSYM LEFT_AND_OVER_OR]);
+  (* - *)
+  TYPE_THEN `FINITE EH /\ FINITE EV` SUBAGOAL_TAC;
+  USE 13 SYM;
+  USE 13 (MATCH_MP union_imp_subset);
+  ASM_MESON_TAC[FINITE_SUBSET];
+(*** Modified by JRH for new theorem name
+  TH_INTRO_TAC[`(\ z. (hyperplane 2 e1 z))`;`UNIV:real->bool`;`EH`] FINITE_SUBSET_IMAGE;
+ ***)
+  TH_INTRO_TAC[`(\ z. (hyperplane 2 e1 z))`;`UNIV:real->bool`;`EH`] FINITE_SUBSET_IMAGE_IMP;
+  TYPE_THEN `EH` UNABBREV_TAC;
+  REWRITE_TAC[INTER;SUBSET;IMAGE;UNIV];
+(*** Modified by JRH for new theorem name
+  TH_INTRO_TAC[`(\ z. (hyperplane 2 e2 z))`;`UNIV:real->bool`;`EV`] FINITE_SUBSET_IMAGE;
+ ***)
+  TH_INTRO_TAC[`(\ z. (hyperplane 2 e2 z))`;`UNIV:real->bool`;`EV`] FINITE_SUBSET_IMAGE_IMP;
+  TYPE_THEN `EV` UNABBREV_TAC;
+  REWRITE_TAC[INTER;SUBSET;IMAGE;UNIV];
+  (* - *)
+  WITH 21 (MATCH_MP finite_LB);
+  WITH 18 (MATCH_MP finite_LB);
+  TYPE_THEN `f = (h_translate (&1 - t')) o (v_translate (&1 - t))` ABBREV_TAC ;
+  TYPE_THEN `plane_graph_image f H` EXISTS_TAC;
+  TYPE_THEN `IMAGE2 f E` EXISTS_TAC;
+  (* A- *)
+  TYPE_THEN `homeomorphism f top2 top2` SUBAGOAL_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  IMATCH_MP_TAC  homeomorphism_compose;
+  TYPE_THEN `top2` EXISTS_TAC;
+  REWRITE_TAC[v_translate_hom;h_translate_hom];
+  (* - *)
+  TYPE_THEN `graph_isomorphic H (plane_graph_image f H)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  plane_graph_image_iso;
+  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph]);
+  (* - *)
+  CONJ_TAC;
+  TH_INTRO_TAC[`G`;`H`;`plane_graph_image f H`] graph_isomorphic_trans;
+  (* - *)
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE2];
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  ASM_REWRITE_TAC[FINITE_UNION];
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  plane_graph_image_plane;
+  (* B- *)
+  TYPE_THEN `!z. IMAGE  f (hyperplane 2 e1 z) = hyperplane 2 e1 (z - t' + &1)` SUBAGOAL_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE_o;hyperplane1_v_translate;hyperplane1_h_translate];
+  AP_TERM_TAC;
+  REAL_ARITH_TAC;
+  TYPE_THEN `!z. IMAGE f (hyperplane 2 e2 z) = hyperplane 2 e2 (z - t + &1)` SUBAGOAL_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE_o;hyperplane2_v_translate;hyperplane2_h_translate];
+  AP_TERM_TAC;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[IMAGE2;GSYM image_unions;];
+  REWRITE_TAC[plane_graph_image_e;plane_graph_image_v;IMAGE2];
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
+  USE 29 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `g` UNABBREV_TAC;
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  USE 13 GSYM;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* C- *)
+  USE 13 GSYM;
+  CONJ_TAC;
+  USE 29 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[good_plane_graph;plane_graph;SUBSET]);
+  USE 31 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `v` UNABBREV_TAC;
+  TYPE_THEN `f (point p) = point(FST p - t' + &1 , SND p  - t + &1)` SUBAGOAL_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  TYPE_THEN `p = FST p,SND p` SUBAGOAL_TAC;
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN  PURE_REWRITE_TAC[h_translate_point;v_translate_point;o_DEF ;];
+  PURE_ONCE_ASM_REWRITE_TAC[] THEN  PURE_REWRITE_TAC[h_translate_point;v_translate_point;o_DEF ;];
+  REWRITE_TAC[point_inj ;PAIR_SPLIT];
+  REAL_ARITH_TAC;
+  USE 28 GSYM ;
+  USE 27 GSYM;
+  TSPEC `point p` 6;
+  CONJ_TAC;
+  IMATCH_MP_TAC  image_imp;
+  RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
+  IMATCH_MP_TAC  image_imp;
+  RULE_ASSUM_TAC (REWRITE_RULE[coord01]);
+  (* D- *)
+  TYPE_THEN `g = IMAGE f` ABBREV_TAC ;
+  USE 29 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `EH x \/ EV x` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[UNION]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `EH` UNABBREV_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `z - t' + &1` EXISTS_TAC;
+  TYPE_THEN `s' z` SUBAGOAL_TAC;
+  USE 16 (REWRITE_RULE[SUBSET;IMAGE]);
+  TSPEC `x` 16;
+  REWR 16;
+  LEFT 16 "z'";
+  TSPEC `z` 16;
+  REWR 16;
+  TYPE_THEN `z = x'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  hyperplane1_inj;
+  ASM_REWRITE_TAC[];
+  TSPEC `z` 23;
+  UND 23 THEN REAL_ARITH_TAC;
+  TYPE_THEN `EV` UNABBREV_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `z - t + &1` EXISTS_TAC;
+  TYPE_THEN `s'' z` SUBAGOAL_TAC;
+  USE 19 (REWRITE_RULE[SUBSET;IMAGE]);
+  TSPEC `x` 19;
+  REWR 19;
+  LEFT 19 "z'";
+  TSPEC `z` 19;
+  REWR 19;
+  TYPE_THEN `z = x'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  hyperplane2_inj;
+  ASM_REWRITE_TAC[];
+  TSPEC `z` 22;
+  UND 22 THEN REAL_ARITH_TAC;
+  (* Thu Sep  9 17:00:37 EDT 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let hyperplane_ne = prove_by_refinement(
+  `!z z'. ~(hyperplane 2 e1 z = hyperplane 2 e2 z')`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[e1;e2;GSYM line2D_S;GSYM line2D_F];
+  RULE_ASSUM_TAC (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `point(z, z'+ &1)` 0;
+  REWR 0;
+  RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;point_inj]);
+  USE 0 SYM;
+  TYPE_THEN `(?p. ((z = FST p) /\ (z' + &1 = SND p)) /\ (FST p = z))` SUBAGOAL_TAC;
+  TYPE_THEN `(z,z' + &1)` EXISTS_TAC;
+  ASSUME_TAC (REAL_ARITH `~(z' + &1 = z')`);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* SECTION R *)
+(* ------------------------------------------------------------------ *)
+
+
+extend_simp_rewrites[UNION_EMPTY ];;
+
+let inductive_set_restrict = prove_by_refinement(
+  `!G A S. inductive_set G S /\
+     ~(S INTER A = EMPTY) /\
+     segment A /\ A SUBSET G ==> inductive_set A (S INTER A)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[inductive_set];
+  CONJ_TAC;
+  REWRITE_TAC[INTER;SUBSET];
+  REWRITE_TAC[INTER];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  RULE_ASSUM_TAC (REWRITE_RULE[INTER]);
+  UNIFY_EXISTS_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  ]);;
+  (* }}} *)
+
+let inductive_set_adj = prove_by_refinement(
+  `!A B S m. inductive_set (A UNION B) S /\ (endpoint B m) /\
+   (FINITE A) /\ (FINITE B) /\
+   (endpoint A m) /\ (A SUBSET S) ==> (~(S INTER B = EMPTY)) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `?e. A e /\ closure top2 e (pointI m)` SUBAGOAL_TAC;
+  TYPE_THEN `terminal_edge A m` EXISTS_TAC;
+  IMATCH_MP_TAC  terminal_endpoint;
+  TYPE_THEN `?e'. B e' /\ closure top2 e' (pointI m)` SUBAGOAL_TAC;
+  TYPE_THEN `terminal_edge B m` EXISTS_TAC;
+  IMATCH_MP_TAC  terminal_endpoint;
+  RULE_ASSUM_TAC (REWRITE_RULE[inductive_set]);
+  TSPEC `e` 6;
+  TSPEC `e'` 6;
+  (* - *)
+  TYPE_THEN `e = e'` ASM_CASES_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[SUBSET ;EQ_EMPTY;INTER; ]);
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `S e /\ (A UNION B) e' /\ adj e e'` SUBAGOAL_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  CONJ_TAC;
+  REWRITE_TAC[UNION];
+  REWRITE_TAC[adj];
+  REWRITE_TAC[EMPTY_EXISTS;INTER;];
+  UNIFY_EXISTS_TAC;
+  REWR 6;
+  RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY ;INTER]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let inductive_set_join = prove_by_refinement(
+  `!A B S . ~(S INTER A = EMPTY) /\ (segment B) /\ (segment A) /\
+      (?m. endpoint A m /\ endpoint B m) /\
+      (inductive_set (A UNION B) S)  ==>
+    (S = (A UNION B))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TH_INTRO_TAC[`A UNION B`;`A`;`S`] inductive_set_restrict;
+  REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `(S INTER A) = A` SUBAGOAL_TAC;
+  USE 6 (REWRITE_RULE[inductive_set]);
+  USE 3 (REWRITE_RULE[segment]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `A SUBSET S` SUBAGOAL_TAC;
+  UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[INTER;SUBSET];
+  (* - *)
+  TH_INTRO_TAC [`A`;`B`;`S`;`m`] inductive_set_adj;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  (* - *)
+  TH_INTRO_TAC[`A UNION B`;`B`;`S`] inductive_set_restrict;
+  REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `(S INTER B) = B` SUBAGOAL_TAC;
+  USE 10 (REWRITE_RULE[inductive_set]);
+  USE 4 (REWRITE_RULE[segment]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `B SUBSET S` SUBAGOAL_TAC;
+  UND 11 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[INTER;SUBSET];
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  USE 0 (REWRITE_RULE[inductive_set]);
+  REWRITE_TAC[union_subset];
+  ]);;
+  (* }}} *)
+
+let segment_union = prove_by_refinement(
+  `!A B m. segment A /\ segment B /\
+     endpoint A m /\ endpoint B m /\
+     (A INTER B = EMPTY) /\
+  (!n. (0 < num_closure A (pointI n)) /\
+          (0 < num_closure B (pointI n)) ==> (n = m) )
+    ==>
+    segment (A UNION B)` ,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  (* - *)
+  TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  (* - *)
+  REWRITE_TAC[segment];
+  ASM_REWRITE_TAC[FINITE_UNION];
+  (* - *)
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
+  UND 8 THEN REWRITE_TAC[EMPTY_EXISTS;UNION];
+  TYPE_THEN `u` EXISTS_TAC;
+  (* - *)
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  (* - *)
+  TYPE_THEN `!m'. { C | (A UNION B) C /\ closure top2 C (pointI m')} = {C | A C /\ closure top2 C (pointI m')} UNION {C | B C /\ closure top2 C (pointI m')}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  TYPE_THEN `A x` ASM_CASES_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER]);
+  TSPEC `x` 1;
+  REWR 1;
+  TYPE_THEN `!m. num_closure(A UNION B) (pointI m) =  num_closure A (pointI m) + num_closure B (pointI m)` SUBAGOAL_TAC;
+  REWRITE_TAC[num_closure];
+  IMATCH_MP_TAC  (CARD_UNION);
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `A` EXISTS_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  REWRITE_TAC[SUBSET];
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `B` EXISTS_TAC;
+  REWRITE_TAC[SUBSET];
+  REWRITE_TAC[EQ_EMPTY ];
+  RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER ]);
+  ASM_MESON_TAC[];
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `num_closure A (pointI m') = 0` ASM_CASES_TAC;
+  REDUCE_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  TYPE_THEN `num_closure B (pointI m') = 0` ASM_CASES_TAC;
+  REDUCE_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  UND 10 THEN UND 11 THEN REWRITE_TAC [ARITH_RULE  `~(x = 0) <=> (0 < x)`];
+  TYPE_THEN `m' = m` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  RULE_ASSUM_TAC (REWRITE_RULE[endpoint]);
+  REWRITE_TAC[ARITH_RULE `1+ 1 = 2`;INR IN_INSERT];
+  (* -A *)
+  TYPE_THEN `inductive_set (A UNION B) S` SUBAGOAL_TAC;
+  REWRITE_TAC[inductive_set];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~(S INTER A = EMPTY)` ASM_CASES_TAC;
+  (* -- cut here *)
+  IMATCH_MP_TAC  inductive_set_join;
+  UNIFY_EXISTS_TAC;
+  REWR 14;
+  TYPE_THEN `~(S INTER B = EMPTY)` SUBAGOAL_TAC;
+  UND 15 THEN UND 14 THEN UND 11 THEN UND 12 THEN REWRITE_TAC[INTER;EQ_EMPTY;SUBSET;UNION] THEN MESON_TAC[];
+  (* - *)
+  ONCE_REWRITE_TAC [UNION_COMM];
+  IMATCH_MP_TAC  inductive_set_join;
+  ONCE_REWRITE_TAC [UNION_COMM];
+  UNIFY_EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+let two_endpoint_segment = prove_by_refinement(
+  `!C p q m. segment C /\ endpoint C q /\ endpoint C p /\ endpoint C m /\
+     ~(m = p) ==>
+      (q = m) \/ (q = p)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `psegment C` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  endpoint_psegment;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  TH_INTRO_TAC[`C`] endpoint_size2;
+  IMATCH_MP_TAC  (TAUT `(~A ==> B) ==> (A \/ B)`);
+  IMATCH_MP_TAC  two_exclusion;
+  UNIFY_EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+let EQ_ANTISYM = prove_by_refinement(
+  `!A B. (A ==>B) /\ (B ==> A) ==> (A = B)`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let segment_union2 = prove_by_refinement(
+  `!A B m p. segment A /\ segment B /\ ~(m = p) /\
+     endpoint A m /\ endpoint B m /\
+     endpoint A p /\ endpoint B p /\
+     (A INTER B = EMPTY) /\
+  (!n. (0 < num_closure A (pointI n)) /\ (0 < num_closure B (pointI n)) <=>
+          (((n = m ) \/ (n = p) )))
+    ==>
+    rectagon (A UNION B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  (* - *)
+  REWRITE_TAC[rectagon];
+  ASM_REWRITE_TAC[FINITE_UNION];
+  (* - *)
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  RULE_ASSUM_TAC (REWRITE_RULE[EMPTY_EXISTS]);
+  UND 11 THEN REWRITE_TAC[EMPTY_EXISTS;UNION];
+  TYPE_THEN `u` EXISTS_TAC;
+  (* - *)
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  (* - *)
+  TYPE_THEN `!m'. { C | (A UNION B) C /\ closure top2 C (pointI m')} = {C | A C /\ closure top2 C (pointI m')} UNION {C | B C /\ closure top2 C (pointI m')}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  TYPE_THEN `A x` ASM_CASES_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER]);
+  TSPEC `x` 1;
+  REWR 1;
+  (* - *)
+  TYPE_THEN `!m. num_closure(A UNION B) (pointI m) =  num_closure A (pointI m) + num_closure B (pointI m)` SUBAGOAL_TAC;
+  REWRITE_TAC[num_closure];
+  IMATCH_MP_TAC  (CARD_UNION);
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `A` EXISTS_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  REWRITE_TAC[SUBSET];
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `B` EXISTS_TAC;
+  REWRITE_TAC[SUBSET];
+  REWRITE_TAC[EQ_EMPTY ];
+  RULE_ASSUM_TAC (REWRITE_RULE[EQ_EMPTY;INTER ]);
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!q. endpoint A q ==> (q = m) \/ (q = p)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC two_endpoint_segment;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `!q. endpoint B q ==> (q = m) \/ (q = p)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC two_endpoint_segment;
+  TYPE_THEN  `B` EXISTS_TAC;
+  UNIFY_EXISTS_TAC;
+  (* -A *)
+  TYPE_THEN `!m. (num_closure A (pointI m) = 1) <=> (num_closure B (pointI m) = 1)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  RULE_ASSUM_TAC (REWRITE_RULE[endpoint]);
+  CONJ_TAC;
+  TSPEC `m'` 13;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  TSPEC `m'` 14;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  FULL_REWRITE_TAC[endpoint];
+  TYPE_THEN `!x. {0, 2} x <=> {0, 1, 2} x /\ ~(x = 1)` SUBAGOAL_TAC;
+  REWRITE_TAC[INSERT];
+  ARITH_TAC;
+  KILL 16;
+  TYPE_THEN `num_closure A (pointI m') = 0` ASM_CASES_TAC;
+  REDUCE_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  TSPEC `m'` 15;
+  REWR 25;
+  UND 25 THEN ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `num_closure B (pointI m') = 0` ASM_CASES_TAC;
+  REDUCE_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[segment]);
+  ARITH_TAC;
+  FULL_REWRITE_TAC [ARITH_RULE  `~(x = 0) <=> (0 < x)`];
+  TYPE_THEN `(m' = m) \/ (m' = p)` SUBAGOAL_TAC;
+  TSPEC `m'` 0;
+  REWR 0;
+  TYPE_THEN `num_closure A (pointI m') = 1` SUBAGOAL_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `num_closure B (pointI m') = 1` SUBAGOAL_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[ARITH_RULE `1+ 1 = 2`;INR IN_INSERT;ARITH_RULE `~(2 = 1)`];
+  (* - *)
+  TYPE_THEN `inductive_set (A UNION B) S` SUBAGOAL_TAC;
+  REWRITE_TAC[inductive_set];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~(S INTER A = EMPTY)` ASM_CASES_TAC;
+  (* -- *)
+  IMATCH_MP_TAC  inductive_set_join;
+  UNIFY_EXISTS_TAC;
+  REWR 20;
+  TYPE_THEN `~(S INTER B = EMPTY)` SUBAGOAL_TAC;
+  UND 20 THEN UND 21 THEN UND 17 THEN UND 18 THEN REWRITE_TAC[INTER;EQ_EMPTY;SUBSET;UNION] THEN MESON_TAC[];
+  (* - *)
+  ONCE_REWRITE_TAC [UNION_COMM];
+  IMATCH_MP_TAC  inductive_set_join;
+  ONCE_REWRITE_TAC [UNION_COMM];
+  UNIFY_EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+let card_inj = prove_by_refinement(
+  `!(f:A->B) A B. INJ f A B /\ FINITE B ==> (CARD A <= CARD B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `CARD (IMAGE f A) = CARD A` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  CARD_IMAGE_INJ;
+  CONJ_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  FINITE_INJ;
+  ASM_MESON_TAC[];
+  USE 2 GSYM;
+  IMATCH_MP_TAC  CARD_SUBSET;
+  RULE_ASSUM_TAC (REWRITE_RULE[INJ]);
+  REWRITE_TAC[IMAGE;SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ]);;
+  (* }}} *)
+
+let inj_bij_size = prove_by_refinement(
+  `!A B (f:A->B). INJ f A B /\ B HAS_SIZE (CARD A) ==> BIJ f A B`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[HAS_SIZE];
+  TH_INTRO_TAC [`f`;`A`] inj_bij;
+  FULL_REWRITE_TAC[INJ];
+  ASM_MESON_TAC[];
+  TYPE_THEN `IMAGE f A = B` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  CARD_SUBSET_EQ;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[INJ];
+  REWRITE_TAC[IMAGE;SUBSET];
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  EQ_SYM;
+  IMATCH_MP_TAC  BIJ_CARD;
+  UNIFY_EXISTS_TAC;
+  ASM_MESON_TAC[FINITE_INJ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let bij_empty = prove_by_refinement(
+  `!(f:A->B). BIJ f EMPTY EMPTY `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[BIJ;INJ;SURJ];
+  ]);;
+  (* }}} *)
+
+let bij_sing = prove_by_refinement(
+  `!(f:A->B) a b. BIJ f {a} {b} <=> (f a = b)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[BIJ;INJ;SURJ;INR IN_SING ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let card_sing = prove_by_refinement(
+  `!(a:A). (CARD {a} = 1)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`a`;`EMPTY:A->bool`] card_suc_insert;
+  REWRITE_TAC[FINITE_RULES];
+  FULL_REWRITE_TAC[CARD_CLAUSES];
+  TYPE_THEN `CARD {a}` UNABBREV_TAC;
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let pair_indistinct = prove_by_refinement(
+  `!(a:A). {a,a} = {a}`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[INR ABSORPTION;INR COMPONENT];
+  ]);;
+  (* }}} *)
+
+let has_size2_distinct = prove_by_refinement(
+  `!(a:A) b. {a,b} HAS_SIZE 2 ==> ~(a = b)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `b` UNABBREV_TAC;
+  FULL_REWRITE_TAC [pair_indistinct];
+  THM_INTRO_TAC[`a`] sing_has_size1;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  UND 0 THEN UND 2 THEN ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let has_size2_subset = prove_by_refinement(
+  `!X (a:A) b. X HAS_SIZE 2 /\ X SUBSET {a,b} ==> (X = {a,b})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  FULL_REWRITE_TAC [has_size2];
+  TYPE_THEN `X` UNABBREV_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  FULL_REWRITE_TAC[SUBSET;in_pair];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  COPY 0;
+  TSPEC `b'` 0;
+  TSPEC `a'` 3;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let inj_subset2 = prove_by_refinement(
+  `!t t' s (f:A->B). INJ f s t /\ t SUBSET t' ==> INJ f s t'`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ;SUBSET;];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ]);;
+  (* }}} *)
+
+let terminal_adj = prove_by_refinement(
+  `!E b. segment E /\ endpoint E b /\ ~(SING E) ==>
+    (?!e.  E e /\ adj (terminal_edge E b) e )`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[EXISTS_UNIQUE_ALT];
+  THM_INTRO_TAC[`E`;`b`] terminal_endpoint;
+  FULL_REWRITE_TAC[segment];
+  (* - *)
+  THM_INTRO_TAC[`terminal_edge E b`] two_endpoint;
+  FULL_REWRITE_TAC[segment;ISUBSET];
+  (* - *)
+  FULL_REWRITE_TAC[has_size2];
+  USE 6 (REWRITE_RULE[FUN_EQ_THM]);
+  TYPE_THEN `?x. !y. (closure top2 (terminal_edge E b) (pointI y) <=> ((y = x) \/ (y = b)))` SUBAGOAL_TAC;
+  USE 6 (REWRITE_RULE[in_pair]);
+  REWRITE_TAC[in_pair];
+  TYPE_THEN `(b = b') \/ (b = a)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC  ;
+  TYPE_THEN  `a` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `b'` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `!e. (adj (terminal_edge E b) e /\ (E e) ==> (closure top2 e (pointI x)))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`terminal_edge E b`;`e`] edge_inter;
+  ASM_MESON_TAC[segment;ISUBSET];
+  FULL_REWRITE_TAC[INTER;eq_sing];
+  TSPEC `m` 7;
+  REWR 7;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[endpoint];
+  THM_INTRO_TAC[`E`;`(pointI b)`] num_closure1;
+  FULL_REWRITE_TAC[segment];
+  REWR 14;
+  COPY 14;
+  TSPEC `terminal_edge E b` 15;
+  TSPEC `e` 14;
+  TYPE_THEN `e' = terminal_edge E b` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e' = e` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[adj];
+  UND 18 THEN UND 17 THEN UND 16 THEN MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`E`;`terminal_edge E b`] midpoint_exists;
+  FULL_REWRITE_TAC[SING];
+  LEFT 0 "x" ;
+  TSPEC `terminal_edge E b` 0;
+  ASM_MESON_TAC[];
+  (* - *)
+  FULL_REWRITE_TAC[midpoint];
+  THM_INTRO_TAC[`E`;`(pointI m)`] num_closure2;
+  FULL_REWRITE_TAC[segment];
+  REWR 11;
+  (* -DD *)
+  TYPE_THEN `?c. ~(terminal_edge E b = c) /\ (E c) /\ (closure top2 c (pointI m))` SUBAGOAL_TAC;
+  COPY 12;
+  TSPEC `terminal_edge E b` 11;
+  REWR 11;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `b''` EXISTS_TAC;
+  TYPE_THEN `a'` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `c` EXISTS_TAC;
+  COPY 7;
+  TSPEC `m` 16;
+  REWR 16;
+  TYPE_THEN `adj (terminal_edge E b) c` SUBAGOAL_TAC;
+  REWRITE_TAC[adj];
+  REWRITE_TAC[EMPTY_EXISTS;INTER;];
+  TYPE_THEN `pointI m` EXISTS_TAC;
+  (* - *)
+  IMATCH_MP_TAC  EQ_ANTISYM ;
+  CONJ_TAC;
+  TYPE_THEN `closure top2 y (pointI x)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `closure top2 c (pointI x)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  KILL 6;
+  TYPE_THEN `closure top2 (terminal_edge E b) (pointI x)` SUBAGOAL_TAC;
+  TYPE_THEN `({0,1,2} (num_closure E (pointI x)))` SUBAGOAL_TAC;
+  UND 2 THEN MESON_TAC[segment];
+  FULL_REWRITE_TAC[INSERT;];
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment];
+  THM_INTRO_TAC[`E`;`(pointI x)`] num_closure0;
+  REWR 22;
+  THM_INTRO_TAC[`E`;`(pointI x)`] num_closure1;
+  THM_INTRO_TAC[`E`;`(pointI x)`] num_closure2;
+  REWR 22;
+  UND 22 THEN REP_CASES_TAC ;
+  TYPE_THEN `(terminal_edge E b = a'') \/ (terminal_edge E b = b''')` SUBAGOAL_TAC;
+  TSPEC `terminal_edge E b` 22;
+  REWR 22;
+  TYPE_THEN `(c = a'') \/ (c = b''')` SUBAGOAL_TAC;
+  TSPEC `c` 22;
+  REWR 22;
+  TYPE_THEN `(y = a'') \/ (y = b''')` SUBAGOAL_TAC;
+  TSPEC `y` 22;
+  REWR 22;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `a''` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  REWR 29;
+  TYPE_THEN `b'''` UNABBREV_TAC;
+  USE 18(REWRITE_RULE[adj]);
+  UND 29 THEN UND 15 THEN UND 28 THEN MESON_TAC[];
+  TYPE_THEN `b'''` UNABBREV_TAC;
+  USE 18 (REWRITE_RULE[adj]);
+  UND 31 THEN UND 15 THEN UND 29 THEN UND 28 THEN MESON_TAC[];
+  (* --- *)
+  UND 20 THEN UND 21 THEN UND 14 THEN UND 19 THEN UND 22 THEN MESON_TAC[];
+  UND 22 THEN UND 19 THEN UND 20 THEN MESON_TAC[];
+  (* - *)
+  TYPE_THEN `y` UNABBREV_TAC;
+  ]);;
+  (* }}} *)
+
+let psegment_order_induct_lemma = prove_by_refinement(
+  `!n. !E a b. psegment E /\ (CARD E = n) /\ (endpoint E a) /\
+    (endpoint E b) /\ ~(a = b) ==>
+    (?f. (BIJ f { p | p < n} E) /\ (f 0 = terminal_edge E a) /\
+      ((0 < n) ==> (f (n - 1) = terminal_edge E b)) /\
+      (!i j. (i < CARD E /\ j < CARD E) ==>
+             (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))))`,
+  (* {{{ proof *)
+  [
+  INDUCT_TAC;
+  (* -- 0 case *)
+  TYPE_THEN `f = (\ (x:num). terminal_edge E a)` ABBREV_TAC ;
+  TYPE_THEN `f` EXISTS_TAC;
+  TYPE_THEN `{ p | p < 0} = EMPTY` SUBAGOAL_TAC;
+  REWRITE_TAC[EQ_EMPTY];
+  UND 6 THEN ARITH_TAC;
+  TYPE_THEN `E HAS_SIZE 0` SUBAGOAL_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  FULL_REWRITE_TAC[psegment;segment];
+  FULL_REWRITE_TAC[HAS_SIZE_0];
+  REWRITE_TAC[ARITH_RULE `~(k <| 0)`;bij_empty];
+  EXPAND_TAC "f";
+  (* - 1 case *)
+  REWRITE_TAC[ARITH_RULE `0 <| SUC n /\ (SUC n - 1 = n)`];
+  TYPE_THEN `n = 0` ASM_CASES_TAC;
+  KILL 5;
+  REWRITE_TAC[ARITH_RULE `i <| SUC 0 <=> (i = 0)`;];
+  REWRITE_TAC[ARITH_RULE `~(SUC 0 = 0)`;adj];
+  TYPE_THEN `n` UNABBREV_TAC;
+  FULL_REWRITE_TAC[ARITH_RULE `SUC 0 = 1`];
+  TYPE_THEN `E HAS_SIZE 1` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[HAS_SIZE;psegment;segment];
+  USE 5(MATCH_MP   CARD_SING_CONV);
+  FULL_REWRITE_TAC[SING];
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `f = (\ (y:num). x )` ABBREV_TAC ;
+  TYPE_THEN `f` EXISTS_TAC;
+  TYPE_THEN `FINITE {x}` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment;segment];
+  TYPE_THEN `{p | p = 0} = {0}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING];
+  KILL 7;
+  TYPE_THEN `f 0 = x` SUBAGOAL_TAC;
+  EXPAND_TAC "f";
+  REWRITE_TAC[bij_sing];
+  TH_INTRO_TAC[`{x}`;`a`] terminal_endpoint;
+  TH_INTRO_TAC[`{x}`;`b`] terminal_endpoint;
+  FULL_REWRITE_TAC[INR IN_SING];
+  (* - A2 and above *)
+  TYPE_THEN `e = terminal_edge E b` ABBREV_TAC ;
+  TYPE_THEN `b' = other_end e b` ABBREV_TAC ;
+  TYPE_THEN `E' = E DELETE e` ABBREV_TAC ;
+  (* - *)
+  TYPE_THEN `E e /\ closure top2 e (pointI b)` SUBAGOAL_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  IMATCH_MP_TAC  terminal_endpoint;
+  RULE_ASSUM_TAC (REWRITE_RULE[psegment;segment]);
+  (* - *)
+  TYPE_THEN `psegment E'` SUBAGOAL_TAC;
+  REWRITE_TAC[psegment];
+  CONJ_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  IMATCH_MP_TAC  segment_delete;
+  TYPE_THEN `b` EXISTS_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[psegment]);
+  REWRITE_TAC[];
+  TYPE_THEN `E` UNABBREV_TAC;
+  THM_INTRO_TAC [`e`] sing_has_size1;
+  RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
+  UND 12 THEN UND 3 THEN UND 6 THEN ARITH_TAC;
+  THM_INTRO_TAC [`E'`;`E`] rectagon_subset;
+  RULE_ASSUM_TAC (REWRITE_RULE[psegment]);
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[DELETE;SUBSET];
+  TYPE_THEN `E'` UNABBREV_TAC;
+  UND 13 THEN UND 11 THEN MESON_TAC[INR DELETE_NON_ELEMENT];
+  (* - *)
+  TYPE_THEN `SUC (CARD E') = SUC n` SUBAGOAL_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  TYPE_THEN `SUC n` UNABBREV_TAC;
+  IMATCH_MP_TAC  CARD_SUC_DELETE;
+  FULL_REWRITE_TAC[psegment;segment];
+  FULL_REWRITE_TAC[SUC_INJ];
+  (* -B *)
+  THM_INTRO_TAC [`E`;`b`;`e`] psegment_delete_end;
+  REWRITE_TAC[];
+  TYPE_THEN `E` UNABBREV_TAC;
+  FULL_REWRITE_TAC[card_sing];
+  UND 3 THEN UND 6 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `endpoint E' = {a,b'}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  has_size2_subset;
+  CONJ_TAC;
+  IMATCH_MP_TAC  endpoint_size2;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;INSERT;DELETE];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC [`E`;`x`;`a`;`b`] two_endpoint_segment;
+  FULL_REWRITE_TAC[psegment];
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`e`;`b`] other_end_prop;
+  UND 4 THEN REWRITE_TAC[psegment;segment;SUBSET;];
+  (* - *)
+  TYPE_THEN `{a,b'} HAS_SIZE 2` SUBAGOAL_TAC;
+  TYPE_THEN `{a,b'}` UNABBREV_TAC;
+  IMATCH_MP_TAC  endpoint_size2;
+  USE 16 (MATCH_MP has_size2_distinct);
+  UND 5 THEN DISCH_THEN (THM_INTRO_TAC[`E'`;`a`;`b'`]);
+  REWRITE_TAC[in_pair];
+  (* - *)
+  TYPE_THEN `g = (\ i.  if (i <| n) then f i else e)` ABBREV_TAC ;
+  TYPE_THEN `!i. (i <| n) ==> (g i = f i)` SUBAGOAL_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  TYPE_THEN `g n = e` SUBAGOAL_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  REWRITE_TAC[ARITH_RULE `~(n <| n)`];
+  TYPE_THEN `g` EXISTS_TAC;
+  (* - FINAL PUSH *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  inj_bij_size;
+  REWRITE_TAC[CARD_NUMSEG_LT];
+  CONJ_TAC;
+  TYPE_THEN `{p | p <| SUC n} = {p | p <| n} UNION {n}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;INR IN_SING];
+  ARITH_TAC;
+  IMATCH_MP_TAC  inj_split;
+  CONJ_TAC;
+  TYPE_THEN `INJ g {p | p <| n} E = INJ f {p | p <| n} E` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  inj_domain_sub;
+  USE 24 (REWRITE_RULE[]);
+  RULE_ASSUM_TAC (REWRITE_RULE[BIJ]);
+  (* --- temp *)
+  IMATCH_MP_TAC  inj_subset2;
+  UNIFY_EXISTS_TAC;
+  UND 9 THEN REWRITE_TAC[SUBSET;DELETE];
+  TYPE_THEN `E'` UNABBREV_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[INJ;INR IN_SING;];
+  REP_BASIC_TAC;
+  REWRITE_TAC[IMAGE;INTER;EQ_EMPTY;INR IN_SING ];
+  TYPE_THEN `x''` UNABBREV_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `g n` UNABBREV_TAC;
+  TSPEC `x'` 21;
+  TYPE_THEN `g x'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[BIJ;SURJ];
+  TSPEC `x'` 22;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[DELETE];
+  ASM_MESON_TAC[];
+  UND 4 THEN ASM_REWRITE_TAC[HAS_SIZE;psegment;segment;rectagon];
+  (* - C*)
+  TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[DELETE;SUBSET];
+  (* - *)
+  TSPEC `0` 21;
+  TYPE_THEN `0 <| n` SUBAGOAL_TAC;
+  UND 6 THEN ARITH_TAC;
+  TYPE_THEN `f 0` UNABBREV_TAC;
+  CONJ_TAC;
+  TYPE_THEN `e' = terminal_edge E' a` ABBREV_TAC ;
+  THM_INTRO_TAC[`E'`;`a`;`e'`] terminal_unique;
+  REWRITE_TAC[INR in_pair];
+  UND 12 THEN REWRITE_TAC[psegment;segment];
+  TYPE_THEN `e'` UNABBREV_TAC;
+  TYPE_THEN `g 0 ` UNABBREV_TAC;
+  THM_INTRO_TAC[`E`;`a`;`terminal_edge E' a`] terminal_unique;
+  UND 4 THEN (REWRITE_TAC[psegment;segment]);
+  REWR 26;
+  ASM_MESON_TAC[ISUBSET];
+  (* -D *)
+  TYPE_THEN `E' (terminal_edge E' b')` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`E'`;`b'`] terminal_endpoint;
+  FULL_REWRITE_TAC[psegment;segment;INR in_pair ];
+  (* - *)
+  TYPE_THEN `~(E' (terminal_edge E b))` SUBAGOAL_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[DELETE];
+  TYPE_THEN `terminal_edge E b` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `adj e (g (n - 1))` SUBAGOAL_TAC;
+  TYPE_THEN `g (n - 1) = f (n-1 )` SUBAGOAL_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  TYPE_THEN `n - 1 < n` SUBAGOAL_TAC;
+  UND 21 THEN ARITH_TAC;
+  TYPE_THEN `f (n - 1)` UNABBREV_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  REWRITE_TAC[adj];
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  CONJ_TAC;
+   TYPE_THEN `g n` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `pointI b'` EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `b'` UNABBREV_TAC;
+  THM_INTRO_TAC[`terminal_edge E b`;`b`]other_end_prop;
+  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
+  THM_INTRO_TAC  [`E'`;`b'`] terminal_endpoint;
+  FULL_REWRITE_TAC[psegment;segment;in_pair];
+  (* - *)
+  TYPE_THEN `!i. (i <| SUC n) ==> (adj (g n) (g i) = (SUC i = n))` SUBAGOAL_TAC;
+  TYPE_THEN `( i' = n) \/ (i' <| n)` SUBAGOAL_TAC;
+  UND 30 THEN ARITH_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  REWRITE_TAC[adj];
+  ARITH_TAC;
+  (* -- *)
+  THM_INTRO_TAC[`E`;`b`] terminal_adj;
+  FULL_REWRITE_TAC[psegment];
+  REWRITE_TAC[];
+  USE 35 (MATCH_MP CARD_SING);
+  TYPE_THEN `CARD E` UNABBREV_TAC;
+  UND 3 THEN UND 21 THEN ARITH_TAC;
+  FULL_REWRITE_TAC[EXISTS_UNIQUE_ALT];
+  TYPE_THEN `!i'. (i' <| n) ==> (adj e (g i') = (e' = (g i')))` SUBAGOAL_TAC;
+  TSPEC  `g (i'')`33;
+  TYPE_THEN `E (g i'')` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[BIJ;SURJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 34 THEN ARITH_TAC;
+  REWR 33;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  TSPEC `n - 1` 34;
+  TYPE_THEN `n - 1 < n` SUBAGOAL_TAC;
+  UND 21 THEN ARITH_TAC;
+  TYPE_THEN `(g i' = g (n - 1)) ==> (SUC i' = n)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC [BIJ;INJ];
+  IMATCH_MP_TAC  (ARITH_RULE  `((i' = n - 1) /\ (0 < n)) ==> (SUC i' = n)` );
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWR 34;
+  (* -- *)
+  TYPE_THEN `i' = n - 1` SUBAGOAL_TAC;
+  UND 35 THEN UND 21 THEN ARITH_TAC;
+  TSPEC `i'` 34;
+  TYPE_THEN `i'` UNABBREV_TAC;
+  REWR 32;
+  (* -E *)
+  TYPE_THEN `(i = n) \/ (i <| n)` SUBAGOAL_TAC;
+  UND 26 THEN ARITH_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TSPEC `j` 30;
+  UND 30 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `(j = n) \/ (j <| n)` SUBAGOAL_TAC;
+  UND 25 THEN ARITH_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ONCE_REWRITE_TAC [adj_symm];
+  UND 26 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `g` UNABBREV_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+
+  ]);;
+  (* }}} *)
+
+(* a couple of variants *)
+let psegment_order = prove_by_refinement(
+  `!E a b. psegment E /\ (endpoint E a) /\
+    (endpoint E b) /\ ~(a = b) ==>
+    (?f. (BIJ f { p | p < CARD E} E) /\ (f 0 = terminal_edge E a) /\
+      ((0 < CARD E) ==> (f (CARD E - 1) = terminal_edge E b)) /\
+      (!i j. (i < CARD E /\ j < CARD E) ==>
+             (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`CARD E`;`E`;`a`;`b`] psegment_order_induct_lemma;
+  REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let psegment_order' = prove_by_refinement(
+  `!A m. psegment A /\ endpoint A m  ==>
+    (?f. BIJ f {p | p < CARD A} A /\
+        (f 0 = terminal_edge A m) /\
+        (!i j. (i < CARD A /\ j < CARD A) ==>
+             (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`A`] endpoint_size2;
+  FULL_REWRITE_TAC[has_size2];
+  TYPE_THEN `?n. (endpoint A n) /\ ~(m = n)` SUBAGOAL_TAC;
+  REWR 0;
+  FULL_REWRITE_TAC[in_pair];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  THM_INTRO_TAC[`A`;`m`;`n`] psegment_order;
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+    ]);;
+  (* }}} *)
+
+let order_imp_psegment = prove_by_refinement(
+  `!f n. (INJ f { p | p < n} (edge)) /\ (0 < n) /\
+     (!i j. (i < n /\ j < n) ==>
+             (adj (f i) (f j) = ((SUC i = j) \/ (SUC j = i)   ))) ==>
+    (psegment (IMAGE f { p | p < n}))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `E = IMAGE f {p | p <| n}` ABBREV_TAC ;
+  IMATCH_MP_TAC  endpoint_psegment;
+  REWRITE_TAC[segment;];
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  REWRITE_TAC[FINITE_NUMSEG_LT];
+  (* - *)
+  TYPE_THEN `~(E = {})` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  FULL_REWRITE_TAC[image_empty];
+  FULL_REWRITE_TAC[EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  FULL_REWRITE_TAC[IMAGE;INJ;SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  TYPE_THEN `E (f 0)` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC ;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `0` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `edge (f 0)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET];
+  (* -A *)
+  TYPE_THEN `?m. endpoint E m` SUBAGOAL_TAC;
+  REWRITE_TAC[endpoint];
+  ASM_SIMP_TAC[num_closure1];
+  LEFT_TAC "e";
+  TYPE_THEN `f 0 ` EXISTS_TAC;
+  THM_INTRO_TAC[`f 0`] two_endpoint;
+  FULL_REWRITE_TAC[has_size2];
+  ASM_CASES_TAC `n =1`;
+  TYPE_THEN `a` EXISTS_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `n` UNABBREV_TAC;
+  FULL_REWRITE_TAC[IMAGE];
+  TYPE_THEN `(x' = 0) /\ (x = 0)` SUBAGOAL_TAC;
+  UND 7 THEN UND 13 THEN ARITH_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `a` 10;
+  FULL_REWRITE_TAC[in_pair];
+  (* -- *)
+  TYPE_THEN `E (f 1)` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `1` EXISTS_TAC;
+  UND 11 THEN UND 1 THEN ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `edge (f 1)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET];
+  (* -- *)
+  TYPE_THEN `adj (f 0 ) (f 1)` SUBAGOAL_TAC;
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`0`;`1`]);
+  UND 11 THEN UND 1 THEN ARITH_TAC;
+  ARITH_TAC;
+  THM_INTRO_TAC[`f 0`;`f 1`] edge_inter;
+  FULL_REWRITE_TAC[INTER;INR eq_sing  ];
+  (* -- *)
+  TYPE_THEN `?r. closure top2 (f 0) (pointI r) /\ ~(r = m)` SUBAGOAL_TAC;
+  USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  FULL_REWRITE_TAC[in_pair];
+  TYPE_THEN `m = a` ASM_CASES_TAC;
+  TYPE_THEN `m` UNABBREV_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN`?j. (j <| n) /\ (e' = f j)` SUBAGOAL_TAC;
+  TYPE_THEN`E` UNABBREV_TAC;
+  FULL_REWRITE_TAC[IMAGE];
+  TYPE_THEN`x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `e'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `adj (f 0) (f j)` SUBAGOAL_TAC;
+  REWRITE_TAC[adj;EMPTY_EXISTS;INTER ];
+  TYPE_THEN`pointI r` EXISTS_TAC;
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[` 0`;` j`] );
+  REWR 0;
+  TYPE_THEN `j = 1` SUBAGOAL_TAC;
+  UND 0 THEN ARITH_TAC;
+  TYPE_THEN `j` UNABBREV_TAC;
+  TSPEC `pointI r` 15;
+  REWR 15;
+  FULL_REWRITE_TAC[pointI_inj];
+  ASM_MESON_TAC[];
+  TYPE_THEN `e'` UNABBREV_TAC;
+  CONJ_TAC;
+  UNIFY_EXISTS_TAC;
+  (* -B *)
+  TYPE_THEN `!e. (E e ==> ?i. (i <| n) /\ (e = f i))` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  FULL_REWRITE_TAC[IMAGE];
+  ASM_MESON_TAC[];
+  (* - *)
+  CONJ_TAC;
+  REWRITE_TAC[INSERT];
+  ASM_SIMP_TAC [num_closure0;num_closure1;num_closure2];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  LEFT 11 "e";
+  LEFT 12 "e";
+  TSPEC `e` 12;
+  LEFT 12 "e'";
+  FULL_REWRITE_TAC[NOT_IMP];
+  TYPE_THEN `E e' /\ closure top2 e' (pointI m') /\ ~(e = e')` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `adj e e'` SUBAGOAL_TAC;
+  REWRITE_TAC[adj;EMPTY_EXISTS;INTER;];
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `(?i. (i <| n) /\ (e = f i))` SUBAGOAL_TAC;
+  TYPE_THEN `(?j. (j <| n) /\ (e' = f j))` SUBAGOAL_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  TYPE_THEN `(SUC i = j) \/ (SUC j = i)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  LEFT 13 "a";
+  TSPEC `f i` 13;
+  LEFT 13 "b";
+  TSPEC `f j` 13;
+  UND 13 THEN REWRITE_TAC[];
+  REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `?k. (k <| n) /\ (e'' = f k)` SUBAGOAL_TAC;
+  TYPE_THEN `e''` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  TYPE_THEN `adj (f i) (f k) /\ adj (f j) (f k)` SUBAGOAL_TAC;
+  REWRITE_TAC[adj];
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  LEFT_TAC "u";
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `(SUC j = k) \/ (SUC k = j)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `(SUC i = k) \/ (SUC k = i)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+   UND 29 THEN UND 28 THEN UND 19 THEN ARITH_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -C *)
+  TYPE_THEN `X = {p | p <| n /\ S (f p)}` ABBREV_TAC ;
+  TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;SUBSET];
+  TYPE_THEN `E u` SUBAGOAL_TAC;
+  TYPE_THEN `(?i. (i <| n) /\ (u = f i))` SUBAGOAL_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  UNDF `EMPTY` THEN REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `i` EXISTS_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `!j k. X j /\ (k <| n) /\ ((SUC j = k) \/ (SUC k = j)) ==> (X k)` SUBAGOAL_TAC;
+  TYPE_THEN `j = k` ASM_CASES_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `S (f j)` SUBAGOAL_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  TYPE_THEN `E (f k)` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `k` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `adj (f j) (f k)` SUBAGOAL_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `S (f k)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `X` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `(?i. X i /\ (!m. m <| i ==> ~X m))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  ASM_MESON_TAC[num_WOP];
+  TYPE_THEN `i = 0` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `?j. SUC j = i` SUBAGOAL_TAC;
+  TYPE_THEN `i - 1` EXISTS_TAC;
+  UND 19 THEN ARITH_TAC;
+  TSPEC `j` 17;
+  UND 17 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  UND 20 THEN ARITH_TAC;
+  UND 17 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `i` EXISTS_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  UND 17 THEN UND 20 THEN ARITH_TAC;
+  TYPE_THEN `i` UNABBREV_TAC;
+  (* -D *)
+  TYPE_THEN `X = { p | p <| n }` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp_eq;
+  CONJ_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `Z = ({p | p <| n} DIFF X)` ABBREV_TAC ;
+  TYPE_THEN `?n. Z n /\ (!m. m <| n ==> ~Z m)` SUBAGOAL_TAC;
+  UND 19 THEN MESON_TAC[num_WOP];
+  TYPE_THEN `Z` UNABBREV_TAC;
+  FULL_REWRITE_TAC[DIFF];
+  TSPEC `n' - 1` 21;
+  TYPE_THEN `~(n' = 0)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `n' - 1 <| n'` SUBAGOAL_TAC;
+  UND 24 THEN ARITH_TAC;
+  TYPE_THEN `n' - 1 <| n` SUBAGOAL_TAC;
+  UND 20 THEN ARITH_TAC;
+  REWR 21;
+  UND 19 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `n' - 1` EXISTS_TAC;
+  UND 24 THEN ARITH_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  REWRITE_TAC[SUBSET];
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  USE 20 (REWRITE_RULE[IMAGE]);
+  USE 19 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x'` 19;
+  FULL_REWRITE_TAC[];
+  REWR 19;
+  ]);;
+  (* }}} *)
+
+let rectagon_nonsing = prove_by_refinement(
+  `!G. rectagon G ==> ~SING G`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[rectagon;SING];
+  TYPE_THEN `G` UNABBREV_TAC;
+  THM_INTRO_TAC [`x`] two_endpoint;
+  FULL_REWRITE_TAC[SUBSET;INR IN_SING;];
+  FULL_REWRITE_TAC[has_size2];
+  USE 6 (ONCE_REWRITE_RULE [FUN_EQ_THM]);
+  FULL_REWRITE_TAC[in_pair];
+  TSPEC `b` 6;
+  REWR 6;
+  TSPEC `b` 2;
+  THM_INTRO_TAC[`{x}`;`pointI b`] num_closure0;
+  FULL_REWRITE_TAC[INR IN_SING];
+  REWR 2;
+  LEFT 2 "e" ;
+  TSPEC  `x` 2;
+  REWR 2;
+  THM_INTRO_TAC[`{x}`;`pointI b`] num_closure2;
+  REWR 8;
+  FULL_REWRITE_TAC[INR IN_SING];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let rectagon_2 = prove_by_refinement(
+  `!G S. rectagon G /\ S SUBSET G /\ ~(S = EMPTY) /\
+    (!m. {0,2} (num_closure S (pointI m))) ==> (S = G)`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `Tx = { A | ~(A = EMPTY) /\ A SUBSET S /\ (!m. {0,2} (num_closure A (pointI m))) }` ABBREV_TAC ;
+  TYPE_THEN `~(Tx = EMPTY)` SUBAGOAL_TAC;
+  UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `S` EXISTS_TAC;
+  TYPE_THEN `Tx` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET];
+  USE 5 (MATCH_MP select_card_min);
+  (* - *)
+  TYPE_THEN `z SUBSET G` SUBAGOAL_TAC;
+  TYPE_THEN `Tx` UNABBREV_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `(z = G) ==> (S = G)` SUBAGOAL_TAC;
+  TYPE_THEN `Tx` UNABBREV_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  FULL_REWRITE_TAC [ISUBSET];
+  ASM_MESON_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  KILL 8;
+  (* - *)
+  IMATCH_MP_TAC  rectagon_subset;
+  TYPE_THEN `segment G` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  (* - *)
+  REWRITE_TAC[rectagon];
+  TYPE_THEN `Tx` UNABBREV_TAC;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `G` EXISTS_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `G` EXISTS_TAC;
+  (* -A1 *)
+  IMATCH_MP_TAC  CARD_SUBSET_LE;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  UNIFY_EXISTS_TAC;
+  KILL 5;
+  KILL 0;
+  TSPEC `m` 4;
+  FULL_REWRITE_TAC[INSERT];
+  USE 0 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`S'`;`z`;`pointI m`] num_closure_mono;
+  UND 4 THEN UND 5 THEN ARITH_TAC;
+  KILL 0;
+  (* - *)
+  TYPE_THEN `~(num_closure S' (pointI m) = 1)` ASM_CASES_TAC;
+  THM_INTRO_TAC[`S'`;`z`;`pointI m`] num_closure_mono;
+  UND 5 THEN UND 0 THEN UND 4 THEN ARITH_TAC;
+  REWR 0;
+  (* - *)
+  THM_INTRO_TAC[`S'`;`(pointI m)`] num_closure1;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  REWR 5;
+  (* - *)
+  THM_INTRO_TAC[`z`;`pointI m`] num_closure2;
+  REWR 14;
+  COPY 14;
+  TSPEC `e` 16;
+  COPY 5;
+  TSPEC `e` 5;
+  USE 5 (REWRITE_RULE[]);
+  TYPE_THEN `z e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[ISUBSET];
+  TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  KILL 16;
+  (* -B1 *)
+  TYPE_THEN `?e'. (closure top2 e' (pointI m)) /\ z e' /\ ~(e = e')` SUBAGOAL_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `a` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  UND 11 THEN DISCH_THEN (THM_INTRO_TAC[`e`;`e'`]);
+  REWRITE_TAC[adj;INTER;EMPTY_EXISTS;];
+  TYPE_THEN `pointI m` EXISTS_TAC;
+  TSPEC  `e'` 17 ;
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let closure_imp_adj = prove_by_refinement(
+  `!X Y m. (closure top2 X (pointI m) /\ closure top2 Y (pointI m) /\
+      ~(X = Y) ==> adj X Y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[adj];
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  UNIFY_EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+let inductive_set_endpoint = prove_by_refinement(
+  `!G S. FINITE G /\ inductive_set G S ==>
+     (endpoint S SUBSET endpoint G)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[inductive_set];
+  REWRITE_TAC[SUBSET;endpoint];
+  TYPE_THEN `FINITE S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  THM_INTRO_TAC[`S`;`pointI x`] num_closure1;
+  REWR 6;
+  ASM_SIMP_TAC[num_closure1];
+  TYPE_THEN `e` EXISTS_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  COPY 6;
+  TSPEC `e'` 6;
+  TSPEC `e` 9;
+  REWR 6;
+  REWR 9;
+  PROOF_BY_CONTR_TAC;
+  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`e`;`e'`]);
+  IMATCH_MP_TAC  closure_imp_adj;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `e'` UNABBREV_TAC;
+  TSPEC `e` 6;
+  ASM_MESON_TAC[ISUBSET];
+  ]);;
+  (* }}} *)
+
+let endpoint_closure = prove_by_refinement(
+  `!e. (edge e) ==> (endpoint {e} = {m | closure top2 e (pointI m)})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[endpoint];
+  THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1;
+  REWRITE_TAC[FINITE_SING];
+  REWRITE_TAC[INR IN_SING];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `e = e'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let rectagon_delete = prove_by_refinement(
+  `!E e. (rectagon E) /\ (E e) ==> (psegment (E DELETE e))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[psegment];
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  CONJ_TAC;
+  THM_INTRO_TAC[`E DELETE e`;`E`] rectagon_subset;
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  REWRITE_TAC[DELETE;SUBSET];
+  ASM_MESON_TAC[INR DELETE_NON_ELEMENT];
+  (* - *)
+  REWRITE_TAC[segment];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  REWRITE_TAC[FINITE_DELETE];
+  (* - *)
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[delete_empty];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  USE 1 (MATCH_MP rectagon_nonsing);
+  FULL_REWRITE_TAC[SING];
+  ASM_MESON_TAC[];
+  (* - *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `E` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[DELETE;SUBSET];
+  FULL_REWRITE_TAC[rectagon];
+  (* - *)
+  SUBCONJ_TAC;
+  THM_INTRO_TAC[`E DELETE e`;`E`;`pointI m`] num_closure_mono;
+  FULL_REWRITE_TAC[rectagon;DELETE;SUBSET];
+  FULL_REWRITE_TAC[rectagon];
+  UND 5 THEN UND 4 THEN (REWRITE_TAC[INSERT]) ;
+  TSPEC `m` 4;
+  UND 4 THEN UND 5 THEN ARITH_TAC;
+  (* -A *)
+  TYPE_THEN `~S e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET;DELETE];
+  ASM_MESON_TAC[];
+  TYPE_THEN `(e INSERT S = E) ==> (S = E DELETE e)` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC [DELETE_INSERT];
+  ASM_MESON_TAC[INR DELETE_NON_ELEMENT];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  REWRITE_TAC[DELETE;SUBSET];
+  (* - *)
+  THM_INTRO_TAC[`E DELETE e`;`S`] inductive_set_endpoint;
+  REWRITE_TAC[inductive_set];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  rectagon_2;
+  CONJ_TAC;
+  REWRITE_TAC[INSERT_SUBSET];
+  UND 6 THEN REWRITE_TAC[SUBSET;DELETE];
+  (* - *)
+  CONJ_TAC;
+  FULL_REWRITE_TAC[EQ_EMPTY;INSERT;];
+  ASM_MESON_TAC[];
+  (* -B *)
+  TYPE_THEN `e INSERT S SUBSET E` SUBAGOAL_TAC;
+  UND 6 THEN REWRITE_TAC[INSERT;DELETE;SUBSET];
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`e INSERT S`;`E`;`pointI m`] num_closure_mono;
+  FULL_REWRITE_TAC[rectagon];
+  TYPE_THEN `~(num_closure (e INSERT S) (pointI m) = 1)` ASM_CASES_TAC;
+  TYPE_THEN `S' = e INSERT S` ABBREV_TAC ;
+  KILL 15;
+  FULL_REWRITE_TAC[INSERT;rectagon];
+  TSPEC `m` 15;
+  UND 15 THEN UND 14 THEN UND 13 THEN ARITH_TAC;
+  REWR 14;
+  PROOF_BY_CONTR_TAC;
+  KILL 13;
+  KILL 15;
+  KILL 9;
+  (* - *)
+  TYPE_THEN `!A x. (A SUBSET E) /\ (num_closure A (pointI x) = 1) ==> (num_closure E (pointI x) = 2)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  TSPEC `x` 15;
+  USE 15 (REWRITE_RULE[INSERT]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`A`;`E`;`pointI x`] num_closure_mono;
+  UND 20 THEN UND 19 THEN UND 9 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `endpoint (E DELETE e) SUBSET  endpoint {e}` SUBAGOAL_TAC;
+  REWRITE_TAC[SUBSET;endpoint];
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`E DELETE e`;`x`]);
+  REWRITE_TAC[SUBSET;DELETE];
+  THM_INTRO_TAC[`E`;`pointI x`] num_closure2;
+  FULL_REWRITE_TAC[rectagon];
+  REWR 15;
+  THM_INTRO_TAC[`E DELETE e`;`pointI x`] num_closure1;
+  REWR 17;
+  USE 17 (REWRITE_RULE[DELETE]);
+  THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1;
+  REWRITE_TAC[FINITE_SING];
+  REWRITE_TAC[INR IN_SING];
+  TYPE_THEN `e` EXISTS_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  REWRITE_TAC[];
+  TYPE_THEN `e''` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `E a /\ closure top2 a (pointI x)` SUBAGOAL_TAC;
+  TYPE_THEN `E b /\ closure top2 b (pointI x)` SUBAGOAL_TAC;
+  TSPEC `e` 15;
+  UND 15 THEN ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC ;
+  USE 15 (REWRITE_RULE[DE_MORGAN_THM]);
+  COPY 17;
+  TSPEC `a` 17;
+  TSPEC `b` 25;
+  KILL 18;
+  KILL 4;
+  KILL 7;
+  TYPE_THEN `e' = b` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  KILL 25;
+  TYPE_THEN `e' = a` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  UND 7 THEN UND 4 THEN UND 16 THEN MESON_TAC[];
+  (* -C *)
+  TYPE_THEN `endpoint S SUBSET endpoint {e}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  UNIFY_EXISTS_TAC;
+  KILL 13;
+  KILL 11;
+  (* - *)
+  THM_INTRO_TAC[`S`;`E`] endpoint_even;
+  SUBCONJ_TAC;
+  ASM_MESON_TAC[rectagon_segment];
+  SUBCONJ_TAC;
+  UND 12 THEN REWRITE_TAC[INSERT;SUBSET] THEN MESON_TAC[];
+  THM_INTRO_TAC[`S`;`E`] rectagon_subset;
+  TYPE_THEN `S` UNABBREV_TAC;
+  UND 8 THEN REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `X = {S' | ?e. S e /\ (S' = segment_of S e)}` ABBREV_TAC ;
+  TYPE_THEN `FINITE X` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`segment_of S`;`S`] FINITE_IMAGE;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E DELETE e` EXISTS_TAC;
+  TYPE_THEN `X = IMAGE (segment_of S) S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  TYPE_THEN `X` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC;
+  USE 5 (REWRITE_RULE[EMPTY_EXISTS]);
+  UND 17 THEN REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `segment_of S u` EXISTS_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[HAS_SIZE];
+  (* -D *)
+  TYPE_THEN `edge e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  FULL_REWRITE_TAC[ISUBSET];
+  THM_INTRO_TAC[`e`] endpoint_closure;
+  THM_INTRO_TAC[`e`] two_endpoint;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  (* - *)
+  TYPE_THEN `endpoint S = endpoint {e}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  CARD_SUBSET_LE;
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  (ARITH_RULE  `~(CARD X = 0) ==> 2 <= 2 * CARD X`);
+  TYPE_THEN `X HAS_SIZE 0` SUBAGOAL_TAC;
+  ASM_REWRITE_TAC[HAS_SIZE];
+  FULL_REWRITE_TAC[HAS_SIZE_0];
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`e INSERT S`;`pointI m`] num_closure1;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  REWR 24;
+  USE 24 (REWRITE_RULE[INSERT]);
+  TYPE_THEN `closure top2 e (pointI m)` ASM_CASES_TAC;
+  TYPE_THEN `e' = e` SUBAGOAL_TAC;
+  TSPEC `e` 24;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e'` UNABBREV_TAC;
+  TYPE_THEN `endpoint S m` SUBAGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`S`;`m`]endpoint_edge;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E DELETE e` EXISTS_TAC ;
+  FULL_REWRITE_TAC[EXISTS_UNIQUE_ALT];
+  TSPEC  `e''` 27;
+  TSPEC  `e''` 24;
+  TYPE_THEN `e = e''` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e''` UNABBREV_TAC;
+  KILL 9;
+  KILL 20;
+  KILL 7;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `~endpoint S m` SUBAGOAL_TAC;
+  UND 26 THEN ASM_REWRITE_TAC[];
+  (* - *)
+  USE 26 (REWRITE_RULE[endpoint]);
+  THM_INTRO_TAC[`S`;`E`;`pointI m`] num_closure_mono;
+  FULL_REWRITE_TAC[rectagon];
+  UND 6 THEN REWRITE_TAC[DELETE;SUBSET];
+  TYPE_THEN `{0,2} (num_closure E (pointI m))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  TYPE_THEN `FINITE S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET ;
+  TYPE_THEN `E DELETE e` EXISTS_TAC;
+  TYPE_THEN `~(num_closure S (pointI m) = 0)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`S`;`pointI m`] num_closure0;
+  REWR 30;
+  TSPEC `e'` 30;
+  COPY 24;
+  TSPEC `e` 32;
+  TSPEC `e'` 24;
+  REWR 24;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e'` UNABBREV_TAC;
+  KILL 4;
+  KILL 9;
+  ASM_MESON_TAC[];
+  (* - *)
+  USE 28 (REWRITE_RULE [INSERT]);
+  USE 28 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
+  FIRST_ASSUM DISJ_CASES_TAC;
+  UND 27 THEN UND 31 THEN UND 30 THEN ARITH_TAC;
+  KILL 28;
+  TYPE_THEN `num_closure S (pointI m) = 2` SUBAGOAL_TAC;
+  UND 31 THEN UND 30 THEN UND 26 THEN UND 27 THEN ARITH_TAC;
+  KILL 31;
+  KILL 9;
+  KILL 4;
+  KILL 7;
+  KILL 30;
+  (* -E *)
+  THM_INTRO_TAC[`S`;`pointI m`] num_closure2;
+  REWR 4;
+  TYPE_THEN `S a /\ closure top2 a (pointI m)` SUBAGOAL_TAC;
+  TYPE_THEN `S b /\ closure top2 b (pointI m)` SUBAGOAL_TAC;
+  KILL 4;
+  TYPE_THEN `e' = a` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e' =b` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  UND 7 THEN REWRITE_TAC[];
+  TYPE_THEN `e'` UNABBREV_TAC;
+  ]);;
+  (* }}} *)
+
+let rectagon_adj = prove_by_refinement(
+  `!E e f. (rectagon E) /\ E e /\ E f ==>
+         (adj e f <=>
+    (?a. endpoint (E DELETE e) a /\ (f = terminal_edge (E DELETE e) a)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[DELETE;SUBSET];
+  (* - *)
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  IMATCH_MP_TAC  (TAUT `A /\ b ==> b /\ A`);
+  CONJ_TAC;
+  IMATCH_MP_TAC closure_imp_adj;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  FULL_REWRITE_TAC[endpoint];
+  THM_INTRO_TAC[`E DELETE e`;`pointI a`] num_closure1;
+  REWR 5;
+  USE 5 (REWRITE_RULE[DELETE]);
+  TYPE_THEN `{0,2} (num_closure E (pointI a))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  USE 7 (REWRITE_RULE[INSERT]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`E`;`pointI a`] num_closure2;
+  REWR 9;
+  TYPE_THEN `E a' /\ closure top2 a' (pointI a)` SUBAGOAL_TAC;
+  TYPE_THEN `E b /\ closure top2 b (pointI a)` SUBAGOAL_TAC;
+  SUBCONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  TSPEC `e` 9;
+  UND 9 THEN ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USE 9(REWRITE_RULE[DE_MORGAN_THM]);
+  COPY 5;
+  TSPEC `a'` 5;
+  TSPEC `b` 17;
+  TYPE_THEN `e' = b` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`E DELETE e`;`a`]terminal_endpoint;
+  REWRITE_TAC[endpoint];
+  UND 17 THEN REWRITE_TAC[DELETE] THEN MESON_TAC[];
+  (* -- case 0 *)
+  THM_INTRO_TAC[`E`;`pointI a`] num_closure0;
+  REWR 9;
+  ASM_MESON_TAC[];
+  (* -A *)
+  THM_INTRO_TAC[`e`;`f`] edge_inter;
+  FULL_REWRITE_TAC[rectagon;ISUBSET];
+  FULL_REWRITE_TAC[INTER;INR eq_sing];
+  TYPE_THEN `m` EXISTS_TAC;
+  SUBCONJ_TAC;
+  REWRITE_TAC[endpoint];
+  THM_INTRO_TAC[`E DELETE e`;`pointI m`] num_closure1;
+  KILL 9;
+  TYPE_THEN `f` EXISTS_TAC;
+  REWRITE_TAC[DELETE];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  TYPE_THEN `e''` UNABBREV_TAC;
+  FULL_REWRITE_TAC[adj];
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `{0, 2} (num_closure E (pointI m))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  FULL_REWRITE_TAC[INSERT];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`E`;`pointI m`]num_closure2;
+  REWR 14;
+  PROOF_BY_CONTR_TAC;
+  COPY 14;
+  COPY 14;
+  TSPEC `e` 14;
+  TSPEC `f` 18;
+  TSPEC `e''` 17;
+  KILL 13;
+  KILL 12;
+  KILL 6;
+  TYPE_THEN `e'' = a` ASM_CASES_TAC ;
+  TYPE_THEN `e''` UNABBREV_TAC;
+  TYPE_THEN `(f = b)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `f` UNABBREV_TAC;
+  TYPE_THEN `e = b` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e` UNABBREV_TAC;
+  FULL_REWRITE_TAC[adj];
+  TYPE_THEN `e'' = b` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e''` UNABBREV_TAC;
+  TYPE_THEN `f = a` SUBAGOAL_TAC;
+  KILL 14;
+  ASM_MESON_TAC[];
+  TYPE_THEN `f` UNABBREV_TAC ;
+  FULL_REWRITE_TAC[adj];
+  ASM_MESON_TAC[];
+  (* -- 0 case -- *)
+  THM_INTRO_TAC[`E`;`pointI m`] num_closure0;
+  REWR 14;
+  KILL 6;
+  ASM_MESON_TAC[];
+  (* -B *)
+  THM_INTRO_TAC[`E DELETE e`;`m`;`f`] terminal_unique;
+  USE 10 (ONCE_REWRITE_RULE [EQ_SYM_EQ]);
+  ASM_REWRITE_TAC[DELETE];
+  ASM_MESON_TAC[adj];
+  ]);;
+  (* }}} *)
+
+let rectagon_delete_end = prove_by_refinement(
+  `!E e m. rectagon E /\ E e /\ closure top2 e (pointI m) ==>
+       endpoint (E DELETE e ) m`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[endpoint];
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC[DELETE;SUBSET];
+  THM_INTRO_TAC[`E DELETE e`;`pointI m`] num_closure1;
+  KILL 5;
+  REWRITE_TAC[DELETE];
+  (* - *)
+  TYPE_THEN `{0,2} (num_closure E (pointI m))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  FULL_REWRITE_TAC[INSERT];
+  (* - *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  KILL 5;
+  THM_INTRO_TAC[`E`;`pointI m`] num_closure2;
+  REWR 5;
+  TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `?c. (E c /\ ~(c = e) /\ closure top2 c (pointI m)) /\ (!e'. E e' /\ closure top2 e' (pointI m) <=> (e' = e) \/ (e' = c))` SUBAGOAL_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `a` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `c` EXISTS_TAC;
+  TYPE_THEN `c = e''` ASM_CASES_TAC;
+  TYPE_THEN `e''` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  REWR 14;
+  KILL 5;
+  TSPEC `e''` 9;
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`E`;`pointI m`] num_closure0;
+  REWR 7;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let rectagon_order = prove_by_refinement(
+  `!E e m. rectagon E /\ E e /\ closure top2 e (pointI m) ==>
+     (?f. BIJ f { p | p < CARD E } E /\
+         (f (CARD E - 1) = e) /\ (closure top2 (f 0) (pointI m)) /\
+      (!i j. (i < CARD E /\ j < CARD E) ==>
+            (adj (f i) (f j) <=> ((SUC i = j) \/ (SUC j = i) \/
+   ((i = 0) /\ (j = (CARD E -1))) \/ ((i = CARD E -1) /\ (j = 0))))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`E`;`e`] rectagon_delete;
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  TYPE_THEN `FINITE (E DELETE e)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC   FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC[DELETE;SUBSET];
+  TYPE_THEN `endpoint (E DELETE e) m` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  rectagon_delete_end;
+  (* - *)
+  TYPE_THEN `?n. (endpoint (E DELETE e) n) /\ ~(n = m)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`E DELETE e`] endpoint_size2;
+  FULL_REWRITE_TAC[has_size2];
+  TYPE_THEN `m = a` ASM_CASES_TAC ;
+  TYPE_THEN `b` EXISTS_TAC;
+  REWRITE_TAC[INR in_pair];
+  TYPE_THEN `a` EXISTS_TAC;
+  REWRITE_TAC[INR in_pair];
+  (* - *)
+  THM_INTRO_TAC[`E DELETE e`;`m`;`n`] psegment_order;
+  THM_INTRO_TAC[`e`;`E`;] CARD_SUC_DELETE;
+  TYPE_THEN `~(CARD E = 0)` SUBAGOAL_TAC;
+  TYPE_THEN `E HAS_SIZE 0` SUBAGOAL_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  FULL_REWRITE_TAC[HAS_SIZE_0;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  TYPE_THEN `CARD (E DELETE e) = CARD (E) - 1` SUBAGOAL_TAC;
+  UND 14 THEN UND 13 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `g = \ (i:num). if (i < CARD E - 1) then f i else e` ABBREV_TAC ;
+  TYPE_THEN `(g (CARD E - 1) = e)` SUBAGOAL_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  REWRITE_TAC[ARITH_RULE `~(x <| x)`];
+  TYPE_THEN `(!i. (i < CARD E -| 1) ==> (g i = f i))` SUBAGOAL_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  KILL 16;
+  TYPE_THEN `g` EXISTS_TAC;
+  (* -A *)
+  TYPE_THEN `{p | p < CARD E - 1} UNION {(CARD E - 1)} = {p | p <| CARD E}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;INR IN_SING ];
+  UND 14 THEN ARITH_TAC;
+  (* - *)
+  SUBCONJ_TAC;
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  USE 16 (SYM);
+  IMATCH_MP_TAC  inj_split;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[BIJ;INJ];
+  TYPE_THEN `CARD (E DELETE e)` UNABBREV_TAC;
+  CONJ_TAC;
+  UND 20 THEN REWRITE_TAC[DELETE] THEN UND 15 THEN MESON_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 15 THEN UND 21 THEN UND 22 THEN UND 18 THEN MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[INJ;INR IN_SING ];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE;INTER;EQ_EMPTY;INR IN_SING  ];
+  TYPE_THEN `x` UNABBREV_TAC ;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  REWR 19;
+  TYPE_THEN `g x' = f x'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `g x'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[BIJ;INJ];
+  TYPE_THEN `CARD(E DELETE e)` UNABBREV_TAC;
+  USE 21(REWRITE_RULE[DELETE]);
+  ASM_MESON_TAC[];
+  (* -- SURJ -- *)
+  REWRITE_TAC[SURJ];
+  USE 19 (REWRITE_RULE[INJ]);
+  REWRITE_TAC[];
+  TYPE_THEN `x = e` ASM_CASES_TAC;
+  TYPE_THEN `CARD E - 1` EXISTS_TAC;
+  UND 14 THEN ARITH_TAC;
+  TYPE_THEN `(E DELETE e) x` SUBAGOAL_TAC;
+  ASM_REWRITE_TAC[DELETE];
+  FULL_REWRITE_TAC[BIJ;SURJ];
+  TSPEC `x` 12;
+  REWR 12;
+  TYPE_THEN `y` EXISTS_TAC;
+  CONJ_TAC;
+  UND 26 THEN ARITH_TAC;
+  (* -B *)
+  TYPE_THEN `~(SING E)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SING];
+  TYPE_THEN `E` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INR IN_SING];
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[psegment;segment];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  UND 22 THEN ASM_REWRITE_TAC[DELETE;INR IN_SING];
+  ASM_MESON_TAC[];
+  TYPE_THEN `~(CARD E = 1)` SUBAGOAL_TAC;
+  TYPE_THEN `E HAS_SIZE 1` SUBAGOAL_TAC;
+  ASM_REWRITE_TAC[HAS_SIZE];
+  ASM_MESON_TAC[CARD_SING_CONV];
+  (* - *)
+  TYPE_THEN `0 < CARD E - 1` SUBAGOAL_TAC;
+  UND 21 THEN UND 14 THEN ARITH_TAC;
+  COPY 18 ;
+  TSPEC `0` 23;
+  (* - *)
+  SUBCONJ_TAC;
+  THM_INTRO_TAC[`E DELETE e`;`m`]terminal_endpoint;
+  (* -C *)
+  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `CARD (E DELETE e) - 1 = CARD E - 2` SUBAGOAL_TAC;
+  UND 23 THEN ARITH_TAC;
+  REWR 10;
+  (* - *)
+  TYPE_THEN `!k. endpoint (E DELETE e) k  ==> (k = n) \/ (k = m)` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 29 (REWRITE_RULE[DE_MORGAN_THM]);
+  THM_INTRO_TAC[`E DELETE e`] endpoint_size2;
+  THM_INTRO_TAC[`endpoint(E DELETE e)`;`n`;`m`;`k`]two_exclusion;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!j. (j <| CARD E - 1) ==> (adj e (g j) <=> (j = 0) \/ (j = CARD E - 2))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`E`;`e`;`g j'`] rectagon_adj;
+  TSPEC `j'` 18;
+  TYPE_THEN `f j'` UNABBREV_TAC;
+  USE 19 (REWRITE_RULE[BIJ;SURJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 29 THEN ARITH_TAC;
+  (* -- *)
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`j'`]);
+  TYPE_THEN `g j'` UNABBREV_TAC;
+  REWR 30;
+  TSPEC  `a` 28;
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  TYPE_THEN `a` UNABBREV_TAC;
+  DISJ2_TAC;
+  TYPE_THEN `f j' = f (CARD E -| 2)` SUBAGOAL_TAC;
+  USE 12(REWRITE_RULE[BIJ;INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 29 THEN UND 23 THEN ARITH_TAC;
+  TYPE_THEN `a` UNABBREV_TAC;
+  DISJ1_TAC;
+  TYPE_THEN `f j' = f 0` SUBAGOAL_TAC;
+  USE 12 (REWRITE_RULE[BIJ;INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`E`;`e`;`f 0`] rectagon_adj;
+  TYPE_THEN `terminal_edge (E DELETE e) m` UNABBREV_TAC;
+  USE 22 SYM;
+  USE 19 (REWRITE_RULE[BIJ;SURJ]);
+  TSPEC `0` 22;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 23 THEN ARITH_TAC;
+  ASM_MESON_TAC[];
+  (* -- *)
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`E`;`e`;`f (CARD E - 2)`] rectagon_adj;
+  TYPE_THEN `terminal_edge (E DELETE e) n` UNABBREV_TAC;
+  UND 18 THEN DISCH_THEN  (THM_INTRO_TAC[`CARD E -2`]);
+  UND 23 THEN ARITH_TAC;
+  USE 10 GSYM;
+  USE 19 (REWRITE_RULE[BIJ;SURJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 23 THEN ARITH_TAC;
+  REWR 33;
+  TYPE_THEN `n` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `i  = CARD E - 1` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `j = CARD E - 1` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[adj];
+  UND 32 THEN UND 23 THEN ARITH_TAC;
+  UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`j`]);
+  UND 31 THEN UND 24 THEN ARITH_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `j` UNABBREV_TAC;
+  DISJ2_TAC;
+  DISJ1_TAC;
+  UND 23 THEN ARITH_TAC;
+  UND 32 THEN REP_CASES_TAC;
+  TYPE_THEN `j` UNABBREV_TAC;
+  UND 24 THEN ARITH_TAC;
+  DISJ2_TAC;
+  UND 32 THEN UND 23 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `j = CARD E - 1` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC [adj_symm];
+  UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
+  UND 30 THEN UND 25 THEN ARITH_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  UND 23 THEN ARITH_TAC;
+  UND 32 THEN REP_CASES_TAC;
+  UND 32 THEN UND 23 THEN ARITH_TAC;
+  TYPE_THEN `i` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 25 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `i < CARD E - 1 /\ j < CARD E - 1` SUBAGOAL_TAC;
+  UND 31 THEN UND 30 THEN UND 24 THEN UND 25 THEN ARITH_TAC;
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+
+let order_imp_psegment_shift = prove_by_refinement(
+  `! f m n.
+     INJ f { p | m <= p /\ p < n} edge /\
+       m <| n /\
+       (! i j. m <= i /\ i < n /\ m <= j /\ j < n ==>
+         (adj (f i) (f j) <=> (SUC i = j) \/ (SUC j = i))) ==>
+      psegment (IMAGE f {p | m <= p /\ p < n})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `g = \ (i: num). f (i + m)` ABBREV_TAC ;
+  TYPE_THEN `IMAGE f {p | m <=| p /\ p < n} = IMAGE g {p | p < n - m}` SUBAGOAL_TAC;
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  TYPE_THEN `x' -| m` EXISTS_TAC;
+  CONJ_TAC;
+  UND 5 THEN UND 6 THEN ARITH_TAC;
+  AP_TERM_TAC;
+  UND 6 THEN ARITH_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  TYPE_THEN `x' +| m` EXISTS_TAC;
+  UND 5 THEN UND 1 THEN ARITH_TAC;
+  IMATCH_MP_TAC  order_imp_psegment;
+  (* - *)
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  TYPE_THEN`g`UNABBREV_TAC;
+  FULL_REWRITE_TAC[INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 5 THEN UND 1 THEN ARITH_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `((x +| m) = (y + m)) ==> (x = y)`);
+  FULL_REWRITE_TAC[INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 6 THEN UND 7 THEN UND 1 THEN ARITH_TAC;
+  (* - *)
+  CONJ_TAC;
+  UND 1 THEN ARITH_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`i +| m`;`j +| m`]);
+  UND 6 THEN UND 7 THEN UND 1 THEN ARITH_TAC;
+  REWRITE_TAC[ARITH_RULE `(SUC(i + m) = (j +| m)) <=> (SUC i = j)`];
+  ]);;
+  (* }}} *)
+
+let cls = jordan_def
+  `cls E = {m | ?e. E e /\ closure top2 e (pointI m)}`;;
+
+let cls_edge = prove_by_refinement(
+  `!e. (cls {e} = {m | closure top2 e (pointI m)})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cls;INR IN_SING ;];
+  IMATCH_MP_TAC  EQ_EXT;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let cls_inj_lemma_v = prove_by_refinement(
+  `!m n. (cls {(v_edge m)} = cls {(v_edge n)}) ==> (m = n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cls_edge;INR IN_SING;];
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 0 (REWRITE_RULE[INR IN_SING]);
+  FULL_REWRITE_TAC[v_edge_closure;vc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT];
+  SUBCONJ_TAC;
+  TSPEC `m` 0;
+  ASM_MESON_TAC[];
+  TYPE_THEN `FST n` UNABBREV_TAC;
+  COPY 0;
+  TSPEC `m` 1;
+  TSPEC `(FST m, SND n)` 0;
+  REWR 0;
+  REWR 1;
+  UND 0 THEN UND 1 THEN INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let cls_inj_lemma_h = prove_by_refinement(
+  `!m n. (cls {(h_edge m)} = cls {(h_edge n)}) ==> (m = n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cls_edge;INR IN_SING;];
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 0 (REWRITE_RULE[INR IN_SING]);
+  FULL_REWRITE_TAC[h_edge_closure;hc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT];
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  SUBCONJ_TAC;
+  TSPEC `m` 0;
+  ASM_MESON_TAC[];
+  TYPE_THEN `SND  n` UNABBREV_TAC;
+  COPY 0;
+  TSPEC `m` 1;
+  TSPEC `(FST n, SND m)` 0;
+  REWR 0;
+  REWR 1;
+  UND 0 THEN UND 1 THEN INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let cls_inj_lemma_hv = prove_by_refinement(
+  `!m n. ~(cls {(h_edge m)} = cls {(v_edge n)})` ,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cls_edge;];
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 0 (REWRITE_RULE[INR IN_SING]);
+  FULL_REWRITE_TAC[v_edge_closure;vc_edge;h_edge_closure;hc_edge;UNION;cell_clauses;INR IN_SING ;plus_e12;PAIR_SPLIT];
+  COPY 0;
+  TSPEC  `n` 0;
+  TSPEC `(FST n, SND n +: &:1)` 1;
+  REWR 0;
+  REWR 1;
+  TYPE_THEN `SND n = SND m` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `SND m` UNABBREV_TAC;
+  UND 1 THEN INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let cls_inj = prove_by_refinement(
+  `!e f . (edge e /\ edge f /\ (cls {e} = cls {f}) ==> (e = f))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge];
+  JOIN 1 2 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
+  UND 1 THEN REP_CASES_TAC THEN REWR 0 THEN REWRITE_TAC[v_edge_inj;h_edge_inj];
+  IMATCH_MP_TAC cls_inj_lemma_v;
+  ASM_MESON_TAC[cls_inj_lemma_hv];
+  ASM_MESON_TAC[cls_inj_lemma_hv];
+  IMATCH_MP_TAC  cls_inj_lemma_h;
+  ]);;
+  (* }}} *)
+
+let adjv = jordan_def
+  `adjv e f = @m. (closure top2 e (pointI m)) /\
+                  (closure top2 f (pointI m))` ;;
+
+let adjv_adj = prove_by_refinement(
+  `!e f. edge e /\ edge f /\ adj e f ==>
+        closure top2 e (pointI (adjv e f))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[adjv];
+  SELECT_TAC ;
+  THM_INTRO_TAC[`e`;`f`] edge_inter;
+  FULL_REWRITE_TAC [INTER;INR eq_sing;];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let adjv_adj2 = prove_by_refinement(
+  `!e f. edge e /\ edge f /\ adj e f ==>
+        closure top2 f (pointI (adjv e f))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[adjv];
+  SELECT_TAC ;
+  THM_INTRO_TAC[`e`;`f`] edge_inter;
+  FULL_REWRITE_TAC [INTER;INR eq_sing;];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let has_size2_pair = prove_by_refinement(
+  `!(X:A->bool) a b. (X HAS_SIZE 2) /\ X a /\ X b /\ ~(a = b) ==>
+      (X = {a,b})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  CARD_SUBSET_EQ;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  REWRITE_TAC[SUBSET;INR in_pair];
+  ASM_MESON_TAC[pair_size_2;HAS_SIZE];
+  ]);;
+  (* }}} *)
+
+let adjv_unique = prove_by_refinement(
+  `!e f n. edge e /\ edge f /\ adj e f /\ closure top2 e (pointI n) /\
+      closure top2 f (pointI n) ==> (n = adjv e f)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[adjv];
+  SELECT_TAC;
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`e`] two_endpoint;
+  THM_INTRO_TAC[`f`] two_endpoint;
+  THM_INTRO_TAC[ `{m | closure top2 f (pointI m)}`;`n`;`t`] has_size2_pair;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[ `{m | closure top2 e (pointI m)}`;`n`;`t`] has_size2_pair;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `cls {e} = cls {f}` SUBAGOAL_TAC;
+  REWRITE_TAC[cls_edge;INR IN_SING ];
+  THM_INTRO_TAC[`e`;`f`] cls_inj;
+  TYPE_THEN`f` UNABBREV_TAC;
+  FULL_REWRITE_TAC[adj];
+  (* - *)
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let adjv_symm = prove_by_refinement(
+  `!e f. edge e /\ edge f /\ adj e f ==>
+    (adjv f e = adjv e f)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  adjv_unique;
+  THM_INTRO_TAC[`f`;`e`] adjv_adj;
+  ASM_MESON_TAC[adj_symm];
+  THM_INTRO_TAC[`f`;`e`] adjv_adj2;
+  ASM_MESON_TAC[adj_symm];
+  ]);;
+  (* }}} *)
+
+let adjv_segment  = prove_by_refinement(
+  `!E e f. segment E /\ E e /\ E f /\ adj e f ==>
+     ({C| E C /\ closure top2 C (pointI (adjv e f))} = {e,f} ) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  has_size2_pair;
+  TYPE_THEN `~(e = f)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[adj];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `edge e /\ edge f` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment;ISUBSET];
+  (* - *)
+  TYPE_THEN `closure top2 e (pointI (adjv e f))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  adjv_adj;
+  TYPE_THEN `closure top2 f (pointI (adjv e f))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  adjv_adj2;
+  (* - *)
+  TYPE_THEN `{0,1,2} (num_closure E (pointI (adjv e f)))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment];
+  FULL_REWRITE_TAC[INSERT];
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment];
+  UND 9 THEN REP_CASES_TAC;
+  THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure_size;
+  REWR 11;
+  (* -- *)
+  THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure1;
+  REWR 11;
+  COPY 11;
+  TSPEC `f` 11;
+  TSPEC `e` 12;
+  REWR 11;
+  REWR 12;
+  (* - *)
+  THM_INTRO_TAC[`E`;`pointI (adjv e f)`] num_closure0;
+  REWR 11;
+  TSPEC  `e` 11;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let num_closure_elt = prove_by_refinement(
+  `!S m. (0 <| num_closure S m) ==> (?e. S e /\ closure top2 e m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[num_closure];
+  TYPE_THEN `~({C | S C /\ closure top2 C m} = EMPTY)` SUBAGOAL_TAC;
+  REWR 0;
+  FULL_REWRITE_TAC[CARD_CLAUSES];
+  UND 0 THEN ARITH_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  UNIFY_EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+(* I shouldn't need three minor variations of the same
+   thing here, but here they are *)
+
+let rectagon_subset_endpoint = prove_by_refinement(
+  `!E S k. rectagon E /\ S SUBSET E /\ (0 <| num_closure S (pointI k)) /\
+   (0 <| num_closure (E DIFF S) (pointI k)) ==>
+   (endpoint S k)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[endpoint];
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  THM_INTRO_TAC[`S`;`E`;`pointI k`] num_closure_mono;
+  TYPE_THEN `{0,2} (num_closure E (pointI k))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  FULL_REWRITE_TAC[INSERT];
+  (* - *)
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `num_closure S (pointI k) = 2` SUBAGOAL_TAC;
+  REWR 5;
+  UND 8 THEN UND 1 THEN UND 5 THEN ARITH_TAC;
+  TYPE_THEN `{C | S C /\ closure top2 C (pointI k)} = {C | E C /\ closure top2 C (pointI k)}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  CARD_SUBSET_EQ;
+  USE 9 (REWRITE_RULE[num_closure]);
+  USE 7 (REWRITE_RULE[num_closure]);
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC[SUBSET;];
+  REWRITE_TAC[SUBSET;];
+  FULL_REWRITE_TAC[ISUBSET];
+  (* -- *)
+  USE 0 (REWRITE_RULE[num_closure]);
+  USE 0 (MATCH_MP (ARITH_RULE `0 <| CARD X ==> ~(CARD X = 0)`));
+  TYPE_THEN `{C | (E DIFF S) C /\ closure top2 C (pointI k)} = EMPTY ` SUBAGOAL_TAC;
+  REWRITE_TAC[EQ_EMPTY ];
+  USE 12 (REWRITE_RULE[DIFF]);
+  USE 10 (ONCE_REWRITE_RULE [FUN_EQ_THM]);
+  TSPEC `x` 10;
+  REWR 10;
+  UND 0 THEN ASM_REWRITE_TAC[];
+  REWRITE_TAC[CARD_CLAUSES];
+  UND 7 THEN UND 5 THEN UND 1 THEN ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let psegment_subset_endpoint = prove_by_refinement(
+  `!E S k. psegment E /\ S SUBSET E /\ (0 <| num_closure S (pointI k)) /\
+   (0 <| num_closure (E DIFF S) (pointI k)) ==>
+   (endpoint S k)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[endpoint];
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment;segment];
+  THM_INTRO_TAC[`S`;`E`;`pointI k`] num_closure_mono;
+  TYPE_THEN `{0,1,2} (num_closure E (pointI k))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment;segment];
+  FULL_REWRITE_TAC[INSERT];
+  (* - *)
+  FULL_REWRITE_TAC[DISJ_ACI];
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `num_closure S (pointI k) = 2` SUBAGOAL_TAC;
+  REWR 5;
+  UND 8 THEN UND 1 THEN UND 5 THEN ARITH_TAC;
+  TYPE_THEN `{C | S C /\ closure top2 C (pointI k)} = {C | E C /\ closure top2 C (pointI k)}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  CARD_SUBSET_EQ;
+  USE 9 (REWRITE_RULE[num_closure]);
+  USE 7 (REWRITE_RULE[num_closure]);
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC[SUBSET;];
+  REWRITE_TAC[SUBSET;];
+  FULL_REWRITE_TAC[ISUBSET];
+  (* -- *)
+  USE 0 (REWRITE_RULE[num_closure]);
+  USE 0 (MATCH_MP (ARITH_RULE `0 <| CARD X ==> ~(CARD X = 0)`));
+  TYPE_THEN `{C | (E DIFF S) C /\ closure top2 C (pointI k)} = EMPTY ` SUBAGOAL_TAC;
+  REWRITE_TAC[EQ_EMPTY ];
+  USE 12 (REWRITE_RULE[DIFF]);
+  USE 10 (ONCE_REWRITE_RULE [FUN_EQ_THM]);
+  TSPEC `x` 10;
+  REWR 10;
+  UND 0 THEN ASM_REWRITE_TAC[];
+  REWRITE_TAC[CARD_CLAUSES];
+  (* - *)
+  KILL 6;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`E`;`pointI k`] num_closure1;
+  REWR 8;
+  USE 0 (MATCH_MP num_closure_elt);
+  FULL_REWRITE_TAC[DIFF];
+  USE 1 (MATCH_MP num_closure_elt);
+  COPY 8;
+  TSPEC `e'` 12;
+  TSPEC `e''` 8;
+  FULL_REWRITE_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  (* - *)
+  UND 6 THEN UND 5 THEN UND 1 THEN ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+
+let num_closure_pos = prove_by_refinement(
+  `!G m.
+      FINITE G /\ (?e. G e /\ closure top2 e (pointI m)) ==>
+         (0 <| (num_closure G (pointI m)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC ;
+  TYPE_THEN `num_closure G (pointI m) = 0` SUBAGOAL_TAC;
+  UND 3 THEN ARITH_TAC;
+  THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
+  REWR 5;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let cut_rectagon = prove_by_refinement(
+  `!E m n. (rectagon E) /\ (0 < num_closure E (pointI m)) /\
+     (0 < num_closure E (pointI n)) /\ ~(m = n) ==>
+    (?A B. psegment A /\ psegment B /\ (E = A UNION B) /\
+       (A INTER B = EMPTY) /\ (endpoint A = {m,n}) /\
+       (endpoint B = {m,n}) /\
+       (!k. (0 < num_closure A (pointI k)) /\
+          (0 < num_closure B (pointI k)) ==> (k = m) \/ (k = n) ))
+    `,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  THM_INTRO_TAC[`E`;`pointI m`] num_closure_size;
+  TYPE_THEN `~({C | E C /\ closure top2 C (pointI m)} = EMPTY)` SUBAGOAL_TAC;
+  USE 6 SYM;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  USE 6 (AP_TERM `CARD:(((num->real)->bool)->bool)->num`);
+  USE 6 (REWRITE_RULE[CARD_CLAUSES]);
+(**** Changed by JRH because of new ARITH_RULE's inability to handle alpha equivs
+  UND 6 THEN UND 5 THEN UND 2 THEN ARITH_TAC;
+ ****)
+  UND 6 THEN UND 5 THEN UND 2 THEN REWRITE_TAC[ARITH_RULE `0 < x ==> (y = x) ==> (0 = y) ==> F`];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  (* - *)
+  THM_INTRO_TAC[`E`;`u`;`m`] rectagon_order;
+  TYPE_THEN `!n. (0 <| num_closure E (pointI n)) ==> (num_closure E (pointI n) = 2)` SUBAGOAL_TAC ;
+  TYPE_THEN `{0,2} (num_closure E (pointI n'))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  FULL_REWRITE_TAC[INSERT];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  UND 14 THEN UND 12 THEN ARITH_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  (* -A *)
+  TYPE_THEN `0 < CARD E - 1` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `num_closure E (pointI m) = 2` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`E`;`pointI m`] num_closure;
+  REWR 14;
+  THM_INTRO_TAC[`{C | E C /\ closure top2 C (pointI m)}`;`E`] CARD_SUBSET;
+  REWRITE_TAC[SUBSET];
+  USE 14 SYM ;
+  REWR 15;
+  UND 15 THEN UND 10 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `!m. (closure top2 (f 0) (pointI m)) /\ (closure top2 (f (CARD E - 1)) (pointI m)) ==> (m = adjv (f 0) (f (CARD E -| 1)))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  adjv_unique;
+  FULL_REWRITE_TAC[BIJ;INJ;rectagon;ISUBSET ];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC  ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 10 THEN ARITH_TAC;
+  REWRITE_TAC[adj;EMPTY_EXISTS;INTER;];
+  CONJ_TAC;
+  TYPE_THEN `0 = (CARD E -| 1)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 10 THEN ARITH_TAC;
+  UND 22 THEN UND 10 THEN ARITH_TAC;
+  TYPE_THEN `pointI m'` EXISTS_TAC;
+  (* -B *)
+  TYPE_THEN `num_closure E (pointI n) = 2` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`E`;`pointI n`] num_closure2;
+  REWR 15;
+  TYPE_THEN `E a /\ closure top2 a (pointI n)` SUBAGOAL_TAC;
+  TYPE_THEN `E b /\ closure top2 b (pointI n)` SUBAGOAL_TAC;
+  TYPE_THEN `?i. (i < CARD E) /\ (f i = a)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[BIJ;SURJ];
+  TYPE_THEN `a` UNABBREV_TAC;
+  TYPE_THEN `?j. (j < CARD E) /\ (f j = b)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[BIJ;SURJ];
+  TYPE_THEN `b` UNABBREV_TAC;
+  COPY 8;
+  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  (* - *)
+  TYPE_THEN `adj (f i) (f j)` SUBAGOAL_TAC THEN REWRITE_TAC[adj];
+  REWRITE_TAC[INTER;EMPTY_EXISTS ];
+  UNIFY_EXISTS_TAC;
+  REWR 8;
+  (* -C *)
+  TYPE_THEN `edge (f i)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon;ISUBSET];
+  TYPE_THEN `edge (f j)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon;ISUBSET];
+  TYPE_THEN `?k. (k < CARD E -| 1) /\ (n = adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `i` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 27 THEN UND 23 THEN ARITH_TAC;
+  IMATCH_MP_TAC  adjv_unique;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 28 THEN UND 22 THEN ARITH_TAC;
+  IMATCH_MP_TAC  adjv_unique;
+  USE 24 (ONCE_REWRITE_RULE[adj_symm]);
+  (* -- *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `i` UNABBREV_TAC;
+  TYPE_THEN `j` UNABBREV_TAC;
+  COPY 13;
+  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`m`]);
+  UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`n`]);
+  PROOF_BY_CONTR_TAC;
+  UND 29 THEN UND 13 THEN UND 0 THEN MESON_TAC[];
+  TYPE_THEN `i` UNABBREV_TAC;
+  TYPE_THEN `j` UNABBREV_TAC;
+  COPY 13;
+  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`m`]);
+  UND 29 THEN DISCH_THEN (THM_INTRO_TAC[`n`]);
+  PROOF_BY_CONTR_TAC;
+  UND 29 THEN UND 13 THEN UND 0 THEN MESON_TAC[];
+  (* - *)
+  TYPE_THEN `A = IMAGE f {p | p <| SUC(k)}` ABBREV_TAC ;
+  TYPE_THEN `B = IMAGE f {p | SUC(k) <=| p /\ p < CARD E}` ABBREV_TAC ;
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `B` EXISTS_TAC;
+  (* -D , now prove properties *)
+  KILL 26;
+  KILL 25;
+  KILL 8;
+  KILL 24;
+  KILL 23;
+  KILL 22;
+  KILL 19;
+  KILL 20;
+  KILL 17;
+  KILL 18;
+  KILL 15;
+  KILL 16;
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  IMATCH_MP_TAC  order_imp_psegment;
+  REWRITE_TAC[ARITH_RULE `0 <| SUC k`];
+  (* -- *)
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[BIJ;INJ];
+  TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon;ISUBSET];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 17 THEN UND 28 THEN ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 18 THEN UND 19 THEN UND 28 THEN ARITH_TAC;
+  (* -- *)
+  UND 21 THEN DISCH_THEN (  THM_INTRO_TAC[`i`;`j`]);
+  UND 8 THEN UND 15 THEN UND 28 THEN ARITH_TAC;
+  TYPE_THEN `~(j = CARD E -| 1)` SUBAGOAL_TAC;
+  UND 18 THEN UND 8 THEN UND 28 THEN ARITH_TAC;
+  TYPE_THEN `~(i = CARD E -| 1)` SUBAGOAL_TAC;
+  UND 19 THEN UND 15 THEN UND 28 THEN ARITH_TAC;
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  IMATCH_MP_TAC  order_imp_psegment_shift;
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[BIJ;INJ];
+  TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon;ISUBSET];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  CONJ_TAC;
+  UND 28 THEN ARITH_TAC;
+  (* -- *)
+  UND 21 THEN DISCH_THEN (  THM_INTRO_TAC[`i`;`j`]);
+  TYPE_THEN `~(j = 0)` SUBAGOAL_TAC;
+  UND 21 THEN UND 17 THEN ARITH_TAC;
+  TYPE_THEN `~(i = 0)` SUBAGOAL_TAC;
+  UND 22 THEN UND 19 THEN ARITH_TAC;
+  (* -E *)
+  SUBCONJ_TAC;
+  TYPE_THEN `(IMAGE f {p | p <| CARD E} = E)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  bij_imp_image;
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[GSYM IMAGE_UNION];
+  TYPE_THEN `cE = CARD E` ABBREV_TAC ;
+  UND 16 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  UND 28 THEN ARITH_TAC;
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC ;
+  REWRITE_TAC[IMAGE];
+  PROOF_BY_CONTR_TAC ;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `u'` UNABBREV_TAC;
+  TYPE_THEN `x = x'` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[BIJ;INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 22 THEN UND 28 THEN ARITH_TAC;
+  UND 20 THEN UND 19 THEN UND 22 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `E DIFF A = B` SUBAGOAL_TAC;
+  UND 17 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
+  TYPE_THEN `E DIFF B = A` SUBAGOAL_TAC;
+  UND 17 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
+  (* - finite A ,B *)
+  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  (* -F *)
+  TYPE_THEN `edge (f k) /\ edge (f (SUC k)) /\ adj (f k) (f (SUC k))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon;ISUBSET];
+  KILL 16;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 11 (REWRITE_RULE[BIJ;SURJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 28 THEN ARITH_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 11 (REWRITE_RULE[BIJ;SURJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 28 THEN ARITH_TAC;
+  UND 21 THEN DISCH_THEN (THM_INTRO_TAC[`k`;`SUC k`]);
+  UND 28 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `0 <| num_closure A (pointI n)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  num_closure_pos;
+  TYPE_THEN `f k` EXISTS_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `k` EXISTS_TAC;
+  ARITH_TAC;
+  IMATCH_MP_TAC  adjv_adj;
+  (* - *)
+  TYPE_THEN `0 <| num_closure B (pointI n)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  num_closure_pos;
+  TYPE_THEN `f (SUC k)` EXISTS_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `SUC k` EXISTS_TAC;
+  UND 28 THEN ARITH_TAC;
+  IMATCH_MP_TAC  adjv_adj2;
+  (* - *)
+  TYPE_THEN `0 <| num_closure A (pointI m)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  num_closure_pos;
+  TYPE_THEN `f 0` EXISTS_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `0` EXISTS_TAC;
+  ARITH_TAC;
+  (* - *)
+  TYPE_THEN `0 <| num_closure B (pointI m)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  num_closure_pos;
+  KILL 16;
+  TYPE_THEN `f (CARD E -| 1)` EXISTS_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `CARD E -| 1` EXISTS_TAC;
+  UND 28 THEN ARITH_TAC;
+  (* -G *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  has_size2_pair;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  endpoint_size2;
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_subset_endpoint;
+  UNIFY_EXISTS_TAC ;
+  ASM_REWRITE_TAC[SUBSET;UNION];
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_subset_endpoint;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `n` UNABBREV_TAC;
+  UND 34 THEN UND 27 THEN UND 0 THEN MESON_TAC[];
+  (* - *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  has_size2_pair;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  endpoint_size2;
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_subset_endpoint;
+  UNIFY_EXISTS_TAC ;
+  ASM_REWRITE_TAC[SUBSET;UNION];
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_subset_endpoint;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `n` UNABBREV_TAC;
+  UND 35 THEN UND 27 THEN UND 0 THEN MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`E`;`A`;`k'`] rectagon_subset_endpoint;
+  ASM_REWRITE_TAC[SUBSET;UNION];
+  REWR 38;
+  USE 38 (REWRITE_RULE[INR in_pair]);
+  UND 38 THEN MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION S *)
+(* ------------------------------------------------------------------ *)
+
+(* 2 - connected *)
+
+
+(* -------------- MOVE TO TACTICS,  *)
+(* proves ineqs of the form a + (&:0)*c <= b.
+   This handles ineqs such as a <=: a + &:(SUC n) that
+   INT_ARITH_TAC can't do.  *)
+
+let int_le_mp = prove_by_refinement(
+  `!a b c. (a +: c = b) /\ (&:0 <=: c) ==> (a + (&:0)*c <=: b)`,
+  (* {{{ proof *)
+  [
+  INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+(* rewrites assumptions as 0 <= A, breaks 0 <= A + B into 2,
+   then breaks 0 <= A*B into 2, and tries rewriting and INT_ARITH_TAC *)
+
+let int_le_tac = RULE_ASSUM_TAC (ONCE_REWRITE_RULE [GSYM INT_SUB_LE]) THEN
+             IMATCH_MP_TAC  int_le_mp THEN
+             CONJ_TAC THENL [TRY INT_ARITH_TAC;ALL_TAC] THEN
+             ASM_REWRITE_TAC[INT_POS] THEN
+             REPEAT (IMATCH_MP_TAC  INT_LE_ADD THEN CONJ_TAC THEN
+             ASM_REWRITE_TAC[INT_POS]) THEN
+             REPEAT (IMATCH_MP_TAC  INT_LE_MUL THEN CONJ_TAC THEN
+             ASM_REWRITE_TAC[INT_POS]) THEN
+             ASM_REWRITE_TAC[INT_POS] THEN
+             TRY INT_ARITH_TAC;;
+
+
+let clean_int_le_tac = FULL_REWRITE_TAC[INT_MUL_LZERO;INT_ADD_RID];;
+
+let test_case_int_le_tac = prove_by_refinement(
+  `!a b n. a +: &:(SUC n) <= b ==> a <= b`,
+  (* {{{ proof *)
+  [
+  (* INT_ARITH_TAC fails *)
+  REP_BASIC_TAC;
+  TYPE_THEN `a + (&:0)*((b - (a +: &:(SUC n))) + (&:(SUC n))) <=: b` SUBAGOAL_TAC;
+  int_le_tac;
+  clean_int_le_tac;
+  ]);;
+  (* }}} *)
+
+
+
+
+(* -------------- *)
+
+let segment_end = jordan_def `segment_end S a b <=>
+   psegment S /\ (endpoint S = {a,b})`;;
+
+let conn = jordan_def `conn E <=> (!a b.
+   (cls E a /\ cls E b /\ ~(a = b) ==>
+        (?S. (S SUBSET E /\ segment_end S a b))))`;;
+
+let conn2 = jordan_def `conn2 E <=> (FINITE E) /\
+   (2 <=| CARD E) /\ (!a b c. cls E a /\ cls E b /\
+   ~(a = b) /\ ~(b = c) /\ ~(a = c) ==>
+   (?S. (S SUBSET E /\ segment_end S a b /\ ~(cls S c))))`;;
+
+let segment_end_symm = prove_by_refinement(
+  `!S a b. (segment_end S a b = segment_end S b a)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[segment_end];
+  TYPE_THEN `{a,b} = {b,a}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR in_pair];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let segment_end_disj = prove_by_refinement(
+  `!S a b. segment_end S a b ==> ~(a = b)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[segment_end];
+  THM_INTRO_TAC[`S`] endpoint_size2;
+  USE 3 (REWRITE_RULE[has_size2]);
+  TYPE_THEN `endpoint S` UNABBREV_TAC;
+  USE 1 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  FULL_REWRITE_TAC[INR in_pair];
+  COPY 1;
+  TSPEC `a'` 4;
+  TSPEC `b'` 1;
+  REWR 1;
+  REWR 4;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let cut_psegment = prove_by_refinement(
+  `!E a b c. segment_end E a b /\ cls E c /\ ~(c = a) /\ ~(c = b) ==>
+    (?A B. (E = (A UNION B)) /\ (A INTER B = EMPTY) /\
+     (cls A INTER cls B = {c}) /\
+     segment_end A a c /\ segment_end B c b)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `~(a = b)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`E`;`a`;`b`] segment_end_disj;
+  ASM_MESON_TAC[];
+  (* - *)
+  FULL_REWRITE_TAC[segment_end];
+  FULL_REWRITE_TAC[cls];
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment;segment];
+  REWRITE_TAC[INR eq_sing;INTER;EQ_EMPTY  ];
+  REWRITE_TAC[CONJ_ACI];
+  (* - *)
+  THM_INTRO_TAC[`E`;`a`;`b`] psegment_order;
+  REWRITE_TAC[INR in_pair];
+  TYPE_THEN `num_closure E (pointI c) = 2` SUBAGOAL_TAC;
+  TYPE_THEN `{0,1,2} (num_closure E (pointI c))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment;segment];
+  FULL_REWRITE_TAC[INSERT;DISJ_ACI];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  USE 3 SYM;
+  TYPE_THEN `endpoint E c` SUBAGOAL_TAC;
+  REWRITE_TAC[endpoint];
+  TYPE_THEN `endpoint E` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`E`;`pointI c`] num_closure0;
+  REWR 15;
+  TSPEC `e` 15;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `?k. (k < CARD E -| 1) /\ (c = adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`E`;`pointI c`] num_closure2;
+  REWR 13;
+  TYPE_THEN `E a' /\ closure top2 a' (pointI c)` SUBAGOAL_TAC;
+  TYPE_THEN `?i'.  (i' <| CARD E) /\ ( f i' = a')` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[BIJ;SURJ];
+  TYPE_THEN `a'` UNABBREV_TAC;
+  TYPE_THEN `E b' /\ closure top2 b' (pointI c)` SUBAGOAL_TAC;
+  TYPE_THEN `?j'.  (j' <| CARD E) /\ ( f j' = b')` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[BIJ;SURJ];
+  TYPE_THEN `b'` UNABBREV_TAC;
+  UND 8 THEN DISCH_THEN (  THM_INTRO_TAC[`i'`;`j'`]);
+  USE 8 SYM;
+  TYPE_THEN `adj (f i') (f j')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  closure_imp_adj;
+  UNIFY_EXISTS_TAC;
+  REWR 8;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN  `i'` EXISTS_TAC;
+  CONJ_TAC;
+  UND 22 THEN UND 21 THEN ARITH_TAC;
+  IMATCH_MP_TAC  adjv_unique;
+  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
+  TYPE_THEN `j'` EXISTS_TAC;
+  CONJ_TAC;
+  UND 22 THEN UND 18 THEN ARITH_TAC;
+  IMATCH_MP_TAC  adjv_unique;
+  USE 20 (ONCE_REWRITE_RULE[adj_symm]);
+  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
+  (* -A *)
+  TYPE_THEN `c` UNABBREV_TAC;
+  TYPE_THEN `A = IMAGE f { p | p <| SUC k}` ABBREV_TAC ;
+  TYPE_THEN `B = IMAGE f { p | SUC k <=| p /\ p < CARD E}` ABBREV_TAC ;
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `B` EXISTS_TAC;
+  (* - now prove properties *)
+  TYPE_THEN `psegment A` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  IMATCH_MP_TAC  order_imp_psegment;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[BIJ;INJ];
+  TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 18 THEN UND 14 THEN ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 19 THEN UND 20 THEN UND 14 THEN ARITH_TAC;
+  CONJ_TAC;
+  ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 13 THEN UND 16 THEN UND 14 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `psegment B` SUBAGOAL_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  IMATCH_MP_TAC  order_imp_psegment_shift;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[BIJ;INJ];
+  TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  CONJ_TAC;
+  UND 14 THEN ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  FULL_REWRITE_TAC[IMAGE];
+  TYPE_THEN`x` UNABBREV_TAC;
+  TYPE_THEN `x' = x''` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[BIJ;INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 15 THEN UND 14 THEN ARITH_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  UND 15 THEN UND 20 THEN ARITH_TAC;
+  (* -B *)
+  TYPE_THEN `!x. E x ==> edge x` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment;segment;ISUBSET];
+  (* - *)
+  TYPE_THEN `edge (f k) /\ edge (f (SUC k)) /\ adj (f k) (f (SUC k))` SUBAGOAL_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FULL_REWRITE_TAC[BIJ;SURJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 14 THEN ARITH_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FULL_REWRITE_TAC[BIJ;SURJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 14 THEN ARITH_TAC;
+  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`k`;`SUC k`]);
+  UND 14 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `(?e. A e /\ closure top2 e (pointI (adjv (f k) (f (SUC k)))))` SUBAGOAL_TAC;
+  TYPE_THEN `f k` EXISTS_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `k` EXISTS_TAC;
+  ARITH_TAC;
+  IMATCH_MP_TAC  adjv_adj;
+  (* - *)
+  TYPE_THEN `(?e. B e /\ closure top2 e (pointI (adjv (f k) (f (SUC k)))))` SUBAGOAL_TAC;
+  TYPE_THEN `f (SUC k)` EXISTS_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `SUC k` EXISTS_TAC;
+  UND 14 THEN ARITH_TAC;
+  IMATCH_MP_TAC  adjv_adj2;
+  (* - *)
+  TYPE_THEN `IMAGE f {p | p <| CARD E} = E` SUBAGOAL_TAC;
+  IMATCH_MP_TAC bij_imp_image;
+  (* - *)
+  TYPE_THEN `A UNION B = E` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[GSYM IMAGE_UNION];
+  TYPE_THEN `cE = CARD E` ABBREV_TAC ;
+  UND 27 THEN (DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t])) THEN AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  UND 14 THEN ARITH_TAC;
+  (* -C *)
+  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  USE 28 SYM;
+  REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  USE 28 SYM;
+  REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `E DIFF A = B` SUBAGOAL_TAC;
+  USE 28 SYM;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;DIFF];
+  UND 18 THEN MESON_TAC[];
+  (* - *)
+  TYPE_THEN `E DIFF B = A` SUBAGOAL_TAC;
+  USE 28 SYM;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;DIFF];
+  UND 18 THEN MESON_TAC[];
+  (* - *)
+  TYPE_THEN `endpoint A (adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  psegment_subset_endpoint;
+  UNIFY_EXISTS_TAC;
+  USE 28 (SYM);
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  REWRITE_TAC[ARITH_RULE `(0 <| x) <=> ~(x = 0)`];
+  CONJ_TAC;
+  THM_INTRO_TAC[`A`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
+  REWR 34;
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`B`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
+  REWR 34;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `endpoint B (adjv (f k) (f (SUC k)))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  psegment_subset_endpoint;
+  UNIFY_EXISTS_TAC;
+  USE 28 (SYM);
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  REWRITE_TAC[ARITH_RULE `(0 <| x) <=> ~(x = 0)`];
+  CONJ_TAC;
+  THM_INTRO_TAC[`B`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
+  REWR 35;
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`A`;`(pointI (adjv (f k) (f (SUC k))))`] num_closure0;
+  REWR 35;
+  ASM_MESON_TAC[];
+  (* -D *)
+  TYPE_THEN `endpoint A a` SUBAGOAL_TAC;
+  REWRITE_TAC[endpoint];
+  TYPE_THEN `endpoint E a` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  THM_INTRO_TAC[`A`;`E`;`pointI a`] num_closure_mono;
+  USE 28 SYM;
+  REWRITE_TAC[SUBSET;UNION];
+  USE 35 (REWRITE_RULE[endpoint]);
+  REWR 36;
+  USE 36 (REWRITE_RULE[ARITH_RULE `(x <=| 1) <=> (x = 1) \/ (x = 0)`]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`A`;`pointI a`] num_closure0;
+  REWR 38;
+  TSPEC `f 0` 38 ;
+  USE 10 SYM;
+  UND 38 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  TYPE_THEN`A` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `0` EXISTS_TAC;
+  ARITH_TAC;
+  THM_INTRO_TAC[`E`;`a`] terminal_endpoint;
+  REWRITE_TAC[INR in_pair];
+  UND 39 THEN ASM_REWRITE_TAC[];
+  (* -E *)
+  TYPE_THEN `endpoint B b` SUBAGOAL_TAC;
+  REWRITE_TAC[endpoint];
+  TYPE_THEN `endpoint E b` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  THM_INTRO_TAC[`B`;`E`;`pointI b`] num_closure_mono;
+  USE 28 SYM;
+  REWRITE_TAC[SUBSET;UNION];
+  USE 36 (REWRITE_RULE[endpoint]);
+  REWR 37;
+  USE 37 (REWRITE_RULE[ARITH_RULE `(x <=| 1) <=> (x = 1) \/ (x = 0)`]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`B`;`pointI b`] num_closure0;
+  REWR 39;
+  TSPEC `f (CARD E -| 1)` 39 ;
+  UND 39 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  TYPE_THEN`B` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `CARD E -| 1` EXISTS_TAC;
+  UND 14 THEN ARITH_TAC;
+  THM_INTRO_TAC[`E`;`b`] terminal_endpoint;
+  REWRITE_TAC[INR in_pair];
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  UND 14 THEN ARITH_TAC;
+  UND 39 THEN ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `endpoint A = {a, (adjv (f k) (f (SUC k)))}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  has_size2_pair;
+  IMATCH_MP_TAC  endpoint_size2;
+  TYPE_THEN `endpoint B = {(adjv (f k) (f (SUC k))), b}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  has_size2_pair;
+  IMATCH_MP_TAC  endpoint_size2;
+  (* - *)
+  CONJ_TAC;
+  USE 37 SYM;
+  TYPE_THEN `endpoint A u` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  psegment_subset_endpoint;
+  UNIFY_EXISTS_TAC;
+  CONJ_TAC;
+  USE 28 SYM;
+  REWRITE_TAC[SUBSET;UNION];
+  CONJ_TAC;
+  IMATCH_MP_TAC  num_closure_pos;
+  UNIFY_EXISTS_TAC;
+  IMATCH_MP_TAC  num_closure_pos;
+  TYPE_THEN `e''''` EXISTS_TAC ;
+  USE 38 SYM;
+  TYPE_THEN `endpoint B u` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  psegment_subset_endpoint;
+  UNIFY_EXISTS_TAC;
+  CONJ_TAC;
+  USE 28 SYM;
+  REWRITE_TAC[SUBSET;UNION];
+  CONJ_TAC;
+  IMATCH_MP_TAC  num_closure_pos;
+  TYPE_THEN `e''''` EXISTS_TAC ;
+  IMATCH_MP_TAC  num_closure_pos;
+  TYPE_THEN `e'''` EXISTS_TAC ;
+  TYPE_THEN `endpoint A` UNABBREV_TAC;
+  TYPE_THEN `endpoint B` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INR in_pair];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `e'` EXISTS_TAC;
+  TYPE_THEN `e''` EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+let segment_end_inj = prove_by_refinement(
+  `!S a b c. (segment_end S a b /\ segment_end S a c) ==> (b = c)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`S`;`a`;`b`] segment_end_disj;
+  THM_INTRO_TAC[`S`;`a`;`c`] segment_end_disj;
+  FULL_REWRITE_TAC[segment_end];
+  TYPE_THEN `endpoint S` UNABBREV_TAC;
+  USE 0 (ONCE_REWRITE_RULE  [FUN_EQ_THM]);
+  TSPEC `b` 0;
+  FULL_REWRITE_TAC[INR in_pair];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let segment_end_finite = prove_by_refinement(
+  `!S a b. segment_end S a b ==> FINITE S`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[segment_end;psegment;segment];
+  ]);;
+  (* }}} *)
+
+let segment_superset_endpoint = prove_by_refinement(
+  `!E S k. segment E /\ S SUBSET E /\ (endpoint S k) /\
+     (num_closure (E DIFF S) (pointI k) = 0) ==>
+     (endpoint E k) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[endpoint];
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment];
+  ASM_SIMP_TAC[num_closure1];
+  TYPE_THEN `FINITE S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  THM_INTRO_TAC[`S`;`pointI k`] num_closure1;
+  REWR 6;
+  TYPE_THEN `e` EXISTS_TAC;
+  TYPE_THEN `S e /\ closure top2 e (pointI k)` SUBAGOAL_TAC;
+  TYPE_THEN `S e'` ASM_CASES_TAC;
+  FULL_REWRITE_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`S`;`pointI k`] num_closure0;
+  REWR 10;
+  FULL_REWRITE_TAC[ARITH_RULE `~(1=0)`];
+  TYPE_THEN `~(e = e')` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[];
+  USE 0 (REWRITE_RULE[ARITH_RULE `(x = 0) <=> ~(0 <| x)`]);
+  UND 0 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  num_closure_pos;
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  TYPE_THEN `e'` EXISTS_TAC;
+  REWRITE_TAC[DIFF];
+  ]);;
+  (* }}} *)
+
+let segment_end_union_lemma = prove_by_refinement(
+  `!A B a b c. segment_end A a b /\ segment_end B b c /\
+     (A INTER B = EMPTY) /\ (cls A INTER cls B = {b}) ==>
+    segment_end (A UNION B) a c `,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`A`;`a`;`b`] segment_end_disj;
+  THM_INTRO_TAC[`B`;`b`;`c`] segment_end_disj;
+  FULL_REWRITE_TAC[cls;segment_end];
+  TYPE_THEN `segment (A UNION B) /\ (endpoint (A UNION B) = {a,c})  ==> psegment (A UNION B) /\ (endpoint (A UNION B) = {a, c})` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  endpoint_psegment;
+  TYPE_THEN `a` EXISTS_TAC;
+  REWRITE_TAC[INR in_pair];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  segment_union;
+  TYPE_THEN `b` EXISTS_TAC;
+  REWRITE_TAC[INR in_pair];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment];
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  FULL_REWRITE_TAC[INR IN_SING;INTER;];
+  TSPEC `n` 0;
+  ASM_MESON_TAC[num_closure_elt];
+  (* - *)
+  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment;segment];
+  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment;segment];
+  TYPE_THEN `FINITE (A UNION B)` SUBAGOAL_TAC;
+  REWRITE_TAC[FINITE_UNION];
+  (* -A *)
+  TYPE_THEN `endpoint (A UNION B) a` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  segment_superset_endpoint;
+  TYPE_THEN `A` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION ];
+  REWRITE_TAC[INR in_pair];
+  TYPE_THEN `(A UNION B) DIFF A = B` SUBAGOAL_TAC;
+  UND 1 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
+  ASM_SIMP_TAC[num_closure0];
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
+  TSPEC `a` 0;
+  TYPE_THEN `(?e. A e /\ closure top2 e (pointI a))` SUBAGOAL_TAC;
+  TYPE_THEN `terminal_edge A a` EXISTS_TAC;
+  TYPE_THEN `endpoint A a` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  IMATCH_MP_TAC  terminal_endpoint;
+  ASM_MESON_TAC[];
+  TYPE_THEN `psegment (A UNION B)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[endpoint_psegment];
+  IMATCH_MP_TAC  has_size2_pair;
+  (* - *)
+  TYPE_THEN `endpoint (A UNION B) c` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  segment_superset_endpoint;
+  TYPE_THEN `B` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION ];
+  REWRITE_TAC[INR in_pair];
+  TYPE_THEN `(A UNION B) DIFF B = A` SUBAGOAL_TAC;
+  UND 1 THEN SET_TAC[UNION;DIFF;INTER;EMPTY];
+  ASM_SIMP_TAC[num_closure0];
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
+  TSPEC `c` 0;
+  TYPE_THEN `(?e. B e /\ closure top2 e (pointI c))` SUBAGOAL_TAC;
+  TYPE_THEN `terminal_edge B c` EXISTS_TAC;
+  TYPE_THEN `endpoint B c` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  IMATCH_MP_TAC  terminal_endpoint;
+  ASM_MESON_TAC[];
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  endpoint_size2;
+  (* - *)
+  TYPE_THEN`a` UNABBREV_TAC;
+  TYPE_THEN `endpoint B c /\ endpoint A c` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 0 (REWRITE_RULE[INTER;INR IN_SING]);
+  TSPEC `c` 0;
+  TYPE_THEN `(?e. A e /\ closure top2 e (pointI c))` SUBAGOAL_TAC;
+  TYPE_THEN `terminal_edge A c` EXISTS_TAC;
+  IMATCH_MP_TAC  terminal_endpoint;
+  TYPE_THEN `(?e. B e /\ closure top2 e (pointI c))` SUBAGOAL_TAC;
+  TYPE_THEN `terminal_edge B c` EXISTS_TAC;
+  IMATCH_MP_TAC  terminal_endpoint;
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let cls_subset = prove_by_refinement(
+  `!A B. A SUBSET B ==> cls A SUBSET cls B`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cls];
+  REWRITE_TAC[SUBSET];
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  ]);;
+  (* }}} *)
+
+let segment_end_union = prove_by_refinement(
+  `!A B a b c. segment_end A a b /\ segment_end B b c /\
+     (cls A INTER cls B = {b}) ==>
+    segment_end (A UNION B) a c`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  segment_end_union_lemma;
+  TYPE_THEN `b` EXISTS_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  TYPE_THEN `edge u` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end;psegment;segment;ISUBSET];
+  TYPE_THEN `(cls {u} ) HAS_SIZE 2` SUBAGOAL_TAC;
+  REWRITE_TAC[cls_edge];
+  IMATCH_MP_TAC  two_endpoint;
+  FULL_REWRITE_TAC[has_size2];
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 0 (REWRITE_RULE[INR IN_SING ]);
+  COPY 0;
+  TSPEC  `a'` 8;
+  TSPEC `b'` 0;
+  TYPE_THEN `cls {u} a' /\ cls {u} b'` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  KILL 7;
+  TYPE_THEN `cls {u} SUBSET cls A` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  TYPE_THEN `cls {u} SUBSET cls B` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  FULL_REWRITE_TAC[ISUBSET];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let segment_end_cls = prove_by_refinement(
+  `!A a b. segment_end A a b ==> cls A a`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cls;segment_end];
+  TYPE_THEN `terminal_edge A a` EXISTS_TAC;
+  IMATCH_MP_TAC  terminal_endpoint;
+  FULL_REWRITE_TAC[INR in_pair;psegment;segment];
+  ]);;
+  (* }}} *)
+
+let segment_end_cls2 = prove_by_refinement(
+  `!A a b. segment_end A a b ==> cls A b`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cls;segment_end];
+  TYPE_THEN `terminal_edge A b` EXISTS_TAC;
+  IMATCH_MP_TAC  terminal_endpoint;
+  FULL_REWRITE_TAC[INR in_pair;psegment;segment];
+  ]);;
+  (* }}} *)
+
+let card_subset_lt = prove_by_refinement(
+  `!(a:A->bool) b. a SUBSET b /\ ~(a = b) /\ FINITE b ==>
+          (CARD a < CARD b)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE (`x <=| y /\ ~( x = y) ==> (x < y)`));
+  CONJ_TAC;
+  IMATCH_MP_TAC  CARD_SUBSET;
+  UND 1 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  CARD_SUBSET_EQ;
+  ]);;
+  (* }}} *)
+
+let segment_end_trans = prove_by_refinement(
+  `!R S a b c. segment_end R a b /\ segment_end S b c /\ ~(a = c) ==>
+     (?U. segment_end U a c /\ (U SUBSET (R UNION S)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN`SS = { (U,V,b') | segment_end U a b' /\ segment_end V b' c /\ (U SUBSET (R UNION S) /\ V SUBSET (R UNION S) ) }` ABBREV_TAC ;
+  TYPE_THEN `~(SS = EMPTY)` SUBAGOAL_TAC;
+  UND 4 THEN REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `(R,S,b)` EXISTS_TAC;
+  TYPE_THEN `SS` UNABBREV_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "U");
+  CONV_TAC (dropq_conv "V");
+  TYPE_THEN `b` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `FINITE R` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  segment_end_finite;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `FINITE S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  segment_end_finite;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `FINITE (R UNION S)` SUBAGOAL_TAC;
+  ASM_REWRITE_TAC[FINITE_UNION];
+  (* - *)
+  TYPE_THEN `f = (\ ((U,V,b):((((num->real)->bool)->bool)#((((num->real)->bool)->bool)#(int#int))) ). (CARD U) + (CARD V))` ABBREV_TAC ;
+  THM_INTRO_TAC[`SS`;`f`] select_image_num_min;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `?Um Vm bm. z = (Um,Vm,bm)` SUBAGOAL_TAC ;
+  REWRITE_TAC[PAIR_SPLIT];
+  MESON_TAC[];
+  TYPE_THEN `z` UNABBREV_TAC;
+  TYPE_THEN `!U' V' b''. (SS (U',V',b'') ==> f (Um,Vm,bm) <=| f (U',V',b''))` SUBAGOAL_TAC;
+  KILL 9;
+  TYPE_THEN `SS` UNABBREV_TAC;
+  KILL 4;
+  (* - *)
+  USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
+  REWR 4;
+  TYPE_THEN `U` UNABBREV_TAC;
+  USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
+  REWR 4;
+  TYPE_THEN `V` UNABBREV_TAC;
+  TYPE_THEN `b'` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `! U V b'. f (U,V,b') = CARD U +| CARD V` SUBAGOAL_TAC;
+  USE 8 SYM;
+  GBETA_TAC;
+  KILL 8;
+  REWR 11;
+  KILL 3;
+  USE 4 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
+  REWR 3;
+  USE 3 (CONV_RULE (dropq_conv "U"));
+  USE 3 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
+  REWR 3;
+  USE 3 (CONV_RULE (dropq_conv "V"));
+  USE 3 (CONV_RULE (dropq_conv "b''"));
+  (* - *)
+  TYPE_THEN `FINITE Vm` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `FINITE Um` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  (* -A *)
+  THM_INTRO_TAC[`S`;`b`;`c`] segment_end_disj;
+  THM_INTRO_TAC[`R`;`a`;`b`] segment_end_disj;
+  TYPE_THEN `cls Vm a` ASM_CASES_TAC;
+  THM_INTRO_TAC[`Vm`;`bm`;`c`;`a`] cut_psegment;
+  THM_INTRO_TAC[`Um`;`a`;`bm`] segment_end_disj;
+  TYPE_THEN `B` EXISTS_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Vm` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `cls Um c` ASM_CASES_TAC;
+  THM_INTRO_TAC[`Um`;`a`;`bm`;`c`] cut_psegment;
+  THM_INTRO_TAC[`Vm`;`bm`;`c`] segment_end_disj;
+  TYPE_THEN `A` EXISTS_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Um` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `Um UNION Vm` EXISTS_TAC;
+  IMATCH_MP_TAC  (TAUT ` a /\ b ==> b /\ a`);
+  SUBCONJ_TAC;
+  REWRITE_TAC[union_subset];
+  (* - *)
+  IMATCH_MP_TAC  segment_end_union;
+  TYPE_THEN `bm` EXISTS_TAC;
+  REWRITE_TAC[INTER;eq_sing];
+  TYPE_THEN `cls Um bm /\ cls Vm bm` SUBAGOAL_TAC;
+  ASM_MESON_TAC[segment_end_cls;segment_end_cls2];
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  (* -B *)
+  TYPE_THEN `~(u = a)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `~(u = c)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`Vm`;`bm`;`c`;`u`] cut_psegment;
+  THM_INTRO_TAC[`Um`;`a`;`bm`;`u`] cut_psegment;
+  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`A'`;`B`;`u`]);
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Um` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Vm` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `FINITE A'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `Um` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `Vm` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  (* -C *)
+  USE 34 SYM;
+  TYPE_THEN `CARD A' < CARD Um` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  card_subset_lt;
+  USE 34 SYM;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `B' = EMPTY` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[UNION;INTER;EQ_EMPTY];
+  USE 37(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 37;
+  FULL_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  TYPE_THEN`B'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[segment_end;segment;psegment];
+  (* - *)
+  USE 29 SYM;
+  TYPE_THEN `CARD B < CARD Vm` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  card_subset_lt;
+  USE 29 SYM;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `A = EMPTY` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[UNION;INTER;EQ_EMPTY];
+  USE 38(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 38;
+  FULL_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  TYPE_THEN`A` UNABBREV_TAC;
+  FULL_REWRITE_TAC[segment_end;segment;psegment];
+  (* - *)
+  UND 38 THEN UND 37 THEN UND 3 THEN ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let cls_union = prove_by_refinement(
+  `!A B. cls(A UNION B) = cls A UNION cls B`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cls;UNION ];
+  IMATCH_MP_TAC  EQ_EXT;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let conn_union = prove_by_refinement(
+  `!E E'. conn E /\ conn E' /\ ~(cls E INTER cls E' = EMPTY) ==>
+    conn (E UNION E')`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[conn;cls_union];
+  RULE_ASSUM_TAC (REWRITE_RULE[UNION]);
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `!E E' a b u. ~(a = b) /\ ~cls E b /\ ~cls E' a /\ cls E a /\ cls E' b /\ (conn E) /\ (conn E') /\ cls E u /\ cls E' u ==> (?S. S SUBSET (E UNION E') /\  segment_end S a b)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[conn];
+  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`u'`]);
+  ASM_MESON_TAC [];
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`u'`;`b'`]);
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`S`;`S'`;`a'`;`u'`;`b'`] segment_end_trans;
+  TYPE_THEN `U` EXISTS_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `S UNION S'` EXISTS_TAC;
+  IMATCH_MP_TAC  subset_union_pair;
+  (* - *)
+  TYPE_THEN `cls E a /\ cls E b` ASM_CASES_TAC;
+  USE 2 (REWRITE_RULE[conn]);
+  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]);
+  TYPE_THEN `S` EXISTS_TAC;
+  UND 10 THEN REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `cls E' a /\ cls E' b` ASM_CASES_TAC;
+  USE 1 (REWRITE_RULE[conn]);
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]);
+  TYPE_THEN `S` EXISTS_TAC;
+  UND 11 THEN REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `cls E a /\ cls E' b` ASM_CASES_TAC;
+  REWR 9;
+  REWR 8;
+  UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`E`;`E'`;`a`;`b`;`u`]);
+  (* - *)
+  TYPE_THEN `cls E' a /\ cls E b` ASM_CASES_TAC;
+  REWR 9;
+  REWR 8;
+  UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`E'`;`E`;`a`;`b`;`u`]);
+  TYPE_THEN `S` EXISTS_TAC;
+  UND 13 THEN REWRITE_TAC[SUBSET;UNION];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let cls_empty = prove_by_refinement(
+  `cls EMPTY  = EMPTY `,
+  (* {{{ proof *)
+  [
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[cls];
+  ]);;
+  (* }}} *)
+
+let finite_cls = prove_by_refinement(
+  `!E. FINITE E  ==> (E SUBSET edge ==> FINITE (cls E))`,
+  (* {{{ proof *)
+  [
+  IMATCH_MP_TAC  FINITE_INDUCT_STRONG;
+  REWRITE_TAC[cls_empty;FINITE_RULES ];
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `cls (E UNION {x})` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[cls_union;FINITE_UNION;];
+  (* -- *)
+  TYPE_THEN `edge x /\ E SUBSET edge` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[INSERT;SUBSET];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[cls_edge];
+  USE 5 (MATCH_MP two_endpoint);
+  FULL_REWRITE_TAC[HAS_SIZE];
+  (* - *)
+  IMATCH_MP_TAC  cls_subset;
+  REWRITE_TAC[INSERT;SUBSET;INR IN_SING;UNION ];
+  ]);;
+  (* }}} *)
+
+let infinite_int = prove_by_refinement(
+  `INFINITE (UNIV:int->bool)`,
+  (* {{{ proof *)
+  [
+  IMATCH_MP_TAC  infinite_subset;
+  TYPE_THEN `IMAGE (&:) UNIV` EXISTS_TAC;
+  THM_INTRO_TAC[`(&:)`] INFINITE_IMAGE_INJ;
+  ASM_MESON_TAC[INT_OF_NUM_EQ];
+  TSPEC  `UNIV:num->bool` 0;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[num_INFINITE];
+  ]);;
+  (* }}} *)
+
+let infinite_intpair = prove_by_refinement(
+  `INFINITE (UNIV:int#int->bool)`,
+  (* {{{ proof *)
+  [
+  IMATCH_MP_TAC  infinite_subset;
+  TYPE_THEN `IMAGE (\ (i:int) . (i,&:0)) UNIV` EXISTS_TAC;
+  THM_INTRO_TAC[`(\ (i:int) . (i,&:0))`] INFINITE_IMAGE_INJ;
+  FULL_REWRITE_TAC[PAIR_SPLIT];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[infinite_int];
+  ]);;
+  (* }}} *)
+
+let not_cls_exists = prove_by_refinement(
+  `!E. ?c. (FINITE E /\ E SUBSET edge) ==>   ~cls E c`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  RIGHT_TAC "c";
+  THM_INTRO_TAC[`E`] finite_cls;
+  FULL_REWRITE_TAC[cls];
+  TYPE_THEN `INFINITE (UNIV DIFF {m | ?e. E e /\ closure top2 e (pointI m)})` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  INFINITE_DIFF_FINITE;
+  REWRITE_TAC[infinite_intpair];
+  (* - *)
+  USE 3 (MATCH_MP INFINITE_NONEMPTY);
+  USE 3 (REWRITE_RULE[EMPTY_EXISTS;DIFF]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let conn2_imp_conn = prove_by_refinement(
+  `!E. (E SUBSET edge ) /\ conn2 E ==> conn E`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[conn;conn2];
+  THM_INTRO_TAC[`E`] finite_cls;
+  THM_INTRO_TAC[`E`] not_cls_exists;
+  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`;`c`]);
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let has_size1 = prove_by_refinement(
+  `!(X:A -> bool). X HAS_SIZE 1 <=> SING X`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  ASM_REWRITE_TAC[CARD_SING_CONV];
+  FULL_REWRITE_TAC[SING];
+  REWRITE_TAC[sing_has_size1];
+  ]);;
+  (* }}} *)
+
+let card_gt_3 = prove_by_refinement(
+  `!(X:A->bool). FINITE X ==> ( 3 <= CARD X <=>
+     (?a b c. X a /\ X b /\ X c /\ ~(a = b) /\ ~(a = c) /\ ~( b = c)))`,
+  (* {{{ proof *)
+  [
+  FULL_REWRITE_TAC[ARITH_RULE `(3 <= x) <=> ~(x = 0) /\ ~(x = 1) /\ ~(x = 2)`];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `~(X HAS_SIZE 0)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[HAS_SIZE];
+  FULL_REWRITE_TAC[HAS_SIZE_0 ;EMPTY_EXISTS ];
+  TYPE_THEN `~(X HAS_SIZE 1) /\ ~(X HAS_SIZE 2)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[HAS_SIZE];
+  FULL_REWRITE_TAC[has_size1 ;SING;has_size2;INR eq_sing ];
+  TYPE_THEN `?v. (X v /\ ~(v = u))` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `u` EXISTS_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  LEFT 5 "a";
+  TSPEC `u` 5;
+  LEFT 5 "b";
+  TSPEC `v` 5;
+  USE 5 (REWRITE_RULE[DE_MORGAN_THM]);
+  REWR 5;
+  USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  LEFT 5 "x";
+  FULL_REWRITE_TAC[INR in_pair];
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `~(X HAS_SIZE 0) /\ ~(X HAS_SIZE 1) /\ ~(X HAS_SIZE 2) ==> ~(CARD X = 0) /\ ~(CARD X = 1) /\ ~(CARD X = 2)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  ASM_MESON_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  KILL 7;
+  REWRITE_TAC[HAS_SIZE_0;has_size1;SING;EMPTY_EXISTS ];
+  CONJ_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INR IN_SING];
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`X`;`a`;`b`;`c`] two_exclusion;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let card_has_subset = prove_by_refinement(
+  `!(A:A->bool) n. FINITE A /\ (n <= CARD A) ==>
+       (?B. B SUBSET A /\ (B HAS_SIZE n))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `A HAS_SIZE CARD A` SUBAGOAL_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  FULL_REWRITE_TAC[has_size_bij];
+  TYPE_THEN `IMAGE f {m | m <| n}` EXISTS_TAC;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[IMAGE;SUBSET;BIJ;SURJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 3 THEN UND 0 THEN ARITH_TAC;
+  TYPE_THEN `f` EXISTS_TAC;
+  IMATCH_MP_TAC  inj_bij;
+  FULL_REWRITE_TAC[INJ;BIJ;];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 3 THEN UND 4 THEN UND 0 THEN ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let cls_edge_size2 = prove_by_refinement(
+  `!e. (edge e) ==> (cls {e} HAS_SIZE 2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cls_edge];
+  IMATCH_MP_TAC  two_endpoint;
+  ]);;
+  (* }}} *)
+
+let conn2_cls3 = prove_by_refinement(
+  `!E. (E SUBSET edge) /\ conn2 E ==> (3 <= CARD (cls E))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`E`] finite_cls;
+  FULL_REWRITE_TAC[conn2];
+  ASM_SIMP_TAC[card_gt_3];
+  FULL_REWRITE_TAC[conn2];
+  THM_INTRO_TAC[`E`;`2`] card_has_subset;
+  FULL_REWRITE_TAC[has_size2];
+  TYPE_THEN `B` UNABBREV_TAC;
+  USE 6(REWRITE_RULE[SUBSET;INR in_pair]);
+  TYPE_THEN `E b` SUBAGOAL_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `E a` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  USE 2(REWRITE_RULE[SUBSET]);
+  TYPE_THEN `edge a /\ edge b` SUBAGOAL_TAC;
+  (* - *)
+  TYPE_THEN `cls {a} HAS_SIZE 2 /\ cls {b} HAS_SIZE 2` SUBAGOAL_TAC;
+  ASM_MESON_TAC[cls_edge_size2];
+  FULL_REWRITE_TAC[has_size2];
+  USE 12 SYM;
+  USE 14 SYM;
+  TYPE_THEN `cls {a} SUBSET cls E` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  TYPE_THEN `cls {b} SUBSET cls E` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  (* - *)
+  TYPE_THEN `cls E a' /\ cls E b' /\ cls E a'' /\ cls E b''` SUBAGOAL_TAC;
+  USE 12 GSYM;
+  USE 14 SYM;
+  REWR 15;
+  REWR 16;
+  FULL_REWRITE_TAC[SUBSET;INR in_pair];
+  ASM_MESON_TAC[];
+  (* -A *)
+  TYPE_THEN `a'` EXISTS_TAC;
+  TYPE_THEN `b'` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `~(cls {a} = cls {b})` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`a`;`b`] cls_inj;
+  ASM_MESON_TAC[];
+  USE 14 SYM;
+  TYPE_THEN `cls {b} a''` ASM_CASES_TAC;
+  REWR 22;
+  FULL_REWRITE_TAC[INR in_pair ];
+  TYPE_THEN `b''` EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `b''` UNABBREV_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `a''` UNABBREV_TAC;
+  TYPE_THEN `cls {b}` UNABBREV_TAC;
+  TYPE_THEN `cls {a}` UNABBREV_TAC;
+  UND 21 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INSERT];
+  MESON_TAC[];
+  TYPE_THEN `a''` UNABBREV_TAC;
+  (* -- *)
+  TYPE_THEN `b''` UNABBREV_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC  ;
+  TYPE_THEN `a''` UNABBREV_TAC;
+  TYPE_THEN `a''` UNABBREV_TAC;
+  TYPE_THEN `cls {b}` UNABBREV_TAC;
+  TYPE_THEN `cls {a}` UNABBREV_TAC;
+  (* -B *)
+  TYPE_THEN `a''` EXISTS_TAC;
+  REWR 22;
+  FULL_REWRITE_TAC[INR in_pair];
+  UND 22 THEN MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let has_size2_subset_ne = prove_by_refinement(
+  `!X (a:A) b. X HAS_SIZE 2 /\ {a,b} SUBSET X /\ ~(a = b) ==>
+           (X = {a,b})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  IMATCH_MP_TAC  CARD_SUBSET_EQ;
+  THM_INTRO_TAC[`a`;`b`] pair_size_2;
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[HAS_SIZE];
+  ]);;
+  (* }}} *)
+
+let segment_end_sing = prove_by_refinement(
+  `!a b e. closure top2 e (pointI a) /\ closure top2 e (pointI b) /\
+     ~(a = b) /\ (edge e) ==> segment_end {e} a b`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[segment_end];
+  CONJ_TAC ;
+  IMATCH_MP_TAC  psegment_edge;
+  (* - *)
+  IMATCH_MP_TAC has_size2_subset_ne;
+  CONJ_TAC;
+  IMATCH_MP_TAC  endpoint_size2;
+  IMATCH_MP_TAC  psegment_edge;
+  (* - *)
+  REWRITE_TAC[endpoint;SUBSET];
+  FULL_REWRITE_TAC[INR in_pair];
+  THM_INTRO_TAC[`{e}`;`pointI x`] num_closure1;
+  REWRITE_TAC[FINITE_SING];
+  KILL 5;
+  TYPE_THEN `e` EXISTS_TAC;
+  REWRITE_TAC[INR IN_SING];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let conn2_no1 = prove_by_refinement(
+  `!E. (E SUBSET edge) /\ conn2 E ==>
+         (!m. ~(num_closure E (pointI m) = 1))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+    TYPE_THEN `FINITE E` SUBAGOAL_TAC ;
+  FULL_REWRITE_TAC[conn2];
+  TYPE_THEN `?e. E e /\ closure top2 e (pointI m)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`E`;`pointI m`] num_closure1;
+  REWR 4;
+  MESON_TAC[];
+  THM_INTRO_TAC[`e`] cls_edge_size2;
+  ASM_MESON_TAC[ISUBSET];
+  TYPE_THEN `?n. closure top2 e (pointI n) /\ ~(n = m)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[has_size2];
+  USE 7 SYM;
+  TYPE_THEN `cls {e} m` SUBAGOAL_TAC;
+  REWRITE_TAC[cls;INR IN_SING ];
+  ASM_MESON_TAC[];
+  USE 7 SYM;
+  REWR 8;
+  FULL_REWRITE_TAC[INR in_pair];
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `cls{e} a` SUBAGOAL_TAC;
+  REWRITE_TAC[INSERT];
+  FULL_REWRITE_TAC[cls;INR IN_SING ];
+  ASM_MESON_TAC[];
+  TYPE_THEN `b` EXISTS_TAC;
+  TYPE_THEN `cls{e} b` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[INR in_pair;cls; INR IN_SING];
+  FULL_REWRITE_TAC[cls;INR IN_SING];
+  ASM_MESON_TAC[];
+  TYPE_THEN `edge e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET];
+  (* -A *)
+  TYPE_THEN`?c. cls E c /\ ~(c = m) /\ ~(c = n)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`E`] conn2_cls3;
+  THM_INTRO_TAC[`E`] finite_cls;
+  THM_INTRO_TAC[`cls E`] card_gt_3;
+  REWR 12;
+  TYPE_THEN `~(a = m) /\ ~(a = n)` ASM_CASES_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `~(b = m) /\ ~(b = n)` ASM_CASES_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  TYPE_THEN `~(c = m) /\ ~(c = n)` ASM_CASES_TAC;
+  TYPE_THEN `c` EXISTS_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  ASM_MESON_TAC[];
+  (* - *)
+  FULL_REWRITE_TAC[conn2];
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`m`;`c`;`n`]);
+  REWRITE_TAC[cls];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `cls {e} n` SUBAGOAL_TAC;
+  REWRITE_TAC[cls;INR IN_SING ];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `~S e` SUBAGOAL_TAC;
+  TYPE_THEN `cls {e} SUBSET cls S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  FULL_REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`S`;`m`] terminal_endpoint;
+  FULL_REWRITE_TAC[segment_end];
+  FULL_REWRITE_TAC[psegment;segment;INR in_pair];
+  THM_INTRO_TAC[`E`;`pointI m`] num_closure1;
+  REWR 21;
+  COPY 21;
+  TSPEC  `e` 21;
+  TYPE_THEN `e = e'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e'` UNABBREV_TAC;
+  TSPEC  `(terminal_edge S m)` 22;
+  REWR 22;
+  USE 22 SYM;
+  TYPE_THEN `E (terminal_edge S m)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[ISUBSET];
+  REWR 22;
+  TYPE_THEN `e` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let conn2_union = prove_by_refinement(
+  `!A B. (A SUBSET edge) /\ (B SUBSET edge) /\ (conn2 A) /\ (conn2 B) /\
+    (?a b. ~(a = b) /\ ({a,b} SUBSET (cls A INTER cls B))) ==>
+    (conn2 (A UNION B))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[conn2];
+  TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[conn2];
+  SUBCONJ_TAC;
+  REWRITE_TAC[FINITE_UNION];
+  (* - *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  LE_TRANS;
+  TYPE_THEN `CARD A` EXISTS_TAC;
+  FULL_REWRITE_TAC[conn2];
+  IMATCH_MP_TAC  CARD_SUBSET;
+  REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `cls A a' /\ cls A b'` ASM_CASES_TAC;
+  FULL_REWRITE_TAC[conn2];
+  UND 18 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`;`c`]);
+  TYPE_THEN`S` EXISTS_TAC;
+  UND 22 THEN REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `cls B a' /\ cls B b'` ASM_CASES_TAC;
+  FULL_REWRITE_TAC[conn2];
+  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`;`c`]);
+  TYPE_THEN`S` EXISTS_TAC;
+  UND 23 THEN REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `?d. cls A d /\ cls B d /\ ~(c = d)` SUBAGOAL_TAC;
+  TYPE_THEN `c = a` ASM_CASES_TAC;
+  TYPE_THEN `c` UNABBREV_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  FULL_REWRITE_TAC[SUBSET;INTER;INR in_pair];
+  ASM_MESON_TAC[];
+  TYPE_THEN `a` EXISTS_TAC;
+  FULL_REWRITE_TAC[SUBSET;INTER;INR in_pair];
+  ASM_MESON_TAC[];
+  (* -A *)
+  TYPE_THEN `!m n. cls A m /\ ~cls B m /\ ~cls A n /\ cls B n /\ ~(m = n) /\ ~(m = c) /\ ~(n = c) ==> (?S. S SUBSET A UNION B /\ segment_end S m n /\ ~cls S c)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[conn2];
+  UND 28 THEN DISCH_THEN (THM_INTRO_TAC[`m`;`d`;`c`]);
+  REWRITE_TAC[];
+  TYPE_THEN `m` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`d`;`n`;`c`]);
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`S`;`S'`;`m`;`d`;`n`] segment_end_trans;
+  TYPE_THEN `U` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `S UNION S'` EXISTS_TAC ;
+  IMATCH_MP_TAC  subset_union_pair;
+  TYPE_THEN `cls U SUBSET cls (S UNION S')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  FULL_REWRITE_TAC[cls_union ];
+  FULL_REWRITE_TAC[ISUBSET];
+  TSPEC `c` 38;
+  USE 37 (REWRITE_RULE[UNION]);
+  ASM_MESON_TAC[];
+  (* -B *)
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  FULL_REWRITE_TAC[cls_union ];
+  USE 12(REWRITE_RULE[UNION]);
+  USE 13 (REWRITE_RULE[UNION]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  REWR 15;
+  REWR 12;
+  REWR 16;
+  UND 20 THEN DISCH_THEN (THM_INTRO_TAC[`a'`;`b'`]);
+  (* - *)
+  REWR 16;
+  REWR 12;
+  REWR 15;
+  UND 20 THEN DISCH_THEN  (THM_INTRO_TAC[`b'`;`a'`]);
+  TYPE_THEN `S` EXISTS_TAC;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  ]);;
+  (* }}} *)
+
+let cut_rectagon_cls = prove_by_refinement(
+  `!E m n. rectagon E /\ ~(m = n) /\ cls E m /\ cls E n ==>
+    (?A B. segment_end A m n /\ segment_end B m n /\
+        (E = A UNION B) /\ (A INTER B = EMPTY) /\
+         (cls A INTER cls B = {m,n}))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[segment_end;cls;];
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon;segment;psegment];
+  THM_INTRO_TAC[`E`;`m`;`n`] cut_rectagon;
+  CONJ_TAC;
+  IMATCH_MP_TAC  num_closure_pos;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  num_closure_pos;
+  ASM_MESON_TAC[];
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `B` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR in_pair];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  (TAUT `a \/ b ==> b \/ a`);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  CONJ_TAC;
+  IMATCH_MP_TAC  num_closure_pos;
+  ASM_MESON_TAC[psegment;segment];
+  IMATCH_MP_TAC  num_closure_pos;
+  ASM_MESON_TAC[psegment;segment];
+  (* - *)
+  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `endpoint A m /\ endpoint A n /\ endpoint B m /\ endpoint B n` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  (* - *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  CONJ_TAC;
+  TYPE_THEN  `terminal_edge A n` EXISTS_TAC;
+  IMATCH_MP_TAC  terminal_endpoint;
+  TYPE_THEN  `terminal_edge B n` EXISTS_TAC;
+  IMATCH_MP_TAC  terminal_endpoint;
+  CONJ_TAC;
+  TYPE_THEN  `terminal_edge A m` EXISTS_TAC;
+  IMATCH_MP_TAC  terminal_endpoint;
+  TYPE_THEN  `terminal_edge B m` EXISTS_TAC;
+  IMATCH_MP_TAC  terminal_endpoint;
+  ]);;
+  (* }}} *)
+
+let conn2_rectagon = prove_by_refinement(
+  `!E. rectagon E ==> conn2 E`,
+  (* {{{ proof *)
+  [
+  FULL_REWRITE_TAC[conn2];
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  SUBCONJ_TAC;
+  THM_INTRO_TAC[`E`] rectagon_h_edge;
+  THM_INTRO_TAC[`E`] rectagon_v_edge;
+  TYPE_THEN `~(h_edge m = v_edge m')` SUBAGOAL_TAC;
+  ASM_MESON_TAC[hv_edgeV2];
+  TYPE_THEN `CARD {(h_edge m),(v_edge m')} <= CARD E` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  CARD_SUBSET;
+  REWRITE_TAC[SUBSET;INR in_pair];
+  ASM_MESON_TAC[];
+  TYPE_THEN `{(h_edge m),(v_edge m')} HAS_SIZE 2` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  pair_size_2;
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[HAS_SIZE];
+  REWR 5;
+  (* - *)
+  THM_INTRO_TAC[`E`;`a`;`b`] cut_rectagon_cls;
+  TYPE_THEN `~cls A c` ASM_CASES_TAC;
+  TYPE_THEN `A` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  REWR 13;
+  (* - *)
+  TYPE_THEN `~cls B c ` SUBAGOAL_TAC;
+  USE 8 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `c` 8;
+  FULL_REWRITE_TAC[INTER;INR in_pair];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `B` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  ]);;
+  (* }}} *)
+
+let rectangle_grid = jordan_def
+  `rectangle_grid p q = { e |
+     (?m. (e = h_edge m) /\ FST p <= FST m /\ (FST m +: &:1 <=: FST q) /\
+                          SND p <= SND m /\ SND m <=: SND q) \/
+     (?m. (e = v_edge m) /\ FST p <= FST m /\ FST m <= FST q /\
+                          SND p <= SND m /\ SND m +: &:1 <=: SND q) }`;;
+
+let rectangle_grid_h = prove_by_refinement(
+  `!p q m. rectangle_grid p q (h_edge m) <=>
+        (FST p <=: FST m) /\ (FST m +: &:1 <=: FST q) /\
+        (SND p <=: SND m) /\ (SND m <=: SND q)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[rectangle_grid];
+  REWRITE_TAC[cell_clauses;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let rectangle_grid_v = prove_by_refinement(
+  `!p q m. rectangle_grid p q (v_edge m) <=>
+        (FST p <= FST m /\ FST m <= FST q /\
+                 SND p <= SND m /\ SND m +: &:1 <=: SND q)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[rectangle_grid];
+  REWRITE_TAC[cell_clauses;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let rectangle_grid_edge = prove_by_refinement(
+  `!p q. rectangle_grid p q SUBSET edge`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;rectangle_grid;edge];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let rectangle_grid_sq = prove_by_refinement(
+  `!p.  (rectangle_grid p (FST p +: &:1, SND p +: &:1)) =
+         {(h_edge p), (h_edge (up p)), (v_edge p), (v_edge (right  p))}`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `E = rectangle_grid p (FST p +: &:1, SND p +: &:1)` ABBREV_TAC ;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INSERT];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `edge x` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
+  (* - *)
+  FULL_REWRITE_TAC[edge];
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  FULL_REWRITE_TAC[rectangle_grid_v;PAIR_SPLIT];
+  REWRITE_TAC[cell_clauses];
+  REWRITE_TAC[PAIR_SPLIT;right ];
+  UND 0 THEN UND 1 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  FULL_REWRITE_TAC[rectangle_grid_h;PAIR_SPLIT];
+  REWRITE_TAC[cell_clauses];
+  REWRITE_TAC[PAIR_SPLIT;up ];
+  UND 0 THEN UND 1 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `E` UNABBREV_TAC;
+  UND 1 THEN REP_CASES_TAC THEN ASM_REWRITE_TAC[rectangle_grid_v;rectangle_grid_h;up;right ;] THEN INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let rectangle_grid_sq_cls = prove_by_refinement(
+  `!p. cls (rectangle_grid p (FST p +: &:1, SND p +: &:1)) =
+     {(p),(right  p),(up p),  (up (right  p))}`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[cls];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[rectangle_grid_sq];
+  REWRITE_TAC[INSERT];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  (* - *)
+  CONJ_TAC;
+  FULL_REWRITE_TAC[right ;up;];
+  UND 1 THEN REP_CASES_TAC THEN (TYPE_THEN `e` UNABBREV_TAC) THEN FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING;plus_e12;pointI_inj;cell_clauses;] THEN ASM_MESON_TAC[];
+  (* - *)
+  FULL_REWRITE_TAC[right ;up;];
+  TYPE_THEN `closure top2 (h_edge p) (pointI x) \/ closure top2 (h_edge (FST p,SND p +: &:1)) (pointI x)` SUBAGOAL_TAC;
+  UND 0 THEN REP_CASES_TAC THEN (TYPE_THEN`x` UNABBREV_TAC) THEN FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;vc_edge;hc_edge;UNION;INR IN_SING;plus_e12;pointI_inj;cell_clauses;];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let segment_end_union_rectagon = prove_by_refinement(
+  `!A B m p. segment_end A m p /\ segment_end B m p /\
+       (A INTER B = EMPTY) /\ (cls A INTER cls B = {m,p}) ==>
+       (rectagon (A UNION B))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`A`;`m`;`p`] segment_end_disj;
+  IMATCH_MP_TAC  segment_union2;
+  TYPE_THEN `m` EXISTS_TAC;
+  TYPE_THEN `p` EXISTS_TAC;
+  FULL_REWRITE_TAC[segment_end;INR in_pair];
+  REWRITE_TAC[INR in_pair];
+  FULL_REWRITE_TAC[psegment];
+  REP_BASIC_TAC;
+  (* - *)
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `n` 0;
+  USE 0 (REWRITE_RULE[INR in_pair;INTER;cls]);
+  IMATCH_MP_TAC  (TAUT `a \/ b ==> b \/ a`);
+  USE 0 SYM;
+  CONJ_TAC;
+  USE 10 (MATCH_MP num_closure_elt);
+  ASM_MESON_TAC[];
+  USE 9 (MATCH_MP num_closure_elt);
+  ASM_MESON_TAC[];
+  (* -A *)
+  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment];
+  TYPE_THEN `FINITE B` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment];
+  TYPE_THEN `endpoint B m /\ endpoint B p /\ endpoint A m /\ endpoint A p` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  CONJ_TAC;
+  IMATCH_MP_TAC  num_closure_pos;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`A`;`m`] terminal_endpoint;
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`A`;`p`] terminal_endpoint;
+  ASM_MESON_TAC[];
+    IMATCH_MP_TAC  num_closure_pos;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`B`;`m`] terminal_endpoint;
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`B`;`p`] terminal_endpoint;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let cls_h = prove_by_refinement(
+  `!m. (cls {(h_edge m)} = {m, (right  m)})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cls];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR in_pair;INR IN_SING;];
+  CONV_TAC (dropq_conv "e");
+  REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right  ;up; vc_edge;hc_edge;UNION;plus_e12; INR IN_SING; PAIR_SPLIT;cell_clauses;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let cls_v = prove_by_refinement(
+  `!m. (cls {(v_edge m)} = {m, (up  m)})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cls];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR in_pair;INR IN_SING;];
+  CONV_TAC (dropq_conv "e");
+  REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right  ;up; vc_edge;hc_edge;UNION;plus_e12; INR IN_SING; PAIR_SPLIT;cell_clauses;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let rectagon_rectangle_grid_sq = prove_by_refinement(
+  `!p. rectagon ((rectangle_grid p (FST p +: &:1, SND p +: &:1)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `E = rectagon (rectangle_grid p (FST p +: &:1,SND p +: &:1))` ABBREV_TAC ;
+  TYPE_THEN `segment_end {(h_edge p)} p (right  p) /\ segment_end {(v_edge p)} p (up p) /\ segment_end { (h_edge (up p)) } (up p) (right  (up p)) /\ segment_end {(v_edge (right  p))} (right  p) (right  (up p))` SUBAGOAL_TAC;
+  (REPEAT CONJ_TAC) THEN IMATCH_MP_TAC  segment_end_sing THEN REWRITE_TAC[edge_h;edge_v;v_edge_closure;h_edge_closure;right  ;up; vc_edge;hc_edge; UNION ;plus_e12; INR IN_SING; PAIR_SPLIT ] THEN INT_ARITH_TAC ;
+  (* - *)
+  THM_INTRO_TAC[`{(h_edge p)}`;`{(v_edge (right  p))}`;`p`;`right  p`;`right  (up p)`] segment_end_union;
+  THM_INTRO_TAC[`p`] cls_h;
+  THM_INTRO_TAC[`right  p`] cls_v;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR IN_SING;];
+  REWRITE_TAC[INR in_pair;right  ;up; PAIR_SPLIT ];
+  INT_ARITH_TAC;
+  (* - *)
+  THM_INTRO_TAC[`{(v_edge p)}`;`{(h_edge (up p))}`;`p`;`up p`;`right  (up p)`] segment_end_union;
+  THM_INTRO_TAC[`p`] cls_v;
+  THM_INTRO_TAC[`up  p`] cls_h;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR IN_SING;];
+  REWRITE_TAC[INR in_pair;right  ;up; PAIR_SPLIT ];
+  INT_ARITH_TAC;
+  (* - *)
+  THM_INTRO_TAC[`{(v_edge p)} UNION {(h_edge (up p))}`;`{(h_edge p)} UNION {(v_edge (right p))}`;`p`;`right  (up p)`] segment_end_union_rectagon;
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  USE 7(REWRITE_RULE[INTER;UNION;INR IN_SING]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  FULL_REWRITE_TAC[cell_clauses;up;PAIR_SPLIT ];
+  UND 8 THEN INT_ARITH_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  FULL_REWRITE_TAC[cell_clauses;up; right  ;PAIR_SPLIT ];
+  UND 8 THEN INT_ARITH_TAC;
+  REWRITE_TAC[cls_h;cls_v;cls_union];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[up; right ; INTER; UNION;];
+  REWRITE_TAC[INR in_pair];
+  REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `FST x = FST p` ASM_CASES_TAC;
+  REWRITE_TAC[INT_ARITH `~(FST p = FST p +: &:1)`];
+  INT_ARITH_TAC;
+  INT_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[rectangle_grid_sq];
+  TYPE_THEN `{(h_edge p), (h_edge (up p)), (v_edge p),( v_edge (right p))} = (({(v_edge p)} UNION {(h_edge (up p))}) UNION {(h_edge p)} UNION  {(v_edge (right p))})` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  REWRITE_TAC[INR IN_SING];
+  REWRITE_TAC[INSERT];
+  MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let conn2_union_edge = prove_by_refinement(
+  `!A B. A SUBSET edge /\ B SUBSET edge /\ conn2 A /\ conn2 B /\
+    (~(A INTER B = EMPTY)) ==> conn2 (A UNION B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  conn2_union;
+  USE 0 (REWRITE_RULE [EMPTY_EXISTS;INTER;]);
+  TYPE_THEN `edge u` SUBAGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  USE 6 (MATCH_MP cls_edge_size2);
+  FULL_REWRITE_TAC[has_size2];
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  USE 7 SYM;
+  REWRITE_TAC[SUBSET_INTER];
+  CONJ_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  ASM_REWRITE_TAC[SUBSET;INR IN_SING];
+  IMATCH_MP_TAC  cls_subset;
+  ASM_REWRITE_TAC[SUBSET;INR IN_SING];
+  ]);;
+  (* }}} *)
+
+let rectangle_grid_h_conn2 = prove_by_refinement(
+  `!n p. conn2 (rectangle_grid p (FST p +: &:(SUC n), SND p +: &:1))`,
+  (* {{{ proof *)
+  [
+  INDUCT_TAC;
+  REWRITE_TAC[ARITH_RULE `SUC 0 = 1`] ;
+  IMATCH_MP_TAC  conn2_rectagon;
+  REWRITE_TAC[rectagon_rectangle_grid_sq];
+  (* - *)
+  TYPE_THEN `rectangle_grid p (FST p +: &:(SUC (SUC n)),SND p +: &:1) = rectangle_grid p (FST p +: &:(SUC n),SND p +: &:1) UNION rectangle_grid (FST p +: &:(SUC n),SND p) (FST p +: &:(SUC (SUC n)),SND p +: &:1)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  (* - *)
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `edge x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
+  FULL_REWRITE_TAC [edge];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[rectangle_grid_v];
+  UND 4 THEN UND 5 THEN INT_ARITH_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[rectangle_grid_h];
+  UND 4 THEN UND 5 THEN INT_ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `edge x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
+  FULL_REWRITE_TAC [edge];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[rectangle_grid_v];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
+  UND 5 THEN INT_ARITH_TAC;
+  TYPE_THEN `(FST p +: (&:0)*((FST m - (FST p + &:(SUC n))) + (&:(SUC n))) <= FST m)` SUBAGOAL_TAC;
+  int_le_tac;
+  clean_int_le_tac;
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[rectangle_grid_h];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
+  UND 5 THEN INT_ARITH_TAC;
+  TYPE_THEN `(FST p +: (&:0)*((FST m - (FST p + &:(SUC n))) + (&:(SUC n))) <= FST m)` SUBAGOAL_TAC;
+  int_le_tac;
+  clean_int_le_tac;
+  (* -A *)
+  IMATCH_MP_TAC  conn2_union_edge;
+  REWRITE_TAC[rectangle_grid_edge];
+  CONJ_TAC;
+  IMATCH_MP_TAC  conn2_rectagon;
+  THM_INTRO_TAC[`FST p +: &:(SUC n),SND p`] rectagon_rectangle_grid_sq;
+  TYPE_THEN `(FST p +: &:(SUC (SUC n)),SND p +: &:1) = (FST (FST p +: &:(SUC n),SND p) +: &:1, SND (FST p +: &:(SUC n),SND p) +: &:1)` SUBAGOAL_TAC;
+  REWRITE_TAC[PAIR_SPLIT;GSYM INT_OF_NUM_SUC];
+  INT_ARITH_TAC;
+  REWR 2;
+  UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;];
+  TYPE_THEN `v_edge (FST p +: &:(SUC n),SND p)` EXISTS_TAC;
+  REWRITE_TAC[rectangle_grid_v];
+  REPEAT CONJ_TAC THEN (TRY INT_ARITH_TAC);
+  TYPE_THEN `FST p + (&:0)*(&:(SUC n)) <=: FST p + &: (SUC n)` SUBAGOAL_TAC;
+  int_le_tac;
+  clean_int_le_tac;
+  REWRITE_TAC[GSYM INT_OF_NUM_SUC];
+  INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let rectangle_grid_conn2 = prove_by_refinement(
+  `!m n p. conn2
+        (rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC m)))`,
+  (* {{{ proof *)
+  [
+  INDUCT_TAC;
+  REWRITE_TAC[ARITH_RULE `SUC 0 = 1`] ;
+  REWRITE_TAC[rectangle_grid_h_conn2];
+  (* - *)
+  TYPE_THEN `rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC (SUC m))) = rectangle_grid p (FST p +: &:(SUC n),SND p +: &:(SUC m)) UNION rectangle_grid (FST p ,SND p + &:(SUC m)) (FST p +: &:(SUC n),SND p +: &:(SUC (SUC m)))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  (* - *)
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `edge x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
+  FULL_REWRITE_TAC [edge];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[rectangle_grid_v];
+  UND 1 THEN UND 3 THEN INT_ARITH_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[rectangle_grid_h];
+  UND 1 THEN UND 3 THEN INT_ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `edge x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[rectangle_grid_edge;ISUBSET];
+  FULL_REWRITE_TAC [edge];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[rectangle_grid_v];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
+  UND 3 THEN INT_ARITH_TAC;
+  TYPE_THEN `(SND p +: (&:0)*((SND  m' - (SND  p + &:(SUC m))) + (&:(SUC m))) <= SND m')` SUBAGOAL_TAC;
+  int_le_tac;
+  clean_int_le_tac;
+  (* -- *)
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[rectangle_grid_h];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[GSYM INT_OF_NUM_SUC];
+  UND 3 THEN INT_ARITH_TAC;
+  TYPE_THEN `(SND  p +: (&:0)*((SND  m' - (SND  p + &:(SUC m))) + (&:(SUC m))) <= SND m')` SUBAGOAL_TAC;
+  int_le_tac;
+  clean_int_le_tac;
+  (* -A *)
+  IMATCH_MP_TAC  conn2_union_edge;
+  REWRITE_TAC[rectangle_grid_edge];
+  CONJ_TAC;
+  THM_INTRO_TAC[`n`;`(FST p,SND p +: &:(SUC m))` ] rectangle_grid_h_conn2;
+  TYPE_THEN `(FST p +: &:(SUC n),SND p +: &:(SUC (SUC m))) = (FST (FST p,SND p +: &:(SUC m)) +: &:(SUC n), SND (FST p,SND p +: &:(SUC m)) +: &:1)` SUBAGOAL_TAC;
+  REWRITE_TAC[GSYM INT_OF_NUM_SUC;PAIR_SPLIT ];
+  INT_ARITH_TAC;
+  REWR 2;
+  (* - // *)
+  UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;];
+  TYPE_THEN `h_edge (FST p ,SND p + &:(SUC m))` EXISTS_TAC;
+  REWRITE_TAC[rectangle_grid_h];
+  REPEAT CONJ_TAC THEN (TRY (IMATCH_MP_TAC  INT_LE_LADD_IMP)) THEN (REWRITE_TAC[INT_OF_NUM_LE;INT_LE_ADDR ]) THEN (TRY INT_ARITH_TAC) THEN (TRY ARITH_TAC);
+  ]);;
+  (* }}} *)
+
+let conn2_has_rectagon = prove_by_refinement(
+  `!E. (E SUBSET edge) /\ (conn2 E) ==> (?B. (B SUBSET E) /\ rectagon B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `?e. E e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[conn2];
+  THM_INTRO_TAC[`E`;`1`] card_has_subset;
+  UND 2 THEN ARITH_TAC;
+  FULL_REWRITE_TAC[has_size1;SING ];
+  TYPE_THEN `B` UNABBREV_TAC;
+  FULL_REWRITE_TAC[SUBSET;INR IN_SING];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `edge e` SUBAGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  USE 3 (MATCH_MP cls_edge_size2);
+  FULL_REWRITE_TAC[has_size2];
+  (* - *)
+  TYPE_THEN `2 <=| num_closure E (pointI a)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `~(x = 0) /\ ~(x = 1) ==> 2 <= x`);
+  CONJ_TAC;
+  THM_INTRO_TAC[`E`;`pointI a`] num_closure0;
+  FULL_REWRITE_TAC[conn2];
+  REWR 6;
+  TYPE_THEN `cls {e} a` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  FULL_REWRITE_TAC[cls;INR IN_SING ];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[conn2_no1];
+  FULL_REWRITE_TAC[num_closure];
+  THM_INTRO_TAC[`{C | E C /\ closure top2 C (pointI a)}`;`2`] card_has_subset;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  FULL_REWRITE_TAC[conn2];
+  REWRITE_TAC[SUBSET];
+  FULL_REWRITE_TAC[has_size2];
+  TYPE_THEN `B` UNABBREV_TAC;
+  USE 7(REWRITE_RULE[SUBSET;INR in_pair ]);
+  (* - *)
+  TYPE_THEN `?e' . (E e' /\ closure top2 e' (pointI a) /\ ~(e = e'))` SUBAGOAL_TAC;
+  TYPE_THEN `e = a'` ASM_CASES_TAC;
+  TYPE_THEN `b'` EXISTS_TAC;
+  TYPE_THEN `a'` UNABBREV_TAC;
+  TSPEC `b'` 7;
+  ASM_MESON_TAC[];
+  TYPE_THEN `a'` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  (* -A *)
+  TYPE_THEN`?c. (cls {e'} = {a,c}) /\ ~(c = a) ` SUBAGOAL_TAC;
+  TYPE_THEN `edge e'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  USE 11 (MATCH_MP cls_edge_size2);
+  FULL_REWRITE_TAC[has_size2];
+  USE 12 SYM;
+  TYPE_THEN `cls{e'} a` SUBAGOAL_TAC;
+  REWRITE_TAC[cls;INR IN_SING ];
+  ASM_MESON_TAC[];
+  TYPE_THEN `cls {e'}` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INR in_pair];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `b''` UNABBREV_TAC;
+  TYPE_THEN `a''` EXISTS_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR in_pair];
+  MESON_TAC[];
+  TYPE_THEN `a''` UNABBREV_TAC;
+  TYPE_THEN `b''` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  (* -B *)
+  TYPE_THEN `~(c = b)` SUBAGOAL_TAC;
+  TYPE_THEN`c` UNABBREV_TAC;
+  TYPE_THEN `cls{e} = cls{e'}` SUBAGOAL_TAC;
+  ASM_MESON_TAC[cls_inj;ISUBSET];
+  (* - *)
+  TYPE_THEN `?S. S SUBSET E /\ segment_end S b c /\ ~cls S a` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[conn2];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `cls {e} b /\ cls {e'} c` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  USE 12 SYM;
+  USE 4 SYM;
+  TYPE_THEN `cls {e} SUBSET cls E /\ cls {e'} SUBSET cls E` SUBAGOAL_TAC;
+  CONJ_TAC THEN IMATCH_MP_TAC  cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING];
+  ASM_MESON_TAC[ISUBSET];
+  (* -C *)
+  THM_INTRO_TAC[`b`;`a`;`e`] segment_end_sing;
+  TYPE_THEN `cls {e} a /\ cls {e} b` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  FULL_REWRITE_TAC[cls;INR IN_SING ];
+  ASM_MESON_TAC[ISUBSET];
+  THM_INTRO_TAC[`a`;`c`;`e'`] segment_end_sing;
+  TYPE_THEN `cls {e'} a /\ cls {e'} c` SUBAGOAL_TAC;
+  REWRITE_TAC[INR in_pair];
+  FULL_REWRITE_TAC[cls;INR IN_SING ];
+  ASM_MESON_TAC[ISUBSET];
+  (* - *)
+  THM_INTRO_TAC[`{e}`;`{e'}`;`b`;`a`;`c`] segment_end_union;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR in_pair;INR IN_SING];
+  ASM_MESON_TAC[];
+  (* -D *)
+  THM_INTRO_TAC[`S`;`{e} UNION {e'}`;`b`;`c`] segment_end_union_rectagon;
+  REWRITE_TAC[cls_union; UNION_OVER_INTER; EMPTY_UNION; ];
+  CONJ_TAC;
+  REWRITE_TAC[EQ_EMPTY;INTER ;INR IN_SING ];
+  CONJ_TAC ;
+  TYPE_THEN `x` UNABBREV_TAC;
+  USE 4 SYM;
+  TYPE_THEN `cls {e} SUBSET cls S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  ASM_MESON_TAC[ISUBSET;INR IN_SING];
+  USE 20 (REWRITE_RULE[SUBSET]);
+  TSPEC `a` 20;
+  TYPE_THEN `cls {e}` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INR in_pair];
+  ASM_MESON_TAC[];
+  USE 12 SYM;
+  TYPE_THEN `cls {e'} SUBSET cls S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  ASM_MESON_TAC[ISUBSET;INR IN_SING];
+  USE 22 (REWRITE_RULE[SUBSET]);
+  TSPEC `a` 22;
+  TYPE_THEN `cls {e'}` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INR in_pair];
+  ASM_MESON_TAC[];
+  (* --E *)
+  REWRITE_TAC[GSYM UNION_OVER_INTER];
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[INTER;UNION;SUBSET;INR in_pair];
+  TYPE_THEN `((x = c) \/ (x = b)) \/ (x = a)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  (* -- *)
+  REWRITE_TAC[INTER;UNION;SUBSET;INR in_pair];
+  TYPE_THEN `cls S b /\ cls S c` SUBAGOAL_TAC;
+  ASM_MESON_TAC[segment_end_cls2;segment_end_cls];
+  ASM_MESON_TAC[];
+  TYPE_THEN `(S UNION {e} UNION {e'})` EXISTS_TAC;
+  REWRITE_TAC[union_subset];
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION T *)
+(* ------------------------------------------------------------------ *)
+
+
+(* 1.0.6 rectagon components *)
+
+(* redo some results from E that USE the segment hypothesis *)
+
+let curve_cell_h_ver2 = prove_by_refinement(
+  `!G n.  (curve_cell G (h_edge n) = G (h_edge n))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; h_edge_pointI];
+  ]);;
+
+  (* }}} *)
+
+let curve_cell_v_ver2 = prove_by_refinement(
+  `!G n. (curve_cell G (v_edge n) = G (v_edge n))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[curve_cell;UNION ; eq_sing;INR IN_SING; v_edge_pointI];
+  ]);;
+  (* }}} *)
+
+let curve_closure_ver2 = prove_by_refinement(
+  `!G. (FINITE  G) /\ (G SUBSET edge)  ==>
+    (closure top2 (UNIONS G) = (UNIONS (curve_cell G)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASSUME_TAC top2_top;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  ASM_SIMP_TAC[closure_unions];
+  REWRITE_TAC[IMAGE;INR IN_UNIONS;SUBSET ];
+  TYPE_THEN `edge x'` SUBGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  FULL_REWRITE_TAC [edge];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `t` UNABBREV_TAC;
+  FULL_REWRITE_TAC [v_edge_closure;vc_edge;UNION ;INR IN_SING ];
+  UND 3 THEN   REP_CASES_TAC;
+  TYPE_THEN `v_edge m` EXISTS_TAC;
+  ASM_SIMP_TAC [curve_cell_v_ver2];
+  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
+  (* ---- *)
+  ASM_SIMP_TAC [curve_cell_point];
+  REWRITE_TAC[INR IN_SING];
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC [v_edge_closure;vc_edge;UNION;plus_e12;INR IN_SING ];
+  TYPE_THEN `{(pointI (FST m,SND m +: &:1))}` EXISTS_TAC;
+  ASM_SIMP_TAC [curve_cell_point];
+  REWRITE_TAC[INR IN_SING;plus_e12];
+  TYPE_THEN `v_edge m` EXISTS_TAC;
+  REWRITE_TAC [v_edge_closure;vc_edge;UNION;plus_e12;INR IN_SING ];
+  (* dt2 , down to 2 goals *)
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `t` UNABBREV_TAC;
+  FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING];
+  UND 3 THEN REP_CASES_TAC;
+  TYPE_THEN `h_edge m` EXISTS_TAC;
+  ASM_SIMP_TAC[curve_cell_h_ver2];
+  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
+  ASM_SIMP_TAC[curve_cell_point ;INR IN_SING ];
+  TYPE_THEN `h_edge m` EXISTS_TAC;
+  FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING];
+  TYPE_THEN `{x}` EXISTS_TAC;
+  ASM_REWRITE_TAC[INR IN_SING];
+  ASM_SIMP_TAC[curve_cell_point ;INR IN_SING;plus_e12 ];
+  TYPE_THEN `h_edge m` EXISTS_TAC;
+  FULL_REWRITE_TAC [h_edge_closure;hc_edge;UNION;INR IN_SING;plus_e12];
+  (* dt1 *)
+  REWRITE_TAC[curve_cell; UNIONS_UNION; union_subset];
+  ASM_SIMP_TAC[closure_unions];
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;IMAGE;UNIONS];
+  DISCH_ALL_TAC;
+  CONV_TAC (dropq_conv "u");
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_MESON_TAC[subset_closure;ISUBSET ];
+  (* // *)
+  TYPE_THEN `A = UNIONS (IMAGE (closure top2) G)` ABBREV_TAC ;
+  REWRITE_TAC[UNIONS;SUBSET ];
+  TYPE_THEN `u` UNABBREV_TAC;
+  FULL_REWRITE_TAC [INR IN_SING];
+  ASM_MESON_TAC [];
+  ]);;
+  (* }}} *)
+
+let curve_cell_h_inter_ver2 = prove_by_refinement(
+  `!G m.  (FINITE  G) /\ (G SUBSET edge) ==>
+     (((h_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
+         (~(G (h_edge m))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ONCE_REWRITE_TAC [GSYM curve_cell_h_ver2];
+  IMATCH_MP_TAC  cell_inter;
+  ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
+  ASM_MESON_TAC[segment;curve_cell_cell];
+  ]);;
+  (* }}} *)
+
+let curve_cell_v_inter_ver2 = prove_by_refinement(
+  `!G m. (FINITE  G) /\ (G SUBSET edge) ==>
+     (((v_edge m) INTER (UNIONS (curve_cell G)) = {}) <=>
+         (~(G (v_edge m))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ONCE_REWRITE_TAC [GSYM curve_cell_v_ver2];
+  IMATCH_MP_TAC  cell_inter;
+  ASM_REWRITE_TAC [cell_rules;curve_cell_cell];
+  ASM_MESON_TAC[segment;curve_cell_cell];
+  ]);;
+  (* }}} *)
+
+let curve_cell_squ_ver2 = prove_by_refinement(
+  `!G m. (FINITE  G) /\ (G SUBSET edge) ==> ~curve_cell G (squ m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[curve_cell;UNION ;eq_sing;square_pointI; segment];
+  FULL_REWRITE_TAC [SUBSET; edge];
+  TSPEC `squ m` 1;
+  USE 0(REWRITE_RULE[square_v_edgeV2;square_h_edgeV2;cell_clauses]);
+  ]);;
+  (* }}} *)
+
+let curve_cell_squ_inter_ver2 = prove_by_refinement(
+  `!G m. (FINITE  G) /\ (G SUBSET edge) ==>
+     (((squ m) INTER (UNIONS (curve_cell G)) = {}))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `cell (squ m)` SUBGOAL_TAC;
+  REWRITE_TAC[cell_rules];
+  TYPE_THEN `(curve_cell G SUBSET cell)` SUBGOAL_TAC;
+  ASM_MESON_TAC[curve_cell_cell;segment];
+  ASM_SIMP_TAC [cell_inter];
+  ASM_MESON_TAC [curve_cell_squ_ver2];
+  ]);;
+  (* }}} *)
+
+let curve_point_unions_ver2 = prove_by_refinement(
+  `!G m. (FINITE  G) /\ (G SUBSET edge) ==>
+     (UNIONS (curve_cell G) (pointI m) = curve_cell G {(pointI m)})`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `UNIONS (curve_cell G) (pointI m) <=> ~({(pointI m)} INTER (UNIONS (curve_cell G)) = EMPTY )` SUBGOAL_TAC;
+  REWRITE_TAC[REWRITE_RULE[not_eq] single_inter];
+  REWRITE_TAC [not_eq];
+  IMATCH_MP_TAC  cell_inter;
+  ASM_MESON_TAC[cell_rules;curve_cell_cell];
+  ]);;
+  (* }}} *)
+
+let curve_cell_not_point_ver2 = prove_by_refinement(
+  `!G m. (FINITE  G) /\ (G SUBSET edge) ==> ((curve_cell G {(pointI m)} <=>
+     ~(num_closure G (pointI m) = 0)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[curve_cell_point;num_closure0];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let curve_closed_ver2 = prove_by_refinement(
+  `!G. (FINITE  G) /\ (G SUBSET edge) ==>
+       (closed_ top2 (UNIONS (curve_cell G)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[GSYM curve_closure_ver2];
+  IMATCH_MP_TAC  closure_closed;
+  REWRITE_TAC[top2_top];
+  IMATCH_MP_TAC  UNIONS_SUBSET;
+  FULL_REWRITE_TAC [SUBSET;top2_unions;edge;  ];
+  ASM_MESON_TAC[REWRITE_RULE[SUBSET] h_edge_euclid;REWRITE_RULE[SUBSET] v_edge_euclid];
+  ]);;
+  (* }}} *)
+
+let ctop_top2_ver2 = prove_by_refinement(
+  `!G A. (FINITE  G) /\ (G SUBSET edge) /\ ctop G A ==> top2 A`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[ctop;induced_top;IMAGE ;];
+  TYPE_THEN `U = top_of_metric(euclid 2,d_euclid)` ABBREV_TAC ;
+  TYPE_THEN `euclid 2 = UNIONS U` SUBGOAL_TAC;
+  TYPE_THEN `U` UNABBREV_TAC;
+  ASM_MESON_TAC[top_of_metric_unions;metric_euclid];
+  IMATCH_MP_TAC  top_inter;
+  ASM_REWRITE_TAC[top2_top;];
+  ASM_SIMP_TAC[GSYM curve_closure_ver2;top2];
+  IMATCH_MP_TAC  (REWRITE_RULE[open_DEF] closed_open);
+  IMATCH_MP_TAC  closure_closed;
+  CONJ_TAC;
+  TYPE_THEN `U` UNABBREV_TAC;
+  ASM_MESON_TAC[top_of_metric_top;metric_euclid];
+  USE 5(GSYM);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  UNIONS_SUBSET;
+  FULL_REWRITE_TAC [edge;ISUBSET;];
+  TSPEC `A'` 2;
+  REWRITE_TAC[];
+  FIRST_ASSUM  DISJ_CASES_TAC;
+  ASM_MESON_TAC[ (REWRITE_RULE[ISUBSET;] v_edge_euclid)];
+  ASM_MESON_TAC [(REWRITE_RULE[ISUBSET;] h_edge_euclid)];
+  ]);;
+  (* }}} *)
+
+let convex_connected_ver2 = prove_by_refinement(
+  `!G Z. (FINITE  G) /\ (G SUBSET edge) /\ convex Z /\
+         (Z SUBSET (UNIONS (ctop G))) ==>
+            (connected (ctop G) Z)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[connected];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 8 (REWRITE_RULE[DE_MORGAN_THM;SUBSET ]);
+  LEFT 8 "x";
+  LEFT 9 "x";
+  TYPE_THEN `Z x /\ Z x'` SUBGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `mk_segment x x' SUBSET A UNION B` SUBGOAL_TAC;
+  FULL_REWRITE_TAC [convex];
+  ASM_MESON_TAC[ISUBSET];
+  TYPE_THEN `connected (top_of_metric(euclid 2,d_euclid)) (mk_segment x x')` SUBGOAL_TAC;
+  IMATCH_MP_TAC  connected_mk_segment;
+  USE 3(REWRITE_RULE[ctop_unions;SUBSET;DIFF;]);
+  (* - *)
+  FULL_REWRITE_TAC [connected];
+  TYPEL_THEN [`A`;`B`] (USE 13 o ISPECL);
+  REWR 13;
+  TYPE_THEN `top_of_metric (euclid 2,d_euclid) A /\ top_of_metric (euclid 2,d_euclid) B` SUBGOAL_TAC;
+  REWRITE_TAC[GSYM top2];
+  ASM_MESON_TAC[ctop_top2_ver2;top2];
+  UND 13 THEN   ASM_REWRITE_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  (* -- *)
+  UND 9 THEN REWRITE_TAC[];
+  UND 8 THEN ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  ASM_MESON_TAC[mk_segment_end;ISUBSET];
+  ASM_MESON_TAC [mk_segment_end;ISUBSET ];
+  ]);;
+  (* }}} *)
+
+let convex_component_ver2 = prove_by_refinement(
+  `!G Z x. (FINITE  G) /\ (G SUBSET edge) /\ convex Z /\
+       (Z SUBSET (UNIONS (ctop G))) /\
+     (~(Z INTER (component  (ctop G) x ) = EMPTY))  ==>
+        (Z SUBSET (component  (ctop G) x))  `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `connected (ctop G) Z` SUBGOAL_TAC;
+  ASM_SIMP_TAC[convex_connected_ver2];
+  USE 4(REWRITE_RULE[EMPTY_EXISTS;INTER ]);
+  USE 4(MATCH_MP component_replace);
+  IMATCH_MP_TAC  connected_component;
+  ]);;
+  (* }}} *)
+
+let unions_cell_of_ver2 = prove_by_refinement(
+  `!G x. ((FINITE  G) /\ (G SUBSET edge) ==>
+     (UNIONS (cell_of (component  (ctop G) x)) =
+           component  (ctop G) x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  REWRITE_TAC [UNIONS;SUBSET;cell_of];
+  CONJ_TAC;
+  TYPE_THEN `(euclid 2 x')` SUBGOAL_TAC;
+  UND 2 THEN REWRITE_TAC[component_DEF   ;connected;SUBSET ;ctop_unions;DIFF ];
+  USE 3 (MATCH_MP point_onto);
+  TYPE_THEN `x'` UNABBREV_TAC;
+  ASSUME_TAC cell_unions;
+  TSPEC `p` 3;
+  USE 3 (REWRITE_RULE[UNIONS]);
+  TYPE_THEN `u` EXISTS_TAC;
+  (* - *)
+  DISCH_ALL_TAC;
+  TYPE_THEN `u SUBSET (component  (ctop G) x)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  convex_component_ver2 ;
+  ASM_REWRITE_TAC[EMPTY_EXISTS];
+  CONJ_TAC;
+  ASM_MESON_TAC[cell_convex];
+  CONJ_TAC;
+  REWRITE_TAC[ctop_unions];
+  REWRITE_TAC[DIFF;SUBSET ];
+  CONJ_TAC;
+  ASM_MESON_TAC[cell_euclid;ISUBSET];
+  FULL_REWRITE_TAC[UNIONS];
+  USE 1 (MATCH_MP   curve_cell_cell);
+  USE 1 (REWRITE_RULE[ISUBSET]);
+  TSPEC `u'` 1;
+  TYPE_THEN `u = u'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  REWRITE_TAC[EMPTY_EXISTS;INTER];
+  ASM_MESON_TAC[];
+  (* --- *)
+  USE 2 (REWRITE_RULE[component_DEF;connected;SUBSET ]);
+  TYPE_THEN `UNIONS (ctop G) (point p)` SUBGOAL_TAC;
+  USE 12(REWRITE_RULE[ctop_unions;DIFF ;UNIONS ;DE_MORGAN_THM ]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `point p` EXISTS_TAC;
+  ASM_REWRITE_TAC [INTER];
+  (* - *)
+  FULL_REWRITE_TAC [ISUBSET];
+  ]);;
+  (* }}} *)
+
+let unbounded = jordan_def `unbounded C <=>
+  (?r. !s. (r <=. s) ==> C (point(s,&.0)))`;;
+
+let curve_cell_empty = prove_by_refinement(
+  `curve_cell EMPTY = EMPTY `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[curve_cell];
+  REWRITE_TAC[EQ_EMPTY];
+  THM_INTRO_TAC[`top2`] closure_empty;
+  REWRITE_TAC[top2_top];
+  REWR 0;
+  ]);;
+  (* }}} *)
+
+let curve_cell_union = prove_by_refinement(
+  `!A B. curve_cell (A UNION B) = curve_cell A UNION curve_cell B`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[curve_cell];
+  FULL_REWRITE_TAC[UNIONS_UNION;];
+  ASM_SIMP_TAC[top2_top;closure_union];
+  TYPE_THEN `{z | ?n. (z = {(pointI n)}) /\  (closure top2 (UNIONS A) UNION closure top2 (UNIONS B)) (pointI n)} = ( {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS A) (pointI n)}) UNION ({z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS B) (pointI n)})` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  MESON_TAC[];
+  TYPE_THEN `C = {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS A) (pointI n)}` ABBREV_TAC ;
+  TYPE_THEN `D = {z | ?n. (z = {(pointI n)}) /\ closure top2 (UNIONS B) (pointI n)}` ABBREV_TAC ;
+  REWRITE_TAC[UNION_ACI];
+  ]);;
+  (* }}} *)
+
+let insert_sing = prove_by_refinement(
+  `!A (x:A). x INSERT A = {x} UNION A`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INSERT;UNION;INR IN_SING];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let curve_cell_sing = prove_by_refinement(
+  `!e. (edge e) ==> (UNIONS (curve_cell {e}) = closure top2 e)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[curve_cell;UNIONS_UNION];
+  FULL_REWRITE_TAC[edge];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  REWRITE_TAC[v_edge_closure;vc_edge;plus_e12];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;UNIONS];
+  CONV_TAC (dropq_conv "u");
+  REWRITE_TAC[INR IN_SING;cell_clauses;pointI_inj];
+  RIGHT_TAC "n";
+  TYPE_THEN `v_edge m x` ASM_CASES_TAC;
+  MESON_TAC[];
+  (* - *)
+  REWRITE_TAC[h_edge_closure;hc_edge;plus_e12];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;UNIONS];
+  CONV_TAC (dropq_conv "u");
+  REWRITE_TAC[INR IN_SING;cell_clauses;pointI_inj];
+  RIGHT_TAC "n";
+  TYPE_THEN `h_edge m x` ASM_CASES_TAC;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let unbounded_elt = prove_by_refinement(
+  `!G. (FINITE G) /\ (G SUBSET edge) ==>
+     (?r. !x . (UNIONS (curve_cell G)) x ==> (x 0 <. r))`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `!G. (FINITE G) ==> ((G SUBSET edge) ==> (?r. !x . (UNIONS (curve_cell G)) x ==> (x 0 <. r)))` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  FINITE_INDUCT_STRONG ;ASM_MESON_TAC[]];
+  (* - *)
+  CONJ_TAC;
+  REWRITE_TAC[curve_cell_empty];
+  (* - *)
+  ASSUME_TAC top2_top;
+  ONCE_REWRITE_TAC[insert_sing];
+  REWRITE_TAC[curve_cell_union;UNIONS_UNION];
+  REWRITE_TAC[UNION;];
+  NAME_CONFLICT_TAC;
+  THM_INTRO_TAC[`x`] curve_cell_sing;
+  FULL_REWRITE_TAC[INSERT;SUBSET];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `G SUBSET edge` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[ISUBSET;INSERT];
+  ASM_MESON_TAC[];
+  REP_BASIC_TAC;
+  (* - *)
+  TYPE_THEN `edge x` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[INSERT;SUBSET;];
+  ASM_MESON_TAC[];
+  TYPE_THEN `?r. !x'. closure top2 x x' ==> x' 0 < r` SUBAGOAL_TAC;
+  USE 7(REWRITE_RULE[edge]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  REWRITE_TAC[v_edge_closure;vc_edge;UNION ;INR IN_SING;plus_e12 ];
+  TYPE_THEN  `real_of_int (FST m) + (&1)`  EXISTS_TAC;
+  FULL_REWRITE_TAC[pointI];
+  UND 9 THEN REP_CASES_TAC THEN   FULL_REWRITE_TAC[v_edge;coord01];
+  FULL_REWRITE_TAC[v_edge;coord01];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[coord01];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[coord01;pointI];
+  REAL_ARITH_TAC;
+  (* --A *)
+  REWRITE_TAC[h_edge_closure;hc_edge;UNION ;INR IN_SING;plus_e12 ];
+  TYPE_THEN  `real_of_int (FST m) + (&2)`  EXISTS_TAC;
+  UND 9 THEN REP_CASES_TAC;
+  FULL_REWRITE_TAC[h_edge;coord01];
+  FULL_REWRITE_TAC[h_edge;coord01];
+  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
+  UND 10 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[pointI];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[pointI];
+  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
+  REAL_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `max_real r r'` EXISTS_TAC;
+  TSPEC `x'` 3;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN `r'` EXISTS_TAC;
+  ASM_REWRITE_TAC[max_real_le];
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN `r` EXISTS_TAC;
+  REWRITE_TAC[max_real_le];
+  ]);;
+  (* }}} *)
+
+let mk_segment_convex = prove_by_refinement(
+  `!x y. convex (mk_segment x y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[convex];
+  FULL_REWRITE_TAC[mk_segment;SUBSET;];
+  REP_BASIC_TAC;
+  REWRITE_TAC[euclid_ldistrib];
+  ONCE_REWRITE_TAC[euclid_plus_pair];
+  REWRITE_TAC[euclid_scale_act];
+  REWRITE_TAC[GSYM euclid_rdistrib];
+  TYPE_THEN `(a * a'' + (&1 - a) * a')` EXISTS_TAC;
+  CONJ_TAC;
+  ineq_le_tac `(&0) + (a * a'') + (&1 - a)* a' = (a * a'' + (&1 - a)*a')`;
+  CONJ_TAC;
+  ineq_le_tac `(a * a'' + (&1 - a) * a') + ((&1 - a)*(&1 - a')) + a*(&1 - a'') = &1`;
+  AP_TERM_TAC;
+  AP_THM_TAC;
+  AP_TERM_TAC;
+  real_poly_tac;
+  ]);;
+  (* }}} *)
+
+let mk_segment_h = prove_by_refinement(
+  `!r s b x. (r <= s) ==> (mk_segment (point(r,b)) (point(s,b)) x <=> (?t. (r <= t /\ t <= s /\ (x = point(t,b)))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[mk_segment];
+  REWRITE_TAC[point_scale;point_add;GSYM REAL_RDISTRIB;REAL_ARITH `a + &1 - a = &1`;REAL_ARITH `&1 * b = b`];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `a * r + (&1 - a) *s` EXISTS_TAC;
+  CONJ_TAC;
+  ineq_le_tac `r + (s - r)* (&1 - a) = a * r + (&1 - a)*s`;
+  ineq_le_tac `(a * r + (&1 - a) * s) + (s - r)*a = s`;
+  TYPE_THEN `s = r` ASM_CASES_TAC;
+  REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1* a = a)`];
+  TYPE_THEN `&0` EXISTS_TAC;
+  UND 2 THEN UND 3 THEN UND 4 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[point_inj;PAIR_SPLIT];
+  TYPE_THEN `v = &1/(s - r)` ABBREV_TAC ;
+  TYPE_THEN `(s - r)*v = &1` SUBAGOAL_TAC;
+  TYPE_THEN `v` UNABBREV_TAC;
+  REWRITE_TAC[GSYM real_div_assoc];
+  REDUCE_TAC;
+  IMATCH_MP_TAC  REAL_DIV_REFL;
+  UND 5 THEN UND 4 THEN REAL_ARITH_TAC;
+  TYPE_THEN `v*(s - t)` EXISTS_TAC;
+  TYPE_THEN `&0 < v` SUBAGOAL_TAC;
+  TYPE_THEN `v` UNABBREV_TAC;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  UND 7 THEN UND 2 THEN REAL_ARITH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_LCANCEL_IMP;
+  TYPE_THEN `(s - r)` EXISTS_TAC;
+  CONJ_TAC;
+  UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_MUL_ASSOC];
+  REDUCE_TAC;
+  UND 3 THEN REAL_ARITH_TAC;
+  TYPE_THEN `(v * (s - t)) * r + (&1 - v * (s - t)) * s = s + ((s - r)*v)*(t - s)` SUBAGOAL_TAC THENL [real_poly_tac;REDUCE_TAC];
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+
+  ]);;
+  (* }}} *)
+
+let unbounded_comp = prove_by_refinement(
+  `!G. (FINITE G) /\ (G SUBSET edge) ==>
+      (?x. unbounded (component  (ctop G) x))` ,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[unbounded];
+  THM_INTRO_TAC[`G`] unbounded_elt;
+  TYPE_THEN `point(r, &0)` EXISTS_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  TYPE_THEN `Z = mk_segment (point(r, &0)) (point(s, &0))` ABBREV_TAC ;
+  THM_INTRO_TAC[`G`;`Z`;`(point(r, &0))`] convex_component_ver2;
+  CONJ_TAC;
+  TYPE_THEN `Z` UNABBREV_TAC;
+  REWRITE_TAC[mk_segment_convex];
+  (* -- *)
+  CONJ_TAC;
+  TYPE_THEN `Z` UNABBREV_TAC;
+  REWRITE_TAC[ctop_unions];
+  REWRITE_TAC[SUBSET;DIFF];
+  THM_INTRO_TAC[`r`;`s`;`&0`;`x`] mk_segment_h;
+  REWR 5;
+  REWRITE_TAC[euclid_point];
+  TSPEC `(point (t ,&0))` 2;
+  FULL_REWRITE_TAC[coord01];
+  UND 2 THEN UND 7 THEN REAL_ARITH_TAC;
+  UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `(point(r,&0))` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  (* -- *)
+  CONJ_TAC;
+  TYPE_THEN `Z` UNABBREV_TAC;
+  THM_INTRO_TAC[`r`;`s`;`&0`;`point(r,&0)`] mk_segment_h;
+  TYPE_THEN `r` EXISTS_TAC;
+  UND 3 THEN REAL_ARITH_TAC;
+  IMATCH_MP_TAC  component_refl;
+  REWRITE_TAC[ctop_unions];
+  REWRITE_TAC[DIFF;euclid_point];
+  TSPEC  `(point(r,&0))` 2;
+  FULL_REWRITE_TAC[coord01];
+  UND 2 THEN REAL_ARITH_TAC;
+  (* -A *)
+  FULL_REWRITE_TAC[SUBSET];
+  TSPEC  `(point(s,&0))` 5;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `Z` UNABBREV_TAC;
+  REWRITE_TAC[mk_segment_end];
+  ]);;
+  (* }}} *)
+
+let unbounded_comp_unique = prove_by_refinement(
+  `!G x y. (FINITE G) /\ (G SUBSET edge) /\
+      (unbounded (component  (ctop G) x)) /\
+       (unbounded(component  (ctop G) y)) ==>
+         (component  (ctop G) x = component  (ctop G) y) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[unbounded];
+  TSPEC  `max_real r r'` 0;
+  TSPEC `max_real r r'` 1;
+  FULL_REWRITE_TAC[max_real_le];
+  ASM_MESON_TAC[component_replace];
+  ]);;
+  (* }}} *)
+
+let unbounded_set = jordan_def
+  `unbounded_set G x = unbounded(component  (ctop G) x)`;;
+
+let bounded_set = jordan_def
+   `bounded_set G x <=> ~(component  (ctop G) x = EMPTY) /\
+      ~(unbounded (component  (ctop G) x))`;;
+
+let bounded_unbounded_disj = prove_by_refinement(
+  `!G. bounded_set G INTER unbounded_set G = EMPTY `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[EQ_EMPTY];
+  FULL_REWRITE_TAC[INTER;bounded_set;unbounded_set];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let bounded_unbounded_union = prove_by_refinement(
+  `!G. bounded_set G UNION unbounded_set G = UNIONS (ctop G)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;bounded_set;unbounded_set];
+  THM_INTRO_TAC[`G`] ctop_top;
+  TYPE_THEN `component  (ctop G) x = EMPTY` ASM_CASES_TAC;
+  THM_INTRO_TAC[`ctop G`;`x`] component_empty;
+  REWR 2;
+  REWRITE_TAC[unbounded];
+  TSPEC `r + &1` 3;
+  UND 3 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[TAUT `~A \/ A`];
+  ASM_MESON_TAC[component_empty];
+  ]);;
+  (* }}} *)
+
+let bounded_subset_unions = prove_by_refinement(
+  `!G x. (bounded_set G x ==> UNIONS (ctop G) x) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[GSYM bounded_unbounded_union;UNION];
+  ]);;
+  (* }}} *)
+
+let unbounded_subset_unions = prove_by_refinement(
+  `!G x. (unbounded_set G x ==> UNIONS (ctop G) x) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[GSYM bounded_unbounded_union;UNION];
+  ]);;
+  (* }}} *)
+
+let unbounded_set_nonempty = prove_by_refinement(
+  `!G. (FINITE G) /\ (G SUBSET edge) ==>
+        ~(unbounded_set G = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[EMPTY_EXISTS];
+  REWRITE_TAC[unbounded_set];
+  THM_INTRO_TAC[`G`] unbounded_comp;
+  ]);;
+  (* }}} *)
+
+let unbounded_set_comp = prove_by_refinement(
+  `!G. (FINITE G) /\ (G SUBSET edge) ==>
+      (?x. unbounded_set G = component  (ctop G) x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`G`] unbounded_comp;
+  TYPE_THEN `x` EXISTS_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 3(REWRITE_RULE[SUBSET]);
+  LEFT 3 "x'";
+  UND 3 THEN REWRITE_TAC[];
+  THM_INTRO_TAC[`G`;`x`;`x'`] unbounded_comp_unique;
+  FULL_REWRITE_TAC[unbounded_set];
+  IMATCH_MP_TAC  component_refl;
+  FULL_REWRITE_TAC[unbounded_set];
+  FULL_REWRITE_TAC[unbounded];
+  TSPEC  `r` 3;
+  FULL_REWRITE_TAC[ARITH_RULE `r <= r`];
+  TYPE_THEN `~(component  (ctop G) x' = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[EQ_EMPTY];
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`ctop G`;`x'`] component_empty;
+  REWRITE_TAC[ctop_top];
+  ASM_MESON_TAC[];
+  (* - *)
+  REWRITE_TAC[SUBSET];
+  REWRITE_TAC[unbounded_set];
+  TYPE_THEN `component  (ctop G) x = component  (ctop G) x'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  component_replace;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let unbounded_set_comp_elt = prove_by_refinement(
+  `!G x. (FINITE G) /\ (G SUBSET edge) /\
+        (unbounded_set G = component  (ctop G) x) ==>
+           (unbounded_set G x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC ;
+  THM_INTRO_TAC[`G`]unbounded_set_nonempty;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  REWR 3;
+  TYPE_THEN `~(component  (ctop G) x = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[EQ_EMPTY ];
+  ASM_MESON_TAC[];
+  ASSUME_TAC ctop_top;
+  TYPE_THEN `(UNIONS (ctop G) x)` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`ctop G`;`x`] component_empty;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[component_refl];
+  ]);;
+  (* }}} *)
+
+let unbounded_even_subset = prove_by_refinement(
+  `!G. rectagon G ==> (unbounded_set G SUBSET UNIONS (par_cell T G))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `FINITE G /\ G SUBSET edge` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  THM_INTRO_TAC[`G`] unbounded_set_comp;
+  THM_INTRO_TAC[`G`;`T`;`x`] par_cell_comp;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  PROOF_BY_CONTR_TAC;
+  KILL 6;
+  KILL 4;
+  THM_INTRO_TAC[`G`;`x`] unbounded_set_comp_elt;
+  USE 4 (REWRITE_RULE[unbounded_set;unbounded]);
+  THM_INTRO_TAC[`G`] unbounded_elt;
+  TYPE_THEN `s =  floor (max_real r r') + &:1` ABBREV_TAC ;
+  TYPE_THEN `r < real_of_int s /\ r' < real_of_int s` SUBAGOAL_TAC;
+  TYPE_THEN `s` UNABBREV_TAC;
+  TYPE_THEN `!t u. t <= u ==> t <. real_of_int( floor u + &:1)` SUBAGOAL_TAC;
+  REWRITE_TAC[int_add_th ; int_of_num_th];
+  IMATCH_MP_TAC  REAL_LET_TRANS;
+  TYPE_THEN `u` EXISTS_TAC;
+  REWRITE_TAC[floor_ineq];
+  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN REWRITE_TAC[max_real_le] ;
+  (* -A *)
+  TYPE_THEN `~(UNIONS (curve_cell G) (pointI (s, &:0)))` SUBAGOAL_TAC;
+  TSPEC `pointI (s, &:0)` 6;
+  USE 6 (REWRITE_RULE[pointI;coord01]);
+  UND 6 THEN UND 8 THEN REAL_ARITH_TAC;
+  THM_INTRO_TAC[`G`] rectagon_segment;
+  THM_INTRO_TAC[`G`;`(s,&:0)`] curve_point_unions;
+  UND 12 THEN ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  (* - *)
+  TYPE_THEN `par_cell T G {(pointI (s, &:0))}` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`G`;`(s, &:0)`;`T`] par_cell_point;
+  CONJ_TAC;
+  ASM_MESON_TAC[curve_cell_not_point];
+  REWRITE_TAC[num_lower];
+  TYPE_THEN `{m | G (h_edge m) /\ (FST m = s) /\ SND m <=: &:0} = EMPTY` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  USE 6(REWRITE_RULE[UNIONS]);
+  LEFT 6 "u";
+  LEFT 6 "u";
+  TSPEC  `h_edge u` 6;
+  THM_INTRO_TAC[`G`;`u`] curve_cell_h;
+  REWR 6;
+  USE 6(REWRITE_RULE[h_edge]);
+  REWR 6;
+  USE 6 (CONV_RULE (dropq_conv "x"));
+  USE 6 (REWRITE_RULE[coord01]);
+  USE 6 (CONV_RULE (dropq_conv "v"));
+  TSPEC `real_of_int s + &1/ (&2)` 6;
+  USE 6(REWRITE_RULE[int_add_th;int_of_num_th; REAL_LT_ADDR; REAL_LT_LADD; ]);
+  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  IMATCH_MP_TAC  half_pos;
+  TYPE_THEN `real_of_int s < r'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LT_TRANS;
+  TYPE_THEN `real_of_int s + &1 / &2` EXISTS_TAC;
+  REWRITE_TAC[REAL_LT_ADDR; REAL_LT_HALF1];
+  UND 18 THEN UND 8 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[CARD_CLAUSES;EVEN2];
+  (* -B *)
+  TYPE_THEN `UNIONS (par_cell F G) (pointI (s,&:0))` SUBAGOAL_TAC;
+  USE 5 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[pointI;int_of_num_th];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 9 THEN REAL_ARITH_TAC ;
+  TYPE_THEN `UNIONS (par_cell T G) (pointI (s,&:0))` SUBAGOAL_TAC;
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `{(pointI (s,&:0))}` EXISTS_TAC ;
+  REWRITE_TAC[INR IN_SING];
+  (* - *)
+  THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
+  USE 16(REWRITE_RULE[INTER;EQ_EMPTY]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let odd_bounded_subset = prove_by_refinement(
+  `!G. rectagon G ==> (UNIONS (par_cell F G) SUBSET  bounded_set G)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  (* - *)
+  REWRITE_TAC[SUBSET];
+  THM_INTRO_TAC[`G`] unbounded_even_subset;
+  FULL_REWRITE_TAC[SUBSET];
+  TSPEC `x` 2;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[bounded_set;unbounded_set;DE_MORGAN_THM ];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`G`] ctop_top;
+  THM_INTRO_TAC[`ctop G`;`x`] component_empty;
+  UND 6 THEN ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`G`]rectagon_segment;
+  THM_INTRO_TAC[`G`;`T`] par_cell_partition;
+  USE 7(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 7;
+  FULL_REWRITE_TAC[UNION];
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
+  UND 5 THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let unique_bounded = prove_by_refinement(
+  `!G x y. (rectagon G) /\ bounded_set G x /\ bounded_set G y ==>
+   (component  (ctop G) x = component  (ctop G) y) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`G`;`x`] bounded_subset_unions;
+  THM_INTRO_TAC[`G`;`y`] bounded_subset_unions;
+  TYPE_THEN `FINITE G /\ G SUBSET edge` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  THM_INTRO_TAC[`G`] unbounded_set_nonempty;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  THM_INTRO_TAC[`G`;`u`] unbounded_subset_unions;
+  THM_INTRO_TAC[`G`] rectagon_h_edge;
+  THM_INTRO_TAC[`G`] ctop_top;
+  TYPE_THEN `~(component  (ctop G) x = EMPTY) /\ ~(component  (ctop G) u = EMPTY) /\ ~(component  (ctop G) y = EMPTY)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[component_empty];
+  TYPE_THEN `segment G` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  THM_INTRO_TAC[`G`;`x`;`h_edge m`] along_lemma11;
+  THM_INTRO_TAC[`G`;`y`;`h_edge m`] along_lemma11;
+  THM_INTRO_TAC[`G`;`u`;`h_edge m`] along_lemma11;
+  USE 16 (MATCH_MP squc_h);
+  USE 18 (MATCH_MP squc_h);
+  USE 20 (MATCH_MP squc_h);
+  TYPE_THEN `(p'' = p) \/ (p'' = p') \/ (p' = p)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `!p a b. squ p SUBSET component  (ctop G) a /\ squ p SUBSET component  (ctop G) b ==> (component  (ctop G) a = component  (ctop G) b)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET];
+  THM_INTRO_TAC[`squ p'''`] cell_nonempty;
+  REWRITE_TAC[cell_rules];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TSPEC `u'` 22;
+  TSPEC `u'` 23;
+  KILL 19 THEN KILL 17 THEN KILL 15 THEN KILL 5;
+  ASM_MESON_TAC[component_replace];
+  (* - *)
+  TYPE_THEN `!a. bounded_set G a ==> ~(component  (ctop G) a = component  (ctop G) u)` SUBAGOAL_TAC;
+  TYPE_THEN `unbounded_set G a` SUBAGOAL_TAC;
+  REWRITE_TAC[unbounded_set];
+  REWRITE_TAC[GSYM unbounded_set];
+  THM_INTRO_TAC[`G`] bounded_unbounded_disj;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* - *)
+  UND 21 THEN REP_CASES_TAC;
+  TYPE_THEN `p''` UNABBREV_TAC;
+  UND 22 THEN DISCH_THEN (THM_INTRO_TAC[`p`;`u`;`x`]);
+  UND 23 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `p''` UNABBREV_TAC;
+  UND 22 THEN DISCH_THEN (THM_INTRO_TAC[`p'`;`u`;`y`]);
+  UND 23 THEN DISCH_THEN (THM_INTRO_TAC[`y`]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `p'` UNABBREV_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let odd_bounded = prove_by_refinement(
+  `!G. rectagon G ==> (UNIONS (par_cell F G) =  bounded_set G)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  odd_bounded_subset;
+  REWRITE_TAC[SUBSET];
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`G`;`F`] par_cell_nonempty;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `?y. UNIONS (par_cell F G) y` SUBAGOAL_TAC;
+  REWRITE_TAC[UNIONS];
+  LEFT_TAC "u";
+  TYPE_THEN `u` EXISTS_TAC;
+  TYPE_THEN `cell u` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`G`;`F`] par_cell_cell;
+  ASM_MESON_TAC[ISUBSET];
+  USE 4 (MATCH_MP cell_nonempty);
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`G`] odd_bounded_subset;
+  TYPE_THEN `bounded_set G y` SUBAGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  (* - *)
+  THM_INTRO_TAC[`G`;`x`;`y`] unique_bounded;
+  TYPE_THEN `component  (ctop G) y SUBSET UNIONS (par_cell F G)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`G`;`F`;`y`] par_cell_comp;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  USE 9 (REWRITE_RULE[SUBSET]);
+  TSPEC `y` 9;
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  IMATCH_MP_TAC  component_refl;
+  IMATCH_MP_TAC  bounded_subset_unions;
+  THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* - *)
+  USE 7 SYM;
+  REWR 8;
+  USE 8 (REWRITE_RULE[SUBSET]);
+  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  IMATCH_MP_TAC  component_refl;
+  IMATCH_MP_TAC  bounded_subset_unions;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let unbounded_even = prove_by_refinement(
+  `!G. rectagon G ==> (unbounded_set G = UNIONS (par_cell T G))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  THM_INTRO_TAC[`G`] unbounded_even_subset;
+  REWRITE_TAC[SUBSET];
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`G`] odd_bounded;
+  USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 4;
+  (* - *)
+  TYPE_THEN `segment G` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  TYPE_THEN `UNIONS (ctop G) x` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`G`;`T`] par_cell_partition;
+  USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 6;
+  USE 6 (REWRITE_RULE[UNION]);
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`G`] bounded_unbounded_union;
+  USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  FULL_REWRITE_TAC[UNION];
+  TYPE_THEN `bounded_set G x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  REWR 4;
+  THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
+  FULL_REWRITE_TAC[EQ_EMPTY;INTER];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_union_comp = prove_by_refinement(
+  `!G eps x. (rectagon G) /\ (UNIONS (par_cell eps G) x) ==>
+      (UNIONS (par_cell eps G) = component  (ctop G) x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `eps = T` ASM_CASES_TAC;
+  TYPE_THEN `UNIONS (par_cell T G) = unbounded_set G` SUBAGOAL_TAC;
+  ASM_MESON_TAC[unbounded_even];
+  TYPE_THEN `eps` UNABBREV_TAC;
+  REWR 0;
+  THM_INTRO_TAC[`G`]unbounded_set_comp;
+  FULL_REWRITE_TAC[rectagon];
+  REWR 0;
+  ASM_MESON_TAC[component_replace];
+  (* - *)
+  TYPE_THEN `eps = F` ASM_CASES_TAC;
+  TYPE_THEN `eps` UNABBREV_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET];
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`G`;`x`;`x'`] unique_bounded;
+  ASM_MESON_TAC[odd_bounded];
+  UND 4 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  component_refl;
+  IMATCH_MP_TAC  bounded_subset_unions;
+  ASM_MESON_TAC[odd_bounded];
+  THM_INTRO_TAC[`G`;`T`;`x`] par_cell_comp;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  USE 4 (REWRITE_RULE [SUBSET]);
+  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  IMATCH_MP_TAC  component_refl;
+  IMATCH_MP_TAC   bounded_subset_unions;
+  ASM_MESON_TAC[odd_bounded];
+  THM_INTRO_TAC[`G`;`T`] par_cell_union_disjoint;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* 1.0.7 Adding segments *)
+
+let edge_cell = prove_by_refinement(
+  `!e. (edge e) ==> (cell e)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge];
+  ASM_MESON_TAC[cell_rules];
+  ]);;
+  (* }}} *)
+
+let edge_subset_ctop = prove_by_refinement(
+  `!G A. FINITE G /\ G SUBSET edge /\ A SUBSET edge /\
+        (A INTER G = EMPTY) ==> (UNIONS A SUBSET UNIONS (ctop G))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[ctop_unions;DIFF_SUBSET];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `UNIONS edge` EXISTS_TAC ;
+  CONJ_TAC;
+  IMATCH_MP_TAC  UNIONS_UNIONS;
+  FULL_REWRITE_TAC[segment];
+  REWRITE_TAC[UNIONS;SUBSET];
+  USE 5 (MATCH_MP edge_euclid2);
+  FULL_REWRITE_TAC[SUBSET];
+  (* - *)
+  REWRITE_TAC[UNIONS;INTER;EQ_EMPTY];
+  FULL_REWRITE_TAC[EQ_EMPTY];
+  TSPEC `u` 0;
+  USE 0(REWRITE_RULE[INTER]);
+  UND 0 THEN ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `cell u /\ cell u'` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`G`] curve_cell_cell;
+  THM_INTRO_TAC[`u`] edge_cell;
+  FULL_REWRITE_TAC[ISUBSET];
+  FULL_REWRITE_TAC[ISUBSET];
+  (* - *)
+  TYPE_THEN `u = u'` SUBAGOAL_TAC ;
+  IMATCH_MP_TAC  cell_partition;
+  REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  ASM_MESON_TAC[];
+  TYPE_THEN `u'` UNABBREV_TAC;
+  TYPE_THEN `edge u` SUBAGOAL_TAC;
+  ASM_MESON_TAC[ISUBSET];
+  FULL_REWRITE_TAC[edge];
+  ASM_MESON_TAC[curve_cell_h_ver2;curve_cell_v_ver2];
+  ]);;
+  (* }}} *)
+
+let par_cell_pointI = prove_by_refinement(
+  `!G eps m.
+     (par_cell eps G {(pointI m)} =
+         UNIONS (par_cell eps G) (pointI m))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `!u. cell u /\ u (pointI m) ==> ( u = {(pointI m)})` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[cell];
+  UND 1 THEN REP_CASES_TAC THEN (TYPE_THEN `u` UNABBREV_TAC) THEN (FULL_REWRITE_TAC[cell_clauses;INR IN_SING;pointI_inj]);
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
+  REWRITE_TAC[INR IN_SING];
+  TYPE_THEN `u = {(pointI m)}` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[par_cell_cell;subset_imp];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_pointI_trichot = prove_by_refinement(
+  `!G eps m. (rectagon G) ==>
+    ((par_cell eps G {(pointI m)}) \/ (par_cell (~eps) G {(pointI m)})
+        \/ (cls G m))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `UNIONS (ctop G) (pointI m)` ASM_CASES_TAC;
+  THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
+  IMATCH_MP_TAC  rectagon_segment;
+  USE 2 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC  `pointI m` 2;
+  REWR 2;
+  USE 2(REWRITE_RULE[UNION]);
+  USE 2 (REWRITE_RULE[GSYM par_cell_pointI]);
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`G`] rectagon_segment;
+  (* - *)
+  DISJ2_TAC;
+  DISJ2_TAC;
+  REWRITE_TAC[cls];
+  FULL_REWRITE_TAC[ctop_unions;DIFF;DE_MORGAN_THM ];
+  THM_INTRO_TAC[`G`;`m`] curve_point_unions;
+  REWR 1;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[pointI;euclid_point];
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`G`;`m`] curve_cell_not_point;
+  REWR 4;
+  THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
+  FULL_REWRITE_TAC[rectagon];
+  REWR 6;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_nbd = prove_by_refinement(
+  `!G eps m e. (rectagon G) /\ (par_cell eps G {(pointI m)}) /\ edge e
+     /\ closure top2 e (pointI m) ==> (par_cell eps G e)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  FULL_REWRITE_TAC[edge];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`G`;`m`;`eps`] par_cell_point_v;
+  TYPE_THEN `e` UNABBREV_TAC;
+  FULL_REWRITE_TAC[v_edge_closure;vc_edge;UNION;plus_e12;cell_clauses;INR IN_SING ;pointI_inj;];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `m'` UNABBREV_TAC;
+  TYPE_THEN `m` UNABBREV_TAC;
+  TYPE_THEN `down (FST m',SND m' +: &:1) = m'` SUBAGOAL_TAC;
+  REWRITE_TAC[down;PAIR_SPLIT];
+  INT_ARITH_TAC;
+  REWR 5;
+  (* - *)
+  TYPE_THEN `e` UNABBREV_TAC;
+  THM_INTRO_TAC[`G`;`m`;`eps`] par_cell_point_h;
+  FULL_REWRITE_TAC[h_edge_closure;hc_edge;UNION;plus_e12;cell_clauses;INR IN_SING ;pointI_inj;];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `m'` UNABBREV_TAC;
+  TYPE_THEN `m` UNABBREV_TAC;
+  TYPE_THEN `left (FST m' +: &:1,SND m') = m'` SUBAGOAL_TAC;
+  REWRITE_TAC[left  ;PAIR_SPLIT];
+  INT_ARITH_TAC;
+  REWR 4;
+  ]);;
+  (* }}} *)
+
+let segment_in_comp = prove_by_refinement(
+  `!G A. rectagon G /\ segment A /\ (A INTER G = EMPTY) /\
+     (cls G INTER cls A SUBSET  endpoint A)
+   ==> (?eps. A SUBSET par_cell eps G)`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `?e. A e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment;EMPTY_EXISTS ];
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`G`;`A`] edge_subset_ctop;
+  FULL_REWRITE_TAC[segment;rectagon];
+  (* - *)
+  THM_INTRO_TAC[`G`] rectagon_segment;
+  TYPE_THEN`edge e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET;segment];
+  THM_INTRO_TAC[`e`] edge_cell;
+  THM_INTRO_TAC[`e`] cell_nonempty;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  (* - *)
+  TYPE_THEN `?eps. ~(e INTER (UNIONS (par_cell eps G)) = EMPTY)` SUBAGOAL_TAC;
+  REWRITE_TAC[EMPTY_EXISTS];
+  THM_INTRO_TAC[`G`;`T`] par_cell_partition;
+  USE 10(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `u` 10;
+  TYPE_THEN `UNIONS (ctop G) u` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `UNIONS A` EXISTS_TAC;
+  REWRITE_TAC[UNIONS];
+  ASM_MESON_TAC[];
+  REWR 10;
+  USE 10 (REWRITE_RULE[SUBSET ;UNION]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `T` EXISTS_TAC;
+  TYPE_THEN `u` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  REWRITE_TAC[INTER];
+  ASM_MESON_TAC[];
+  (* -A *)
+  TYPE_THEN `eps` EXISTS_TAC;
+  (* - *)
+  USE 10 (REWRITE_RULE [EMPTY_EXISTS;INTER;UNIONS]);
+  TYPE_THEN `u'' = e` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  ASM_MESON_TAC[par_cell_cell;subset_imp ];
+  TYPE_THEN `u''` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `S = A INTER par_cell eps G` ABBREV_TAC ;
+  TYPE_THEN `inductive_set A S` BACK_TAC ;  (* // *)
+  FULL_REWRITE_TAC[inductive_set;segment];
+  TYPE_THEN `S = A` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 2 THEN MESON_TAC[];
+  KILL 15 THEN KILL 20 THEN KILL 16 THEN KILL 21;
+  TYPE_THEN `S` UNABBREV_TAC;
+  ASM_MESON_TAC[SUBSET_INTER_ABSORPTION];
+  (* -// *)
+  REWRITE_TAC[inductive_set];
+  SUBCONJ_TAC;
+  TYPE_THEN `S` UNABBREV_TAC ;
+  REWRITE_TAC[INTER;SUBSET];
+  REWRITE_TAC[EMPTY_EXISTS];
+  CONJ_TAC;
+  TYPE_THEN `e` EXISTS_TAC;
+  TYPE_THEN `S` UNABBREV_TAC;
+  REWRITE_TAC[INTER];
+  (* -B *)
+  USE 13(REWRITE_RULE[INTER]);
+  TYPE_THEN `S` UNABBREV_TAC;
+  THM_INTRO_TAC[`C`;`C'`] adjv_adj;
+  FULL_REWRITE_TAC[segment];
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `m = adjv C C'` ABBREV_TAC ;
+  (* - *)
+  TYPE_THEN `FINITE G /\ FINITE A` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment];
+  TYPE_THEN `~endpoint A m` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[endpoint];
+  THM_INTRO_TAC[`A`;`pointI m`] num_closure1;
+  REWR 23;
+  COPY 23;
+  TSPEC `C` 23;
+  TSPEC `C'` 24;
+  TYPE_THEN `e' = C` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e'` UNABBREV_TAC;
+  THM_INTRO_TAC[`C`;`C'`] adjv_adj2;
+  USE 2(REWRITE_RULE[segment]);
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `C = C'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[adj];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `cls A m` SUBAGOAL_TAC;
+  REWRITE_TAC[cls];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `~cls G m` SUBAGOAL_TAC;
+  USE 0 (REWRITE_RULE[SUBSET;INTER]);
+  ASM_MESON_TAC[];
+  (* -C *)
+  TYPE_THEN `edge C /\ edge C'` SUBAGOAL_TAC;
+  USE 2(REWRITE_RULE[segment]);
+  ASM_MESON_TAC[subset_imp];
+  THM_INTRO_TAC[`G`;`eps`;`m`] par_cell_pointI_trichot;
+  REWR 27;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`G`;`eps`;`m`;`C'`] par_cell_nbd;
+  TYPE_THEN `m` UNABBREV_TAC;
+  IMATCH_MP_TAC  adjv_adj2;
+  (* - *)
+  THM_INTRO_TAC[`G`;`~eps`;`m`;`C`] par_cell_nbd;
+  THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let segment_end_select = prove_by_refinement(
+  `!E A a b. (E SUBSET edge) /\ segment_end A a b /\
+        ~cls E a /\ cls E b ==>
+    (?B c. segment_end B a c /\ cls E c /\ B SUBSET A /\
+            (cls B INTER cls E = {c}))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `EE  = { (B,c) | segment_end B a c /\ cls E c /\ B SUBSET A }` ABBREV_TAC ;
+  (* - *)
+  TYPE_THEN `~(EE = EMPTY)` SUBAGOAL_TAC;
+  UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `(A,b)` EXISTS_TAC;
+  TYPE_THEN `EE` UNABBREV_TAC;
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL];
+  (* - *)
+  THM_INTRO_TAC[`EE`;`(CARD o FST):((((num->real)->bool)->bool)#(int#int))->num`] select_image_num_min;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `?Bm cm. (z = (Bm,cm))` SUBAGOAL_TAC;
+  ONCE_REWRITE_TAC[PAIR_SPLIT];
+  MESON_TAC[];
+  TYPE_THEN `z` UNABBREV_TAC;
+  TYPE_THEN `Bm` EXISTS_TAC;
+  TYPE_THEN `cm` EXISTS_TAC;
+  TYPE_THEN `EE` UNABBREV_TAC;
+  FULL_REWRITE_TAC[o_DEF];
+  USE 4(ONCE_REWRITE_RULE[PAIR_SPLIT]);
+  USE 4(REWRITE_RULE[]);
+  TYPE_THEN `c` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  (* - *)
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  FULL_REWRITE_TAC[SUBSET;INR IN_SING;INTER];
+  IMATCH_MP_TAC  segment_end_cls2;
+  ASM_MESON_TAC[];
+  (* - *)
+  REWRITE_TAC[SUBSET;INTER;INR IN_SING];
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`Bm`;`a`;`cm`;`x`] cut_psegment;
+  DISCH_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  TSPEC `(A',x)` 6;
+  USE 6 (ONCE_REWRITE_RULE[PAIR_SPLIT]);
+  REWR 6;
+  USE 6 (CONV_RULE (dropq_conv "B"));
+  USE 6 (CONV_RULE (dropq_conv "c"));
+  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Bm` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  USE 6(MATCH_MP (ARITH_RULE `x <=| y ==> ~( y < x)`));
+  UND 6 THEN REWRITE_TAC[];
+  (* - *)
+  IMATCH_MP_TAC  card_subset_lt;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  REWRITE_TAC[FINITE_UNION];
+  FULL_REWRITE_TAC[segment_end;segment;psegment];
+  (* - *)
+  TYPE_THEN `~(B' = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end;segment;psegment];
+  UND 17 THEN UND 19 THEN MESON_TAC[];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  FULL_REWRITE_TAC[EQ_EMPTY;INTER ];
+  TSPEC `u` 15;
+  USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `u` 6;
+  FULL_REWRITE_TAC[UNION];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let endpoint_cls = prove_by_refinement(
+  `!G. FINITE G ==> (endpoint G SUBSET cls G)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[endpoint;SUBSET;cls];
+  THM_INTRO_TAC[`G`;`pointI x`] num_closure1;
+  REWR 2;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let conn2_proper = prove_by_refinement(
+  `!G H .  (G SUBSET edge) /\
+        conn2 G /\ conn2 H /\ H SUBSET G /\ ~(H = G)  ==>
+     (?A. A SUBSET G /\ (A INTER H = EMPTY) /\ psegment A /\
+         (cls H INTER cls A = endpoint A))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  (* - *)
+  TYPE_THEN `cls G SUBSET cls H` ASM_CASES_TAC;
+  TYPE_THEN `?e. G e /\ ~H e` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 0 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `edge e` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `{e}` EXISTS_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[SUBSET;INR IN_SING];
+  CONJ_TAC;
+  ASM_REWRITE_TAC[EQ_EMPTY;INR IN_SING;INTER];
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  psegment_edge;
+  TYPE_THEN `endpoint{e} = cls{e}` SUBAGOAL_TAC;
+  ASM_SIMP_TAC[endpoint_closure;cls_edge];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_INTER_ABSORPTION];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `cls G` EXISTS_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  (* -A *)
+  TYPE_THEN `?a. cls G a /\ ~cls H a` SUBAGOAL_TAC;
+  USE 5(REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `FINITE H /\ H SUBSET edge` SUBAGOAL_TAC;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[conn2];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `?b c. cls H b /\ cls H c /\ ~(b = c)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`H`] conn2_cls3;
+  THM_INTRO_TAC[`cls H`;`2`] card_has_subset;
+  CONJ_TAC;
+  ASM_MESON_TAC[finite_cls];
+  UND 10 THEN ARITH_TAC;
+  FULL_REWRITE_TAC[has_size2];
+  TYPE_THEN `B` UNABBREV_TAC;
+  FULL_REWRITE_TAC[SUBSET;INR in_pair];
+  TYPE_THEN `a'` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  (* -B *)
+  TYPE_THEN `cls H SUBSET cls G` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  TYPE_THEN `~(a = b) /\ ~(a = c)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `(?U. U SUBSET G /\ segment_end U a b /\ ~cls U c)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[conn2];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[subset_imp];
+  THM_INTRO_TAC[`H`;`U`;`a`;`b`] segment_end_select;
+  TYPE_THEN `B SUBSET G` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `U` EXISTS_TAC;
+  TYPE_THEN `~cls B c` SUBAGOAL_TAC;
+  TYPE_THEN `cls B SUBSET cls U` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  USE 25 (REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[];
+  KILL 20 THEN KILL 16 THEN KILL 17 THEN KILL 18 THEN KILL 15 THEN KILL 10;
+  KILL 12;
+  TYPE_THEN `~(a = c')` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `~(c = c')` SUBAGOAL_TAC;
+  TYPE_THEN`c'` UNABBREV_TAC;
+  USE 19 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC  `c` 12;
+  USE 12 (REWRITE_RULE[INTER;INR IN_SING]);
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `(?V. V SUBSET G /\ segment_end V a c /\ ~cls V c')` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[conn2];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[subset_imp];
+  THM_INTRO_TAC[`H`;`V`;`a`;`c`] segment_end_select;
+  (* -C *)
+  TYPE_THEN `B' SUBSET G` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `V` EXISTS_TAC;
+  TYPE_THEN `~cls B' c'` SUBAGOAL_TAC;
+  TYPE_THEN `cls B' SUBSET cls V` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  USE 29 (REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[];
+  KILL 20 THEN KILL 16 THEN KILL 17;
+  KILL 15;
+  KILL 12 THEN KILL 24 THEN KILL 14;
+  (* - *)
+  TYPE_THEN `~(c'' = c')` SUBAGOAL_TAC;
+  TYPE_THEN `c''` UNABBREV_TAC;
+  USE 18 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC  `c'` 12;
+  USE 12 (REWRITE_RULE[INTER;INR IN_SING]);
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `B INTER H = EMPTY` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  USE 14(REWRITE_RULE[INTER]);
+  USE 19 SYM;
+  TYPE_THEN `cls {u} SUBSET cls B INTER cls H` SUBAGOAL_TAC;
+  REWRITE_TAC[SUBSET_INTER];
+  CONJ_TAC THEN IMATCH_MP_TAC  cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING];
+  USE 16 SYM;
+  REWR 17;
+  THM_INTRO_TAC[`u`] cls_edge_size2;
+  FULL_REWRITE_TAC[SUBSET];
+  FULL_REWRITE_TAC[has_size2];
+  REWR 17;
+  USE 17 (REWRITE_RULE[SUBSET;INR IN_SING;INR in_pair ]);
+  COPY 17;
+  TSPEC `a'` 17;
+  TSPEC `b` 24;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `B' INTER H = EMPTY` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  USE 15(REWRITE_RULE[INTER]);
+  USE 18 SYM;
+  TYPE_THEN `cls {u} SUBSET cls B' INTER cls H` SUBAGOAL_TAC;
+  REWRITE_TAC[SUBSET_INTER];
+  CONJ_TAC THEN IMATCH_MP_TAC  cls_subset THEN REWRITE_TAC[SUBSET;INR IN_SING];
+  USE 17 SYM;
+  REWR 18;
+  THM_INTRO_TAC[`u`] cls_edge_size2;
+  FULL_REWRITE_TAC[SUBSET];
+  FULL_REWRITE_TAC[has_size2];
+  REWR 18;
+  USE 18 (REWRITE_RULE[SUBSET;INR IN_SING;INR in_pair ]);
+  COPY 18;
+  TSPEC `a'` 18;
+  TSPEC `b` 29;
+  ASM_MESON_TAC[];
+  (* -D *)
+  USE 22 (ONCE_REWRITE_RULE[segment_end_symm]);
+  THM_INTRO_TAC[`B`;`B'`;`c'`;`a`;`c''`] segment_end_trans;
+  TYPE_THEN `U` EXISTS_TAC;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `B UNION B'` EXISTS_TAC;
+  REWRITE_TAC[union_subset];
+  (* - *)
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;SUBSET;UNION;INTER;EQ_EMPTY ];
+  ASM_MESON_TAC[];
+  (* - *)
+  CONJ_TAC;
+  USE 20(REWRITE_RULE[segment_end]);
+  (* -// *)
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[INTER;SUBSET];
+  USE 20 (REWRITE_RULE[segment_end]);
+  REWRITE_TAC[INR in_pair];
+  TYPE_THEN `cls U SUBSET cls(B UNION B')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  USE 31(REWRITE_RULE[SUBSET;cls_union]);
+  USE 31(REWRITE_RULE[UNION]);
+  TSPEC `x` 31;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  USE 19(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 19;
+  USE 19 (REWRITE_RULE[INTER;INR IN_SING]);
+  ASM_MESON_TAC[];
+  USE 18(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 18;
+  USE 18 (REWRITE_RULE[INTER;INR IN_SING]);
+  ASM_MESON_TAC[];
+  (* -E *)
+  USE 20(REWRITE_RULE[segment_end]);
+  REWRITE_TAC[SUBSET;INTER;INR in_pair];
+  CONJ_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `FINITE U` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end;psegment;segment];
+  (* - *)
+  USE 20 SYM;
+  TYPE_THEN `endpoint U SUBSET cls U` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  endpoint_cls;
+  USE 31(REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 20 SYM;
+  REWRITE_TAC[INR in_pair];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION U *)
+(* ------------------------------------------------------------------ *)
+
+
+(* EVEN and ODD components.  1.0.8, Nov 28, 2004, 9am *)
+
+let parity_select  = jordan_def
+  `parity G C = @eps. par_cell eps G C`;;
+
+let cell_ununion = prove_by_refinement(
+  `!V C u. cell C /\ C u /\ (V SUBSET cell) /\ (UNIONS V) u ==> V C`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `u' = C` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  CONJ_TAC;
+  ASM_MESON_TAC[subset_imp];
+  UND 5 THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_cell_partition = prove_by_refinement(
+  `!G eps C. segment G /\ cell C ==>
+      (par_cell eps G C \/ par_cell (~eps) G C \/ curve_cell G C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `curve_cell G C` ASM_CASES_TAC;
+  THM_INTRO_TAC[`C`] cell_nonempty;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `UNIONS (ctop G) u` SUBAGOAL_TAC;
+  REWRITE_TAC[ctop_unions;DIFF;UNIONS  ];
+  CONJ_TAC;
+  THM_INTRO_TAC[`C`] cell_euclid;
+  ASM_MESON_TAC[subset_imp];
+  THM_INTRO_TAC[`curve_cell G`;`C`;`u`] cell_ununion;
+  CONJ_TAC;
+  IMATCH_MP_TAC  curve_cell_cell;
+  FULL_REWRITE_TAC[segment];
+  REWRITE_TAC[UNIONS];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
+  USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `u` 5;
+  REWR 5;
+  USE 5(REWRITE_RULE[UNION]);
+  THM_INTRO_TAC[`G`] par_cell_cell;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  DISJ1_TAC;
+  IMATCH_MP_TAC  cell_ununion;
+  ASM_MESON_TAC[];
+  DISJ2_TAC;
+  IMATCH_MP_TAC  cell_ununion;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_curve_cell_disj = prove_by_refinement(
+  `!G  eps. (G SUBSET edge) ==>
+   (par_cell eps G  INTER curve_cell G = EMPTY )`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[INTER;EQ_EMPTY];
+  USE 2(MATCH_MP par_cell_curve_disj);
+  UND 2 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;UNIONS ];
+  TYPE_THEN `cell x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[curve_cell_cell;subset_imp];
+  USE 2 (MATCH_MP cell_nonempty);
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let curve_cell_edge = prove_by_refinement(
+  `!G e . edge e ==> (curve_cell G e = G e) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  REWRITE_TAC[curve_cell;UNION;INR eq_sing; cell_clauses;v_edge_pointI;h_edge_pointI ];
+  REWRITE_TAC[curve_cell;UNION;INR eq_sing; cell_clauses;v_edge_pointI;h_edge_pointI ];
+  ]);;
+  (* }}} *)
+
+let parity = prove_by_refinement(
+  `!G C. segment G /\ cell C /\ ~curve_cell G C ==>
+        par_cell (parity G C) G C`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[parity_select];
+  SELECT_TAC;
+  THM_INTRO_TAC[`G`;`T`;`C`] par_cell_cell_partition;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let parity_unique = prove_by_refinement(
+  `!G C eps. segment G  /\
+        par_cell eps G C ==> (eps = parity G C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `cell C /\ ~curve_cell G C` SUBAGOAL_TAC;
+  SUBCONJ_TAC;
+  ASM_MESON_TAC[par_cell_cell;subset_imp];
+  THM_INTRO_TAC[`G`;`eps`] par_cell_curve_cell_disj;
+  FULL_REWRITE_TAC[segment];
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`G`;`C`] parity;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN`parity G C = ~eps` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `parity G C` UNABBREV_TAC;
+  THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let unions_curve_cell = prove_by_refinement(
+  `!G C. (G SUBSET edge) /\ cell C ==>
+     ((C INTER UNIONS (curve_cell G) = EMPTY) = (~curve_cell G C))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  USE 3(REWRITE_RULE[INTER;UNIONS;EQ_EMPTY]);
+  USE 0 (MATCH_MP cell_nonempty);
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  (* - *)
+  REWRITE_TAC[EQ_EMPTY;INTER];
+  UND 2 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  cell_ununion;
+  UNIFY_EXISTS_TAC;
+  IMATCH_MP_TAC  curve_cell_cell;
+  ]);;
+  (* }}} *)
+
+let even_num_lower_union = prove_by_refinement(
+  `!A B m. FINITE A /\ FINITE B /\ (A INTER B = EMPTY) ==>
+    (EVEN (num_lower (A UNION B) m) <=>
+        (EVEN (num_lower A m) = EVEN (num_lower B m)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[num_lower_set];
+  THM_INTRO_TAC[`set_lower A m`;`set_lower B m`] even_card_even;
+  REPEAT CONJ_TAC THEN (TRY (IMATCH_MP_TAC finite_set_lower));
+  REWRITE_TAC[EQ_EMPTY;INTER;set_lower];
+  FULL_REWRITE_TAC[EQ_EMPTY;INTER];
+  ASM_MESON_TAC[];
+  (* - *)
+  AP_TERM_TAC;
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[set_lower;UNION];
+  TYPE_THEN `C <=> (FST x = FST m) /\ SND x <=: SND m` ABBREV_TAC ;
+  USE 0 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `h_edge x` 0;
+  UND 0 THEN MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let eq_pair_exchange = prove_by_refinement(
+  `!(a:bool) b c d. ((a = b) <=> (c = d)) <=> ((a = c) <=> (b = d))`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let parity_point = prove_by_refinement(
+  `!A p. segment A /\ ~(curve_cell A {(pointI p)}) ==>
+        (parity A {(pointI p)} = EVEN (num_lower A p))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  parity_unique;
+  REWRITE_TAC[par_cell;cell_clauses];
+  THM_INTRO_TAC[`A`;`{(pointI p)}`] unions_curve_cell;
+  FULL_REWRITE_TAC[cell_rules;segment];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let parity_h = prove_by_refinement(
+  `!A p. segment A /\ ~A (h_edge p) ==>
+       (parity A (h_edge p) <=> EVEN (num_lower A p))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  parity_unique;
+  REWRITE_TAC[par_cell;cell_clauses];
+  THM_INTRO_TAC[`A`;`h_edge p`] unions_curve_cell;
+  FULL_REWRITE_TAC[cell_rules;segment];
+  THM_INTRO_TAC[`A`;`h_edge p`] curve_cell_edge;
+  REWRITE_TAC[edge_h];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let parity_v = prove_by_refinement(
+  `!A p. segment A /\ ~A (v_edge p) ==>
+       (parity A (v_edge p) <=> EVEN (num_lower A p))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  parity_unique;
+  REWRITE_TAC[par_cell;cell_clauses];
+  THM_INTRO_TAC[`A`;`v_edge p`] unions_curve_cell;
+  FULL_REWRITE_TAC[cell_rules;segment];
+  THM_INTRO_TAC[`A`;`v_edge p`] curve_cell_edge;
+  REWRITE_TAC[edge_v];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let parity_squ = prove_by_refinement(
+  `!A p. segment A  ==>
+       (parity A (squ p) <=> EVEN (num_lower A p))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  parity_unique;
+  REWRITE_TAC[par_cell;cell_clauses];
+  THM_INTRO_TAC[`A`;`squ p`] unions_curve_cell;
+  FULL_REWRITE_TAC[cell_rules;segment];
+  THM_INTRO_TAC[`A`;`p`] curve_cell_squ;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let parity_union = prove_by_refinement(
+  `!A B C. segment A /\ segment B /\ segment (A UNION B) /\
+    (A INTER B = EMPTY) /\
+    cell C /\ ~curve_cell A C /\  ~curve_cell B C ==>
+         (parity (A UNION B) C  <=> (parity A C = parity B C))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  parity_unique;
+  REWRITE_TAC[par_cell];
+  TYPE_THEN `A UNION B SUBSET edge` SUBAGOAL_TAC;
+  REWRITE_TAC[union_subset];
+  FULL_REWRITE_TAC[segment];
+  ASM_SIMP_TAC[unions_curve_cell];
+  TYPE_THEN `FINITE A /\ FINITE B` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment];
+  ASM_SIMP_TAC[even_num_lower_union];
+  ONCE_REWRITE_TAC[eq_pair_exchange];
+  (* -A *)
+  REWRITE_TAC[curve_cell_union];
+  REWRITE_TAC[UNION];
+  (* - *)
+  WITH 2(REWRITE_RULE[cell_mem]);
+  UND 10 THEN REP_CASES_TAC ;
+  (* --cases-- *)
+  REWRITE_TAC[cell_clauses];
+  TYPE_THEN`p` EXISTS_TAC;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
+  TYPE_THEN `C` UNABBREV_TAC;
+  CONJ_TAC THEN (IMATCH_MP_TAC  parity_point);
+  REWRITE_TAC[cell_clauses];
+  TYPE_THEN`p` EXISTS_TAC;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
+  TYPE_THEN `C` UNABBREV_TAC;
+  CONJ_TAC THEN (IMATCH_MP_TAC  parity_h) THEN ASM_MESON_TAC[curve_cell_h_ver2];
+  REWRITE_TAC[cell_clauses];
+  TYPE_THEN`p` EXISTS_TAC;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
+  TYPE_THEN `C` UNABBREV_TAC;
+  CONJ_TAC THEN (IMATCH_MP_TAC  parity_v) THEN ASM_MESON_TAC[curve_cell_v_ver2];
+  REWRITE_TAC[cell_clauses];
+  TYPE_THEN`p` EXISTS_TAC;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> (a <=> b)`);
+  TYPE_THEN `C` UNABBREV_TAC;
+  CONJ_TAC THEN (IMATCH_MP_TAC  parity_squ) ;
+  ]);;
+
+  (* }}} *)
+
+(* extraneous fact *)
+let component_simple_arc = prove_by_refinement(
+  `!G x y. (FINITE G /\ G SUBSET edge ) /\ ~(x = y) ==>
+      ((component  (ctop G) x y) <=>
+        (?C. simple_arc_end C x y /\
+             (C INTER (UNIONS (curve_cell G)) = EMPTY)))`,
+  (* {{{ proof *)
+  [
+  (*
+   string together :component-imp-connected, connected-induced2,
+                    p_conn_conn, p_conn_hv_finite;
+   other_direction : simple_arc_connected, connected-induced,
+                    connected-component; *)
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`G`] ctop_top;
+  ASSUME_TAC top2_top;
+  THM_INTRO_TAC[`G`] curve_closed_ver2;
+  TYPE_THEN `top2 (euclid 2 DIFF UNIONS (curve_cell G))` SUBAGOAL_TAC;
+  USE 5 (MATCH_MP closed_open);
+  FULL_REWRITE_TAC[top2_unions;open_DEF ];
+  TYPE_THEN `A = euclid 2 DIFF UNIONS (curve_cell G)` ABBREV_TAC ;
+  TYPE_THEN `UNIONS (ctop G) = A` SUBAGOAL_TAC;
+  TYPE_THEN`A` UNABBREV_TAC;
+  REWRITE_TAC[ctop_unions];
+  TYPE_THEN `induced_top top2 A = ctop G` SUBAGOAL_TAC;
+  REWRITE_TAC[ctop];
+  (* - *)
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  THM_INTRO_TAC[`(ctop G)`;`x`] component_imp_connected;
+  THM_INTRO_TAC[`(top2)`;`A`;`(component  (ctop G) x)`] connected_induced2;
+  REWRITE_TAC[top2_unions];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
+  CONJ_TAC;
+  KILL 7;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[component_unions];
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  REWR 12;
+  (* --A *)
+  TYPE_THEN `B = component  (ctop G) x` ABBREV_TAC ;
+  TYPE_THEN `B x /\ B y` SUBAGOAL_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  THM_INTRO_TAC[`(ctop G)`;`x`;`y`] component_replace;
+  IMATCH_MP_TAC  component_symm;
+  (* -- *)
+  ASSUME_TAC loc_path_conn_top2;
+  TYPE_THEN `top_of_metric(A,d_euclid) = (ctop G)` SUBAGOAL_TAC;
+  REWRITE_TAC[ctop];
+  REWRITE_TAC[top2];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  top_of_metric_induced;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  (* -- *)
+  TYPE_THEN `loc_path_conn (ctop G)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid;
+  FULL_REWRITE_TAC[top2];
+  ASM_MESON_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`top2`] loc_path_conn;
+  REWR 20;
+  TSPEC `A` 20;
+  REWR 20;
+  TSPEC `x` 20;
+  TYPE_THEN `A x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `top2 B` SUBAGOAL_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  ASM_MESON_TAC[path_eq_conn];
+  (* --B *)
+  THM_INTRO_TAC[`B`;`x`;`y`] p_conn_conn;
+  (* -- *)
+  THM_INTRO_TAC[`B`;`x`;`y`] p_conn_hv_finite;
+  ASM_MESON_TAC[];
+  REWR 24;
+  TYPE_THEN `C` EXISTS_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `u` 7;
+  FULL_REWRITE_TAC[DIFF];
+  TYPE_THEN `B u` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `A u` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  REWR 7;
+  (* -C *)
+  (* other_direction : simple_arc_connected, connected-induced,
+                    connected-component; *)
+  THM_INTRO_TAC[`C`;`x`;`y`] simple_arc_end_simple;
+  THM_INTRO_TAC[`C`] simple_arc_connected;
+  TYPE_THEN `C SUBSET euclid 2` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_euclid;
+  THM_INTRO_TAC[`top2`;`A`;`C`] connected_induced2;
+  REWRITE_TAC[top2_unions];
+  REWR 15;
+  (* - *)
+  TYPE_THEN `C SUBSET A` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[DIFF_SUBSET];
+  REWR 15;
+  (* - *)
+  THM_INTRO_TAC[`(ctop G)`;`C`;`x`] connected_component;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  USE 17(REWRITE_RULE[SUBSET]);
+  TSPEC `y` 17;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let ctop_comp_open = prove_by_refinement(
+  `!G x . (FINITE G /\ G SUBSET edge ) ==>
+         top2 (component  (ctop G) x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`G`] ctop_top;
+  ASSUME_TAC top2_top;
+  THM_INTRO_TAC[`G`] curve_closed_ver2;
+  TYPE_THEN `top2 (euclid 2 DIFF UNIONS (curve_cell G))` SUBAGOAL_TAC;
+  USE 4 (MATCH_MP closed_open);
+  FULL_REWRITE_TAC[top2_unions;open_DEF ];
+  TYPE_THEN `A = euclid 2 DIFF UNIONS (curve_cell G)` ABBREV_TAC ;
+  TYPE_THEN `UNIONS (ctop G) = A` SUBAGOAL_TAC;
+  TYPE_THEN`A` UNABBREV_TAC;
+  REWRITE_TAC[ctop_unions];
+  TYPE_THEN `induced_top top2 A = ctop G` SUBAGOAL_TAC;
+  REWRITE_TAC[ctop];
+  (* - *)
+  TYPE_THEN `B = component  (ctop G) x` ABBREV_TAC ;
+  TYPE_THEN `B = EMPTY` ASM_CASES_TAC;
+  THM_INTRO_TAC[`top2`] open_EMPTY;
+  FULL_REWRITE_TAC[open_DEF];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  (* - *)
+  THM_INTRO_TAC[`(ctop G)`;`x`] component_imp_connected;
+  THM_INTRO_TAC[`(top2)`;`A`;`(component  (ctop G) x)`] connected_induced2;
+  REWRITE_TAC[top2_unions];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `UNIONS (ctop G)` EXISTS_TAC;
+  CONJ_TAC;
+  KILL 6;
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[component_unions];
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  REWR 12;
+  (* --A *)
+  TYPE_THEN `B x /\ B u` SUBAGOAL_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  THM_INTRO_TAC[`(ctop G)`;`x`;`u`] component_replace;
+  IMATCH_MP_TAC  component_symm;
+  (* -- *)
+  ASSUME_TAC loc_path_conn_top2;
+  TYPE_THEN `top_of_metric(A,d_euclid) = (ctop G)` SUBAGOAL_TAC;
+  REWRITE_TAC[ctop];
+  REWRITE_TAC[top2];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  top_of_metric_induced;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  (* -- *)
+  TYPE_THEN `loc_path_conn (ctop G)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid;
+  FULL_REWRITE_TAC[top2];
+  ASM_MESON_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`top2`] loc_path_conn;
+  REWR 18;
+  TSPEC `A` 18;
+  REWR 18;
+  TSPEC `x` 18;
+  TYPE_THEN `A x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `B` UNABBREV_TAC;
+  ASM_MESON_TAC[path_eq_conn];
+  (* --B *)
+  ]);;
+  (* }}} *)
+
+let psegment_triple = jordan_def
+  `psegment_triple A B C <=>
+       psegment A /\ psegment B /\ psegment C /\
+           rectagon (A UNION B) /\ rectagon (A UNION C) /\
+             rectagon(B UNION C) /\
+          (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\
+          (B INTER C = EMPTY) /\
+          (cls A INTER cls B = endpoint A) /\
+          (cls B INTER cls C = endpoint A) /\
+          (cls A INTER cls C = endpoint A) /\
+          (endpoint A = endpoint B) /\ (endpoint B = endpoint C)`;;
+
+let psegment_triple3 = prove_by_refinement(
+  `!A B C. psegment_triple A B C ==> psegment_triple B C A`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[UNION_COMM;INTER_COMM];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let psegment_triple2 = prove_by_refinement(
+  `!A B C. psegment_triple A B C ==> psegment_triple C B A`,
+  (* {{{ proof *)
+  [
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[UNION_COMM;INTER_COMM];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let unions_empty_imp_empty  = prove_by_refinement(
+  `!(A:(A->bool)->bool) B. (UNIONS A INTER UNIONS B = EMPTY) /\
+       (!C. A C ==> ~(C = EMPTY)) ==>
+           (A INTER B = EMPTY)  `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[EQ_EMPTY;INTER;UNIONS];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_closure = prove_by_refinement(
+  `!G A eps.
+       FINITE A /\ A SUBSET edge /\ rectagon G /\
+         A SUBSET par_cell eps G ==>
+       (curve_cell A INTER par_cell (~eps) G = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  unions_empty_imp_empty;
+  ASSUME_TAC top2_top;
+  TYPE_THEN `(par_cell (~eps) G) = EMPTY` ASM_CASES_TAC;
+  REWRITE_TAC[INTER_EMPTY];
+  FULL_REWRITE_TAC[curve_cell;UNION];
+  TYPE_THEN `C` UNABBREV_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[SUBSET];
+  TYPE_THEN `edge {}` SUBAGOAL_TAC;
+  TYPE_THEN `cell {}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  edge_cell;
+  USE 9 (MATCH_MP cell_nonempty);
+  ASM_MESON_TAC[];
+  USE 8 SYM;
+  FULL_REWRITE_TAC[EQ_EMPTY;INR IN_SING ];
+  ASM_MESON_TAC[];
+  (* - *)
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `~(UNIONS (par_cell (~eps) G)  = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[UNIONS;EQ_EMPTY];
+  TYPE_THEN `~ (u = EMPTY)` SUBAGOAL_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  THM_INTRO_TAC[`G`;`~eps`] par_cell_cell;
+  FULL_REWRITE_TAC[SUBSET];
+  TYPE_THEN `cell {}` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  USE 8 (MATCH_MP cell_nonempty);
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TSPEC `u'` 6;
+  ASM_MESON_TAC[];
+  (* -A *)
+  TYPE_THEN`closed_ top2 (euclid 2 DIFF (UNIONS (par_cell (~eps) G)))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`top2`;`(UNIONS (par_cell (~eps) G))`] open_closed;
+  REWRITE_TAC[open_DEF];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  THM_INTRO_TAC[`G`;`~eps`;`u'`] par_cell_union_comp;
+  IMATCH_MP_TAC ctop_comp_open ;
+  ASM_MESON_TAC[rectagon];
+  FULL_REWRITE_TAC[top2_unions];
+  (* -B *)
+  THM_INTRO_TAC[`A`] curve_closure_ver2;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  THM_INTRO_TAC[`A`] curve_cell_cell;
+  USE 10 (REWRITE_RULE[SUBSET]);
+  TSPEC `C` 10;
+  USE 9 (MATCH_MP cell_nonempty);
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN`UNIONS (curve_cell A) SUBSET (euclid 2 DIFF UNIONS (par_cell (~eps) G))` SUBAGOAL_TAC;
+  USE 8 GSYM;
+  IMATCH_MP_TAC  closure_subset;
+  REWRITE_TAC[DIFF_SUBSET];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `UNIONS edge` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  UNIONS_UNIONS;
+  REWRITE_TAC[UNIONS;SUBSET];
+  THM_INTRO_TAC[`u'`] edge_euclid2;
+  ASM_MESON_TAC[subset_imp];
+  REWRITE_TAC[INTER;EQ_EMPTY];
+  COPY 10;
+  USE 11(REWRITE_RULE[UNIONS]);
+  THM_INTRO_TAC[`par_cell (~eps) G`;`u'`;`x`] cell_ununion;
+  TYPE_THEN`edge u'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  ASM_MESON_TAC [par_cell_cell;edge_cell];
+  USE 0 (REWRITE_RULE[SUBSET]);
+  TSPEC `u'` 0;
+  THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* - *)
+  FULL_REWRITE_TAC[DIFF_SUBSET];
+  ]);;
+  (* }}} *)
+
+let cell_unions_disj = prove_by_refinement(
+  `!U V. U SUBSET cell /\ V SUBSET cell ==> ((U INTER V = EMPTY) <=>
+      (UNIONS U INTER UNIONS V = EMPTY))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  USE 3(REWRITE_RULE[INTER]);
+  TYPE_THEN `?C. V C /\ C u` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[UNIONS];
+  ASM_MESON_TAC[];
+  TYPE_THEN `cell C` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `U C` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cell_ununion;
+  ASM_MESON_TAC[];
+  USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  ASM_MESON_TAC[];
+  (* - *)
+  IMATCH_MP_TAC  unions_empty_imp_empty;
+  REP_BASIC_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  TYPE_THEN `cell EMPTY ` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  ASM_MESON_TAC[cell_nonempty];
+  ]);;
+  (* }}} *)
+
+let unions_curve_cell_par_cell_disj = prove_by_refinement(
+  `!G eps. (G SUBSET edge) ==>
+    (UNIONS (par_cell eps G) INTER UNIONS (curve_cell G) = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`par_cell eps G`;`curve_cell G`] cell_unions_disj;
+  THM_INTRO_TAC[`G`] curve_cell_cell;
+  REWRITE_TAC[par_cell_cell];
+  USE 1 SYM;
+  IMATCH_MP_TAC  par_cell_curve_cell_disj;
+  ]);;
+  (* }}} *)
+
+let par_cell_simple_arc = prove_by_refinement(
+  `!G eps x y. rectagon G /\ ~(x = y) ==>
+      ((UNIONS (par_cell eps G) x /\ UNIONS (par_cell eps G) y) <=>
+        (?C. simple_arc_end C x y /\
+             (C SUBSET (UNIONS (par_cell eps G)))) )`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  THM_INTRO_TAC[`G`;`eps`;`x`] par_cell_union_comp;
+  THM_INTRO_TAC[`G`;`x`;`y`] component_simple_arc;
+  FULL_REWRITE_TAC[rectagon];
+  REWR 2;
+  TYPE_THEN `C` EXISTS_TAC;
+  USE 4 SYM;
+  REWRITE_TAC[SUBSET];
+  PROOF_BY_CONTR_TAC;
+  (* -- *)
+  THM_INTRO_TAC[`C`;`x`;`y`;`x'`] simple_arc_end_cut;
+  CONJ_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `x'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`G`;`x`;`x'`] component_simple_arc;
+  FULL_REWRITE_TAC[rectagon];
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `~component (ctop G) x x'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  UND 13 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `C'` EXISTS_TAC;
+  FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ]SUBSET_EMPTY];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C INTER UNIONS (curve_cell G)` EXISTS_TAC;
+  IMATCH_MP_TAC subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  TYPE_THEN `C` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  (* -A *)
+  TYPE_THEN `C x /\ C y` SUBAGOAL_TAC;
+  CONJ_TAC THEN   ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
+  ASM_MESON_TAC[subset_imp];
+  ]);;
+  (* }}} *)
+
+let trap_triple_seg = prove_by_refinement(
+  `!A B C eps eps'. psegment_triple A B C /\
+      C SUBSET par_cell (~eps) (A UNION B)
+      ==>
+     (par_cell eps (A UNION B) SUBSET par_cell eps' (A UNION C) \/
+      par_cell eps (A UNION B) SUBSET par_cell (~eps') (A UNION C))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 2 (REWRITE_RULE[SUBSET]);
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  LEFT 2 "x";
+  LEFT 3 "x";
+  UND 2 THEN REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  UND 3 THEN REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN`cell x' /\ cell x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[par_cell_cell;subset_imp];
+  (* - *)
+  TYPE_THEN `!x. cell x /\ par_cell eps (A UNION B) x ==> par_cell eps' (A UNION C) x \/ par_cell (~eps') (A UNION C) x` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`A UNION C`;`eps'`;`x''`] par_cell_cell_partition;
+  IMATCH_MP_TAC  rectagon_segment;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 10 (REWRITE_RULE[curve_cell_union]);
+  UND 10 THEN REP_CASES_TAC;
+  USE 10 (REWRITE_RULE[UNION]);
+  (* -- *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`A UNION B`;`eps`] par_cell_curve_cell_disj;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 21 (REWRITE_RULE[rectagon]);
+  USE 12 (REWRITE_RULE[INTER;EQ_EMPTY;curve_cell_union;DE_MORGAN_THM ]);
+  TSPEC `x''` 12;
+  REWR 12;
+  USE 12 (REWRITE_RULE[UNION;DE_MORGAN_THM ]);
+  ASM_MESON_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`A UNION B`;`C`;`~eps`;] par_cell_closure;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 22(REWRITE_RULE[psegment;segment]);
+  USE 12 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  ASM_MESON_TAC[];
+  (* - *)
+  COPY 8;
+  TSPEC `x` 8;
+  TSPEC `x'` 9;
+  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  REWR 8;
+  REWR 9;
+  (* - *)
+  USE 6 (MATCH_MP cell_nonempty);
+  USE 7(MATCH_MP cell_nonempty);
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `UNIONS (par_cell eps (A UNION B)) u /\ UNIONS (par_cell eps (A UNION B)) u'` SUBAGOAL_TAC;
+  REWRITE_TAC[UNIONS];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `u = u'` ASM_CASES_TAC;
+  TYPE_THEN `u'` UNABBREV_TAC;
+  TYPE_THEN `cell x /\ cell x'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[par_cell_cell;subset_imp];
+  TYPE_THEN `x = x'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  TYPE_THEN `x'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  (* -B *)
+  THM_INTRO_TAC[`A UNION B`;`eps`;`u`;`u'`]par_cell_simple_arc;
+  FULL_REWRITE_TAC[psegment_triple];
+  REWR 13;
+  (* - *)
+  TYPE_THEN `C' INTER UNIONS (curve_cell A) = EMPTY` SUBAGOAL_TAC;
+  REWRITE_TAC [ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_EMPTY];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C' INTER UNIONS (curve_cell (A UNION B))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL;curve_cell_union;UNIONS_UNION];
+  REWRITE_TAC[SUBSET;UNION];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `UNIONS (par_cell eps (A UNION B)) INTER UNIONS (curve_cell (A UNION B))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  REWRITE_TAC[SUBSET_EMPTY];
+  IMATCH_MP_TAC  unions_curve_cell_par_cell_disj ;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 24 (REWRITE_RULE[rectagon]);
+  (* -C *)
+  THM_INTRO_TAC[`A UNION B`;`C`;`~eps`] par_cell_closure;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 26(REWRITE_RULE[psegment;segment]);
+  REWR 16;
+  THM_INTRO_TAC[`curve_cell C`;`par_cell eps (A UNION B)`] cell_unions_disj;
+  CONJ_TAC;
+  IMATCH_MP_TAC  curve_cell_cell;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 27(REWRITE_RULE[psegment;segment]);
+  REWRITE_TAC[par_cell_cell];
+  REWR 17;
+  TYPE_THEN `UNIONS (curve_cell C) INTER C' = EMPTY` SUBAGOAL_TAC ;
+    REWRITE_TAC [ONCE_REWRITE_RULE [EQ_SYM_EQ] SUBSET_EMPTY];
+  USE 17 SYM;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  (* - *)
+  TYPE_THEN `C' INTER UNIONS (curve_cell (A UNION C)) = EMPTY` SUBAGOAL_TAC;
+  REWRITE_TAC[curve_cell_union;UNIONS_UNION];
+  REWRITE_TAC[UNION_OVER_INTER; UNION_EMPTY];
+  REWRITE_TAC[UNION_EMPTY];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  (* -D *)
+  THM_INTRO_TAC[`A UNION C`;`u`;`u'`] component_simple_arc;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 28(REWRITE_RULE[rectagon]);
+  (* - *)
+  TYPE_THEN `component  (ctop (A UNION C)) u u'` SUBAGOAL_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  REWR 20;
+  TYPE_THEN `UNIONS (par_cell (eps') (A UNION C)) u'` SUBAGOAL_TAC;
+  REWRITE_TAC[UNIONS];
+  ASM_MESON_TAC[];
+  TYPE_THEN `UNIONS (par_cell (~eps') (A UNION C)) u` SUBAGOAL_TAC;
+  REWRITE_TAC[UNIONS];
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC [`A UNION C`;`eps'`]  par_cell_union_disjoint;
+  THM_INTRO_TAC[`A UNION C`;`eps'`;`u'`] par_cell_union_comp;
+  FULL_REWRITE_TAC[psegment_triple];
+  THM_INTRO_TAC[`A UNION C`;`~eps'`;`u`] par_cell_union_comp;
+  FULL_REWRITE_TAC[psegment_triple];
+  TYPE_THEN `UNIONS (par_cell (~eps') (A UNION C))` UNABBREV_TAC;
+  TYPE_THEN `UNIONS (par_cell eps' (A UNION C))` UNABBREV_TAC;
+  USE 25 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC  `u'` 25;
+  REWR 25;
+  ]);;
+  (* }}} *)
+
+let parity_even_cell = prove_by_refinement(
+  `!G m. (rectagon G) ==> (parity G (squ m) = even_cell G (squ m))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`G`;`m`] parity_squ;
+  IMATCH_MP_TAC  rectagon_segment;
+  REWRITE_TAC[parity_squ;even_cell_squ];
+  ]);;
+  (* }}} *)
+
+let par_cell_squ_neg = prove_by_refinement(
+  `!G m eps. segment G ==>
+    (par_cell (~eps) G (squ m) <=> ~(par_cell eps G (squ m)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  THM_INTRO_TAC[`G`;`eps`] par_cell_disjoint;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`G`;`eps`;`squ m`] par_cell_cell_partition;
+  REWRITE_TAC[cell_rules];
+  ASM_MESON_TAC[curve_cell_squ];
+  ]);;
+  (* }}} *)
+
+let triple_par_cell_distinct = prove_by_refinement(
+  `!A B C eps eps'. psegment_triple A B C ==>
+     ~(par_cell eps (A UNION B) = par_cell eps' (A UNION C))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `s = (eps = eps')` ABBREV_TAC ;
+  TYPE_THEN `!m. (parity (A UNION B) (squ m) = parity(A UNION C) (squ m)) = s` SUBAGOAL_TAC;
+  TYPE_THEN `s` UNABBREV_TAC;
+  REWRITE_TAC[EQ_SYM_EQ];
+  ONCE_REWRITE_TAC[eq_pair_exchange];
+  TYPE_THEN `eps = parity (A UNION B) (squ m)` ASM_CASES_TAC;
+  IMATCH_MP_TAC  parity_unique;
+  USE 0 SYM;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  IMATCH_MP_TAC  rectagon_segment;
+  IMATCH_MP_TAC  parity;
+  REWRITE_TAC[cell_rules;];
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  IMATCH_MP_TAC  rectagon_segment;
+  ASM_MESON_TAC[curve_cell_squ];
+  (* -- *)
+  TYPE_THEN `!m. par_cell (~eps) (A UNION B) (squ m)  = par_cell (~eps') (A UNION C) (squ m)` SUBAGOAL_TAC;
+  TYPE_THEN `segment (A UNION B) /\ segment(A UNION C)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  CONJ_TAC THEN IMATCH_MP_TAC  rectagon_segment;
+  ASM_SIMP_TAC [par_cell_squ_neg];
+  TYPE_THEN `~eps = parity (A UNION B) (squ m)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  KILL 2;
+  TYPE_THEN `~(~eps' = parity (A UNION C) (squ m))` SUBAGOAL_TAC;
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  KILL 3;
+  UND 2 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  parity_unique;
+  TSPEC `m` 4;
+  USE 2 SYM;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  IMATCH_MP_TAC  rectagon_segment;
+  IMATCH_MP_TAC  parity;
+  REWRITE_TAC[cell_rules;];
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  IMATCH_MP_TAC  rectagon_segment;
+  ASM_MESON_TAC[curve_cell_squ];
+  (* -A *)
+  THM_INTRO_TAC[`A UNION B`] parity_even_cell;
+  RIGHT 4 "m";
+  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  FULL_REWRITE_TAC[psegment_triple];
+  REWR 3;
+  THM_INTRO_TAC[`A UNION C`] parity_even_cell;
+  RIGHT 5 "m";
+  UND 5 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  FULL_REWRITE_TAC[psegment_triple];
+  REWR 3;
+  (* - *)
+  TYPE_THEN `?e. B e /\ ~C e /\ ~A e` SUBAGOAL_TAC;
+  TYPE_THEN `~(B = EMPTY)` SUBAGOAL_TAC ;
+  TYPE_THEN `B` UNABBREV_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 17( REWRITE_RULE[psegment;segment]);
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `u` EXISTS_TAC;
+  REWRITE_TAC[GSYM DE_MORGAN_THM];
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `edge e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 20 (REWRITE_RULE[psegment;segment]);
+  ASM_MESON_TAC[subset_imp];
+  FULL_REWRITE_TAC[edge];
+  TYPE_THEN `rectagon (A UNION B) /\ rectagon (A UNION C)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  (* - *)
+  KILL 5;
+  KILL 4;
+  KILL 0;
+  KILL 2;
+  TYPE_THEN `~(A UNION C) e /\ (A UNION B) e` SUBAGOAL_TAC;
+  ASM_REWRITE_TAC[UNION];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  THM_INTRO_TAC[`(A UNION B)`;`m`] squ_left_odd;
+  THM_INTRO_TAC[`(A UNION C)`;`m`] squ_left_even;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e` UNABBREV_TAC;
+  THM_INTRO_TAC[`A UNION B`;`m`] squ_down;
+  FULL_REWRITE_TAC[rectagon];
+  THM_INTRO_TAC[`A UNION C`;`m`] squ_down;
+  FULL_REWRITE_TAC[rectagon];
+  FULL_REWRITE_TAC[set_lower_n];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let triple_in_comp = prove_by_refinement(
+  `!A B C eps. psegment_triple A B C /\
+     ~(C SUBSET par_cell eps (A UNION B)) ==>
+    (C SUBSET par_cell (~eps) (A UNION B)) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 12 (REWRITE_RULE[psegment]);
+  REWRITE_TAC[cls_union;];
+  CONJ_TAC;
+  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  TYPE_THEN `endpoint A` UNABBREV_TAC;
+  TYPE_THEN `endpoint B` UNABBREV_TAC;
+  TYPE_THEN `endpoint C` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[SUBSET_REFL];
+  TYPE_THEN `eps' = eps` ASM_CASES_TAC;
+  TYPE_THEN`eps'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  ]);;
+  (* }}} *)
+
+let trap_odd_cell = prove_by_refinement(
+  `!A B C. psegment_triple A B C ==>
+   (A SUBSET par_cell F (B UNION C)) \/
+   (B SUBSET par_cell F (A UNION C)) \/
+   (C SUBSET par_cell F (A UNION B))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  TYPE_THEN `C SUBSET par_cell (~F) (A UNION B)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  triple_in_comp;ALL_TAC];
+  TYPE_THEN `A SUBSET par_cell (~F) (B UNION C)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  triple_in_comp;ALL_TAC];
+  IMATCH_MP_TAC  psegment_triple3;
+  TYPE_THEN `B SUBSET par_cell (~F) (C UNION A)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  triple_in_comp;ALL_TAC];
+  CONJ_TAC;
+  IMATCH_MP_TAC  psegment_triple3;
+  IMATCH_MP_TAC  psegment_triple3;
+  USE 6(ONCE_REWRITE_RULE[UNION_COMM]);
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!A B. psegment_triple A B C /\ (C SUBSET par_cell T (A UNION B)) /\ (A SUBSET par_cell T (B UNION C)) ==> (par_cell F (A UNION B) SUBSET par_cell T (B UNION C))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`B'`;`A'`;`C`;`F`;`T`] trap_triple_seg;
+  FULL_REWRITE_TAC[UNION_COMM];
+  IMATCH_MP_TAC  psegment_triple3;
+  IMATCH_MP_TAC  psegment_triple2;
+  FULL_REWRITE_TAC[UNION_COMM];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`B'`;`C`;`A'`;`F`;`F`] trap_triple_seg;
+    IMATCH_MP_TAC  psegment_triple3;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[UNION_COMM];
+  TYPE_THEN `par_cell F (B' UNION C) = par_cell F (A' UNION B')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  THM_INTRO_TAC[`B'`;`A'`;`C`;`F`;`F`] triple_par_cell_distinct;
+    IMATCH_MP_TAC  psegment_triple3;
+  IMATCH_MP_TAC  psegment_triple2;
+  FULL_REWRITE_TAC[UNION_COMM];
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `par_cell F (B' UNION A') SUBSET par_cell T (B' UNION A')` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[UNION_COMM];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `par_cell F (B' UNION C)` EXISTS_TAC;
+  (* -- *)
+  THM_INTRO_TAC[`A' UNION B'`;`F` ] par_cell_nonempty;
+  USE 9(REWRITE_RULE[psegment_triple]);
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  THM_INTRO_TAC[`A' UNION B'`;`F`] par_cell_disjoint;
+  FULL_REWRITE_TAC[EQ_EMPTY;INTER];
+  TSPEC `u` 16;
+  REWR 16;
+  USE 14(REWRITE_RULE[SUBSET]);
+  FULL_REWRITE_TAC[UNION_COMM];
+  ASM_MESON_TAC[];
+  (* -A *)
+  COPY 7;
+  UND 7 THEN DISCH_THEN (THM_INTRO_TAC[`A`;`B`]);
+   UND 8  THEN DISCH_THEN (THM_INTRO_TAC[`B`;`A`]);
+  FULL_REWRITE_TAC[UNION_COMM];
+    IMATCH_MP_TAC  psegment_triple3;
+  IMATCH_MP_TAC  psegment_triple2;
+  (* - *)
+  FULL_REWRITE_TAC[UNION_COMM];
+  THM_INTRO_TAC[`A UNION B`;`F`] par_cell_nonempty;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  THM_INTRO_TAC[`A UNION B`;`u`;`F`] parity_unique;
+  FULL_REWRITE_TAC[psegment_triple];
+  IMATCH_MP_TAC  rectagon_segment;
+  TYPE_THEN `par_cell T (A UNION C) u /\ par_cell T (B UNION C) u` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  THM_INTRO_TAC[`A UNION C`;`u`;`T`] parity_unique;
+  FULL_REWRITE_TAC[psegment_triple];
+  IMATCH_MP_TAC  rectagon_segment;
+  THM_INTRO_TAC[`B UNION C`;`u`;`T`] parity_unique;
+  FULL_REWRITE_TAC[psegment_triple];
+  IMATCH_MP_TAC  rectagon_segment;
+  (* -B *)
+  TYPE_THEN `cell u` SUBAGOAL_TAC;
+  ASM_MESON_TAC[par_cell_cell;subset_imp];
+  TYPE_THEN `!A B eps. rectagon (A UNION B) /\ (par_cell eps (A UNION B) u) ==> ~curve_cell A u` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`A' UNION B'`;`eps`] par_cell_curve_cell_disj;
+  FULL_REWRITE_TAC[rectagon];
+  FULL_REWRITE_TAC[EQ_EMPTY;INTER];
+  TSPEC `u` 19;
+  USE 19 (REWRITE_RULE[curve_cell_union;DE_MORGAN_THM ]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  USE 20 (REWRITE_RULE[UNION]);
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `segment A /\ segment B /\ segment C /\ segment (A UNION B) /\ segment (B UNION C) /\ segment (A UNION C) /\ (A INTER B = EMPTY) /\ (B INTER C = EMPTY) /\ (A INTER C = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[psegment];
+  FULL_REWRITE_TAC[UNION_COMM];
+  REPEAT CONJ_TAC THEN (IMATCH_MP_TAC  rectagon_segment);
+  (* -C *)
+  THM_INTRO_TAC[`A`;`B`;`u`] parity_union;
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
+  TYPE_THEN `B` EXISTS_TAC;
+  TYPE_THEN `F` EXISTS_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  TYPE_THEN `A` EXISTS_TAC;
+  USE 10 SYM;
+  TYPE_THEN `F` EXISTS_TAC;
+  FULL_REWRITE_TAC[UNION_COMM];
+  FULL_REWRITE_TAC[psegment_triple];
+  (* - *)
+  THM_INTRO_TAC[`B`;`C`;`u`] parity_union;
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
+  TYPE_THEN `C` EXISTS_TAC;
+  TYPE_THEN `T` EXISTS_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  TYPE_THEN `B` EXISTS_TAC;
+  TYPE_THEN `T` EXISTS_TAC;
+  FULL_REWRITE_TAC[UNION_COMM];
+  FULL_REWRITE_TAC[psegment_triple];
+  (* - *)
+  THM_INTRO_TAC[`A`;`C`;`u`] parity_union;
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
+  TYPE_THEN `C` EXISTS_TAC;
+  TYPE_THEN `T` EXISTS_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `T` EXISTS_TAC;
+  FULL_REWRITE_TAC[UNION_COMM];
+  FULL_REWRITE_TAC[psegment_triple];
+  REWR 28;
+  REWR 27;
+  ]);;
+
+    (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* SECTION V *)
+(* ------------------------------------------------------------------ *)
+
+(* -- more on 2-connectedness, etc. *)
+
+let euclid_diff_par_cell = prove_by_refinement(
+  `!G eps. (segment G) ==>
+    (euclid 2 DIFF UNIONS(par_cell (~eps) G) =
+         UNIONS(par_cell eps G) UNION UNIONS (curve_cell G))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[DIFF;UNION];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 3(REWRITE_RULE[DE_MORGAN_THM]);
+  TYPE_THEN `UNIONS (ctop G) x` SUBAGOAL_TAC;
+  ASM_REWRITE_TAC[ctop_unions;DIFF];
+  (* -- *)
+  THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
+  USE 6 SYM;
+  REWR 5;
+  FULL_REWRITE_TAC[UNION];
+  ASM_MESON_TAC[];
+  (* - *)
+  CONJ_TAC;
+  USE 1(REWRITE_RULE[UNIONS]);
+  LEFT 1 "u";
+  THM_INTRO_TAC[`u`] cell_euclid;
+  THM_INTRO_TAC[`G`;`eps`] par_cell_cell;
+  THM_INTRO_TAC[`G`] curve_cell_cell;
+  FULL_REWRITE_TAC[segment];
+  ASM_MESON_TAC[subset_imp];
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  THM_INTRO_TAC[`G`;`eps`] par_cell_union_disjoint;
+  USE 3(REWRITE_RULE[INTER;EQ_EMPTY]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`G`] ctop_unions;
+  USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 5;
+  FULL_REWRITE_TAC[DIFF];
+  TYPE_THEN `~UNIONS (ctop G )x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`G`;`eps`] par_cell_partition;
+  USE 7 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  FULL_REWRITE_TAC[UNION];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_closure_cell = prove_by_refinement(
+  `!G C d eps.
+       cell C /\ cell d /\ rectagon G /\ (d SUBSET closure top2 C) /\
+          par_cell eps G C ==>
+       (par_cell eps G d \/ curve_cell G d)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASSUME_TAC top2_top;
+  TYPE_THEN`closed_ top2 (euclid 2 DIFF (UNIONS (par_cell (~eps) G)))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`top2`;`(UNIONS (par_cell (~eps) G))`] open_closed;
+  REWRITE_TAC[open_DEF];
+  TYPE_THEN `UNIONS (par_cell (~eps) G) = EMPTY ` ASM_CASES_TAC;
+  USE 5 (MATCH_MP   (REWRITE_RULE[open_DEF]open_EMPTY));
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  THM_INTRO_TAC[`G`;`~eps`;`u`] par_cell_union_comp;
+  IMATCH_MP_TAC ctop_comp_open ;
+  ASM_MESON_TAC[rectagon];
+  FULL_REWRITE_TAC[top2_unions];
+  THM_INTRO_TAC[`G`;`eps`] euclid_diff_par_cell;
+  IMATCH_MP_TAC  rectagon_segment;
+  REWR 6;
+  KILL 7;
+  (* -A *)
+  TYPE_THEN `closure top2 C SUBSET (UNIONS (par_cell eps G) UNION UNIONS (curve_cell G))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  closure_subset;
+  IMATCH_MP_TAC  in_union;
+  DISJ1_TAC;
+  IMATCH_MP_TAC  sub_union;
+  (* - *)
+  TYPE_THEN `d SUBSET UNIONS (par_cell eps G) UNION UNIONS (curve_cell G)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[GSYM UNIONS_UNION];
+  (* - *)
+  THM_INTRO_TAC[`d`] cell_nonempty;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  (* - *)
+  THM_INTRO_TAC[`par_cell eps G UNION curve_cell G`;`d`;`u`] cell_ununion;
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  REWRITE_TAC [par_cell_cell];
+  THM_INTRO_TAC[`G`] curve_cell_cell;
+  FULL_REWRITE_TAC[rectagon];
+  REWRITE_TAC[UNIONS;UNION];
+  USE 8(REWRITE_RULE[SUBSET;UNIONS]);
+  TSPEC `u` 8;
+  USE 8 (REWRITE_RULE[UNION]);
+  TYPE_THEN `u'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[UNION];
+  (* Thu Dec  2 09:50:25 EST 2004 *)
+  ]);;
+  (* }}} *)
+
+let rectagon_curve = prove_by_refinement(
+  `!G C a b. FINITE G /\ G SUBSET edge /\ simple_arc_end C a b /\
+      (C INTER UNIONS (curve_cell G) = EMPTY) ==>
+      (C SUBSET (component  (ctop G) a))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[SUBSET];
+  TYPE_THEN `a = x` ASM_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  IMATCH_MP_TAC  component_refl;
+  FULL_REWRITE_TAC[ctop_unions;DIFF;EQ_EMPTY ;INTER ];
+  CONJ_TAC;
+  USE 1 (MATCH_MP simple_arc_end_simple);
+  USE 1 (MATCH_MP simple_arc_euclid);
+  ASM_MESON_TAC[subset_imp];
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`G`;`a`;`x`] component_simple_arc;
+  TYPE_THEN `x = b` ASM_CASES_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  (* - *)
+  THM_INTRO_TAC[`C`;`a`;`b`;`x`] simple_arc_end_cut;
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  FULL_REWRITE_TAC[GSYM SUBSET_EMPTY];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `(C' UNION C'') INTER UNIONS (curve_cell G)` EXISTS_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  REWRITE_TAC[SUBSET;UNION];
+  (* Thu Dec  2 10:11:45 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+(*  *)
+let star_avoidance_lemma1 = prove_by_refinement(
+  `!E E' R B x. bounded_set E x /\ E SUBSET E' /\ FINITE E' /\
+       E' SUBSET edge /\ rectagon R /\ R SUBSET E /\
+       ~(UNIONS (curve_cell B) x) /\
+       B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==>
+        (bounded_set (E' DIFF B) x \/ unbounded_set (E' DIFF B) x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`ctop E`;`x`] component_empty;
+  REWRITE_TAC[ctop_top];
+  (* - *)
+  TYPE_THEN `UNIONS (ctop E) x` SUBAGOAL_TAC;
+  USE 9 (ONCE_REWRITE_RULE[ONCE_REWRITE_RULE[EQ_SYM_EQ] not_eq]);
+  FULL_REWRITE_TAC[EMPTY_EXISTS;bounded_set];
+  ASM_MESON_TAC[];
+  KILL 9;
+  (* - *)
+  TYPE_THEN `UNIONS (ctop (E' DIFF B)) x` SUBAGOAL_TAC;
+  REWRITE_TAC[ctop_unions];
+  TYPE_THEN `E'' = E' DIFF B` ABBREV_TAC ;
+  REWRITE_TAC[DIFF];
+  CONJ_TAC;
+  USE 10(REWRITE_RULE[ctop_unions;DIFF]);
+  TYPE_THEN `E' = E'' UNION E'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  TYPE_THEN `E''` UNABBREV_TAC;
+  REWRITE_TAC[DIFF;UNION];
+  MESON_TAC[];
+  THM_INTRO_TAC[`E''`;`E'`] curve_cell_union;
+  USE 12 SYM;
+  REWR 13;
+  TYPE_THEN `UNIONS (curve_cell E') = UNIONS (curve_cell E'') UNION UNIONS(curve_cell E')` SUBAGOAL_TAC;
+  REWRITE_TAC[GSYM UNIONS_UNION];
+  AP_TERM_TAC;
+  ASM_MESON_TAC[];
+  USE 14(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 14;
+  USE 14(REWRITE_RULE[UNION]);
+  ASM_MESON_TAC[];
+  (* -A *)
+  THM_INTRO_TAC[`E' DIFF B`] bounded_unbounded_union;
+  USE 11(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 11;
+  REWR 11;
+  USE 11(REWRITE_RULE[UNION]);
+  (* - *)
+  ]);;
+  (* }}} *)
+
+let curve_cell_imp_subset = prove_by_refinement(
+  `!A B. A SUBSET B ==> curve_cell A SUBSET curve_cell B`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `B = A UNION (B DIFF A)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC EQ_EXT;
+  FULL_REWRITE_TAC [UNION;DIFF;SUBSET ];
+  ASM_MESON_TAC [];
+  TYPE_THEN `C = B DIFF A` ABBREV_TAC ;
+  REWRITE_TAC[curve_cell_union];
+  REWRITE_TAC[SUBSET;UNION];
+  ]);;
+  (* }}} *)
+
+let unbound_set_x_axis = prove_by_refinement(
+  `!G. (FINITE G /\ G SUBSET edge ) ==>
+       (?r. !s. (r <= s) ==> unbounded_set G (point(s,&0)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[unbounded_set;unbounded;];
+  NAME_CONFLICT_TAC;
+  LEFT_TAC "r'";
+  LEFT_TAC "r'";
+  THM_INTRO_TAC[`G`] unbounded_set_nonempty;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;unbounded_set;unbounded];
+  TYPE_THEN `r` EXISTS_TAC;
+  TYPE_THEN `(\ (s:real). r)` EXISTS_TAC;
+  COPY 2;
+  TSPEC `s'` 2;
+  TSPEC  `s''` 5;
+  USE 4 (MATCH_MP component_symm);
+  USE 4 (MATCH_MP component_replace);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let star_avoidance = prove_by_refinement(
+  `!E E' R B x. unbounded_set (E' DIFF B) x /\ E SUBSET E' /\ FINITE E' /\
+       E' SUBSET edge /\ rectagon R /\ R SUBSET E /\
+       FINITE B /\ B SUBSET edge /\
+       ~(UNIONS (curve_cell B) x) /\
+       B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==>
+        ( unbounded_set (E) x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `E'' = E' DIFF B` ABBREV_TAC ;
+  RULE_ASSUM_TAC (REWRITE_RULE[unbounded_set;unbounded]);
+  (* - *)
+  THM_INTRO_TAC[`R`] unbound_set_x_axis;
+  FULL_REWRITE_TAC[rectagon];
+  (* - *)
+  TYPE_THEN `?r. !s. (r <= s) ==> component  (ctop E'') x (point(s,&0)) /\ ~(x = (point(s,&0))) /\ unbounded_set R (point(s,&0)) ` SUBAGOAL_TAC;
+  TYPE_THEN `r'' = &1 + (||. r') + (||. r) + ||. (x 0)` ABBREV_TAC ;
+  TYPE_THEN `r''` EXISTS_TAC;
+  TYPE_THEN `r <= s` SUBAGOAL_TAC;
+  UNDF `r'' <= s` THEN UND 13 THEN REAL_ARITH_TAC;
+  CONJ_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[coord01];
+  UND 13 THEN UND 14 THEN REAL_ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 13 THEN UND 14 THEN REAL_ARITH_TAC;
+  KILL 12;
+  KILL 10;
+  (* - *)
+  TYPE_THEN `FINITE E'' /\ E'' SUBSET edge` SUBAGOAL_TAC;
+  TYPE_THEN `E''` UNABBREV_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_DIFF;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC[SUBSET_DIFF];
+  (* - *)
+  TYPE_THEN `!s. ?C. (r'' <= s) ==> (simple_arc_end C x (point(s,&0))  /\ (C INTER UNIONS (curve_cell E'') = {}))` SUBAGOAL_TAC;
+  TSPEC `s` 13;
+  RIGHT_TAC "C";
+  THM_INTRO_TAC[`E''`;`x`;`point(s,&0)`] component_simple_arc;
+  ASM_MESON_TAC[];
+  (* -A *)
+  REWRITE_TAC[unbounded_set;unbounded];
+  TYPE_THEN `r''` EXISTS_TAC;
+  TSPEC `s` 13;
+  TSPEC `s` 14;
+  THM_INTRO_TAC[`E`;`x`;`point(s,&0)`] component_simple_arc;
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  ASM_MESON_TAC[];
+  TYPE_THEN `C` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `R SUBSET E''` SUBAGOAL_TAC;
+  TYPE_THEN `E''` UNABBREV_TAC;
+  REWRITE_TAC[DIFF_SUBSET];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  ASM_MESON_TAC[];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj;
+  FULL_REWRITE_TAC[rectagon];
+  USE 21(REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `u` 21;
+  UND 21 THEN ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  ASM_MESON_TAC[subset_imp];
+  ASM_MESON_TAC[curve_cell_subset;subset_imp];
+  (* -B *)
+  TYPE_THEN `C INTER UNIONS(curve_cell R) = EMPTY` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[GSYM SUBSET_EMPTY];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C INTER UNIONS (curve_cell E'')` EXISTS_TAC;
+  IMATCH_MP_TAC subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  IMATCH_MP_TAC  UNIONS_UNIONS;
+  IMATCH_MP_TAC  curve_cell_imp_subset;
+  (* - *)
+  THM_INTRO_TAC[`R`;`C`;`x`;`point(s,&0)`] rectagon_curve;
+  FULL_REWRITE_TAC[rectagon];
+  (* - *)
+  THM_INTRO_TAC[`R`]unbounded_set_comp;
+  FULL_REWRITE_TAC[rectagon];
+  TYPE_THEN `component  (ctop R) x' = component  (ctop R) (point(s,&0))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  component_replace;
+  USE 23 SYM;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `component  (ctop R) x'` UNABBREV_TAC;
+  TYPE_THEN `component  (ctop R) x = component  (ctop R) (point(s,&0))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  component_replace;
+  USE 22(REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  (* -C *)
+  THM_INTRO_TAC[`R`;`B`;`F`] par_cell_closure;
+  (* - *)
+  TYPE_THEN `C INTER UNIONS (curve_cell B) = EMPTY` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[GSYM SUBSET_EMPTY ];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `UNIONS (par_cell T R) INTER UNIONS (curve_cell B)` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  THM_INTRO_TAC[`R`] unbounded_even;
+  USE 26 SYM;
+  ASM_MESON_TAC[];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  FULL_REWRITE_TAC[SUBSET_EMPTY ];
+  THM_INTRO_TAC[`curve_cell B`;`par_cell T R`] cell_unions_disj;
+  THM_INTRO_TAC[`B`]curve_cell_cell;
+  THM_INTRO_TAC[`R`]par_cell_cell;
+  USE 26 (ONCE_REWRITE_RULE[EQ_SYM_EQ]);
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `E SUBSET E'' UNION B` SUBAGOAL_TAC;
+  TYPE_THEN `E''` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;DIFF;UNION];
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  FULL_REWRITE_TAC[GSYM SUBSET_EMPTY ];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C INTER UNIONS (curve_cell (E'' UNION B))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  IMATCH_MP_TAC  UNIONS_UNIONS;
+  IMATCH_MP_TAC  curve_cell_imp_subset;
+  (* - *)
+  REWRITE_TAC[curve_cell_union;UNIONS_UNION];
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  (* Thu Dec  2 16:12:59 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let star_avoidance_contrp = prove_by_refinement(
+  `!E E' R B x. bounded_set (E) x /\ E SUBSET E' /\ FINITE E' /\
+       E' SUBSET edge /\ rectagon R /\ R SUBSET E /\
+       FINITE B /\ B SUBSET edge /\
+       ~(UNIONS (curve_cell B) x) /\
+       B SUBSET par_cell F R /\ ~(UNIONS (curve_cell E') x) ==>
+        ( bounded_set (E' DIFF B) x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`E`;`E'`;`R`;`B`;`x`] star_avoidance_lemma1;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`E`;`E'`;`R`;`B`;`x`] star_avoidance;
+  THM_INTRO_TAC[`E`] bounded_unbounded_disj;
+  FULL_REWRITE_TAC[EQ_EMPTY;INTER];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let bounded_avoidance_subset = prove_by_refinement(
+  `!E E' x. bounded_set E x /\ E SUBSET E' /\ (E' SUBSET edge) /\
+     (FINITE E') /\
+           conn2 E /\
+        ~(UNIONS (curve_cell E') x) ==>
+       (bounded_set E' x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`E`] conn2_has_rectagon;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`E`;`E'`;`B`;`EMPTY:((num->real)->bool)->bool`;`x`] star_avoidance_contrp;
+  ASM_REWRITE_TAC[FINITE_RULES;curve_cell_empty];
+  FULL_REWRITE_TAC[DIFF_EMPTY];
+  ]);;
+  (* }}} *)
+
+let unbounded_avoidance_subset = prove_by_refinement(
+  `!E E' x.  (unbounded_set E' x) /\ E SUBSET E' /\ (E' SUBSET edge) /\
+     (FINITE E') /\
+           conn2 E /\
+        ~(UNIONS (curve_cell E') x) ==> unbounded_set E x
+       `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`E`] conn2_has_rectagon;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`E`;`E'`;`B`;`EMPTY:((num->real)->bool)->bool`;`x`] star_avoidance;
+  ASM_REWRITE_TAC[FINITE_RULES;curve_cell_empty;DIFF_EMPTY];
+  ]);;
+  (* }}} *)
+
+let diff_unchange = prove_by_refinement(
+  `! (A:A -> bool) B. (A DIFF B = A) <=> (A INTER B = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  USE 0(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 0(REWRITE_RULE[DIFF]);
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[EQ_EMPTY;INTER];
+  ASM_MESON_TAC[];
+  USE 0 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  IMATCH_MP_TAC  EQ_EXT;
+  FULL_REWRITE_TAC[DIFF;INTER];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let union_diff2 = prove_by_refinement(
+  `!(A:A->bool) B. (A UNION B) DIFF A = (B DIFF A)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;DIFF;];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let unbounded_triple_avoidance = prove_by_refinement(
+  `!A B C x. psegment_triple A B C /\
+       A SUBSET par_cell F (B UNION C) /\
+       unbounded_set (B UNION C) x ==>
+       unbounded_set (A UNION B UNION C) x`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`B UNION C`;`A`;`x`] star_avoidance;
+  CONJ_TAC;
+  TYPE_THEN `(A UNION B UNION C) DIFF A = (B UNION C)` SUBAGOAL_TAC;
+  ONCE_REWRITE_TAC [union_diff2];
+  REWRITE_TAC[diff_unchange];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  FULL_REWRITE_TAC[psegment_triple];
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  REWRITE_TAC[SUBSET_REFL];
+  CONJ_TAC;
+  REWRITE_TAC[FINITE_UNION];
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[psegment;segment];
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[psegment;segment];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 15 (REWRITE_RULE[segment;psegment]);
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 15 (REWRITE_RULE[segment;psegment]);
+  SUBCONJ_TAC;
+  THM_INTRO_TAC[`(B UNION C)`;`A`;`F`] par_cell_closure;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 16 (REWRITE_RULE[psegment;segment]);
+  THM_INTRO_TAC[`B UNION C`] unbounded_even;
+  FULL_REWRITE_TAC[psegment_triple];
+  REWR 0;
+  KILL 5;
+  FULL_REWRITE_TAC[UNIONS];
+  TYPE_THEN `u = u'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cell_partition;
+  REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  THM_INTRO_TAC[`A`] curve_cell_cell;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 19 (REWRITE_RULE[psegment;segment;]);
+  REPEAT CONJ_TAC THEN (TRY (ASM_MESON_TAC[par_cell_cell;subset_imp]));
+  TYPE_THEN`u'` UNABBREV_TAC;
+  USE 4 (REWRITE_RULE [EQ_EMPTY;INTER]);
+  ASM_MESON_TAC[];
+  (* -A *)
+  USE 3(ONCE_REWRITE_RULE[curve_cell_union; ]);
+  USE 3(REWRITE_RULE[UNIONS_UNION]);
+  TYPE_THEN `D =  B UNION C` ABBREV_TAC ;
+  USE 3(REWRITE_RULE[UNION]);
+  REWR 3;
+  TYPE_THEN `D` UNABBREV_TAC;
+  THM_INTRO_TAC[`B UNION C`;`T`] unions_curve_cell_par_cell_disj;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 12(REWRITE_RULE[rectagon]);
+  THM_INTRO_TAC[`B UNION C`] unbounded_even;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let unbounded_set_comp_elt_eq = prove_by_refinement(
+  `! G x. FINITE G /\
+          G SUBSET edge /\ unbounded_set G x ==>
+          (unbounded_set G = component (ctop G) x)
+          `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`G`] unbounded_set_comp;
+  IMATCH_MP_TAC  component_replace;
+  REWR 0;
+  ]);;
+  (* }}} *)
+
+let outer_segment_even = prove_by_refinement(
+  `!A B C. psegment_triple A B C /\ A SUBSET par_cell F (B UNION C)
+     ==> C SUBSET par_cell T (A UNION B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment_triple;psegment;segment];
+  TYPE_THEN `C` UNABBREV_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  (* - *)
+  THM_INTRO_TAC[`B UNION C`] unbounded_set_nonempty;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 10(REWRITE_RULE [rectagon]);
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  (* - *)
+  THM_INTRO_TAC[`B UNION C`;`u'`] unbounded_set_comp_elt_eq;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 11 (REWRITE_RULE[rectagon]);
+  THM_INTRO_TAC[`B UNION C`;`u'`;`u`] along_lemma11;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  IMATCH_MP_TAC  rectagon_segment;
+  REWRITE_TAC[EMPTY_EXISTS];
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[UNION];
+  (* - *)
+  THM_INTRO_TAC[`squ p`] cell_nonempty;
+  REWRITE_TAC[cell_rules];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `unbounded_set (B UNION C) u''` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  (* -A *)
+  THM_INTRO_TAC[`A`;`B`;`C`;`u''`] unbounded_triple_avoidance;
+  THM_INTRO_TAC[`A UNION B`;`A UNION B UNION C`;`u''`] unbounded_avoidance_subset;
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[psegment;segment];
+  CONJ_TAC;
+  REWRITE_TAC[FINITE_UNION];
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[psegment;segment];
+  CONJ_TAC;
+  IMATCH_MP_TAC  conn2_rectagon;
+  FULL_REWRITE_TAC[psegment_triple];
+  (* --B *)
+  TYPE_THEN `D = B UNION C` ABBREV_TAC ;
+  USE 10(REWRITE_RULE[curve_cell_union;]);
+  USE 10(REWRITE_RULE[UNIONS_UNION]);
+  USE 10(REWRITE_RULE[UNION]);
+  THM_INTRO_TAC[`D`] unbounded_even;
+  TYPE_THEN `D` UNABBREV_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  KILL 4;
+  TYPE_THEN `unbounded_set D` UNABBREV_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`D`;`A`;`F`] par_cell_closure;
+  TYPE_THEN `D` UNABBREV_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 23(REWRITE_RULE[psegment;segment]);
+  THM_INTRO_TAC[`curve_cell A`;`par_cell T D`] cell_unions_disj;
+  THM_INTRO_TAC[`A`] curve_cell_cell;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 25(REWRITE_RULE[psegment;segment]);
+  THM_INTRO_TAC[`D`] par_cell_cell;
+  REWR 12;
+  REWR 13;
+  USE 12 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  ASM_MESON_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`D`;`T`]unions_curve_cell_par_cell_disj;
+  FULL_REWRITE_TAC[psegment_triple];
+  TYPE_THEN `D` UNABBREV_TAC;
+  USE 19 (REWRITE_RULE[rectagon]);
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* -C *)
+  THM_INTRO_TAC[`A UNION B`] unbounded_even;
+  FULL_REWRITE_TAC[psegment_triple];
+  KILL 4;
+  TYPE_THEN `unbounded_set (A UNION B)` UNABBREV_TAC;
+  THM_INTRO_TAC[`par_cell T (A UNION B)`;`squ p`;`u''`] cell_ununion;
+  REWRITE_TAC[par_cell_cell;cell_rules];
+  THM_INTRO_TAC[`A UNION B`;`squ p`;`u`;`T`] par_cell_closure_cell;
+  REWRITE_TAC[cell_rules;squ_closure];
+  CONJ_TAC;
+  IMATCH_MP_TAC  edge_cell;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 21 (REWRITE_RULE[psegment;segment]);
+  ASM_MESON_TAC[subset_imp];
+  FULL_REWRITE_TAC[psegment_triple];
+  (* - *)
+  THM_INTRO_TAC[`A UNION B`;`u`] curve_cell_edge;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 22 (REWRITE_RULE[psegment;segment]);
+  ASM_MESON_TAC[subset_imp];
+  REWR 11;
+  KILL 12;
+  (* - *)
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  THM_INTRO_TAC[`A UNION B`;`C`] segment_in_comp;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[psegment];
+  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  CONJ_TAC;
+    FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[cls_union];
+  ONCE_REWRITE_TAC[INTER_COMM];
+    REWRITE_TAC[UNION_OVER_INTER;union_subset];
+     FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[INTER_COMM];
+  ASM_MESON_TAC[SUBSET_REFL];
+  (* -- *)
+  TYPE_THEN `eps = T` ASM_CASES_TAC;
+  TYPE_THEN `eps` UNABBREV_TAC;
+  TYPE_THEN `eps = F` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps` UNABBREV_TAC;
+  THM_INTRO_TAC[`A UNION B`;`T`] par_cell_disjoint;
+  USE 15(REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `u` 15;
+  USE 13 (REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[];
+  (* - *)
+  USE 12 (REWRITE_RULE[UNION]);
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let meeting_lemma = prove_by_refinement(
+  `!R B C v eps. rectagon R /\ B SUBSET par_cell eps R /\
+    (C INTER R = EMPTY) /\ cls R INTER cls C SUBSET endpoint C /\
+     cls C v /\ cls B v /\ ~cls R v /\ segment C /\ B SUBSET edge ==>
+    C SUBSET par_cell eps R`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`R`;`C`] segment_in_comp;
+  TYPE_THEN `eps' = eps` ASM_CASES_TAC ;
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  KILL 10;
+  (* - *)
+  TYPE_THEN `~(C INTER par_cell eps R = EMPTY)` BACK_TAC ;
+  USE 10(REWRITE_RULE[INTER;EMPTY_EXISTS ]);
+  THM_INTRO_TAC[`R`;`eps`] par_cell_disjoint;
+  USE 12(REWRITE_RULE[INTER;EQ_EMPTY]);
+  USE 9 (REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `?eC. closure top2 eC (pointI v) /\ C eC` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[cls];
+  ASM_MESON_TAC[];
+  TYPE_THEN `?eB. closure top2 eB (pointI v) /\ B eB` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[cls];
+  ASM_MESON_TAC[];
+  (* - *)
+  UND 10 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `eC` EXISTS_TAC;
+  IMATCH_MP_TAC  par_cell_nbd;
+  TYPE_THEN `v` EXISTS_TAC;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  FULL_REWRITE_TAC[segment];
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  THM_INTRO_TAC[`R`;`eB`;`{(pointI v)}`;`eps`] par_cell_closure_cell;
+  REWRITE_TAC[cell_rules;SUBSET;INR IN_SING];
+  CONJ_TAC;
+  IMATCH_MP_TAC  edge_cell;
+  ASM_MESON_TAC[subset_imp];
+  ASM_MESON_TAC[subset_imp];
+  PROOF_BY_CONTR_TAC;
+  REWR 10;
+  THM_INTRO_TAC[`R`;`v`] curve_cell_not_point;
+  IMATCH_MP_TAC  rectagon_segment;
+  UND 16 THEN ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`R`;`pointI v`] num_closure0;
+  FULL_REWRITE_TAC[rectagon];
+  USE 2(REWRITE_RULE[cls]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let parity_union_triple = prove_by_refinement(
+  `!A B C e. segment B /\ segment C /\ (segment (B UNION C)) /\
+      (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY)
+     /\ (A SUBSET edge) /\  A e ==>
+       (parity (B UNION C) e = (parity B e = parity C e))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `edge e` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  THM_INTRO_TAC[`B`;`C`;`e`] parity_union;
+  CONJ_TAC;
+  IMATCH_MP_TAC  edge_cell;
+  (* - *)
+  TYPE_THEN `~B e /\ ~C e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  ASM_SIMP_TAC[curve_cell_edge];
+  ]);;
+  (* }}} *)
+
+let parity_union_triple_even = prove_by_refinement(
+  `!A B C e.  segment B /\ segment C /\ (segment (B UNION C)) /\
+      (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY)
+     /\ (segment A ) /\  A e /\
+   A SUBSET par_cell T (B UNION C) ==> (parity B e = parity C e)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`A`;`B`;`C`;`e`] parity_union_triple;
+  FULL_REWRITE_TAC[segment];
+  USE 9(ONCE_REWRITE_RULE[EQ_SYM_EQ]);
+  THM_INTRO_TAC[`B UNION C`;`e`;`T`] parity_unique;
+  ASM_MESON_TAC[subset_imp];
+  ]);;
+  (* }}} *)
+
+let parity_union_triple_odd = prove_by_refinement(
+  `!A B C e.  segment B /\ segment C /\ (segment (B UNION C)) /\
+      (B INTER C = EMPTY) /\ (A INTER B = EMPTY) /\ (A INTER C = EMPTY)
+     /\ (A SUBSET edge) /\ A e /\
+   A SUBSET par_cell F (B UNION C) ==> ~(parity B e = parity C e)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`A`;`B`;`C`;`e`] parity_union_triple;
+  REWR 10;
+  THM_INTRO_TAC[`B UNION C`;`e`;`F`] parity_unique;
+  ASM_MESON_TAC[subset_imp];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let par_cell_even_imp = prove_by_refinement(
+  `!A B C D. psegment_triple A B D /\ segment C /\
+    cls (A UNION B) INTER cls C SUBSET endpoint C /\
+    (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (C INTER D = EMPTY)
+    /\ C SUBSET par_cell T (B UNION D) /\ C SUBSET par_cell T (A UNION D)
+   ==> C SUBSET par_cell T (A UNION B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp;
+  REWRITE_TAC[cls_union];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  FULL_REWRITE_TAC[INTER_COMM];
+  (* - *)
+  TYPE_THEN `eps = T` ASM_CASES_TAC;
+  TYPE_THEN `eps` UNABBREV_TAC;
+  TYPE_THEN `eps = F` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps` UNABBREV_TAC;
+  KILL 9;
+  PROOF_BY_CONTR_TAC;
+  (* - *)
+  TYPE_THEN `?e. edge e /\ C e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN  `u` EXISTS_TAC;
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  THM_INTRO_TAC[`C`;`A`;`D`;`e`]  parity_union_triple_even;
+  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
+  IMATCH_MP_TAC  rectagon_segment;
+  THM_INTRO_TAC[`C`;`B`;`D`;`e`]  parity_union_triple_even;
+  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
+  IMATCH_MP_TAC  rectagon_segment;
+  TYPE_THEN `parity D e` UNABBREV_TAC;
+  USE 12 SYM;
+  (* - *)
+  THM_INTRO_TAC[`C`;`A`;`B`;`e`] parity_union_triple;
+  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  USE 6(REWRITE_RULE[segment]);
+  REWR 13;
+  (* - *)
+  THM_INTRO_TAC[`(A UNION B)`;`e`] parity;
+  ASM_SIMP_TAC[curve_cell_edge];
+  FULL_REWRITE_TAC[psegment_triple];
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  CONJ_TAC;
+  IMATCH_MP_TAC  edge_cell;
+  USE 27 (REWRITE_RULE[UNION]);
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`A UNION B`;`parity(A UNION B) e`] par_cell_disjoint;
+  USE 15(REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `e` 15;
+  UND 15 THEN ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[subset_imp];
+  ]);;
+  (* }}} *)
+
+let par_cell_odd_imp = prove_by_refinement(
+  `!A B C D. psegment_triple A B D /\ segment C /\
+    cls (A UNION B) INTER cls C SUBSET endpoint C /\
+    (A INTER C = EMPTY) /\ (B INTER C = EMPTY) /\ (C INTER D = EMPTY)
+    /\ C SUBSET par_cell F (B UNION D) /\ C SUBSET par_cell T (A UNION D)
+   ==> C SUBSET par_cell F (A UNION B)`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`(A UNION B)`;`C`] segment_in_comp;
+  REWRITE_TAC[cls_union];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  FULL_REWRITE_TAC[INTER_COMM];
+  (* - *)
+  TYPE_THEN `eps = F` ASM_CASES_TAC;
+  TYPE_THEN `eps` UNABBREV_TAC;
+  TYPE_THEN `eps = T` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps` UNABBREV_TAC;
+  KILL 9;
+  PROOF_BY_CONTR_TAC;
+  (* - *)
+  TYPE_THEN `?e. edge e /\ C e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN  `u` EXISTS_TAC;
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  THM_INTRO_TAC[`C`;`A`;`D`;`e`]  parity_union_triple_even;
+  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
+  IMATCH_MP_TAC  rectagon_segment;
+  THM_INTRO_TAC[`C`;`B`;`D`;`e`]  parity_union_triple_odd;
+  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  USE 6 (REWRITE_RULE[segment]);
+  TYPE_THEN `parity D e` UNABBREV_TAC;
+  USE 13 GSYM;
+  (* - *)
+  THM_INTRO_TAC[`C`;`A`;`B`;`e`] parity_union_triple;
+  FULL_REWRITE_TAC[INTER_COMM;psegment_triple;psegment];
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  USE 6(REWRITE_RULE[segment]);
+  (* - *)
+  THM_INTRO_TAC[`(A UNION B)`;`e`] parity;
+  ASM_SIMP_TAC[curve_cell_edge];
+  FULL_REWRITE_TAC[psegment_triple];
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  CONJ_TAC;
+  IMATCH_MP_TAC  edge_cell;
+  USE 27 (REWRITE_RULE[UNION]);
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `parity(A UNION B) e = F` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  KILL 13 THEN REWR 14;
+  UND 9 THEN ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`A UNION B`;`F`] par_cell_disjoint;
+  USE 9(REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `e` 9;
+  ASM_MESON_TAC[subset_imp];
+  ]);;
+
+  (* }}} *)
+
+let curve_cell_cls = prove_by_refinement(
+  `!G m. segment G ==> (curve_cell G {(pointI m)} = cls G m)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[curve_cell_not_point];
+  THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
+  FULL_REWRITE_TAC[segment];
+  REWRITE_TAC[cls];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let conn2_rect_diff_inner = prove_by_refinement(
+  `!E R. conn2 E /\ (E SUBSET edge) /\ rectagon R /\ R SUBSET E ==>
+     conn2 (E DIFF (E INTER par_cell F R))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[conn2];
+  TYPE_THEN `J = E INTER par_cell F R` ABBREV_TAC ;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  (* - *)
+  TYPE_THEN `R SUBSET E DIFF J` SUBAGOAL_TAC;
+  REWRITE_TAC[DIFF_SUBSET];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC [EMPTY_EXISTS;INTER];
+  TYPE_THEN `J` UNABBREV_TAC;
+  THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj;
+  FULL_REWRITE_TAC[rectagon];
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  TSPEC `u` 10;
+  THM_INTRO_TAC[`R`;`u`] curve_cell_edge;
+  FULL_REWRITE_TAC[rectagon];
+  ASM_MESON_TAC[subset_imp];
+  REWR 10;
+  (* -/ *)
+  THM_INTRO_TAC[`R`] conn2_rectagon;
+  CONJ_TAC;
+  THM_INTRO_TAC[`R`;`E DIFF J`] CARD_SUBSET;
+  FULL_REWRITE_TAC[conn2];
+  UND 10 THEN UND 11 THEN ARITH_TAC;
+  TYPE_THEN `(E DIFF J) UNION J = E` SUBAGOAL_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[DIFF;INTER;UNION];
+  MESON_TAC[];
+  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`;`c`]);
+  UND 15 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[cls_union];
+  REWRITE_TAC[UNION];
+  (* -A *)
+  TYPE_THEN `S SUBSET E DIFF J` ASM_CASES_TAC;
+  TYPE_THEN `S` EXISTS_TAC;
+  TYPE_THEN `~(S INTER J = EMPTY)` SUBAGOAL_TAC;
+  TYPE_THEN `~(S = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end;segment;psegment];
+  TYPE_THEN `S` UNABBREV_TAC ;
+  USE 20 (REWRITE_RULE[EMPTY_EXISTS]);
+  UND 20 THEN UND 19 THEN UND 18 THEN UND 17 THEN REWRITE_TAC[EQ_EMPTY;SUBSET;INTER;DIFF] THEN MESON_TAC[];
+  (* -/ *)
+  THM_INTRO_TAC[`R`;`T`;`{(pointI a)}`] par_cell_cell_partition;
+  REWRITE_TAC[cell_rules];
+  IMATCH_MP_TAC  rectagon_segment;
+  TYPE_THEN `par_cell T R {(pointI a)} \/ cls R a` SUBAGOAL_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[cls];
+  USE 14 (REWRITE_RULE[DIFF]);
+  THM_INTRO_TAC[`R`;`F`;`a`;`e'`] par_cell_nbd;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `J` UNABBREV_TAC;
+  USE 14(REWRITE_RULE[INTER]);
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`R`;`a`]curve_cell_cls;
+  IMATCH_MP_TAC  rectagon_segment;
+  ASM_MESON_TAC[];
+  (* -B/ *)
+  KILL 20;
+  THM_INTRO_TAC[`R`;`T`;`{(pointI b)}`] par_cell_cell_partition;
+  REWRITE_TAC[cell_rules];
+  IMATCH_MP_TAC  rectagon_segment;
+  (* - *)
+  TYPE_THEN `par_cell T R {(pointI b)} \/ cls R b` SUBAGOAL_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[cls];
+  USE 25 (REWRITE_RULE[DIFF]);
+  THM_INTRO_TAC[`R`;`F`;`b`;`e`] par_cell_nbd;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `J` UNABBREV_TAC;
+  USE 25(REWRITE_RULE[INTER]);
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`R`;`b`]curve_cell_cls;
+  IMATCH_MP_TAC  rectagon_segment;
+  ASM_MESON_TAC[];
+  KILL 20;
+  KILL 18;
+  USE 19 (REWRITE_RULE [EMPTY_EXISTS;INTER]);
+  (* -C/ *)
+  TYPE_THEN `~cls J a \/ cls R a` SUBAGOAL_TAC;
+  UND 21 THEN DISCH_THEN DISJ_CASES_TAC;
+  DISJ1_TAC;
+  USE 21(REWRITE_RULE[cls]);
+  THM_INTRO_TAC[`R`;`T`;`a`;`e`] par_cell_nbd;
+  TYPE_THEN `J` UNABBREV_TAC;
+  USE 23(REWRITE_RULE[INTER]);
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `J` UNABBREV_TAC;
+  USE 23(REWRITE_RULE[INTER]);
+  THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
+  USE 25(REWRITE_RULE[INTER;EQ_EMPTY]);
+  ASM_MESON_TAC[];
+  (* -/ *)
+  TYPE_THEN `~cls J b \/ cls R b` SUBAGOAL_TAC;
+  UND 22 THEN DISCH_THEN DISJ_CASES_TAC;
+  DISJ1_TAC;
+  USE 23(REWRITE_RULE[cls]);
+  THM_INTRO_TAC[`R`;`T`;`b`;`e`] par_cell_nbd;
+  TYPE_THEN `J` UNABBREV_TAC;
+  USE 24(REWRITE_RULE[INTER]);
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `J` UNABBREV_TAC;
+  USE 24(REWRITE_RULE[INTER]);
+  THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
+  USE 26(REWRITE_RULE[INTER;EQ_EMPTY]);
+  ASM_MESON_TAC[];
+  (* -D/ *)
+  TYPE_THEN `!a b S'. (S' SUBSET S) /\ segment_end S' a b /\ (cls S' INTER cls (R UNION J) = {b}) ==> cls R b /\ (S' INTER (R UNION J) = EMPTY)` SUBAGOAL_TAC;
+  TYPE_THEN `S' INTER (R UNION J) = EMPTY` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  USE 27 (REWRITE_RULE[INTER;UNION ]);
+  THM_INTRO_TAC[`u'`] two_endpoint;
+  FULL_REWRITE_TAC[segment_end;psegment;segment];
+  UND 28 THEN UND 31 THEN MESON_TAC[subset_imp];
+  TYPE_THEN `!n. closure top2 u' (pointI n) ==> (n = b')` SUBAGOAL_TAC;
+  USE 24 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `n` 24;
+  USE 24 (REWRITE_RULE[INTER;INR IN_SING]);
+  USE 24 SYM;
+  TYPE_THEN `{u'} SUBSET S' /\ {u'} SUBSET (R UNION J)` SUBAGOAL_TAC;
+  REWRITE_TAC[SUBSET;INR IN_SING;UNION ];
+  USE 31(MATCH_MP cls_subset);
+  USE 32(MATCH_MP cls_subset);
+  FULL_REWRITE_TAC[cls_edge];
+  FULL_REWRITE_TAC[SUBSET];
+  USE 29 (REWRITE_RULE[has_size2]);
+  USE 31(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 31(REWRITE_RULE[INR in_pair]);
+  COPY 31;
+  TSPEC `a''` 32;
+  TSPEC `b''` 31;
+  REWR 31;
+  REWR 32;
+  UND 29 THEN REWRITE_TAC[];
+  (* --E *)
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `cls J b'` SUBAGOAL_TAC;
+  USE 24(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 24(REWRITE_RULE[INTER;INR IN_SING]);
+  TSPEC `b'` 24;
+  USE 24(REWRITE_RULE[cls_union]);
+  USE 24(REWRITE_RULE[UNION]);
+  REWR 24;
+  (* --/ *)
+  TYPE_THEN`par_cell F R {(pointI b')}` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`R`;`T`;`{(pointI b')}`] par_cell_cell_partition;
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  REWRITE_TAC[cell_rules];
+  UND 30 THEN REP_CASES_TAC;
+  USE 29 (REWRITE_RULE[cls]);
+  THM_INTRO_TAC[`R`;`e`;`{(pointI b')}`;`F`] par_cell_closure_cell;
+  REWRITE_TAC[cell_rules];
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  TYPE_THEN `J` UNABBREV_TAC;
+  USE 31 (REWRITE_RULE[INTER]);
+  IMATCH_MP_TAC  edge_cell;
+  UND 31 THEN UND 2 THEN MESON_TAC[subset_imp];
+  FIRST_ASSUM DISJ_CASES_TAC  ;
+  THM_INTRO_TAC[`R`;`F`] par_cell_curve_cell_disj;
+  FULL_REWRITE_TAC[rectagon];
+  THM_INTRO_TAC[`R`;`b'`] curve_cell_cls;
+  IMATCH_MP_TAC  rectagon_segment;
+  REWR 33;
+  THM_INTRO_TAC[`R`;`b'`] curve_cell_cls;
+  IMATCH_MP_TAC  rectagon_segment;
+  REWR 30;
+  (* --/ *)
+  USE 24 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 24 (REWRITE_RULE[INR IN_SING;cls_union]);
+  TSPEC `b'` 24;
+  USE 24 (REWRITE_RULE[INTER;UNION]);
+  USE 31(REWRITE_RULE[cls]);
+  THM_INTRO_TAC[`R`;`F`;`b'`;`e`] par_cell_nbd;
+  USE 16 (REWRITE_RULE[segment_end;segment;psegment]);
+  UND 36 THEN UND 26 THEN UND 32 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  USE 27(REWRITE_RULE[EQ_EMPTY;INTER;UNION]);
+  TSPEC `e` 27;
+  UND 27 THEN ASM_REWRITE_TAC[];
+  DISJ2_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  REWRITE_TAC[INTER];
+  UND 17 THEN UND 26 THEN UND 32 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  (* -F *)
+  TYPE_THEN `?m. (cls R m /\ cls S m)` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`R`;`S`] segment_in_comp;
+  FULL_REWRITE_TAC[segment_end;psegment];
+  LEFT 25  "m" ;
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 28(REWRITE_RULE[EMPTY_EXISTS;INTER ]);
+  THM_INTRO_TAC[`u'`] two_endpoint;
+  UND 29 THEN UND 17 THEN UND 2 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  USE 30(REWRITE_RULE[has_size2]);
+  USE 31(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `a'` 31;
+  USE 31(REWRITE_RULE[INR in_pair]);
+  TSPEC `a'` 25;
+  USE 25(REWRITE_RULE[cls]);
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `EMPTY:((int#int)->bool)` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_EMPTY;EQ_EMPTY;INTER;];
+  TSPEC `x` 25;
+  UND 25 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `eps = T` ASM_CASES_TAC ;
+  TYPE_THEN `eps` UNABBREV_TAC;
+  THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
+  USE 27(REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `u` 27;
+  USE 26(REWRITE_RULE[SUBSET]);
+  TYPE_THEN`J` UNABBREV_TAC;
+  USE 18 (REWRITE_RULE[INTER]);
+  UND 6 THEN UND 26 THEN UND 27 THEN UND 19 THEN MESON_TAC[];
+  TYPE_THEN `eps = F` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  KILL 27;
+  TYPE_THEN `eps` UNABBREV_TAC;
+  USE 16 (REWRITE_RULE[segment_end]);
+  THM_INTRO_TAC[`S`;`a`] terminal_endpoint;
+  USE 16 (REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `a` 16;
+  FULL_REWRITE_TAC[psegment;segment;INR in_pair];
+  TYPE_THEN `e = terminal_edge S a` ABBREV_TAC ;
+  USE 20 (REWRITE_RULE[cls]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  LEFT 31 "e";
+  TSPEC `e` 31;
+  TYPE_THEN `J` UNABBREV_TAC;
+  USE 31(REWRITE_RULE[INTER]);
+  UND 6 THEN ASM_REWRITE_TAC[];
+  UND 29 THEN UND 26 THEN UND 17 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  LEFT 25 "m";
+  TSPEC `a` 25;
+  USE 25 (REWRITE_RULE[cls]);
+  KILL 24;
+  ASM_MESON_TAC[];
+  (* -G/ *)
+  TYPE_THEN `conn2 R` SUBAGOAL_TAC;
+  USE 27(REWRITE_RULE[conn2]);
+  TSPEC `m` 27;
+  LEFT 27 "c";
+  TSPEC `c` 27;
+  (* - a case *)
+  TYPE_THEN `(~(a = m)) ==> (?S'. S' SUBSET E DIFF J /\ segment_end S' a m /\ ~cls S' c)` SUBAGOAL_TAC;
+  TYPE_THEN `cls R a` ASM_CASES_TAC;
+  UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`a`]);
+  KILL 24;
+  ASM_MESON_TAC[];
+  TYPE_THEN `S'` EXISTS_TAC;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `R` EXISTS_TAC;
+  (* -- *)
+  TYPE_THEN `?S'. S' SUBSET S /\ segment_end S' a m` SUBAGOAL_TAC;
+  TYPE_THEN `m = b` ASM_CASES_TAC;
+  TYPE_THEN `S` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  THM_INTRO_TAC[`S`;`a`;`b`;`m`] cut_psegment;
+  TYPE_THEN `A` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_UNION];
+  THM_INTRO_TAC[`R UNION J`;`S'`;`a`;`m`] segment_end_select;
+  REWRITE_TAC[cls_union;union_subset];
+  ASM_REWRITE_TAC[UNION];
+  IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  REWR 20;
+  CONJ_TAC;
+  FULL_REWRITE_TAC [rectagon];
+  TYPE_THEN `J` UNABBREV_TAC;
+  UND 2 THEN REWRITE_TAC[INTER;SUBSET] THEN MESON_TAC[];
+  (* -- *)
+  UND 24 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`c'`;`B`]);
+  UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  TYPE_THEN `c' = m` ASM_CASES_TAC;
+  TYPE_THEN `B` EXISTS_TAC;
+  CONJ_TAC;
+  USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
+  UND 24 THEN UND 35 THEN UND 33 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
+  TYPE_THEN `c'` UNABBREV_TAC;
+  TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  UND 39 THEN UND 40 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `B SUBSET E DIFF J /\ ~cls B c` SUBAGOAL_TAC;
+  CONJ_TAC;
+  USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
+  UND 24 THEN UND 35 THEN UND 33 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
+  TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  UND 35 THEN UND 33 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  UND 41 THEN UND 40 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  (* -- *)
+  UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`c'`]);
+  CONJ_TAC;
+  TYPE_THEN `c'` UNABBREV_TAC;
+  USE 37(MATCH_MP segment_end_cls2);
+  UND 40 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `c` UNABBREV_TAC;
+  USE 32 (MATCH_MP segment_end_cls2);
+  TYPE_THEN `cls S' SUBSET cls S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  UND 25 THEN UND 3 THEN MESON_TAC[];
+  USE 42 (ONCE_REWRITE_RULE[segment_end_symm]);
+  (* -- *)
+  TYPE_THEN `S'' SUBSET (E DIFF J)`SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `R` EXISTS_TAC;
+  THM_INTRO_TAC[`B`;`S''`;`a`;`c'`;`m`] segment_end_trans;
+  TYPE_THEN `U` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `B UNION S''` EXISTS_TAC;
+  REWRITE_TAC[union_subset];
+  TYPE_THEN `cls U SUBSET cls (B UNION S'')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  USE 48(REWRITE_RULE[cls_union]);
+  UND 48 THEN UND 47 THEN UND 40 THEN UND 27 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
+  (* -H *)
+    TYPE_THEN `(~(b = m)) ==> (?S'. S' SUBSET E DIFF J /\ segment_end S' b m /\ ~cls S' c)` SUBAGOAL_TAC;
+  TYPE_THEN `cls R b` ASM_CASES_TAC;
+  UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`b`]);
+  KILL 24;
+  ASM_MESON_TAC[];
+  TYPE_THEN `S'` EXISTS_TAC;
+  USE 33(ONCE_REWRITE_RULE[segment_end_symm]);
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `R` EXISTS_TAC;
+  (* -- *)
+  TYPE_THEN `?S'. S' SUBSET S /\ segment_end S' b m` SUBAGOAL_TAC;
+  TYPE_THEN `m = a` ASM_CASES_TAC;
+  TYPE_THEN `S` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  USE 16 (ONCE_REWRITE_RULE[segment_end_symm]);
+  THM_INTRO_TAC[`S`;`b`;`a`;`m`] cut_psegment;
+  USE 16 (ONCE_REWRITE_RULE[segment_end_symm]);
+  TYPE_THEN `A` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_UNION];
+  (* -- *)
+  THM_INTRO_TAC[`R UNION J`;`S'`;`b`;`m`] segment_end_select;
+  REWRITE_TAC[cls_union;union_subset];
+  ASM_REWRITE_TAC[UNION];
+  IMATCH_MP_TAC (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  REWR 23;
+  CONJ_TAC;
+  FULL_REWRITE_TAC [rectagon];
+  TYPE_THEN `J` UNABBREV_TAC;
+  UND 2 THEN REWRITE_TAC[INTER;SUBSET] THEN MESON_TAC[];
+  (* -- *)
+  UND 24 THEN DISCH_THEN (THM_INTRO_TAC[`b`;`c'`;`B`]);
+  UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  TYPE_THEN `c' = m` ASM_CASES_TAC;
+  TYPE_THEN `B` EXISTS_TAC;
+  CONJ_TAC;
+  USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
+  UND 24 THEN UND 36 THEN UND 34 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
+  TYPE_THEN `c'` UNABBREV_TAC;
+  TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  UND 40 THEN UND 41 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `B SUBSET E DIFF J /\ ~cls B c` SUBAGOAL_TAC;
+  CONJ_TAC;
+  USE 24(REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
+  UND 24 THEN UND 36 THEN UND 34 THEN UND 17 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
+  TYPE_THEN `cls B SUBSET cls S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  UND 36 THEN UND 34 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  UND 42 THEN UND 41 THEN UND 3 THEN REWRITE_TAC[SUBSET] THEN MESON_TAC[];
+  (* -- *)
+  UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`c'`]);
+  CONJ_TAC;
+  TYPE_THEN `c'` UNABBREV_TAC;
+  USE 38(MATCH_MP segment_end_cls2);
+  UND 41 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `c` UNABBREV_TAC;
+  USE 33 (MATCH_MP segment_end_cls2);
+  TYPE_THEN `cls S' SUBSET cls S` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  UND 25 THEN UND 3 THEN MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `S'' SUBSET (E DIFF J)`SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `R` EXISTS_TAC;
+  THM_INTRO_TAC[`B`;`S''`;`b`;`c'`;`m`] segment_end_trans;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  TYPE_THEN `U` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `B UNION S''` EXISTS_TAC;
+  REWRITE_TAC[union_subset];
+  TYPE_THEN `cls U SUBSET cls (B UNION S'')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  USE 49(REWRITE_RULE[cls_union]);
+  UND 49 THEN UND 48 THEN UND 41 THEN UND 27 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
+  (* -I *)
+  TYPE_THEN `b = m` ASM_CASES_TAC;
+  TYPE_THEN`m` UNABBREV_TAC;
+  TYPE_THEN `a = m` ASM_CASES_TAC;
+  TYPE_THEN `m` UNABBREV_TAC;
+  TYPE_THEN `S'` EXISTS_TAC;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`S''`;`S'`;`a`;`m`;`b`] segment_end_trans;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  TYPE_THEN `U` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `S'' UNION S'` EXISTS_TAC;
+  REWRITE_TAC[union_subset];
+  TYPE_THEN `cls U SUBSET cls (S'' UNION S')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  USE 41(REWRITE_RULE[SUBSET;cls_union]);
+  UND 41 THEN UND 40 THEN UND 30 THEN UND 33 THEN REWRITE_TAC[UNION] THEN MESON_TAC[];
+  (* Sat Dec  4 18:57:41 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let conn2_psegment_triple = prove_by_refinement(
+  `!E. conn2 E /\ (E SUBSET edge) /\
+      ~(rectagon E) ==> (?A B C. psegment_triple A B C
+        /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E /\
+            A SUBSET par_cell F (B UNION C))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(?A B C. psegment_triple A B C /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E)` BACK_TAC;
+  THM_INTRO_TAC[`A`;`B`;`C`] trap_odd_cell;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  USE 6 (MATCH_MP psegment_triple3);
+  USE 9 (ONCE_REWRITE_RULE[UNION_COMM ]);
+  ASM_MESON_TAC[];
+  USE 6 (MATCH_MP psegment_triple2);
+  USE 9 (ONCE_REWRITE_RULE[UNION_COMM ]);
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`E`] conn2_has_rectagon;
+  THM_INTRO_TAC[`E`;`B`] conn2_proper;
+  CONJ_TAC;
+  IMATCH_MP_TAC  conn2_rectagon;
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`A`] endpoint_size2;
+  FULL_REWRITE_TAC[has_size2];
+  THM_INTRO_TAC[`B`;`a`;`b`] cut_rectagon_cls;
+  REWR 5;
+  USE 5 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 5 (REWRITE_RULE[INTER;INR in_pair]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `C = A'` ABBREV_TAC ;
+  TYPE_THEN `A'` UNABBREV_TAC;
+  TYPE_THEN`A` EXISTS_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  TYPE_THEN `B'` EXISTS_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  REWRITE_TAC[psegment_triple];
+  TYPE_THEN `psegment B' /\ psegment C` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end];
+  TYPE_THEN`(A INTER B' = EMPTY) /\ (A INTER C = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  FULL_REWRITE_TAC[INTER_COMM];
+  USE 5 (REWRITE_RULE[cls_union]);
+  FULL_REWRITE_TAC[UNION_OVER_INTER;];
+  TYPE_THEN `(endpoint B' = {a,b}) /\ (endpoint C = {a,b})` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end];
+  TYPE_THEN `(cls A INTER cls B' = {a, b}) /\ (cls A INTER cls C = {a, b})` SUBAGOAL_TAC;
+  TYPE_THEN `endpoint A` UNABBREV_TAC;
+
+  USE 10 (REWRITE_RULE[FUN_EQ_THM]);
+  USE 5 (REWRITE_RULE[INTER;UNION;INR in_pair]);
+  CONJ_TAC THEN IMATCH_MP_TAC  EQ_EXT THEN REWRITE_TAC[INTER;INR in_pair];
+  ASM_MESON_TAC[segment_end_cls;segment_end_cls2];
+  ASM_MESON_TAC[segment_end_cls;segment_end_cls2];
+  (* - *)
+  FULL_REWRITE_TAC[UNION_COMM];
+  (* - *)
+  TYPE_THEN`segment_end A a b` SUBAGOAL_TAC;
+  REWRITE_TAC[segment_end];
+  CONJ_TAC ;
+  ASM_MESON_TAC[segment_end_union_rectagon;segment_end_symm;INTER_COMM;UNION_COMM];
+  ASM_MESON_TAC[union_subset];
+  ]);;
+  (* }}} *)
+
+let rectagon_surround_conn2 = prove_by_refinement(
+  `!G. conn2 G /\ G SUBSET edge ==>
+     (?C. rectagon C /\ C SUBSET G /\
+          (!x. bounded_set G x ==> bounded_set C x))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `EE = {C | conn2 C /\ (C SUBSET G) /\ (!x. bounded_set G x ==> bounded_set C x)}` ABBREV_TAC ;
+  TYPE_THEN `EE G` SUBAGOAL_TAC;
+  TYPE_THEN `EE` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  THM_INTRO_TAC[`EE`] select_card_min;
+  UND 4 THEN REWRITE_TAC[EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  TYPE_THEN `C = z` ABBREV_TAC ;
+  TYPE_THEN `z` UNABBREV_TAC;
+  TYPE_THEN `rectagon C` BACK_TAC ;
+  TYPE_THEN  `C` EXISTS_TAC;
+  TYPE_THEN `EE` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `!R. rectagon R /\ R SUBSET C ==> (C INTER par_cell F R = EMPTY)` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `J = (C INTER par_cell F R )` ABBREV_TAC ;
+  TYPE_THEN `EE (C DIFF J)` SUBAGOAL_TAC;
+  TYPE_THEN `EE` UNABBREV_TAC;
+  CONJ_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  IMATCH_MP_TAC  conn2_rect_diff_inner;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C` EXISTS_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  TSPEC  `x` 2;
+  THM_INTRO_TAC[`C`;`C`;`R`;`J`;`x`] star_avoidance_contrp;
+  REWRITE_TAC[SUBSET_REFL];
+  (* --- *)
+  TYPE_THEN `FINITE G` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[conn2];
+  TYPE_THEN `J SUBSET G` SUBAGOAL_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  UND 3 THEN REWRITE_TAC[SUBSET;INTER] THEN MESON_TAC[];
+  TYPE_THEN `FINITE C /\ FINITE J` SUBAGOAL_TAC;
+  CONJ_TAC THEN IMATCH_MP_TAC  FINITE_SUBSET THEN ASM_MESON_TAC[];
+  TYPE_THEN `C SUBSET edge /\ J SUBSET edge` SUBAGOAL_TAC;
+  CONJ_TAC THEN IMATCH_MP_TAC  SUBSET_TRANS THEN ASM_MESON_TAC[];
+  TYPE_THEN `J SUBSET par_cell F R` SUBAGOAL_TAC;
+  TYPE_THEN`J` UNABBREV_TAC;
+  REWRITE_TAC[INTER;SUBSET];
+  TYPE_THEN `~(UNIONS (curve_cell G) x)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`G`;`x`] bounded_subset_unions;
+  USE 22(REWRITE_RULE[ctop_unions;DIFF ]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `!A. A SUBSET G ==> UNIONS (curve_cell A) SUBSET UNIONS(curve_cell G)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  UNIONS_UNIONS;
+  IMATCH_MP_TAC  curve_cell_imp_subset;
+  ASM_MESON_TAC[subset_imp];
+  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`C DIFF J`]);
+  USE 4(MATCH_MP (ARITH_RULE  `x <=| y ==> ~(y < x)`));
+  UND 4 THEN ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  card_subset_lt;
+  CONJ_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  CONJ_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  USE 9(REWRITE_RULE[EMPTY_EXISTS]);
+  USE 4 (REWRITE_RULE[diff_unchange]);
+  USE 4(REWRITE_RULE[EQ_EMPTY]);
+  FULL_REWRITE_TAC[INTER];
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `G` EXISTS_TAC;
+  FULL_REWRITE_TAC[conn2];
+  TYPE_THEN `EE` UNABBREV_TAC;
+  (* -A *)
+  THM_INTRO_TAC[`C`] conn2_psegment_triple;
+  TYPE_THEN `EE` UNABBREV_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  ASM_MESON_TAC[];
+  TSPEC `(B UNION C')` 7;
+  UND 7 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  REWRITE_TAC[union_subset];
+  UND 7 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `~(A = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  TYPE_THEN `A` UNABBREV_TAC;
+  USE 25 (REWRITE_RULE[psegment;segment]);
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_MESON_TAC[subset_imp];
+  ]);;
+  (* }}} *)
+
+let curve_cell_subset = prove_by_refinement(
+  `!H G. (H SUBSET G) ==>
+      UNIONS (curve_cell H) SUBSET UNIONS (curve_cell G)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  UNIONS_UNIONS;
+  TYPE_THEN `G = H UNION (G DIFF H)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  UND 0 THEN REWRITE_TAC[SUBSET;UNION;DIFF] THEN MESON_TAC[];
+  UND 1 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  REWRITE_TAC[curve_cell_union];
+  REWRITE_TAC[SUBSET;UNION];
+  ]);;
+  (* }}} *)
+
+let bounded_set_curve_cell_empty = prove_by_refinement(
+  `!H G x. bounded_set G x /\ H SUBSET G ==> ~UNIONS (curve_cell H) x`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`H`;`G`]curve_cell_subset;
+  THM_INTRO_TAC[`G`] bounded_unbounded_union;
+  USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 4;
+  USE 4(REWRITE_RULE[UNION;ctop_unions;DIFF ]);
+  FULL_REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let unbounded_set_curve_cell_empty = prove_by_refinement(
+  `!H G x. unbounded_set G x /\ H SUBSET G ==> ~UNIONS (curve_cell H) x`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`H`;`G`]curve_cell_subset;
+  THM_INTRO_TAC[`G`] bounded_unbounded_union;
+  USE 4 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `x` 4;
+  USE 4(REWRITE_RULE[UNION;ctop_unions;DIFF ]);
+  FULL_REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let bounded_triple_avoidance = prove_by_refinement(
+  `!A B C. psegment_triple A B C /\ A SUBSET par_cell F (B UNION C) ==>
+       bounded_set (A UNION B UNION C) SUBSET bounded_set (B UNION C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[SUBSET];
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`B UNION C`;`A`;`x`] star_avoidance_lemma1;
+  REWRITE_TAC[SUBSET_REFL];
+  REWRITE_TAC[FINITE_UNION;union_subset];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[psegment;segment];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[psegment;segment];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  CONJ_TAC;
+  THM_INTRO_TAC[`A`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
+  REWRITE_TAC[SUBSET;UNION];
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`A UNION B UNION C`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
+  REWRITE_TAC[SUBSET_REFL ];
+  ASM_MESON_TAC[];
+  (* -A *)
+  TYPE_THEN `(A UNION B UNION C) DIFF A = (B UNION C)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  IMATCH_MP_TAC  EQ_EXT;
+  UND 10 THEN UND 11 THEN REWRITE_TAC[EQ_EMPTY;INTER;UNION;DIFF] THEN MESON_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  REWR 6;
+  REWR 6;
+  (* - *)
+  THM_INTRO_TAC[`A`;`B`;`C`;`x`] unbounded_triple_avoidance;
+  THM_INTRO_TAC[`A UNION B UNION C`] bounded_unbounded_disj;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY ];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let bounded_euclid = prove_by_refinement(
+  `!G x. bounded_set G x ==> euclid 2 x`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  USE 0(MATCH_MP bounded_subset_unions);
+  FULL_REWRITE_TAC[ctop_unions;DIFF ];
+  ]);;
+  (* }}} *)
+
+let unbounded_euclid = prove_by_refinement(
+  `!G x. unbounded_set G x ==> euclid 2 x`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  USE 0(MATCH_MP unbounded_subset_unions);
+  FULL_REWRITE_TAC[ctop_unions;DIFF ];
+  ]);;
+  (* }}} *)
+
+let bounded_triple_inner_union = prove_by_refinement(
+  `!A B C. psegment_triple A B C ==> bounded_set (A UNION B UNION C)
+       SUBSET (bounded_set (A UNION B) UNION bounded_set (B UNION C))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`;`A`;`B`] trap_odd_cell;
+  IMATCH_MP_TAC  psegment_triple3;
+  IMATCH_MP_TAC  psegment_triple3;
+  UND 1 THEN REP_CASES_TAC;
+  THM_INTRO_TAC[`C`;`A`;`B`] bounded_triple_avoidance;
+  IMATCH_MP_TAC  psegment_triple3;
+  IMATCH_MP_TAC  psegment_triple3;
+  FULL_REWRITE_TAC[UNION_ACI;];
+  IMATCH_MP_TAC  in_union;
+  THM_INTRO_TAC[`A`;`B`;`C`] bounded_triple_avoidance;
+  FULL_REWRITE_TAC[UNION_ACI;];
+  IMATCH_MP_TAC  in_union;
+  (* - *)
+  REWRITE_TAC[SUBSET];
+  ONCE_REWRITE_TAC[UNION];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  THM_INTRO_TAC[`B UNION C`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
+  REWRITE_TAC[UNION;SUBSET];
+  THM_INTRO_TAC[`A UNION B`;`A UNION B UNION C`;`x`] bounded_set_curve_cell_empty;
+  REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[];
+  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[bounded_euclid];
+  THM_INTRO_TAC[`A UNION B`] bounded_unbounded_union;
+  USE 8(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 8(REWRITE_RULE[ctop_unions;DIFF]);
+  TSPEC `x` 8;
+  TYPE_THEN `R = A UNION B` ABBREV_TAC ;
+  USE 8(REWRITE_RULE[UNION]);
+  REWR 8;
+  TYPE_THEN `R` UNABBREV_TAC;
+  (* -A *)
+  THM_INTRO_TAC[`B UNION C`] bounded_unbounded_union;
+  USE 9(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 9(REWRITE_RULE[ctop_unions;DIFF]);
+  TSPEC `x` 9;
+  TYPE_THEN `R = B UNION C` ABBREV_TAC ;
+  USE 9(REWRITE_RULE[UNION]);
+  REWR 9;
+  TYPE_THEN `R'` UNABBREV_TAC;
+  KILL 5;
+  KILL 6;
+  KILL 3;
+  KILL 4;
+  (* - *)
+  THM_INTRO_TAC[`x`] point_onto;
+  TYPE_THEN `x` UNABBREV_TAC;
+  THM_INTRO_TAC[`p`] cell_unions;
+  USE 3(REWRITE_RULE[UNIONS]);
+  THM_INTRO_TAC[`B UNION C`] unbounded_even;
+  FULL_REWRITE_TAC[psegment_triple];
+  REWR 9;
+  KILL 5;
+  THM_INTRO_TAC[`par_cell T (B UNION C)`;`u`;`point p`] cell_ununion;
+  REWRITE_TAC[par_cell_cell];
+  KILL 6;
+  (* - *)
+  THM_INTRO_TAC[`A UNION B`] unbounded_even;
+  FULL_REWRITE_TAC[psegment_triple];
+  REWR 8;
+  KILL 6;
+  THM_INTRO_TAC[`par_cell T (A UNION B)`;`u`;`point p`] cell_ununion;
+  REWRITE_TAC[par_cell_cell];
+  KILL 8;
+  (* - *)
+  TYPE_THEN `unbounded_set (A UNION B UNION C) (point p)` ASM_CASES_TAC;
+  THM_INTRO_TAC[`A UNION B UNION C`] bounded_unbounded_disj;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* -B *)
+  TYPE_THEN `~unbounded_set (B UNION C UNION A) (point p)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[UNION_ACI];
+  ASM_MESON_TAC[];
+  UND 9 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  unbounded_triple_avoidance;
+  CONJ_TAC;
+  IMATCH_MP_TAC  psegment_triple3;
+  (* - *)
+  FULL_REWRITE_TAC[UNION_ACI];
+  KILL 8;
+  KILL 2;
+  THM_INTRO_TAC[`A UNION C`] unbounded_even;
+  FULL_REWRITE_TAC[psegment_triple];
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `u` EXISTS_TAC;
+  KILL 2;
+  (* - *)
+  THM_INTRO_TAC[`A UNION B`;`u`;`T`] parity_unique;
+  IMATCH_MP_TAC  rectagon_segment;
+  FULL_REWRITE_TAC[psegment_triple];
+  THM_INTRO_TAC[`B UNION C`;`u`;`T`] parity_unique;
+  IMATCH_MP_TAC  rectagon_segment;
+  FULL_REWRITE_TAC[psegment_triple];
+  (* - *)
+  TYPE_THEN `!A B. rectagon (A UNION B) /\ par_cell T (A UNION B) u ==> ~curve_cell A u` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`A' UNION B'`;`T`] par_cell_curve_cell_disj;
+  FULL_REWRITE_TAC[rectagon];
+  UND 12 THEN ASM_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `u` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  THM_INTRO_TAC[`A'`;`A' UNION B'`] curve_cell_imp_subset;
+  REWRITE_TAC[SUBSET;UNION];
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  TYPE_THEN `~curve_cell A u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
+  TYPE_THEN `B` EXISTS_TAC;
+  FULL_REWRITE_TAC[psegment_triple;psegment;];
+  TYPE_THEN `~curve_cell B u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
+  TYPE_THEN `A` EXISTS_TAC;
+  REWRITE_TAC[UNION_ACI];
+  FULL_REWRITE_TAC[psegment_triple;psegment;];
+  TYPE_THEN `~curve_cell C u` SUBAGOAL_TAC THENL[FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
+  TYPE_THEN `B` EXISTS_TAC;
+  REWRITE_TAC[UNION_ACI];
+  FULL_REWRITE_TAC[psegment_triple;psegment;];
+  (* -C *)
+  THM_INTRO_TAC[`A`;`B`;`u`] parity_union;
+  FULL_REWRITE_TAC[psegment_triple;psegment;];
+  IMATCH_MP_TAC  rectagon_segment;
+  REWR 13;
+  (* - *)
+  THM_INTRO_TAC[`B`;`C`;`u`] parity_union;
+  FULL_REWRITE_TAC[psegment_triple;psegment;];
+  IMATCH_MP_TAC  rectagon_segment;
+  REWR 14;
+  (* - *)
+  TYPE_THEN `parity A u = parity C u` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  KILL 13;
+  KILL 14;
+  THM_INTRO_TAC[`A`;`C`;`u`] parity_union;
+  FULL_REWRITE_TAC[psegment_triple;psegment;];
+  IMATCH_MP_TAC  rectagon_segment;
+  REWR 13;
+  TYPE_THEN `parity (A UNION C) u = T` SUBAGOAL_TAC;
+  USE 14 SYM;
+  IMATCH_MP_TAC  parity;
+  REWRITE_TAC[curve_cell_union];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple;psegment;];
+  IMATCH_MP_TAC  rectagon_segment;
+  USE 16(REWRITE_RULE[UNION]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION W *)
+(* ------------------------------------------------------------------ *)
+
+
+(* back to the K3 graph *)
+
+let rectagon_graph = jordan_def
+  `rectagon_graph G  <=>
+       graph G /\
+       graph_edge G SUBSET psegment /\
+       (!e. graph_edge G e ==> (graph_inc G e = endpoint e)) /\
+       (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
+             (e INTER e' = EMPTY)) /\
+       (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
+             (cls e INTER cls e' = endpoint e INTER endpoint e'))`;;
+
+let rectagonal_graph = jordan_def
+  `rectagonal_graph (G:(A,B)graph_t) <=>
+    (?H. rectagon_graph H /\ graph_isomorphic H G)`;;
+
+let k33_rectagon_hyp  = jordan_def
+   `k33_rectagon_hyp R f <=>  rectagon R /\
+   (!(i:three_t) j. ~(i = j) ==> (cls (f i) INTER (cls (f j)) = EMPTY)) /\
+   (!i j. ~(i = j) ==> ((f i) INTER (f j) = EMPTY)) /\
+   (!i. ?A B. (R = A UNION B) /\ psegment_triple A B (f i) /\
+       (!j. ~(cls (f j) INTER cls A = EMPTY) /\
+               ~(cls (f j) INTER cls B = EMPTY)) /\
+       (!j. ~(i = j) ==> (cls (f j) INTER cls A INTER cls B = EMPTY)))`;;
+
+let k33_rectagon_two_even = prove_by_refinement(
+  `!R f i. k33_rectagon_hyp R f /\
+      f i SUBSET par_cell F R  ==>
+       (!j. ~(j = i) ==> (f j SUBSET par_cell T R))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  FULL_REWRITE_TAC [k33_rectagon_hyp];
+  COPY 2;
+  TSPEC `i` 2;
+  TYPE_THEN `R` UNABBREV_TAC;
+  (* - *)
+  THM_INTRO_TAC[`f i`;`A`;`B`] outer_segment_even;
+  IMATCH_MP_TAC  psegment_triple3;
+  IMATCH_MP_TAC  psegment_triple3;
+  THM_INTRO_TAC[`f i`;`B`;`A`] outer_segment_even;
+  FULL_REWRITE_TAC[UNION_ACI];
+  IMATCH_MP_TAC  psegment_triple2;
+  (* - *)
+  TSPEC `j` 7;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  USE 7 (REWRITE_RULE[INTER]);
+  USE 11(REWRITE_RULE[INTER]);
+  (* -A *)
+  THM_INTRO_TAC[`f i UNION A`;`B`;`f j`;`u`;`T`] meeting_lemma;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[UNION_COMM];
+  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  CONJ_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `j` UNABBREV_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[UNION_COMM];
+  TSPEC `j` 6;
+  REWRITE_TAC[GSYM SUBSET_EMPTY];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `f j INTER (A' UNION B')` EXISTS_TAC;
+  CONJ_TAC;
+  USE 42 SYM;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  REWRITE_TAC[SUBSET;UNION];
+  REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
+  FULL_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[cls_union];
+  (* -- *)
+  TSPEC `j` 2;
+  REWR 2;
+  USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `u` 2;
+  REWR 2;
+  COPY 4;
+  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  TYPE_THEN `i` UNABBREV_TAC;
+  USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
+  TSPEC `u` 4;
+  REWR 4;
+  (* -- *)
+  TYPE_THEN `B SUBSET edge` SUBAGOAL_TAC;
+  USE 8 (REWRITE_RULE[psegment_triple]);
+  USE 26(REWRITE_RULE[psegment;segment]);
+  (* -- *)
+  TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
+  TSPEC `j` 6;
+  USE 17 (REWRITE_RULE[psegment_triple]);
+  FULL_REWRITE_TAC[psegment];
+  (* -- *)
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  USE 17 (REWRITE_RULE[UNION]);
+  REWR 17;
+  (* -- *)
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  CONJ_TAC;
+  UND 14 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
+  TYPE_THEN `j` UNABBREV_TAC;
+  (* -- *)
+  TSPEC `j` 6;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `cls (f j) INTER cls(A' UNION B')` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  USE 19 SYM;
+  IMATCH_MP_TAC  cls_subset;
+  REWRITE_TAC[SUBSET;UNION];
+  USE 18(REWRITE_RULE[psegment_triple]);
+  REWRITE_TAC[cls_union;UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  FULL_REWRITE_TAC[INTER_COMM];
+  TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  (* -B *)
+  THM_INTRO_TAC[`f i UNION B`;`A`;`f j`;`u'`;`T`] meeting_lemma;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[UNION_COMM];
+  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  CONJ_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `j` UNABBREV_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[UNION_COMM];
+  TSPEC `j` 6;
+  REWRITE_TAC[GSYM SUBSET_EMPTY];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `f j INTER (A' UNION B')` EXISTS_TAC;
+  CONJ_TAC;
+  USE 43 SYM;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  REWRITE_TAC[SUBSET;UNION];
+  REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
+  FULL_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[cls_union];
+  (* -- *)
+  TSPEC `j` 2;
+  REWR 2;
+  USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `u'` 2;
+  REWR 2;
+  COPY 4;
+  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  TYPE_THEN `i` UNABBREV_TAC;
+  USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
+  TSPEC `u'` 4;
+  REWR 4;
+  (* -- *)
+  TYPE_THEN `A SUBSET edge` SUBAGOAL_TAC;
+  USE 8 (REWRITE_RULE[psegment_triple]);
+  USE 28(REWRITE_RULE[psegment;segment]);
+  (* -- *)
+  TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
+  TSPEC `j` 6;
+  USE 18 (REWRITE_RULE[psegment_triple]);
+  FULL_REWRITE_TAC[psegment];
+  (* -- *)
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  USE 18 (REWRITE_RULE[UNION]);
+  REWR 18;
+  (* -- *)
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  CONJ_TAC;
+  UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
+  TYPE_THEN `j` UNABBREV_TAC;
+  (* -- *)
+  TSPEC `j` 6;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `cls (f j) INTER cls(A' UNION B')` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  USE 20 SYM;
+  IMATCH_MP_TAC  cls_subset;
+  REWRITE_TAC[SUBSET;UNION];
+  USE 19(REWRITE_RULE[psegment_triple]);
+  REWRITE_TAC[cls_union;UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  FULL_REWRITE_TAC[INTER_COMM];
+  TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  (* -C *)
+  IMATCH_MP_TAC  par_cell_even_imp;
+  TYPE_THEN `f i` EXISTS_TAC;
+  FULL_REWRITE_TAC[UNION_ACI];
+  CONJ_TAC;
+  TSPEC `j` 6;
+  USE 17 (REWRITE_RULE [psegment_triple]);
+  USE 29(REWRITE_RULE[psegment]);
+  (* - *)
+  CONJ_TAC;
+  TSPEC `j` 6;
+  FULL_REWRITE_TAC[psegment_triple];
+  REWRITE_TAC[cls_union ;];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  FULL_REWRITE_TAC[INTER_COMM];
+  TYPE_THEN `endpoint A'` UNABBREV_TAC;
+  TYPE_THEN `endpoint B'` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
+  TYPE_THEN `j` UNABBREV_TAC;
+  (* - *)
+  TSPEC `j` 6;
+  UND 17 THEN UND 18 THEN (POP_ASSUM_LIST (fun t -> ALL_TAC));
+  TYPE_THEN `!C. C SUBSET (A' UNION B') ==> (C INTER f j = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  FULL_REWRITE_TAC[SUBSET;UNION ];
+  ASM_MESON_TAC[];
+  USE 1 SYM;
+  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN (ASM_REWRITE_TAC[SUBSET ]) THEN ASM_REWRITE_TAC[UNION];
+  ]);;
+  (* }}} *)
+
+let psegment_triple_odd_even = prove_by_refinement(
+  `!A B C. psegment_triple A B C /\ C SUBSET par_cell T (A UNION B) ==>
+    (?A' B'. psegment_triple A' B' C /\ C SUBSET par_cell T (A' UNION B')
+         /\ A' SUBSET par_cell F (B' UNION C)
+         /\ B' SUBSET par_cell T (A' UNION C)
+         /\ (A UNION B = A' UNION B')
+         /\ (cls A INTER cls B = cls A' INTER cls B') /\
+         (!P. (P A  /\ P B ) ==> P A' /\ P B'))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `A SUBSET par_cell F (B UNION C)` ASM_CASES_TAC;
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `B` EXISTS_TAC;
+  IMATCH_MP_TAC  outer_segment_even;
+  FULL_REWRITE_TAC[UNION_COMM];
+  IMATCH_MP_TAC  psegment_triple3;
+  IMATCH_MP_TAC  psegment_triple3;
+  IMATCH_MP_TAC  psegment_triple2;
+  THM_INTRO_TAC[`A`;`B`;`C`] trap_odd_cell;
+  UND 3 THEN REP_CASES_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `B` EXISTS_TAC;
+  TYPE_THEN `A` EXISTS_TAC;
+  FULL_REWRITE_TAC[UNION_COMM;INTER_COMM;];
+  CONJ_TAC;
+  IMATCH_MP_TAC  psegment_triple3;
+  IMATCH_MP_TAC  psegment_triple2;
+  IMATCH_MP_TAC  outer_segment_even;
+  FULL_REWRITE_TAC[UNION_COMM];
+  IMATCH_MP_TAC  psegment_triple3;
+  (* - *)
+  TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  TYPE_THEN `C` UNABBREV_TAC;
+  USE 15 (REWRITE_RULE[psegment;segment]);
+  (* - *)
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  THM_INTRO_TAC[`A UNION B`;`T`] par_cell_disjoint;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[subset_imp];
+  ]);;
+  (* }}} *)
+
+let k33_rectagon_two_odd = prove_by_refinement(
+  `!R f i. k33_rectagon_hyp R f /\
+      f i SUBSET par_cell T R  ==>
+       (!j. ~(j = i) ==> (f j SUBSET par_cell F R))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  FULL_REWRITE_TAC [k33_rectagon_hyp];
+  COPY 2;
+  TSPEC `i` 2;
+  TYPE_THEN `R` UNABBREV_TAC;
+  (* - *)
+  THM_INTRO_TAC[`A`;`B`;`f i`] psegment_triple_odd_even;
+  TYPE_THEN `A UNION B` UNABBREV_TAC;
+  TYPE_THEN `cls A INTER cls B` UNABBREV_TAC;
+  TYPE_THEN `!j. ~(cls (f j) INTER cls A' = {}) /\ ~(cls (f j) INTER cls B' = {})` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  KILL 7; (* 7 -> 10 *)
+  KILL 9;
+  KILL 8;
+  (* - *)
+  TSPEC `j` 10;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  USE 7 (REWRITE_RULE[INTER]);
+  USE 8(REWRITE_RULE[INTER]);
+  (* -A *)
+  THM_INTRO_TAC[`f i UNION A'`;`B'`;`f j`;`u`;`T`] meeting_lemma;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[UNION_COMM];
+  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  FULL_REWRITE_TAC[UNION_COMM];
+  CONJ_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `j` UNABBREV_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[UNION_COMM];
+  TSPEC `j` 6;
+  FULL_REWRITE_TAC[UNION_COMM];
+  REWRITE_TAC[GSYM SUBSET_EMPTY];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `f j INTER (A'' UNION B'')` EXISTS_TAC;
+  CONJ_TAC;
+  USE 43 SYM;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  REWRITE_TAC[SUBSET;UNION];
+  REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
+  FULL_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[cls_union];
+  (* -- *)
+  TSPEC `j` 2;
+  REWR 2;
+  USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `u` 2;
+  REWR 2;
+  COPY 4;
+  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  TYPE_THEN `i` UNABBREV_TAC;
+  USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
+  TSPEC `u` 4;
+  REWR 4;
+  (* -- *)
+  TYPE_THEN `B' SUBSET edge` SUBAGOAL_TAC;
+  USE 15 (REWRITE_RULE[psegment_triple]);
+  USE 27(REWRITE_RULE[psegment;segment]);
+  (* -- *)
+  TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
+  TSPEC `j` 6;
+  USE 18 (REWRITE_RULE[psegment_triple]);
+  FULL_REWRITE_TAC[psegment];
+  (* -- *)
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  USE 18 (REWRITE_RULE[UNION]);
+  REWR 18;
+  (* -- *)
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  UND 11 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
+  TYPE_THEN `j` UNABBREV_TAC;
+  (* -- *)
+  TSPEC `j` 6;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `cls (f j) INTER cls(A'' UNION B'')` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  USE 20 SYM;
+  IMATCH_MP_TAC  cls_subset;
+  REWRITE_TAC[SUBSET;UNION];
+  USE 19(REWRITE_RULE[psegment_triple]);
+  REWRITE_TAC[cls_union;UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  FULL_REWRITE_TAC[INTER_COMM];
+  TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  (* -B *)
+  THM_INTRO_TAC[`f i UNION B'`;`A'`;`f j`;`u'`;`F`] meeting_lemma;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[UNION_COMM];
+  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  FULL_REWRITE_TAC[UNION_COMM];
+  CONJ_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `j` UNABBREV_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[UNION_COMM];
+  TSPEC `j` 6;
+  REWRITE_TAC[GSYM SUBSET_EMPTY];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `f j INTER (A'' UNION B'')` EXISTS_TAC;
+  CONJ_TAC;
+  USE 44 SYM;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  REWRITE_TAC[SUBSET;UNION];
+  REWRITE_TAC[SUBSET_EMPTY;UNION_OVER_INTER;EMPTY_UNION];
+  FULL_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[cls_union];
+  (* -- *)
+  TSPEC `j` 2;
+  REWR 2;
+  USE 2 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `u'` 2;
+  REWR 2;
+  COPY 4;
+  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  TYPE_THEN `i` UNABBREV_TAC;
+  USE 4(REWRITE_RULE [EQ_EMPTY;INTER]);
+  TSPEC `u'` 4;
+  REWR 4;
+  (* -- *)
+  TYPE_THEN `A' SUBSET edge` SUBAGOAL_TAC;
+  USE 15 (REWRITE_RULE[psegment_triple]);
+  USE 29(REWRITE_RULE[psegment;segment]);
+  (* -- *)
+  TYPE_THEN `segment (f j)` SUBAGOAL_TAC;
+  TSPEC `j` 6;
+  USE 19 (REWRITE_RULE[psegment_triple]);
+  FULL_REWRITE_TAC[psegment];
+  (* -- *)
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  USE 19 (REWRITE_RULE[UNION]);
+  REWR 19;
+  (* -- *)
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  UND 16 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
+  TYPE_THEN `j` UNABBREV_TAC;
+  (* -- *)
+  TSPEC `j` 6;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `cls (f j) INTER cls(A'' UNION B'')` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  REWRITE_TAC[SUBSET_REFL];
+  USE 21 SYM;
+  IMATCH_MP_TAC  cls_subset;
+  REWRITE_TAC[SUBSET;UNION];
+  USE 20(REWRITE_RULE[psegment_triple]);
+  REWRITE_TAC[cls_union;UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  FULL_REWRITE_TAC[INTER_COMM];
+  TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  (* -C *)
+  IMATCH_MP_TAC  par_cell_odd_imp;
+  TYPE_THEN `f i` EXISTS_TAC;
+  FULL_REWRITE_TAC[UNION_ACI];
+  CONJ_TAC;
+  TSPEC `j` 6;
+  USE 18 (REWRITE_RULE [psegment_triple]);
+  USE 30(REWRITE_RULE[psegment]);
+  (* - *)
+  CONJ_TAC;
+  TSPEC `j` 6;
+  FULL_REWRITE_TAC[psegment_triple];
+  REWRITE_TAC[cls_union ;];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  FULL_REWRITE_TAC[INTER_COMM];
+  TYPE_THEN `endpoint A''` UNABBREV_TAC;
+  TYPE_THEN `endpoint B''` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
+  TYPE_THEN `j` UNABBREV_TAC;
+  (* - *)
+  TSPEC `j` 6;
+  UND 19 THEN UND 18 THEN (POP_ASSUM_LIST (fun t -> ALL_TAC));
+  TYPE_THEN `!C. C SUBSET (A'' UNION B'') ==> (C INTER f j = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  FULL_REWRITE_TAC[SUBSET;UNION ];
+  ASM_MESON_TAC[];
+  USE 0 SYM;
+  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN (ASM_REWRITE_TAC[SUBSET ]) THEN ASM_REWRITE_TAC[UNION];
+  ]);;
+  (* }}} *)
+
+let ABS3_012 = prove_by_refinement(
+  `(REP3 (ABS3 0) = 0) /\ (REP3(ABS3 1) = 1) /\ (REP3(ABS3 2) = 2)`,
+  (* {{{ proof *)
+  [
+  ASSUME_TAC three_t;
+  USE 0(ONCE_REWRITE_RULE[EQ_SYM_EQ]);
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let three_t_not_sing = prove_by_refinement(
+  `!i. ?(j:three_t). ~(i = j)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `i = ABS3 0` ASM_CASES_TAC;
+  TYPE_THEN `ABS3 1` EXISTS_TAC;
+  USE 1(AP_TERM `REP3`);
+  FULL_REWRITE_TAC[ABS3_012];
+  UND 1 THEN ARITH_TAC;
+  TYPE_THEN `ABS3 0` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let ABS3_onto = prove_by_refinement(
+  `!(i:three_t). ?j. (i = ABS3 j) /\ (j < 3)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `REP3 i` EXISTS_TAC;
+  REWRITE_TAC[BETA_RULE three_t];
+  ]);;
+  (* }}} *)
+
+let three_t_eq = prove_by_refinement(
+  `!i j. (i = j) <=> (REP3 i = REP3 j)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  DISCH_TAC;
+  USE 0(AP_TERM `ABS3`);
+  FULL_REWRITE_TAC[three_t];
+  ]);;
+  (* }}} *)
+
+let rep3_lt = prove_by_refinement(
+  `!i. (REP3 i < 3)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[BETA_RULE three_t];
+  ]);;
+  (* }}} *)
+
+let three_t_not_pair = prove_by_refinement(
+  `!i j. ?(k:three_t). ~(k = i) /\ ~(k = j)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[three_t_eq];
+  TYPE_THEN `?k'. (k' < 3) /\ ~(k' = REP3 i) /\ ~(k' = REP3 j)` SUBAGOAL_TAC;
+  TYPE_THEN `  ~(0 = REP3 i) /\ ~(0 = REP3 j)` ASM_CASES_TAC;
+  ASM_MESON_TAC[ARITH_RULE `0 < 3`];
+  TYPE_THEN `  ~(1 = REP3 i) /\ ~(1 = REP3 j)` ASM_CASES_TAC;
+  ASM_MESON_TAC[ARITH_RULE `1 < 3`];
+  TYPE_THEN `  ~(2 = REP3 i) /\ ~(2 = REP3 j)` ASM_CASES_TAC;
+  ASM_MESON_TAC[ARITH_RULE `2 < 3`];
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  PROOF_BY_CONTR_TAC;
+  UND 0 THEN UND 1 THEN UND 2 THEN ARITH_TAC;
+  TYPE_THEN` ABS3 k'` EXISTS_TAC;
+  ASM_MESON_TAC [BETA_RULE three_t];
+  ]);;
+  (* }}} *)
+
+let bool_size = prove_by_refinement(
+  `(UNIV:bool->bool) HAS_SIZE 2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[has_size_bij2];
+  TYPE_THEN `\ u.  if u then 0 else 1` EXISTS_TAC;
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  COND_CASES_TAC THEN ARITH_TAC ;
+  UND 0 THEN COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[ARITH_RULE `~(0 =1) /\ ~(1 = 0)`];
+  FULL_REWRITE_TAC[SURJ;INJ];
+  REP_BASIC_TAC;
+  USE 2 (REWRITE_RULE[ARITH_RULE `x <| 2 <=> (x = 0)\/ (x = 1)`]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `T` EXISTS_TAC;
+  TYPE_THEN `F` EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+let three_delete_size = prove_by_refinement(
+  `!(i:three_t). (UNIV DELETE i) HAS_SIZE 2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[HAS_SIZE;FINITE_DELETE];
+  THM_INTRO_TAC[] thr_finite;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  IMATCH_MP_TAC  (ARITH_RULE `(SUC x = 3) ==> (x = 2)`);
+  USE 0 SYM;
+  IMATCH_MP_TAC  CARD_SUC_DELETE;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let has_size_bij_set = prove_by_refinement(
+  `!(A:A->bool) (B:B->bool) n. A HAS_SIZE n /\ B HAS_SIZE n ==>
+          (?f. BIJ f A B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  USE 0(REWRITE_RULE [has_size_bij]);
+  USE 1(REWRITE_RULE[has_size_bij2]);
+  TYPE_THEN `compose f  f'` EXISTS_TAC;
+  IMATCH_MP_TAC  COMP_BIJ;
+  UNIFY_EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+let bool_three_delete_bij = prove_by_refinement(
+  `!i. ?b. BIJ b (UNIV:bool->bool) ((UNIV:three_t->bool) DELETE i)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  has_size_bij_set;
+  TYPE_THEN`2` EXISTS_TAC;
+  REWRITE_TAC[bool_size;three_delete_size];
+  ]);;
+  (* }}} *)
+
+let k33_rectagon_hyp_odd_exist = prove_by_refinement(
+  `!R f. k33_rectagon_hyp R f ==>
+      (?i. (f i SUBSET par_cell F R))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[k33_rectagon_hyp];
+  TYPE_THEN `j = ABS3 0` ABBREV_TAC ;
+  TYPE_THEN `f j SUBSET par_cell F R` ASM_CASES_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `k = ABS3 1` ABBREV_TAC ;
+  TYPE_THEN `k` EXISTS_TAC;
+  THM_INTRO_TAC[`R`;`f`;`j`] k33_rectagon_two_odd;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[k33_rectagon_hyp];
+  THM_INTRO_TAC[`R`;`f j`] segment_in_comp;
+  TSPEC `j` 0;
+  USE 8 (REWRITE_RULE[psegment_triple]);
+  CONJ_TAC;
+  USE 20(REWRITE_RULE[psegment]);
+  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  FULL_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[cls_union];
+  REWRITE_TAC[UNION_OVER_INTER;union_subset];
+  FULL_REWRITE_TAC[INTER_COMM];
+  TYPE_THEN `endpoint (f j)` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  TYPE_THEN `eps = F` ASM_CASES_TAC;
+  REWR 7;
+  TYPE_THEN `eps = T` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps` UNABBREV_TAC;
+  (* - *)
+  TSPEC `k` 7;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `j` UNABBREV_TAC;
+  TYPE_THEN `k` UNABBREV_TAC;
+  USE 4 (AP_TERM `REP3`);
+  FULL_REWRITE_TAC[ABS3_012];
+  UND 4 THEN ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let k33_rectagon_hyp_false = prove_by_refinement(
+  `!R f. ~k33_rectagon_hyp R f`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`R`;`f`] k33_rectagon_hyp_odd_exist;
+  THM_INTRO_TAC[`R`;`f`;`i`] k33_rectagon_two_even;
+  THM_INTRO_TAC[`i`] three_t_not_sing;
+  COPY 2;
+  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`j`]);
+  TYPE_THEN `j` UNABBREV_TAC;
+  (* - *)
+  THM_INTRO_TAC[`i`;`j`] three_t_not_pair;
+  TSPEC `k` 2;
+  THM_INTRO_TAC[`R`;`f`;`j`] k33_rectagon_two_odd;
+  TSPEC `k` 7;
+  TYPE_THEN `~(f k = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[k33_rectagon_hyp];
+  TSPEC `k` 0;
+  FULL_REWRITE_TAC[psegment_triple];
+  USE 25(REWRITE_RULE[psegment;segment]);
+  TYPE_THEN `f k` UNABBREV_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  THM_INTRO_TAC[`R`;`T`] par_cell_disjoint;
+  FULL_REWRITE_TAC[EQ_EMPTY;INTER ];
+  FULL_REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let k33_graph_edge = prove_by_refinement(
+  `graph_edge (k33_graph) = cartesian UNIV UNIV`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[k33_graph;graph_edge_mk_graph];
+  ]);;
+  (* }}} *)
+
+let k33_graph_vertex = prove_by_refinement(
+  `graph_vertex (k33_graph) = cartesian UNIV UNIV`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[k33_graph;graph_vertex_mk_graph];
+  ]);;
+  (* }}} *)
+
+let k33_graph_inc = prove_by_refinement(
+  `!e v. graph_inc (k33_graph) e v <=> (v = (FST e,T)) \/ (v = (SND e,F))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[k33_graph;graph_inc_mk_graph;INR in_pair ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let cartesian_univ = prove_by_refinement(
+  `!x. cartesian (UNIV:A->bool) (UNIV:B->bool) x`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cartesian;PAIR_SPLIT];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let rectagonal_graph_k33 = prove_by_refinement(
+  `rectagonal_graph k33_graph <=> (?f uA uB.
+     INJ uA UNIV UNIV /\
+     INJ uB UNIV UNIV /\
+     (!(i:three_t#three_t).
+          segment_end (f i) (uA (FST i)) (uB (SND i))) /\
+     (!i j. ~(f i INTER f j = EMPTY) ==> (i = j)) /\
+     (!i j. ~(i = j) ==> (cls (f i) INTER cls (f j) =
+           endpoint (f i) INTER endpoint (f j))))
+     `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[rectagonal_graph];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  (* - *)
+  CONJ_TAC;
+  THM_INTRO_TAC[`H`;`k33_graph`] graph_isomorphic_symm;
+  FULL_REWRITE_TAC[rectagon_graph];
+  KILL 0;
+  FULL_REWRITE_TAC [graph_isomorphic;graph_iso];
+  FULL_REWRITE_TAC[rectagon_graph];
+  FULL_REWRITE_TAC[k33_graph_edge;k33_graph_vertex;k33_graph_inc];
+  KILL 4;
+  TYPE_THEN `v` EXISTS_TAC;
+  TYPE_THEN `uA = (\ i. u (i,T))` ABBREV_TAC ;
+  TYPE_THEN `uB = (\ i. u (i,F))` ABBREV_TAC ;
+  TYPE_THEN  `uA` EXISTS_TAC;
+  TYPE_THEN `uB` EXISTS_TAC;
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[INJ];
+  TYPE_THEN `uA` UNABBREV_TAC;
+  USE 3(REWRITE_RULE[BIJ;INJ]);
+  TYPE_THEN`(x,T) = (y,T)` BACK_TAC;
+  USE 12 (REWRITE_RULE[PAIR_SPLIT]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[cartesian_univ];
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[INJ];
+  TYPE_THEN `uB` UNABBREV_TAC;
+  USE 3(REWRITE_RULE[BIJ;INJ]);
+  TYPE_THEN`(x,F) = (y,F)` BACK_TAC;
+  USE 12 (REWRITE_RULE[PAIR_SPLIT]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[cartesian_univ];
+  (* --A *)
+  TYPE_THEN `!i. graph_edge H (v i)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[BIJ;SURJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[cartesian_univ];
+  FULL_REWRITE_TAC[cartesian_univ];
+  (* -- *)
+  SUBCONJ_TAC;
+  REWRITE_TAC[segment_end];
+  CONJ_TAC;
+  USE 7(REWRITE_RULE[SUBSET]);
+  USE 6 GSYM;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IMAGE;k33_graph_inc;INR in_pair];
+  TYPE_THEN `uA` UNABBREV_TAC;
+  TYPE_THEN `uB` UNABBREV_TAC;
+  NAME_CONFLICT_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `(SND i,F)` EXISTS_TAC;
+  TYPE_THEN `(FST i,T)` EXISTS_TAC;
+  (* --B *)
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 5 THEN DISCH_THEN (THM_INTRO_TAC[`v i`;`v j`]);
+  PROOF_BY_CONTR_TAC;
+  UND 13 THEN REWRITE_TAC[];
+  USE 2 (REWRITE_RULE[BIJ;INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[cartesian_univ];
+  ASM_MESON_TAC[];
+  (* -- *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  DISCH_TAC;
+  UND 12 THEN REWRITE_TAC[];
+  USE 2 (REWRITE_RULE[BIJ;INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[cartesian_univ];
+  (* -C *)
+  TYPE_THEN `?H. rectagon_graph H /\ graph_isomorphic k33_graph H` BACK_TAC;
+  TYPE_THEN `H` EXISTS_TAC;
+  IMATCH_MP_TAC  graph_isomorphic_symm;
+  REWRITE_TAC[k33_isgraph];
+  REWRITE_TAC[rectagon_graph;graph_isomorphic;graph_iso];
+  REWRITE_TAC[k33_graph_vertex;k33_graph_edge];
+  TYPE_THEN `H = mk_graph_t (IMAGE uA UNIV UNION IMAGE uB UNIV ,IMAGE f (cartesian UNIV UNIV), endpoint)` ABBREV_TAC ;
+  TYPE_THEN `H` EXISTS_TAC;
+  TYPE_THEN `graph_edge H = IMAGE f (cartesian UNIV UNIV)` SUBAGOAL_TAC;
+  TYPE_THEN `H` UNABBREV_TAC;
+  REWRITE_TAC[graph_edge_mk_graph];
+  TYPE_THEN `graph_vertex H = IMAGE uA UNIV UNION IMAGE uB UNIV ` SUBAGOAL_TAC;
+  TYPE_THEN `H` UNABBREV_TAC;
+  REWRITE_TAC[graph_vertex_mk_graph];
+  TYPE_THEN `graph_inc H = endpoint` SUBAGOAL_TAC;
+  TYPE_THEN `H` UNABBREV_TAC;
+  REWRITE_TAC[graph_inc_mk_graph];
+  (* - *)
+  REWRITE_TAC[GSYM CONJ_ASSOC];
+  CONJ_TAC;
+  REWRITE_TAC[graph];
+  REWRITE_TAC[SUBSET];
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[UNION];
+  USE 9(REWRITE_RULE[IMAGE]);
+  TYPE_THEN `x'` UNABBREV_TAC;
+  CONJ_TAC;
+  TSPEC `x''` 2;
+  USE 2(REWRITE_RULE[segment_end]);
+  REWR 10;
+  USE 10 (REWRITE_RULE[INR in_pair]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  REWRITE_TAC[IMAGE];
+  MESON_TAC[];
+  REWRITE_TAC[IMAGE];
+  MESON_TAC[];
+  IMATCH_MP_TAC  endpoint_size2;
+  TSPEC `x''` 2;
+  USE 2(REWRITE_RULE[segment_end]);
+  (* -D *)
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;cartesian_univ];
+  USE 2(REWRITE_RULE[segment_end]);
+  (* - *)
+  KILL 5;
+  KILL 6;
+  KILL 7;
+  KILL 8;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[IMAGE;cartesian_univ];
+  PROOF_BY_CONTR_TAC;
+  UND 5 THEN REWRITE_TAC[];
+  AP_TERM_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  (* - *)
+  CONJ_TAC;
+  FULL_REWRITE_TAC[IMAGE;cartesian_univ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  LEFT_TAC "u";
+  TYPE_THEN `u = (\ x. (if (SND x) then (uA (FST x)) else uB(FST x)))` ABBREV_TAC ;
+  TYPE_THEN `u` EXISTS_TAC;
+  LEFT_TAC "v";
+  TYPE_THEN `f` EXISTS_TAC;
+  TYPE_THEN `(u,f)` EXISTS_TAC;
+  (* -E *)
+  TYPE_THEN `!i j. ~(uA i = uB j)` SUBAGOAL_TAC;
+  TSPEC `(i,j)` 2;
+  USE 2(MATCH_MP segment_end_disj);
+  UND 2 THEN ASM_REWRITE_TAC[];
+  (* - *)
+  SUBCONJ_TAC;
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ;cartesian_univ];
+  CONJ_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  COND_CASES_TAC;
+  REWRITE_TAC[IMAGE;UNION];
+  MESON_TAC[];
+  REWRITE_TAC[IMAGE;UNION];
+  MESON_TAC[];
+  REWRITE_TAC[PAIR_SPLIT];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  (* ---// *)
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `!x y. (uA (x) = uA (y)) ==> (x = y)` SUBAGOAL_TAC;
+  USE 4 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `!x y. (uB (x) = uB (y)) ==> (x = y)` SUBAGOAL_TAC;
+  USE 3 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 8 THEN REWRITE_TAC[DE_MORGAN_THM];
+  KILL 0 THEN KILL 1 THEN KILL 2;
+  UND 7 THEN  COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_MESON_TAC[];
+  (* -- *)
+  REWRITE_TAC[SURJ];
+  CONJ_TAC;
+  USE 7(REWRITE_RULE[INJ]);
+  REWRITE_TAC[cartesian_univ];
+  TYPE_THEN `u` UNABBREV_TAC;
+  USE 8 (REWRITE_RULE[UNION]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  USE 8(REWRITE_RULE[IMAGE]);
+  TYPE_THEN `(x',T)` EXISTS_TAC;
+  USE 8(REWRITE_RULE[IMAGE]);
+  TYPE_THEN `(x',F)` EXISTS_TAC;
+  (* -F *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_bij;
+  REWRITE_TAC[INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `f x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INTER_IDEMPOT];
+  TSPEC `y` 2;
+  FULL_REWRITE_TAC[segment_end;psegment;segment];
+  ASM_MESON_TAC[];
+  (* - *)
+  TSPEC `e` 2;
+  FULL_REWRITE_TAC[segment_end];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR in_pair;IMAGE;k33_graph_inc];
+  NAME_CONFLICT_TAC;
+  THM_INTRO_TAC[`u`;`cartesian (UNIV:three_t->bool) (UNIV:bool->bool)`;`(IMAGE uA UNIV UNION IMAGE uB UNIV)`] bij_imp_image;
+  USE 10 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USE 10 (REWRITE_RULE[IMAGE ;cartesian_univ;UNION]);
+  USE 10 (CONV_RULE (NAME_CONFLICT_CONV));
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TSPEC `uB (SND e)` 10;
+  USE 10 (MATCH_MP (TAUT `(a <=> (b \/ c)) ==> (c ==> a)`));
+  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  MESON_TAC[];
+  TYPE_THEN`(SND e,F)` EXISTS_TAC;
+  TYPE_THEN `u x'` UNABBREV_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  (* -- *)
+  TYPE_THEN `x` UNABBREV_TAC;
+  TSPEC `uA (FST  e)` 10;
+  USE 10 (MATCH_MP (TAUT `(a <=> (b \/ c)) ==> (b ==> a)`));
+  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  MESON_TAC[];
+  TYPE_THEN`(FST  e,T)` EXISTS_TAC;
+  TYPE_THEN `u x'` UNABBREV_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  (* - *)
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  ]);;
+  (* }}} *)
+
+let eq_exchange = prove_by_refinement(
+  `!x a (b:A). (x = a) /\ (x = b) <=> (x = a) /\ (a = b)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let rectagon_graph_k33_false = prove_by_refinement(
+  `~(rectagonal_graph k33_graph)`,
+  (* {{{ proof *)
+  [
+  DISCH_TAC;
+  FULL_REWRITE_TAC[rectagonal_graph_k33];
+  ASSUME_TAC k33_rectagon_hyp_false;
+  LEFT 5 "f";
+  TYPE_THEN `diag  = (\ (i:three_t). f (i,i))` ABBREV_TAC ;
+  TYPE_THEN `!i. diag i = f(i,i)` SUBAGOAL_TAC;
+  TYPE_THEN `diag` UNABBREV_TAC;
+  KILL 6;
+  TSPEC `diag` 5;
+  RIGHT 5 "R";
+  UND 5 THEN REWRITE_TAC[];
+  REWRITE_TAC[k33_rectagon_hyp];
+  TYPE_THEN `R = UNIONS { e | (?i j. ~(i = j) /\ (e = f (i,j)) ) }` ABBREV_TAC ;
+  TYPE_THEN  `R` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `!i j. ~(uA i = uB j)` SUBAGOAL_TAC;
+  TSPEC `i,j` 2;
+  USE 2(MATCH_MP segment_end_disj);
+  REWR 2;
+  (* - *)
+  TYPE_THEN `!i j. (uA i = uA j) <=> (i = j)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM ;
+  USE 4 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  TYPE_THEN `!i j. (uB i = uB j) <=> (i = j)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM ;
+  USE 3 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* -A *)
+  TYPE_THEN `(!i j. ~(i = j) ==> (cls (f (i,i)) INTER cls (f (j,j)) = {}))` SUBAGOAL_TAC;
+  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(i,i)`;`j,j`]);
+  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
+  ASM_MESON_TAC[];
+  COPY 2;
+  TSPEC `i,i` 11;
+  TSPEC `j,j` 2;
+  FULL_REWRITE_TAC[segment_end];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR in_pair];
+  FIRST_ASSUM DISJ_CASES_TAC THEN (TYPE_THEN `x` UNABBREV_TAC);
+  REWR 15;
+  REWR 15;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `(!i j. ~(i = j) ==> (f (i,i) INTER f (j,j) = {}))` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 11 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `(i,i) = (j,j)` BACK_TAC;
+  USE 11(REWRITE_RULE[PAIR_SPLIT]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  LEFT_TAC "i";
+  (* -B start main reduction *)
+  TYPE_THEN `?A. (cls (A T) INTER cls (A F) SUBSET endpoint (f (i,i))) /\ (A T INTER A F = EMPTY ) /\ (A T UNION A F = R) /\ (!eps. psegment (A eps)) /\ (!j eps. ~(cls (f (j,j)) INTER cls (A eps) = EMPTY)) /\ (!eps. A eps INTER (f (i,i)) = EMPTY) /\ (!eps. endpoint (A eps) = endpoint (f(i,i))) /\ (!eps. (cls (A eps) INTER cls (f(i,i)) = endpoint (f(i,i))))` BACK_TAC;
+  LEFT_TAC "A";
+  LEFT_TAC "B";
+  TYPE_THEN `A T` EXISTS_TAC;
+  TYPE_THEN `A F` EXISTS_TAC;
+  TYPE_THEN `(!j. ~(i = j) ==> (cls (f (j,j)) INTER cls (A T) INTER cls (A F) = {}))` SUBAGOAL_TAC;
+  REWRITE_TAC[GSYM SUBSET_EMPTY];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `cls (f (j,j)) INTER cls(f (i,i))` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_EMPTY];
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  ASM_REWRITE_TAC[SUBSET_REFL];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `endpoint (f (i,i))` EXISTS_TAC;
+  IMATCH_MP_TAC  endpoint_cls;
+  USE 2(REWRITE_RULE[segment_end;psegment;segment]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `j` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  SUBCONJ_TAC;
+  ASM_REWRITE_TAC[psegment_triple];
+  TYPE_THEN `cls (A T) INTER cls (A F) = endpoint (f (i,i))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM ;
+  COPY 13;
+  TSPEC `T` 21;
+  TSPEC `F` 13;
+  REWRITE_TAC[SUBSET_INTER];
+  TYPE_THEN `FINITE (f(i,i))` SUBAGOAL_TAC;
+  USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
+  CONJ_TAC;
+  USE 21 SYM;
+  IMATCH_MP_TAC  endpoint_cls;
+  USE 16(REWRITE_RULE[psegment;segment]);
+  USE 13 SYM;
+  IMATCH_MP_TAC  endpoint_cls;
+  USE 16(REWRITE_RULE[psegment;segment]);
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[segment_end];
+  (* ---C *)
+  TYPE_THEN `endpoint (f (i,i)) = {(uA (i)), (uB(i))}` SUBAGOAL_TAC;
+  USE 2 (REWRITE_RULE[segment_end]);
+  CONJ_TAC;
+  TYPE_THEN `R` UNABBREV_TAC;
+  USE 5 SYM;
+  IMATCH_MP_TAC  segment_end_union_rectagon;
+  TYPE_THEN `uA i` EXISTS_TAC;
+  TYPE_THEN `uB i` EXISTS_TAC;
+  ASM_REWRITE_TAC[segment_end];
+  (* --- *)
+  CONJ_TAC THEN IMATCH_MP_TAC  segment_end_union_rectagon THEN   TYPE_THEN `uA i` EXISTS_TAC THEN TYPE_THEN `uB i` EXISTS_TAC THEN ASM_REWRITE_TAC[segment_end];
+  (* -- *)
+  FULL_REWRITE_TAC[psegment_triple];
+  KILL 5;
+  TYPE_THEN `R` UNABBREV_TAC;
+  (* -D *)
+  THM_INTRO_TAC[`i`] bool_three_delete_bij;
+  TYPE_THEN `!e. ~(b e = i)` SUBAGOAL_TAC;
+  USE 12(REWRITE_RULE[BIJ;SURJ;DELETE ]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `!e e'. (b e = b e') <=> (e = e')` SUBAGOAL_TAC;
+  USE 12 (REWRITE_RULE[BIJ;INJ]);
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `!j. ~(j = i) ==> (?e. (j = b e))` SUBAGOAL_TAC;
+  USE 12(REWRITE_RULE[BIJ;SURJ]);
+  USE 12 (GSYM);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[DELETE];
+  TYPE_THEN `j` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `A = (\ (e: bool). f(i, b e) UNION f (b (~e),b e) UNION f (b(~e),i))` ABBREV_TAC ;
+  TYPE_THEN `A` EXISTS_TAC;
+  (* - now satisfy constraints *)
+  TYPE_THEN `(!eps. A eps INTER f (i,i) = {})` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  REPEAT CONJ_TAC THEN PROOF_BY_CONTR_TAC THEN (UND 1 THEN DISCH_THEN (fun t -> RULE_ASSUM_TAC  (REWRITE_RULE[PAIR_SPLIT] o (TRY_RULE (MATCH_MP t)))))  THEN ASM_MESON_TAC[];
+  (* -E *)
+  TYPE_THEN `(!eps. cls (A eps) INTER cls (f (i,i)) = endpoint (f (i,i)))` SUBAGOAL_TAC ;
+  TYPE_THEN `A` UNABBREV_TAC;
+  ONCE_REWRITE_TAC[INTER_COMM];
+  FULL_REWRITE_TAC[UNION_OVER_INTER;cls_union];
+  COPY 0;
+  UND 0 THEN DISCH_THEN(  THM_INTRO_TAC[`(i,i)`;`(i, b eps)`]);
+  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
+  ASM_MESON_TAC[];
+  COPY 16;
+  UND 16 THEN DISCH_THEN(  THM_INTRO_TAC[`(i,i)`;`(b (~eps),i)`]);
+  USE 16 (REWRITE_RULE[PAIR_SPLIT]);
+  ASM_MESON_TAC[];
+  COPY 18;
+  UND 18 THEN DISCH_THEN(  THM_INTRO_TAC[`(i,i)`;`(b (~eps),b eps)`]);
+  USE 18 (REWRITE_RULE[PAIR_SPLIT]);
+  ASM_MESON_TAC[];
+  REWRITE_TAC[GSYM UNION_OVER_INTER];
+  REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] SUBSET_INTER_ABSORPTION];
+  USE 2 (REWRITE_RULE[segment_end]);
+  REWRITE_TAC[SUBSET;UNION;INR in_pair  ];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  (* - *)
+  TYPE_THEN `(!j eps. ~(cls (f (j,j)) INTER cls (A eps) = {}))` SUBAGOAL_TAC;
+  TYPE_THEN `j = i` ASM_CASES_TAC;
+  TYPE_THEN `i` UNABBREV_TAC;
+  USE 19 (ONCE_REWRITE_RULE[INTER_COMM]);
+  TSPEC  `eps` 18;
+  REWR 19;
+  TSPEC `(j,j)` 2;
+  FULL_REWRITE_TAC[segment_end];
+  REWR 2;
+  USE 2 SYM;
+  USE 2(REWRITE_RULE[EQ_EMPTY;INR in_pair]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `A` UNABBREV_TAC;
+  FULL_REWRITE_TAC[cls_union];
+  FULL_REWRITE_TAC[UNION_OVER_INTER;EMPTY_UNION];
+  UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`j`]);
+  TYPE_THEN `j` UNABBREV_TAC;
+  TYPE_THEN `j` UNABBREV_TAC;
+  TYPE_THEN `(e = eps) \/ (e = ~eps)` SUBAGOAL_TAC;
+  MESON_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(b eps,b eps)`;`(i,b eps)`] );
+  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
+  TYPE_THEN `i` UNABBREV_TAC;
+  REWR 21;
+  UND 21 THEN REWRITE_TAC[EMPTY_EXISTS ];
+  REWRITE_TAC[INTER];
+  FULL_REWRITE_TAC[segment_end;INR in_pair];
+  FULL_REWRITE_TAC[segment_end;INR in_pair];
+  TYPE_THEN `uB (b eps)` EXISTS_TAC;
+  (* -- *)
+    TYPE_THEN `e` UNABBREV_TAC;
+  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(b (~eps),b (~eps))`;`(b (~eps),i)`] );
+  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
+  TYPE_THEN `i` UNABBREV_TAC;
+  REWR 16;
+  UND 16 THEN REWRITE_TAC[EMPTY_EXISTS ];
+  REWRITE_TAC[INTER];
+  FULL_REWRITE_TAC[segment_end;INR in_pair];
+  FULL_REWRITE_TAC[segment_end;INR in_pair];
+  TYPE_THEN `uA (b (~eps))` EXISTS_TAC;
+  (* -F *)
+  TYPE_THEN `A T INTER A F = EMPTY ` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[UNION_OVER_INTER];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[EMPTY_UNION];
+  TYPE_THEN `!i j. (f i INTER f j = EMPTY) <=> ~( i = j)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `i'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INTER_IDEMPOT];
+  TSPEC `j` 2;
+  TYPE_THEN `f j` UNABBREV_TAC;
+  FULL_REWRITE_TAC[segment_end;psegment;segment];
+  PROOF_BY_CONTR_TAC;
+  UND 16 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[PAIR_SPLIT];
+  (* - *)
+  TYPE_THEN `A T UNION A F = R` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `R` UNABBREV_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION;UNIONS];
+  CONV_TAC (dropq_conv "u");
+  UND 5 THEN REP_CASES_TAC THEN UNIFY_EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION;UNIONS];
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `!i'. (i' = i) \/ (i' = b T) \/ (i' = b F)` SUBAGOAL_TAC;
+  TYPE_THEN`i'' = i` ASM_CASES_TAC;
+  UND 15 THEN DISCH_THEN (  THM_INTRO_TAC[`i''`]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `e = T` ASM_CASES_TAC;
+  MESON_TAC[];
+  MESON_TAC[];
+  COPY 16;
+  TSPEC `i'` 16;
+  TSPEC `j` 22;
+  JOIN 16 22 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
+  UND 16 THEN REP_CASES_TAC THEN REWR 5 ;
+  TYPE_THEN `j` UNABBREV_TAC;
+  TYPE_THEN `i'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `j` UNABBREV_TAC;
+  TYPE_THEN `i'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `j` UNABBREV_TAC;
+  TYPE_THEN `i'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  (* -G *)
+  SUBCONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[cls_union];
+  REWRITE_TAC[UNION_OVER_INTER];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[union_subset];
+  USE 2(REWRITE_RULE[segment_end]);
+  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
+  ASM_SIMP_TAC[];
+  REWRITE_TAC[INTER;SUBSET;INR in_pair];
+  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
+  ONCE_REWRITE_TAC[eq_exchange];
+  ASM_REWRITE_TAC[];
+  (* -H *)
+  KILL 21;
+  KILL 20;
+  KILL 17;
+  KILL 19;
+  KILL 18;
+  TYPE_THEN `!eps. segment_end (A eps) (uA i) (uB i)` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  THM_INTRO_TAC[`f (b (~eps),i)`;`f (b (~eps),b eps)`;`uB i`;`uA(b (~eps))`;`uB(b eps)`] segment_end_union;
+  CONJ_TAC;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  TSPEC `(b (~eps),i)` 2;
+  REWR 2;
+  CONJ_TAC;
+  TSPEC `(b (~eps),b eps)` 2;
+  REWR 2;
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`(b (~eps),i)`;`(b (~eps),b eps)`]);
+  USE 0(REWRITE_RULE[PAIR_SPLIT]);
+  ASM_MESON_TAC[];
+  USE 2(REWRITE_RULE[segment_end]);
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;INR in_pair;INR IN_SING;];
+  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
+  ONCE_REWRITE_TAC[eq_exchange];
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`f (i,b eps)`;`f (b (~eps),i) UNION f (b (~eps),b eps)`;`uA i`;`uB (b eps)`;`uB i`] segment_end_union;
+  CONJ_TAC;
+  TSPEC `(i,b eps)` 2;
+  REWR 2;
+  CONJ_TAC;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  REWRITE_TAC[cls_union];
+  COPY 0;
+  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`(i,b eps)`;`b (~eps),i`]);
+  USE 0 (REWRITE_RULE[PAIR_SPLIT]);
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[UNION_OVER_INTER];
+  UND 17 THEN DISCH_THEN (  THM_INTRO_TAC[`(i,b eps)`;`b (~eps),(b eps)`]);
+  USE 17 (REWRITE_RULE[PAIR_SPLIT]);
+  ASM_MESON_TAC[];
+  USE 2(REWRITE_RULE[segment_end]);
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;UNION;INR in_pair;INR IN_SING;];
+  REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
+  ONCE_REWRITE_TAC[eq_exchange];
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[UNION_COMM];
+  (* - *)
+  USE 17(REWRITE_RULE[segment_end]);
+  USE 2 (REWRITE_RULE[segment_end]);
+  ]);;
+  (* }}} *)
+
+(* --- *)
+
+
+(* ------------------------------------------------------------------ *)
+(* SECTION X *)
+(* ------------------------------------------------------------------ *)
+
+
+(* Continue from SECTION Q.
+   1.0.2 Rational approximation.  *)
+
+(* work out homeo on graph_support_set properties *)
+(* apply h_translate (-- &1) o r_scale (&1/z) *)
+
+
+(* Let's go back and do it in a symmetric way for both cases. *)
+
+let eps_translate_def = jordan_def `eps_translate eps  =
+  if eps then h_translate else v_translate`;;
+
+let eps_translate = prove_by_refinement(
+  `!eps r. eps_translate eps r = if eps then h_translate r else
+     v_translate r`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[eps_translate_def];
+  COND_CASES_TAC;
+  ]);;
+  (* }}} *)
+
+let homeomorphism_eps_translate = prove_by_refinement(
+  `!eps r. homeomorphism (eps_translate eps r) top2 top2`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[eps_translate];
+  COND_CASES_TAC THEN REWRITE_TAC[h_translate_hom;v_translate_hom];
+  ]);;
+  (* }}} *)
+
+let eps_hyper = jordan_def `eps_hyper eps z =
+  if eps then hyperplane 2 e1 z else hyperplane 2 e2 z`;;
+
+let eps_hyper_translate = prove_by_refinement(
+  `!eps r z. IMAGE (eps_translate eps r) (eps_hyper eps z) =
+         (eps_hyper eps (z + r)) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[eps_translate;eps_hyper];
+  COND_CASES_TAC THEN REWRITE_TAC[hyperplane1_h_translate;hyperplane2_v_translate];
+  ]);;
+  (* }}} *)
+
+let eps_hyper_translate_perp = prove_by_refinement(
+  `!eps r z. IMAGE (eps_translate eps r) (eps_hyper (~eps) z) =
+         (eps_hyper (~eps) z) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[eps_translate;eps_hyper];
+  COND_CASES_TAC THEN REWRITE_TAC[hyperplane2_h_translate;hyperplane1_v_translate];
+  ]);;
+  (* }}} *)
+
+let eps_scale = jordan_def `eps_scale eps r =
+  if eps then r_scale r else u_scale r`;;
+
+let eps_hyper_scale_perp = prove_by_refinement(
+  `!eps r z. (&0 < r) ==>
+         (IMAGE (eps_scale eps r) (eps_hyper (~eps) z) =
+            (eps_hyper (~eps) z)) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[eps_scale;eps_hyper];
+  COND_CASES_TAC THEN ASM_SIMP_TAC[hyperplane1_u_scale;hyperplane2_r_scale];
+  ]);;
+  (* }}} *)
+
+let eps_hyper_scale = prove_by_refinement(
+  `!eps r z. (&0 < r) ==>
+         (IMAGE (eps_scale eps r) (eps_hyper (eps) z) =
+            (eps_hyper (eps) (if (&0 < z) then r*z else z))) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[eps_scale;eps_hyper];
+  COND_CASES_TAC THEN ASM_SIMP_TAC[hyperplane2_u_scale;hyperplane1_r_scale];
+  ]);;
+  (* }}} *)
+
+let homeomorphism_eps_scale = prove_by_refinement(
+  `!eps r. (&0 < r) ==> homeomorphism (eps_scale eps r) top2 top2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[eps_scale];
+  COND_CASES_TAC THEN ASM_SIMP_TAC [u_scale_hom;r_scale_hom];
+  ]);;
+  (* }}} *)
+
+let graph_support_eps = jordan_def `graph_support_eps G E <=>
+  good_plane_graph G /\  FINITE E /\
+  (!e. (graph_edge G e ==> e SUBSET UNIONS E)) /\
+  (!v. (graph_vertex G v ==>
+         E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)))) /\
+  (!e. (E e ==> (?z eps. (e = eps_hyper eps z)))) /\
+  (!z eps. (z <= &0 /\ E (eps_hyper eps z) ==> (?j. z = -- &j)))`;;
+
+let iso_support_eps_pair = jordan_def
+ `iso_support_eps_pair (G:(A,B)graph_t) =
+  { (H,E) | (graph_isomorphic G H) /\  graph_support_eps H E }`;;
+
+let eps_hyper_ne = prove_by_refinement(
+  `!z z' eps. ~(eps_hyper eps z = eps_hyper (~eps) z')`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[eps_hyper];
+  UND 0 THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[hyperplane_ne;GSYM hyperplane_ne] ;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let eps_hyper_inj = prove_by_refinement(
+  `!z z' eps eps'. (eps_hyper eps z = eps_hyper eps' z') <=>
+     ((eps = eps') /\ (z = z'))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN`eps' = ~eps` ASM_CASES_TAC;
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  REWRITE_TAC [eps_hyper_ne];
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  REWRITE_TAC[eps_hyper];
+  COND_CASES_TAC THEN IMATCH_MP_TAC  EQ_ANTISYM THEN CONJ_TAC;
+  IMATCH_MP_TAC  hyperplane1_inj;
+  IMATCH_MP_TAC  hyperplane2_inj;
+  ]);;
+  (* }}} *)
+
+let iso_support_eps_nonempty = prove_by_refinement(
+  `!(G:(A,B)graph_t). (planar_graph G) /\
+         FINITE (graph_edge G) /\
+         FINITE (graph_vertex G) /\
+         ~(graph_edge G = {}) /\
+         (!v. CARD (graph_edge_around G v) <=| 4) ==>
+     ~(iso_support_eps_pair G = EMPTY) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[iso_support_eps_pair];
+  TH_INTRO_TAC [`G`] graph_support_init;
+  UND 0 THEN REWRITE_TAC[EMPTY_EXISTS];
+  CONV_TAC (dropq_conv "u");
+  REWRITE_TAC[graph_support_eps];
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  CONJ_TAC;
+  REWRITE_TAC[eps_hyper];
+  (* - *)
+  TYPE_THEN `(!e. E e ==> (?z eps. (&0 < z) /\ (e = eps_hyper eps z)))` SUBAGOAL_TAC;
+  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`e`]);
+  FIRST_ASSUM DISJ_CASES_TAC  ;
+  TYPE_THEN`z` EXISTS_TAC;
+  TYPE_THEN `T` EXISTS_TAC;
+  REWRITE_TAC[eps_hyper];
+  TYPE_THEN`z` EXISTS_TAC;
+  TYPE_THEN `F` EXISTS_TAC;
+  REWRITE_TAC[eps_hyper];
+  (* - *)
+  CONJ_TAC;
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`e`]);
+  MESON_TAC[];
+  (* - *)
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`eps_hyper eps z`]);
+  FULL_REWRITE_TAC[eps_hyper_inj];
+  TYPE_THEN `z'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 14 THEN UND 13 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let count_iso_eps_pair = jordan_def
+  `count_iso_eps_pair ((H:(A,B)graph_t),E) =
+   CARD { e | (?z eps. (&0 < z) /\ E e /\  (e  = eps_hyper eps z)) }`;;
+
+let iso_support_eps_finite = prove_by_refinement(
+  `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) ==> FINITE
+   { e | (?z eps. (&0 < z) /\ E e /\  (e  = eps_hyper eps z)) }`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[iso_support_eps_pair ;PAIR_SPLIT; graph_support_eps;];
+  TYPE_THEN `E'` UNABBREV_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[SUBSET];
+  ]);;
+  (* }}} *)
+
+let iso_eps_support0 = prove_by_refinement(
+  `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) /\
+   (count_iso_eps_pair (H,E) = 0) ==>
+  good_plane_graph H /\  FINITE E /\
+  (!e. (graph_edge H e ==> e SUBSET UNIONS E)) /\
+  (!v. (graph_vertex H v ==>
+         E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)))) /\
+  (!e. (E e ==> (?z eps. (e = eps_hyper eps z) ))) /\
+  (!z eps. (E (eps_hyper eps z) ==> (?j. z = -- &j)))
+    `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[count_iso_eps_pair;];
+  TYPE_THEN `A = { e | (?z eps. (&0 < z) /\ E e /\  (e  =  eps_hyper eps z)) }` ABBREV_TAC ;
+  TYPE_THEN `A HAS_SIZE 0` SUBAGOAL_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  TYPE_THEN `A` UNABBREV_TAC;
+  TH_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_finite;
+  RULE_ASSUM_TAC (REWRITE_RULE[PAIR_SPLIT;graph_support_eps;iso_support_eps_pair]);
+  TYPE_THEN `E'` UNABBREV_TAC;
+  TYPE_THEN `H'` UNABBREV_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN`eps` EXISTS_TAC;
+  FULL_REWRITE_TAC[HAS_SIZE_0];
+  TYPE_THEN `A` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 2 (MATCH_MP (REAL_ARITH `~( z <= &0) ==> (&0 < z)`));
+  UND 3 THEN REWRITE_TAC[EMPTY_EXISTS];
+  CONV_TAC (dropq_conv "u");
+  UNIFY_EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+let iso_support_eps_min = prove_by_refinement(
+  `!(G:(A,B)graph_t) H E. iso_support_eps_pair G (H,E) /\
+    (0 < count_iso_eps_pair (H,E)) ==>
+    (?z eps. (&0 < z) /\ E (eps_hyper eps z) /\
+      (!w. (&0 < w /\ w < z) ==> ~(E (eps_hyper eps w))))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[count_iso_eps_pair];
+  TYPE_THEN `A = {e | ?z eps. &0 < z /\ E e /\ (e = eps_hyper eps z)}` ABBREV_TAC ;
+  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
+  TH_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_finite;
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `~(A HAS_SIZE 0) ` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE]);
+  UND 4 THEN UND 0 THEN ARITH_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[HAS_SIZE_0;EMPTY_EXISTS]);
+  TYPE_THEN `?r eps. (u = eps_hyper eps r)` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  MESON_TAC[];
+  TYPE_THEN `u` UNABBREV_TAC;
+  (* - *)
+  TH_INTRO_TAC[`{z | &0 < z}`;`eps_hyper eps`;`{e | ?z. (&0 < z) /\ E e /\ (e = eps_hyper eps z)}`] finite_subset;
+  REWRITE_TAC[SUBSET;IMAGE];
+  CONJ_TAC;
+  TYPE_THEN `z` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `~(C = EMPTY)` SUBAGOAL_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[IMAGE_CLAUSES;SUBSET_EMPTY]);
+  UND 5 THEN REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `A` UNABBREV_TAC;
+  UNIFY_EXISTS_TAC;
+  FULL_REWRITE_TAC[eps_hyper_inj];
+  TYPE_THEN `inf C` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `C (inf C)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  finite_inf;
+  (* - *)
+  TYPE_THEN `(!z. C z ==> inf C <= z)` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  finite_inf_min;ALL_TAC ];
+  TYPE_THEN `z = inf C` ABBREV_TAC ;
+  KILL 11;
+  KILL 8;
+  (* - *)
+  TYPE_THEN `eps` EXISTS_TAC;
+  USE 5(REWRITE_RULE[IMAGE]);
+  USE 5(ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  COPY 5;
+  TSPEC `eps_hyper eps z` 5;
+  USE 5(REWRITE_RULE[INR IN_SING]);
+  USE 5(MATCH_MP (TAUT `(a <=> b) ==> (b ==> a)`));
+  UND 5 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[eps_hyper_inj];
+  TYPE_THEN `z'` UNABBREV_TAC;
+  REP_BASIC_TAC;
+  (* - *)
+  TSPEC `eps_hyper eps w` 8;
+  USE 8(MATCH_MP (TAUT `(a <=> b) ==> (a ==> b)`));
+  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  TYPE_THEN `w` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[eps_hyper_inj];
+  TYPE_THEN `x` UNABBREV_TAC;
+  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`w`]);
+  UND 8 THEN UND 13 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let graph_eps_scale_image = prove_by_refinement(
+  `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> graph_support_eps
+       (plane_graph_image (eps_scale eps r)G)
+       (IMAGE2 (eps_scale eps r) E)
+          `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_support_eps];
+  THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_scale;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  plane_graph_image_plane;
+  (* - *)
+  REWRITE_TAC[plane_graph_image_e;plane_graph_image_v];
+  SUBCONJ_TAC;
+  REWRITE_TAC[IMAGE2];
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  (* - *)
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
+  USE 10 (REWRITE_RULE[IMAGE]);
+  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  FULL_REWRITE_TAC [SUBSET;UNIONS];
+  REWRITE_TAC[IMAGE];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `im` UNABBREV_TAC;
+  USE 3(CONV_RULE NAME_CONFLICT_CONV);
+  USE 13 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TSPEC `x''` 3;
+  REP_BASIC_TAC;
+  TYPE_THEN `u'` EXISTS_TAC;
+  REWRITE_TAC[IMAGE];
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -A *)
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `im` UNABBREV_TAC;
+  USE 11(REWRITE_RULE[IMAGE]);
+  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  CONJ_TAC;
+  UNIFY_EXISTS_TAC;
+  (* ? *)
+  TYPE_THEN `eps = T` ASM_CASES_TAC;
+  ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
+  REWRITE_TAC[eps_scale;r_scale];
+  COND_CASES_TAC;
+  TYPE_THEN `eps = F` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps` UNABBREV_TAC;
+  THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_scale_perp;
+  AP_TERM_TAC;
+  REWRITE_TAC[eps_scale;u_scale];
+  COND_CASES_TAC;
+  (* -- *)
+  TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC;
+  TYPE_THEN `eps = F` ASM_CASES_TAC;
+  ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
+  REWRITE_TAC[eps_scale;u_scale];
+  COND_CASES_TAC;
+  TYPE_THEN `eps = T` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps` UNABBREV_TAC;
+  THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_scale_perp;
+  AP_TERM_TAC;
+  REWRITE_TAC[eps_scale;r_scale];
+  COND_CASES_TAC;
+  (* -B *)
+  CONJ_TAC;
+  USE 12(REWRITE_RULE[IMAGE2]);
+  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
+  USE 12(REWRITE_RULE[IMAGE]);
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  TYPE_THEN `im` UNABBREV_TAC;
+  LEFT_TAC  "eps''";
+  TYPE_THEN `eps'` EXISTS_TAC;
+  TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
+  ASM_SIMP_TAC [eps_hyper_scale_perp];
+  MESON_TAC[];
+  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
+  UND 13 THEN MESON_TAC[];
+  ASM_SIMP_TAC[eps_hyper_scale];
+  MESON_TAC[];
+  (* - *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `eps'` EXISTS_TAC;
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
+  USE 12 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `im` UNABBREV_TAC;
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  REWR 12;
+  TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC;
+  UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale_perp];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  TYPE_THEN `eps'' = eps` SUBAGOAL_TAC;
+  UND 14 THEN MESON_TAC[];
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale];
+  FULL_REWRITE_TAC[eps_hyper_inj];
+  UND 12 THEN COND_CASES_TAC;
+  TYPE_THEN `z` UNABBREV_TAC;
+  TYPE_THEN `&0 < r * z'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  PROOF_BY_CONTR_TAC;
+  UND 12 THEN UND 13 THEN REAL_ARITH_TAC;
+  TYPE_THEN `z'` UNABBREV_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  ]);;
+  (* }}} *)
+
+let graph_eps_scale_image = prove_by_refinement(
+  `!G E eps r. (&0 < r) /\ graph_support_eps G E ==> graph_support_eps
+       (plane_graph_image (eps_scale eps r)G)
+       (IMAGE2 (eps_scale eps r) E)
+          `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_support_eps];
+  THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_scale;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  plane_graph_image_plane;
+  (* - *)
+  REWRITE_TAC[plane_graph_image_e;plane_graph_image_v];
+  SUBCONJ_TAC;
+  REWRITE_TAC[IMAGE2];
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  (* - *)
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
+  USE 10 (REWRITE_RULE[IMAGE]);
+  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  FULL_REWRITE_TAC [SUBSET;UNIONS];
+  REWRITE_TAC[IMAGE];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `im` UNABBREV_TAC;
+  USE 3(CONV_RULE NAME_CONFLICT_CONV);
+  USE 13 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TSPEC `x''` 3;
+  REP_BASIC_TAC;
+  TYPE_THEN `u'` EXISTS_TAC;
+  REWRITE_TAC[IMAGE];
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -A *)
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `im` UNABBREV_TAC;
+  USE 11(REWRITE_RULE[IMAGE]);
+  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  CONJ_TAC;
+  UNIFY_EXISTS_TAC;
+  (* ? *)
+  TYPE_THEN `eps = T` ASM_CASES_TAC;
+  ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
+  REWRITE_TAC[eps_scale;r_scale];
+  COND_CASES_TAC;
+  TYPE_THEN `eps = F` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps` UNABBREV_TAC;
+  THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_scale_perp;
+  AP_TERM_TAC;
+  REWRITE_TAC[eps_scale;u_scale];
+  COND_CASES_TAC;
+  (* -- *)
+  TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC;
+  TYPE_THEN `eps = F` ASM_CASES_TAC;
+  ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
+  REWRITE_TAC[eps_scale;u_scale];
+  COND_CASES_TAC;
+  TYPE_THEN `eps = T` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps` UNABBREV_TAC;
+  THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_scale_perp;
+  AP_TERM_TAC;
+  REWRITE_TAC[eps_scale;r_scale];
+  COND_CASES_TAC;
+  (* -B *)
+  CONJ_TAC;
+  USE 12(REWRITE_RULE[IMAGE2]);
+  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
+  USE 12(REWRITE_RULE[IMAGE]);
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  TYPE_THEN `im` UNABBREV_TAC;
+  LEFT_TAC  "eps''";
+  TYPE_THEN `eps'` EXISTS_TAC;
+  TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
+  ASM_SIMP_TAC [eps_hyper_scale_perp];
+  MESON_TAC[];
+  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
+  UND 13 THEN MESON_TAC[];
+  ASM_SIMP_TAC[eps_hyper_scale];
+  MESON_TAC[];
+  (* - *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `eps'` EXISTS_TAC;
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN   `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
+  USE 12 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `im` UNABBREV_TAC;
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  REWR 12;
+  TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC;
+  UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale_perp];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  TYPE_THEN `eps'' = eps` SUBAGOAL_TAC;
+  UND 14 THEN MESON_TAC[];
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  UND 12 THEN ASM_SIMP_TAC[eps_hyper_scale];
+  FULL_REWRITE_TAC[eps_hyper_inj];
+  UND 12 THEN COND_CASES_TAC;
+  TYPE_THEN `z` UNABBREV_TAC;
+  TYPE_THEN `&0 < r * z'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  PROOF_BY_CONTR_TAC;
+  UND 12 THEN UND 13 THEN REAL_ARITH_TAC;
+  TYPE_THEN `z'` UNABBREV_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  ]);;
+  (* }}} *)
+
+let graph_eps_translate_image = prove_by_refinement(
+  `!G E eps r.  (?j.  -- &j = r) /\
+      (!w. (&0 < w /\ w < -- r) ==> ~(E (eps_hyper eps w)))  /\
+       graph_support_eps G E ==>
+       graph_support_eps
+       (plane_graph_image (eps_translate eps r)G)
+       (IMAGE2 (eps_translate eps r) E)
+          `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[graph_support_eps];
+  THM_INTRO_TAC[`eps`;`r`] homeomorphism_eps_translate;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  plane_graph_image_plane;
+  (* - *)
+  REWRITE_TAC[plane_graph_image_e;plane_graph_image_v];
+  SUBCONJ_TAC;
+  REWRITE_TAC[IMAGE2];
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  (* - *)
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
+  USE 11 (REWRITE_RULE[IMAGE]);
+  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  FULL_REWRITE_TAC [SUBSET;UNIONS];
+  REWRITE_TAC[IMAGE];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `im` UNABBREV_TAC;
+  USE 3(CONV_RULE NAME_CONFLICT_CONV);
+  USE 14 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TSPEC `x''` 3;
+  REP_BASIC_TAC;
+  TYPE_THEN `u'` EXISTS_TAC;
+  REWRITE_TAC[IMAGE];
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -A *)
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `im` UNABBREV_TAC;
+  USE 12(REWRITE_RULE[IMAGE]);
+  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  CONJ_TAC;
+  UNIFY_EXISTS_TAC;
+  (* --- *)
+  TYPE_THEN `eps = T` ASM_CASES_TAC;
+  ASM_SIMP_TAC [eps_hyper_translate;eps_hyper_inj];
+  REWRITE_TAC[eps_translate;h_translate];
+  REWRITE_TAC[euclid_plus;e1;point_scale];
+  REAL_ARITH_TAC;
+  TYPE_THEN `eps = F` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps` UNABBREV_TAC;
+  THM_INTRO_TAC[`F`;`r`;`x 0`] eps_hyper_translate_perp;
+  FULL_REWRITE_TAC [];
+  AP_TERM_TAC;
+  REWRITE_TAC[eps_translate;v_translate];
+   REWRITE_TAC[euclid_plus;e2;point_scale];
+  REAL_ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `eps_hyper F (x 1)` EXISTS_TAC;
+  TYPE_THEN `eps = F` ASM_CASES_TAC;
+  ASM_SIMP_TAC [eps_hyper_translate;eps_hyper_inj];
+  REWRITE_TAC[eps_translate;v_translate];
+   REWRITE_TAC[euclid_plus;e2;point_scale];
+  REAL_ARITH_TAC;
+  TYPE_THEN `eps = T` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps` UNABBREV_TAC;
+  THM_INTRO_TAC[`T`;`r`;`x 1`] eps_hyper_translate_perp;
+  FULL_REWRITE_TAC[];
+  AP_TERM_TAC;
+  REWRITE_TAC[eps_translate;h_translate];
+   REWRITE_TAC[euclid_plus;e1;point_scale];
+  REAL_ARITH_TAC;
+  (* -B *)
+  CONJ_TAC;
+  USE 13(REWRITE_RULE[IMAGE2]);
+  TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
+  USE 13(REWRITE_RULE[IMAGE]);
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  TYPE_THEN `im` UNABBREV_TAC;
+  LEFT_TAC  "eps''";
+  TYPE_THEN `eps'` EXISTS_TAC;
+  TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
+  ASM_SIMP_TAC [eps_hyper_translate_perp];
+  MESON_TAC[];
+  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
+  UND 14 THEN MESON_TAC[];
+  ASM_SIMP_TAC[eps_hyper_translate];
+  MESON_TAC[];
+  (* -C *)
+  TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `~eps` EXISTS_TAC;
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
+  USE 13 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `im` UNABBREV_TAC;
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  REWR 13;
+  TYPE_THEN `eps' = ~eps` ASM_CASES_TAC;
+  UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate_perp];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
+  UND 15 THEN MESON_TAC[];
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate];
+  FULL_REWRITE_TAC[eps_hyper_inj];
+  UND 17 THEN MESON_TAC[];
+  (* -D *)
+  TYPE_THEN `eps' = eps` SUBAGOAL_TAC;
+  UND 15 THEN MESON_TAC[];
+  TYPE_THEN`eps'` UNABBREV_TAC;
+  TYPE_THEN `E(eps_hyper eps (z + &j))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN   `im = IMAGE (eps_translate eps r)` ABBREV_TAC ;
+  USE 13 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `im` UNABBREV_TAC;
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  REWR 13;
+  TYPE_THEN `eps'' = ~eps` ASM_CASES_TAC;
+  UND 13 THEN ASM_SIMP_TAC[eps_hyper_translate_perp];
+  FULL_REWRITE_TAC[eps_hyper_inj];
+  UND 18 THEN MESON_TAC[];
+  TYPE_THEN `eps'' = eps` SUBAGOAL_TAC;
+  UND 16 THEN MESON_TAC[];
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  FULL_REWRITE_TAC[eps_hyper_translate;eps_hyper_inj];
+  TYPE_THEN `r` UNABBREV_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `!a. (z' + (-- a)) + a = z'` SUBAGOAL_TAC;
+  REAL_ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `z = &0` ASM_CASES_TAC;
+  TYPE_THEN  `0` EXISTS_TAC;
+  REAL_ARITH_TAC;
+  UND 0 THEN DISCH_THEN (  THM_INTRO_TAC[`z + &j`;`eps`]);
+  IMATCH_MP_TAC  (REAL_ARITH `~(&0 < z + &j) ==> (z + &j <= &0)`);
+  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`z + &j`]);
+  TYPE_THEN `r` UNABBREV_TAC;
+  UND 17 THEN UND 14 THEN REAL_ARITH_TAC;
+  UND 6 THEN REWRITE_TAC[];
+  TYPE_THEN `j +| j'` EXISTS_TAC;
+  UND 0 THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let count_iso_scale = prove_by_refinement(
+  `!G E eps r. (&0 < r) /\ graph_support_eps G E ==>
+     (count_iso_eps_pair (G,E) = count_iso_eps_pair
+       ((plane_graph_image(eps_scale eps r) G),
+                (IMAGE2 (eps_scale eps r) E))) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[count_iso_eps_pair];
+  THM_INTRO_TAC[`G`;`E`;`eps`;`r`] graph_eps_scale_image;
+  FULL_REWRITE_TAC[graph_support_eps];
+  IMATCH_MP_TAC  BIJ_CARD;
+  TYPE_THEN `IMAGE (eps_scale eps r)` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET ;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[SUBSET];
+  (* - *)
+  FULL_REWRITE_TAC [plane_graph_image_e;plane_graph_image_v];
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN `im = IMAGE (eps_scale eps r)` ABBREV_TAC ;
+  (* - *)
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  TYPE_THEN `if (eps = eps') then r* z else z` EXISTS_TAC;
+  TYPE_THEN `eps'` EXISTS_TAC;
+  CONJ_TAC;
+  COND_CASES_TAC;
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  CONJ_TAC;
+  IMATCH_MP_TAC  image_imp;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `im` UNABBREV_TAC;
+  COND_CASES_TAC;
+  ASM_SIMP_TAC[eps_hyper_scale];
+  TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
+  UND 13 THEN MESON_TAC[];
+  ASM_SIMP_TAC[eps_hyper_scale_perp];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `y` UNABBREV_TAC;
+  TYPE_THEN `im` UNABBREV_TAC;
+  TYPE_THEN `(eps' = eps) \/ (eps' = ~eps)` SUBAGOAL_TAC;
+  MESON_TAC[];
+  TYPE_THEN `(eps'' = eps) \/ (eps'' = ~eps)` SUBAGOAL_TAC;
+  MESON_TAC[];
+  REWRITE_TAC[eps_hyper_inj];
+  JOIN 13 15 THEN FULL_REWRITE_TAC[LEFT_AND_OVER_OR;RIGHT_AND_OVER_OR];
+  UND 13 THEN REP_CASES_TAC THEN UND 14 THEN ASM_SIMP_TAC[eps_hyper_scale;eps_hyper_scale_perp;eps_hyper_inj] THEN REWRITE_TAC[TAUT `((eps = ~eps) <=> F) /\ ((~eps = eps) <=> F)`];
+  IMATCH_MP_TAC  REAL_EQ_LCANCEL_IMP;
+  TYPE_THEN `r` EXISTS_TAC;
+  UND 1 THEN REAL_ARITH_TAC;
+  (* - *)
+  REWRITE_TAC[SURJ];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  (* - *)
+  CONV_TAC (dropq_conv "y");
+  TYPE_THEN `x` UNABBREV_TAC;
+  LEFT_TAC "eps";
+  TYPE_THEN `eps'` EXISTS_TAC;
+  USE 16 (REWRITE_RULE[IMAGE]);
+  UND 8 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `z'` EXISTS_TAC;
+  TYPE_THEN `(eps'' = eps') /\ (z = if (eps = eps'') then r*z' else z')` SUBAGOAL_TAC;
+  TYPE_THEN `im` UNABBREV_TAC;
+  COND_CASES_TAC;
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  UND 15 THEN ASM_SIMP_TAC [eps_hyper_scale;eps_hyper_inj];
+  COND_CASES_TAC;
+  REWR 17;
+  TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC;
+  UND 8 THEN MESON_TAC[];
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  UND 15 THEN ASM_SIMP_TAC [eps_hyper_scale_perp;eps_hyper_inj];
+  (* - *)
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  REWR 17;
+  UND 17 THEN COND_CASES_TAC;
+  THM_INTRO_TAC[`r`;`z'`] REAL_LT_LMUL_0;
+  USE 19 SYM;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let count_iso_translate = prove_by_refinement(
+  `!G E eps .  graph_support_eps G E /\
+       (!w. (&0 < w /\ w <  &1) ==> ~(E (eps_hyper eps w))) /\
+      E (eps_hyper eps (&1))  ==>
+     (count_iso_eps_pair (G,E) = SUC(count_iso_eps_pair
+       ((plane_graph_image(eps_translate eps (-- &1)) G),
+                (IMAGE2 (eps_translate eps (-- &1)) E)))) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[count_iso_eps_pair];
+  TYPE_THEN `A = {e | ?z eps. &0 < z /\ E e /\ (e = eps_hyper eps z)}` ABBREV_TAC ;
+  TYPE_THEN `A (eps_hyper eps (&1))` SUBAGOAL_TAC;
+  TYPE_THEN`A` UNABBREV_TAC;
+  TYPE_THEN `&1` EXISTS_TAC;
+  MESON_TAC[];
+  (* - *)
+  TYPE_THEN`FINITE A` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[graph_support_eps];
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET];
+  (* - *)
+  THM_INTRO_TAC[`(eps_hyper eps (&1))`;`A`]CARD_SUC_DELETE;
+  TYPE_THEN `CARD A` UNABBREV_TAC;
+  REWRITE_TAC[SUC_INJ];
+  THM_INTRO_TAC[`G`;`E`;`eps`;`-- &1`] graph_eps_translate_image;
+  CONJ_TAC;
+  MESON_TAC[];
+  FULL_REWRITE_TAC[REAL_ARITH `-- -- x = x`];
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[graph_support_eps];
+  (* -A0 *)
+  IMATCH_MP_TAC  BIJ_CARD;
+  TYPE_THEN `IMAGE (eps_translate eps (-- &1))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_DELETE_IMP;
+  (* - *)
+  FULL_REWRITE_TAC [plane_graph_image_e;plane_graph_image_v];
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN `im = IMAGE (eps_translate eps (-- &1))` ABBREV_TAC ;
+  (* -A *)
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  FULL_REWRITE_TAC[DELETE];
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[eps_hyper_inj];
+  TYPE_THEN `z` UNABBREV_TAC;
+  TYPE_THEN `if (eps = eps'') then  z' - &1 else z'` EXISTS_TAC;
+  TYPE_THEN `eps''` EXISTS_TAC;
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  CONJ_TAC;
+  COND_CASES_TAC;
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `~((z' = &1) \/ (z' < &1)) ==> (&0 < z' - &1)`);
+  REWR 3;
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`z'`]);
+  UND 1 THEN ASM_REWRITE_TAC[];
+  (* --- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  image_imp;
+  TYPE_THEN `im` UNABBREV_TAC;
+  COND_CASES_TAC;
+  ASM_SIMP_TAC[eps_hyper_translate];
+  AP_TERM_TAC;
+  REAL_ARITH_TAC;
+  TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC;
+  UND 3 THEN MESON_TAC[];
+  ASM_SIMP_TAC[eps_hyper_translate_perp];
+  TYPE_THEN `A` UNABBREV_TAC;
+  FULL_REWRITE_TAC[DELETE];
+  TYPE_THEN `x` UNABBREV_TAC;  (* -// *)
+  TYPE_THEN `y` UNABBREV_TAC;
+  TYPE_THEN `im` UNABBREV_TAC;
+  TYPE_THEN `(eps''' = eps) \/ (eps''' = ~eps)` SUBAGOAL_TAC;
+  MESON_TAC[];
+  TYPE_THEN `(eps'' = eps) \/ (eps'' = ~eps)` SUBAGOAL_TAC;
+  MESON_TAC[];
+  REWRITE_TAC[eps_hyper_inj];
+  JOIN 17 20 THEN FULL_REWRITE_TAC[LEFT_AND_OVER_OR;RIGHT_AND_OVER_OR];
+  UND 17 THEN REP_CASES_TAC THEN UND 18 THEN ASM_SIMP_TAC[eps_hyper_translate;eps_hyper_translate_perp;eps_hyper_inj] THEN REWRITE_TAC[TAUT `((eps = ~eps) <=> F) /\ ((~eps = eps) <=> F)`];
+  UND 17 THEN REAL_ARITH_TAC;
+  (* -B *)
+  REWRITE_TAC[SURJ];
+  FULL_REWRITE_TAC[INJ];
+  (* - *)
+  REP_BASIC_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[DELETE];
+  CONV_TAC (dropq_conv "y");  (* -// *)
+  LEFT_TAC "eps";
+  TYPE_THEN `eps'` EXISTS_TAC;
+  KILL 18;
+  KILL 19;
+  FULL_REWRITE_TAC[eps_hyper_inj];
+  TYPE_THEN `z'` UNABBREV_TAC;
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  (* - *)
+  USE 21 (REWRITE_RULE[IMAGE]);
+  UND 12 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `z''` EXISTS_TAC;
+  TYPE_THEN `(eps'' = eps') /\ (z = if (eps = eps'') then z'' - &1  else z'')` SUBAGOAL_TAC;
+  TYPE_THEN `im` UNABBREV_TAC;
+  COND_CASES_TAC;
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  USE 3 (REWRITE_RULE  [eps_hyper_translate;eps_hyper_inj]);
+  REAL_ARITH_TAC;
+  TYPE_THEN `eps'' = ~eps` SUBAGOAL_TAC;
+  UND 12 THEN MESON_TAC[];
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  USE 3 (REWRITE_RULE[   eps_hyper_translate_perp;eps_hyper_inj]);
+  (* - *)
+  TYPE_THEN `eps''` UNABBREV_TAC;
+  TYPE_THEN `z` UNABBREV_TAC;
+  CONJ_TAC;
+  UND 22 THEN COND_CASES_TAC;
+  UND 12 THEN REAL_ARITH_TAC;
+  TYPE_THEN `z''` UNABBREV_TAC;
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  UND 22 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let iso_support_min_int = prove_by_refinement(
+  `!G:(A,B)graph_t H E. iso_support_eps_pair G (H,E) /\
+    (0 <| count_iso_eps_pair (H,E)) ==>
+    (?H' E'. iso_support_eps_pair G (H',E') /\
+       (count_iso_eps_pair(H',E') = count_iso_eps_pair(H,E)) /\
+       (?eps. E' (eps_hyper eps (&1)) /\
+         (!w. (&0 < w /\ w < &1) ==> ~(E'(eps_hyper eps w)))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`G`;`H`;`E`] iso_support_eps_min;
+  TYPE_THEN `z' = &1/z` ABBREV_TAC ;
+  TYPE_THEN `H' = plane_graph_image (eps_scale eps z') H` ABBREV_TAC ;
+  TYPE_THEN `E' = IMAGE2 (eps_scale eps z') E` ABBREV_TAC ;
+  TYPE_THEN `H'` EXISTS_TAC;
+  TYPE_THEN `E'` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `&0 < z'` SUBAGOAL_TAC;
+  TYPE_THEN `z'` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `z' * z = &1` SUBAGOAL_TAC;
+  TYPE_THEN `z'` UNABBREV_TAC;
+  IMATCH_MP_TAC  REAL_DIV_RMUL;
+  UND 5 THEN UND 4 THEN REAL_ARITH_TAC;
+  (* - *)
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[iso_support_eps_pair];
+  FULL_REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `E''` UNABBREV_TAC;
+  TYPE_THEN `H''` UNABBREV_TAC;
+  TYPE_THEN `H'` EXISTS_TAC;
+  TYPE_THEN `E'` EXISTS_TAC;
+  TYPE_THEN `H'` UNABBREV_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  CONJ_TAC;
+  THM_INTRO_TAC[`eps_scale eps z'`;`H`] plane_graph_image_iso;
+  ASM_SIMP_TAC [homeomorphism_eps_scale];
+  FULL_REWRITE_TAC[graph_support_eps;good_plane_graph];
+  THM_INTRO_TAC[`G`;`H`;`(plane_graph_image (eps_scale eps z') H)`] graph_isomorphic_trans;
+  IMATCH_MP_TAC  graph_eps_scale_image;
+  (* - *)
+  SUBCONJ_TAC;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  TYPE_THEN `E'` UNABBREV_TAC;
+  TYPE_THEN `H'` UNABBREV_TAC;
+  IMATCH_MP_TAC  count_iso_scale;
+  FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
+  ASM_MESON_TAC[];
+  TYPE_THEN `eps` EXISTS_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  (* - *)
+  SUBCONJ_TAC;
+  REWRITE_TAC[IMAGE2];
+  TYPE_THEN `im = IMAGE (eps_scale eps z')` ABBREV_TAC ;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `eps_hyper eps z` EXISTS_TAC;
+  TYPE_THEN `im` UNABBREV_TAC;
+  ASM_SIMP_TAC [eps_hyper_scale];
+  (* - *)
+  FULL_REWRITE_TAC[IMAGE2];
+  TYPE_THEN `im = IMAGE (eps_scale eps z')` ABBREV_TAC ;
+  USE 7(REWRITE_RULE[IMAGE]);
+  TYPE_THEN `im` UNABBREV_TAC;
+  UND 2 THEN  DISCH_THEN (THM_INTRO_TAC[ `z*w`  ]);
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  IMATCH_MP_TAC  (REAL_ARITH `z * w < z* &1 ==> z*w < z`);
+  IMATCH_MP_TAC  REAL_LT_LMUL;
+  TYPE_THEN `x = eps_hyper eps (z * w)` SUBAGOAL_TAC;
+  USE 1 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]);
+  TYPE_THEN `E''` UNABBREV_TAC;
+  USE 17 (REWRITE_RULE[graph_support_eps]);
+  UND 17 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  TYPE_THEN `x` UNABBREV_TAC;
+  REWRITE_TAC[eps_hyper_inj];
+  TYPE_THEN `eps' = eps` ASM_CASES_TAC;
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  UND 7 THEN ASM_SIMP_TAC[eps_hyper_scale;eps_hyper_inj];
+  COND_CASES_TAC;
+  UND 9 THEN REWRITE_TAC[REAL_MUL_AC];
+  ASM_REWRITE_TAC [REAL_MUL_ASSOC];
+  REAL_ARITH_TAC;
+  REWR 13;
+  TYPE_THEN `eps' = ~eps` SUBAGOAL_TAC;
+  UND 17 THEN MESON_TAC[];
+  TYPE_THEN `eps'` UNABBREV_TAC;
+  UND 7 THEN ASM_SIMP_TAC[eps_hyper_scale_perp;eps_hyper_inj];
+  TYPE_THEN `x` UNABBREV_TAC;
+  UND 2 THEN ASM_REWRITE_TAC[];
+
+
+  ]);;
+  (* }}} *)
+
+let iso_int_model_lemma = prove_by_refinement(
+  `!(G:(A,B)graph_t) . (planar_graph G) /\
+         FINITE (graph_edge G) /\
+         FINITE (graph_vertex G) /\
+         ~(graph_edge G = {}) /\
+         (!v. CARD (graph_edge_around G v) <=| 4) ==>
+  (?H E. iso_support_eps_pair G (H,E) /\
+     (count_iso_eps_pair (H,E) = 0))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `c  = count_iso_eps_pair:((num->real,(num->real)->bool)graph_t#(((num->real)->bool)->bool))->num` ABBREV_TAC ;
+  THM_INTRO_TAC[`G`] iso_support_eps_nonempty;
+  THM_INTRO_TAC[`iso_support_eps_pair G`;`c`] select_image_num_min;
+  UND 6 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `?H E. z = H,E` SUBAGOAL_TAC ;
+  REWRITE_TAC[PAIR_SPLIT];
+  MESON_TAC[];
+  TYPE_THEN `z` UNABBREV_TAC;
+  TYPE_THEN `H` EXISTS_TAC;
+  TYPE_THEN `E` EXISTS_TAC;
+  TYPE_THEN `c` UNABBREV_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `~(0 < x) ==> (x = 0)`);
+  THM_INTRO_TAC[`G`;`H`;`E`] iso_support_min_int;
+  THM_INTRO_TAC[`H'`;`E'`;`eps`] count_iso_translate;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
+  ASM_MESON_TAC[];
+  TYPE_THEN `H'' = plane_graph_image (eps_translate eps (-- &1)) H'` ABBREV_TAC ;
+  TYPE_THEN `E'' = IMAGE2 (eps_translate eps ( -- &1)) E'`ABBREV_TAC ;
+  UND 7 THEN DISCH_THEN (THM_INTRO_TAC[ `(H'',E'')`]);
+  TYPE_THEN `H''` UNABBREV_TAC;
+  TYPE_THEN `E''` UNABBREV_TAC;
+  REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
+  CONV_TAC (dropq_conv "H");
+  CONV_TAC (dropq_conv "E");
+  (* -- *)
+  CONJ_TAC;
+  TYPE_THEN `graph_isomorphic H' (plane_graph_image (eps_translate eps (-- &1)) H')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  plane_graph_image_iso;
+  REWRITE_TAC[homeomorphism_eps_translate;];
+  USE 12 (REWRITE_RULE[iso_support_eps_pair;graph_support_eps;good_plane_graph;PAIR_SPLIT]);
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`G`;`H'`;`(plane_graph_image (eps_translate eps (-- &1)) H')`] graph_isomorphic_trans;
+  USE 12 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]);
+  ASM_MESON_TAC[];
+  (* -- *)
+  IMATCH_MP_TAC  graph_eps_translate_image;
+  CONJ_TAC;
+  MESON_TAC[];
+  ASM_REWRITE_TAC[ARITH_RULE `-- (-- x) = x`];
+  USE 12 (REWRITE_RULE[iso_support_eps_pair;PAIR_SPLIT]);
+  ASM_MESON_TAC[];
+  UND 7 THEN UND 13 THEN UND 11 THEN ARITH_TAC;
+
+  ]);;
+  (* }}} *)
+
+let graph_int_model = prove_by_refinement(
+  `!(G:(A,B)graph_t) . (planar_graph G) /\
+         FINITE (graph_edge G) /\
+         FINITE (graph_vertex G) /\
+         ~(graph_edge G = {}) /\
+         (!v. CARD (graph_edge_around G v) <=| 4) ==>
+  (?H E.
+     graph_isomorphic G H /\
+     good_plane_graph H /\
+     FINITE E /\
+     (!e. graph_edge H e ==> e SUBSET UNIONS E) /\
+     (!v. graph_vertex H v
+                  ==> E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1))) /\
+     (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\
+     (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j))
+    )`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`G`]iso_int_model_lemma;
+  TYPE_THEN `H` EXISTS_TAC;
+  TYPE_THEN `E` EXISTS_TAC;
+  THM_INTRO_TAC[`G`;`H`;`E`] iso_eps_support0;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[iso_support_eps_pair;PAIR_SPLIT];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION Y *)
+(* ------------------------------------------------------------------ *)
+
+(* if a graph has an int model then it is a rectagonal graph *)
+(* k33_nonplanar proved! *)
+
+
+let h_edge_ball = prove_by_refinement(
+  `!m. h_edge m SUBSET open_ball
+       (euclid 2,d_euclid)
+       (pointI m + (&1/ &2)*# e1) (&1 / &2)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[h_edge;open_ball;SUBSET;euclid_point;e1;point_scale;pointI;point_add];
+  REWRITE_TAC[euclid_point;];
+  TYPE_THEN `v` UNABBREV_TAC;
+  REDUCE_TAC;
+  REWRITE_TAC[d_euclid_point];
+  REDUCE_TAC;
+  TYPE_THEN `0 **| 2 = 0` SUBAGOAL_TAC;
+  REWRITE_TAC[EXP_EQ_0];
+  UND 0 THEN ARITH_TAC;
+  REDUCE_TAC;
+  REWRITE_TAC[POW_2_SQRT_ABS];
+  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
+  REWRITE_TAC[GSYM REAL_ABS_BETWEEN];
+  CONJ_TAC;
+  REWRITE_TAC[REAL_LT_HALF1];
+  CONJ_TAC;
+  REWRITE_TAC[REAL_LT_SUB_RADD];
+  REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_HALF_DOUBLE];
+  UND 2 THEN REAL_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let v_edge_ball = prove_by_refinement(
+  `!m. v_edge m SUBSET open_ball
+       (euclid 2,d_euclid)
+       (pointI m + (&1/ &2)*# e2) (&1 / &2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[v_edge;open_ball;SUBSET;euclid_point;e2;point_scale;pointI;point_add];
+  REWRITE_TAC[euclid_point;];
+  TYPE_THEN `u` UNABBREV_TAC;
+  REDUCE_TAC;
+  REWRITE_TAC[d_euclid_point];
+  REDUCE_TAC;
+  TYPE_THEN `0 **| 2 = 0` SUBAGOAL_TAC;
+  REWRITE_TAC[EXP_EQ_0];
+  UND 0 THEN ARITH_TAC;
+  REDUCE_TAC;
+  REWRITE_TAC[POW_2_SQRT_ABS];
+  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
+  REWRITE_TAC[GSYM REAL_ABS_BETWEEN];
+  CONJ_TAC;
+  REWRITE_TAC[REAL_LT_HALF1];
+  CONJ_TAC;
+  REWRITE_TAC[REAL_LT_SUB_RADD];
+  REWRITE_TAC[GSYM REAL_ADD_ASSOC;REAL_HALF_DOUBLE];
+  UND 2 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let sqrt_frac = prove_by_refinement(
+  `!n m. sqrt ((&n/ &m) pow 2) = &n/ (&m) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  POW_2_SQRT;
+  IMATCH_MP_TAC  REAL_LE_DIV;
+  REWRITE_TAC[REAL_POS];
+  ]);;
+  (* }}} *)
+
+let abs_dest_int_half = prove_by_refinement(
+  `!m. &1 / &2 <= abs  (real_of_int m - &1 / &2)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  REAL_LE_LCANCEL_IMP;
+  TYPE_THEN `&2` EXISTS_TAC;
+  CONJ_TAC;
+  REAL_ARITH_TAC;
+  TYPE_THEN `&2 * (&1/ &2) = &1` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  UND 0 THEN REAL_ARITH_TAC;
+  TYPE_THEN `&2 = abs  (&2)` SUBAGOAL_TAC;
+  REAL_ARITH_TAC;
+  TYPE_THEN`!x. &2 * abs  x = abs  (&2 * x)` SUBAGOAL_TAC;
+  UND 1 THEN REAL_ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_SUB_LDISTRIB];
+  REWRITE_TAC[GSYM int_of_num_th;GSYM int_mul_th;GSYM int_sub_th;GSYM int_abs_th;GSYM int_le];
+  TYPE_THEN `!x. ~(&:0 = ||: x) ==> (&:1 <= ||: x)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`x`] INT_ABS_POS;
+  UND 3 THEN UND 4 THEN INT_ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 4 SYM;
+  FULL_REWRITE_TAC[INT_ABS_ZERO];
+  THM_INTRO_TAC[`m`] INT_REP;
+  TYPE_THEN`m` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INT_OF_NUM_MUL;INT_SUB_LDISTRIB;INT_EQ_SUB_RADD;INT_OF_NUM_ADD;INT_OF_NUM_EQ;];
+  UND 4 THEN REDUCE_TAC ;
+  TYPE_THEN `ODD (2 *| n)` SUBAGOAL_TAC;
+  REWRITE_TAC[ODD_EXISTS];
+  TYPE_THEN `m'` EXISTS_TAC;
+  ARITH_TAC;
+  KILL 4;
+  TYPE_THEN `EVEN (2 *| n)` SUBAGOAL_TAC;
+  REWRITE_TAC[EVEN_EXISTS];
+  MESON_TAC[];
+  ASM_MESON_TAC[EVEN_AND_ODD];
+  ]);;
+  (* }}} *)
+
+let REAL_LT_SQUARE_ABS = prove_by_refinement(
+  `!x y. abs  x < abs  y <=> x pow 2 < y pow 2`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y /\ ~(y <= x))`];
+  MESON_TAC[REAL_LE_SQUARE_ABS];
+  ]);;
+  (* }}} *)
+
+let h_edge_closed_ball = prove_by_refinement(
+  `!e m. edge e /\ ~(e INTER closed_ball
+       (euclid 2,d_euclid)
+       (pointI m + (&1/ &2)*# e1) (&1 / &2) = EMPTY) ==>
+       (e = h_edge m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC;
+  (*  - *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 1 (MATCH_MP point_onto);
+  TYPE_THEN `u` UNABBREV_TAC;
+  KILL 5;
+  FULL_REWRITE_TAC[point_add;pointI;d_euclid_point;v_edge;point_inj];
+  TYPE_THEN `p` UNABBREV_TAC;
+  TYPE_THEN `u'` UNABBREV_TAC;
+  USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
+  UND 0 THEN REWRITE_TAC[];
+  TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
+  REWRITE_TAC[sqrt_frac];
+  IMATCH_MP_TAC  SQRT_MONO_LT;
+  IMATCH_MP_TAC (REAL_ARITH  `(x <= u /\ &0 < v) ==> x < u + v` );
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS];
+  TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_DIV;ABS_N];
+  ONCE_REWRITE_TAC [GSYM REAL_ABS_NEG];
+  TYPE_THEN `--((real_of_int (FST m) + &1 / &2) - real_of_int (FST m')) = (real_of_int (FST m' - FST m)) - &1 / &2 ` SUBAGOAL_TAC;
+  REWRITE_TAC[int_sub_th];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[abs_dest_int_half];
+  (* -- *)
+  IMATCH_MP_TAC  (REAL_ARITH `&0 <= y /\ ~(y = &0) ==> &0 < y`);
+  REWRITE_TAC[];
+  USE 1 (MATCH_MP POW_ZERO);
+  TYPE_THEN `v = real_of_int (SND m)` SUBAGOAL_TAC;
+  UND 1 THEN REAL_ARITH_TAC;
+  TYPE_THEN `v` UNABBREV_TAC;
+  FULL_REWRITE_TAC[GSYM int_lt];
+  UND 3 THEN UND 5 THEN INT_ARITH_TAC;
+  (* - *)
+  REWRITE_TAC[cell_clauses];
+  TYPE_THEN `e` UNABBREV_TAC;
+  FULL_REWRITE_TAC[h_edge];
+  TYPE_THEN `v` UNABBREV_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  FULL_REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;pointI;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  (* - *)
+  USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
+  UND 0 THEN REWRITE_TAC[];
+  TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
+  REWRITE_TAC[sqrt_frac];
+  IMATCH_MP_TAC  SQRT_MONO_LT;
+  (* - *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  IMATCH_MP_TAC (REAL_ARITH  `(x < u /\ &0 <= v) ==> x < u + v` );
+  (* --B *)
+  REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
+  TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_DIV;ABS_N];
+  KILL 0;
+  TYPE_THEN `!x y. x < abs  y <=> (&0 <= y /\ x < y) \/ (y < &0 /\ x < -- y)` SUBAGOAL_TAC;
+  REAL_ARITH_TAC;
+  TYPE_THEN `&1 / &2 < (real_of_int (FST m) + &1 / &2) - u'` ASM_CASES_TAC;
+  DISJ1_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `&1 / &2` EXISTS_TAC;
+  CONJ_TAC ;
+  IMATCH_MP_TAC  REAL_LE_DIV;
+  REAL_ARITH_TAC;
+  UND 9 THEN REAL_ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `real_of_int (FST m) + &1 < u'` BACK_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LT_TRANS;
+  TYPE_THEN `real_of_int (FST m) + &1 - u'` EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `&1 / &2 < &1` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_LT_HALF2];
+  UND 11 THEN REAL_ARITH_TAC;
+  UND 10 THEN REAL_ARITH_TAC;
+  THM_INTRO_TAC[`&1`] REAL_HALF_DOUBLE;
+  UND 11 THEN DISCH_THEN (fun t-> USE 10 (ONCE_REWRITE_RULE[GSYM t]));
+  UND 10 THEN REAL_ARITH_TAC;
+  (* -- *)
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `u' <= real_of_int (FST m) + &1` SUBAGOAL_TAC;
+  UND 10 THEN REAL_ARITH_TAC;
+  TYPE_THEN `real_of_int (FST m) <= u'` SUBAGOAL_TAC;
+  UND 9 THEN REAL_ARITH_TAC;
+  TYPE_THEN `~(u' = real_of_int (FST m) + &1)` SUBAGOAL_TAC;
+  TYPE_THEN `u'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[GSYM int_le;GSYM int_lt;GSYM int_of_num_th;GSYM int_add_th;];
+  UND 7 THEN UND 5 THEN UND 6 THEN INT_ARITH_TAC;
+  TYPE_THEN `u' < real_of_int (FST m) + &1` SUBAGOAL_TAC;
+  UND 13 THEN UND 11 THEN ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `floor u' = (FST m')` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
+  ASM_REWRITE_TAC[floor_range];
+  UND 6 THEN REAL_ARITH_TAC;
+  USE 15 SYM;
+  TYPE_THEN `floor u' = FST m` SUBAGOAL_TAC;
+  REWRITE_TAC[floor_range];
+  ASM_MESON_TAC[];
+  (* -C different second coord *)
+  IMATCH_MP_TAC  (REAL_ARITH `x < z /\ &0 <= y  ==> x < y + z`);
+  REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
+  REDUCE_TAC;
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN `&1` EXISTS_TAC;
+  CONJ_TAC;
+  KILL 0;
+  REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM];
+  REWRITE_TAC[REAL_LT_HALF2];
+  REWRITE_TAC[GSYM int_sub_th;GSYM int_abs_th;GSYM int_le; GSYM int_of_num_th;];
+  UND 7 THEN INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let v_edge_closed_ball = prove_by_refinement(
+  `!e m. edge e /\ ~(e INTER closed_ball
+       (euclid 2,d_euclid)
+       (pointI m + (&1/ &2)*# e2) (&1 / &2) = EMPTY) ==>
+       (e = v_edge m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC;
+  (*  - *)
+  USE 4 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 1 (MATCH_MP point_onto);
+  TYPE_THEN `u` UNABBREV_TAC;
+  KILL 5;
+  FULL_REWRITE_TAC[point_add;pointI;d_euclid_point;h_edge;point_inj];
+  TYPE_THEN `p` UNABBREV_TAC;
+  TYPE_THEN `v ` UNABBREV_TAC;
+  USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
+  UND 0 THEN REWRITE_TAC[];
+  TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
+  REWRITE_TAC[sqrt_frac];
+  IMATCH_MP_TAC  SQRT_MONO_LT;
+  IMATCH_MP_TAC (REAL_ARITH  `(x <= v /\ &0 < u) ==> x < u + v` );
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS];
+  TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_DIV;ABS_N];
+  ONCE_REWRITE_TAC [GSYM REAL_ABS_NEG];
+  TYPE_THEN `--((real_of_int (SND m) + &1 / &2) - real_of_int (SND  m')) = (real_of_int (SND  m' - SND  m)) - &1 / &2 ` SUBAGOAL_TAC;
+  REWRITE_TAC[int_sub_th];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[abs_dest_int_half];
+  (* --// *)
+  IMATCH_MP_TAC  (REAL_ARITH `&0 <= y /\ ~(y = &0) ==> &0 < y`);
+  REWRITE_TAC[];
+  USE 1 (MATCH_MP POW_ZERO);
+  TYPE_THEN `u' = real_of_int (FST  m)` SUBAGOAL_TAC;
+  UND 1 THEN REAL_ARITH_TAC;
+  TYPE_THEN `u'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[GSYM int_lt];
+  UND 3 THEN UND 5 THEN INT_ARITH_TAC;
+  (* - *)
+  REWRITE_TAC[cell_clauses];
+  TYPE_THEN `e` UNABBREV_TAC;
+  FULL_REWRITE_TAC[v_edge];
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `u'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[edge;closed_ball;SUBSET;euclid_point;pointI;point_add;e1;e2;INTER;point_scale;EMPTY_EXISTS ;d_euclid_point ] THEN REDUCE_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  (* - *)
+  USE 0 (MATCH_MP (REAL_ARITH `x <= y ==> ~( y < x)`));
+  UND 0 THEN REWRITE_TAC[];
+  TYPE_THEN `!x. (&1/ &2 < x) <=> sqrt((&1/ &2) pow 2) < x` SUBAGOAL_TAC;
+  REWRITE_TAC[sqrt_frac];
+  IMATCH_MP_TAC  SQRT_MONO_LT;
+  (* - *)
+  USE 3 (MATCH_MP (TAUT `a \/ b ==> b \/ a`));
+  FIRST_ASSUM DISJ_CASES_TAC;
+  IMATCH_MP_TAC (REAL_ARITH  `(x < v /\ &0 <= u) ==> x < u + v` );
+  (* --B *)
+  REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
+  TYPE_THEN `abs  (&1/ &2) = &1 / &2` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_DIV;ABS_N];
+  KILL 0;
+  TYPE_THEN `!x y. x < abs  y <=> (&0 <= y /\ x < y) \/ (y < &0 /\ x < -- y)` SUBAGOAL_TAC;
+  REAL_ARITH_TAC;
+  TYPE_THEN `&1 / &2 < (real_of_int (SND  m) + &1 / &2) - v` ASM_CASES_TAC;
+  DISJ1_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `&1 / &2` EXISTS_TAC;
+  CONJ_TAC ;
+  IMATCH_MP_TAC  REAL_LE_DIV;
+  REAL_ARITH_TAC;
+  UND 9 THEN REAL_ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `real_of_int (SND  m) + &1 < v` BACK_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LT_TRANS;
+  TYPE_THEN `real_of_int (SND  m) + &1 - v` EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `&1 / &2 < &1` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_LT_HALF2];
+  UND 11 THEN REAL_ARITH_TAC;
+  UND 10 THEN REAL_ARITH_TAC;
+  THM_INTRO_TAC[`&1`] REAL_HALF_DOUBLE;
+  UND 11 THEN DISCH_THEN (fun t-> USE 10 (ONCE_REWRITE_RULE[GSYM t]));
+  UND 10 THEN REAL_ARITH_TAC;
+  (* -- *)
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `v <= real_of_int (SND  m) + &1` SUBAGOAL_TAC;
+  UND 10 THEN REAL_ARITH_TAC;
+  TYPE_THEN `real_of_int (SND  m) <= v` SUBAGOAL_TAC;
+  UND 9 THEN REAL_ARITH_TAC;
+  TYPE_THEN `~(v = real_of_int (SND  m) + &1)` SUBAGOAL_TAC;
+  TYPE_THEN `v` UNABBREV_TAC;
+  FULL_REWRITE_TAC[GSYM int_le;GSYM int_lt;GSYM int_of_num_th;GSYM int_add_th;];
+  UND 7 THEN UND 5 THEN UND 6 THEN INT_ARITH_TAC;
+  TYPE_THEN `v < real_of_int (SND  m) + &1` SUBAGOAL_TAC;
+  UND 13 THEN UND 11 THEN ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `floor v = (SND  m')` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[int_add_th;int_of_num_th];
+  ASM_REWRITE_TAC[floor_range];
+  UND 6 THEN REAL_ARITH_TAC;
+  USE 15 SYM;
+  TYPE_THEN `floor v = SND  m` SUBAGOAL_TAC;
+  REWRITE_TAC[floor_range];
+  ASM_MESON_TAC[];
+  (* -C different second coord *)
+  IMATCH_MP_TAC  (REAL_ARITH `x < y /\ &0 <= z  ==> x < y + z`);
+  REWRITE_TAC[GSYM REAL_LT_SQUARE_ABS];
+  REDUCE_TAC;
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN `&1` EXISTS_TAC;
+  CONJ_TAC;
+  KILL 0;
+  REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM];
+  REWRITE_TAC[REAL_LT_HALF2];
+  REWRITE_TAC[GSYM int_sub_th;GSYM int_abs_th;GSYM int_le; GSYM int_of_num_th;];
+  UND 7 THEN INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let connected_in_edge = prove_by_refinement(
+  `!C. connected top2 C /\ C SUBSET (UNIONS edge) ==>
+    (?e. edge e /\ C SUBSET e)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `C = EMPTY` ASM_CASES_TAC ;
+  REWRITE_TAC[connected_empty];
+  TYPE_THEN `C` UNABBREV_TAC;
+  TYPE_THEN `h_edge (&:0,&:0)` EXISTS_TAC;
+  REWRITE_TAC[edge_h];
+  (* - *)
+  TYPE_THEN `?e. edge e /\ ~(C INTER e = EMPTY)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET;UNIONS;EMPTY_EXISTS];
+  TSPEC `u` 0;
+  REWRITE_TAC[INTER ];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `e` EXISTS_TAC;
+  FULL_REWRITE_TAC[connected;edge];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  TYPE_THEN `A = open_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e2) (&1 / &2)` ABBREV_TAC ;
+  TYPE_THEN `B = closed_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e2) (&1 / &2)` ABBREV_TAC ;
+  TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ;
+  UND 1 THEN (DISCH_THEN (THM_INTRO_TAC[`A`;`E`]));
+  CONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  open_ball_open;
+  CONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[top2];
+  THM_INTRO_TAC[`top2`;`B`] closed_open ;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  closed_ball_closed;
+  FULL_REWRITE_TAC[open_DEF;top2_unions;];
+  FULL_REWRITE_TAC[top2];
+  CONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[EQ_EMPTY;INTER;DIFF];
+  UND 1 THEN REWRITE_TAC[];
+  ASM_MESON_TAC[open_ball_sub_closed;subset_imp;];
+  USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
+  REWRITE_TAC[SUBSET;UNION];
+  TSPEC `x` 0;
+  REWRITE_TAC[];
+  TYPE_THEN `u = v_edge m` ASM_CASES_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  DISJ1_TAC;
+  ASM_MESON_TAC[v_edge_ball;subset_imp ];
+  DISJ2_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[DIFF];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[top2_unions];
+  ASM_MESON_TAC[subset_imp];
+  UND 10 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  v_edge_closed_ball;
+  REWRITE_TAC[EMPTY_EXISTS;INTER];
+  ASM_MESON_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
+  REWRITE_TAC[SUBSET];
+  TSPEC `x` 0;
+  REWRITE_TAC[];
+  TYPE_THEN `u = v_edge m` BACK_TAC ;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  v_edge_closed_ball;
+  REWRITE_TAC[INTER;EMPTY_EXISTS ];
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_MESON_TAC[open_ball_sub_closed;subset_imp];
+  USE 3 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
+  PROOF_BY_CONTR_TAC;
+  UND 9 THEN (TYPE_THEN `E` UNABBREV_TAC) THEN REWRITE_TAC[DIFF;SUBSET];
+  TSPEC `u` 8;
+  UND 8 THEN REWRITE_TAC[DE_MORGAN_THM];
+  DISJ2_TAC;
+  ASM_MESON_TAC[v_edge_ball;subset_imp;open_ball_sub_closed];
+  (* -A *)
+  TYPE_THEN `e` UNABBREV_TAC;
+  TYPE_THEN `A = open_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e1) (&1 / &2)` ABBREV_TAC ;
+  TYPE_THEN `B = closed_ball   (euclid 2,d_euclid)    (pointI m + (&1/ &2)*# e1) (&1 / &2)` ABBREV_TAC ;
+  TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ;
+  UND 1 THEN (DISCH_THEN (THM_INTRO_TAC[`A`;`E`]));
+  CONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  open_ball_open;
+  CONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[top2];
+  THM_INTRO_TAC[`top2`;`B`] closed_open ;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  closed_ball_closed;
+  FULL_REWRITE_TAC[open_DEF;top2_unions;];
+  FULL_REWRITE_TAC[top2];
+  CONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[EQ_EMPTY;INTER;DIFF];
+  UND 1 THEN REWRITE_TAC[];
+  ASM_MESON_TAC[open_ball_sub_closed;subset_imp;];
+  USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
+  REWRITE_TAC[SUBSET;UNION];
+  TSPEC `x` 0;
+  REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `u = h_edge m` ASM_CASES_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  DISJ1_TAC;
+  ASM_MESON_TAC[h_edge_ball;subset_imp ];
+  DISJ2_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[DIFF];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[top2_unions];
+  ASM_MESON_TAC[subset_imp];
+  UND 10 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  h_edge_closed_ball;
+  REWRITE_TAC[EMPTY_EXISTS;INTER];
+  ASM_MESON_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  USE 0 (REWRITE_RULE[SUBSET;UNIONS]);
+  REWRITE_TAC[SUBSET];
+  TSPEC `x` 0;
+  REWRITE_TAC[];
+  TYPE_THEN `u = h_edge m` BACK_TAC ;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  h_edge_closed_ball;
+  REWRITE_TAC[INTER;EMPTY_EXISTS ];
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_MESON_TAC[open_ball_sub_closed;subset_imp];
+  USE 3 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
+  PROOF_BY_CONTR_TAC;
+  (* - *)
+  UND 9 THEN (TYPE_THEN `E` UNABBREV_TAC) THEN REWRITE_TAC[DIFF;SUBSET];
+  TSPEC `u` 8;
+  UND 8 THEN REWRITE_TAC[DE_MORGAN_THM];
+  DISJ2_TAC;
+  ASM_MESON_TAC[h_edge_ball;subset_imp;open_ball_sub_closed];
+  (* - *)
+  (* Mon Dec 20 15:16:18 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let int_pow2_gt1 = prove_by_refinement(
+  `!x. ~(x = &:0) ==> &1 <= (real_of_int x) pow 2`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN  `&1 = &1 pow 2` SUBAGOAL_TAC ;
+  REDUCE_TAC;
+  UND 1 THEN DISCH_THEN (fun t -> ONCE_REWRITE_TAC[t]);
+  REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS;GSYM int_le;GSYM int_abs_th ;GSYM int_of_num_th;];
+  UND 0 THEN INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let d_euclid_pointI_pos = prove_by_refinement(
+  `!m n. d_euclid (pointI m) (pointI n) < &1 ==> (m = n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[pointI;d_euclid_point;PAIR_SPLIT];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  USE 0 (MATCH_MP (REAL_ARITH  `x < y ==> ~(y <= x)`));
+  UND 0 THEN REWRITE_TAC[];
+  TYPE_THEN `&1 = sqrt(&1)` SUBAGOAL_TAC;
+  ONCE_REWRITE_TAC [EQ_SYM_EQ];
+  IMATCH_MP_TAC  SQRT_POS_UNIQ;
+  REDUCE_TAC;
+  UND 0 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
+  IMATCH_MP_TAC  SQRT_MONO_LE;
+  REDUCE_TAC;
+  FULL_REWRITE_TAC[GSYM int_sub_th];
+  USE 1 (ONCE_REWRITE_RULE[ONCE_REWRITE_RULE[EQ_SYM_EQ] INT_SUB_0]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `&1 <= x /\ &0 <= y ==> &1 <= x + y`);
+  IMATCH_MP_TAC  int_pow2_gt1;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  (REAL_ARITH `&1 <= x /\ &0 <= y ==> &1 <= y + x`);
+  IMATCH_MP_TAC  int_pow2_gt1;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+extend_simp_rewrites[prove_by_refinement(
+  `&0 < &1 / &2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[REAL_LT_HALF1];
+  ])];;
+  (* }}} *)
+
+extend_simp_rewrites[prove_by_refinement(
+  `&2 * &1/ &2 = &1`,
+  (* {{{ proof *)
+  [
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  UND 0 THEN REAL_ARITH_TAC;
+  ])];;
+  (* }}} *)
+
+let totally_bounded_pointI = prove_by_refinement(
+  `?eps. !x m n. (&0 <eps ) /\
+       (open_ball(euclid 2,d_euclid) x eps (pointI m) /\
+       open_ball(euclid 2,d_euclid) x eps (pointI n) ==>
+        (m = n))  `,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `&1/ &2` EXISTS_TAC;
+  REWRITE_TAC[];
+  IMATCH_MP_TAC  d_euclid_pointI_pos;
+  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`pointI m`;`pointI n`;`x`;`&1 / &2`] BALL_DIST;
+  TYPE_THEN `&2 * &1 / &2 = &1` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let simple_arc_finite_pointI = prove_by_refinement(
+  `! e .
+       simple_arc top2 e  ==>
+       (?X. FINITE X /\ (!m. e (pointI m) ==> X m))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`e`] simple_arc_compact;
+  THM_INTRO_TAC[`e`] simple_arc_euclid;
+  THM_INTRO_TAC[`e`;`d_euclid`] compact_totally_bounded;
+  CONJ_TAC;
+  THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] metric_subspace;
+  THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] compact_subset;
+  FULL_REWRITE_TAC[top2];
+  ASM_MESON_TAC[];
+  (* - *)
+  FULL_REWRITE_TAC[totally_bounded];
+  THM_INTRO_TAC[] totally_bounded_pointI;
+  TSPEC `eps` 3;
+  RIGHT 4 "n";
+  RIGHT 4 "m";
+  RIGHT 4 "x";
+  REWRITE_TAC[];
+  TYPE_THEN `X = { m | ?b. B b /\ b (pointI m) }` ABBREV_TAC ;
+  TYPE_THEN `X` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `!m. ?b. (X m) ==> (B b /\ b (pointI m))` SUBAGOAL_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  MESON_TAC[];
+  LEFT 9 "b";
+  CONJ_TAC;
+  THM_INTRO_TAC[`X`;`B`;`b`] FINITE_INJ;
+  REWRITE_TAC[INJ];
+  REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  COPY 9;
+  TSPEC `x` 13;
+  TSPEC `y` 9;
+  COPY 6;
+  TSPEC `b x` 16;
+  TSPEC `b y` 6;
+  TYPE_THEN `x'` EXISTS_TAC;
+  (* // *)
+  TYPE_THEN `b y` UNABBREV_TAC;
+  TYPE_THEN `b x` UNABBREV_TAC;
+  THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`] metric_subspace;
+  THM_INTRO_TAC[`euclid 2`;`e`;`d_euclid`;`x'`;`eps`] open_ball_subspace;
+  CONJ_TAC THEN ASM_MESON_TAC[subset_imp];
+  (* - *)
+  TYPE_THEN `X` UNABBREV_TAC;
+  FULL_REWRITE_TAC[UNIONS];
+  ASM_MESON_TAC[];
+  (* Mon Dec 20 18:39:42 EST 2004 *)
+
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_finite_lemma1 = prove_by_refinement(
+  `!e v v'. simple_arc_end  e v v' ==>
+    (?X f. (X SUBSET {x | &0 <= x /\ x <= &1}) /\ FINITE X /\
+      (f (&0) = v) /\ (f (&1) = v') /\
+      (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\
+              continuous f (top_of_metric (UNIV,d_real)) top2 /\
+              INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
+        (!x.   &0 <= x /\ x <= &1 ==> ( (?m. f x = pointI m) <=> (X x))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_simple;
+  THM_INTRO_TAC[`e`] simple_arc_finite_pointI;
+  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end;
+  REWR 4;
+  TYPE_THEN `Y = {x | &0 <= x /\ x <= &1 /\ (?m. (f x = pointI m))}` ABBREV_TAC ;
+  TYPE_THEN `Y` EXISTS_TAC;
+  TYPE_THEN `f` EXISTS_TAC;
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN`Y` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET];
+  (* - *)
+  FULL_REWRITE_TAC[top2_unions];
+  CONJ_TAC;
+  THM_INTRO_TAC[`Y`;`IMAGE (pointI) X`;`f`] FINITE_INJ;
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  FULL_REWRITE_TAC[INJ];
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `Y` UNABBREV_TAC;
+  TYPE_THEN `m` EXISTS_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 9 SYM;
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `Y` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `Y` UNABBREV_TAC;
+  ]);;
+  (* }}} *)
+
+let simple_arc_finite_lemma2 = prove_by_refinement(
+  `!e v v'. simple_arc_end e v v'==>
+    (?(N:num) t f.
+      (IMAGE t {i | i < N} SUBSET {x | &0 <= x /\ x <= &1}) /\
+      (f (&0) = v) /\ (f (&1) = v') /\
+      (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\
+      (!i j. (i < j) /\  (i < N) /\  (j < N) ==> (t i < t j)) /\
+              continuous f (top_of_metric (UNIV,d_real)) top2 /\
+              INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
+        (!x.   &0 <= x /\ x <= &1 ==>
+        ( (?m. f x = pointI m) <=> (?k.  (k < N) /\ (x = t k)))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_finite_lemma1;
+  THM_INTRO_TAC[`X`] real_finite_increase;
+  TYPE_THEN `CARD X` EXISTS_TAC;
+  TYPE_THEN `u` EXISTS_TAC;
+  TYPE_THEN `f` EXISTS_TAC;
+  (* - *)
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[BIJ;IMAGE;SURJ];
+  FULL_REWRITE_TAC[SUBSET];
+  TSPEC `x'` 11;
+  (* - *)
+  SUBCONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  TSPEC `x` 1;
+  REWR 1;
+  FULL_REWRITE_TAC[BIJ;SURJ];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ]);;
+  (* }}} *)
+
+let connected_unions_common = prove_by_refinement(
+  `!U (ZZ:(A->bool)->bool). (!Z. ZZ Z ==> connected U Z) /\
+     (!Z Z'. ZZ Z /\ ZZ Z' ==> ~(Z INTER Z' = EMPTY)) ==>
+     (connected U (UNIONS ZZ))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[connected];
+  SUBCONJ_TAC;
+  TYPE_THEN `UU = UNIONS U` ABBREV_TAC ;
+  REWRITE_TAC[UNIONS;SUBSET];
+  TSPEC `u` 1;
+  REWRITE_TAC[];
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  TYPE_THEN `!Z. ZZ Z ==> Z SUBSET A \/ Z SUBSET B` SUBAGOAL_TAC;
+  TSPEC `Z` 1;
+  REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 2 (REWRITE_RULE[UNIONS;SUBSET]);
+  REWRITE_TAC[SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `AA = {Z | ZZ Z /\ Z SUBSET A}` ABBREV_TAC ;
+  TYPE_THEN `BB = {Z | ZZ Z /\ Z SUBSET B}` ABBREV_TAC ;
+  TYPE_THEN `ZZ = AA UNION BB` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  TYPE_THEN `AA` UNABBREV_TAC;
+  TYPE_THEN `BB` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USE 11 (REWRITE_RULE[DE_MORGAN_THM;UNIONS;SUBSET;UNION]);
+  LEFT 11 "x";
+  LEFT 12 "x";
+  TYPE_THEN `AA` UNABBREV_TAC;
+  TYPE_THEN `BB` UNABBREV_TAC;
+  LEFT 11 "u";
+  LEFT 8 "u";
+  LEFT 12 "u";
+  LEFT 9 "u";
+  (* - *)
+  TYPE_THEN `ZZ u` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `ZZ u'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `u SUBSET A` SUBAGOAL_TAC;
+  TSPEC `u` 7;
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  USE 13(REWRITE_RULE[SUBSET]);
+  TSPEC `x` 13;
+  ASM_MESON_TAC[];
+  TYPE_THEN `u' SUBSET B` SUBAGOAL_TAC;
+  TSPEC `u'` 7;
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  USE 14(REWRITE_RULE[SUBSET]);
+  TSPEC `x'` 14;
+  ASM_MESON_TAC[];
+  (* - *)
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`u`;`u'`]);
+  USE 0 (REWRITE_RULE[EMPTY_EXISTS;INTER ]);
+  USE 3(REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `u''` 3;
+  ASM_MESON_TAC[subset_imp];
+  ]);;
+  (* }}} *)
+
+let connect_real_open = prove_by_refinement(
+  `!a b. connected
+       (top_of_metric (UNIV,d_real)) {x | a < x /\ x < b}`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `{x | a < x /\ x < b} = EMPTY` ASM_CASES_TAC;
+  REWRITE_TAC[connected_empty];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `ZZ = {Z | ?a' b'. a < a' /\ a' < u /\ u < b' /\ b' < b /\ (Z = {x | a' <= x /\ x <= b'})}` ABBREV_TAC ;
+  TYPE_THEN `{x | a < x /\ x < b} = UNIONS ZZ` SUBAGOAL_TAC;
+  TYPE_THEN `ZZ` UNABBREV_TAC;
+  REWRITE_TAC[UNIONS];
+  IMATCH_MP_TAC  EQ_EXT;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "u");
+  CONV_TAC (dropq_conv "x'");
+  TYPE_THEN `u < x` ASM_CASES_TAC;
+  TYPE_THEN `(a + u)/ &2` EXISTS_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  real_middle1_lt;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  real_middle2_lt;
+  UND 6 THEN UND 4 THEN REAL_ARITH_TAC;
+  TYPE_THEN `(a + x)/ &2` EXISTS_TAC;
+  TYPE_THEN `(u + b)/ &2` EXISTS_TAC;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  real_middle1_lt;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN `x` EXISTS_TAC;
+  USE 4 (MATCH_MP (REAL_ARITH `~(u < x) ==> (x <= u)`));
+  IMATCH_MP_TAC  real_middle2_lt;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  real_middle1_lt;
+  CONJ_TAC;
+  IMATCH_MP_TAC  real_middle2_lt;
+  CONJ_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
+  IMATCH_MP_TAC  real_middle2_lt;
+  UND 4 THEN UND 7 THEN REAL_ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `u'` UNABBREV_TAC;
+  UND 7 THEN UND 3 THEN UND 2 THEN UND 4 THEN REAL_ARITH_TAC;
+  (* - *)
+  IMATCH_MP_TAC  connected_unions_common;
+  CONJ_TAC;
+  TYPE_THEN `ZZ` UNABBREV_TAC;
+  REWRITE_TAC[connect_real];
+  TYPE_THEN `ZZ` UNABBREV_TAC;
+  TYPE_THEN `Z` UNABBREV_TAC;
+  TYPE_THEN `Z'` UNABBREV_TAC;
+  USE 4(REWRITE_RULE[EQ_EMPTY;INTER]);
+  TSPEC `u` 2;
+  KILL 3;
+  REPEAT (POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let int_neg_num_th = prove_by_refinement(
+  `!j. real_of_int (--: (&: j)) = -- (&j)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[int_neg_th;int_of_num_th;];
+  ]);;
+  (* }}} *)
+
+let closed_ball_subset_larger_open = prove_by_refinement(
+  `!n a r r'.
+     (r < r') ==> closed_ball (euclid n,d_euclid) a r SUBSET
+          open_ball (euclid n,d_euclid) a r'`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closed_ball;open_ball;SUBSET];
+  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_edge_closure = prove_by_refinement(
+  `!C e m n. edge e /\ simple_arc_end C (pointI m) (pointI n) /\
+     (!x. C x /\ ~(x = pointI m) /\ ~(x = pointI n) ==> e x) ==>
+     (closure top2 e (pointI m))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`e`] edge_euclid2;
+  FULL_REWRITE_TAC[edge];
+  TYPE_THEN `connected top2 C` SUBAGOAL_TAC;
+  USE 1 (MATCH_MP simple_arc_end_simple);
+  USE 1(MATCH_MP simple_arc_connected);
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`e`] closure_open_ball;
+  USE 6 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC  `(pointI m)` 6;
+  USE 5 (REWRITE_RULE[top2]);
+  UND 6 THEN ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  (* - *)
+  TYPE_THEN `?r. &0 < r /\ (r < &1/ &2) /\ (e INTER closed_ball (euclid 2, d_euclid) (pointI m) r = EMPTY)` SUBAGOAL_TAC;
+  TYPE_THEN `?s. &0 < s /\ s <= r /\ s <= &1/ &2` SUBAGOAL_TAC;
+  TYPE_THEN `min_real r (&1 / &2)` EXISTS_TAC;
+  REWRITE_TAC[min_real_le];
+  REWRITE_TAC[min_real];
+  COND_CASES_TAC;
+  TYPE_THEN `s/ &2` EXISTS_TAC;
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN `s` EXISTS_TAC;
+  REWRITE_TAC[REAL_LT_HALF2];
+  REWRITE_TAC[EQ_EMPTY;INTER];
+  LEFT 7 "z";
+  TSPEC `x` 7;
+  UND 7 THEN ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `s/ &2 < r` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN  `s` EXISTS_TAC;
+  REWRITE_TAC[REAL_LT_HALF2];
+  THM_INTRO_TAC[`2`;`pointI m`;`s / &2`;`r`] closed_ball_subset_larger_open;
+  ASM_MESON_TAC[subset_imp];
+  (*  - *)
+  THM_INTRO_TAC[`C`;`pointI m`;`pointI n`] simple_arc_end_distinct;
+  FULL_REWRITE_TAC[connected];
+  TYPE_THEN `A = open_ball(euclid 2,d_euclid) (pointI m) r'` ABBREV_TAC ;
+  TYPE_THEN `B = closed_ball(euclid 2,d_euclid) (pointI m) r'` ABBREV_TAC ;
+  TYPE_THEN `E = euclid 2 DIFF B` ABBREV_TAC ;
+  (* -A *)
+  TYPE_THEN `top2 A /\ top2 E /\ (A INTER E = {}) /\ C SUBSET A UNION E /\ A (pointI m) /\ E (pointI n)` SUBAGOAL_TAC;
+  CONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  open_ball_open;
+  CONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[top2];
+  THM_INTRO_TAC[`top2`;`B`] closed_open;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  closed_ball_closed;
+  FULL_REWRITE_TAC[open_DEF;top2_unions ];
+  FULL_REWRITE_TAC[top2];
+  (* --// *)
+  CONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[INTER;EQ_EMPTY;DIFF];
+  ASM_MESON_TAC[subset_imp;open_ball_sub_closed];
+  (* -- *)
+  TYPE_THEN `A (pointI m)` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  IMATCH_MP_TAC  (INR open_ball_nonempty);
+  REWRITE_TAC[pointI];
+  (* -- *)
+  TYPE_THEN `E (pointI n)` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[DIFF];
+  TYPE_THEN `B` UNABBREV_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[pointI];
+  FULL_REWRITE_TAC[pointI_inj];
+  TYPE_THEN `open_ball (euclid 2,d_euclid) (pointI m) (&1 / &2) (pointI n)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`2`;`pointI m`;`r'`;`&1 / &2`] closed_ball_subset_larger_open;
+  ASM_MESON_TAC[subset_imp];
+  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`pointI m`;`pointI n`;`pointI m`;`&1 / &2`] BALL_DIST;
+  IMATCH_MP_TAC  (INR open_ball_nonempty);
+  REWRITE_TAC[pointI];
+  TYPE_THEN `&2 * &1 / &2 = &1` SUBAGOAL_TAC;
+  REWR 17;
+  USE 17 (MATCH_MP d_euclid_pointI_pos);
+  TYPE_THEN `m` UNABBREV_TAC;
+  (* --// *)
+  REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `e x \/ (x = pointI m) \/ (x = pointI n)` SUBAGOAL_TAC;
+  TSPEC `x` 0;
+  ASM_MESON_TAC[];
+  UND 19 THEN REP_CASES_TAC;
+  DISJ2_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[DIFF];
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  ASM_MESON_TAC[subset_imp];
+  DISJ1_TAC;
+  DISJ2_TAC;
+  (* - *)
+  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`A`;`E`]);
+  (* -B *)
+  TYPE_THEN `C (pointI m)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `C (pointI n)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  UNIFY_EXISTS_TAC;
+  USE 19 (REWRITE_RULE[INTER;EQ_EMPTY ]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  USE 24 (REWRITE_RULE[SUBSET]); (* -- *)
+  ASM_MESON_TAC[];
+  USE 24 (REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let vc_edge_pointI = prove_by_refinement(
+  `!m n. vc_edge m (pointI n) <=> (n = m) \/ (n = up m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[vc_edge;cell_clauses;INR IN_SING;UNION];
+  TYPE_THEN `pointI m + e2 = pointI (up m)` SUBAGOAL_TAC;
+  REWRITE_TAC[up;e2;point_add ;pointI];
+  REDUCE_TAC;
+  REWRITE_TAC[int_of_num_th;int_add_th];
+  REWRITE_TAC[pointI_inj];
+  ]);;
+  (* }}} *)
+
+let hc_edge_pointI = prove_by_refinement(
+  `!m n. hc_edge m (pointI n) <=> (n = m) \/ (n = right m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[hc_edge;cell_clauses;INR IN_SING;UNION];
+  TYPE_THEN `pointI m + e1 = pointI (right m)` SUBAGOAL_TAC;
+  REWRITE_TAC[right;e1;point_add ;pointI];
+  REDUCE_TAC;
+  REWRITE_TAC[int_of_num_th;int_add_th];
+  REWRITE_TAC[pointI_inj];
+  ]);;
+  (* }}} *)
+
+let mk_segment_v = prove_by_refinement(
+  `!r s b x. (r <= s) ==> (mk_segment (point(b,r)) (point(b,s)) x <=>
+      (?t. (r <= t /\ t <= s /\ (x = point(b,t)))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[mk_segment];
+  REWRITE_TAC[point_scale;point_add;GSYM REAL_RDISTRIB;REAL_ARITH `a + &1 - a = &1`;REAL_ARITH `&1 * b = b`];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `a * r + (&1 - a) *s` EXISTS_TAC;
+  CONJ_TAC;
+  ineq_le_tac `r + (s - r)* (&1 - a) = a * r + (&1 - a)*s`;
+  ineq_le_tac `(a * r + (&1 - a) * s) + (s - r)*a = s`;
+  TYPE_THEN `s = r` ASM_CASES_TAC;
+  REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_RDISTRIB;REAL_ARITH `(a + &1 - a = &1) /\ (&1* a = a)`];
+  TYPE_THEN `&0` EXISTS_TAC;
+  UND 2 THEN UND 3 THEN UND 4 THEN REAL_ARITH_TAC;
+  (* - *)
+  REWRITE_TAC[point_inj;PAIR_SPLIT];
+  TYPE_THEN `v = &1/(s - r)` ABBREV_TAC ;
+  TYPE_THEN `(s - r)*v = &1` SUBAGOAL_TAC;
+  TYPE_THEN `v` UNABBREV_TAC;
+  REWRITE_TAC[GSYM real_div_assoc];
+  REDUCE_TAC;
+  IMATCH_MP_TAC  REAL_DIV_REFL;
+  UND 5 THEN UND 4 THEN REAL_ARITH_TAC;
+  TYPE_THEN `v*(s - t)` EXISTS_TAC;
+  TYPE_THEN `&0 < v` SUBAGOAL_TAC;
+  TYPE_THEN `v` UNABBREV_TAC;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  UND 7 THEN UND 2 THEN REAL_ARITH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_LCANCEL_IMP;
+  TYPE_THEN `(s - r)` EXISTS_TAC;
+  CONJ_TAC;
+  UND 4 THEN UND 0 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_MUL_ASSOC];
+  REDUCE_TAC;
+  UND 3 THEN REAL_ARITH_TAC;
+  TYPE_THEN `(v * (s - t)) * r + (&1 - v * (s - t)) * s = s + ((s - r)*v)*(t - s)` SUBAGOAL_TAC THENL [real_poly_tac;REDUCE_TAC];
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+
+  ]);;
+  (* }}} *)
+
+let mk_segment_vc = prove_by_refinement(
+  `!m. mk_segment (pointI m) (pointI (up m)) = vc_edge m`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[up;vc_edge;v_edge;pointI;UNION ;e2;];
+  IMATCH_MP_TAC  EQ_EXT;
+  THM_INTRO_TAC[`real_of_int (SND m)`;`real_of_int(SND m + &:1)`;`real_of_int (FST m)`;`x`] mk_segment_v;
+  REWRITE_TAC[GSYM int_le];
+  INT_ARITH_TAC;
+  REWRITE_TAC[point_add;];
+  REDUCE_TAC;
+  (* - *)
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  TYPE_THEN `t = real_of_int (SND m)` ASM_CASES_TAC;
+ REWRITE_TAC[INR IN_SING];
+  TYPE_THEN `t = real_of_int (SND m) + &1` ASM_CASES_TAC;
+  REWRITE_TAC[INR IN_SING];
+  DISJ1_TAC;
+  CONV_TAC (dropq_conv "u");
+CONV_TAC (dropq_conv "v");
+  FULL_REWRITE_TAC[int_add_th;int_of_num_th;];
+  UND 5 THEN UND 4 THEN UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
+  (* - *)
+  UND 1 THEN REP_CASES_TAC ;
+  TYPE_THEN `v` EXISTS_TAC;
+  UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
+  FULL_REWRITE_TAC [INR IN_SING];
+  TYPE_THEN `real_of_int (SND m)` EXISTS_TAC;
+  REWRITE_TAC[int_add_th;int_of_num_th];
+  REAL_ARITH_TAC;
+  FULL_REWRITE_TAC [INR IN_SING];
+  TYPE_THEN `real_of_int (SND m) + &1` EXISTS_TAC;
+  REWRITE_TAC[int_add_th;int_of_num_th];
+  REAL_ARITH_TAC;
+  (* Tue Dec 21 18:22:18 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let mk_segment_hc = prove_by_refinement(
+  `!m. mk_segment (pointI m) (pointI (right m)) = hc_edge m`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[right;hc_edge;h_edge;pointI;UNION ;e1;];
+  IMATCH_MP_TAC  EQ_EXT;
+  THM_INTRO_TAC[`real_of_int (FST m)`;`real_of_int(FST m + &:1)`;`real_of_int (SND  m)`;`x`] mk_segment_h;
+  REWRITE_TAC[int_add_th;int_of_num_th;];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[point_add;];
+  REDUCE_TAC;
+  FULL_REWRITE_TAC[int_add_th;int_of_num_th;];
+  (* - *)
+  REWRITE_TAC[INR IN_SING];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[point_inj;PAIR_SPLIT ];
+  TYPE_THEN `t = real_of_int (FST  m)` ASM_CASES_TAC;
+  TYPE_THEN `t = real_of_int (FST  m) + &1` ASM_CASES_TAC;
+  CONV_TAC (dropq_conv "u");
+CONV_TAC (dropq_conv "v");
+  UND 5 THEN UND 4 THEN UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
+  (* - *)
+  UND 1 THEN REP_CASES_TAC ;
+  TYPE_THEN `u` EXISTS_TAC;
+  UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
+  TYPE_THEN `real_of_int (FST  m)` EXISTS_TAC;
+  REAL_ARITH_TAC;
+  TYPE_THEN `real_of_int (FST  m) + &1` EXISTS_TAC;
+  REAL_ARITH_TAC;
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_edge_full_closure = prove_by_refinement(
+  `!C e m n. edge e /\ simple_arc_end C (pointI m) (pointI n) /\
+    (!x. C x /\ ~(x = pointI m) /\ ~(x = pointI n) ==> e x) ==>
+    (C = closure top2 e ) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`;`e`;`m`;`n`] simple_arc_end_edge_closure;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`;`e`;`n`;`m`] simple_arc_end_edge_closure;
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  TYPE_THEN `C SUBSET closure top2 e` SUBAGOAL_TAC;
+  REWRITE_TAC[SUBSET];
+  TYPE_THEN `e x \/ (x = pointI m) \/ (x = pointI n)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  UND 6 THEN REP_CASES_TAC;
+  THM_INTRO_TAC[`top2`;`e`] subset_closure;
+  REWRITE_TAC[top2_top];
+  ASM_MESON_TAC[subset_imp];
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `B = closure top2 e` ABBREV_TAC ;
+  IMATCH_MP_TAC  simple_arc_end_inj;
+  TYPE_THEN `B` EXISTS_TAC;
+  TYPE_THEN `pointI m` EXISTS_TAC;
+  TYPE_THEN `pointI n` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  TYPE_THEN `simple_arc_end B (pointI m) (pointI n)` BACK_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  (* -A *)
+  THM_INTRO_TAC[`C`;`pointI m`;`pointI n`] simple_arc_end_distinct;
+  FULL_REWRITE_TAC[pointI_inj];
+  (* - *)
+  TYPE_THEN `mk_segment (pointI m) (pointI n) = B` SUBAGOAL_TAC ;
+  FULL_REWRITE_TAC[edge];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;];
+  TYPE_THEN `B` UNABBREV_TAC;
+  TYPE_THEN `(m = m') /\ (n = up m') \/ (m = up m') /\ (n = m')` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[vc_edge_pointI;]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `n` UNABBREV_TAC;
+  REWR 3;
+  TYPE_THEN `n` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  (* --- *)
+  REWRITE_TAC[GSYM mk_segment_vc];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  MESON_TAC[mk_segment_sym];
+  (* -- *)
+  TYPE_THEN `e` UNABBREV_TAC;
+  FULL_REWRITE_TAC[v_edge_closure;h_edge_closure;];
+  TYPE_THEN `B` UNABBREV_TAC;
+  TYPE_THEN `(m = m') /\ (n = right m') \/ (m = right m') /\ (n = m')` SUBAGOAL_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[hc_edge_pointI;]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `n` UNABBREV_TAC;
+  REWR 3;
+  TYPE_THEN `n` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  (* -- *)
+  REWRITE_TAC[GSYM mk_segment_hc];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  MESON_TAC[mk_segment_sym];
+  KILL 6;
+  TYPE_THEN `B` UNABBREV_TAC;
+  IMATCH_MP_TAC  mk_segment_simple_arc_end;
+  REWRITE_TAC[pointI_inj];
+  REWRITE_TAC[pointI];
+  ]);;
+  (* }}} *)
+
+let simple_arc_finite_lemma3 = prove_by_refinement(
+  `!E e v v'. simple_arc_end e v v' /\
+      FINITE E /\
+      e SUBSET UNIONS E /\
+      E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)) /\
+      E (eps_hyper T (v' 0)) /\ E (eps_hyper F (v' 1)) /\
+      (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\
+      (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) ==>
+      (?(N:num) t f.
+      (IMAGE t {i | i < N} SUBSET {x | &0 <= x /\ x <= &1}) /\
+      (f (&0) = v) /\ (f (&1) = v') /\
+      (e = IMAGE f {x | &0 <= x /\ x <= &1}) /\
+      (!i j. (i < j) /\  (i < N) /\  (j < N) ==> (t i < t j)) /\
+              continuous f (top_of_metric (UNIV,d_real)) top2 /\
+              INJ f {x | &0 <= x /\ x <= &1} (euclid 2) /\
+        (!x.   &0 <= x /\ x <= &1 ==>
+        ( (?m. f x = pointI m) = (?k.  (k < N) /\ (x = t k)))) /\
+       (&0 = t 0) /\ (&1 = t (N - 1)) /\
+      (!i. (SUC i < N) ==> (?ed. (edge ed) /\
+           (IMAGE f { x | t i <= x /\ x <= t (SUC i) } =
+             closure top2 ed))))
+   `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_finite_lemma2;
+  TYPE_THEN `N` EXISTS_TAC;
+  TYPE_THEN `t` EXISTS_TAC;
+  TYPE_THEN `f` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!w. (euclid 2 w ) /\ E (eps_hyper T (w 0)) /\ E (eps_hyper F (w 1)) ==> (?m. (w = pointI m))` SUBAGOAL_TAC;
+  COPY 0;
+  COPY 1;
+  TSPEC `eps_hyper F (w 1)` 21;
+  TSPEC `eps_hyper T (w 0)` 1;
+  TSPEC `z` 20;
+  TSPEC `eps` 20;
+  TSPEC `z'` 0;
+  TSPEC `eps'` 0;
+  FULL_REWRITE_TAC[eps_hyper_inj];
+  TYPE_THEN `z` UNABBREV_TAC;
+  TYPE_THEN `z'` UNABBREV_TAC;
+  TYPE_THEN `(?j. w 0 = -- &j)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  TYPE_THEN `?j. w 1 = -- &j` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[pointI];
+  TYPE_THEN `(-- &:j, -- &: j')` EXISTS_TAC;
+  REWRITE_TAC[int_neg;int_abstr;int_of_num_th;];
+  TYPE_THEN `!j. (integer (-- &j))` SUBAGOAL_TAC;
+  REWRITE_TAC[is_int];
+  MESON_TAC[];
+  USE 24 (REWRITE_RULE[int_rep]);
+  USE 19 (MATCH_MP point_onto);
+  REWRITE_TAC[point_inj];
+  TYPE_THEN `w` UNABBREV_TAC;
+  FULL_REWRITE_TAC[coord01;PAIR_SPLIT];
+  (* -A *)
+  SUBCONJ_TAC;
+  TYPE_THEN `?m. v = pointI m` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_end;
+  USE 8 (MATCH_MP simple_arc_end_simple);
+  USE 8 (MATCH_MP simple_arc_euclid);
+  ASM_MESON_TAC[subset_imp];
+  UND 9 THEN (DISCH_THEN (THM_INTRO_TAC[`&0`]));
+  REDUCE_TAC;
+  TYPE_THEN `(?k. k <| N /\ (&0 = t k))` SUBAGOAL_TAC;
+  USE 9 SYM;
+  TYPE_THEN `m` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `~(0 < k) ==> (k = 0)`);
+  USE 16 (REWRITE_RULE[IMAGE;SUBSET ]);
+  USE 16 (CONV_RULE NAME_CONFLICT_CONV);
+  TSPEC `t 0` 16;
+  LEFT 16 "x'" ;
+  TSPEC `0` 16;
+  TYPE_THEN `0 < N` SUBAGOAL_TAC;
+  UND 21 THEN UND 20 THEN ARITH_TAC;
+  REWR 16;
+  USE 23 (MATCH_MP (ARITH_RULE `x <= y ==> ~( y < x)`));
+  UND 23 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* -B *)
+  SUBCONJ_TAC;
+  TYPE_THEN `?m. v' = pointI m` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  THM_INTRO_TAC[`e`;`v`;`v'`] simple_arc_end_end2;
+  USE 8 (MATCH_MP simple_arc_end_simple);
+  USE 8 (MATCH_MP simple_arc_euclid);
+  ASM_MESON_TAC[subset_imp];
+  UND 9 THEN (DISCH_THEN (THM_INTRO_TAC[`&1`]));
+  REDUCE_TAC;
+  REWRITE_TAC[ARITH_RULE `1 <= 1`];
+  USE 18 SYM;
+  REDUCE_TAC;
+  (* -- *)
+  TYPE_THEN `(?k. k <| N /\ (&1 = t k))` SUBAGOAL_TAC;
+  USE 9 SYM;
+  TYPE_THEN `m` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `(k < N) /\ ~(k < N - 1) ==> (k = N - 1)`);
+  USE 16 (REWRITE_RULE[IMAGE;SUBSET ]);
+  USE 22 (CONV_RULE NAME_CONFLICT_CONV);
+  TSPEC `t (N-1)` 22;
+  LEFT 22 "x'" ;
+  TSPEC `N-1` 22;
+  UND 22 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  UND 21 THEN ARITH_TAC;
+  REWR 22;
+  USE 22 (MATCH_MP (ARITH_RULE `x <= y ==> ~( y < x)`));
+  UND 22 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 16 THEN ARITH_TAC;
+  (* -C *)
+  USE 20 SYM;
+  USE 18 SYM;
+  TYPE_THEN `&0 <= t i /\ t i <= &1` SUBAGOAL_TAC;
+  USE 16 (REWRITE_RULE[SUBSET;IMAGE]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `i` EXISTS_TAC;
+  UND 19 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `&0 <= t (SUC i) /\ t (SUC i) <= &1` SUBAGOAL_TAC;
+  USE 16 (REWRITE_RULE[SUBSET;IMAGE]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `SUC i` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `connected top2 (IMAGE f {x | t i < x /\ x < t (SUC i)})` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  connect_image;
+  TYPE_THEN `top_of_metric (UNIV,d_real)` EXISTS_TAC;
+  REWRITE_TAC[top2_unions];
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;SUBSET];
+  USE 10 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 26 THEN UND 27 THEN UND 23 THEN UND 22 THEN REAL_ARITH_TAC;
+  (* --D *)
+  REWRITE_TAC[connect_real_open];
+  (* - *)
+  TYPE_THEN `!x. &0 <= x /\ x <= &1 /\ ~(IMAGE t {j | j<| N} x) ==> (?e. edge e /\ (e (f x)))` SUBAGOAL_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  USE 6 (REWRITE_RULE[SUBSET;UNIONS;IMAGE  ]);
+  USE 6 (CONV_RULE NAME_CONFLICT_CONV);
+  TSPEC `f x` 6;
+  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TSPEC `u'` 1;
+  REWRITE_TAC[];
+  TYPE_THEN `u'` UNABBREV_TAC;
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`z`;`eps`]);
+  TYPE_THEN `z` UNABBREV_TAC;
+  (* --E *)
+  TYPE_THEN `euclid 2 (f x)` SUBAGOAL_TAC;
+  USE 8 (MATCH_MP simple_arc_end_simple);
+  USE 0 (MATCH_MP simple_arc_euclid);
+  USE 0 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `?C. cell C /\ C (f x)` SUBAGOAL_TAC;
+  USE 0 (MATCH_MP point_onto);
+  THM_INTRO_TAC[`p`] cell_unions;
+  USE 1 (REWRITE_RULE[UNIONS]);
+  TYPE_THEN `u` EXISTS_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  FULL_REWRITE_TAC[cell];
+  UND 29 THEN REP_CASES_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INR IN_SING];
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  TYPE_THEN `(?k. k <| N /\ (x = t k))` SUBAGOAL_TAC;
+  USE 9 SYM;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 26 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[edge_h];
+  REWRITE_TAC[edge_v];
+  TYPE_THEN `C` UNABBREV_TAC;
+  USE 1 (REWRITE_RULE[squ]);
+  TYPE_THEN `f x` UNABBREV_TAC;
+  USE 6 (REWRITE_RULE[eps_hyper]);
+  UND 6 THEN COND_CASES_TAC;
+   FULL_REWRITE_TAC[e1];
+  FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] line2D_F];
+  FULL_REWRITE_TAC[point_inj];
+  TYPE_THEN `p'` UNABBREV_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  (* ---F *)
+  FULL_REWRITE_TAC[GSYM int_neg_num_th;GSYM int_lt;];
+  UND 30 THEN UND 31 THEN INT_ARITH_TAC;
+  (* -- *)
+   FULL_REWRITE_TAC[e2];
+  FULL_REWRITE_TAC[ONCE_REWRITE_RULE[EQ_SYM_EQ] line2D_S];
+  FULL_REWRITE_TAC[point_inj];
+  TYPE_THEN `p'` UNABBREV_TAC;
+  TYPE_THEN `v''` UNABBREV_TAC;
+  FULL_REWRITE_TAC[GSYM int_neg_num_th;GSYM int_lt;];
+  UND 1 THEN UND 29 THEN INT_ARITH_TAC;
+  (* -G *)
+  THM_INTRO_TAC[`(IMAGE f {x | t i < x /\ x < t (SUC i)})`] connected_in_edge;
+  REWRITE_TAC[IMAGE;SUBSET;UNIONS];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  CONJ_TAC;
+  UND 29 THEN UND 22 THEN REAL_ARITH_TAC;
+  CONJ_TAC;
+  UND 23 THEN UND 28 THEN REAL_ARITH_TAC;
+  USE 30 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `x'` UNABBREV_TAC;
+  USE 28 (MATCH_MP (REAL_ARITH `x < y ==> ~(y < x) /\ ~(x = y)`));
+  UND 30 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC   (ARITH_RULE  `~(x = y) /\ ~(x <| y) ==> (y < x)`);
+  CONJ_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  USE 29 (MATCH_MP (REAL_ARITH `x < y ==> ~(y < x) /\ ~(x = y)`));
+  UND 32 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `i <| N` SUBAGOAL_TAC;
+  UND 19 THEN ARITH_TAC;
+  IMATCH_MP_TAC   (ARITH_RULE  `~(x = y) /\ ~(x <| y) ==> (y < x)`);
+  CONJ_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  UND 33 THEN UND 30 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `e'` EXISTS_TAC;
+  (* -H *)
+  TYPE_THEN `C = IMAGE f {x | t i <= x /\ x <= t (SUC i)}` ABBREV_TAC ;
+  IMATCH_MP_TAC  simple_arc_end_edge_full_closure;
+  KILL 5;
+  KILL 4;
+  KILL 2;
+  KILL 3;
+  KILL 0;
+  KILL 17;
+  TYPE_THEN `v` UNABBREV_TAC;
+  TYPE_THEN `v'` UNABBREV_TAC;
+  TYPE_THEN `!k. k <| N ==> (?m. f (t k) = pointI m)` SUBAGOAL_TAC;
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`t k`]);
+  USE 16 (REWRITE_RULE[IMAGE;SUBSET]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `k` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  COPY 0;
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
+  UND 19 THEN ARITH_TAC;
+  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]);
+  TYPE_THEN `m` EXISTS_TAC;
+  TYPE_THEN `m'` EXISTS_TAC;
+  IMATCH_MP_TAC  (TAUT `A /\ B ==> B /\ A`);
+  CONJ_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  USE 5 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `pointI m` UNABBREV_TAC;
+  TYPE_THEN `pointI m'` UNABBREV_TAC;
+  USE 27 (REWRITE_RULE[IMAGE;SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `x'` EXISTS_TAC;
+  TYPE_THEN `~(x' = t i)` SUBAGOAL_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `~(x' = t (SUC i))` SUBAGOAL_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  UND 5 THEN UND 2 THEN UND 15 THEN UND 14 THEN REAL_ARITH_TAC;
+  (* - *)
+  REWRITE_TAC[simple_arc_end];
+  THM_INTRO_TAC[`&0`;`&1`;`t i`;`t (SUC i)`;`C`;`f`;`t i`;`t (SUC i)`] arc_restrict;
+  REWRITE_TAC[REAL_ARITH `x <= x`];
+  USE 11 (REWRITE_RULE[top2]);
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 19 THEN ARITH_TAC;
+  IMATCH_MP_TAC  inj_subset_domain;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC[SUBSET];
+  UND 4 THEN UND 5 THEN UND 22 THEN UND 23 THEN REAL_ARITH_TAC;
+  TYPE_THEN `g` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[top2];
+  (* Tue Dec 21 19:05:25 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let order_lt_imp_psegment = prove_by_refinement(
+  `!f n.
+     INJ f {p | p <| n} edge /\
+          0 <| n /\
+          (!i j.
+               i <| n /\ j <| n /\ (i < j)
+               ==> (adj (f i) (f j) = (SUC i = j) ))
+          ==> psegment (IMAGE f {p | p <| n})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  order_imp_psegment;
+  REP_BASIC_TAC;
+  TYPE_THEN `i <| j` ASM_CASES_TAC;
+  TYPE_THEN `~(SUC j = i)` SUBAGOAL_TAC;
+  UND 6 THEN UND 5 THEN ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `i = j` ASM_CASES_TAC;
+  REWRITE_TAC[adj];
+  UND 7 THEN ARITH_TAC;
+  TYPE_THEN `j <| i` SUBAGOAL_TAC;
+  UND 6 THEN UND 5 THEN ARITH_TAC;
+  TYPE_THEN `~(SUC i = j)` SUBAGOAL_TAC;
+  UND 8 THEN UND 7 THEN ARITH_TAC;
+  ONCE_REWRITE_TAC[adj_symm];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ]);;
+  (* }}} *)
+
+
+let simple_arc_finite_lemma4 = prove_by_refinement(
+  `!E e v v'. simple_arc_end e v v' /\
+      FINITE E /\
+      e SUBSET UNIONS E /\
+      E (eps_hyper T (v 0)) /\ E (eps_hyper F (v 1)) /\
+      E (eps_hyper T (v' 0)) /\ E (eps_hyper F (v' 1)) /\
+      (!e. E e ==> (?z eps. e = eps_hyper eps z)) /\
+      (!z eps. E (eps_hyper eps z) ==> (?j. z = -- &j)) ==>
+   (?S a b. segment_end S a b /\ (v = pointI a) /\ (v' = pointI b) /\
+      (e = closure top2 (UNIONS S)))
+   `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`E`;`e`;`v`;`v'`]simple_arc_finite_lemma3;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  REWRITE_TAC[segment_end];
+  LEFT 9 "ed";
+  LEFT 9 "ed";
+  TYPE_THEN `S = IMAGE ed {p | p <| N - 1}` ABBREV_TAC ;
+  TYPE_THEN `S` EXISTS_TAC;
+  TYPE_THEN `!i. i <| N ==> (?m. f (t i) = pointI m)` SUBAGOAL_TAC;
+  USE 10 SYM;
+  USE 11 SYM;
+  UND 12 THEN DISCH_THEN (THM_INTRO_TAC[`t i`]);
+  USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `0 <| N` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `~(N = 0) ==> (0 <| N)`);
+  TYPE_THEN `N` UNABBREV_TAC;
+  FULL_REWRITE_TAC[ARITH_RULE `0 -| 1 = 0`];
+  UND 10 THEN UND 11 THEN REAL_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `?a. f (t 0) = pointI a` SUBAGOAL_TAC;
+  TYPE_THEN `?b. f (t (N - 1)) = pointI b` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 22 THEN ARITH_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `v = pointI a` SUBAGOAL_TAC;
+  TYPE_THEN `v` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `v' = pointI b` SUBAGOAL_TAC;
+  TYPE_THEN `v'` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  (* -A *)
+  TYPE_THEN `(INJ ed {p | p <| N-1 } edge) /\ ( 0 <| N-1) /\ (!i j. i <| N-1 /\ j <| N-1 /\ i <| j ==> (adj (ed i) (ed j) <=> (SUC i = j)))` SUBAGOAL_TAC;
+  TYPE_THEN `S` UNABBREV_TAC;
+  SUBCONJ_TAC; (* // *)
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  UND 20 THEN ARITH_TAC;
+  TYPE_THEN `!x y. x < y /\ y <| N - 1 ==> ~(ed x = ed y)` SUBAGOAL_TAC;
+  TYPE_THEN `t x' < t y'` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 31 THEN UND 30 THEN ARITH_TAC;
+  COPY 9;
+  UND 33 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  UND 31 THEN UND 30 THEN ARITH_TAC;
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`y'`]);
+  UND 30 THEN ARITH_TAC;
+  TYPE_THEN `ed x'` UNABBREV_TAC;
+  TYPE_THEN `IMAGE f {x | t x' <= x /\ x <= t (SUC x')} (f (t x'))` SUBAGOAL_TAC;
+  USE 33 SYM;
+  IMATCH_MP_TAC  image_imp;
+  CONJ_TAC;
+  REAL_ARITH_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 31 THEN UND 30 THEN ARITH_TAC;
+  TYPE_THEN `IMAGE f {x | t y' <= x /\ x <= t (SUC y')} (f (t x'))` SUBAGOAL_TAC;
+  USE 33 SYM;
+  ASM_REWRITE_TAC[];
+  USE 36 (REWRITE_RULE[IMAGE]);
+  USE 13 (REWRITE_RULE[INJ]);
+  TYPE_THEN `t x' = x''` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 11 SYM;
+  USE 10 SYM;
+  USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `x'` EXISTS_TAC;
+  UND 31 THEN UND 30 THEN ARITH_TAC;
+  TYPE_THEN `&0 <= t y' /\ t y' <= &1` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `y'` EXISTS_TAC;
+  UND 30 THEN ARITH_TAC;
+  CONJ_TAC;
+  UND 41 THEN UND 38 THEN ARITH_TAC;
+  TYPE_THEN `&0 <= t (SUC y') /\ t (SUC y') <= &1` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `SUC y'` EXISTS_TAC;
+  UND 30 THEN ARITH_TAC;
+  UND 42 THEN UND 37 THEN ARITH_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  UND 38 THEN UND 32 THEN REAL_ARITH_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE  `(~(x <| y) /\ ~(y < x)) ==> (x = y)`);
+  CONJ_TAC;
+  UND 30 THEN UND 29 THEN UND 27 THEN UND 20 THEN MESON_TAC[];
+  UND 30 THEN UND 29 THEN UND 28 THEN UND 20 THEN MESON_TAC[];
+  (* -- *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `~(0 = N-1) ==> (0 <| N- 1)`);
+  TYPE_THEN `N -| 1` UNABBREV_TAC;
+  UND 10 THEN UND 11 THEN REAL_ARITH_TAC;
+  (* --B *)
+  TYPE_THEN `!i u. (i <| N - 1) ==> (closure top2 (ed i) u <=> (?x. (u = f x) /\ t i <= x /\ x <= t (SUC i)))` SUBAGOAL_TAC;
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
+  UND 31 THEN ARITH_TAC;
+  USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `u` 9;
+  USE 9 SYM;
+  REWRITE_TAC[IMAGE];
+  REWRITE_TAC[CONJ_ACI];
+  (* -- *)
+  REWRITE_TAC[adj;EMPTY_EXISTS;INTER ];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `x = x'` SUBAGOAL_TAC;
+  USE 13 (REWRITE_RULE[INJ]);
+  USE 10 SYM;
+  USE 11 SYM;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `!x j. j < N -| 1 /\ t j <= x /\ x <= t (SUC j) ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC;
+  USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
+  TYPE_THEN `&0 <= t j' /\ t j' <= &1` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `j'` EXISTS_TAC;
+  UND 41 THEN ARITH_TAC;
+  TYPE_THEN `&0 <= t (SUC j') /\ t (SUC j') <= &1` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `SUC j'` EXISTS_TAC;
+  UND 41 THEN ARITH_TAC;
+  UND 44 THEN UND 39 THEN UND 43 THEN UND 40 THEN REAL_ARITH_TAC;
+  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN  `i` EXISTS_TAC;
+  TYPE_THEN `j` EXISTS_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `t i < t j` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 28 THEN UND 29 THEN ARITH_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `t j <= t (SUC i)` SUBAGOAL_TAC;
+  UND 35 THEN UND 33 THEN REAL_ARITH_TAC;
+  USE 40 (MATCH_MP (REAL_ARITH `x <= y ==> ~(y < x)`));
+  UND 40 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 39 THEN UND 27 THEN UND 28 THEN UND 29 THEN ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `j` UNABBREV_TAC;
+  CONJ_TAC;
+  TYPE_THEN `i = SUC i` SUBAGOAL_TAC;
+  USE 20 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 33 THEN ARITH_TAC;
+  TYPE_THEN `f (t (SUC i))` EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `t (SUC i)` EXISTS_TAC;
+  REWRITE_TAC[REAL_ARITH `x <= x`];
+  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 28 THEN ARITH_TAC;
+  TYPE_THEN `t (SUC i)` EXISTS_TAC;
+  REWRITE_TAC[REAL_ARITH `x <= x`];
+  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 28 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `!i u. (i <| N - 1) ==> (closure top2 (ed i) u <=> (?x. (u = f x) /\ t i <= x /\ x <= t (SUC i)))` SUBAGOAL_TAC;
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
+  UND 30 THEN ARITH_TAC;
+  USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `u` 9;
+  USE 9 SYM;
+  REWRITE_TAC[IMAGE];
+  REWRITE_TAC[CONJ_ACI];
+  (* - *)
+  USE 11 SYM;
+  USE 10 SYM;
+  TYPE_THEN `!x j. j < N -| 1 /\ t j <= x /\ x <= t (SUC j) ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC;
+  USE 19 (REWRITE_RULE[IMAGE;SUBSET]);
+  TYPE_THEN `&0 <= t j /\ t j <= &1` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `j` EXISTS_TAC;
+  UND 33 THEN ARITH_TAC;
+  TYPE_THEN `&0 <= t (SUC j) /\ t (SUC j) <= &1` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `SUC j` EXISTS_TAC;
+  UND 33 THEN ARITH_TAC;
+  UND 36 THEN UND 31 THEN UND 35 THEN UND 32 THEN REAL_ARITH_TAC;
+  (* -C *)
+  ONCE_REWRITE_TAC[CONJ_ACI];
+  SUBCONJ_TAC;
+  THM_INTRO_TAC[`ed`;`N-| 1`] order_lt_imp_psegment;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `S` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `{a, b} SUBSET endpoint S` SUBAGOAL_TAC;
+  REWRITE_TAC[SUBSET;INR in_pair];
+  REWRITE_TAC[endpoint];
+  THM_INTRO_TAC[`S`;`pointI x`] num_closure1;
+  USE 32 (REWRITE_RULE[psegment;segment]);
+  FIRST_ASSUM DISJ_CASES_TAC; (* // *)
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `ed (N -2)` EXISTS_TAC;
+  TYPE_THEN `S` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `x' < N -| 2` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `x' < N -| 1 /\ ~(x' = N-2) ==> x' < N -2`);
+  PROOF_BY_CONTR_TAC;
+  REWR 37;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  (* ---- *)
+  TYPE_THEN `pointI b` UNABBREV_TAC;
+  UND 20 THEN UND 30 THEN UND 36 THEN SIMP_TAC[];
+  USE 10 SYM;
+  TYPE_THEN `t (N -1) = x''` SUBAGOAL_TAC;
+  USE 13 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 10 SYM;
+  REDUCE_TAC;
+  REWRITE_TAC[ARITH_RULE `1 <= 1`];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN  `x'` EXISTS_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  USE 20 (MATCH_MP (REAL_ARITH  `x <= y ==> ~( y < x)`));
+  UND 20 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 37 THEN ARITH_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  CONJ_TAC;
+  TYPE_THEN `N-| 2` EXISTS_TAC;
+  UND 28 THEN ARITH_TAC;
+  TYPE_THEN `N -| 2 < N -| 1` SUBAGOAL_TAC;
+  UND 28 THEN ARITH_TAC;
+  TYPE_THEN `t (N - 1)` EXISTS_TAC;
+  TYPE_THEN `SUC (N - 2) = N - 1` SUBAGOAL_TAC;
+  UND 28 THEN  ARITH_TAC;
+  USE 10 SYM;
+  REWRITE_TAC[REAL_ARITH `x <= x`];
+  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 28 THEN ARITH_TAC;
+  (* --D *)
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `ed (0)` EXISTS_TAC;
+  TYPE_THEN `S` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `0 < x'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `~(x' = 0) ==> 0 < x'`);
+  TYPE_THEN `x'` UNABBREV_TAC;
+  (* --- *)
+  TYPE_THEN `pointI a` UNABBREV_TAC;
+  UND 20 THEN UND 30 THEN UND 36 THEN SIMP_TAC[];
+  USE 11 SYM;
+  TYPE_THEN `t (0) = x''` SUBAGOAL_TAC;
+  USE 13 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 11 SYM;
+  REDUCE_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN  `x'` EXISTS_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  USE 25 (MATCH_MP (REAL_ARITH  `x <= y ==> ~( y < x)`));
+  UND 25 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 38 THEN ARITH_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  CONJ_TAC;
+  TYPE_THEN `0` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `t (0)` EXISTS_TAC;
+  REDUCE_TAC;
+  USE 11 SYM;
+  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 28 THEN ARITH_TAC;
+  (* -E *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  has_size2_pair;
+  CONJ_TAC;
+  IMATCH_MP_TAC  endpoint_size2;
+  USE 33 (REWRITE_RULE[SUBSET;INR in_pair]);
+  CONJ_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `a` UNABBREV_TAC;
+  TYPE_THEN `v = v'` SUBAGOAL_TAC;
+  USE 8(MATCH_MP simple_arc_end_distinct);
+  UND 8 THEN ASM_REWRITE_TAC[];
+  (* -F *)
+  IMATCH_MP_TAC  EQ_EXT ;
+  THM_INTRO_TAC[`S`;`top2`] closure_unions;
+  REWRITE_TAC[top2_top];
+  FULL_REWRITE_TAC[psegment;segment];
+  TYPE_THEN `S` UNABBREV_TAC;
+  REWRITE_TAC[UNIONS];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  USE 20 (REWRITE_RULE[IMAGE]);
+  (* -- *)
+  TYPE_THEN `A = {i | (i <=| N -| 1) /\ (t i <= x')}` ABBREV_TAC ;
+  TYPE_THEN `FINITE A` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `{i | i <=| (N -| 1)}` EXISTS_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET];
+  REWRITE_TAC[FINITE_NUMSEG_LE];
+  TYPE_THEN `A 0` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  UND 28 THEN ARITH_TAC;
+  THM_INTRO_TAC[`A`] select_num_max;
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `0` EXISTS_TAC;
+  TYPE_THEN `x' = &1` ASM_CASES_TAC;
+  TYPE_THEN `closure top2 (ed (N -| 2))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  image_imp;
+  IMATCH_MP_TAC  image_imp;
+  UND 28 THEN ARITH_TAC;
+  USE 24 SYM;
+  TYPE_THEN `N - 2 <| N - 1` SUBAGOAL_TAC;
+  UND 28 THEN ARITH_TAC;
+  TYPE_THEN `t (N -| 1)` EXISTS_TAC;
+  TYPE_THEN `N - 1 = SUC (N - 2)` SUBAGOAL_TAC;
+  UND 28 THEN ARITH_TAC;
+  USE 10 SYM;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_ARITH `x <= x`];
+  IMATCH_MP_TAC  (REAL_ARITH `x < y ==> x <= y`);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 28 THEN ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `closure top2 (ed z)` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  image_imp;
+  IMATCH_MP_TAC  image_imp;
+  TYPE_THEN `A` UNABBREV_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `z <= N - 1 /\ ~(z = N - 1) ==> z < N - 1`);
+  DISCH_TAC;
+  TYPE_THEN `z` UNABBREV_TAC;
+  UND 36 THEN UND 43 THEN UND 38 THEN UND 10 THEN REAL_ARITH_TAC;
+  TYPE_THEN `z <| N-1` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `z <= N - 1 /\ ~(z = N - 1) ==> z < N - 1`);
+  TYPE_THEN `A` UNABBREV_TAC;
+  DISCH_TAC;
+  TYPE_THEN `z` UNABBREV_TAC;
+  UND 36 THEN UND 43 THEN UND 38 THEN UND 10 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `~(x <= y) ==> (y <= x)`);
+  UND 41 THEN DISCH_THEN (THM_INTRO_TAC[`SUC z`]);
+  UND 44 THEN ARITH_TAC;
+  UND 41 THEN ARITH_TAC;
+  (* -G *)
+  USE 36 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  UND 30 THEN DISCH_THEN (THM_INTRO_TAC[`x''`;`x`]);
+  REWR 30;
+  IMATCH_MP_TAC  image_imp;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `x''` EXISTS_TAC;
+  (* Wed Dec 22 07:47:58 EST 2004 *)
+  ]);;
+  (* }}} *)
+
+let psegment_cls = prove_by_refinement(
+  `!S. psegment S ==> IMAGE pointI (cls S) SUBSET closure top2 (UNIONS S)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[cls;IMAGE;SUBSET];
+  THM_INTRO_TAC[`S`;`top2`] closure_unions;
+  FULL_REWRITE_TAC[top2_top;psegment;segment];
+  REWRITE_TAC[UNIONS;IMAGE];
+  CONV_TAC (dropq_conv "u");
+  UNIFY_EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+let planar_graph_rectagonal = prove_by_refinement(
+  `!(G:(A,B)graph_t). planar_graph G /\ FINITE (graph_edge G) /\
+         FINITE (graph_vertex G) /\
+         ~(graph_edge G = {}) /\
+         (!v. CARD (graph_edge_around G v) <=| 4) ==>
+      (rectagonal_graph G)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`G`] graph_int_model;
+  REWRITE_TAC[rectagonal_graph;rectagon_graph];
+  TYPE_THEN `graph H` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[good_plane_graph;plane_graph];
+  TYPE_THEN `!e. graph_edge H e ==> (?S a b. segment_end S a b /\ (graph_inc H e = { (pointI a), (pointI b) }) /\ (e = closure top2 (UNIONS S)))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[good_plane_graph];
+  TSPEC `e` 10;
+  REWR 10;
+  THM_INTRO_TAC[`H`;`e`] graph_edge_end_select;
+  UND 10 THEN DISCH_THEN (THM_INTRO_TAC[`v`;`v'`]);
+  THM_INTRO_TAC[`E`;`e`;`v`;`v'`] simple_arc_finite_lemma4;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`H`;`e`] graph_inc_subset;
+  TYPE_THEN `graph_vertex H v` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `graph_vertex H v'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `S` EXISTS_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  USE 18 SYM;
+  IMATCH_MP_TAC  has_size2_subset_ne;
+  CONJ_TAC;
+  IMATCH_MP_TAC  graph_edge2;
+  REWRITE_TAC[SUBSET;INR in_pair];
+  CONJ_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  USE 19 SYM;
+  ASM_REWRITE_TAC[];
+  USE 20 SYM;
+  ASM_REWRITE_TAC[];
+  UND 15 THEN ASM_REWRITE_TAC[];
+  (* -A *)
+  LEFT 13 "S";
+  LEFT 13 "S";
+  (* - *)
+  TYPE_THEN `!w. (euclid 2 w ) /\ E (eps_hyper T (w 0)) /\ E (eps_hyper F (w 1)) ==> (?m. (w = pointI m))` SUBAGOAL_TAC;
+  TYPE_THEN `(?j. w 0 = -- &j)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  TYPE_THEN `?j. w 1 = -- &j` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[pointI];
+  TYPE_THEN `(-- &:j, -- &: j')` EXISTS_TAC;
+  REWRITE_TAC[int_neg_num_th];
+  USE 16 (MATCH_MP point_onto);
+  REWRITE_TAC[point_inj];
+  TYPE_THEN `w` UNABBREV_TAC;
+  FULL_REWRITE_TAC[coord01;PAIR_SPLIT];
+  (* -- *)
+  TYPE_THEN `!v. graph_vertex H v ==> ?a. (v = pointI a)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FULL_REWRITE_TAC[good_plane_graph;plane_graph];
+  ASM_MESON_TAC[subset_imp];
+  LEFT 15 "a";
+  LEFT 15 "a";
+  TYPE_THEN `J = mk_graph_t (IMAGE a (graph_vertex H), IMAGE S (graph_edge H),endpoint)` ABBREV_TAC ;
+  TYPE_THEN `J` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `graph_isomorphic H J` SUBAGOAL_TAC;
+  REWRITE_TAC[graph_isomorphic;graph_iso];
+  LEFT_TAC "u";
+  TYPE_THEN `a` EXISTS_TAC;
+  LEFT_TAC "v";
+  TYPE_THEN `S` EXISTS_TAC;
+  TYPE_THEN `a,S` EXISTS_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph];
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_bij;
+  REWRITE_TAC[INJ];
+  TYPE_THEN `x = pointI (a x)` SUBAGOAL_TAC;
+  TYPE_THEN `y = pointI (a y)` SUBAGOAL_TAC;
+  TYPE_THEN `a x` UNABBREV_TAC;
+  TYPE_THEN `pointI (a y)` UNABBREV_TAC;
+  (* -- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_bij;
+  REWRITE_TAC[INJ];
+  TYPE_THEN `x = closure top2 (UNIONS (S x))` SUBAGOAL_TAC;
+  USE 16 SYM;
+  ASM_MESON_TAC[];
+  TYPE_THEN `y = closure top2 (UNIONS (S y))` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `S x` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  (* -- *)
+  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`e`]);
+  THM_INTRO_TAC[`H`;`e`] graph_inc_subset;
+  REWR 19;
+  USE 19 (REWRITE_RULE[SUBSET;INR in_pair]);
+  TYPE_THEN `IMAGE a {(pointI a'), (pointI b)} = {a', b}` SUBAGOAL_TAC;
+  REWRITE_TAC[IMAGE ;INR in_pair];
+  IMATCH_MP_TAC  EQ_EXT ;
+  REWRITE_TAC[INR in_pair];
+  NAME_CONFLICT_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  DISJ1_TAC;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  TSPEC `pointI b` 15;
+  USE 15 (REWRITE_RULE[pointI_inj]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  DISJ2_TAC;
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  TSPEC `pointI a'` 15;
+  USE 15 (REWRITE_RULE[pointI_inj]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* --- *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `pointI b` EXISTS_TAC;
+  TSPEC `pointI b` 15;
+  USE 15 (REWRITE_RULE[pointI_inj]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `pointI a'` EXISTS_TAC;
+  TSPEC `pointI a'` 15;
+  USE 15 (REWRITE_RULE[pointI_inj]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FULL_REWRITE_TAC[segment_end];
+  (* -B *)
+  REWRITE_TAC[GSYM CONJ_ASSOC];
+  SUBCONJ_TAC;
+  THM_INTRO_TAC[`H`;`J`] graph_isomorphic_graph;
+  SUBCONJ_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;graph_edge_mk_graph];
+  USE 16 (REWRITE_RULE[IMAGE]);
+  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  FULL_REWRITE_TAC[segment_end];
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  REWRITE_TAC[graph_inc_mk_graph];
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph];
+  USE 22 (REWRITE_RULE[IMAGE]);
+  USE 23 (REWRITE_RULE[IMAGE]);
+  COPY 13;
+  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  UND 25 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  PROOF_BY_CONTR_TAC;  (* repeat from - to here // *)
+  USE 30 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
+  TYPE_THEN `edge u` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end;psegment;segment];
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `(UNIONS (S x) SUBSET closure top2 (UNIONS (S x)))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_closure;
+  REWRITE_TAC[top2_top];
+  TYPE_THEN `(UNIONS (S x') SUBSET closure top2 (UNIONS (S x')))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_closure;
+  REWRITE_TAC[top2_top];
+  TYPE_THEN `UNIONS (S x) SUBSET x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `UNIONS (S x') SUBSET x'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  USE 36 (REWRITE_RULE[UNIONS;SUBSET]);
+  USE 35 (REWRITE_RULE[UNIONS;SUBSET]);
+  LEFT 35 "u" ;
+  LEFT 35 "u" ;
+  LEFT 36 "u" ;
+  LEFT 36 "u" ;
+  TSPEC `u` 36;
+  TSPEC `u` 35;
+  TYPE_THEN `u SUBSET x` SUBAGOAL_TAC;
+  REWRITE_TAC[SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `u SUBSET x'` SUBAGOAL_TAC;
+  REWRITE_TAC[SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FULL_REWRITE_TAC[good_plane_graph;plane_graph];
+  UND 39 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`x'`]);
+  DISCH_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  UND 21 THEN ASM_REWRITE_TAC[];
+  USE 39 (REWRITE_RULE[INTER;SUBSET]);
+  TYPE_THEN `~(u = EMPTY)` SUBAGOAL_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  USE 32 (MATCH_MP edge_cell);
+  USE 32 (MATCH_MP cell_nonempty);
+  UND 32 THEN (REWRITE_TAC[]);
+  USE 44 (REWRITE_RULE[EMPTY_EXISTS]);
+  TSPEC  `u'` 39;
+  TYPE_THEN `graph_vertex H u'` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[subset_imp];
+  UND 15 THEN DISCH_THEN (THM_INTRO_TAC[`u'`]);
+  UND 15 THEN UND 44 THEN UND 32 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC));
+  FULL_REWRITE_TAC[edge];
+  TYPE_THEN `c = a u'` ABBREV_TAC ;
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `u'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[cell_clauses];
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `u'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[cell_clauses];
+  (* -C *)
+  TYPE_THEN `graph_isomorphic J G` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`G`;`H`;`J`] graph_isomorphic_trans;
+  IMATCH_MP_TAC  graph_isomorphic_symm;
+  IMATCH_MP_TAC  planar_is_graph;
+  (* - *)
+  TYPE_THEN `J` UNABBREV_TAC;
+  FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph;graph_inc_mk_graph];
+  USE 23 (REWRITE_RULE[IMAGE]);
+  USE 24 (REWRITE_RULE[IMAGE]);
+  COPY 13;
+  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  UND 27 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  CONJ_TAC THEN (IMATCH_MP_TAC endpoint_cls);
+  FULL_REWRITE_TAC[segment_end;psegment;segment];
+  FULL_REWRITE_TAC[segment_end;psegment;segment];
+  (* -D *)
+  TYPE_THEN `IMAGE pointI (cls(S x') INTER cls(S x)) SUBSET (IMAGE pointI (endpoint (S x') INTER endpoint (S x)))` BACK_TAC;
+  THM_INTRO_TAC[`pointI`] image_inj;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `UNIV:int#int ->bool` EXISTS_TAC;
+  REWRITE_TAC[INJ];
+  FULL_REWRITE_TAC[pointI_inj];
+  (* - *)
+  TYPE_THEN `!A B. (IMAGE pointI (A INTER B) = IMAGE pointI A INTER IMAGE pointI B)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  inj_inter;
+  TYPE_THEN `UNIV:int#int->bool` EXISTS_TAC;
+  TYPE_THEN `UNIV:(num->real)->bool` EXISTS_TAC;
+  REWRITE_TAC[INJ];
+  FULL_REWRITE_TAC[pointI_inj];
+  (* - *)
+  TYPE_THEN `IMAGE pointI (endpoint (S x')) = graph_inc H x'` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end];
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR in_pair];
+  MESON_TAC[];
+  TYPE_THEN `IMAGE pointI (endpoint (S x)) = graph_inc H x` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end];
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR in_pair];
+  MESON_TAC[];
+  USE 28 SYM;
+  USE 30 SYM;
+  (* -E *)
+  TYPE_THEN `!e. graph_edge H e ==> (graph_inc H e = e INTER graph_vertex H)` SUBAGOAL_TAC;
+  USE 10 (REWRITE_RULE[good_plane_graph;plane_graph]);
+  TYPE_THEN `x' INTER x SUBSET graph_vertex H` SUBAGOAL_TAC;
+  USE 10 (REWRITE_RULE[good_plane_graph;plane_graph]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 24 THEN UND 23 THEN UND 16 THEN MESON_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `x' INTER x` EXISTS_TAC;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  UND 36 THEN REWRITE_TAC[INTER;SUBSET;] THEN MESON_TAC[];
+  (* - *)
+  IMATCH_MP_TAC  subset_inter_pair;
+  (* -F *)
+  UND 31 THEN UND 13 THEN UND 29 THEN UND 27 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC));
+  FULL_REWRITE_TAC[segment_end];
+  ASM_MESON_TAC[psegment_cls];
+  (* Wed Dec 22 11:18:27 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let cartesian_finite = prove_by_refinement(
+  `!(A:A->bool) (B:B->bool). FINITE A /\ FINITE B ==>
+          FINITE (cartesian A B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `cartesian A B = {(x,y) | (x IN A) /\ (y IN B)}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[cartesian];
+  IMATCH_MP_TAC  FINITE_PRODUCT;
+  ]);;
+  (* }}} *)
+
+let three_t_finite = prove_by_refinement(
+  `FINITE (UNIV:three_t ->bool)`,
+  (* {{{ proof *)
+  [
+  THM_INTRO_TAC[`ABS3 0`] three_delete_size;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  FULL_REWRITE_TAC[FINITE_DELETE];
+  ]);;
+  (* }}} *)
+
+let three_t_size3 = prove_by_refinement(
+  `(UNIV:three_t ->bool) HAS_SIZE 3`,
+  (* {{{ proof *)
+  [
+  THM_INTRO_TAC[`ABS3 0`] three_delete_size;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  FULL_REWRITE_TAC[FINITE_DELETE];
+  THM_INTRO_TAC[`ABS3 0`;`UNIV:three_t->bool`;] CARD_SUC_DELETE;
+  ASM_REWRITE_TAC[];
+  USE 2 SYM;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let k33_nonplanar = prove_by_refinement(
+  `~(planar_graph k33_graph)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`k33_graph`] planar_graph_rectagonal;
+  REWRITE_TAC[k33_graph_edge;k33_graph_inc;k33_graph_vertex];
+  ASSUME_TAC three_t_finite;
+  ASSUME_TAC bool_size;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  CONJ_TAC;
+  IMATCH_MP_TAC  cartesian_finite;
+  CONJ_TAC;
+  IMATCH_MP_TAC  cartesian_finite;
+  (* -- *)
+  REWRITE_TAC[EMPTY_EXISTS];
+  CONJ_TAC;
+  TYPE_THEN `(ABS3 0,ABS3 0)` EXISTS_TAC;
+  REWRITE_TAC[cartesian;PAIR_SPLIT];
+  MESON_TAC[];
+  REWRITE_TAC[graph_edge_around];
+  REWRITE_TAC[k33_graph_edge;k33_graph_inc;k33_graph_vertex;cartesian_univ];
+  TYPE_THEN `E = {e | (v = FST e,T) \/ (v = SND e,F)}` ABBREV_TAC ;
+  TYPE_THEN `SND v ==> (E = IMAGE (\ f. (FST v, f)) UNIV)` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IMAGE];
+  REWRITE_TAC[PAIR_SPLIT];
+  MESON_TAC[];
+  TYPE_THEN `~(SND v) ==> (E = IMAGE (\ f. (f,FST v)) UNIV)` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IMAGE];
+  REWRITE_TAC[PAIR_SPLIT];
+  NAME_CONFLICT_TAC;
+  MESON_TAC[];
+  TYPE_THEN `CARD E <=| CARD (UNIV:three_t ->bool)` SUBAGOAL_TAC;
+  TYPE_THEN `SND v` ASM_CASES_TAC;
+  IMATCH_MP_TAC  CARD_IMAGE_LE;
+  IMATCH_MP_TAC  CARD_IMAGE_LE;
+  ASSUME_TAC three_t_size3;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  UND 8 THEN UND 7 THEN ARITH_TAC;
+  (* - *)
+  ASSUME_TAC rectagon_graph_k33_false;
+  UND 2 THEN ASM_REWRITE_TAC[];
+  (* Wed Dec 22 11:57:49 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION Z *)
+(* ------------------------------------------------------------------ *)
+
+(* show the complement of a simple arc is connected *)
+
+
+let grid33 = jordan_def `grid33 m =
+         rectangle_grid (FST m -: &:1, SND m -: &:1)
+                    (FST m +: &:2, SND m +: &:2)`;;
+
+let grid = jordan_def `grid f N =
+   UNIONS (IMAGE
+    ( \ i. grid33 (floor (f (&i / &N) 0), floor (f (&i / &N) 1)))
+    {j | j <= N})`;;
+
+let grid33_conn2 = prove_by_refinement(
+  `!m. conn2 (grid33 m)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[grid33];
+  TYPE_THEN `SUC 2 = 3` SUBAGOAL_TAC;
+  ARITH_TAC;
+  TYPE_THEN `a = FST m -: &:1` ABBREV_TAC  ;
+  TYPE_THEN `FST m +: &:2 = a +: &:(SUC 2)` SUBAGOAL_TAC;
+  TYPE_THEN `a` UNABBREV_TAC;
+  INT_ARITH_TAC;
+  TYPE_THEN `b = SND m -: &:1` ABBREV_TAC ;
+  TYPE_THEN `SND m +: &:2 = b +: &:(SUC 2)` SUBAGOAL_TAC;
+  TYPE_THEN `b` UNABBREV_TAC;
+  ARITH_TAC;
+  USE 0 SYM;
+  THM_INTRO_TAC[`2`;`2`;`(a,b)`] rectangle_grid_conn2;
+  FULL_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let grid_finite = prove_by_refinement(
+  `!f N. FINITE (grid f N)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[ grid];
+  TYPE_THEN `FINITE (IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1))) {j | j <=| N}) ` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  REWRITE_TAC[FINITE_NUMSEG_LE];
+  ASM_SIMP_TAC[FINITE_FINITE_UNIONS];
+  USE 1 (REWRITE_RULE[IMAGE]);
+  THM_INTRO_TAC[`floor (f (&x / &N) 0),floor (f (&x / &N) 1)`] grid33_conn2;
+  FULL_REWRITE_TAC[conn2];
+  ]);;
+  (* }}} *)
+
+let grid33_edge = prove_by_refinement(
+  `!m. grid33 m SUBSET edge `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[grid33;rectangle_grid_edge];
+  ]);;
+  (* }}} *)
+
+let grid_edge = prove_by_refinement(
+  `!f N . grid f N SUBSET edge `,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[grid;UNIONS;SUBSET;IMAGE ];
+  TYPE_THEN `u` UNABBREV_TAC;
+  ASM_MESON_TAC[grid33_edge;subset_imp];
+  ]);;
+
+  (* }}} *)
+
+let floor_add_num = prove_by_refinement(
+  `!x m. floor (x + &m) = floor x +: &:m`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC [floor_range;int_add_th;int_of_num_th;];
+  THM_INTRO_TAC[`x`;`floor x`] floor_range;
+  REWR 0;
+  UND 0 THEN UND 1 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let floor_abs = prove_by_refinement(
+  `!x y m. (abs  (x -. y) <= &m) ==> (||: (floor x -: floor y) <=: &:m)`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `!x y m. (y <. x) /\ (x - y <= &m) ==> (floor x -: floor y <=: &:m)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`x`;`y + &m`] floor_mono;
+  UND 0 THEN REAL_ARITH_TAC;
+  FULL_REWRITE_TAC[floor_add_num];
+  UND 2 THEN INT_ARITH_TAC ;
+  TYPE_THEN `y = x` ASM_CASES_TAC;
+  TYPE_THEN `y` UNABBREV_TAC;
+  FULL_REWRITE_TAC[REAL_ARITH `x -. x = &0`;ABS_0;INT_SUB_REFL;INT_ABS_0;int_le ; int_of_num_th];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `y <= x` ASM_CASES_TAC;
+  TYPE_THEN `abs  (x - y) = (x - y)` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_REFL];
+  UND 3 THEN REAL_ARITH_TAC;
+  REWR 0;
+  TYPE_THEN `floor y  <=: floor x` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  floor_mono;
+  TYPE_THEN `||: (floor x -: floor y) = (floor x -: floor y)` SUBAGOAL_TAC;
+  REWRITE_TAC[INT_ABS_REFL];
+  UND 5 THEN INT_ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x < y` SUBAGOAL_TAC;
+  UND 2 THEN UND 3 THEN REAL_ARITH_TAC;
+  (* -A *)
+  TYPE_THEN `abs  (x - y) = (y - x)` SUBAGOAL_TAC;
+  UND 4 THEN REAL_ARITH_TAC;
+  REWR 0;
+  TYPE_THEN `floor x  <=: floor y` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  floor_mono;
+  UND 4 THEN REAL_ARITH_TAC;
+  TYPE_THEN `||: (floor x -: floor y) = (floor y -: floor x)` SUBAGOAL_TAC;
+  UND 6 THEN INT_ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ]);;
+  (* }}} *)
+
+let d_euclid_floor = prove_by_refinement(
+  `!x y i n. (euclid n x) /\ (euclid n y) /\ (d_euclid x y < &1) ==>
+     (||: (floor (x i) -: floor (y i)) <=: &:1)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  floor_abs;
+  THM_INTRO_TAC[`n`;`x`;`y`;`i`] proj_contraction;
+  UND 3 THEN UND 0 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+extend_simp_rewrites[prove_by_refinement(
+  `!x . x/ &0 = &0 `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[REAL_INV_0;real_div;REAL_MUL_RZERO];
+  ])];;
+  (* }}} *)
+
+extend_simp_rewrites[INR in_pair ; INR IN_SING];;
+
+extend_simp_rewrites[REAL_POS];;
+
+let real_eq_div = prove_by_refinement(
+  `!x y z. ~(z = &0) ==> ((x / z = y) <=> (x = y * z))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `&0 < z` ASM_CASES_TAC;
+  ASM_SIMP_TAC[REAL_EQ_LDIV_EQ];
+  TYPE_THEN `&0 < -- z` SUBAGOAL_TAC;
+  UND 0 THEN UND 1 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x / z = (--x)/(--z)` SUBAGOAL_TAC;
+  REWRITE_TAC[real_div;REAL_INV_NEG;REAL_NEG_MUL2];
+  ASM_SIMP_TAC[REAL_EQ_LDIV_EQ];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let grid_conn2_induct_lemma = prove_by_refinement(
+  `!k f N.
+   (k <= N) /\ (IMAGE f {x | &0 <= x /\ x <= &1} SUBSET (euclid 2)) /\
+   (!i. (i < N) ==> d_euclid  (f (&i / &N)) (f (&(SUC i) / &N)) < &1) ==>
+   conn2 (UNIONS (IMAGE
+    ( \ i. grid33 (floor (f (&i / &N) 0), floor (f (&i / &N) 1)))
+    {j | j <= k}))`,
+  (* {{{ proof *)
+
+  [
+  INDUCT_TAC;
+  TYPE_THEN `{j | j <=| 0} = {0}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_SING];
+  ARITH_TAC;
+  REWRITE_TAC[IMAGE;INR IN_SING ];
+  TYPE_THEN `{y | ?x. (x = 0) /\ (y = grid33 (floor (f (&x / &N) 0),floor (f (&x / &N) 1)))} =  {(grid33 (floor (f (&0 / &N) 0), floor (f (&0 / &N) 1)))}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[INR IN_SING];
+  CONV_TAC (dropq_conv "x'");
+  REWRITE_TAC[grid33_conn2];
+  (* - *)
+  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`f`;`N`]);
+  UND 2 THEN ARITH_TAC;
+  TYPE_THEN `{j | j <=| SUC k} = {j | j <=| k} UNION {(SUC k)}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;];
+  ARITH_TAC;
+  REWRITE_TAC[IMAGE_UNION;UNIONS_UNION;image_sing;UNIONS_1];
+  IMATCH_MP_TAC  conn2_union_edge;
+  ASM_REWRITE_TAC[grid33_conn2];
+  (* - *)
+  CONJ_TAC;
+    REWRITE_TAC[grid;UNIONS;SUBSET;IMAGE ];
+  TYPE_THEN `u` UNABBREV_TAC;
+  ASM_MESON_TAC[grid33_edge;subset_imp];
+  REWRITE_TAC[EMPTY_EXISTS];
+  REWRITE_TAC[grid33_edge];
+  TYPE_THEN `{j | j <=| k} = {j | j <| k} UNION {k}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;INR IN_SING];
+  ARITH_TAC;
+  REWRITE_TAC[IMAGE_UNION;UNIONS_UNION;image_sing;UNIONS_1];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  REWRITE_TAC[UNION_OVER_INTER];
+  REWRITE_TAC[UNION];
+  RIGHT_TAC "u";
+  DISJ2_TAC;
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`k`]);
+  UND 2 THEN ARITH_TAC;
+  (* -A *)
+  TYPE_THEN `a = floor (f (&k / &N) 0)` ABBREV_TAC ;
+  TYPE_THEN `b = floor (f (&k / &N) 1)` ABBREV_TAC ;
+  TYPE_THEN `a' = floor (f (&(SUC k) / &N) 0)` ABBREV_TAC ;
+  TYPE_THEN `b' = floor (f (&(SUC k) / &N) 1)` ABBREV_TAC ;
+  TYPE_THEN `h_edge (a,b)` EXISTS_TAC;
+  REWRITE_TAC[INTER];
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  REWRITE_TAC[grid33];
+  REWRITE_TAC[rectangle_grid_h];
+  INT_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `!k. (k <=| N) ==> euclid 2 (f (&k / &N))` SUBAGOAL_TAC;
+  USE 1(REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  image_imp;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_DIV;
+  TYPE_THEN `&N = &0` ASM_CASES_TAC;
+  REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  TYPE_THEN `&0 < &N` SUBAGOAL_TAC;
+  UND 11 THEN REWRITE_TAC[REAL_OF_NUM_EQ;REAL_LT] THEN ARITH_TAC;
+  ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
+  UND 10 THEN REWRITE_TAC[REAL_LE;REAL_OF_NUM_MUL] THEN ARITH_TAC ;
+  (* - *)
+  TYPE_THEN `euclid 2 (f (&k/ &N))` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 2 THEN ARITH_TAC;
+  TYPE_THEN `euclid 2 (f (&(SUC k)/ &N))` SUBAGOAL_TAC;
+  (* - *)
+  THM_INTRO_TAC[`f(&k/ &N)`;`f(&(SUC k)/ &N)`;`0`;`2`] d_euclid_floor;
+  THM_INTRO_TAC[`f(&k/ &N)`;`f(&(SUC k)/ &N)`;`1`;`2`] d_euclid_floor;
+  TYPE_THEN `||: (a - a') <=: &:1` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `||: (b - b') <=: &:1` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  KILL 14 THEN KILL 13;
+  KILL 5 THEN KILL  4;
+  KILL 3 THEN KILL 1;
+  REWRITE_TAC[grid33];
+  REWRITE_TAC[rectangle_grid_h];
+  UND 16 THEN UND 15 THEN INT_ARITH_TAC;
+  (* Thu Dec 23 10:46:15 EST 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let grid_conn2 = prove_by_refinement(
+  `!f N. (IMAGE f {x | &0 <= x /\ x <= &1} SUBSET (euclid 2)) /\
+   (!i. (i < N) ==> d_euclid  (f (&i / &N)) (f (&(SUC i) / &N)) < &1) ==>
+   conn2 (grid f N)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`N`;`f`;`N`] grid_conn2_induct_lemma;
+  ARITH_TAC;
+  REWRITE_TAC[grid];
+  ]);;
+  (* }}} *)
+
+let simple_arc_uniformly_continuous = prove_by_refinement(
+  `!f . continuous f (top_of_metric(UNIV,d_real)) top2 /\
+      INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
+   uniformly_continuous f
+        ({x | &0 <= x /\ x <= &1},d_real)
+        (euclid 2,d_euclid)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASSUME_TAC metric_real;
+  IMATCH_MP_TAC  compact_uniformly_continuous;
+  THM_INTRO_TAC[`&0`;`&1`] interval_compact;
+  THM_INTRO_TAC[`UNIV:real->bool`;`{x | &0 <= x /\ x <= &1}`;`d_real`] compact_subset;
+  REWRITE_TAC[metric_real];
+  REWR 4;
+  KILL 4;
+  KILL 3;
+  (* - *)
+  TYPE_THEN  `IMAGE f {x | &0 <= x /\ x <= &1} SUBSET euclid 2` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  inj_image_subset;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  (* -A *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC metric_subspace;
+  TYPE_THEN `UNIV:real->bool` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  (* -// *)
+  THM_INTRO_TAC[`f`;`top_of_metric(UNIV,d_real)`;`top2`;`{x | &0 <= x /\ x <= &1}`] continuous_induced_domain;
+  ASM_SIMP_TAC[metric_real;GSYM top_of_metric_unions];
+  (* - *)
+  THM_INTRO_TAC[`UNIV:real->bool`;`{x | &0 <= x /\ x <= &1}`;`d_real`] top_of_metric_induced;
+  REWRITE_TAC[metric_real];
+  REWR 5;
+  THM_INTRO_TAC[`f`;`{x | &0 <= x /\ x <= &1}`;`euclid 2`;`d_real`;`d_euclid`] metric_continuous_continuous;
+  USE 7 SYM;
+  FULL_REWRITE_TAC[top2];
+  (* Thu Dec 23 11:29:49 EST 2004 *)
+  ]);;
+  (* }}} *)
+
+let num_abs_of_int_mono = prove_by_refinement(
+  `!a b. &:0 <= a /\ a <= b ==> num_abs_of_int a <= num_abs_of_int b`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM REAL_LE;num_abs_of_int_th;GSYM int_abs_th;GSYM int_le ];
+  UND 0 THEN UND 1 THEN INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let floor_num = prove_by_refinement(
+  `!n. floor (&n) = &:n`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[floor_range];
+  REWRITE_TAC[int_of_num_th;];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let floor_neg_num = prove_by_refinement(
+  `!n. floor (-- &n) = -- (&:n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[floor_range];
+  REWRITE_TAC[int_neg_th;int_of_num_th;];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let delta_partition_lemma = prove_by_refinement(
+  `!delta. (&0 < delta) ==> (?N. !x. ?i.  (0 < N) /\
+      ((&0 <= x /\ x <= &1) ==> (i <= N) /\ abs  (&i/ &N - x) < delta))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[ `&1/ delta` ] REAL_ARCH_SIMPLE;
+  TYPE_THEN `n` EXISTS_TAC;
+  TYPE_THEN `num_abs_of_int (floor (&n*x))` EXISTS_TAC;
+  TYPE_THEN `&0 < &1/ delta` SUBAGOAL_TAC;
+  TYPE_THEN `&0 < &n` SUBAGOAL_TAC;
+  UND 1 THEN UND 2 THEN REAL_ARITH_TAC;
+  TYPE_THEN `(&1 <= &n* delta)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[REAL_LE_LDIV_EQ];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[REAL_LT];
+  TYPE_THEN `&:0 <= floor (&n * x)` SUBAGOAL_TAC;
+  TYPE_THEN `floor (&0) <=: floor (&n * x)` BACK_TAC;
+  FULL_REWRITE_TAC[floor_num];
+  IMATCH_MP_TAC  floor_mono;
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `num_abs_of_int (floor (&n * x)) <= num_abs_of_int (floor (&n))` BACK_TAC;
+  FULL_REWRITE_TAC[floor_num;num_abs_of_int_num];
+  IMATCH_MP_TAC  num_abs_of_int_mono;
+  IMATCH_MP_TAC  floor_mono;
+  TYPE_THEN `&n * x <= &n * &1` BACK_TAC;
+  UND 8 THEN REAL_ARITH_TAC;
+  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
+  (* -A *)
+  IMATCH_MP_TAC  REAL_LT_LCANCEL_IMP;
+  TYPE_THEN `&n` EXISTS_TAC;
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN`&1` EXISTS_TAC;
+  (* - *)
+  REWRITE_TAC[num_abs_of_int_th;];
+  TYPE_THEN `abs  (real_of_int (floor (&n * x))) = (real_of_int (floor (&n *x)))` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_REFL];
+  FULL_REWRITE_TAC [int_le; int_of_num_th;];
+  TYPE_THEN `!u. &n * abs  (u / &n - x) = abs  (u - &n*x)` SUBAGOAL_TAC;
+  TYPE_THEN `!t. &n * abs  t = abs  (&n *t)` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_NUM];
+  AP_TERM_TAC;
+  REWRITE_TAC[REAL_SUB_LDISTRIB];
+  TYPE_THEN `&n * u/ &n = u` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  UND 10 THEN UND 3 THEN REAL_ARITH_TAC;
+  TYPE_THEN `t = &n * x ` ABBREV_TAC ;
+  TYPE_THEN `real_of_int(floor t) <= t` SUBAGOAL_TAC;
+  REWRITE_TAC[floor_ineq];
+  TYPE_THEN `abs  (real_of_int (floor t) - t) = t - real_of_int (floor t)` SUBAGOAL_TAC;
+  UND 11 THEN REAL_ARITH_TAC;
+  THM_INTRO_TAC[`t`] floor_ineq;
+  UND 13 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let simple_arc_ball_cover  = prove_by_refinement(
+  `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
+      INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
+    (?N. !x. ?i. (0 < N) /\ (&0 <= x /\ x <= &1 ==>
+        (i <= N) /\
+           open_ball (euclid 2,d_euclid) (f (&i / &N)) (&1) (f x)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
+  FULL_REWRITE_TAC[uniformly_continuous];
+  TSPEC `&1` 2;
+  UND 2 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  REWRITE_TAC[open_ball];
+  THM_INTRO_TAC[`delta`] delta_partition_lemma;
+  TYPE_THEN `N` EXISTS_TAC;
+  TSPEC `x` 4;
+  TYPE_THEN `i` EXISTS_TAC;
+  REP_BASIC_TAC;
+  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  (* - *)
+  TYPE_THEN `&0 <= &i/ &N /\ &i/ &N <= &1` SUBAGOAL_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_DIV;
+  THM_INTRO_TAC[`&i`;`&1`;`&N`] REAL_LE_LDIV_EQ;
+  REWRITE_TAC[REAL_LT];
+  REWRITE_TAC[REAL_MUL;REAL_LE];
+  UND 8 THEN ARITH_TAC;
+  (* - *)
+  FULL_REWRITE_TAC[INJ];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[d_real];
+  ]);;
+  (* }}} *)
+
+let unbounded_diff = prove_by_refinement(
+  `!G. unbounded_set G = UNIONS(ctop G) DIFF (bounded_set G)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM bounded_unbounded_union];
+  IMATCH_MP_TAC  EQ_EXT;
+  THM_INTRO_TAC[`G`] bounded_unbounded_disj;
+  UND 0 THEN REWRITE_TAC[EQ_EMPTY;UNION ;INTER;DIFF] THEN MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let bounded_diff = prove_by_refinement(
+  `!G. bounded_set G = UNIONS(ctop G) DIFF (unbounded_set G)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[GSYM bounded_unbounded_union];
+  IMATCH_MP_TAC  EQ_EXT;
+  THM_INTRO_TAC[`G`] bounded_unbounded_disj;
+  UND 0 THEN REWRITE_TAC[EQ_EMPTY;UNION ;INTER;DIFF] THEN MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let rectangle_grid_subset = prove_by_refinement(
+  `!p q r s. (FST p <=: FST r) /\ (SND p <= SND r) /\
+       (FST s <= FST q) /\ (SND s <= SND q) ==>
+    rectangle_grid r s SUBSET rectangle_grid p q`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;rectangle_grid];
+  FIRST_ASSUM DISJ_CASES_TAC THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[cell_clauses] THEN  CONV_TAC (dropq_conv "m'");
+  UND 5 THEN UND 6 THEN UND 7 THEN UND 8 THEN UND 1 THEN UND 2 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC;
+  UND 5 THEN UND 6 THEN UND 7 THEN UND 8 THEN UND 1 THEN UND 2 THEN UND 3 THEN UND 4 THEN INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let grid_image_bounded = prove_by_refinement(
+  `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
+      INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
+   (?N. (0 < N) /\ ((IMAGE f {x | &0 <= x /\ x <= &1}) INTER
+         (unbounded_set (grid f N)) =  EMPTY))  `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[EQ_EMPTY;INTER;];
+  THM_INTRO_TAC[`f`] simple_arc_ball_cover;
+  TYPE_THEN `N` EXISTS_TAC;
+  REWRITE_TAC[IMAGE];
+  NAME_CONFLICT_TAC;
+  RIGHT 2 "i";
+  RIGHT 2 "x";
+  TYPE_THEN `x''` UNABBREV_TAC;
+  FULL_REWRITE_TAC[unbounded_diff;DIFF;ctop_unions ];
+  UND 2 THEN REWRITE_TAC[];
+  UND 6 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  REWR 2;
+  FULL_REWRITE_TAC[open_ball];
+  (* _ *)
+  IMATCH_MP_TAC  bounded_avoidance_subset;
+  TYPE_THEN `E = grid33 (floor (f (&i/ &N) 0),floor (f (&i / &N) 1))` ABBREV_TAC ;
+  TYPE_THEN `E` EXISTS_TAC;
+  (* _ *)
+  TYPE_THEN `conn2 E` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[grid33_conn2];
+  REWRITE_TAC[grid_edge;grid_finite];
+  TYPE_THEN `E SUBSET grid f N` SUBAGOAL_TAC;
+  REWRITE_TAC[grid];
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `{j | j <=| N} = {i} UNION {j | j <=| N /\ ~(j = i)}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  UND 6 THEN ARITH_TAC;
+  REWRITE_TAC[IMAGE_UNION;UNIONS_UNION];
+  REWRITE_TAC[SUBSET;UNION];
+  DISJ1_TAC;
+  REWRITE_TAC[image_sing];
+  (* _ *)
+  TYPE_THEN `~UNIONS (curve_cell E) (f x')` SUBAGOAL_TAC;
+  UND 3 THEN REWRITE_TAC[];
+  THM_INTRO_TAC[`E`;`grid f N`] curve_cell_imp_subset;
+  USE 3 (MATCH_MP UNIONS_UNIONS);
+  ASM_MESON_TAC[subset_imp];
+  KILL 13;
+  KILL 3;
+  (* _A *)
+  TYPE_THEN `E' = rectangle_grid (floor (f x' 0),floor (f x' 1)) (floor (f x' 0) +: &:1,floor (f x' 1) +: &:1)` ABBREV_TAC ;
+  THM_INTRO_TAC[`(floor (f x' 0),floor (f x' 1))`] rectagon_rectangle_grid_sq;
+  FULL_REWRITE_TAC [];
+  REWR 13;
+  TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[grid33];
+  IMATCH_MP_TAC  rectangle_grid_subset;
+  (* __ *)
+  THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`0`;`2`] d_euclid_floor;
+  THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`1`;`2`] d_euclid_floor;
+  UND 3 THEN UND 11 THEN INT_ARITH_TAC;
+  (* _ *)
+  IMATCH_MP_TAC  bounded_avoidance_subset;
+  TYPE_THEN `E'` EXISTS_TAC;
+  TYPE_THEN `conn2 E'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  conn2_rectagon;
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[conn2];
+  (* _ *)
+  TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[grid33_edge];
+  (* _ *)
+  ASM_SIMP_TAC[GSYM odd_bounded];
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN ` squ (floor (f x' 0),floor (f x' 1))` EXISTS_TAC;
+  IMATCH_MP_TAC  (TAUT ` a/\ b ==> b /\ a`);
+  (* -B *)
+  TYPE_THEN `~UNIONS (curve_cell E') (f x')` SUBAGOAL_TAC;
+  UND 14 THEN REWRITE_TAC[];
+  THM_INTRO_TAC[`E'`;`E`] curve_cell_imp_subset;
+  USE 14 (MATCH_MP UNIONS_UNIONS);
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  TYPE_THEN `m = (floor (f x' 0),floor (f x' 1))` ABBREV_TAC ;
+  TYPE_THEN `~(h_edge m (f x'))` SUBAGOAL_TAC;
+  UND 19 THEN REWRITE_TAC[];
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `h_edge m` EXISTS_TAC;
+  REWRITE_TAC[curve_cell_h_ver2];
+  USE 20 (REWRITE_RULE[PAIR_SPLIT]);
+  REWR 3;
+  FULL_REWRITE_TAC[rectangle_grid_sq];
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[INSERT];
+  (* - *)
+  TYPE_THEN `~(v_edge m (f x'))` SUBAGOAL_TAC;
+  UND 19 THEN REWRITE_TAC[];
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `v_edge m` EXISTS_TAC;
+  REWRITE_TAC[curve_cell_v_ver2];
+  USE 20 (REWRITE_RULE[PAIR_SPLIT]);
+  REWR 3;
+  FULL_REWRITE_TAC[rectangle_grid_sq];
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[INSERT];
+  (* - *)
+  TYPE_THEN `~(f x' = pointI m)` SUBAGOAL_TAC;
+  UND 19 THEN REWRITE_TAC[];
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
+  ASM_SIMP_TAC[rectagon_segment;curve_cell_cls];
+  USE 20 (REWRITE_RULE[PAIR_SPLIT]);
+  REWR 3;
+  FULL_REWRITE_TAC[rectangle_grid_sq];
+  TYPE_THEN `{(h_edge m)} SUBSET E'` SUBAGOAL_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;INSERT];
+  USE 24 (MATCH_MP cls_subset);
+  USE 24 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[cls_h];
+  (* -C *)
+  USE 9 (MATCH_MP point_onto);
+  THM_INTRO_TAC[`p`] square_domain;
+  UND 24 THEN LET_TAC;
+  TYPE_THEN `(floor (FST p),floor (SND p)) = m` SUBAGOAL_TAC;
+  TYPE_THEN `m` UNABBREV_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  REWR 24;
+  TYPE_THEN `point p` UNABBREV_TAC;
+  USE 24 (REWRITE_RULE[UNION;INR IN_SING;]);
+  REWR 9;
+  (* -D *)
+  ASM_SIMP_TAC[rectagon_segment;par_cell_squ];
+  FULL_REWRITE_TAC[num_lower];
+  USE 20 (REWRITE_RULE[PAIR_SPLIT]);
+  REWR 3;
+  FULL_REWRITE_TAC[rectangle_grid_sq];
+  TYPE_THEN `!m'. E' (h_edge m') <=> (m' = up m) \/ (m' = m)` SUBAGOAL_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[INSERT;cell_clauses];
+  REWR 24;
+  (* - *)
+  TYPE_THEN `{m' | ((m' = up m) \/ (m' = m)) /\ (FST m' = FST m) /\ SND m' <=: SND m} = {m}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[up;PAIR_SPLIT];
+  INT_ARITH_TAC;
+  REWR 24;
+  FULL_REWRITE_TAC[card_sing;EVEN2];
+  (* Thu Dec 23 20:25:33 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let conn2_sequence_lemma1 = prove_by_refinement(
+  `!k G N . (k <= N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
+    (!i. (i <= N) ==> (G i SUBSET edge )) /\
+    (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) ==>
+   conn2 (UNIONS (IMAGE G ({i | i <=| k})))`,
+  (* {{{ proof *)
+  [
+  INDUCT_TAC;
+  TYPE_THEN `{i | i <=| 0} = {0}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC   EQ_EXT ;
+  ARITH_TAC;
+  REWRITE_TAC[image_sing];
+  (* - *)
+  UND 4 THEN DISCH_THEN (THM_INTRO_TAC[`G`;`N`]);
+  UND 3 THEN ARITH_TAC;
+  TYPE_THEN `{i | i <=| SUC k} = {i | i <= k} UNION {(SUC k)}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  ARITH_TAC;
+  REWRITE_TAC[image_sing;IMAGE_UNION;UNIONS_UNION];
+  IMATCH_MP_TAC  conn2_union_edge;
+  REWRITE_TAC[EMPTY_EXISTS];
+  CONJ_TAC;
+  REWRITE_TAC[UNIONS;IMAGE;SUBSET];
+  FULL_REWRITE_TAC[SUBSET];
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  UND 8 THEN UND 3 THEN ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `u` UNABBREV_TAC;
+  REWRITE_TAC[INTER];
+  TYPE_THEN`{i | i <=| k} = {i | i <| k} UNION {k}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  ARITH_TAC;
+  (* - *)
+  REWRITE_TAC[image_sing;IMAGE_UNION;UNIONS_UNION];
+  REWRITE_TAC[UNION];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`k`]);
+  FULL_REWRITE_TAC[INTER];
+  TYPE_THEN `u` EXISTS_TAC;
+  ]);;
+  (* }}} *)
+
+let thread_finite_union = prove_by_refinement(
+  `!(A:(A->bool)->(B->bool)) S.
+    (FINITE S) /\ (!a b. A (a UNION b) = A a UNION A b) /\
+      (A EMPTY = EMPTY) ==>
+       (A (UNIONS S) = UNIONS (IMAGE A S))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `!k S. S HAS_SIZE k ==> (A (UNIONS S) = UNIONS (IMAGE A S))` SUBAGOAL_TAC THENL [INDUCT_TAC;ALL_TAC];
+  FULL_REWRITE_TAC[HAS_SIZE_0];
+  ASM_REWRITE_TAC[IMAGE_CLAUSES;UNIONS_0;];
+  THM_INTRO_TAC[`S'`;`k`] HAS_SIZE_SUC;
+  REWR 5;
+  USE 6 (REWRITE_RULE[EMPTY_EXISTS]);
+  TSPEC `u` 5;
+  TSPEC `S' DELETE u` 4;
+  TYPE_THEN `S' = (S' DELETE u) UNION {u}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  UND 6 THEN REWRITE_TAC[DELETE;UNION;INR IN_SING ] THEN MESON_TAC[];
+  UND 7 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  ASM_REWRITE_TAC[UNIONS_UNION;IMAGE_UNION;image_sing;];
+  (* - *)
+  UND 3 THEN DISCH_THEN (THM_INTRO_TAC[`CARD S`;`S`]);
+  ASM_REWRITE_TAC[HAS_SIZE];
+  ]);;
+  (* }}} *)
+
+let conn2_sequence_lemma2 = prove_by_refinement(
+  `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
+    (!i. (i <= N) ==> (G i SUBSET edge )) /\
+    (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\
+   (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) /\
+   ~(unbounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) ==>
+   (bounded_set (UNIONS (IMAGE G {i | i <=| N})) p)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC  [unbounded_diff;DIFF;DE_MORGAN_THM;];
+  UND 6 THEN ASM_REWRITE_TAC[];
+  USE 0 (ONCE_REWRITE_RULE[DISJ_SYM]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  KILL 0;
+  FULL_REWRITE_TAC[ctop_unions;DIFF;DE_MORGAN_THM;];
+  (* - *)
+  COPY 1;
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`0`]);
+  UND 5 THEN ARITH_TAC;
+  REWR 6;
+  (* - *)
+  TYPE_THEN `?j. (j <=| N) /\ UNIONS (curve_cell (G j)) p` SUBAGOAL_TAC;
+  TYPE_THEN `!r. UNIONS (curve_cell r) = (UNIONS o curve_cell) r` SUBAGOAL_TAC;
+  REWRITE_TAC[o_DEF];
+  REWR 6;
+  TYPE_THEN `A = UNIONS o curve_cell` ABBREV_TAC ;
+  THM_INTRO_TAC[`A`;`IMAGE G {i | i <=| N}`] thread_finite_union;
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  REWRITE_TAC[FINITE_NUMSEG_LE];
+  TYPE_THEN `A` UNABBREV_TAC;
+  USE 9 GSYM;
+  CONJ_TAC;
+  REWRITE_TAC[curve_cell_union;UNIONS_UNION];
+  REWRITE_TAC[curve_cell_empty;];
+  USE 11 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `p` 11;
+  TYPE_THEN `A` UNABBREV_TAC;
+  KILL 9;
+  FULL_REWRITE_TAC[IMAGE_o];
+  FULL_REWRITE_TAC[o_DEF];
+  REWR 11;
+  FULL_REWRITE_TAC[GSYM UNIONS_IMAGE_UNIONS];
+  USE 9 (REWRITE_RULE[UNIONS]);
+  USE 11 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `u'` UNABBREV_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `u` EXISTS_TAC;
+  (* - *)
+  FULL_REWRITE_TAC[curve_cell_union;UNIONS_UNION];
+  FULL_REWRITE_TAC[UNION;DE_MORGAN_THM];
+  TYPE_THEN `j = 0` ASM_CASES_TAC;
+  REWR 9;
+  (* - *)
+  TYPE_THEN `?i. j = SUC i` SUBAGOAL_TAC ;
+  TYPE_THEN `j - 1` EXISTS_TAC;
+  UND 12 THEN ARITH_TAC;
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
+  REWR 10;
+  TYPE_THEN `j` UNABBREV_TAC;
+  UND 14 THEN ASM_REWRITE_TAC[];
+  (* Fri Dec 24 07:02:02 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let conn2_sequence_lemma3 = prove_by_refinement(
+  `!G N. (!i. (i <= N) ==> (G i SUBSET edge )) ==>
+    (UNIONS (IMAGE G {i | i <=| N}) SUBSET edge)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[UNIONS;IMAGE;SUBSET ];
+  UND 0 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  ASM_MESON_TAC[subset_imp];
+  ]);;
+  (* }}} *)
+
+let unbounded_avoidance_subset_ver2 = prove_by_refinement(
+  `!E E' x.
+          unbounded_set E' x /\
+          E SUBSET E' /\
+          E' SUBSET edge /\
+          FINITE E' /\
+          conn2 E
+             ==> unbounded_set E x`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`E`;`E'`;`x`] unbounded_avoidance_subset;
+  THM_INTRO_TAC[`E'`;`x`] unbounded_subset_unions;
+  FULL_REWRITE_TAC[ctop_unions;DIFF];
+  UND 6 THEN ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let conn2_sequence_lemma4 = prove_by_refinement(
+  `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
+    (!i. (i <= N) ==> (G i SUBSET edge )) /\
+    (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\
+   (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) /\
+   (bounded_set (UNIONS (IMAGE G ({i | i <= N}))) p) ==>
+    (?C i j . rectagon C /\ bounded_set C p /\
+       (SUC i < j) /\ (j <=| N) /\
+       (C SUBSET (UNIONS (IMAGE G ({x | (i <=| x) /\ (x <=| j)})))) /\
+    (!C' i' j'. rectagon C' /\ bounded_set  C' p /\
+       (i' < j') /\ (j' <=| N) /\
+       (C' SUBSET (UNIONS (IMAGE G ({x | (i' <=| x /\ x <=| j')})))) ==>
+       (j - i <= j' - i') /\
+   ((j - i = j' - i') ==>
+      (CARD (C DIFF (G (SUC i))) <= CARD (C' DIFF (G (SUC i')))))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`N`;`G`;`N`] conn2_sequence_lemma1;
+  ARITH_TAC;
+  TYPE_THEN `X = {(C,i,j) | rectagon C /\ bounded_set C p /\ (i <| j) /\ (j <=| N) /\ (C SUBSET UNIONS (IMAGE G {x | i <=| x /\ x <=| j})) }` ABBREV_TAC ;
+  TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC;
+  UND 8 THEN REWRITE_TAC[EMPTY_EXISTS];
+  THM_INTRO_TAC[`UNIONS (IMAGE G {i | i <=| N})`] rectagon_surround_conn2;
+  IMATCH_MP_TAC  conn2_sequence_lemma3;
+  TYPE_THEN `(C,0,N)` EXISTS_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `C` EXISTS_TAC;
+  TYPE_THEN `0` EXISTS_TAC;
+  TYPE_THEN `N` EXISTS_TAC;
+  REWRITE_TAC[ARITH_RULE `!x. 0 <=| x`];
+  ARITH_TAC;
+  (* -A *)
+  THM_INTRO_TAC[`X`;`(\ (C,i,j). j -| i):(((((num->real)->bool)->bool)#(num#num)) -> num)`] select_image_num_min;
+  UND 8 THEN ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `?D i j. z = (D,i,j)` SUBAGOAL_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  MESON_TAC[];
+  TYPE_THEN `z` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `Y = {(C,i',j') | rectagon C /\ bounded_set C p /\ (i' <| j') /\ (j' <=| N) /\ (C SUBSET UNIONS (IMAGE G {x | i' <=| x /\ x <=| j'})) /\ (j' - i' = j - i) }` ABBREV_TAC ;
+  TYPE_THEN `~(Y = EMPTY)` SUBAGOAL_TAC;
+  UND 12 THEN REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `(D,i,j)` EXISTS_TAC;
+  TYPE_THEN `Y` UNABBREV_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `D` EXISTS_TAC;
+  TYPE_THEN `i` EXISTS_TAC;
+  TYPE_THEN `j` EXISTS_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  USE 7 (REWRITE_RULE[PAIR_SPLIT]);
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`Y`;`\ (C,i',(j':num)). (CARD (C DIFF (G (SUC i'))))`] select_image_num_min;
+  UND 12 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `?C i' j'. z' = (C,i',j')` SUBAGOAL_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  MESON_TAC[];
+  TYPE_THEN `z'` UNABBREV_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  TYPE_THEN `i'` EXISTS_TAC;
+  TYPE_THEN `j'` EXISTS_TAC;
+  USE 11 SYM;
+  REWR 14;
+  USE 11 SYM;
+  USE 14 (REWRITE_RULE[PAIR_SPLIT]);
+  TYPE_THEN `C'` UNABBREV_TAC;
+  TYPE_THEN `i''` UNABBREV_TAC;
+  TYPE_THEN `j''` UNABBREV_TAC;
+  (* -B *)
+  CONJ_TAC;
+  TYPE_THEN `(SUC i' <| j') \/ (SUC i' = j')` SUBAGOAL_TAC;
+  UND 18 THEN ARITH_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `j'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 1 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
+  TYPE_THEN `{x | i' <=| x /\ x <=| SUC i'} = {i'} UNION {(SUC i')}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  ARITH_TAC;
+  REWR 16;
+  USE 16 (REWRITE_RULE[UNIONS_UNION;image_sing;IMAGE_UNION]);
+  (* -- *)
+  THM_INTRO_TAC[`C`;`(G i' UNION G (SUC i'))`;`p`]unbounded_avoidance_subset_ver2;
+  REWRITE_TAC[union_subset];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UND 17 THEN ARITH_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[FINITE_UNION];
+  TYPE_THEN `i' <=| N` SUBAGOAL_TAC;
+  UND 17 THEN ARITH_TAC;
+  FULL_REWRITE_TAC[conn2];
+  IMATCH_MP_TAC  conn2_rectagon;
+  (* -- *)
+  THM_INTRO_TAC[`C`] bounded_unbounded_disj;
+  USE 24 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPEC `p` 24;
+  UND 24 THEN ASM_REWRITE_TAC[];
+  (* -C *)
+  TYPE_THEN `X (C'',i''',j''')` SUBAGOAL_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `C''` EXISTS_TAC;
+  TYPE_THEN `i'''` EXISTS_TAC;
+  TYPE_THEN `j'''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  TSPEC `(C'',i''',j''')` 9;
+  USE 9 (GBETA_RULE);
+  (* - *)
+  TYPE_THEN `Y (C'',i''',j''')` SUBAGOAL_TAC;
+  TYPE_THEN `Y` UNABBREV_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `C''` EXISTS_TAC;
+  TYPE_THEN `i'''` EXISTS_TAC;
+  TYPE_THEN `j'''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 13 THEN DISCH_THEN (THM_INTRO_TAC[`(C'',i''',j''')`]);
+(*** Removed by JRH; no longer needed with paired beta in default rewrites
+  USE 13 (GBETA_RULE);
+ ***)
+  (* Fri Dec 24 12:26:34 EST 2004 *)
+  ]);;
+  (* }}} *)
+
+let endpoint_sub_rectagon = prove_by_refinement(
+  `!C G m. rectagon G /\ C SUBSET G /\ endpoint C m ==>
+    (?!e. G e /\ ~(C e) /\ cls {e} m)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  FULL_REWRITE_TAC[endpoint];
+  THM_INTRO_TAC[`C`;`pointI m`] num_closure1;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `G` EXISTS_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  REWR 3;
+  FULL_REWRITE_TAC[rectagon];
+  KILL 2;
+  TSPEC `m` 4;
+  USE 2 (REWRITE_RULE[INSERT]);
+  USE 2 (ONCE_REWRITE_RULE[TAUT `a \/ b <=> b \/ a`]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  THM_INTRO_TAC[`G`;`pointI m`] num_closure0;
+  REWR 8;
+  TSPEC `e` 8;
+  USE 1 (REWRITE_RULE[SUBSET]);
+  TSPEC `e` 3;
+  ASM_MESON_TAC[];
+  (* -A *)
+  COPY 3;
+  TSPEC `e` 8;
+  USE 8 (REWRITE_RULE[]);
+  THM_INTRO_TAC[`G`;`pointI m`] num_closure2;
+  REWR 10;
+  COPY 10;
+  TSPEC `e` 10;
+  TYPE_THEN `G e` SUBAGOAL_TAC;
+  USE 1 (REWRITE_RULE[SUBSET]);
+  TYPE_THEN `(e = a) \/ (e = b)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[cls];
+  REWRITE_TAC[EXISTS_UNIQUE_ALT];
+  (* - *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  TSPEC `y` 12;
+  REWR 12;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `y` UNABBREV_TAC;
+  UND 18 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `y` UNABBREV_TAC;
+  TSPEC  `b` 3;
+  TSPEC `b` 12;
+  REWR 12;
+  REWR 3;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `e` UNABBREV_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  TSPEC `y` 12;
+  REWR 12;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `y` UNABBREV_TAC;
+  UND 18 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `y` UNABBREV_TAC;
+  TSPEC  `a` 3;
+  TSPEC `a` 12;
+  REWR 12;
+  REWR 3;
+  TYPE_THEN `a` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Mon Dec 27 15:17:28 EST 2004 *)
+  ]);;
+  (* }}} *)
+
+let cut_rectagon_unique = prove_by_refinement(
+  `!E A B C m n. rectagon E /\ A SUBSET E /\ B SUBSET E /\ C SUBSET E /\
+    segment_end A m n /\ segment_end B m n /\ segment_end C m n /\
+    (E = A UNION B) /\ (A INTER B = EMPTY) ==>
+    (C = A) \/ (C = B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `!A. A SUBSET E /\ segment_end A m n /\ ~(A INTER C = EMPTY) ==> (A SUBSET C)` SUBAGOAL_TAC;
+  TYPE_THEN `inductive_set A' (A' INTER C)` SUBAGOAL_TAC;
+  REWRITE_TAC[inductive_set];
+  CONJ_TAC;
+  REWRITE_TAC[INTER;SUBSET];
+  FULL_REWRITE_TAC[INTER];
+  TYPE_THEN `edge C' /\ edge C''` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end;psegment;segment];
+  UND 16 THEN UND 15 THEN UND 13 THEN MESON_TAC[subset_imp];
+  THM_INTRO_TAC[`C'`;`C''`] adjv_adj;
+  THM_INTRO_TAC[`C'`;`C''`] adjv_adj2;
+  TYPE_THEN `q =adjv C' C''` ABBREV_TAC ;
+  TYPE_THEN `~(C' = C'')` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[adj];
+  UND 22 THEN ASM_REWRITE_TAC[];
+  (* --- *)
+  TYPE_THEN `~(endpoint A' q)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end];
+  USE 2 SYM;
+  USE 22 (REWRITE_RULE[endpoint]);
+  THM_INTRO_TAC[`A'`;`pointI q`] num_closure1;
+  USE 3 (REWRITE_RULE[psegment;segment]);
+  REWR 27;
+  COPY 27;
+  TSPEC `C'` 27;
+  TSPEC `C''` 28;
+  ASM_MESON_TAC[];
+  (* ---A *)
+  TYPE_THEN `~(endpoint C q)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end];
+  TYPE_THEN `endpoint A'` UNABBREV_TAC;
+  TYPE_THEN `endpoint C` UNABBREV_TAC;
+  UND 22 THEN ASM_REWRITE_TAC[];
+  (* --- *)
+  PROOF_BY_CONTR_TAC;
+  UND 23 THEN ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  rectagon_subset_endpoint;
+  USE 1 SYM;
+  TYPE_THEN `E` EXISTS_TAC;
+  CONJ_TAC THEN IMATCH_MP_TAC  num_closure_pos;
+  CONJ_TAC;
+  USE 2 (REWRITE_RULE[segment_end;segment;psegment]);
+  TYPE_THEN `C'` EXISTS_TAC;
+  (* --- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  FULL_REWRITE_TAC[rectagon];
+  TYPE_THEN `C''` EXISTS_TAC;
+  REWRITE_TAC[DIFF];
+  USE 11 (REWRITE_RULE[SUBSET]);
+  (* -- *)
+  USE 10 (REWRITE_RULE[segment_end;psegment;segment]);
+  FULL_REWRITE_TAC[inductive_set];
+  UND 14 THEN DISCH_THEN (THM_INTRO_TAC[`A' INTER C`]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET_INTER_ABSORPTION];
+  (* -B *)
+  TYPE_THEN `!A B. (A INTER B = EMPTY ) /\ (E = A UNION B) /\ (segment_end B m n) /\ (segment_end A m n) /\ (B SUBSET E) /\ (A SUBSET E) /\ ~(C INTER A = EMPTY) ==> (C = A)` SUBAGOAL_TAC;
+  TYPE_THEN `A' SUBSET C` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FULL_REWRITE_TAC[INTER_COMM];
+  UND 10 THEN ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `B' INTER C = EMPTY` ASM_CASES_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `A UNION B` UNABBREV_TAC;
+  UND 5 THEN UND 18 THEN UND 17 THEN POP_ASSUM_LIST (fun t-> ALL_TAC);
+  FULL_REWRITE_TAC[SUBSET;INTER;EQ_EMPTY;UNION];
+  IMATCH_MP_TAC  EQ_EXT ;
+  TSPEC `x` 0;
+  TSPEC `x` 1;
+  TSPEC `x` 2;
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `B' SUBSET C` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USE 1 SYM;
+  TYPE_THEN `E = C` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_MESON_TAC[subset_imp];
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `A UNION B` UNABBREV_TAC;
+  USE 5 (REWRITE_RULE[SUBSET;UNION]);
+  TYPE_THEN `C` UNABBREV_TAC;
+  USE 2 (REWRITE_RULE[segment_end;psegment]);
+  UND 20 THEN ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~(C INTER A = EMPTY) \/ ~( C INTER B = EMPTY)` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 11 (REWRITE_RULE[DE_MORGAN_THM]);
+  TYPE_THEN `E` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY];
+  USE 5 (REWRITE_RULE[SUBSET;UNION]);
+  USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  TSPEC `u` 1;
+  TSPEC `u` 11;
+  TSPEC `u` 12;
+  ASM_MESON_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  DISJ1_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `B` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET;UNION];
+  DISJ2_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `A` EXISTS_TAC;
+  FULL_REWRITE_TAC[INTER_COMM;UNION_COMM];
+  ASM_REWRITE_TAC[SUBSET;UNION];
+  (* Mon Dec 27 20:34:44 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let conn2_sequence_lemma5 = prove_by_refinement(
+  `!C E . ~(E SUBSET C) /\ psegment E /\ rectagon C /\
+    endpoint E SUBSET cls C  ==>
+   (?E'. E' SUBSET E /\ psegment E' /\ (E' INTER C = EMPTY ) /\
+     (cls E' INTER cls C = endpoint E'))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `?e. E e /\ ~C e` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `J = segment_of (E DIFF C) e` ABBREV_TAC ;
+  TYPE_THEN `X = { A | psegment A /\ A SUBSET E /\ (A INTER C = EMPTY) /\ (endpoint A SUBSET cls C)}` ABBREV_TAC ;
+  TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC THENL [REWRITE_TAC[EMPTY_EXISTS];ALL_TAC];
+  TYPE_THEN `X` UNABBREV_TAC;
+  TYPE_THEN `J` EXISTS_TAC;
+  TYPE_THEN `J SUBSET (E DIFF C)` SUBAGOAL_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  THM_INTRO_TAC[`(E DIFF C)`;`e`] segment_of_G;
+  REWRITE_TAC[DIFF];
+  CONJ_TAC;
+  THM_INTRO_TAC[`E`;`E DIFF C`;`e`] segment_of_segment;
+  FULL_REWRITE_TAC[psegment];
+  REWRITE_TAC[DIFF;SUBSET];
+  TYPE_THEN `J` UNABBREV_TAC;
+  REWRITE_TAC[psegment];
+  DISCH_TAC;
+  THM_INTRO_TAC[`segment_of (E DIFF C) e`;`E`] rectagon_subset;
+  USE 2 (REWRITE_RULE[psegment]);
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `E DIFF C` EXISTS_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  USE 2 (REWRITE_RULE[psegment]);
+  ASM_MESON_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  UND 7 THEN REWRITE_TAC[SUBSET;DIFF];
+  CONJ_TAC;
+  UND 7 THEN REWRITE_TAC[SUBSET;DIFF;INTER;EQ_EMPTY] THEN MESON_TAC[];
+  REWRITE_TAC[SUBSET];
+  PROOF_BY_CONTR_TAC;
+  (* --A *)
+  THM_INTRO_TAC[`E DIFF C`;`e`] inductive_segment;
+  REWRITE_TAC[DIFF];
+  FULL_REWRITE_TAC[inductive_set];
+  USE 8 (REWRITE_RULE[endpoint]);
+  THM_INTRO_TAC[`J`;`pointI x`] num_closure1;
+  TYPE_THEN `J` UNABBREV_TAC;
+  IMATCH_MP_TAC  segment_of_finite;
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  USE 2 (REWRITE_RULE[psegment;segment]);
+  REWRITE_TAC[DIFF];
+  REWR 13;
+ USE 2 (REWRITE_RULE[psegment;segment]);
+  TSPEC `x` 15;
+  USE 15 (REWRITE_RULE[INSERT]);
+  UND 15 THEN REP_CASES_TAC;
+  THM_INTRO_TAC[`E`;`pointI x`] num_closure2;
+  REWR 15;
+  (* ---- *)
+  TYPE_THEN `?a b. ~(a = b) /\ (!e. E e /\ closure top2 e (pointI x) <=> (e = a) \/ (e = b)) /\ (!e. J e /\ closure top2 e (pointI x) <=> (e = a))` SUBAGOAL_TAC;
+  TYPE_THEN `(e' = a) \/ (e' = b)` SUBAGOAL_TAC;
+  TSPEC `e'` 15;
+  USE 15 (ONCE_REWRITE_RULE[EQ_SYM_EQ]);
+  TSPEC `e'` 13;
+  TYPE_THEN `J` UNABBREV_TAC;
+  THM_INTRO_TAC[`E DIFF C`;`e`] segment_of_G;
+  REWRITE_TAC[DIFF];
+  USE 21 (REWRITE_RULE[SUBSET]);
+  TSPEC `e'` 21;
+  USE 13 (REWRITE_RULE[DIFF]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  TYPE_THEN `a` EXISTS_TAC ;
+  TYPE_THEN `b` EXISTS_TAC;
+  MESON_TAC[];
+  TYPE_THEN `e'` UNABBREV_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  REWRITE_TAC [EQ_SYM_EQ ];
+  MESON_TAC[];
+  (* ---- *)
+  USE 6 SYM;
+  TYPE_THEN `segment_of (E DIFF C) e b'` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `a'` EXISTS_TAC;
+  CONJ_TAC;
+  TSPEC `a'` 21;
+  TYPE_THEN `J` UNABBREV_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[DIFF];
+  CONJ_TAC;
+  TSPEC `b'` 22;
+  KILL 15;
+  REWR 22;
+  (* ------ *)
+  USE 9 (REWRITE_RULE[cls]);
+  LEFT 9 "e";
+  TSPEC  `b'` 9;
+  TSPEC `b'` 22;
+  KILL 15;
+  UND 22 THEN ASM_REWRITE_TAC[];
+  UND 9 THEN ASM_REWRITE_TAC[];
+  (* ----- *)
+  REWRITE_TAC[adj];
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  TYPE_THEN `pointI x` EXISTS_TAC;
+  KILL 15;
+  COPY 22;
+  TSPEC  `a'` 15;
+  TSPEC `b'` 22;
+  REWR 22;
+  REWR 15;
+  (* ---- *)
+  TSPEC `b'` 21;
+  TYPE_THEN `J` UNABBREV_TAC;
+  TSPEC `b'` 22;
+  KILL 15;
+  REWR 6;
+  KILL 13;
+  UND 21 THEN ASM_REWRITE_TAC[];
+  (* --- *)
+  USE 0 (REWRITE_RULE[SUBSET]);
+  TSPEC `x` 0;
+  USE 0 (REWRITE_RULE[endpoint]);
+  UND 9 THEN ASM_REWRITE_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`J`;`E`;`pointI x`] num_closure_mono;
+  TYPE_THEN `J` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET];
+  THM_INTRO_TAC[`E DIFF C`;`e`] segment_of_G;
+  REWRITE_TAC[DIFF];
+  USE 19 (REWRITE_RULE[SUBSET]);
+  TSPEC `x'` 19;
+  USE 6 (REWRITE_RULE[DIFF]);
+  UND 8 THEN UND 15 THEN UND 19 THEN ARITH_TAC;
+  (* -B *)
+  THM_INTRO_TAC[`X`] select_card_min;
+  UND 8 THEN ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `z` EXISTS_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  IMATCH_MP_TAC  (TAUT `a /\ b==> b /\ a`);
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET_INTER];
+  IMATCH_MP_TAC  endpoint_cls;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  USE 2 (REWRITE_RULE[psegment;segment]);
+  REWRITE_TAC[INTER;SUBSET];
+  PROOF_BY_CONTR_TAC;
+  (* - cut along x *)
+  THM_INTRO_TAC[`z`] endpoint_size2;
+  FULL_REWRITE_TAC[has_size2];
+  TYPE_THEN `segment_end z a b` SUBAGOAL_TAC;
+  REWRITE_TAC[segment_end];
+  (* - *)
+  THM_INTRO_TAC[`z`;`a`;`b`;`x`] cut_psegment;
+  TYPE_THEN `endpoint z` UNABBREV_TAC;
+  USE 15 (REWRITE_RULE[INR in_pair;DE_MORGAN_THM ]);
+  UND 9 THEN DISCH_THEN (THM_INTRO_TAC[`A`]);
+  CONJ_TAC;
+  USE 20 (REWRITE_RULE[segment_end]);
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `z` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  CONJ_TAC;
+  REWRITE_TAC[EQ_EMPTY;INTER];
+  USE 10 (REWRITE_RULE[INTER;EQ_EMPTY ]);
+  TSPEC `x'` 10;
+  UND 10 THEN ASM_REWRITE_TAC[];
+  REWRITE_TAC[UNION];
+  USE 20 (REWRITE_RULE[segment_end]);
+  REWRITE_TAC[SUBSET;INR in_pair];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  USE 7 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[];
+  USE 9 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
+  UND 9 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  card_subset_lt;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  CONJ_TAC;
+  TYPE_THEN `B = EMPTY` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 24 (REWRITE_RULE[EMPTY_EXISTS]);
+  USE 9 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPEC `u` 9;
+  USE 9 (REWRITE_RULE[UNION]);
+  UND 22 THEN ASM_REWRITE_TAC[INTER;EMPTY_EXISTS];
+  ASM_MESON_TAC[];
+  TYPE_THEN `B` UNABBREV_TAC;
+  USE 19 (REWRITE_RULE[segment_end;psegment;segment]);
+  (* - *)
+  TYPE_THEN `A UNION B` UNABBREV_TAC;
+  USE 12 (REWRITE_RULE[psegment;segment;]);
+  (* Mon Dec 27 23:01:48 EST 2004 *)
+
+
+  ]);;
+  (* }}} *)
+
+let conn_splice = prove_by_refinement(
+  `!E AE B a b a' b'. segment_end E a b /\ segment_end AE a' b' /\
+      segment_end B a' b' /\ AE SUBSET E ==>
+      (?B'. segment_end B' a b /\ B' SUBSET (E DIFF AE) UNION B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `J= (E DIFF AE) UNION B` ABBREV_TAC ;
+  TYPE_THEN `B SUBSET J` SUBAGOAL_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  TYPE_THEN `cls B SUBSET cls J` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  TYPE_THEN `endpoint B SUBSET cls B` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  endpoint_cls;
+  USE 1 (REWRITE_RULE[segment_end;segment;psegment]);
+  (* - *)
+  TYPE_THEN `cls B a' /\ cls B b'` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET];
+  USE 1 (REWRITE_RULE[segment_end]);
+  CONJ_TAC  THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_REWRITE_TAC[INR in_pair ];
+  TYPE_THEN `cls J a' /\ cls J b'` SUBAGOAL_TAC;
+  USE 6 (REWRITE_RULE[SUBSET]);
+  (* -// *)
+  TYPE_THEN `conn J` SUBAGOAL_TAC ;
+  TYPE_THEN `!x. cls J x ==> (x = a') \/ (?P. segment_end P x a' /\ P SUBSET J)` BACK_TAC;
+  REWRITE_TAC[conn];
+  TYPE_THEN `a'' = a'` ASM_CASES_TAC;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  TYPE_THEN `a''` UNABBREV_TAC;
+  TSPEC `b''` 12;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `b''` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `P` EXISTS_TAC;
+  (* --- *)
+  TYPE_THEN `b'' = a'` ASM_CASES_TAC;
+  TYPE_THEN `b''` UNABBREV_TAC;
+  TSPEC `a''` 12;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `a''` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `P` EXISTS_TAC;
+  (* --- *)
+  COPY 12;
+  TSPEC `a''` 18;
+  REWR 15;
+  TSPEC `b''` 12;
+  REWR 12;
+  THM_INTRO_TAC[`P`;`P'`;`a''`;`a'`;`b''`] segment_end_trans;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  TYPE_THEN `U` EXISTS_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `P UNION P'` EXISTS_TAC;
+  REWRITE_TAC[union_subset];
+  (* --A// *)
+  TYPE_THEN `x = a'` ASM_CASES_TAC;
+  TYPE_THEN `x = b'` ASM_CASES_TAC;
+  TYPE_THEN `B` EXISTS_TAC;
+  ONCE_REWRITE_TAC [segment_end_symm];
+  (* -- *)
+  TYPE_THEN `?P. segment_end P x b' /\ P SUBSET J` ASM_CASES_TAC;
+  THM_INTRO_TAC[`P`;`B`;`x`;`b'`;`a'`] segment_end_trans;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  TYPE_THEN `U` EXISTS_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `P UNION B` EXISTS_TAC;
+  REWRITE_TAC[union_subset];
+  (* -- *)
+  TYPE_THEN `cls B x` ASM_CASES_TAC;
+  THM_INTRO_TAC[`B`;`a'`;`b'`;`x`] cut_psegment;
+  TYPE_THEN `A` EXISTS_TAC;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  TYPE_THEN `J` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  (* --// *)
+  TYPE_THEN `cls E x` SUBAGOAL_TAC;
+  TYPE_THEN `(E DIFF AE) SUBSET E` SUBAGOAL_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  USE 17 (MATCH_MP cls_subset);
+  USE 17 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `J` UNABBREV_TAC;
+  FULL_REWRITE_TAC[cls_union];
+  USE 12 (REWRITE_RULE[UNION]);
+  REWR 4;
+  (* -- *)
+  TYPE_THEN `cls (E DIFF AE) x` SUBAGOAL_TAC ;
+  TYPE_THEN `J` UNABBREV_TAC;
+  USE 12 (REWRITE_RULE[cls_union]);
+  USE 4 (REWRITE_RULE[UNION]);
+  REWR 4;
+  (* -- *)
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `S = {e | E e /\ ~AE e /\ (?x. closure top2 e (pointI x) /\ ~(?P. segment_end P x a' /\ P SUBSET J) /\ ~(?P. segment_end P x b' /\ P SUBSET J) ) }` ABBREV_TAC ;
+  TYPE_THEN `inductive_set E S` SUBAGOAL_TAC;
+  REWRITE_TAC[inductive_set];
+  SUBCONJ_TAC;
+  TYPE_THEN `S` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET];
+  SUBCONJ_TAC;
+  USE 18 (REWRITE_RULE[cls]);
+  UND 22 THEN REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `e` EXISTS_TAC;
+  TYPE_THEN `S` UNABBREV_TAC;
+  USE 23 (REWRITE_RULE[DIFF]);
+  TYPE_THEN `x` EXISTS_TAC;
+  (* --- *)
+  TYPE_THEN `S` UNABBREV_TAC;
+  CONJ_TAC;
+  THM_INTRO_TAC[`E`;`AE`;`adjv C C'`] psegment_subset_endpoint;
+  SUBCONJ_TAC;
+  USE 3 (REWRITE_RULE[segment_end]);
+  CONJ_TAC;
+  IMATCH_MP_TAC  num_closure_pos;
+  CONJ_TAC;
+  USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
+  TYPE_THEN `C'` EXISTS_TAC;
+  IMATCH_MP_TAC  adjv_adj2;
+  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
+  USE 34 (REWRITE_RULE[SUBSET]);
+  IMATCH_MP_TAC  num_closure_pos;
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  USE 3 (REWRITE_RULE[segment_end;psegment;segment]);
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC [DIFF];
+  IMATCH_MP_TAC  adjv_adj;
+  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
+  USE 34 (REWRITE_RULE[SUBSET]);
+  USE 2 (REWRITE_RULE[segment_end]);
+  TYPE_THEN `endpoint AE` UNABBREV_TAC;
+  USE 30 (REWRITE_RULE[INR in_pair]);
+  (* ----B *)
+  TYPE_THEN `x' = adjv C C'` ASM_CASES_TAC;
+  TYPE_THEN `adjv C C'` UNABBREV_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC THEN REP_BASIC_TAC THEN (TYPE_THEN`x'` UNABBREV_TAC);
+  UND 24 THEN REWRITE_TAC[];
+  TYPE_THEN `B` EXISTS_TAC;
+  ONCE_REWRITE_TAC [segment_end_symm];
+  UND 20 THEN REWRITE_TAC[];
+  TYPE_THEN `B` EXISTS_TAC;
+  (* ----//B1 *)
+  THM_INTRO_TAC[`C`;`C'`] adjv_adj;
+  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
+  USE 35 (REWRITE_RULE[SUBSET]);
+  (* ---- *)
+  TYPE_THEN `{C} SUBSET J` SUBAGOAL_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;INR IN_SING;DIFF;UNION];
+  (* ---- *)
+  TYPE_THEN `segment_end {C} x' (adjv C C')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  segment_end_sing;
+  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
+  USE 37 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `b'` UNABBREV_TAC;
+  UND 20 THEN REWRITE_TAC[];
+  TYPE_THEN `{C}` EXISTS_TAC;
+  TYPE_THEN `a'` UNABBREV_TAC;
+  UND 24 THEN REWRITE_TAC[];
+  TYPE_THEN `{C}` EXISTS_TAC;
+  (* --- *)
+  TYPE_THEN `adjv C C'` EXISTS_TAC;
+  TYPE_THEN `edge C /\ edge C'` SUBAGOAL_TAC;
+   USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
+  USE 32 (REWRITE_RULE[SUBSET]);
+  CONJ_TAC;
+  IMATCH_MP_TAC  adjv_adj2;
+  (* --- *)
+  TYPE_THEN `x' = adjv C C'` ASM_CASES_TAC;
+  TYPE_THEN `adjv C C'` UNABBREV_TAC;
+  (* ---C//  *)
+  TYPE_THEN `segment_end {C} x' (adjv C C')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  segment_end_sing;
+  IMATCH_MP_TAC  adjv_adj;
+  TYPE_THEN `{C} SUBSET J` SUBAGOAL_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;DIFF;UNION;INR IN_SING ];
+  (* --- *)
+  TYPE_THEN `adjv C C' = a'` ASM_CASES_TAC;
+  TYPE_THEN `adjv C C'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 24 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `{C}` EXISTS_TAC;
+  TYPE_THEN `adjv C C' = b'` ASM_CASES_TAC;
+  TYPE_THEN `adjv C C'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 20 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `{C}` EXISTS_TAC;
+  (* --- repeat from here *)
+  TYPE_THEN `x' = a'` ASM_CASES_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 20 THEN REWRITE_TAC[];
+  TYPE_THEN `B` EXISTS_TAC;
+  TYPE_THEN `x' = b'` ASM_CASES_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UND 24 THEN REWRITE_TAC[];
+  TYPE_THEN `B` EXISTS_TAC;
+  ONCE_REWRITE_TAC[segment_end_symm];
+  (* --- *)
+  CONJ_TAC;
+  UND 24 THEN REWRITE_TAC[];
+  THM_INTRO_TAC[`{C}`;`P`;`x'`;`adjv C C'`;`a'`] segment_end_trans;
+  TYPE_THEN `U` EXISTS_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `{C} UNION P` EXISTS_TAC;
+  REWRITE_TAC[union_subset];
+  (* ---// *)
+  UND 20 THEN REWRITE_TAC[];
+  THM_INTRO_TAC[`{C}`;`P`;`x'`;`adjv C C'`;`b'`] segment_end_trans;
+  TYPE_THEN `U` EXISTS_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `{C} UNION P` EXISTS_TAC;
+  REWRITE_TAC[union_subset];
+  (* -- *)
+  TYPE_THEN `S = E` SUBAGOAL_TAC;
+  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FULL_REWRITE_TAC[inductive_set];
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `S` UNABBREV_TAC;
+  USE 22 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TYPE_THEN `~(AE = EMPTY)` SUBAGOAL_TAC;
+  USE 2 (REWRITE_RULE[segment_end;segment;psegment]);
+  UND 27 THEN ASM_REWRITE_TAC[];
+  USE 22 (REWRITE_RULE[EMPTY_EXISTS]);
+  TSPEC `u` 20;
+  UND 20 THEN ASM_REWRITE_TAC[];
+  USE 0 (REWRITE_RULE[SUBSET]);
+  (* -D//  *)
+  FULL_REWRITE_TAC[conn];
+  TYPE_THEN `~(a = b)` SUBAGOAL_TAC;
+  USE 3 (MATCH_MP segment_end_disj);
+ UND 3 THEN ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[TAUT `a /\ b <=> b /\ a`];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  TYPE_THEN `!c. endpoint E c /\ cls AE c ==> endpoint AE c` SUBAGOAL_TAC;
+  REWRITE_TAC[endpoint];
+  THM_INTRO_TAC[`AE`;`E`;`pointI c`] num_closure_mono;
+  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
+  USE 15 (REWRITE_RULE[endpoint]);
+  REWR 16;
+  USE 16 (MATCH_MP (ARITH_RULE `x <=| 1 ==> (x = 1) \/ (x = 0)`));
+  FIRST_ASSUM DISJ_CASES_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 14 (REWRITE_RULE[cls]);
+  THM_INTRO_TAC[`AE`;`pointI c`] num_closure0;
+  USE 2 (REWRITE_RULE[segment_end;psegment;segment]);
+  REWR 20;
+  TSPEC `e` 20;
+  UND 19 THEN ASM_REWRITE_TAC[];
+  (* -E *)
+  TYPE_THEN `!c. endpoint E c ==> cls J c` SUBAGOAL_TAC;
+  TYPE_THEN `J` UNABBREV_TAC;
+  REWRITE_TAC[cls_union];
+  REWRITE_TAC[UNION];
+  TYPE_THEN `cls AE c` ASM_CASES_TAC;
+  TSPEC `c` 14;
+  TYPE_THEN `endpoint AE c` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `endpoint B c` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[segment_end];
+  TYPE_THEN `{a',b'}` UNABBREV_TAC;
+  THM_INTRO_TAC[`B`] endpoint_cls;
+  USE 1 (REWRITE_RULE[segment_end;psegment;segment]);
+  DISJ2_TAC;
+  ASM_MESON_TAC[subset_imp];
+  DISJ1_TAC;
+  TYPE_THEN `E = (E DIFF AE) UNION AE` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  UND 0 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
+  TYPE_THEN `cls E c` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`E`] endpoint_cls;
+  USE 3 (REWRITE_RULE[segment_end;segment;psegment]);
+  ASM_MESON_TAC[subset_imp];
+  UND 16 THEN DISCH_THEN (fun t -> USE 17 (ONCE_REWRITE_RULE[t]));
+  FULL_REWRITE_TAC[cls_union];
+  USE 16 (REWRITE_RULE[UNION ]);
+  REWR 16;
+  (* - *)
+  USE 3 (REWRITE_RULE[segment_end]);
+  TYPE_THEN `endpoint E` UNABBREV_TAC;
+  USE 15 (REWRITE_RULE[INR in_pair]);
+  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
+  (* Tue Dec 28 12:02:34 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let conn2_sequence = prove_by_refinement(
+  `!G N p. (0 < N) /\ (!i. (i <= N) ==> (conn2 (G i))) /\
+    (!i. (i <= N) ==> (G i SUBSET edge )) /\
+    (!i. (SUC i <= N) ==> ~(G i INTER G (SUC i) = EMPTY)) /\
+    (!i j. (i < j) /\ (j <=| N) /\ ~(SUC i = j) ==>
+         (curve_cell (G i) INTER (curve_cell (G j)) = EMPTY)) /\
+    (!i. (SUC i <= N) ==> (unbounded_set (G i UNION G (SUC i)) p)) ==>
+    (unbounded_set (UNIONS (IMAGE G ({i | i <= N}))) p)
+   `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`N`;`G`;`N`] conn2_sequence_lemma1;
+  ARITH_TAC;
+  THM_INTRO_TAC[`G`;`N`;`p`] conn2_sequence_lemma2;
+  THM_INTRO_TAC[`G`;`N`] conn2_sequence_lemma3;
+  THM_INTRO_TAC[`G`;`N`;`p`] conn2_sequence_lemma4;
+  (* - *)
+  TYPE_THEN `?ei. C ei /\ G i ei /\ (!k. i < k /\ k <=|j ==> ~G k ei)` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`C`;`SUC i`;`j`]);
+  TYPE_THEN `{x | i <=| x /\ x <=| j} = {i} UNION {x | SUC i <= x /\ x <= j}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  UNDH 3810 THEN ARITH_TAC;
+  REWRH 1849;
+  USEH 4802 (REWRITE_RULE[IMAGE_UNION;image_sing;UNIONS_UNION]);
+  USEH 5681 (REWRITE_RULE[SUBSET;UNION;UNIONS;IMAGE]);
+  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
+  CONV_TAC (dropq_conv "u");
+  NAME_CONFLICT_TAC;
+  TSPECH `x` 7945;
+  LEFTH 1695 "ei";
+  TSPECH `x` 5608;
+  LEFTH 1699 "u";
+  USEH 7623 (CONV_RULE NAME_CONFLICT_CONV);
+  REWRH 2787;
+  TYPE_THEN `G i x` ASM_CASES_TAC;
+  REWRH 2360;
+  LEFTH 4513 "k" ;
+  TYPE_THEN `k` EXISTS_TAC;
+  UNDH 2414 THEN MESON_TAC[ARITH_RULE `a <| b ==> SUC a <=| b`];
+  REWRH 7623;
+  ASM_MESON_TAC[];
+  UNDH 5817 THEN UNDH 3810 THEN ARITH_TAC;
+  (* -A *)
+  TYPE_THEN `?ej. C ej /\ G j ej /\ (!k. i <= k /\ k <| j ==> ~G k ej)` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`C`;`i`;`j -1`]);
+  TYPE_THEN `{x | i <=| x /\ x <=| j} = {j} UNION {x | i <= x /\ x <= j- 1}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  UNDH 3810 THEN ARITH_TAC;
+  REWRH 1849;
+  USEH 6712 (REWRITE_RULE[IMAGE_UNION;image_sing;UNIONS_UNION]);
+  USEH 7737 (REWRITE_RULE[SUBSET;UNION;UNIONS;IMAGE]);
+  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
+  CONJ_TAC ;
+  UNDH 3810 THEN ARITH_TAC;
+  CONJ_TAC;
+  UNDH 5153 THEN ARITH_TAC;
+  CONV_TAC (dropq_conv "u");
+  NAME_CONFLICT_TAC;
+  TSPECH `x` 5663;
+  LEFTH 6587 "ej";
+  TSPECH `x` 613;
+  LEFTH 8601 "u";
+  USEH 2468 (CONV_RULE NAME_CONFLICT_CONV);
+  REWRH 3770;
+  TYPE_THEN `G j x` ASM_CASES_TAC;
+  REWRH 7772;
+  LEFTH 3203 "k" ;
+  TYPE_THEN `k` EXISTS_TAC;
+  UNDH 9304 THEN MESON_TAC[ARITH_RULE `a <| b ==> a <=| b - 1`];
+  REWRH 2468;
+  ASM_MESON_TAC[];
+  UNDH 7805 THEN UNDH 3810 THEN ARITH_TAC;
+  (* -B< *)
+  TYPE_THEN `Ci = {e | C e /\ G i e /\ (!k. i <| k /\ k <=| j ==> ~G k e)}` ABBREV_TAC ;
+  TYPE_THEN `Ci ei` SUBAGOAL_TAC;
+  TYPE_THEN `Ci` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `CiS = segment_of Ci ei` ABBREV_TAC ;
+  TYPE_THEN `segment CiS` SUBAGOAL_TAC;
+  TYPE_THEN `CiS` UNABBREV_TAC;
+  IMATCH_MP_TAC  segment_of_segment;
+  TYPE_THEN `C` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  TYPE_THEN `Ci` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET];
+  (* - *)
+  TYPE_THEN `~Ci ej` SUBAGOAL_TAC THENL [TYPE_THEN `Ci` UNABBREV_TAC;ALL_TAC];
+  TSPECH `j` 9673;
+  UNDH 375 THEN ASM_REWRITE_TAC[];
+  UNDH 3810  THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `CiS SUBSET Ci` SUBAGOAL_TAC;
+  TYPE_THEN `CiS` UNABBREV_TAC;
+  IMATCH_MP_TAC  segment_of_G;
+  (* - *)
+  TYPE_THEN `psegment CiS` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`CiS`;`C`] rectagon_subset;
+  USEH 5119 (REWRITE_RULE[psegment]);
+  REWRH 2394;
+  CONJ_TAC;
+  IMATCH_MP_TAC  rectagon_segment;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Ci` EXISTS_TAC;
+  TYPE_THEN `Ci` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET];
+  TYPE_THEN `C` UNABBREV_TAC;
+  USEH 2712 (REWRITE_RULE[SUBSET]);
+  UNDH 7665 THEN REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`CiS`] endpoint_size2;
+  FULL_REWRITE_TAC[has_size2];
+  USEH 1801 SYM;
+  (* -C< *)
+  TYPE_THEN `Ci SUBSET C` SUBAGOAL_TAC;
+  TYPE_THEN `Ci` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET];
+  TYPE_THEN `CiS SUBSET C` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `Ci` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `!m. endpoint CiS m ==> cls (G (SUC i)) m` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`CiS`;`C`;`m`] endpoint_sub_rectagon;
+  USEH 5941 (REWRITE_RULE[EXISTS_UNIQUE_ALT]);
+  REWRITE_TAC[cls];
+  TYPE_THEN `e` EXISTS_TAC;
+  TSPECH `e` 8431;
+  USEH 3634 (REWRITE_RULE[cls_edge]);
+  (* -- *)
+  KILLH 3313 THEN KILLH 5237 THEN KILLH 2072  THEN KILLH 4795 THEN KILLH 3667 THEN KILLH 8912;
+  REWRH 142;
+  TYPE_THEN `~Ci e` SUBAGOAL_TAC;
+  KILLH 5989 THEN KILLH 9803 THEN KILLH 1909 THEN KILLH 8416 THEN KILLH 320 THEN KILLH 846;
+  THM_INTRO_TAC[`Ci`;`ei`] inductive_segment;
+  FULL_REWRITE_TAC[inductive_set];
+  USEH 7070 (REWRITE_RULE[endpoint]);
+  THM_INTRO_TAC[`CiS`;`pointI m`] num_closure1;
+  FULL_REWRITE_TAC[segment];
+  REWRH 4780;
+  UNDH 8549 THEN DISCH_THEN (THM_INTRO_TAC[`e'`;`e`]);
+  REWRITE_TAC[adj;INTER;EMPTY_EXISTS];
+  TSPECH `e'` 5120;
+  REWRH 6063;
+  CONJ_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  UNDH 9580 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `pointI m` EXISTS_TAC;
+  TYPE_THEN `CiS` UNABBREV_TAC;
+  UNDH 1420 THEN ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `UNIONS (IMAGE G {x | i <=| x /\ x <=| j}) e` SUBAGOAL_TAC;
+  USEH 1849 (REWRITE_RULE[SUBSET]);
+  USEH 9077 (REWRITE_RULE[UNIONS;IMAGE]);
+  TYPE_THEN `u` UNABBREV_TAC;
+  (* --// *)
+  TYPE_THEN `!y. (SUC i < y) /\ (y <=| N) ==> ~(G y e)` SUBAGOAL_TAC;
+  UNDH 4928 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`y`]);
+  UNDH 8692 THEN ARITH_TAC;
+  USEH 6879 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPECH `{(pointI m)}` 6278;
+  TYPE_THEN `!r. (r <=| N) ==> (G r SUBSET UNIONS (IMAGE G {i | i <=| N}))` SUBAGOAL_TAC;
+  REWRITE_TAC[UNIONS;IMAGE;SUBSET];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `r` EXISTS_TAC;
+  (* --- *)
+  TYPE_THEN `!r. (r <=| N) ==> (curve_cell (G r) {(pointI m)} <=> (?e. G r e /\ closure top2 e (pointI m)))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  curve_cell_point;
+  USEH 2858 (REWRITE_RULE[conn2;]);
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  UNIFY_EXISTS_TAC;
+  (* --- *)
+  TYPE_THEN `i <=| N` SUBAGOAL_TAC;
+  UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
+  UNDH 4794 THEN ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  USEH 7070 (REWRITE_RULE[endpoint]);
+  THM_INTRO_TAC[`CiS`;`pointI m`] num_closure1;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `C` EXISTS_TAC;
+  FULL_REWRITE_TAC[rectagon];
+  REWRH 4780;
+  TYPE_THEN `e'` EXISTS_TAC;
+  TSPECH `e'` 5120;
+  REWRH 6063;
+  TYPE_THEN `Ci` UNABBREV_TAC;
+  USEH 2281 (REWRITE_RULE[SUBSET]);
+  (* --- *)
+  TYPE_THEN `e` EXISTS_TAC;
+  (* --D< *)
+  PROOF_BY_CONTR_TAC;
+  USEH 1849 (REWRITE_RULE[UNIONS;IMAGE;SUBSET]);
+  TSPECH `e` 5988;
+  FULL_REWRITE_TAC[];
+  TYPE_THEN `u'` UNABBREV_TAC;
+  TYPE_THEN `x' = i` ASM_CASES_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `Ci` UNABBREV_TAC;
+  UNDH 8814 THEN ASM_REWRITE_TAC[];
+  TSPECH  `k` 8651;
+  TYPE_THEN `k = SUC i` ASM_CASES_TAC;
+  UNDH 9079 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `k` UNABBREV_TAC;
+  UNDH 5461 THEN ASM_REWRITE_TAC[];
+  UNDH 9872 THEN UNDH 5198 THEN  UNDH 2528 THEN UNDH 5153 THEN ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `x' = SUC i` ASM_CASES_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  UNDH 9079 THEN ASM_REWRITE_TAC[];
+  TSPECH `x'` 8651;
+  UNDH 7878 THEN ASM_REWRITE_TAC[];
+  UNDH 9481 THEN UNDH 5258 THEN UNDH 5565 THEN UNDH 6996 THEN UNDH 5153 THEN ARITH_TAC;
+  (* - *)
+  COPYH 9674;
+  UNDH 9674 THEN DISCH_THEN (THM_INTRO_TAC[`b`]);
+  USEH 8662 SYM;
+  REWRITE_TAC[];
+  UNDH 9674 THEN DISCH_THEN (THM_INTRO_TAC[`a`]);
+  USEH 8662 SYM;
+  REWRITE_TAC[];
+  (* -E *)
+  TYPE_THEN `X = { E | E SUBSET (C UNION (G (SUC i))) /\ ~(E ei) /\ ~(E ej) /\ segment_end E a b }` ABBREV_TAC ;
+  TYPE_THEN `~(X = EMPTY)` SUBAGOAL_TAC THENL [REWRITE_TAC[EMPTY_EXISTS];ALL_TAC];
+  TYPE_THEN `X` UNABBREV_TAC;
+  UNDH 8912 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]);
+  UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
+  THM_INTRO_TAC[`G (SUC i)`] conn2_imp_conn;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+   UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
+  FULL_REWRITE_TAC[conn];
+  UNDH 6247 THEN DISCH_THEN (THM_INTRO_TAC[`a`;`b`]);
+  TYPE_THEN  `S` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `G (SUC i)` EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION ];
+  TSPECH `SUC i` 320;
+  TSPECH `SUC i` 9803;
+  UNDH 8789 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  UNDH 3810 THEN ARITH_TAC;
+  UNDH 5005 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  ARITH_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  USEH 1620 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  UNDH 4837 THEN REWRITE_TAC[] THEN FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 683 THEN REWRITE_TAC[] THEN FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `f = (\ E . CARD (E DIFF C))` ABBREV_TAC ;
+  THM_INTRO_TAC[`X`;`f`] select_image_num_min;
+  UNDH 6007 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `E = z` ABBREV_TAC ;
+  TYPE_THEN `z` UNABBREV_TAC;
+  (* -F< *)
+  TYPE_THEN `cls C a /\ cls C b` SUBAGOAL_TAC;
+  TYPE_THEN `cls CiS SUBSET cls C` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cls_subset;
+  USEH 2127 (REWRITE_RULE[SUBSET]);
+  THM_INTRO_TAC[`CiS`] endpoint_cls;
+  USEH 214 (REWRITE_RULE[psegment;segment]);
+  USEH 477 (REWRITE_RULE[SUBSET]);
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN (TYPE_THEN `endpoint CiS` UNABBREV_TAC) THEN REWRITE_TAC[INR in_pair];
+  (* -// *)
+  THM_INTRO_TAC[`C`;`a`;`b`] cut_rectagon_cls;
+  TYPE_THEN `segment_end CiS a b` SUBAGOAL_TAC;
+  REWRITE_TAC[segment_end];
+  TYPE_THEN `?CjS. (cls (CjS) INTER cls CiS = {a,b}) /\ (CiS INTER CjS = EMPTY) /\ (C = CiS UNION CjS) /\ segment_end CjS a b ` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`C`;`A`;`B`;`CiS`;`a`;`b`] cut_rectagon_unique;
+  REWRITE_TAC[SUBSET;UNION];
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[INTER_COMM];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `B` UNABBREV_TAC;
+  TYPE_THEN `A` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[INTER_COMM;UNION_COMM;];
+  KILLH 7539 THEN KILLH 8335 THEN KILLH 2130 THEN KILLH 6524 THEN KILLH 3863;
+  (* -G< *)
+  TYPE_THEN `CjS ej` SUBAGOAL_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  USEH 2238 (REWRITE_RULE[UNION ]);
+  UNDH 3048 THEN UNDH 2712 THEN UNDH 7665 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC ));
+  USEH 2712 (REWRITE_RULE[SUBSET]);
+  ASM_MESON_TAC[];
+  (* -// *)
+  TYPE_THEN `CiS ei` SUBAGOAL_TAC;
+  TYPE_THEN `CiS` UNABBREV_TAC;
+  REWRITE_TAC[segment_of_in];
+  TYPE_THEN `~CjS ei` SUBAGOAL_TAC;
+  UNDH 947 THEN UNDH 1398  THEN UNDH 3558 THEN REWRITE_TAC[INTER;EQ_EMPTY] THEN MESON_TAC[];
+  (* -// *)
+  TYPE_THEN `~(E SUBSET C)` SUBAGOAL_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  THM_INTRO_TAC[`C`;`CiS`;`CjS`;`E`;`a`;`b`] cut_rectagon_unique;
+  REWRITE_TAC[SUBSET;UNION];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  UNDH 5338 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `E` UNABBREV_TAC;
+  UNDH 442 THEN ASM_REWRITE_TAC[];
+  (* -H< *)
+  THM_INTRO_TAC[`C`;`E`] conn2_sequence_lemma5;
+  USEH 4704 SYM;
+  CONJ_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  USEH 7614 (REWRITE_RULE[segment_end]);
+  TYPE_THEN `X` UNABBREV_TAC;
+  USEH 7614 (REWRITE_RULE[segment_end]);
+  REWRITE_TAC[SUBSET;INR in_pair];
+  FIRST_ASSUM (DISJ_CASES_TAC ) THEN (TYPE_THEN `x` UNABBREV_TAC);
+  (* -// *)
+  THM_INTRO_TAC[`E'`] endpoint_size2;
+  FULL_REWRITE_TAC[has_size2];
+  (* -// *)
+  TYPE_THEN `?E''. E'' SUBSET C /\ ~E'' ei /\ ~E'' ej /\ segment_end E'' a' b'` ASM_CASES_TAC;
+  UNDH 3844 THEN UNDH 6993 THEN UNDH 1260 THEN UNDH 6943 THEN UNDH 8389 THEN UNDH 2907 THEN UNDH 6174 THEN UNDH 7802 THEN UNDH 4430 THEN UNDH 5435 THEN UNDH 7079 THEN UNDH 2483 THEN UNDH 1489 THEN UNDH 9777 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC));
+  (* -- *)
+  TYPE_THEN `X` UNABBREV_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  (* --I< *)
+  THM_INTRO_TAC[`E`;`E'`;`E''`;`a`;`b`;`a'`;`b'`] conn_splice;
+  REWRITE_TAC[segment_end];
+  TSPECH `B'` 8320;
+  UNDH 8902 THEN  DISCH_THEN (THM_INTRO_TAC[]);
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `E UNION E''` EXISTS_TAC ;
+  CONJ_TAC;
+  UNDH 280 THEN REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
+  REWRITE_TAC[union_subset];
+  UNDH 6943 THEN REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `B' SUBSET E UNION E''` SUBAGOAL_TAC;
+  UNDH 280 THEN REWRITE_TAC[DIFF;SUBSET;UNION] THEN MESON_TAC[];
+  USEH 9489 (REWRITE_RULE[SUBSET;UNION]);
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `B' DIFF C SUBSET (E DIFF E') DIFF C` SUBAGOAL_TAC;
+  UNDH 280 THEN UND 3 THEN REWRITE_TAC[SUBSET;DIFF;UNION;] THEN MESON_TAC[];
+  USEH 8272 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
+  UNDH 200 THEN ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  card_subset_lt;
+  CONJ_TAC;
+  UNDH 8308 THEN (REWRITE_TAC[DIFF;SUBSET]) THEN MESON_TAC[];
+  CONJ_TAC;
+  USEH 7143 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TYPE_THEN `~(E' = EMPTY)` SUBAGOAL_TAC ;
+  USEH 4430 (REWRITE_RULE[psegment;segment]);
+  UNDH 5706 THEN ASM_REWRITE_TAC[];
+  USEH 5706 (REWRITE_RULE[EMPTY_EXISTS]);
+  TSPECH `u` 5085;
+  USEH 9707 (REWRITE_RULE[DIFF]);
+  USEH 7802 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPECH `u` 6967;
+  UNDH 366 THEN ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  REWRH 2690;
+  USEH 8308 (REWRITE_RULE[SUBSET;DIFF;]);
+  TSPECH `u` 5436;
+  USEH 5435 (REWRITE_RULE[SUBSET]);
+  TSPECH `u` 5036;
+  ASM_MESON_TAC[];
+  (* -- *)
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `E` EXISTS_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  USEH 7614 (REWRITE_RULE[segment_end;segment;psegment]);
+  (* -J< // (57 HYP here ) *)
+  (* KILLH 846  THEN KILLH 1909  THEN KILLH 5989; ?? *)
+  KILLH 9203 THEN KILLH 4704 THEN KILLH 3558 THEN KILLH 3114 THEN KILLH 5443 THEN KILLH 7079 THEN KILLH 1489 THEN KILLH 6007 THEN KILLH 9461 THEN KILLH 4797 THEN KILLH 8662 THEN KILLH 214;
+  KILLH 4596 THEN KILLH 947 THEN KILLH 5282;
+  (* - *)
+  TYPE_THEN `E' SUBSET C UNION (G (SUC i))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `E` EXISTS_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `E' SUBSET (G (SUC i))` SUBAGOAL_TAC;
+  UNDH 7718 THEN UNDH 7802 THEN REWRITE_TAC[EQ_EMPTY;INTER;SUBSET;UNION] THEN MESON_TAC[];
+  KILLH 7718;
+  KILLH 7292 THEN KILLH 4330 THEN KILLH 4248 THEN KILLH 2712 THEN KILLH 7665 THEN KILLH 5425 THEN KILLH 5357 THEN KILLH 1285;
+  KILLH 145 THEN KILLH 7070 THEN KILLH 2483 THEN KILLH 9777;
+  KILLH 7420;
+  KILLH 5435;
+  (* -K< *)
+  TYPE_THEN `cls C a' /\ cls C b'` SUBAGOAL_TAC;
+  TYPE_THEN ` endpoint E' SUBSET cls C` SUBAGOAL_TAC;
+  USEH 2907 SYM;
+ KILLH  8660;
+  TYPE_THEN `endpoint E'` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;INTER];
+  REWRH 5756;
+  USEH 6207 (REWRITE_RULE[SUBSET;INR in_pair]);
+  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
+  (* -// *)
+  TYPE_THEN `?A B. segment_end A a' b' /\ segment_end B a' b' /\ (C = A UNION B) /\ (A INTER B = EMPTY) /\ (cls A INTER cls B = {a',b'}) /\ (A ei) /\ (B ej)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`C`;`a'`;`b'`] cut_rectagon_cls;
+  TYPE_THEN `A ei` ASM_CASES_TAC;
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `B` EXISTS_TAC;
+  FULL_REWRITE_TAC[INTER_COMM];
+  LEFTH 4284 "E''";
+  TSPECH `B` 567;
+  UNDH 469 THEN ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  UNDH 7424 THEN REP_CASES_TAC;
+  PROOF_BY_CONTR_TAC;
+  UNDH 3642 THEN REWRITE_TAC[SUBSET;UNION];
+  USEH 8335 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPECH `ei` 554;
+  UNDH 8511 THEN ASM_REWRITE_TAC[];
+  (* --// *)
+  TYPE_THEN `B` EXISTS_TAC;
+  TYPE_THEN `A` EXISTS_TAC;
+  FULL_REWRITE_TAC[INTER_COMM;UNION_COMM];
+  CONJ_TAC;
+  UNDH 4532 THEN (TYPE_THEN `C` UNABBREV_TAC) THEN ASM_REWRITE_TAC[UNION];
+  LEFTH 4284 "E''";
+  TSPECH `A` 567;
+  PROOF_BY_CONTR_TAC;
+  UNDH 937 THEN ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET;UNION];
+  (* -L< *)
+
+  TYPE_THEN `~(G (SUC i) ei)` SUBAGOAL_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
+  UNDH 3810 THEN ARITH_TAC;
+  TYPE_THEN `~(G (SUC i) ej)` SUBAGOAL_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
+  ARITH_TAC;
+  (* -// *)
+  TYPE_THEN `psegment_triple A B E'` SUBAGOAL_TAC;
+  UNDH 830 THEN UNDH 8335 THEN UNDH 2130 THEN UNDH 4401 THEN UNDH 3688 THEN UNDH 8389 THEN UNDH 2907 THEN UNDH 6174 THEN UNDH 7802 THEN UNDH 4430 THEN UNDH 5107 THEN (POP_ASSUM_LIST (fun t-> ALL_TAC));
+  FULL_REWRITE_TAC[psegment_triple;segment_end];
+  CONJ_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  TYPE_THEN `(A INTER E' = EMPTY) /\ (B INTER E' = EMPTY)` SUBAGOAL_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  UNDH 7714 THEN REWRITE_TAC[EQ_EMPTY;INTER;UNION] THEN MESON_TAC[];
+  (* --// *)
+  TYPE_THEN `(cls A INTER cls E' = {a',b'}) /\ (cls B INTER cls E' = {a',b'})` SUBAGOAL_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  USEH 9349 (REWRITE_RULE[cls_union]);
+  CONJ_TAC THEN (IMATCH_MP_TAC  SUBSET_ANTISYM);
+  CONJ_TAC;
+  TYPE_THEN `endpoint E'` UNABBREV_TAC;
+  TYPE_THEN `{a',b'}` UNABBREV_TAC;
+  REWRITE_TAC[INTER;SUBSET;UNION];
+  REWRITE_TAC[SUBSET_INTER];
+  CONJ_TAC;
+  KILLH 2907;
+  TYPE_THEN `{a',b'}` UNABBREV_TAC;
+  REWRITE_TAC[INTER;SUBSET];
+  TYPE_THEN `{a',b'}` UNABBREV_TAC;
+  IMATCH_MP_TAC  endpoint_cls;
+  FULL_REWRITE_TAC[psegment;segment];
+  CONJ_TAC;
+  TYPE_THEN `{a',b'}` UNABBREV_TAC;
+  TYPE_THEN `endpoint E'` UNABBREV_TAC;
+  REWRITE_TAC[INTER;SUBSET;UNION];
+  REWRITE_TAC[SUBSET_INTER];
+  CONJ_TAC;
+  USEH 5640 SYM;
+  IMATCH_MP_TAC  endpoint_cls;
+  USEH 4134 (REWRITE_RULE[psegment;segment]);
+  USEH 2907 SYM;
+  IMATCH_MP_TAC  endpoint_cls;
+  USEH 4430 (REWRITE_RULE[psegment;segment]);
+  CONJ_TAC THEN IMATCH_MP_TAC  segment_end_union_rectagon;
+  FULL_REWRITE_TAC[segment_end];
+  MESON_TAC[];
+  FULL_REWRITE_TAC[segment_end];
+  MESON_TAC[];
+  (* -M< // *)
+  USEH 2518 (MATCH_MP psegment_triple3);
+  COPYH 7680;
+  USEH 7680 (MATCH_MP bounded_triple_inner_union);
+  USEH 3265 (REWRITE_RULE [SUBSET]);
+  (* TSPEC p deferred ///// *)
+  (* -// *)
+  TYPE_THEN `~(bounded_set (B UNION E') p)` SUBAGOAL_TAC;
+  UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`B UNION E'`;`i`;`j`]);
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  CONJ_TAC;
+  UNDH 3810 THEN ARITH_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `C UNION E'` EXISTS_TAC ;
+  CONJ_TAC;
+  REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[];
+  TYPE_THEN `A UNION B` UNABBREV_TAC;
+  REWRITE_TAC[union_subset];
+  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `SUC i` EXISTS_TAC;
+  USEH 343 (REWRITE_RULE[SUBSET]);
+  UNDH 3810 THEN ARITH_TAC;
+  REWRH 9345;
+  USEH 1598 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
+  UNDH 5101 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  card_subset_lt;
+  CONJ_TAC;
+  UNDH 343 THEN  REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
+  CONJ_TAC;
+  USEH 7390 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPECH `ei` 9338;
+  USEH 4016 (REWRITE_RULE[UNION;DIFF]);
+  UNDH 1090 THEN ASM_REWRITE_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  UNDH 8335 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `ei` EXISTS_TAC;
+  UNDH 4837 THEN ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[subset_imp];
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `A UNION B` EXISTS_TAC;
+  CONJ_TAC;
+  USEH 2130 SYM;
+  USEH 5107 (REWRITE_RULE[rectagon]);
+  REWRITE_TAC[SUBSET;DIFF];
+  (* -// *)
+  TYPE_THEN `~(bounded_set (E' UNION A) p)` SUBAGOAL_TAC;
+  UNDH 3313 THEN DISCH_THEN (THM_INTRO_TAC[`E' UNION A`;`i`;`j`]);
+  CONJ_TAC;
+  FULL_REWRITE_TAC[psegment_triple];
+  CONJ_TAC;
+  UNDH 3810 THEN ARITH_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `E' UNION C` EXISTS_TAC ;
+  CONJ_TAC;
+  REWRITE_TAC[UNION;SUBSET] THEN MESON_TAC[];
+  TYPE_THEN `A UNION B` UNABBREV_TAC;
+  REWRITE_TAC[union_subset];
+  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `SUC i` EXISTS_TAC;
+  USEH 343 (REWRITE_RULE[SUBSET]);
+  UNDH 3810 THEN ARITH_TAC;
+  REWRH 9505;
+  USEH 4752 (MATCH_MP (ARITH_RULE `x <=| y ==> ~(y < x)`));
+  UNDH 2448 THEN REWRITE_TAC[];
+  IMATCH_MP_TAC  card_subset_lt;
+  CONJ_TAC;
+  UNDH 343 THEN  REWRITE_TAC[SUBSET;DIFF;UNION] THEN MESON_TAC[];
+  CONJ_TAC;
+  USEH 758 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPECH `ej` 1425;
+  USEH 5076 (REWRITE_RULE[UNION;DIFF]);
+  UNDH 5580 THEN ASM_REWRITE_TAC[];
+  USEH 3977 (MATCH_MP (TAUT `a \/ b ==> b\/ a`));
+  FIRST_ASSUM DISJ_CASES_TAC;
+  UNDH 8335 THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `ej` EXISTS_TAC;
+  UNDH 683 THEN ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[subset_imp];
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `A UNION B` EXISTS_TAC;
+  CONJ_TAC;
+  USEH 2130 SYM;
+  USEH 5107 (REWRITE_RULE[rectagon]);
+  REWRITE_TAC[SUBSET;DIFF];
+  (* -N< // *)
+  KILLH 3313 THEN KILLH 4532 THEN KILLH 846 THEN KILLH 320 THEN KILLH 8416 THEN KILLH 1909 THEN KILLH 9803 THEN KILLH 5989 THEN KILLH 4430 THEN KILLH 7802 THEN KILLH 6174 THEN KILLH 2907;
+  KILLH 683 THEN KILLH 4837 THEN KILLH 3627 THEN KILLH 2590 THEN KILLH 830 THEN KILLH 8335 THEN KILLH 4401 THEN KILLH 3688;
+  POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t));
+  (* - *)
+  TYPE_THEN `bounded_set (B UNION E' UNION A) p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  bounded_avoidance_subset;
+  TYPE_THEN `C` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  USEH 7680 (REWRITE_RULE[psegment_triple;segment_end;segment;psegment]);
+  CONJ_TAC;
+  REWRITE_TAC[FINITE_UNION];
+  USEH 7680 (REWRITE_RULE[psegment_triple;segment_end;segment;psegment]);
+  CONJ_TAC;
+  TYPE_THEN `A UNION B` UNABBREV_TAC;
+  IMATCH_MP_TAC  conn2_rectagon;
+  (* --// *)
+  UNDH 8721 THEN REWRITE_TAC[] THEN (IMATCH_MP_TAC  bounded_set_curve_cell_empty);
+  TYPE_THEN `UNIONS (IMAGE G {i | i <=| N})` EXISTS_TAC;
+  TYPE_THEN `B UNION E' UNION A = E' UNION C` SUBAGOAL_TAC;
+  REWRITE_TAC[UNION_ACI ];
+  REWRITE_TAC[union_subset];
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `(SUC i)` EXISTS_TAC;
+  USEH 343 (REWRITE_RULE[SUBSET]);
+  UNDH 3810 THEN UNDH 5153 THEN ARITH_TAC;
+  TYPE_THEN `A UNION B` UNABBREV_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  UNIFY_EXISTS_TAC;
+  IMATCH_MP_TAC  UNIONS_UNIONS;
+  REWRITE_TAC[IMAGE;SUBSET];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  UNDH 6996 THEN UNDH 5153 THEN ARITH_TAC;
+  TSPECH `p` 2110;
+  USEH 1588 (ONCE_REWRITE_RULE[UNION]);
+  USEH 6893 (REWRITE_RULE[]);
+  ASM_MESON_TAC[];
+  (* Tue Dec 28 15:56:13 EST 2004 *)
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION AA *)
+(* ------------------------------------------------------------------ *)
+
+
+(* finish proof of the connectedness of the complement of an arc *)
+
+let real_div_denom = prove_by_refinement(
+  `!z x y . (&0 < z) ==> ((x/ z <= y/ z) <=> (x <= y))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
+  ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`];
+  REWRITE_TAC[GSYM real_div_assoc];
+  ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
+  FULL_REWRITE_TAC[REAL_MUL_AC];
+  IMATCH_MP_TAC  REAL_LE_RMUL_EQ;
+  ]);;
+  (* }}} *)
+
+let real_div_denom_lt = prove_by_refinement(
+  `!z x y . (&0 < z) ==> ((x/ z < y/ z) <=> (x < y))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
+  ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`];
+  REWRITE_TAC[GSYM real_div_assoc];
+  ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
+  FULL_REWRITE_TAC[REAL_MUL_AC];
+  IMATCH_MP_TAC  REAL_LT_RMUL_EQ;
+  ]);;
+  (* }}} *)
+
+let simple_arc_constants = prove_by_refinement(
+  `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\
+                           euclid 2 p /\ euclid 2 q ==>
+  (?d N B a d'. (&0 <. d) /\ (&0 <. d') /\ (0 < N) /\
+    (!i. (i <| N) ==> simple_arc_end (B i) (a i) (a (SUC i))) /\
+    (C = UNIONS (IMAGE B {i | i <| N})) /\
+    (!x. C x ==>
+        (&8 * d <= d_euclid x p) /\ (&8 * d <= d_euclid x q)) /\
+    (!i j x y. (SUC i < j) /\ (j <| N) /\ B i x /\ B j y ==>
+        (&16 * d' < d_euclid x y)) /\
+    (!i. (i <| N) ==>
+        (?x. B i x /\ B i SUBSET (open_ball (euclid 2,d_euclid) x d))))
+    `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`]simple_arc_compact;
+  THM_INTRO_TAC[`2`] metric_euclid;
+  THM_INTRO_TAC[`C`] simple_arc_nonempty;
+  THM_INTRO_TAC[`top2`] compact_point;
+  FULL_REWRITE_TAC[top2_unions];
+  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`C`;`{p}`] compact_distance;
+  FULL_REWRITE_TAC[top2];
+  REWRITE_TAC[EMPTY_EXISTS];
+  MESON_TAC[];
+  FULL_REWRITE_TAC[INR IN_SING];
+  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`C`;`{q}`] compact_distance;
+  FULL_REWRITE_TAC[top2];
+  REWRITE_TAC[EMPTY_EXISTS];
+  MESON_TAC[];
+  FULL_REWRITE_TAC[INR IN_SING];
+  (* - *)
+  TYPE_THEN `p''''` UNABBREV_TAC;
+  TYPE_THEN `p''` UNABBREV_TAC;
+  TYPE_THEN `d = (min_real (d_euclid p''' q) (d_euclid p' p))/(&8)` ABBREV_TAC ;
+  TYPE_THEN `d` EXISTS_TAC;
+  TYPE_THEN `&0 < d` SUBAGOAL_TAC;
+  TYPE_THEN `d` UNABBREV_TAC;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  ASSUME_TAC (REAL_ARITH `&0 < &8`);
+  REWRITE_TAC[min_real] ;
+  THM_INTRO_TAC[`C`] simple_arc_euclid;
+  COND_CASES_TAC;
+  IMATCH_MP_TAC  d_euclid_pos2;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_MESON_TAC[subset_imp];
+  IMATCH_MP_TAC  d_euclid_pos2;
+  TYPE_THEN `2` EXISTS_TAC;
+  ASM_MESON_TAC[subset_imp];
+  (* -A// *)
+  TYPE_THEN `(!x. C x ==> &8 * d <= d_euclid x p /\ &8 * d <= d_euclid x q)` SUBAGOAL_TAC;
+  TYPE_THEN `&8 * d = min_real (d_euclid p''' q) (d_euclid p' p)` SUBAGOAL_TAC;
+  TYPE_THEN `d` UNABBREV_TAC;
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  UND 10 THEN REAL_ARITH_TAC ;
+  UNDH 6289 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`q`]);
+  ASM_REWRITE_TAC[];
+  UNDH 4386 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`p`]);
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`(d_euclid p''' q)`;`d_euclid p' p  `] min_real_le;
+  UNDH 4228 THEN UNDH 5042 THEN UNDH 8570 THEN UNDH 8336 THEN REAL_ARITH_TAC;
+  KILLH 8745 THEN KILLH 6021 THEN KILLH 6289 THEN KILLH 371;
+  KILLH 4386 THEN KILLH 6186;
+  (* -B// *)
+  COPYH 3550;
+  USEH 3550 (REWRITE_RULE[simple_arc]);
+  FULL_REWRITE_TAC[top2_unions];
+  THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
+  FULL_REWRITE_TAC[uniformly_continuous];
+  TSPECH `d` 814;
+  FULL_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `?N. &1/delta <= &N` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ARCH_SIMPLE];
+  TYPE_THEN `&0 < &N` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `&1/ &N <= delta` SUBAGOAL_TAC;
+  UNDH 338 THEN   ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
+  FULL_REWRITE_TAC[REAL_MUL_AC];
+  TYPE_THEN `N' = 2*N` ABBREV_TAC ;
+  TYPE_THEN `&0 < &N'` SUBAGOAL_TAC;
+  TYPE_THEN `N'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[REAL_OF_NUM_LT];
+  UNDH 7562 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `!r. (r <= &1/ (&N')) ==> (r < delta)` SUBAGOAL_TAC;
+  TYPE_THEN `&1/ &N' < &1/ &N` SUBAGOAL_TAC;
+  ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
+  ONCE_REWRITE_TAC[REAL_ARITH `x*y = y*x`];
+  REWRITE_TAC[GSYM real_div_assoc];
+  ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
+  TYPE_THEN `N'` UNABBREV_TAC;
+  REDUCE_TAC;
+  UNDH 5547 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC;
+  UNDH 5945 THEN UNDH 3160 THEN UNDH 532 THEN REAL_ARITH_TAC;
+  (* -C// *)
+  KILLH 1557 THEN KILLH 5945 THEN KILLH 5547 THEN KILLH 338;
+  TYPE_THEN `N'` EXISTS_TAC;
+  TYPE_THEN `B = (\ i. IMAGE f {x | (&i / &N') <= x /\ (x <= &(SUC i)/(&N'))} )` ABBREV_TAC ;
+  TYPE_THEN `B` EXISTS_TAC;
+  TYPE_THEN `a = (\ i. f(&i / &N'))` ABBREV_TAC  ;
+  TYPE_THEN `a` EXISTS_TAC;
+  (* - *)
+  THM_INTRO_TAC[`&N'`] real_div_denom;
+  REWRH 9377;
+  (* - *)
+  TYPE_THEN `!x. (&0 <= x/ &N') <=> (&0 <= x)` SUBAGOAL_TAC;
+  UNDH 5498 THEN DISCH_THEN (THM_INTRO_TAC[`&0`;`x`]);
+  FULL_REWRITE_TAC[REAL_DIV_LZERO];
+  (* - *)
+  TYPE_THEN `!x. (x/ &N' <= &1) <=> (x <= &N')` SUBAGOAL_TAC;
+  UNDH 5498 THEN DISCH_THEN (THM_INTRO_TAC[`x`;`&N'`]);
+  THM_INTRO_TAC[`&N'`] REAL_DIV_REFL;
+  TYPE_THEN `&N'` UNABBREV_TAC;
+  UNDH 869 THEN REAL_ARITH_TAC;
+  REWRH 4881;
+  (* - *)
+  TYPE_THEN `!i x. (i <| N') /\ (&i / &N' <= x) /\ (x <= &(SUC i) / &N') ==> (&0 <= x /\ x <= &1)` SUBAGOAL_TAC;
+  TYPE_THEN `&0 <= &i / &N' /\ &(SUC i) / (&N') <= &1` BACK_TAC;
+  UNDH 601 THEN UNDH 1707 THEN UNDH 167 THEN UNDH 1199 THEN REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_OF_NUM_LE];
+  UNDH 9580 THEN ARITH_TAC;
+  (* -D// *)
+  TYPE_THEN `(!i. i <| N' ==> (?x. B i x /\ B i SUBSET open_ball (euclid 2,d_euclid) x d))` SUBAGOAL_TAC;
+  TYPE_THEN `a i` EXISTS_TAC;
+  TYPE_THEN `a` UNABBREV_TAC;
+  SUBCONJ_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[REAL_OF_NUM_LE ];
+  ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[open_ball;IMAGE;SUBSET;];
+  TYPE_THEN `x` UNABBREV_TAC;
+  USEH 3550 (MATCH_MP simple_arc_euclid);
+  TYPE_THEN `C` UNABBREV_TAC;
+  USEH 3429 (REWRITE_RULE[SUBSET]);
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[REAL_OF_NUM_LE ];
+  UNDH 9580 THEN ARITH_TAC;
+  (* -- *)
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  image_imp;
+  FIRST_ASSUM  IMATCH_MP_TAC ;
+  TYPE_THEN  `i` EXISTS_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[REAL_OF_NUM_LE];
+  CONJ_TAC;
+  UNDH 9580 THEN ARITH_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `i` EXISTS_TAC;
+  REWRITE_TAC[d_real];
+  TYPE_THEN `x' <= &i/ &N' + &1/ &N'` SUBAGOAL_TAC;
+  UNDH 3570 THEN REWRITE_TAC[REAL];
+  REWRITE_TAC[real_div;GSYM REAL_ADD_RDISTRIB];
+  REWRITE_TAC[GSYM real_div];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 4551 THEN UNDH 1464 THEN  REAL_ARITH_TAC;
+  KILLH 8623 THEN KILLH 2193;
+  KILLH 626 THEN KILLH 4538;
+  (* -E// *)
+  TYPE_THEN `!i. &i / &N' < &(SUC i)/ &N'` SUBAGOAL_TAC;
+  ASM_SIMP_TAC[real_div_denom_lt];
+  REWRITE_TAC[REAL_OF_NUM_LT];
+  ARITH_TAC;
+  (* - *)
+  TYPE_THEN `(!i. i <| N' ==> simple_arc_end (B i) (a i) (a (SUC i)))` SUBAGOAL_TAC;
+  TYPE_THEN `a` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[simple_arc_end];
+  THM_INTRO_TAC[`f`;`&0`;`&1`;`&i/ &N'`;`&(SUC i)/ &N'`] arc_reparameter_gen;
+  IMATCH_MP_TAC  inj_subset_domain;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC[SUBSET];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `i` EXISTS_TAC;
+  TYPE_THEN `g` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -F// *)
+  TYPE_THEN `(IMAGE f {x | &0 <= x /\ x <= &1} = UNIONS (IMAGE B {i | i <| N'}))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNIONS;IMAGE];
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "u");
+  NAME_CONFLICT_TAC;
+  LEFT_TAC "x''";
+  LEFT_TAC "x''";
+  TYPE_THEN `x'` EXISTS_TAC;
+  (* --- *)
+  TYPE_THEN `x' = &1` ASM_CASES_TAC;
+  TYPE_THEN `N' -| 1` EXISTS_TAC;
+  FULL_REWRITE_TAC[REAL_LT;REAL_LE];
+  TYPE_THEN `N' -| 1 <| N'` SUBAGOAL_TAC;
+  UNDH 8859 THEN ARITH_TAC;
+  CONJ_TAC;
+  UNDH 9064 THEN ARITH_TAC;
+  FULL_REWRITE_TAC[GSYM REAL_LT];
+  ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
+  REDUCE_TAC;
+  FULL_REWRITE_TAC[REAL_LT];
+  UND 25 THEN ARITH_TAC;
+  (* --- *)
+  TYPE_THEN `num_abs_of_int (floor (&N' * x'))` EXISTS_TAC;
+  TYPE_THEN `t = &N' * x'` ABBREV_TAC ;
+  TYPE_THEN `x' = t/(&N')` SUBAGOAL_TAC;
+  TYPE_THEN `t` UNABBREV_TAC;
+  REWRITE_TAC[real_div_assoc];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ ];
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  UNDH 3200 THEN UNDH 7688 THEN REAL_ARITH_TAC;
+  TYPE_THEN `&0 <= t` SUBAGOAL_TAC;
+  TYPE_THEN `t` UNABBREV_TAC;
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  TYPE_THEN `&:0 <=: (floor t)` SUBAGOAL_TAC;
+  REWRITE_TAC[int_of_num_th;GSYM floor_le];
+  REWRITE_TAC[GSYM REAL_OF_NUM_LT];
+  ASM_REWRITE_TAC[REAL;num_abs_of_int_th;GSYM int_abs_th;];
+  TYPE_THEN `(||: (floor t) = (floor t))` SUBAGOAL_TAC;
+  REWRITE_TAC[INT_ABS_REFL;];
+  THM_INTRO_TAC[`t`] floor_ineq;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  TYPE_THEN `t < &N' * &1` SUBAGOAL_TAC;
+  TYPE_THEN `t` UNABBREV_TAC;
+  ASM_SIMP_TAC[REAL_LT_LMUL_EQ];
+  UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC;
+  CONJ_TAC;
+  UNDH 5082 THEN REAL_ARITH_TAC;
+  TYPE_THEN `real_of_int (floor (&N' )) = &N'` SUBAGOAL_TAC;
+  REWRITE_TAC[floor_num;int_of_num_th;];
+  UNDH 6307 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[GSYM   int_lt ];
+  IMATCH_MP_TAC  (INT_ARITH  `~(x = y) /\ (x <= y) ==> (x <: y)`);
+  CONJ_TAC;
+  FULL_REWRITE_TAC[floor_range];
+  FULL_REWRITE_TAC[int_of_num_th;floor_num];
+  UNDH 1048 THEN UNDH 6689 THEN REAL_ARITH_TAC;
+  IMATCH_MP_TAC  floor_mono;
+  UNDH 1048 THEN REAL_ARITH_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `x''` EXISTS_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `x'` EXISTS_TAC;
+  (* -G// *)
+  TYPE_THEN `!i. (i <| N') ==> compact top2 (B i)` SUBAGOAL_TAC;
+  UNDH 8913 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
+  USEH 9744 (MATCH_MP simple_arc_end_simple);
+  USEH 3463 (MATCH_MP simple_arc_compact);
+  (* - *)
+  TYPE_THEN `!i. (i <| N') ==> ~(B i = EMPTY)` SUBAGOAL_TAC;
+  UNDH 8913 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
+  USEH 9744 (MATCH_MP simple_arc_end_simple);
+  USEH 3463 (MATCH_MP simple_arc_nonempty);
+  UNDH 8481 THEN ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!k. ?dij. !i j. (k = (i,j)) /\ SUC i < j /\ j < N' ==> (&0 < dij /\ (!x y. B i x /\ B j y ==> dij <= d_euclid x y))` SUBAGOAL_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  CONV_TAC (dropq_conv "i");
+  CONV_TAC (dropq_conv "j");
+  TYPE_THEN `i = FST k` ABBREV_TAC ;
+  TYPE_THEN `j = SND k` ABBREV_TAC ;
+  RIGHT_TAC "y";
+  RIGHT_TAC "x";
+  RIGHT_TAC "dij";
+  THM_INTRO_TAC[`(euclid 2)`;`d_euclid`;`(B i)`;`(B j)`] compact_distance;
+  CONJ_TAC THENL [FIRST_ASSUM IMATCH_MP_TAC ;ALL_TAC];
+  UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
+  FULL_REWRITE_TAC[top2];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
+  TYPE_THEN `d_euclid p' p''` EXISTS_TAC;
+  (* -- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  d_euclid_pos2;
+  TYPE_THEN `2` EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `p''` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  USEH 7066 (REWRITE_RULE[IMAGE]);
+  USEH 6258 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `p'` UNABBREV_TAC;
+  TYPE_THEN `x = x'` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
+  UNIFY_EXISTS_TAC;
+  UNIFY_EXISTS_TAC;
+  UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `&j/ &N' <= &(SUC i) / (&N')` SUBAGOAL_TAC THENL[IMATCH_MP_TAC  REAL_LE_TRANS;ALL_TAC];
+  UNIFY_EXISTS_TAC;
+  UNDH 5902 THEN ASM_REWRITE_TAC[];
+  UNDH 4223 THEN UNDH 3810 THEN REWRITE_TAC[REAL_LE] THEN ARITH_TAC;
+  (* --- *)
+  TYPE_THEN `(i <| N')` SUBAGOAL_TAC;
+  UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
+  TYPE_THEN `!i x. (i <| N') /\ (B i x) ==> (euclid 2 x)` SUBAGOAL_TAC;
+  TSPECH `i'` 8913;
+  USEH 9316 (MATCH_MP simple_arc_end_simple);
+  USEH 5604 (MATCH_MP simple_arc_euclid);
+  ASM_MESON_TAC[subset_imp];
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
+  UNIFY_EXISTS_TAC;
+  UNIFY_EXISTS_TAC;
+  (* -- *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* -H// *)
+  LEFTH 8852 "dij";
+  TYPE_THEN `?d''. (&0 < d'') /\  (!i j. (SUC i < j /\ j <| N') ==> (d'' <= dij (i,j)))` SUBAGOAL_TAC;
+  TYPE_THEN `X = { r  | (?i j. SUC i < j /\ j <| N' /\ (r = dij (i,j))) }` ABBREV_TAC ;
+  TYPE_THEN `d'' = inf X` ABBREV_TAC ;
+  TYPE_THEN `X = IMAGE dij {(i,j) | (SUC i < j /\ j < N')}` SUBAGOAL_TAC;
+  TYPE_THEN `X` UNABBREV_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IMAGE;];
+  NAME_CONFLICT_TAC;
+  POP_ASSUM_LIST (fun t->ALL_TAC);
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "x'");
+  ASM_MESON_TAC[];
+  TYPE_THEN `x'` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `FINITE X` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `A = {i | (i <| N')}` ABBREV_TAC ;
+  TYPE_THEN `{(i,j) | A i /\ A j}` EXISTS_TAC;
+  CONJ_TAC;
+  THM_INTRO_TAC[`A`;`A`] FINITE_PRODUCT;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[FINITE_NUMSEG_LT];
+  REWRITE_TAC[SUBSET;];
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN`i` EXISTS_TAC;
+  TYPE_THEN `j` EXISTS_TAC;
+  UNDH 3810 THEN UNDH 2985 THEN ARITH_TAC;
+  (* --// *)
+  TYPE_THEN `X = EMPTY` ASM_CASES_TAC;
+  TYPE_THEN `&1` EXISTS_TAC;
+  REWRH 9106;
+  USEH 3802 SYM;
+  USEH 7502 (REWRITE_RULE[image_empty]);
+  USEH 1549 (REWRITE_RULE[EQ_EMPTY]);
+  TSPECH  `(i,j)` 7313 ;
+  LEFTH 4977 "i'";
+  TSPECH `i` 9356;
+  LEFTH 6976 "j'";
+  TSPECH `j` 1468;
+  UNDH 5891 THEN ASM_REWRITE_TAC[];
+  (* --H2// *)
+  THM_INTRO_TAC[`X`] finite_inf_min;
+  THM_INTRO_TAC[`X`] finite_inf;
+  TYPE_THEN `d''` EXISTS_TAC;
+  USEH 9106 SYM;
+  (* TYPE_THEN `d''` UNABBREV_TAC; *)
+  (* -- *)
+  CONJ_TAC;
+  TYPE_THEN `?i j. SUC i <| j /\ j <| N' /\ (d'' = dij (i,j))` SUBAGOAL_TAC;
+  UNDH 7611 THEN ASM_REWRITE_TAC[] THEN UNDH 3235 THEN DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  UNDH 3572 THEN DISCH_THEN (THM_INTRO_TAC[`(i,j)`;`i`;`j`]);
+  ASM_REWRITE_TAC[];
+  REP_BASIC_TAC;
+  UNDH 6732 THEN DISCH_THEN (THM_INTRO_TAC[`dij (i,j)`]);
+  UNDH 3235 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
+  ASM_MESON_TAC[];
+  USEH 7679 SYM;
+  ASM_REWRITE_TAC[];
+  (* -I *)
+  TYPE_THEN `d' = d''/ &32` ABBREV_TAC  ;
+  TYPE_THEN `&0 < &32` SUBAGOAL_TAC;
+  REAL_ARITH_TAC;
+  TYPE_THEN `d'` EXISTS_TAC;
+  SUBCONJ_TAC;
+  TYPE_THEN `d'` UNABBREV_TAC;
+  ASM_SIMP_TAC[REAL_LT_RDIV_0];
+  SUBCONJ_TAC;
+  FULL_REWRITE_TAC[REAL_LT];
+  (* - *)
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN `d''` EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `d'` UNABBREV_TAC;
+  REWRITE_TAC[GSYM real_div_assoc];
+  ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
+  REWRITE_TAC[REAL_MUL_AC];
+  IMATCH_MP_TAC  REAL_LT_LMUL;
+  REAL_ARITH_TAC;
+  (* -/// *)
+  UNDH 3572 THEN DISCH_THEN (THM_INTRO_TAC[`(i,j)`;`i`;`j`]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `dij (i,j)` EXISTS_TAC;
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
+  (* Wed Dec 29 17:40:18 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let euclid_scale_rinv = prove_by_refinement(
+  `!x r. (&0 < r) ==> ((r * &1/ r) *# x = x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  USEH 6412 (MATCH_MP   (REAL_ARITH `&0 < r ==> ~(r = &0)`));
+  ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one];
+  ]);;
+  (* }}} *)
+
+let euclid_scale_bij = prove_by_refinement(
+  `!r . (&0 < r) ==> BIJ (euclid_scale r) (euclid 2) (euclid 2)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[BIJ;INJ;];
+  TYPE_THEN `!x. (r * &1 / r) *# x = x` SUBAGOAL_TAC;
+  USEH 6412 (MATCH_MP   (REAL_ARITH `&0 < r ==> ~(r = &0)`));
+  ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one];
+  SUBCONJ_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  euclid_scale_closure;
+  TYPE_THEN `euclid_scale (&1/ r)` (fun t -> USEH 9290 (AP_TERM t));
+  FULL_REWRITE_TAC[euclid_scale_act];
+  USEH 7114 (ONCE_REWRITE_RULE[REAL_ARITH `x * y = y *x`]);
+  REWRH 5498;
+  REWRITE_TAC[SURJ];
+  REP_BASIC_TAC;
+  TYPE_THEN`(&1/ r) *# x` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  euclid_scale_closure;
+  REWRITE_TAC[euclid_scale_act];
+  ]);;
+  (* }}} *)
+
+let euclid_scale_cont = prove_by_refinement(
+  `!r. (&0 < r) ==> (continuous (euclid_scale r) top2 top2)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`( *# ) r`] metric_continuous_continuous_top2;
+  REWRITE_TAC[IMAGE;SUBSET];
+  IMATCH_MP_TAC euclid_scale_closure;
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  TYPE_THEN `epsilon/r` EXISTS_TAC;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  THM_INTRO_TAC[`2`;`r`;`x`;`y`] norm_scale_vec;
+  TYPE_THEN `abs  r = r` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_REFL];
+  UNDH 6412 THEN REAL_ARITH_TAC;
+  UNDH 3108 THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
+  FULL_REWRITE_TAC[REAL_MUL_AC];
+  ]);;
+  (* }}} *)
+
+let euclid_scale_inv = prove_by_refinement(
+  `!r x. (&0 < r) /\ (euclid 2 x) ==>
+     (INV (( *# ) r) (euclid 2) (euclid 2) x = (( *# ) (&1 / r)) x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`( *# ) r`;`(euclid 2)`;`(euclid 2)`;`&1 / r *# x`;`x`] INVERSE_XY;
+  ASM_SIMP_TAC[euclid_scale_bij];
+  IMATCH_MP_TAC  euclid_scale_closure;
+  USEH 6412 (MATCH_MP   (REAL_ARITH `&0 < r ==> ~(r = &0)`));
+  REWRITE_TAC[euclid_scale_act];
+  ASM_SIMP_TAC[REAL_DIV_LMUL;euclid_scale_one];
+  ]);;
+  (* }}} *)
+
+let euclid_scale_homeo = prove_by_refinement(
+  `!r. (&0 < r) ==> homeomorphism (euclid_scale r) top2 top2`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  bicont_homeomorphism;
+  REWRITE_TAC[top2_unions];
+  ASM_SIMP_TAC [euclid_scale_bij];
+  ASM_SIMP_TAC[euclid_scale_cont];
+  IMATCH_MP_TAC  cont_domain;
+  TYPE_THEN `( *# ) (&1 / r)` EXISTS_TAC;
+  TYPE_THEN `&0 < &1 /r` SUBAGOAL_TAC;
+  ASM_SIMP_TAC[euclid_scale_cont];
+  FULL_REWRITE_TAC[top2_unions];
+  ASM_SIMP_TAC[euclid_scale_inv];
+  (* Wed Dec 29 18:45:44 EST 2004 *)
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_homeo = prove_by_refinement(
+  `!f C a b. simple_arc_end C a b /\ homeomorphism f top2 top2 ==>
+  simple_arc_end (IMAGE f C) (f a) (f b)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc_end_cont];
+  TYPE_THEN `f o f'` EXISTS_TAC;
+  REWRITE_TAC[IMAGE_o];
+  TYPE_THEN `metric_space ({x | &0 <= x /\ x <= &1},d_real)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  metric_subspace;
+  TYPE_THEN `UNIV:real->bool` EXISTS_TAC;
+  REWRITE_TAC[metric_real];
+  (* - *)
+  TYPE_THEN `UNIONS (top_of_metric (({x | &0 <= x /\ x <= &1},d_real))) = {x | &0 <= x /\ x <= &1}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM top_of_metric_unions);
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  continuous_comp;
+  TYPE_THEN `top2` EXISTS_TAC;
+  REWRITE_TAC[top2_unions];
+  FULL_REWRITE_TAC[homeomorphism];
+  (* -- *)
+  IMATCH_MP_TAC  inj_image_subset;
+  (* - *)
+  CONJ_TAC;
+  REWRITE_TAC[comp_comp];
+  IMATCH_MP_TAC  COMP_INJ;
+  TYPE_THEN `(euclid 2)` EXISTS_TAC;
+  FULL_REWRITE_TAC[homeomorphism];
+  FULL_REWRITE_TAC[top2_unions;BIJ];
+  REWRITE_TAC[o_DEF];
+  ]);;
+  (* }}} *)
+
+let simple_arc_homeo = prove_by_refinement(
+  `!f C. simple_arc top2 C /\ homeomorphism f top2 top2 ==>
+   simple_arc top2 (IMAGE f C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  RULE_ASSUM_TAC (REWRITE_RULE[simple_arc]);
+  TYPE_THEN `simple_arc_end C (f' (&0)) (f' (&1))` SUBAGOAL_TAC;
+  REWRITE_TAC[simple_arc_end];
+  TYPE_THEN `f'` EXISTS_TAC;
+  FULL_REWRITE_TAC[top2_unions];
+  THM_INTRO_TAC[`f`;`C`;`f' (&0)`;`f' (&1)`] simple_arc_end_homeo;
+  USEH 6603 (MATCH_MP simple_arc_end_simple);
+  TYPE_THEN `C` UNABBREV_TAC;
+  ]);;
+  (* }}} *)
+
+let euclid_scale_simple_arc_ver2 = prove_by_refinement(
+  `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\ (euclid 2 p) /\
+    (euclid 2 q) /\ ~(p = q) /\
+    (!A. simple_arc_end A p q ==> ~(C INTER A = EMPTY)) ==>
+    (?C' p' q' d N B a d'.
+           simple_arc top2 C' /\ ~C' p' /\ ~C' q' /\ (euclid 2 p') /\
+        (euclid 2 q') /\ ~(p' = q') /\
+      (!A. simple_arc_end A p' q' ==> ~(C' INTER A = EMPTY)) /\
+      (&1 <=. d) /\ (&1 <=. d') /\ (0 < N) /\
+    (!i. (i <| N) ==> simple_arc_end (B i) (a i) (a (SUC i))) /\
+    (C' = UNIONS (IMAGE B {i | i <| N})) /\
+    (!x. C' x ==>
+        (&8 * d <= d_euclid x p') /\ (&8 * d <= d_euclid x q')) /\
+    (!i j x y. (SUC i < j) /\ (j <| N) /\ B i x /\ B j y ==>
+        (&16 * d' < d_euclid x y)) /\
+    (!i. (i <| N) ==>
+        (?x. B i x /\ B i SUBSET (open_ball (euclid 2,d_euclid) x d))))
+    `,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`;`p`;`q`] simple_arc_constants;
+  TYPE_THEN `r = min_real d d'` ABBREV_TAC ;
+  TYPE_THEN `f = ( *# ) (&1 /r)` ABBREV_TAC ;
+  TYPE_THEN `C' = IMAGE f C` ABBREV_TAC ;
+  TYPE_THEN `B' = (IMAGE f) o B` ABBREV_TAC ;
+  TYPE_THEN `p' = f p` ABBREV_TAC ;
+  TYPE_THEN `q' = f q` ABBREV_TAC ;
+  TYPE_THEN `dr = d/r` ABBREV_TAC ;
+  TYPE_THEN `dr' = d'/r` ABBREV_TAC ;
+  TYPE_THEN `a' = f o a` ABBREV_TAC ;
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `p'` EXISTS_TAC;
+  TYPE_THEN `q'` EXISTS_TAC;
+  TYPE_THEN `dr` EXISTS_TAC;
+  TYPE_THEN `N` EXISTS_TAC;
+  TYPE_THEN `B'` EXISTS_TAC;
+  TYPE_THEN `a'` EXISTS_TAC;
+  TYPE_THEN `dr'` EXISTS_TAC;
+  (* -A *)
+  TYPE_THEN `&0 < r` SUBAGOAL_TAC;
+  TYPE_THEN `r` UNABBREV_TAC;
+  REWRITE_TAC[min_real];
+  COND_CASES_TAC;
+  TYPE_THEN `&0 < &1/ r` SUBAGOAL_TAC;
+  (* - *)
+  TYPE_THEN `homeomorphism f top2 top2` SUBAGOAL_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  IMATCH_MP_TAC  euclid_scale_homeo;
+  USEH 5104 SYM;
+  SUBCONJ_TAC;
+  TYPE_THEN `C'` UNABBREV_TAC;
+  IMATCH_MP_TAC  simple_arc_homeo;
+  (* - *)
+  TYPE_THEN `!x. C x ==> euclid 2 x` SUBAGOAL_TAC;
+  USEH 3550 (MATCH_MP simple_arc_euclid);
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `C'` UNABBREV_TAC;
+  TYPE_THEN `p'` UNABBREV_TAC;
+  UNDH 9726 THEN ASM_REWRITE_TAC[];
+  USEH 7428 (REWRITE_RULE[IMAGE]);
+  FULL_REWRITE_TAC[homeomorphism;BIJ;INJ];
+  TYPE_THEN `(x = p)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FULL_REWRITE_TAC[top2_unions];
+  TYPE_THEN `p` UNABBREV_TAC;
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `C'` UNABBREV_TAC;
+  TYPE_THEN `q'` UNABBREV_TAC;
+  UNDH 6497 THEN ASM_REWRITE_TAC[];
+  USEH 4199 (REWRITE_RULE[IMAGE]);
+  FULL_REWRITE_TAC[homeomorphism;BIJ;INJ];
+  TYPE_THEN `(q = x)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FULL_REWRITE_TAC[top2_unions];
+  TYPE_THEN `q` UNABBREV_TAC;
+  (* -B *)
+  TYPE_THEN `euclid 2 p' /\ euclid 2 q'` SUBAGOAL_TAC;
+  TYPE_THEN `p'` UNABBREV_TAC;
+  TYPE_THEN `q'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[homeomorphism;BIJ;SURJ;top2_unions];
+  (* -// *)
+  CONJ_TAC;
+  TYPE_THEN `p'` UNABBREV_TAC;
+  TYPE_THEN `q'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[homeomorphism;BIJ;INJ];
+  UNDH 11 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[top2_unions];
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `g = ( *# ) r` ABBREV_TAC ;
+  TYPE_THEN `A' = IMAGE g A` ABBREV_TAC ;
+  TYPE_THEN`homeomorphism g top2 top2` SUBAGOAL_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  ASM_SIMP_TAC[euclid_scale_homeo];
+  TSPECH `A'` 8219;
+  TYPE_THEN `!x.  (g (f x) = x)` SUBAGOAL_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  REWRITE_TAC[euclid_scale_act];
+  ASM_SIMP_TAC [euclid_scale_rinv];
+  (* -- *)
+  UNDH 5082 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  TYPE_THEN `A'` UNABBREV_TAC;
+  TYPE_THEN `(p = g p') /\ (q = g q')` SUBAGOAL_TAC;
+  TYPE_THEN `p'` UNABBREV_TAC;
+  TYPE_THEN `q'` UNABBREV_TAC;
+  IMATCH_MP_TAC  simple_arc_end_homeo;
+  USEH 7123  (REWRITE_RULE[INTER;EMPTY_EXISTS]);
+  USEH 8329  (REWRITE_RULE[EQ_EMPTY;INTER]);
+  TSPECH `f u` 5681;
+  UNDH 1812 THEN REWRITE_TAC[];
+  TYPE_THEN `C'` UNABBREV_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  image_imp;
+  TYPE_THEN `A'` UNABBREV_TAC;
+  USEH 1648 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `f` UNABBREV_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  REWRITE_TAC[euclid_scale_act];
+  ONCE_REWRITE_TAC[REAL_ARITH `x * y = y*x`];
+  ASM_SIMP_TAC[euclid_scale_rinv];
+  (* -C *)
+  CONJ_TAC;
+  TYPE_THEN `dr` UNABBREV_TAC;
+  TYPE_THEN `r` UNABBREV_TAC;
+  ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
+  REDUCE_TAC;
+  REWRITE_TAC[min_real_le];
+  CONJ_TAC;
+  TYPE_THEN `dr'` UNABBREV_TAC;
+  TYPE_THEN `r` UNABBREV_TAC;
+  ASM_SIMP_TAC[REAL_LE_RDIV_EQ];
+  REDUCE_TAC;
+  REWRITE_TAC[min_real_le];
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `B'` UNABBREV_TAC;
+  TYPE_THEN `a'` UNABBREV_TAC;
+  REWRITE_TAC[o_DEF];
+  IMATCH_MP_TAC  simple_arc_end_homeo;
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `C'` UNABBREV_TAC;
+  TYPE_THEN `B'` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE_o];
+  REWRITE_TAC[GSYM image_unions];
+  (* - *)
+  TYPE_THEN `!x y. (euclid 2 x) /\ (euclid 2 y) ==> (d_euclid (f x) (f y) = (d_euclid x y)/r)` SUBAGOAL_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  THM_INTRO_TAC[`2`;`&1 / r`;`x`;`y`] norm_scale_vec;
+  TYPE_THEN `abs  (&1/r) = &1/r` SUBAGOAL_TAC;
+  REWRITE_TAC[ABS_REFL];
+  UNDH 4597 THEN REAL_ARITH_TAC;
+  ONCE_REWRITE_TAC[REAL_ARITH `x * y = y* x`];
+  REWRITE_TAC[GSYM real_div_assoc];
+  REDUCE_TAC;
+  (* -D *)
+  CONJ_TAC;
+  TYPE_THEN `C'` UNABBREV_TAC;
+  USEH 3184 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `p'` UNABBREV_TAC;
+  TYPE_THEN `q'` UNABBREV_TAC;
+  ASM_SIMP_TAC[];
+  TYPE_THEN `dr` UNABBREV_TAC;
+  REWRITE_TAC[GSYM real_div_assoc];
+  ASM_SIMP_TAC[real_div_denom];
+  (* - *)
+  TYPE_THEN `!i x. (i <| N) /\ (B i x) ==> (euclid 2 x)` SUBAGOAL_TAC;
+  UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
+  USEH 9744 (MATCH_MP simple_arc_end_simple);
+  USEH 3463 (MATCH_MP simple_arc_euclid);
+  USEH 4246 (REWRITE_RULE[SUBSET]);
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `B'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[o_DEF];
+  USEH 407 (REWRITE_RULE[IMAGE]);
+  USEH 3121 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `i <| N` SUBAGOAL_TAC;
+  UNDH 3810 THEN UNDH 1688 THEN ARITH_TAC;
+  UNDH 2436 THEN DISCH_THEN (THM_INTRO_TAC[`x''`;`x'`]);
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN ASM_MESON_TAC[];
+  TYPE_THEN `dr'` UNABBREV_TAC;
+  REWRITE_TAC[GSYM real_div_assoc];
+  ASM_SIMP_TAC[real_div_denom_lt];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  (* -E *)
+  TSPECH `i` 4673;
+  REWRITE_TAC[];
+  TYPE_THEN `f x` EXISTS_TAC;
+  TYPE_THEN `B'` UNABBREV_TAC;
+  REWRITE_TAC[o_DEF];
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  image_imp;
+  FULL_REWRITE_TAC[SUBSET;open_ball];
+  USEH 4418 (REWRITE_RULE[IMAGE]);
+  TSPECH `x''` 7148;
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  IMATCH_MP_TAC  euclid_scale_closure;
+  CONJ_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  IMATCH_MP_TAC  euclid_scale_closure;
+  ASM_SIMP_TAC[];
+  TYPE_THEN `dr` UNABBREV_TAC;
+  ASM_SIMP_TAC[real_div_denom_lt];
+  (* Thu Dec 30 10:14:03 EST 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let delta_pos_arch = prove_by_refinement(
+  `!d. (&0 < d) ==> (?n. (0 <| n) /\ (&1/(&n) < d))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`&1/d`] REAL_ARCH_SIMPLE;
+  TYPE_THEN `2 * n` EXISTS_TAC;
+  SUBCONJ_TAC;
+  REWRITE_TAC[LT_MULT];
+  CONJ_TAC;
+  ARITH_TAC;
+  REWRITE_TAC[GSYM REAL_LT];
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN `&1 / d` EXISTS_TAC;
+  (* - *)
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN `&1/ &n` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `&0 < &(2 *| n)` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_LT];
+  TYPE_THEN `&0 < &n` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[REAL_LT];
+  FULL_REWRITE_TAC[LT_MULT];
+  CONJ_TAC;
+  ASM_SIMP_TAC[REAL_LT_RDIV_EQ];
+  ONCE_REWRITE_TAC[REAL_ARITH `x * y = y*x`];
+  REWRITE_TAC[GSYM real_div_assoc];
+  ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
+  REDUCE_TAC;
+  FULL_REWRITE_TAC[REAL_LT];
+  UNDH 3476 THEN ARITH_TAC;
+  UNDH 27 THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
+  FULL_REWRITE_TAC[REAL_MUL_AC];
+  ]);;
+  (* }}} *)
+
+let suc_div = prove_by_refinement(
+  `!i a. &(SUC i) / a = &i/ a + &1/a`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[REAL];
+  REWRITE_TAC[real_div];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let delta_partition_lemma_ver2 = prove_by_refinement(
+  `!delta. (&0 < delta) ==> (?M. !N. !x. ?i.  (0 < M) /\
+      ((M <= N) /\ (&0 <= x /\ x <= &1) ==>
+      (i <= N) /\ abs  (&i/ &N - x) < delta))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[ `&1/ delta` ] REAL_ARCH_SIMPLE;
+  TYPE_THEN `n` EXISTS_TAC;
+  TYPE_THEN `num_abs_of_int (floor (&N*x))` EXISTS_TAC;
+  TYPE_THEN `&0 < &1/ delta` SUBAGOAL_TAC;
+  TYPE_THEN `&0 < &n` SUBAGOAL_TAC;
+  UND 1 THEN UND 2 THEN REAL_ARITH_TAC;
+  TYPE_THEN `(&1 <= &n* delta)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[REAL_LE_LDIV_EQ];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[REAL_LT];
+  TYPE_THEN `&:0 <= floor (&N * x)` SUBAGOAL_TAC;
+  TYPE_THEN `floor (&0) <=: floor (&N * x)` BACK_TAC;
+  FULL_REWRITE_TAC[floor_num];
+  IMATCH_MP_TAC  floor_mono;
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `num_abs_of_int (floor (&N * x)) <= num_abs_of_int (floor (&N))` BACK_TAC;
+  FULL_REWRITE_TAC[floor_num;num_abs_of_int_num];
+  IMATCH_MP_TAC  num_abs_of_int_mono;
+  IMATCH_MP_TAC  floor_mono;
+  TYPE_THEN `&N * x <= &N * &1` BACK_TAC;
+  UND 9 THEN REAL_ARITH_TAC;
+  IMATCH_MP_TAC  REAL_PROP_LE_LMUL;
+  (* -A *)
+  IMATCH_MP_TAC  REAL_LT_LCANCEL_IMP;
+  TYPE_THEN `&N` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `&0 < &N` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[REAL_LT];
+  UNDH 3476 THEN UNDH 9390 THEN ARITH_TAC;
+  IMATCH_MP_TAC  REAL_LTE_TRANS;
+  TYPE_THEN`&1` EXISTS_TAC;
+  (* - *)
+  REWRITE_TAC[num_abs_of_int_th;];
+  TYPE_THEN `abs  (real_of_int (floor (&N * x))) = (real_of_int (floor (&N *x)))` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_REFL];
+  FULL_REWRITE_TAC [int_le; int_of_num_th;];
+  TYPE_THEN `!u. &N * abs  (u / &N - x) = abs  (u - &N*x)` SUBAGOAL_TAC;
+  TYPE_THEN `!t. &N * abs  t = abs  (&N *t)` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_NUM];
+  AP_TERM_TAC;
+  REWRITE_TAC[REAL_SUB_LDISTRIB];
+  TYPE_THEN `&N * u/ &N = u` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_DIV_LMUL;
+  UND 12 THEN UND 9 THEN REAL_ARITH_TAC;
+  TYPE_THEN `t = &N * x ` ABBREV_TAC ;
+  TYPE_THEN `real_of_int(floor t) <= t` SUBAGOAL_TAC;
+  REWRITE_TAC[floor_ineq];
+  TYPE_THEN `abs  (real_of_int (floor t) - t) = t - real_of_int (floor t)` SUBAGOAL_TAC;
+  UND 13 THEN REAL_ARITH_TAC;
+  THM_INTRO_TAC[`t`] floor_ineq;
+  CONJ_TAC;
+  UND 15 THEN REAL_ARITH_TAC;
+  (* - *)
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `&n * delta` EXISTS_TAC;
+  ASM_SIMP_TAC[REAL_LE_RMUL_EQ];
+  FULL_REWRITE_TAC[REAL_LE];
+  ]);;
+  (* }}} *)
+
+let simple_arc_ball_cover_ver2  = prove_by_refinement(
+  `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
+      INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
+    (?M. !N. !x. ?i. (0 < M) /\ (( M <= N) /\ (&0 <= x /\ x <= &1) ==>
+        (i <= N) /\
+           open_ball (euclid 2,d_euclid) (f (&i / &N)) (&1) (f x)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
+  FULL_REWRITE_TAC[uniformly_continuous];
+  TSPECH `&1` 814;
+  UNDH 4636 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  REWRITE_TAC[open_ball];
+  THM_INTRO_TAC[`delta`] delta_partition_lemma_ver2;
+  TYPE_THEN `M` EXISTS_TAC;
+  TSPECH `N` 6807;
+  TSPECH `x` 8373;
+  TYPE_THEN `i` EXISTS_TAC;
+  REP_BASIC_TAC;
+  UNDH 5594 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  (* - *)
+  TYPE_THEN `0 <| N` SUBAGOAL_TAC;
+  UNDH 6734 THEN UNDH 4600 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `&0 <= &i/ &N /\ &i/ &N <= &1` SUBAGOAL_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_DIV;
+  THM_INTRO_TAC[`&i`;`&1`;`&N`] REAL_LE_LDIV_EQ;
+  REWRITE_TAC[REAL_LT];
+  REWRITE_TAC[REAL_MUL;REAL_LE];
+  UNDH 8395 THEN ARITH_TAC;
+  (* - *)
+  FULL_REWRITE_TAC[INJ];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[d_real];
+  ]);;
+  (* }}} *)
+
+let grid_image_bounded_ver2 = prove_by_refinement(
+  `!f. continuous f (top_of_metric(UNIV,d_real)) top2 /\
+      INJ f {x | &0 <= x /\ x <= &1} (euclid 2) ==>
+   (?M. !N. (0 < M) /\ ((M <= N) ==>
+    ((IMAGE f {x | &0 <= x /\ x <= &1}) INTER
+         (unbounded_set (grid f N)) =  EMPTY))  )`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[EQ_EMPTY;INTER;];
+  THM_INTRO_TAC[`f`] simple_arc_ball_cover_ver2;
+  TYPE_THEN `M` EXISTS_TAC;
+  REWRITE_TAC[IMAGE];
+  NAME_CONFLICT_TAC;
+  TSPECH `N` 8189;
+  RIGHTH 2874 "i";
+  RIGHTH 3911 "x";
+  TYPE_THEN `x''` UNABBREV_TAC;
+  TYPE_THEN `0 <| N` SUBAGOAL_TAC;
+  UNDH 4600 THEN UNDH 6734 THEN ARITH_TAC;
+  FULL_REWRITE_TAC[unbounded_diff;DIFF;ctop_unions ];
+  UNDH 5619 THEN REWRITE_TAC[]; (* ~bounded *)
+  UNDH 1431 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  REWRH 3036;
+  FULL_REWRITE_TAC[open_ball];
+  (* _ *)
+  IMATCH_MP_TAC  bounded_avoidance_subset;
+  TYPE_THEN `E = grid33 (floor (f (&i/ &N) 0),floor (f (&i / &N) 1))` ABBREV_TAC ;
+  TYPE_THEN `E` EXISTS_TAC;
+  (* _ *)
+  TYPE_THEN `conn2 E` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[grid33_conn2];
+  REWRITE_TAC[grid_edge;grid_finite];
+  TYPE_THEN `E SUBSET grid f N` SUBAGOAL_TAC;
+  REWRITE_TAC[grid];
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `{j | j <=| N} = {i} UNION {j | j <=| N /\ ~(j = i)}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  UNDH 8395 THEN ARITH_TAC; (* i <=| N *)
+  (* -- *)
+  REWRITE_TAC[IMAGE_UNION;UNIONS_UNION];
+  REWRITE_TAC[SUBSET;UNION];
+  DISJ1_TAC;
+  REWRITE_TAC[image_sing];
+  (* - *)
+  TYPE_THEN `~UNIONS (curve_cell E) (f x')` SUBAGOAL_TAC;
+  UNDH 4893 THEN REWRITE_TAC[];
+  THM_INTRO_TAC[`E`;`grid f N`] curve_cell_imp_subset;
+  USEH 2367 (MATCH_MP UNIONS_UNIONS); (* CURVE_CELL SUBSET curve-cell *)
+  ASM_MESON_TAC[subset_imp];
+  KILLH 3474; (* E SUBSET grid f N *)
+  KILLH 4893; (* ~UNIONS (. grid f N) *)
+  (* -A// *)
+  TYPE_THEN `E' = rectangle_grid (floor (f x' 0),floor (f x' 1)) (floor (f x' 0) +: &:1,floor (f x' 1) +: &:1)` ABBREV_TAC ;
+  THM_INTRO_TAC[`(floor (f x' 0),floor (f x' 1))`] rectagon_rectangle_grid_sq;
+  FULL_REWRITE_TAC [];
+  REWRH 2390;
+  TYPE_THEN `E' SUBSET E` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[grid33];
+  IMATCH_MP_TAC  rectangle_grid_subset;
+  (* __ *)
+  THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`0`;`2`] d_euclid_floor;
+  THM_INTRO_TAC[`f (&i/ &N)`;`f x'`;`1`;`2`] d_euclid_floor;
+  UNDH 7979 THEN UNDH 4359 THEN INT_ARITH_TAC;
+  (* -// *)
+  IMATCH_MP_TAC  bounded_avoidance_subset;
+  TYPE_THEN `E'` EXISTS_TAC;
+  TYPE_THEN `conn2 E'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  conn2_rectagon;
+  TYPE_THEN `FINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[conn2];
+  (* -// *)
+  TYPE_THEN `E SUBSET edge` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[grid33_edge];
+  (* -// *)
+  ASM_SIMP_TAC[GSYM odd_bounded];
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN ` squ (floor (f x' 0),floor (f x' 1))` EXISTS_TAC;
+  IMATCH_MP_TAC  (TAUT ` a/\ b ==> b /\ a`);
+  (* -B// *)
+  TYPE_THEN `~UNIONS (curve_cell E') (f x')` SUBAGOAL_TAC;
+  UNDH 1109 THEN REWRITE_TAC[]; (* ~  E *)
+  THM_INTRO_TAC[`E'`;`E`] curve_cell_imp_subset;
+  USEH 2664 (MATCH_MP UNIONS_UNIONS);  (* curve-cell SUBSET *)
+  ASM_MESON_TAC[subset_imp];
+  (* -// *)
+  TYPE_THEN `m = (floor (f x' 0),floor (f x' 1))` ABBREV_TAC ;
+  TYPE_THEN `~(h_edge m (f x'))` SUBAGOAL_TAC;
+  UNDH 8466 THEN REWRITE_TAC[]; (* ~ *)
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `h_edge m` EXISTS_TAC;
+  REWRITE_TAC[curve_cell_h_ver2];
+  USEH 4743 (REWRITE_RULE[PAIR_SPLIT]); (* floor,floor = m *)
+  REWRH 1242; (* rg flor,flor *)
+  FULL_REWRITE_TAC[rectangle_grid_sq];
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[INSERT];
+  (* -// *)
+  TYPE_THEN `~(v_edge m (f x'))` SUBAGOAL_TAC;
+  UNDH 8466 THEN REWRITE_TAC[]; (* ~UNIONS .. E' *)
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `v_edge m` EXISTS_TAC;
+  REWRITE_TAC[curve_cell_v_ver2];
+  USEH 4743 (REWRITE_RULE[PAIR_SPLIT]);
+  REWRH 1242;
+  FULL_REWRITE_TAC[rectangle_grid_sq];
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[INSERT];
+  (* -// *)
+  TYPE_THEN `~(f x' = pointI m)` SUBAGOAL_TAC;
+  UNDH 8466 THEN REWRITE_TAC[];
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `{(pointI m)}` EXISTS_TAC;
+  ASM_SIMP_TAC[rectagon_segment;curve_cell_cls];
+  USEH 4743 (REWRITE_RULE[PAIR_SPLIT]);
+  REWRH 1242;
+  FULL_REWRITE_TAC[rectangle_grid_sq];
+  TYPE_THEN `{(h_edge m)} SUBSET E'` SUBAGOAL_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;INSERT];
+  USEH 9677 (MATCH_MP cls_subset); (* { hedge } SUBSET E' *)
+  USEH 1949 (REWRITE_RULE[SUBSET]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[cls_h];
+  (* -C// *)
+  USEH 2851 (MATCH_MP point_onto); (* euclid 2 (f x') *)
+  THM_INTRO_TAC[`p`] square_domain;
+  UNDH 4082 THEN LET_TAC;
+  TYPE_THEN `(floor (FST p),floor (SND p)) = m` SUBAGOAL_TAC;
+  TYPE_THEN `m` UNABBREV_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  REWRH 2288; (* big ONE *)
+  TYPE_THEN `point p` UNABBREV_TAC;
+  USEH 459 (REWRITE_RULE[UNION;INR IN_SING;]); (* long *)
+  REWRH 4739; (* \/ *)
+  (* -D// *)
+  ASM_SIMP_TAC[rectagon_segment;par_cell_squ];
+  FULL_REWRITE_TAC[num_lower];
+  USEH 4743 (REWRITE_RULE[PAIR_SPLIT]);
+  REWRH 1242;  (* rect-grid *)
+  FULL_REWRITE_TAC[rectangle_grid_sq];
+  TYPE_THEN `!m'. E' (h_edge m') <=> (m' = up m) \/ (m' = m)` SUBAGOAL_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[INSERT;cell_clauses];
+  REWRH 5179; (* EVEN *)
+  (* - *)
+  TYPE_THEN `{m' | ((m' = up m) \/ (m' = m)) /\ (FST m' = FST m) /\ SND m' <=: SND m} = {m}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[up;PAIR_SPLIT];
+  INT_ARITH_TAC;
+  REWRH 3452; (* EVEN *)
+  FULL_REWRITE_TAC[card_sing;EVEN2];
+  ]);;
+
+  (* }}} *)
+
+let grid33_h = prove_by_refinement(
+  `!m. grid33 m (h_edge m)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[grid33];
+  REWRITE_TAC[rectangle_grid];
+  DISJ1_TAC;
+  TYPE_THEN `m` EXISTS_TAC;
+  INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let curve_cell_grid_unions = prove_by_refinement(
+  `!f N. curve_cell (grid f N) =
+       UNIONS (IMAGE curve_cell
+       ((IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1)))
+         {j | j <=| N})))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[grid];
+  TYPE_THEN `S = (IMAGE (\i. grid33 (floor (f (&i / &N) 0),floor (f (&i / &N) 1)))  {j | j <=| N})` ABBREV_TAC ;
+  IMATCH_MP_TAC  thread_finite_union;
+  REWRITE_TAC[curve_cell_union;curve_cell_empty];
+  TYPE_THEN `S` UNABBREV_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  REWRITE_TAC[FINITE_NUMSEG_LE];
+  ]);;
+
+  (* }}} *)
+
+let curve_cell_finite_union = prove_by_refinement(
+  `!E. FINITE E ==>
+     ( curve_cell (UNIONS E) = UNIONS (IMAGE curve_cell E))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  thread_finite_union;
+  REWRITE_TAC[curve_cell_empty;curve_cell_union];
+  ]);;
+  (* }}} *)
+
+let grid33_unions = prove_by_refinement(
+  `!p.  grid33 p =
+    (IMAGE h_edge
+       { m | (FST p -: &:1 <=: FST m) /\ FST m <=: FST p +: &:1 /\
+              SND p -: &:1 <=: SND m /\ (SND m <=: SND p +: &:2) })
+   UNION
+    (IMAGE v_edge
+       { m | FST p -: &:1 <=: FST m /\ FST m <= FST p +: &:2 /\
+             SND p -: &:1 <=: SND m /\ SND m <= SND p +: &:1}) `,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[grid33;IMAGE;rectangle_grid];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION];
+  IMATCH_MP_TAC  EQ_ANTISYM ;
+  CONJ_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[cell_clauses];
+  CONV_TAC (dropq_conv "x");
+  TYPE_THEN `m'` UNABBREV_TAC;
+  UNDH 3867 THEN INT_ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[cell_clauses];
+  CONV_TAC (dropq_conv "x");
+  TYPE_THEN `m'` UNABBREV_TAC;
+  UNDH 2244 THEN INT_ARITH_TAC;
+  (* - *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[cell_clauses];
+  CONV_TAC (dropq_conv "m");
+  TYPE_THEN `x'` UNABBREV_TAC;
+  UNDH 6786 THEN INT_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[cell_clauses];
+  CONV_TAC (dropq_conv "m");
+  TYPE_THEN `x'` UNABBREV_TAC;
+  UNDH 2096 THEN INT_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let int_range_finite = prove_by_refinement(
+  `!a b. FINITE {t | a <=: t /\ t <=: b}`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `b <: a` ASM_CASES_TAC;
+  TYPE_THEN `{ t | a <=: t /\ t <=: b} = EMPTY ` BACK_TAC;
+  REWRITE_TAC[FINITE_RULES];
+  IMATCH_MP_TAC  EQ_EXT;
+  UNDH 5826 THEN INT_ARITH_TAC;
+  (* - *)
+  THM_INTRO_TAC[`a`] INT_REP;
+  THM_INTRO_TAC[`b`] INT_REP;
+  TYPE_THEN `a` UNABBREV_TAC;
+  TYPE_THEN `b` UNABBREV_TAC;
+  (* - *)
+  THM_INTRO_TAC[`{ i | i <=| (n' + m) - (n + m') }`;`{t | (&:n -: &:m)  <=: t /\ t <=: &:n' -: &:m'}`;`(\ i. (&:i) + &:n -: &:m)`] SURJ_FINITE;
+  REWRITE_TAC[FINITE_NUMSEG_LE];
+  REWRITE_TAC[SURJ];
+  CONJ_TAC;
+  TYPE_THEN `(n +| m') <= (n' + m)` SUBAGOAL_TAC;
+  REWRITE_TAC[GSYM INT_OF_NUM_LE];
+  REWRITE_TAC[GSYM INT_OF_NUM_ADD];
+  UNDH 6818 THEN INT_ARITH_TAC;
+  USEH 2499 (MATCH_MP INT_OF_NUM_SUB);
+  USEH 6968 SYM;
+  FULL_REWRITE_TAC[GSYM INT_OF_NUM_LE];
+  REWRH 3919;
+  FULL_REWRITE_TAC[INT_OF_NUM_ADD];
+  CONJ_TAC;
+  TYPE_THEN `&:0 <=: &:x` SUBAGOAL_TAC;
+  REWRITE_TAC[INT_OF_NUM_LE];
+  ARITH_TAC;
+  UNDH 163 THEN ARITH_TAC;
+  UNDH 1710 THEN ARITH_TAC;
+  (* -A *)
+  THM_INTRO_TAC[`x`] INT_REP;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `(n'' + m) -| (m'' + n)` EXISTS_TAC;
+  TYPE_THEN `&:n'' + &:m' <=: &:n' + &:m''` SUBAGOAL_TAC;
+  UNDH 4837 THEN INT_ARITH_TAC;
+  KILLH 4837;
+  TYPE_THEN `&:m'' + &:n <=: &:n'' + &:m` SUBAGOAL_TAC;
+  UNDH 9532 THEN INT_ARITH_TAC;
+  KILLH 9532;
+  KILLH 6818;
+  (* - *)
+  CONJ_TAC;
+  FULL_REWRITE_TAC[INT_OF_NUM_ADD;INT_OF_NUM_LE];
+  UNDH 8565 THEN UNDH 9575 THEN ARITH_TAC;
+  (* - *)
+  FULL_REWRITE_TAC[INT_OF_NUM_ADD;INT_OF_NUM_LE];
+  ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB];
+  FULL_REWRITE_TAC[GSYM INT_OF_NUM_ADD];
+  FULL_REWRITE_TAC[GSYM INT_OF_NUM_LE;GSYM INT_OF_NUM_ADD ];
+  UNDH 4630 THEN UNDH 1357 THEN INT_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let subs_lemma = prove_by_refinement(
+  `!y (f:A->bool). (f y) ==> (!x. (x = y) ==> f x)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  ]);;
+  (* }}} *)
+
+(*** JRH changed the labels here because somehow
+     some beta-redexes get contracted that did not before,
+     (new IN_ELIM_THM?) and this changes the set comprehensions
+
+let int2_range_finite = prove_by_refinement(
+  `! a b c d. FINITE {m | a <=: FST m /\ FST m <=: b /\
+                          c <=: SND m /\ SND m <=: d}`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`{t | a <=: t /\ t <=: b}`;`{u | c <=: u /\ u <=: d}`] FINITE_PRODUCT;
+  REWRITE_TAC[int_range_finite];
+  USEH 3506 (MATCH_MP subs_lemma);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  EQ_EXT;
+  KILLH 8899;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "t'");
+  CONV_TAC (dropq_conv "u'");
+  REWRITE_TAC[PAIR_SPLIT];
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+ ****)
+
+let int2_range_finite = prove_by_refinement(
+  `! a b c d. FINITE {m | a <=: FST m /\ FST m <=: b /\
+                          c <=: SND m /\ SND m <=: d}`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`{t | a <=: t /\ t <=: b}`;`{u | c <=: u /\ u <=: d}`] FINITE_PRODUCT;
+  REWRITE_TAC[int_range_finite];
+  USEH 4853 (MATCH_MP subs_lemma);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  EQ_EXT;
+  KILLH 4636;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  NAME_CONFLICT_TAC;
+  CONV_TAC (dropq_conv "t'");
+  CONV_TAC (dropq_conv "u'");
+  REWRITE_TAC[PAIR_SPLIT];
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+
+let grid33_finite = prove_by_refinement(
+  `!p. FINITE (grid33 p)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[grid33_unions];
+  REWRITE_TAC[FINITE_UNION];
+  CONJ_TAC THEN (IMATCH_MP_TAC  FINITE_IMAGE) THEN (REWRITE_TAC[int2_range_finite]);
+  ]);;
+  (* }}} *)
+
+let d_euclid_bound2 = prove_by_refinement(
+  `!x y eps. euclid 2 x /\ euclid 2 y /\ (abs  (x 0 - y 0) <= eps) /\
+    (abs  (x 1 - y 1) <= eps) ==> (d_euclid x y <= sqrt(&2) * eps)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  D_EUCLID_BOUND;
+  REP_BASIC_TAC;
+  TYPE_THEN `(i=0) \/ (i = 1) \/ (2 <= i)` SUBAGOAL_TAC;
+  ARITH_TAC;
+  UNDH 2744 THEN REP_CASES_TAC;
+  TYPE_THEN `i` UNABBREV_TAC;
+  TYPE_THEN `i` UNABBREV_TAC;
+  FULL_REWRITE_TAC[euclid];
+  UND 0 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let grid33_radius = prove_by_refinement(
+  `!x y. (euclid 2 x) /\
+  (UNIONS (curve_cell (grid33 (floor (x 0),floor (x 1)))) y) ==>
+        (d_euclid x y < &4 )`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `m = (floor (x 0),floor (x 1))` ABBREV_TAC  ;
+  THM_INTRO_TAC[`grid33 m`] (GSYM curve_closure_ver2);
+  REWRITE_TAC[grid33_edge;grid33_finite];
+  REWRH 2056;
+  KILLH 7690;
+  TYPE_THEN `(UNIONS (grid33 m)) SUBSET  closed_ball (euclid 2,d_euclid) x (&3) ` BACK_TAC;
+  THM_INTRO_TAC[`top2`;`UNIONS(grid33 m)`;`closed_ball (euclid 2,d_euclid) x (&3)`;] closure_subset;
+  REWRITE_TAC [top2_top;];
+  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`&3 `]closed_ball_closed;
+  FULL_REWRITE_TAC[GSYM top2];
+  KILLH 1468;
+  FULL_REWRITE_TAC[SUBSET;closed_ball];
+  TSPECH `y` 8043;
+  FULL_REWRITE_TAC[];
+  UNDH 9621 THEN REAL_ARITH_TAC;
+  (* -A *)
+  KILLH 920;
+  FULL_REWRITE_TAC [grid33_unions];
+  REWRITE_TAC[UNIONS_UNION;union_subset];
+  (* - *)
+  TYPE_THEN `sqrt (&2) * (&2) <= (&3)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_POW_2_LE;
+  REWRITE_TAC[REAL_POW_MUL];
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  IMATCH_MP_TAC  SQRT_POS_LE;
+  TYPE_THEN `sqrt(&2) pow 2 = &2` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SQRT_POW_2;
+  REWRITE_TAC[REAL_POW_2];
+  REAL_ARITH_TAC;
+  (* - *)
+  CONJ_TAC;
+  FULL_REWRITE_TAC[UNION;UNIONS;IMAGE;SUBSET;closed_ball];
+  TYPE_THEN `u` UNABBREV_TAC;
+  SUBCONJ_TAC;
+  ASM_MESON_TAC[h_edge_euclid;subset_imp];
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `sqrt(&2) * &2` EXISTS_TAC;
+  IMATCH_MP_TAC d_euclid_bound2;
+  FULL_REWRITE_TAC[h_edge];
+  REWRITE_TAC[coord01];
+  TYPE_THEN `v` UNABBREV_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `m` UNABBREV_TAC;
+  THM_INTRO_TAC[`x 0`] floor_ineq;
+  THM_INTRO_TAC[`x 1`] floor_ineq;
+  FULL_REWRITE_TAC[int_of_num_th;int_add_th;int_sub_th;int_lt;int_le];
+  POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)) THEN REAL_ARITH_TAC;
+  (* - *)
+  FULL_REWRITE_TAC[UNION;UNIONS;IMAGE;SUBSET;closed_ball];
+  TYPE_THEN `u` UNABBREV_TAC;
+  SUBCONJ_TAC;
+  ASM_MESON_TAC[v_edge_euclid;subset_imp];
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `sqrt(&2) * &2` EXISTS_TAC;
+  IMATCH_MP_TAC d_euclid_bound2;
+  FULL_REWRITE_TAC[v_edge];
+  REWRITE_TAC[coord01];
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `m` UNABBREV_TAC;
+  THM_INTRO_TAC[`x 0`] floor_ineq;
+  THM_INTRO_TAC[`x 1`] floor_ineq;
+  FULL_REWRITE_TAC[int_of_num_th;int_add_th;int_sub_th;int_lt;int_le];
+  POP_ASSUM_LIST (fun t-> EVERY (map MP_TAC t)) THEN REAL_ARITH_TAC;
+  (* Thu Dec 30 21:22:53 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_grid_properties = prove_by_refinement(
+  `!C a b. simple_arc_end C a b ==> (?E.
+      E SUBSET edge /\
+      (C INTER (unbounded_set E) = EMPTY) /\
+      conn2 E /\
+      E (h_edge (floor (a 0),floor (a 1))) /\
+      E (h_edge (floor (b 0),floor (b 1))) /\
+     (!y. UNIONS (curve_cell E) y ==> (?x. C x /\ d_euclid x y < &4)))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  COPYH 2895;
+  USEH 2895 (REWRITE_RULE [simple_arc_end]);
+  THM_INTRO_TAC[`f`] simple_arc_uniformly_continuous;
+  FULL_REWRITE_TAC[uniformly_continuous];
+  (* - *)
+  TYPE_THEN `!N' x. (&0 < &N') ==> ((&0 <= x/ &N') <=> (&0 <= x))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`&N'`;`&0`;`x`] real_div_denom;
+  FULL_REWRITE_TAC[REAL_DIV_LZERO];
+  (* - *)
+  TYPE_THEN `!N' x. (&0 < &N') ==> ((x/ &N' <= &1) <=> (x <= &N'))` SUBAGOAL_TAC;
+  ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
+  REDUCE_TAC;
+  (* - *)
+  TYPE_THEN `?N. (!i N'. (N <= N') /\ (i <| N') ==> d_euclid (f (&i / &N')) (f (&(SUC i) / &N')) < &1)` SUBAGOAL_TAC;
+  TSPECH `&1` 814;
+  FULL_REWRITE_TAC[REAL_ARITH `&0 < &1`];
+  THM_INTRO_TAC[`delta`] delta_pos_arch;
+  TYPE_THEN `n` EXISTS_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FULL_REWRITE_TAC[GSYM REAL_LT];
+  FULL_REWRITE_TAC[REAL_LE;REAL_LT;d_real];
+  (* -- *)
+  TYPE_THEN `0 <| N'` SUBAGOAL_TAC;
+  UNDH 800 THEN UNDH 3476 THEN ARITH_TAC;
+  (* -- *)
+  FULL_REWRITE_TAC[REAL_LE;REAL_LT;];
+  CONJ_TAC;
+  UNDH 9580 THEN ARITH_TAC;
+  CONJ_TAC;
+  UNDH 9580 THEN ARITH_TAC;
+  REWRITE_TAC[suc_div];
+  REWRITE_TAC[REAL_ARITH `abs  (x - (x + y)) = abs  y`];
+  REWRITE_TAC[REAL_ABS_DIV;REAL_ABS_NUM];
+  IMATCH_MP_TAC  REAL_LET_TRANS;
+  TYPE_THEN `&1/ &n`EXISTS_TAC;
+  FULL_REWRITE_TAC[GSYM REAL_LT];
+  ASM_SIMP_TAC[RAT_LEMMA4];
+  REDUCE_TAC;
+  (* -A *)
+  THM_INTRO_TAC[`f`] grid_image_bounded_ver2;
+  TYPE_THEN `n = N +| M` ABBREV_TAC  ;
+  TYPE_THEN`E = grid f n` ABBREV_TAC ;
+  TYPE_THEN `E` EXISTS_TAC;
+  TYPE_THEN `0 <| n /\ M <= n /\ N <= n` SUBAGOAL_TAC;
+  RIGHTH 8917 "N";
+  UNDH 8208 THEN UNDH 4600 THEN ARITH_TAC;
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC [  grid_edge];
+  (* - *)
+  SUBCONJ_TAC;
+  TSPECH `n` 8917;
+  TYPE_THEN `E` UNABBREV_TAC;
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  IMATCH_MP_TAC  grid_conn2;
+  CONJ_TAC;
+  IMATCH_MP_TAC  inj_image_subset;
+  (* -- *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* -B *)
+  CONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[grid];
+  TYPE_THEN `a` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE;UNIONS];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `0` EXISTS_TAC;
+  CONJ_TAC;
+  UNDH 3476 THEN ARITH_TAC;
+  REWRITE_TAC[REAL_DIV_LZERO;grid33_h];
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[grid];
+  TYPE_THEN `b` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE;UNIONS];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `n` EXISTS_TAC;
+  CONJ_TAC;
+  ARITH_TAC;
+  USEH 3476 (REWRITE_RULE [GSYM REAL_LT]);
+  USEH 1089 (MATCH_MP (REAL_ARITH `&0 < y ==> ~(y = &0)`));
+  ASM_SIMP_TAC[REAL_DIV_REFL];
+  REWRITE_TAC[grid33_h];
+  (* -C *)
+  TYPE_THEN `E` UNABBREV_TAC;
+  USEH 2127 (REWRITE_RULE[curve_cell_grid_unions]);
+  USEH 957 (REWRITE_RULE[IMAGE;UNIONS]);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `u'` UNABBREV_TAC;
+  TYPE_THEN `f ( &x' / &n )` EXISTS_TAC;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC image_imp ;
+  FULL_REWRITE_TAC[GSYM REAL_LT];
+  FULL_REWRITE_TAC[REAL_LE;REAL_LT ];
+  ARITH_TAC;
+  (* - *)
+  IMATCH_MP_TAC  grid33_radius;
+  CONJ_TAC;
+  USEH 2083 (REWRITE_RULE[IMAGE]);
+  USEH 7215 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  (* - *)
+  REWRITE_TAC[UNIONS];
+  UNIFY_EXISTS_TAC;
+  (* Thu Dec 30 21:27:32 EST 2004 *)
+  ]);;
+
+  (* }}} *)
+
+let unbounded_set_lemma = prove_by_refinement(
+  `!E p. (FINITE E /\ E SUBSET edge) ==>
+     (unbounded_set E p <=> (?r. !s. (r <= s) ==>
+          (?C. simple_arc_end C p (point(s,&0)) /\
+              (C INTER UNIONS (curve_cell E) = EMPTY))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  THM_INTRO_TAC[`E`;`p`] unbounded_euclid;
+  USEH 7802 (MATCH_MP point_onto);
+  TYPE_THEN `p` UNABBREV_TAC;
+  (* -- *)
+  FULL_REWRITE_TAC[unbounded_set;unbounded];
+  TYPE_THEN `r' = max_real r (FST p' + &1)` ABBREV_TAC ;
+  TYPE_THEN `r'` EXISTS_TAC;
+  THM_INTRO_TAC[`E`;`point p'`;`point (s,&0)`] component_simple_arc;
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
+  TYPE_THEN `s` UNABBREV_TAC;
+  TYPE_THEN `r'` UNABBREV_TAC;
+  UNDH 5363 THEN UNDH 4629 THEN REAL_ARITH_TAC;
+  USEH 3140 (ONCE_REWRITE_RULE[EQ_SYM_EQ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+    THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
+  UNDH 1263 THEN UNDH 5669 THEN UNDH 6232 THEN REAL_ARITH_TAC;
+  (* - *)
+  REWRITE_TAC[unbounded_set;unbounded];
+  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
+  TSPECH `r` 3171;
+  FULL_REWRITE_TAC[REAL_ARITH `r <= r`];
+  COPYH 3604;
+  USEH 3604 (MATCH_MP simple_arc_end_end);
+  USEH 3604 (MATCH_MP simple_arc_end_simple);
+  USEH 3550 (MATCH_MP simple_arc_euclid);
+  ASM_MESON_TAC[subset_imp];
+  USEH 7802 (MATCH_MP point_onto);
+  TYPE_THEN `p` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `r' = max_real r (FST p' + &1)` ABBREV_TAC ;
+  TYPE_THEN `r'` EXISTS_TAC;
+  THM_INTRO_TAC[`E`;`point p'`;`point (s,&0)`] component_simple_arc;
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
+  UNDH 5363 THEN UNDH 6232 THEN UNDH 5669 THEN UNDH 9420 THEN REAL_ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `r'` UNABBREV_TAC;
+  THM_INTRO_TAC[`r`;`FST p' + &1`] max_real_le;
+  UNDH 1263 THEN UNDH 540 THEN REAL_ARITH_TAC;
+  (* Fri Dec 31 07:35:03 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_subset_trans_lemma = prove_by_refinement(
+  `!C a b c. simple_arc_end C a b /\ C c /\ ~(c = a) ==>
+    (?C'. C' SUBSET C /\ simple_arc_end C' a c)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `b = c` ASM_CASES_TAC;
+  TYPE_THEN `b` UNABBREV_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_REFL];
+  THM_INTRO_TAC[`C`;`a`;`b`;`c`] simple_arc_end_cut;
+  TYPE_THEN `C'` EXISTS_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_subset_trans = prove_by_refinement(
+  `!C C' a b c. simple_arc_end C a b /\ simple_arc_end C' b c /\
+    ~(a = c) ==>
+    (?U. simple_arc_end U a c /\ U SUBSET (C UNION C'))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `C' a` ASM_CASES_TAC;
+  THM_INTRO_TAC[`C'`;`c`;`b`;`a`] simple_arc_end_subset_trans_lemma;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  TYPE_THEN `C''` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  THM_INTRO_TAC[`C`;`{a}`;`C'`] simple_arc_end_restriction;
+  CONJ_TAC;
+  USEH 2895 (MATCH_MP simple_arc_end_simple);
+  CONJ_TAC;
+  USEH 2895 (MATCH_MP simple_arc_end_end_closed);
+  CONJ_TAC;
+  USEH 3594 (MATCH_MP simple_arc_end_closed);
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER;INR IN_SING ];
+  TYPE_THEN `u` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  CONJ_TAC THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
+  TYPE_THEN `a` EXISTS_TAC;
+  USEH 2895 (MATCH_MP simple_arc_end_end);
+  TYPE_THEN `b` EXISTS_TAC;
+  USEH 2895 (MATCH_MP simple_arc_end_end2);
+  USEH 3594 (MATCH_MP simple_arc_end_end);
+  (* - *)
+  TYPE_THEN `v = a` SUBAGOAL_TAC;
+  USEH 6975 (REWRITE_RULE[eq_sing]);
+  USEH 8361 (REWRITE_RULE[INTER;INR IN_SING]);
+  TYPE_THEN `v` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `v' = c` ASM_CASES_TAC;
+  TYPE_THEN `v'` UNABBREV_TAC;
+  TYPE_THEN `C''` EXISTS_TAC;
+  FULL_REWRITE_TAC[SUBSET;UNION];
+  (* - *)
+  THM_INTRO_TAC[`C'`;`c`;`b`;`v'`] simple_arc_end_subset_trans_lemma;
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  USEH 9287 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  USEH 6723 (MATCH_MP simple_arc_end_symm);
+  THM_INTRO_TAC[`C''`;`C'''`;`a`;`v'`;`c`] simple_arc_end_trans;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER];
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[INTER;eq_sing;INR IN_SING;SUBSET];
+  ASM_MESON_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  USEH 3266 (MATCH_MP simple_arc_end_end2);
+  USEH 2088 (MATCH_MP simple_arc_end_end);
+  TYPE_THEN `C'' UNION C'''` EXISTS_TAC;
+  FULL_REWRITE_TAC[SUBSET;UNION];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  (* Fri Dec 31 08:49:20 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let unbounded_set_trans_lemma = prove_by_refinement(
+  `!E p q x r. FINITE E /\ E SUBSET edge /\
+     (unbounded_set E p) /\
+     (UNIONS E SUBSET (closed_ball(euclid 2,d_euclid) x r)) /\
+     (?C. simple_arc_end C p q /\
+         (C INTER closed_ball(euclid 2,d_euclid) x r = EMPTY)) ==>
+   (unbounded_set E q)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `closure top2 (UNIONS E) SUBSET (closed_ball (euclid 2,d_euclid) x r)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  closure_subset;
+  REWRITE_TAC[top2_top];
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  closed_ball_closed;
+  (* - *)
+  THM_INTRO_TAC[`E`] curve_closure_ver2;
+  REWRH 5238;
+  KILLH 3085;
+  KILLH 5161;
+  (* - *)
+  TYPE_THEN `C INTER UNIONS (curve_cell E) = EMPTY` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  FULL_REWRITE_TAC[EQ_EMPTY ];
+  TSPECH `u` 5342;
+  FULL_REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  (* - *)
+  UNDH 2166 THEN ASM_SIMP_TAC [unbounded_set_lemma];
+  TYPE_THEN `euclid 2 q` SUBAGOAL_TAC;
+  COPYH 5276;
+  USEH 5276 (MATCH_MP simple_arc_end_simple);
+  USEH 5276 (MATCH_MP simple_arc_end_end2);
+  USEH 3550 (MATCH_MP simple_arc_euclid);
+  ASM_MESON_TAC[subset_imp];
+  USEH 877 (MATCH_MP point_onto);
+  TYPE_THEN `q` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `r'' = max_real r' (FST p' + &1)` ABBREV_TAC ;
+  TYPE_THEN `r''` EXISTS_TAC;
+  TSPECH `s` 5976;
+  (* - *)
+  TYPE_THEN `r' <= s` SUBAGOAL_TAC;
+  TYPE_THEN `r''` UNABBREV_TAC;
+  THM_INTRO_TAC[`r'`;`FST p' + &1`] max_real_le;
+  UNDH 6140 THEN UNDH 3019 THEN REAL_ARITH_TAC;
+  REP_BASIC_TAC;
+  USEH 9110 (MATCH_MP simple_arc_end_symm);
+  (* - *)
+  TYPE_THEN `~(point p' = point (s,&0))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  TYPE_THEN `s` UNABBREV_TAC;
+  TYPE_THEN `r''` UNABBREV_TAC;
+  THM_INTRO_TAC[`r'`;`FST p' + &1`] max_real_le;
+  UNDH 9809 THEN UNDH 7108 THEN REAL_ARITH_TAC;
+  THM_INTRO_TAC[`C`;`C'`;`point p'`;`p`;`(point(s,&0))`] simple_arc_end_subset_trans;
+  TYPE_THEN `U` EXISTS_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
+  FULL_REWRITE_TAC[SUBSET;UNION;EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* Fri Dec 31 09:05:35 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let unbounded_set_empty = prove_by_refinement(
+  `(unbounded_set EMPTY = euclid 2)`,
+  (* {{{ proof *)
+  [
+  THM_INTRO_TAC[`EMPTY:((num->real)->bool)->bool`] unbound_set_x_axis;
+  REWRITE_TAC[FINITE_RULES];
+  TSPECH `r` 9109;
+  FULL_REWRITE_TAC[REAL_ARITH `r <= r`];
+  IMATCH_MP_TAC  EQ_EXT;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  unbounded_euclid;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `x = (point(r,&0))` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  IMATCH_MP_TAC  unbounded_set_trans_lemma;
+  REWRITE_TAC[FINITE_RULES];
+  TYPE_THEN `point(r,&0)` EXISTS_TAC;
+  TYPE_THEN `point(&0,&0)` EXISTS_TAC;
+  TYPE_THEN `-- &1` EXISTS_TAC;
+  (* - *)
+  THM_INTRO_TAC[`2`;`point(&0,&0)`;`-- &1`] closed_ball_empty;
+  REAL_ARITH_TAC;
+  TYPE_THEN `mk_segment (point (r,&0)) x` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  mk_segment_simple_arc_end;
+  REWRITE_TAC[INTER_EMPTY];
+  (* Fri Dec 31 09:37:30 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let continuous_real_const = prove_by_refinement(
+  `!r. continuous (\t. r) (top_of_metric (UNIV,d_real))
+ (top_of_metric (UNIV,d_real))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[continuous;preimage];
+  TYPE_THEN `v r` ASM_CASES_TAC;
+  TYPE_THEN `{x | UNIONS (top_of_metric (UNIV,d_real)) x} = UNIONS (top_of_metric(UNIV,d_real))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  IMATCH_MP_TAC  top_univ;
+  IMATCH_MP_TAC  top_of_metric_top;
+  REWRITE_TAC[metric_real];
+(**** Modified by JRH to avoid GSPEC
+  REWRITE_TAC[GSYM EMPTY;GSPEC;top_of_metric_empty ];
+ ****)
+  (let lemma = prove(`{x | F} = {}`,
+                     REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY]) in
+   REWRITE_TAC[lemma; top_of_metric_empty])
+  (* Fri Dec 31 10:30:48 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let continuous_real_mul = prove_by_refinement(
+  `!r. (&0 < r) ==> continuous (( *. ) r)
+  (top_of_metric (UNIV,d_real))
+ (top_of_metric (UNIV,d_real)) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`( *. ) r`;`UNIV:real->bool`;`UNIV:real->bool`;`d_real`;`d_real`;] metric_continuous_continuous;
+  REWRITE_TAC[metric_real];
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  FULL_REWRITE_TAC[d_real];
+  TYPE_THEN `epsilon/r` EXISTS_TAC;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  UNDH 5576 THEN (ASM_SIMP_TAC[REAL_LT_RDIV_EQ]);
+  ASM_SIMP_TAC[REAL_ARITH `r * x - r *y = r*. (x - y)`;ABS_MUL ];
+  UNDH 7175 THEN UNDH 6412 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let polar_curve_lemma = prove_by_refinement(
+  `!x theta r. euclid 2 x /\ &0 < theta /\ theta < &2 * pi /\ &0 < r ==>
+   (?C.
+    simple_arc_end C (x + point(r,&0)) (x + r *# (cis theta)) /\
+    !y. C y ==> (d_euclid x y = r))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `f = (\ (t:real) . r) ` ABBREV_TAC  ;
+  TYPE_THEN `g = ( *. ) theta` ABBREV_TAC ;
+  THM_INTRO_TAC[`x`;`f`;`g`] polar_cont;
+  TYPE_THEN `f` UNABBREV_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  ASM_SIMP_TAC [continuous_real_const;continuous_real_mul];
+  TYPE_THEN `G = (\t. euclid_plus x (f t *# cis (g t))) ` ABBREV_TAC ;
+  TYPE_THEN `C = IMAGE G {x | &0 <= x /\ x <= &1}` ABBREV_TAC ;
+  TYPE_THEN `C` EXISTS_TAC;
+  REWRITE_TAC[simple_arc_end];
+  SUBCONJ_TAC;
+  TYPE_THEN `G` EXISTS_TAC;
+  (* -- *)
+  TYPE_THEN `G (&0) = euclid_plus x (point (r,&0)) ` SUBAGOAL_TAC;
+  TYPE_THEN `G` UNABBREV_TAC;
+  AP_TERM_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  REDUCE_TAC;
+  REWRITE_TAC[cis];
+  REWRITE_TAC[point_scale;COS_0;SIN_0];
+  REDUCE_TAC;
+  (* -- *)
+  TYPE_THEN `G (&1) = euclid_plus x (r *# cis theta)` SUBAGOAL_TAC;
+  TYPE_THEN `G` UNABBREV_TAC;
+  AP_TERM_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  REDUCE_TAC;
+  (* -- *)
+  TYPE_THEN `G` UNABBREV_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  IMATCH_MP_TAC  euclid_add_closure;
+  REWRITE_TAC[polar_euclid];
+  (* -- *)
+  FULL_REWRITE_TAC[euclid_add_cancel];
+  TYPE_THEN `f` UNABBREV_TAC;
+  THM_INTRO_TAC[`g x'`;`g y`;`r`;`r`] polar_inj;
+  TYPE_THEN `g` UNABBREV_TAC;
+  ASSUME_TAC (REAL_ARITH `&0 < r ==> &0 <= r`);
+  TYPE_THEN `!x. &0 <= x ==> &0 <= theta* x` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LE_MUL;
+  UNDH 2540 THEN REAL_ARITH_TAC;
+  TYPE_THEN `!x. (x <= &1) ==> (theta* x < &2 * pi)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LET_TRANS;
+  TYPE_THEN `theta* &1` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_LMUL;
+  UNDH 2540 THEN REAL_ARITH_TAC;
+  REDUCE_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `r` UNABBREV_TAC;
+  UNDH 869 THEN REAL_ARITH_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  FULL_REWRITE_TAC[REAL_EQ_MUL_LCANCEL];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `theta` UNABBREV_TAC;
+  UNDH 869 THEN REAL_ARITH_TAC;
+  (* -A *)
+  TYPE_THEN `C` UNABBREV_TAC;
+  TYPE_THEN `G` UNABBREV_TAC;
+  USEH 1547 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `f` UNABBREV_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  TYPE_THEN `d_euclid x (euclid_plus x (r *# cis (theta * x'))) = d_euclid (x + (&0 *# (cis (theta * x')))) (euclid_plus x (r *# cis (theta * x')))` SUBAGOAL_TAC;
+  AP_THM_TAC;
+  AP_TERM_TAC;
+  REWRITE_TAC[euclid_scale0;euclid_rzero];
+  THM_INTRO_TAC[`2`;`(&0 *# cis (theta * x'))`;`(r *# cis (theta * x'))`;`x`]  metric_translate_LEFT;
+  REWRITE_TAC[polar_euclid];
+  REWRITE_TAC[d_euclid_eq_arg];
+  UNDH 6412 THEN REAL_ARITH_TAC;
+  (* Fri Dec 31 11:25:13 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let unbounded_set_ball = prove_by_refinement(
+  `!E x r p.  (&0 < r) /\
+        FINITE E /\ E SUBSET edge /\ (euclid 2 p) /\
+        UNIONS E SUBSET (closed_ball (euclid 2,d_euclid) x r) /\
+        ~(closed_ball (euclid 2,d_euclid) x r p) ==>
+      unbounded_set E p`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`E`] unbound_set_x_axis;
+  (* - *)
+  TYPE_THEN `E = EMPTY` ASM_CASES_TAC;
+  FULL_REWRITE_TAC[unbounded_set_empty];
+  TYPE_THEN `UNIONS E = EMPTY` ASM_CASES_TAC;
+  FULL_REWRITE_TAC[UNIONS_EQ_EMPTY];
+  REWRH 7639;
+  TYPE_THEN `E` UNABBREV_TAC;
+  USEH 8908(REWRITE_RULE[SUBSET;INR IN_SING ]);
+  TYPE_THEN `edge EMPTY` SUBAGOAL_TAC;
+  USEH 1936 (MATCH_MP edge_cell);
+  USEH 5731 (MATCH_MP cell_nonempty);
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[EMPTY_EXISTS];
+  (* - *)
+  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET;closed_ball];
+  TSPECH `u` 9087;
+  USEH 1837 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  (* -A *)
+  TYPE_THEN `!x. (FST p' + r <  x) ==> unbounded_set E (point(x,&0))` SUBAGOAL_TAC;
+  TYPE_THEN `r' <= x'` ASM_CASES_TAC;
+  IMATCH_MP_TAC  unbounded_set_trans_lemma;
+  TYPE_THEN `point(r',&0)` EXISTS_TAC;
+  TYPE_THEN `point p'` EXISTS_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REAL_ARITH_TAC;
+  TYPE_THEN `mk_segment (point (r',&0)) (point(x',&0))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  mk_segment_simple_arc_end;
+  REWRITE_TAC[point_inj;PAIR_SPLIT];
+  TYPE_THEN `x'` UNABBREV_TAC;
+  UNDH 7236 THEN REAL_ARITH_TAC;
+  ONCE_REWRITE_TAC[mk_segment_sym];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  THM_INTRO_TAC[`x'`;`r'`;`&0`;`u''`]mk_segment_h;
+  UNDH 7636 THEN REAL_ARITH_TAC;
+  REWRH 9446;
+  TYPE_THEN `u''` UNABBREV_TAC;
+  USEH 7067 (REWRITE_RULE[closed_ball]);
+  THM_INTRO_TAC[`2`;`point p'`;`point(t,&0)`;`0`]proj_contraction;
+  FULL_REWRITE_TAC[coord01];
+  UNDH 9207 THEN UNDH 6790 THEN UNDH 9670 THEN UNDH 2823 THEN REAL_ARITH_TAC;
+  (* -B *)
+  KILLH 3473;
+  KILLH 5938;
+  KILLH 7857;
+  (* - *)
+  TYPE_THEN `?R theta. r < R /\ &0 <= theta /\ theta < &2 * pi /\ (p = (point p') + (R *# cis theta))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[closed_ball];
+  TYPE_THEN `?q. (euclid 2 q) /\ (p = point p' + q) ` SUBAGOAL_TAC;
+  TYPE_THEN `euclid_minus p (point p')` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  euclid_sub_closure;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[euclid_plus;euclid_minus];
+  REAL_ARITH_TAC;
+  TYPE_THEN `p` UNABBREV_TAC;
+  (* -- *)
+  USEH 877 (MATCH_MP polar_exist);
+  TYPE_THEN `q` UNABBREV_TAC;
+  TYPE_THEN `r'` EXISTS_TAC ;
+  TYPE_THEN `t` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  UNDH 1925 THEN ASM_REWRITE_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`2`;`&0 *# cis t`;`r' *# cis t`;`point p'`] metric_translate_LEFT;
+  REWRITE_TAC[polar_euclid];
+  TYPE_THEN `point p' + &0 *# cis t = point p'` SUBAGOAL_TAC;
+  REWRITE_TAC[euclid_scale0;euclid_rzero];
+  REWRH 5125;
+  REWRITE_TAC[d_euclid_eq_arg];
+  UNDH 3665 THEN UNDH 1444 THEN REAL_ARITH_TAC;
+  (* -C *)
+  TYPE_THEN `unbounded_set E (point (FST p' + R,SND p'))` SUBAGOAL_TAC;
+  TYPE_THEN `SND p' = &0` ASM_CASES_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 8204 THEN REAL_ARITH_TAC;
+  IMATCH_MP_TAC  unbounded_set_trans_lemma;
+  TYPE_THEN `point (FST p' +R, &0)` EXISTS_TAC;
+  TYPE_THEN `point p'` EXISTS_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 8204 THEN REAL_ARITH_TAC;
+  TYPE_THEN `mk_segment (point (FST p' + R,&0)) (point(FST p' + R,SND p'))` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  mk_segment_simple_arc_end;
+  REWRITE_TAC[point_inj;PAIR_SPLIT];
+  UNDH 5038 THEN ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `&0 <= SND p'` ASM_CASES_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  THM_INTRO_TAC[`&0`;`SND p'`;`FST p' + R`;`u`]mk_segment_v;
+  REWRH 1093;
+  TYPE_THEN `u` UNABBREV_TAC;
+  FULL_REWRITE_TAC[closed_ball];
+  THM_INTRO_TAC[`2`;`point p'`;`point (FST p' + R,t)`;`0`] proj_contraction;
+  FULL_REWRITE_TAC[coord01];
+  UNDH 643 THEN UNDH 8188 THEN UNDH 8204 THEN UNDH 6412 THEN REAL_ARITH_TAC;
+  (* -- *)
+  ONCE_REWRITE_TAC[mk_segment_sym];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  THM_INTRO_TAC[`SND p'`;`&0`;`FST p' + R`;`u`]mk_segment_v;
+  UNDH 2479 THEN REAL_ARITH_TAC;
+  REWRH 2966;
+  TYPE_THEN `u` UNABBREV_TAC;
+  FULL_REWRITE_TAC[closed_ball];
+  THM_INTRO_TAC[`2`;`point p'`;`point (FST p' + R,t)`;`0`] proj_contraction;
+  FULL_REWRITE_TAC[coord01];
+  UNDH 643 THEN UNDH 8188 THEN UNDH 8204 THEN UNDH 6412 THEN REAL_ARITH_TAC;
+  (* -D *)
+  TYPE_THEN `theta= &0` ASM_CASES_TAC ;
+  REWRITE_TAC[cis;COS_0;SIN_0;point_scale];
+  TYPE_THEN `point p' + point (R * &1, R* &0) = point (FST p' + R , SND p')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_SYM;
+  ONCE_REWRITE_TAC[euclid_add_comm];
+  REWRITE_TAC[euclid_cancel1];
+  REWRITE_TAC[euclid_minus_scale;point_scale;point_add;point_inj;PAIR_SPLIT];
+  REAL_ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  IMATCH_MP_TAC  unbounded_set_trans_lemma;
+  TYPE_THEN `point (FST p' + R,SND p')` EXISTS_TAC;
+  TYPE_THEN `point p'` EXISTS_TAC;
+  TYPE_THEN `r` EXISTS_TAC;
+  THM_INTRO_TAC[`point p'`;`theta`;`R`] polar_curve_lemma;
+  UNDH 6412 THEN UNDH 8204 THEN UNDH 6162 THEN UNDH 4026 THEN REAL_ARITH_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  (* - *)
+  CONJ_TAC;
+  TYPE_THEN `?u v. (p' = (u,v))` SUBAGOAL_TAC ;
+  REWRITE_TAC[PAIR_SPLIT];
+  MESON_TAC[];
+  TYPE_THEN `p'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[point_add;REAL_ARITH `x + &0 = x`];
+  (* - *)
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
+  USEH 3064 (REWRITE_RULE[closed_ball]);
+  TSPECH `u` 5780;
+  TYPE_THEN `R` UNABBREV_TAC;
+  UNDH 8265 THEN UNDH 4705 THEN REAL_ARITH_TAC;
+  (* Fri Dec 31 12:28:22 EST 2004 *)
+
+  ]);;
+
+  (* }}} *)
+
+let unbounded_connect = prove_by_refinement(
+  `!E p q. FINITE E /\ E SUBSET edge /\ ~(p = q) /\
+    unbounded_set E p /\ unbounded_set E q ==>
+    (?C. C SUBSET unbounded_set E /\ simple_arc_end C p q)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `(?r. !s. r <= s  ==> (?C. simple_arc_end C p (point (s,&0)) /\ (C INTER UNIONS (curve_cell E) = {})))` SUBAGOAL_TAC;
+  ASM_MESON_TAC[unbounded_set_lemma];
+  TYPE_THEN `(?r. !s. r <= s  ==> (?C. simple_arc_end C q (point (s,&0)) /\ (C INTER UNIONS (curve_cell E) = {})))` SUBAGOAL_TAC;
+  ASM_MESON_TAC[unbounded_set_lemma];
+  TYPE_THEN `r'' = max_real r r'` ABBREV_TAC ;
+  TSPECH `r''` 4812;
+  TSPECH `r''` 3171;
+  THM_INTRO_TAC[`r`;`r'`] max_real_le;
+  UNDH 4459 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  UNDH 6887 THEN UNDH 2 THEN REAL_ARITH_TAC;
+  UNDH 5611 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  UNDH 7318 THEN UNDH 2 THEN REAL_ARITH_TAC;
+  THM_INTRO_TAC[`C`;`C'`;`p`;`point(r'',&0)`;`q`] simple_arc_end_subset_trans;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  TYPE_THEN `U` EXISTS_TAC;
+  (* - *)
+  THM_INTRO_TAC[`E`] unbounded_set_comp;
+  THM_INTRO_TAC[`E`;`x`] unbounded_set_comp_elt;
+  THM_INTRO_TAC[`E`;`x`;`p`] unbounded_comp_unique;
+  REWRITE_TAC[GSYM unbounded_set];
+  IMATCH_MP_TAC  rectagon_curve;
+  TYPE_THEN `q` EXISTS_TAC;
+  (* - *)
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  FULL_REWRITE_TAC[SUBSET;UNION];
+  FULL_REWRITE_TAC[EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* Fri Dec 31 16:38:36 EST 2004 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_arc_conn_complement = prove_by_refinement(
+  `!C p q. simple_arc top2 C /\ ~C p /\ ~C q /\
+       (euclid 2 p) /\ ~(p = q) /\
+   (euclid 2 q) ==> (?A. simple_arc_end A p q /\ (C INTER A = EMPTY))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`C`;`p`;`q`] euclid_scale_simple_arc_ver2;
+  REP_BASIC_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  KILLH 907 THEN KILLH 877 THEN KILLH 7802 THEN KILLH 6497 THEN KILLH 9726 THEN KILLH 3550 THEN KILLH 11;
+  (* - simple-arc-grid-properties *)
+  TYPE_THEN `!i. (?E. (i <| N) ==> (  E SUBSET edge /\  (B i INTER (unbounded_set E) = EMPTY) /\  conn2 E /\ E (h_edge (floor (a i 0),floor (a i 1))) /\ E (h_edge (floor (a (SUC i) 0),floor (a (SUC i) 1))) /\  (!y. UNIONS (curve_cell E) y ==> (?x. B i x /\ d_euclid x y < &4))))` SUBAGOAL_TAC;
+  RIGHT_TAC "E";
+  TSPECH `i` 4963;
+  USEH 9744 (MATCH_MP simple_arc_grid_properties);
+  TYPE_THEN `E` EXISTS_TAC;
+  LEFTH 3651 "E";
+  (* - conn2-sequence *)
+  THM_INTRO_TAC[`E`;`N-1`] conn2_sequence;
+  (* -A *)
+  TYPE_THEN `!i. (i <=| N- 1) ==> (i <| N)` SUBAGOAL_TAC;
+  UNDH 7562 THEN UNDH 6077 THEN ARITH_TAC;
+  TYPE_THEN `(!i. i <=| N- 1 ==> conn2 (E i))` SUBAGOAL_TAC;
+  TSPECH `i` 2188;
+  UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  REWRH 1437;
+  (* - *)
+  TYPE_THEN `!i. (i <= N-| 1) ==> (E i SUBSET edge)` SUBAGOAL_TAC;
+  TSPECH `i` 2188;
+  UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  REWRH 456;
+  (* - *)
+  TYPE_THEN `(!i. (SUC i <= N -| 1) ==> ~(E i INTER E (SUC i) = {}))` SUBAGOAL_TAC;
+  UNDH 6943 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `h_edge (floor (a (SUC i) 0), floor (a (SUC i) 1))` EXISTS_TAC;
+  CONJ_TAC;
+  TSPECH `i` 2188;
+  UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  UNDH 1989 THEN UNDH 7562 THEN ARITH_TAC;
+  TSPECH `SUC i` 2188;
+  UNDH 395 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  REWRH  7915 ;
+  (* -B *)
+  TYPE_THEN `(!i j.  i <| j /\ j <=| N -| 1 /\ ~(SUC i = j) ==> (curve_cell (E i) INTER curve_cell (E j) = {}))` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USEH 2591 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
+  TYPE_THEN `~(u = EMPTY)` SUBAGOAL_TAC THENL [IMATCH_MP_TAC  cell_nonempty ; ALL_TAC];
+  THM_INTRO_TAC[`E i`] curve_cell_cell;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC;
+  ASM_MESON_TAC[subset_imp];
+  USEH 1008 (REWRITE_RULE[EMPTY_EXISTS]);
+  (* -- *)
+  TYPE_THEN `euclid 2 u'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `u` EXISTS_TAC;
+  IMATCH_MP_TAC  cell_euclid;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `curve_cell (E j)` EXISTS_TAC;
+  IMATCH_MP_TAC  curve_cell_cell;
+  (* -- *)
+  TYPE_THEN `(?x. B i x /\ d_euclid x u' < &4)` SUBAGOAL_TAC;
+  TSPECH `i` 2188;
+  UNDH 7200 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[UNIONS];
+  UNIFY_EXISTS_TAC;
+  (* -- *)
+  TYPE_THEN `(?y. B j y /\ d_euclid y u' < &4)` SUBAGOAL_TAC;
+  TSPECH `j` 2188;
+  UNDH 7711 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[UNIONS];
+  UNIFY_EXISTS_TAC;
+  (* -- *)
+  UNDH 1512 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`x`;`y`]);
+  UNDH 5462 THEN UNDH 2236 THEN ARITH_TAC;
+  (* -- *)
+  TYPE_THEN `!k x. B k x /\ (k <| N) ==> euclid 2 x` SUBAGOAL_TAC;
+  UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`k`]);
+  USEH 120 (MATCH_MP   simple_arc_end_simple);
+  USEH 6892 (MATCH_MP simple_arc_euclid);
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `euclid 2 x /\ euclid 2 y` SUBAGOAL_TAC;
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
+  TYPE_THEN `i` EXISTS_TAC;
+  UNDH 2236 THEN UNDH 2835 THEN ARITH_TAC;
+  TYPE_THEN `j` EXISTS_TAC;
+  (* -- *)
+  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`u'`;`y`] metric_space_triangle;
+  TYPE_THEN `d_euclid x y <= &8` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`y`;`u'`] metric_space_symm;
+  UNDH 8326 THEN UNDH 204 THEN UNDH 2611 THEN UNDH 2778 THEN REAL_ARITH_TAC;
+  UNDH 6749 THEN UNDH 4559 THEN UNDH 6444 THEN REAL_ARITH_TAC;
+  REWRH 6286;
+  (* -C *)
+  TYPE_THEN `E' = UNIONS (IMAGE E {i | i <=| N -| 1})` ABBREV_TAC ;
+  TYPE_THEN `E' SUBSET edge` SUBAGOAL_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE;UNIONS;SUBSET];
+  TYPE_THEN `u` UNABBREV_TAC;
+  TSPECH `x'` 2188;
+  UNDH 1746 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `FINITE E'` SUBAGOAL_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  THM_INTRO_TAC[`IMAGE E {i | i <=| N -| 1}`] FINITE_FINITE_UNIONS;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  REWRITE_TAC[FINITE_NUMSEG_LE];
+  USEH 3282 (REWRITE_RULE[IMAGE]);
+  UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  FULL_REWRITE_TAC[conn2];
+  (* - *)
+  TYPE_THEN `C' INTER unbounded_set E' = EMPTY` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USEH 8327 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
+  USEH 3168 (REWRITE_RULE [UNIONS;IMAGE]);
+  TYPE_THEN `u'` UNABBREV_TAC;
+  TSPECH `x` 2188;
+  REP_BASIC_TAC;
+  USEH 2251 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPECH `u` 5859;
+  UNDH 5490 THEN ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  unbounded_avoidance_subset_ver2;
+  TYPE_THEN `E'` EXISTS_TAC;
+  TYPE_THEN `E'` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;UNIONS;IMAGE];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `x` EXISTS_TAC;
+  UNDH 5971 THEN ARITH_TAC;
+  (* -D *)
+  TYPE_THEN `unbounded_set E' p' /\ unbounded_set E' q'` ASM_CASES_TAC;
+  THM_INTRO_TAC[`E'`;`p'`;`q'`] unbounded_connect;
+  TSPECH `C` 7694;
+  USEH 8696 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
+  USEH 5828 (REWRITE_RULE[SUBSET]);
+  USEH 6174 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPECH `u` 5341;
+  TSPECH `u` 7291;
+  UNDH 362 THEN ASM_REWRITE_TAC[];
+  (* -E *)
+  TYPE_THEN `N = 1` ASM_CASES_TAC;
+  TYPE_THEN `N` UNABBREV_TAC;
+  FULL_REWRITE_TAC[ARITH_RULE `i <| 1 <=> (i = 0)`];
+  FULL_REWRITE_TAC[ARITH_RULE `i <= 1 -| 1 <=> (i = 0)`];
+  TSPECH `0` 6703;
+  TYPE_THEN `0 = 0` SUBAGOAL_TAC;
+  TYPE_THEN `{i | i = 0} = {0}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRH 327;
+  REWRH 627;
+  FULL_REWRITE_TAC[image_sing];
+  TYPE_THEN `E'` UNABBREV_TAC;
+  TYPE_THEN `C'` UNABBREV_TAC;
+  TSPECH `0` 4218;
+  UNDH 9174 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  (* -- *)
+  UNDH 5439 THEN REWRITE_TAC[];
+  TYPE_THEN `!p. (!x. B 0 x ==> &8 *d <= d_euclid x p) /\ (euclid 2 p) ==> unbounded_set (E 0) p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  unbounded_set_ball;
+  TYPE_THEN `x` EXISTS_TAC;
+  TYPE_THEN `&7* d` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  UNDH 5147 THEN REAL_ARITH_TAC;
+  (* --- *)
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;closed_ball];
+  SUBCONJ_TAC;
+  TSPECH `0` 6993;
+  UNDH 9405 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  USEH 4758 (MATCH_MP simple_arc_end_simple);
+  USEH 6872 (MATCH_MP simple_arc_euclid);
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `B 0` EXISTS_TAC;
+  SUBCONJ_TAC;
+  USEH 6028 (REWRITE_RULE[UNIONS]);
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `u` EXISTS_TAC;
+  IMATCH_MP_TAC  cell_euclid;
+  IMATCH_MP_TAC  edge_cell;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `E 0` EXISTS_TAC;
+  (* ---- *)
+  UNDH 7489 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `UNIONS (E 0)` EXISTS_TAC;
+  IMATCH_MP_TAC UNIONS_UNIONS;
+  REWRITE_TAC[SUBSET];
+  USEH 361 (REWRITE_RULE[SUBSET]);
+  ASM_SIMP_TAC[curve_cell_edge];
+  USEH 5290 (REWRITE_RULE[SUBSET;open_ball]);
+  TSPECH `x''` 19;
+  REP_BASIC_TAC;
+  (* ---- *)
+  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`x`;`x''`;`x'`] metric_space_triangle;
+  TYPE_THEN `d_euclid x x' <= d + &4` SUBAGOAL_TAC;
+  UNDH 8092 THEN UNDH 8809 THEN UNDH 9378 THEN REAL_ARITH_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `d + &4` EXISTS_TAC;
+  UNDH 5147 THEN REAL_ARITH_TAC;
+  (* --- *)
+  USEH 129 (REWRITE_RULE[closed_ball]);
+  TSPECH `x` 7711;
+  UNDH 6465 THEN UNDH 5617 THEN UNDH 5147 THEN REAL_ARITH_TAC;
+  (* -- *)
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
+  (* -F *)
+  TYPE_THEN `0 <| N -| 1` SUBAGOAL_TAC;
+  UNDH 426 THEN UNDH 7562 THEN ARITH_TAC;
+  REWRH 532;
+  UNDH 7535 THEN REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!p. (euclid 2 p) /\ (!i. (SUC i <= (N-1)) ==> (&8 * d <= d_euclid (a (SUC i)) p)) ==> (unbounded_set E' p)` BACK_TAC;
+  TYPE_THEN `!i. (SUC i <= (N-1)) ==> C' (a (SUC i))` SUBAGOAL_TAC;
+  REWRITE_TAC[UNIONS;IMAGE];
+  CONV_TAC (dropq_conv ("u"));
+  TYPE_THEN `i` EXISTS_TAC;
+  CONJ_TAC;
+  UNDH 1989 THEN ARITH_TAC;
+  TSPECH `i` 4963;
+  TYPE_THEN `i <| N` SUBAGOAL_TAC;
+  UNDH 1989 THEN ARITH_TAC;
+  USEH 9744 (MATCH_MP simple_arc_end_end2);
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC ) THEN REP_BASIC_TAC THEN ASM_MESON_TAC[];
+  (* - *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 8137 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
+  KILLH 6656 THEN KILLH 1512 THEN KILLH 7562 THEN KILLH 6444 THEN KILLH 7694 THEN KILLH 9229 THEN KILLH 2174 THEN KILLH 9099 THEN KILLH 3258 THEN KILLH 6487;
+  COPYH 2188;
+  UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`i`]);
+  UNDH 1989 THEN ARITH_TAC;
+  UNDH 2188 THEN DISCH_THEN (THM_INTRO_TAC[`SUC i`]);
+  KILLH 5053 THEN KILLH 8136 THEN KILLH 5388 THEN KILLH 6737;
+  (* -G *)
+  IMATCH_MP_TAC  unbounded_set_ball;
+  TYPE_THEN `a(SUC i)` EXISTS_TAC;
+  TYPE_THEN `&7 *d` EXISTS_TAC;
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LT_MUL;
+  UNDH 5147 THEN REAL_ARITH_TAC;
+  (* - *)
+  CONJ_TAC;
+  REWRITE_TAC[  FINITE_UNION];
+  FULL_REWRITE_TAC[conn2];
+  REWRITE_TAC[union_subset];
+  REWRITE_TAC[UNIONS_UNION;union_subset];
+  (* - *)
+  IMATCH_MP_TAC  (TAUT `a/\ b ==> b/\ a`);
+  CONJ_TAC;
+  USEH 9183 (REWRITE_RULE[closed_ball]);
+  UNDH 6641 THEN UNDH 3603 THEN UNDH 5147 THEN REAL_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `!i x. (i <| N) /\  (B i x) ==> euclid 2 x` SUBAGOAL_TAC;
+  UNDH 4963 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
+  USEH 9316 (MATCH_MP simple_arc_end_simple);
+  USEH 5604 (MATCH_MP simple_arc_euclid);
+  USEH 2996 (REWRITE_RULE[SUBSET]);
+  COPYH 3219;
+  TSPECH `i` 3219;
+  TSPECH `SUC i` 3219;
+  (* - *)
+  TYPE_THEN `(i <| N) /\ (SUC i <| N)` SUBAGOAL_TAC;
+  UNDH 1989 THEN ARITH_TAC;
+  REWRH 6689;
+  REWRH 5459;
+  (* - *)
+  TYPE_THEN `B i (a(SUC i))` SUBAGOAL_TAC;
+  TSPECH `i` 4963;
+  USEH 9744 (MATCH_MP simple_arc_end_end2);
+  (* - *)
+  TYPE_THEN `B (SUC i) (a (SUC i))` SUBAGOAL_TAC;
+  TSPECH `SUC i` 4963;
+  USEH 9147 (MATCH_MP simple_arc_end_end);
+  (* - *)
+  REWRITE_TAC[SUBSET;closed_ball];
+  TYPE_THEN `euclid 2 (a(SUC i))` SUBAGOAL_TAC;
+  (* - *)
+  TYPE_THEN `!i x y. (i <| N) /\ B i x /\ B i y /\ (euclid 2 x) /\ (euclid 2 y) ==> (d_euclid x y < &2 *d)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  BALL_DIST;
+  TYPE_THEN `euclid 2` EXISTS_TAC;
+  UNDH 4673 THEN DISCH_THEN (THM_INTRO_TAC[`i'`]);
+  TYPE_THEN `x'` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `B i'` EXISTS_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `B i'` EXISTS_TAC;
+  (* - *)
+  KILLH 3302 THEN KILLH 6317 THEN KILLH 4963 THEN KILLH 4847;
+  KILLH 4673 THEN KILLH 3226 THEN KILLH 9755 THEN KILLH 8762 THEN KILLH 6174;
+  KILLH 7802 THEN KILLH 3603 THEN KILLH 5957;
+  (* - *)
+  TYPE_THEN `(!x. (euclid 2 x) /\ (?y. (euclid 2 y) /\ (d_euclid y x < &4) /\ (d_euclid (a (SUC i)) y < &2 * d)) ==> (d_euclid (a (SUC i)) x <= &7 *d))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`euclid 2`;`d_euclid`;`a(SUC i)`;`y`;`x`] metric_space_triangle;
+  UNDH 8917 THEN UNDH 3588 THEN UNDH 1391 THEN UNDH 5147 THEN REAL_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `!G x. G SUBSET edge /\ UNIONS G x ==> (euclid 2 x /\ UNIONS (curve_cell G) x)` SUBAGOAL_TAC;
+  USEH 6599 (REWRITE_RULE[UNIONS]);
+  TYPE_THEN `edge u` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `G` EXISTS_TAC;
+  CONJ_TAC;
+  USEH 9350 (MATCH_MP edge_euclid2);
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `u` EXISTS_TAC;
+  REWRITE_TAC[UNIONS];
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_SIMP_TAC[curve_cell_edge];
+  (* -H *)
+  CONJ_TAC;
+  UNDH 6604 THEN DISCH_THEN (THM_INTRO_TAC[`E i`;`x`]);
+  UNDH 404 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `x'` EXISTS_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `i` EXISTS_TAC;
+  (* - *)
+  UNDH 6604 THEN DISCH_THEN (THM_INTRO_TAC[`E (SUC i)`;`x`]);
+  UNDH 9352 THEN DISCH_THEN (THM_INTRO_TAC[`x`]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `x'` EXISTS_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `SUC i` EXISTS_TAC;
+  (* Sat Jan  1 19:23:34 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let cut_arc =
+  jordan_def `cut_arc C v w = @B. simple_arc_end B v w /\ B SUBSET C`;;
+
+let cut_arc_symm = prove_by_refinement(
+  `!C v w. cut_arc C v w = cut_arc C w v`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cut_arc];
+  TYPE_THEN `!B. simple_arc_end B v w = simple_arc_end B w v` SUBAGOAL_TAC;
+  MESON_TAC[simple_arc_end_symm];
+  ]);;
+  (* }}} *)
+
+let cut_arc_simple = prove_by_refinement(
+  `!C v w. simple_arc top2 C /\  C v /\ C w /\ ~(v = w) ==>
+        simple_arc_end (cut_arc C v w) v w`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cut_arc];
+  SELECT_TAC;
+  ASM_MESON_TAC[simple_arc_end_select];
+  ]);;
+  (* }}} *)
+
+let cut_arc_subset = prove_by_refinement(
+  `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==>
+        cut_arc C v w SUBSET C`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cut_arc];
+  SELECT_TAC;
+  ASM_MESON_TAC[simple_arc_end_select];
+  ]);;
+  (* }}} *)
+
+let cut_arc_unique = prove_by_refinement(
+  `!C v w B. simple_arc top2 C /\ (B SUBSET C) /\ simple_arc_end B v w
+        ==> (cut_arc C v w = B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  simple_arc_end_inj;
+  TYPE_THEN `C` EXISTS_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  TYPE_THEN `w` EXISTS_TAC;
+  TYPE_THEN `~(v = w)` SUBAGOAL_TAC THENL[ (IMATCH_MP_TAC  simple_arc_end_distinct);ALL_TAC];
+  TYPE_THEN `B` EXISTS_TAC;
+  TYPE_THEN `C v` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `B` EXISTS_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  TYPE_THEN `w` EXISTS_TAC;
+  TYPE_THEN `C w` SUBAGOAL_TAC ;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `B` EXISTS_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  UNIFY_EXISTS_TAC;
+  ASM_MESON_TAC [cut_arc_subset;cut_arc_simple];
+  ]);;
+  (* }}} *)
+
+let cut_arc_inter = prove_by_refinement(
+  `!C u v w. simple_arc_end C v w /\ C u /\ ~(u = v) /\ ~(u = w) ==>
+     (cut_arc C v u INTER cut_arc C u w = {u}) /\
+     (cut_arc C v u UNION cut_arc C u w = C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`;`v`;`w`;`u`] simple_arc_end_cut;
+  TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
+  USEH 8829 (MATCH_MP simple_arc_end_simple);
+  TYPE_THEN `cut_arc C v u = C'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cut_arc_unique;
+  TYPE_THEN `C` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `cut_arc C u w = C''` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cut_arc_unique;
+  TYPE_THEN `C` UNABBREV_TAC;
+   REWRITE_TAC[SUBSET;UNION];
+  ASM_REWRITE_TAC[];
+  (* Sat Jan  1 19:57:51 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_closed_curve_euclid = prove_by_refinement(
+  `!C . simple_closed_curve top2 C ==> (C SUBSET euclid 2) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_closed_curve];
+  REWRITE_TAC[IMAGE;SUBSET];
+  TYPE_THEN `!u. &0 <= u /\ u < &1 ==> euclid 2 (f u)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[INJ;top2_unions];
+  FIRST_ASSUM  IMATCH_MP_TAC ;
+  USEH 5825 SYM ;
+  TYPE_THEN `x' = &1` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+ UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let open_real_interval = prove_by_refinement(
+  `!a b. top_of_metric (UNIV,d_real) {x | a < x /\ x < b}`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`b`] half_open;
+  THM_INTRO_TAC[`a`] half_open_above;
+  TYPE_THEN `{x | a < x /\ x < b} = {x | a < x} INTER {x | x < b}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER];
+  IMATCH_MP_TAC  top_inter;
+  IMATCH_MP_TAC  top_of_metric_top;
+  REWRITE_TAC[metric_real];
+  ]);;
+  (* }}} *)
+
+let simple_closed_curve_cut_unique = prove_by_refinement(
+  `!A A' A'' C v w. simple_closed_curve top2 C /\
+      simple_arc_end A v w /\
+      simple_arc_end A' v w /\
+      simple_arc_end A'' v w /\
+      ~(A' = A'') /\
+    (A SUBSET C ) /\ (A' SUBSET C) /\ (A'' SUBSET C) ==>
+      (A = A') \/ (A = A'')`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `C v /\ C w /\ ~(v = w)` SUBAGOAL_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `A'` EXISTS_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  TYPE_THEN`w` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `A'` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_UNION];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  TYPE_THEN `v` EXISTS_TAC;
+  USEH 4051  (MATCH_MP simple_arc_end_distinct);
+  UNDH 1472 THEN ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`C`;`v`] simple_closed_curve_pt;
+  TYPE_THEN `?t. (&0 < t /\ t < &1 /\ (f t = w))` SUBAGOAL_TAC ;
+  (*   KILLH 9405; *)
+  TYPE_THEN `C` UNABBREV_TAC ;
+  FULL_REWRITE_TAC[IMAGE];
+  TYPE_THEN `x` EXISTS_TAC;
+  TYPE_THEN `x = &0` ASM_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `x = &1` ASM_CASES_TAC;
+  ASM_MESON_TAC[];
+  UNDH 3483 THEN UNDH 9557 THEN UNDH 953 THEN UNDH 8032 THEN REAL_ARITH_TAC;
+  TYPE_THEN `w` UNABBREV_TAC;
+  TYPE_THEN `v` UNABBREV_TAC;
+  (* -A *)
+  (*   USEH 9405 SYM; // *)
+  FULL_REWRITE_TAC[top2_unions];
+  TYPE_THEN `simple_arc_end (IMAGE f {x | &0 <= x /\ x <= t}) (f (&0)) (f t)` SUBAGOAL_TAC;
+  USEH 5825 SYM;
+  IMATCH_MP_TAC  simple_arc_segment;
+  UNDH 6523 THEN REAL_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `simple_arc_end (IMAGE f {x | t <= x /\ x <= &1}) (f t) (f (&1))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_segment;
+  UNDH 2449 THEN REAL_ARITH_TAC;
+  USEH 5825 SYM;
+  REWRH 3167;
+  (* - *)
+  TYPE_THEN `!q. {x | q <= x /\ x <= q} = {q}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REAL_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `!x. &0 <= x /\ x <= &1 ==> euclid 2 (f x)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  USEH 5674 SYM;
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  (* - *)
+  TYPE_THEN `! r s. &0 <= r /\ s <= &1 /\ r < s  ==>  (?U. top2 U /\ (IMAGE f {x | r < x /\ x < s} = U INTER C))` SUBAGOAL_TAC;
+  TYPE_THEN `closed_ top2 (IMAGE f {x | &0 <= x /\ x <= r})` SUBAGOAL_TAC;
+  TYPE_THEN `r = &0` ASM_CASES_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[image_sing];
+  IMATCH_MP_TAC  closed_point;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  simple_arc_end_closed;
+  TYPE_THEN  `f( &0)` EXISTS_TAC;
+  TYPE_THEN `f (r)` EXISTS_TAC;
+  IMATCH_MP_TAC  simple_arc_segment;
+  UNDH 5145 THEN UNDH 147 THEN UNDH 7080 THEN UNDH 1908 THEN REAL_ARITH_TAC;
+  TYPE_THEN `closed_ top2 (IMAGE f {x | s <= x /\ x <= &1})` SUBAGOAL_TAC;
+  TYPE_THEN `s = &1` ASM_CASES_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[image_sing];
+  IMATCH_MP_TAC  closed_point;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  simple_arc_end_closed;
+  TYPE_THEN  `f(s)` EXISTS_TAC;
+  USEH 1826 SYM;
+  TYPE_THEN `f (&1)` EXISTS_TAC;
+  IMATCH_MP_TAC  simple_arc_segment;
+  UNDH 2144 THEN UNDH 147 THEN UNDH 7080 THEN UNDH 1908 THEN REAL_ARITH_TAC;
+  TYPE_THEN `closed_ top2 ((IMAGE f {x | &0 <= x /\ x <= r}) UNION (IMAGE f {x | s <= x /\ x <= &1}))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  closed_union;
+  REWRITE_TAC[top2_top];
+  USEH 9076 (MATCH_MP closed_open);
+  FULL_REWRITE_TAC[open_DEF;top2_unions ];
+  TYPE_THEN `(euclid 2 DIFF   (IMAGE f {x | &0 <= x /\ x <= r} UNION  IMAGE f {x | s <= x /\ x <= &1}))` EXISTS_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IMAGE;DIFF;UNION;INTER];
+  NAME_CONFLICT_TAC;
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  REWRITE_TAC[DE_MORGAN_THM;CONJ_ACI];
+  TYPE_THEN `&0 <= x' /\ x' <= &1` SUBAGOAL_TAC;
+  UNDH 507 THEN UNDH 3413 THEN UNDH 1908 THEN UNDH 147 THEN REAL_ARITH_TAC;
+  CONJ_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  CONJ_TAC;
+  USEH 2422 (REWRITE_RULE[INJ]);
+  TYPE_THEN `x'' = &1` ASM_CASES_TAC;
+  TYPE_THEN `x' = &0` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UNDH 507 THEN UNDH 1908 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  UNDH 8462 THEN UNDH 147 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x' = x''` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 5595 THEN UNDH 8732 THEN UNDH 9674 THEN UNDH 507 THEN UNDH 9329 THEN UNDH 1908 THEN REAL_ARITH_TAC ;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  UNDH 507 THEN UNDH 1162 THEN REAL_ARITH_TAC;
+  (* --- *)
+  TYPE_THEN `x' = x''` SUBAGOAL_TAC;
+  USEH 2422 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 8691 THEN UNDH 7080 THEN UNDH 1908 THEN UNDH 507 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  UNDH 3283 THEN UNDH 3413 THEN REAL_ARITH_TAC;
+  (* -- *)
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  TYPE_THEN `x'` EXISTS_TAC;
+  LEFTH  7656 "x'";
+  TSPECH `x'` 4068;
+  TYPE_THEN `x` UNABBREV_TAC;
+  LEFTH 5373 "x''";
+  TSPECH `x'` 1785;
+  UNDH 1589 THEN UNDH 4223 THEN REWRITE_TAC[] THEN UNDH 3324 THEN UNDH 9329 THEN REAL_ARITH_TAC;
+  (* -B *)
+  COPYH 7922;
+  UNDH 7922 THEN DISCH_THEN (THM_INTRO_TAC[`&0`;`t`]);
+  UNDH 6523 THEN REAL_ARITH_TAC;
+  UNDH 7922 THEN DISCH_THEN (THM_INTRO_TAC[`t`;`&1`]);
+  UNDH 2449 THEN REAL_ARITH_TAC;
+  (* - *)
+  USEH 5674 SYM;
+  TYPE_THEN `U INTER U' INTER C = EMPTY` SUBAGOAL_TAC;
+  TYPE_THEN `U INTER U' INTER C = (U INTER C) INTER (U' INTER C)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER] THEN MESON_TAC[];
+  TYPE_THEN `U INTER C` UNABBREV_TAC;
+  TYPE_THEN `U' INTER C` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  USEH 6182 (REWRITE_RULE[IMAGE;INTER;EMPTY_EXISTS]);
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `x = x'` SUBAGOAL_TAC;
+  USEH 2422 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 4410 THEN UNDH 8119 THEN UNDH 6523 THEN UNDH 5777 THEN UNDH 2449 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  UNDH 4480 THEN UNDH 8119 THEN REAL_ARITH_TAC;
+  (* -C *)
+  TYPE_THEN `UNIONS (top_of_metric (UNIV,d_real)) = UNIV` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM top_of_metric_unions);
+  REWRITE_TAC[metric_real];
+  THM_INTRO_TAC[`&0`;`&1`] connect_real_open;
+  THM_INTRO_TAC[`&0`;`&1`] open_real_interval;
+  TYPE_THEN `!B.  simple_arc_end B (f (&0)) (f t) /\ B SUBSET C ==> (B = IMAGE f {x | &0 <= x /\ x <= t}) \/ (B = IMAGE f {x | t <= x /\ x <= &1})` SUBAGOAL_TAC;
+  COPYH 3089;
+    USEH 3089 (REWRITE_RULE[simple_arc_end]);
+  USEH 3272 (REWRITE_RULE[continuous;preimage]);
+  REWRH 1293;
+  TYPE_THEN `!v. top2 v ==> top_of_metric(UNIV,d_real) {x | &0 < x /\ x < &1 /\ v (f' x)}` SUBAGOAL_TAC;
+  TYPE_THEN `{x | &0 < x /\ x < &1 /\ v' (f' x)} = {x | &0 < x /\ x < &1 } INTER {x | v' (f' x)}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER];
+  MESON_TAC[];
+  IMATCH_MP_TAC top_inter;
+  IMATCH_MP_TAC  top_of_metric_top;
+  REWRITE_TAC[metric_real];
+  COPYH 7847;
+  TSPECH `U` 7847;
+  TSPECH `U'`7847;
+  FULL_REWRITE_TAC[connected];
+  UNDH 868 THEN DISCH_THEN (THM_INTRO_TAC[`{x | &0 < x /\ x < &1 /\ U (f' x)}`;`{x | &0 < x /\ x < &1 /\ U' (f' x)}`]);
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  USEH 228 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
+  TYPE_THEN `C (f' u)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `B` EXISTS_TAC;
+  IMATCH_MP_TAC  image_imp;
+  UNDH 5411 THEN UNDH 7814 THEN REAL_ARITH_TAC;
+  USEH 161 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  TSPECH `f' u` 3418;
+  UNDH 1284 THEN ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET;UNION];
+  TYPE_THEN `C (f' x)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `B` EXISTS_TAC;
+  IMATCH_MP_TAC  image_imp;
+  UNDH 4410 THEN UNDH 2236 THEN REAL_ARITH_TAC ;
+  USEH 3773 SYM;
+  REWRH 5090;
+  USEH 8548 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `~(x' = &0)` SUBAGOAL_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `f(&0)` UNABBREV_TAC;
+  TYPE_THEN `f(&1)` UNABBREV_TAC;
+  TYPE_THEN `x = &0` SUBAGOAL_TAC;
+  USEH 5798 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  UNDH 869 THEN REAL_ARITH_TAC;
+  TYPE_THEN `~(x' = &1)` SUBAGOAL_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `f(&0)` UNABBREV_TAC;
+  TYPE_THEN `f(&1)` UNABBREV_TAC;
+  TYPE_THEN `x = &0` SUBAGOAL_TAC;
+  USEH 5798 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  UNDH 869 THEN REAL_ARITH_TAC;
+  TYPE_THEN `~(x' = t)` SUBAGOAL_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `f(&0)` UNABBREV_TAC;
+  TYPE_THEN `f(&1)` UNABBREV_TAC;
+  TYPE_THEN `f t` UNABBREV_TAC;
+  TYPE_THEN `x = &1` SUBAGOAL_TAC;
+  USEH 5798 (REWRITE_RULE[INJ]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 2236 THEN UNDH 4410 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  UNDH 6586 THEN REAL_ARITH_TAC;
+  (* --- *)
+  TYPE_THEN `x' < t` ASM_CASES_TAC;
+  DISJ1_TAC;
+  USEH 9545 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPECH `f x'` 4001;
+  USEH 4175 (REWRITE_RULE[INTER]);
+  USEH 4860 (MATCH_MP (TAUT `(a <=> b /\ c) ==> (a ==> b)`));
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  UNDH 2455 THEN UNDH 9329 THEN REAL_ARITH_TAC;
+  DISJ2_TAC;
+  USEH 6150 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPECH `f x'` 7907;
+  USEH 1343 (REWRITE_RULE[INTER]);
+  USEH 5291 (MATCH_MP (TAUT `(a <=> b /\ c) ==> (a ==> b)`));
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  UNDH 9585 THEN UNDH 7068 THEN UNDH 6268 THEN UNDH 3324 THEN REAL_ARITH_TAC;
+  (* --D *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  DISJ1_TAC;
+  IMATCH_MP_TAC  simple_arc_end_inj;
+  TYPE_THEN `IMAGE f {x | &0 <= x /\ x <= t}` EXISTS_TAC;
+  TYPE_THEN `f (&0)` EXISTS_TAC;
+  TYPE_THEN `f (t)` EXISTS_TAC;
+  CONJ_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  CONJ_TAC;
+  USEH 4679 (MATCH_MP simple_arc_end_simple);
+  REWRITE_TAC[SUBSET_REFL];
+  REWRITE_TAC[SUBSET;IMAGE];
+  (* --- *)
+  TYPE_THEN `x' = &0` ASM_CASES_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `&0` EXISTS_TAC;
+  UNDH 2449 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x' = &1` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `t` EXISTS_TAC;
+  UNDH 2449 THEN REAL_ARITH_TAC;
+  USEH 8833 (REWRITE_RULE[SUBSET]);
+  UNDH 5386 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  UNDH 6268 THEN UNDH 2455 THEN UNDH 9329 THEN UNDH 3324 THEN REAL_ARITH_TAC;
+  TYPE_THEN `C (f' x')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `B` EXISTS_TAC;
+  IMATCH_MP_TAC  image_imp;
+(*** Removed by JRH --- not quite sure why this changed
+  UNDH 7473 THEN UNDH 5707 THEN UNDH 6268 THEN  UNDH 2455 THEN REAL_ARITH_TAC;
+ ***)
+  USEH 9545 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPECH `(f' x')` 4001;
+  USEH 3320 (REWRITE_RULE[INTER;IMAGE]);
+  REWRH 7476;
+  TYPE_THEN `x''` EXISTS_TAC;
+  UNDH 4332 THEN UNDH 4962 THEN REAL_ARITH_TAC;
+  (* --E *)
+  DISJ2_TAC;
+  IMATCH_MP_TAC  simple_arc_end_inj;
+  TYPE_THEN `IMAGE f {x | t <= x /\ x <= &1}` EXISTS_TAC;
+  TYPE_THEN `f t` EXISTS_TAC;
+  TYPE_THEN `f (&1)` EXISTS_TAC;
+  USEH 1826 SYM;
+  CONJ_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  USEH 9241 (MATCH_MP simple_arc_end_simple);
+  REWRITE_TAC[SUBSET_REFL];
+  REWRITE_TAC[SUBSET;IMAGE];
+  (* --- *)
+  TYPE_THEN `x' = &0` ASM_CASES_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `&1` EXISTS_TAC;
+  UNDH 6523 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x' = &1` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `t` EXISTS_TAC;
+  UNDH 6523 THEN REAL_ARITH_TAC;
+  TYPE_THEN `&0 < x' /\ x' < &1` SUBAGOAL_TAC;
+  UNDH 9329 THEN UNDH 2455 THEN UNDH 3324 THEN UNDH 6268 THEN REAL_ARITH_TAC;
+  USEH 1419 (REWRITE_RULE[SUBSET]);
+  UNDH 7111 THEN DISCH_THEN (THM_INTRO_TAC[`x'`]);
+  TYPE_THEN `C (f' x')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `B` EXISTS_TAC;
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  USEH 6150 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPECH `(f' x')` 7907;
+  USEH 1445 (REWRITE_RULE[INTER;IMAGE]);
+  REWRH 6223;
+  TYPE_THEN `x''` EXISTS_TAC;
+  UNDH 4402 THEN UNDH 8966 THEN REAL_ARITH_TAC;
+  (* -F *)
+  TYPE_THEN `X = IMAGE f {x | &0 <= x /\ x <= t}` ABBREV_TAC ;
+  TYPE_THEN `Y = IMAGE f {x | t <= x /\ x <= &1}` ABBREV_TAC ;
+  TYPE_THEN `a = f(&0)` ABBREV_TAC ;
+  TYPE_THEN `b = f t` ABBREV_TAC ;
+  TYPE_THEN `f t` UNABBREV_TAC;
+  TYPE_THEN `f (&0)` UNABBREV_TAC;
+  TYPE_THEN `f (&1)` UNABBREV_TAC;
+  UNDH 7556 THEN UNDH 7601 THEN UNDH 9279 THEN UNDH 3395 THEN UNDH 1702 THEN UNDH 2817 THEN UNDH 7605 THEN UNDH 1063 THEN POP_ASSUM_LIST (fun t-> ALL_TAC);
+  TYPE_THEN `(A = X) \/ (A = Y)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `(A' = X) \/ (A' = Y)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `(A'' = X) \/ (A'' = Y)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  FIRST_ASSUM DISJ_CASES_TAC THEN FIRST_ASSUM DISJ_CASES_TAC THEN ASM_MESON_TAC[];
+  (* Sun Jan  2 11:55:31 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let infinite_closed_interval = prove_by_refinement(
+  `!a b. a < b ==> INFINITE {x | a <= x /\ x <= b}`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `?r s. a < r /\ r < s /\ s < b` SUBAGOAL_TAC;
+  TYPE_THEN `(&2*a + b)/ &3` EXISTS_TAC;
+  TYPE_THEN `(a + &2*b)/ &3` EXISTS_TAC;
+  ASSUME_TAC (REAL_ARITH `&0 < &3 /\ ~(&3 = &0)`);
+  ASM_SIMP_TAC[REAL_LT_RDIV_EQ;REAL_LT_LDIV_EQ;REAL_DIV_RMUL];
+  UNDH 4394 THEN REAL_ARITH_TAC;
+  IMATCH_MP_TAC  infinite_subset;
+  TYPE_THEN `{x | r < x /\ x < s}` EXISTS_TAC ;
+  CONJ_TAC;
+  ASM_SIMP_TAC[infinite_interval];
+  REWRITE_TAC[SUBSET];
+  UNDH 2351 THEN UNDH 2116 THEN UNDH 5157 THEN UNDH 4011 THEN REAL_ARITH_TAC;
+  (* Sun Jan  2 12:21:29 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let infinite_image = prove_by_refinement(
+  `!(f:A->B) X. INFINITE X /\ INJ f X UNIV ==> INFINITE (IMAGE f X)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INJ;INFINITE];
+  THM_INTRO_TAC[`f`;`IMAGE f X`;`X`] FINITE_IMAGE_INJ_GENERAL;
+  ASM_REWRITE_TAC[];
+  UNDH 3229 THEN REWRITE_TAC[];
+  TYPE_THEN `{x | x IN X /\ f x IN IMAGE f X} = X` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  ASM_MESON_TAC[image_imp];
+  REWRH 2588;
+  ]);;
+  (* }}} *)
+
+let simple_arc_infinite = prove_by_refinement(
+  `!C. simple_arc top2 C ==> INFINITE C`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc];
+  IMATCH_MP_TAC  infinite_image;
+  CONJ_TAC;
+  IMATCH_MP_TAC  infinite_closed_interval;
+  FULL_REWRITE_TAC[INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ]);;
+  (* }}} *)
+
+let simple_closed_curve_cut_unique_inter = prove_by_refinement(
+  `!A A' A'' C v w. simple_closed_curve top2 C /\
+      simple_arc_end A v w /\
+      simple_arc_end A' v w /\
+      simple_arc_end A'' v w /\
+      (A' INTER A'' = {v,w})  /\
+    (A SUBSET C ) /\ (A' SUBSET C) /\ (A'' SUBSET C) ==>
+      (A = A') \/ (A = A'')`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  simple_closed_curve_cut_unique;
+  TYPE_THEN `C` EXISTS_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  TYPE_THEN `w` EXISTS_TAC;
+  DISCH_TAC;
+  TYPE_THEN `A''` UNABBREV_TAC;
+  FULL_REWRITE_TAC [INTER_ACI];
+  TYPE_THEN `A'` UNABBREV_TAC;
+  USEH 2648 (MATCH_MP simple_arc_end_simple);
+  USEH 9214 (MATCH_MP simple_arc_infinite);
+  FULL_REWRITE_TAC[INFINITE];
+  UNDH 8436 THEN ASM_REWRITE_TAC[];
+  REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
+  (* Sun Jan  2 12:47:35 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_access = prove_by_refinement(
+  `!A C v w x p. simple_closed_curve top2 C /\
+      simple_arc_end A v w /\
+      A SUBSET C /\
+      A x /\ ~(x = v) /\ ~(x = w) /\
+      (euclid 2 p) /\
+      ~C p /\
+      (?q. ~( p = q) /\ ~(C q) /\ (euclid 2 q) /\
+         (!B. simple_arc_end B p q ==> ~(B INTER C = EMPTY)))   ==>
+    (?E.
+        simple_arc_end E p x /\
+        E INTER C SUBSET A /\
+      (!e. E e /\ ~C e /\ ~(p = e) ==> (cut_arc E p e INTER C = EMPTY)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `C v /\ C w /\ ~(v = w)` SUBAGOAL_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `A` EXISTS_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  TYPE_THEN`w` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `A` EXISTS_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  TYPE_THEN `v` EXISTS_TAC;
+  USEH 9236  (MATCH_MP simple_arc_end_distinct);
+  UNDH 1472 THEN ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`C`;`v`;`w`] simple_closed_cut;
+  (* - *)
+  TYPE_THEN `?B. (A UNION B = C) /\ (A INTER B = {v,w}) /\ (simple_arc_end B v w)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`A`;`C'`;`C''`;`C`;`v`;`w`] simple_closed_curve_cut_unique_inter;
+  TYPE_THEN `C` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  (* -- *)
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  TYPE_THEN `C'` UNABBREV_TAC;
+  TYPE_THEN `C''` EXISTS_TAC;
+  TYPE_THEN `C''` UNABBREV_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  FULL_REWRITE_TAC[INTER_ACI;UNION_ACI];
+  KILLH 6724 THEN KILLH 906 THEN KILLH 4244 THEN KILLH 3747;
+  (* -A *)
+  THM_INTRO_TAC[`B`;`p`;`q`] simple_arc_conn_complement;
+  USEH 2164 (MATCH_MP simple_arc_end_simple);
+  TYPE_THEN `B SUBSET C` SUBAGOAL_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;UNION];
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  THM_INTRO_TAC[`A'`;`{p}`;`A`] simple_arc_end_restriction;
+  CONJ_TAC;
+  USEH 384 (MATCH_MP   simple_arc_end_simple);
+  CONJ_TAC;
+  USEH 384 (MATCH_MP simple_arc_end_end_closed);
+  CONJ_TAC;
+  USEH 9236 (MATCH_MP simple_arc_end_closed);
+  CONJ_TAC;
+  REWRITE_TAC[EQ_EMPTY];
+  FULL_REWRITE_TAC[INTER;INR IN_SING];
+  TYPE_THEN `x'` UNABBREV_TAC;
+  ASM_MESON_TAC[subset_imp];
+  REWRITE_TAC[EMPTY_EXISTS;INTER];
+  CONJ_TAC;
+  CONV_TAC (dropq_conv "u");
+  USEH 384 (MATCH_MP simple_arc_end_end);
+  TSPECH `A'` 1640;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `u` EXISTS_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  FULL_REWRITE_TAC[UNION];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[EQ_EMPTY];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `v' = p` SUBAGOAL_TAC;
+  USEH 6335 (REWRITE_RULE[INR eq_sing;INTER;INR IN_SING ]);
+  TYPE_THEN `v'` UNABBREV_TAC;
+  (* -B *)
+  TYPE_THEN `x = v''` ASM_CASES_TAC ;
+  TYPE_THEN `v''` UNABBREV_TAC;
+  TYPE_THEN `C'` EXISTS_TAC;
+  SUBCONJ_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  REWRITE_TAC[INTER;UNION;SUBSET];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[INTER;EQ_EMPTY;SUBSET ];
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `~(e = x)` SUBAGOAL_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  UNDH 3668 THEN REWRITE_TAC[] ;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `A` EXISTS_TAC;
+  THM_INTRO_TAC[`C'`;`e`;`p`;`x`] cut_arc_inter;
+  (* -- *)
+  PROOF_BY_CONTR_TAC;
+  THM_INTRO_TAC[`C'`;`p`;`e`] cut_arc_subset;
+  CONJ_TAC;
+  USEH 8530 (MATCH_MP simple_arc_end_simple);
+  USEH 8530 (MATCH_MP simple_arc_end_end);
+  FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
+  FULL_REWRITE_TAC[SUBSET;INR eq_sing ;INR IN_SING;];
+  THM_INTRO_TAC[`C'`;`e`;`x`] cut_arc_simple;
+  USEH 8530 (MATCH_MP simple_arc_end_simple);
+  USEH 5502 (MATCH_MP simple_arc_end_end2);
+  ASM_MESON_TAC[];
+  (* -C *)
+  TYPE_THEN `cutvx = cut_arc A v'' x` ABBREV_TAC ;
+  TYPE_THEN `E = C' UNION cutvx` ABBREV_TAC ;
+  TYPE_THEN `E` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `simple_arc top2 A` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `A v'' ` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[INTER;INR eq_sing; INR IN_SING];
+  THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_simple;
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC ;
+  IMATCH_MP_TAC  simple_arc_end_trans;
+  TYPE_THEN `v''` EXISTS_TAC;
+  TYPE_THEN `cutvx` UNABBREV_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  USEH 6508 SYM;
+  REWRITE_TAC[INTER;SUBSET];
+  THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_subset;
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  REWRITE_TAC[SUBSET;INTER;INR IN_SING];
+  FULL_REWRITE_TAC[INTER;INR IN_SING;INR eq_sing];
+  USEH 4778 (MATCH_MP simple_arc_end_end);
+  (* -D *)
+  SUBCONJ_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `cutvx` UNABBREV_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;INTER;UNION];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  KILLH 4866;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  FULL_REWRITE_TAC[SUBSET;EQ_EMPTY;INTER;];
+  ASM_MESON_TAC[];
+  THM_INTRO_TAC[`A`;`v''`;`x`] cut_arc_subset;
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  (* -E *)
+  TYPE_THEN `simple_arc top2 E` SUBAGOAL_TAC;
+  USEH 9538 (MATCH_MP simple_arc_end_simple);
+  TYPE_THEN `C' p /\ C' e`  SUBAGOAL_TAC;
+  CONJ_TAC;
+  FULL_REWRITE_TAC[INTER;INR eq_sing;INR IN_SING];
+  TYPE_THEN `E` UNABBREV_TAC;
+  USEH 3684 (REWRITE_RULE[UNION]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `cutvx SUBSET C` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `cutvx` UNABBREV_TAC;
+  IMATCH_MP_TAC  cut_arc_subset;
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  TYPE_THEN `cut_arc E p e = cut_arc C' p e` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cut_arc_unique;
+  TYPE_THEN `E` UNABBREV_TAC;
+  CONJ_TAC;
+  TYPE_THEN `cut_arc C' p e SUBSET C'` BACK_TAC;
+  UNDH 7958 THEN REWRITE_TAC[SUBSET;UNION];
+  IMATCH_MP_TAC  cut_arc_subset;
+  USEH 2528 (MATCH_MP simple_arc_end_simple);
+  IMATCH_MP_TAC  cut_arc_simple;
+  USEH 2528 (MATCH_MP simple_arc_end_simple);
+  (* - *)
+  TYPE_THEN `~(e = v'')` SUBAGOAL_TAC;
+  UNDH 5697 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `C` UNABBREV_TAC;
+  REWRITE_TAC[UNION];
+  THM_INTRO_TAC[`C'`;`e`;`p`;`v''`] cut_arc_inter;
+  (* - *)
+  TYPE_THEN `C' INTER C = {v''}` SUBAGOAL_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  REWRITE_TAC[eq_sing;INR IN_SING ;INTER;UNION;];
+  USEH 2528 (MATCH_MP simple_arc_end_end2);
+  REP_BASIC_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC ;
+  USEH 6508 (REWRITE_RULE[INTER;INR eq_sing;INR IN_SING]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USEH 7813 (REWRITE_RULE[SUBSET]);
+  USEH 4523 (REWRITE_RULE[EQ_EMPTY;INTER;]);
+  ASM_MESON_TAC[];
+  (* -F *)
+  TYPE_THEN `C' v''` SUBAGOAL_TAC;
+  USEH 2528 (MATCH_MP simple_arc_end_end2);
+  TYPE_THEN `~cut_arc C' p e v''` SUBAGOAL_TAC;
+  USEH 8060 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  UNDH 2267 THEN DISCH_THEN (THM_INTRO_TAC[`v''`]);
+  THM_INTRO_TAC[`C'`;`e`;`v''`] cut_arc_simple;
+  USEH 2528 (MATCH_MP   simple_arc_end_simple);
+  USEH 1175 (MATCH_MP simple_arc_end_end2);
+  UNDH 1069 THEN ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USEH 7182 (REWRITE_RULE [EMPTY_EXISTS;INTER]);
+  USEH 3774 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  TYPE_THEN `u = v''` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `cut_arc C' p e SUBSET C'` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cut_arc_subset;
+  USEH 2528 (MATCH_MP simple_arc_end_simple);
+  IMATCH_MP_TAC  subset_imp;
+  UNIFY_EXISTS_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  UNDH 9484 THEN ASM_REWRITE_TAC[];
+  (* Sun Jan  2 14:55:11 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION BB *)
+(* ------------------------------------------------------------------ *)
+
+
+(* show that a Jordan curve has no more than 2 components *)
+
+let jordan_curve_seg3 = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==>
+     (?s.  (!(i:three_t). (s i SUBSET C) /\ (simple_arc top2 (s i))) /\
+          (!i j. ~(s i INTER s j = EMPTY) ==> (i = j)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_closed_curve];
+  TYPE_THEN `s = (\ i. IMAGE f {x | ((&2 * &(REP3 i) + &1)/ &8) <= x /\ x <= ((&2 * &(REP3 i) + &2)/ &8) } )` ABBREV_TAC ;
+  TYPE_THEN `s` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `&0 < &8 /\ ~(&8 = &0)` SUBAGOAL_TAC;
+  REAL_ARITH_TAC;
+  TYPE_THEN `!i. &0 <= (&2 * &(REP3 i) + &1) / &8` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LE_DIV;
+  REDUCE_TAC;
+  TYPE_THEN `!i. (&2 * &(REP3 i) + &2) / &8 <= &1` SUBAGOAL_TAC;
+  ASM_SIMP_TAC[REAL_LE_LDIV_EQ];
+  REDUCE_TAC;
+  THM_INTRO_TAC[`i`] rep3_lt;
+  UNDH 1618 THEN ARITH_TAC;
+  (* - *)
+  CONJ_TAC;
+  CONJ_TAC;
+  TYPE_THEN `s` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;IMAGE];
+  TYPE_THEN `x'` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  UNIFY_EXISTS_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  UNIFY_EXISTS_TAC;
+  (* -- *)
+  TYPE_THEN `s` UNABBREV_TAC ;
+  THM_INTRO_TAC[`f`;`(&2 * &(REP3 i) + &1) / &8 `;`(&2 * &(REP3 i) + &2) / &8`] simple_arc_segment;
+  FULL_REWRITE_TAC[top2_unions];
+  CONJ_TAC;
+ ASM_SIMP_TAC[real_div_denom_lt];
+  REDUCE_TAC;
+  ARITH_TAC;
+  DISJ1_TAC;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  REDUCE_TAC;
+  ARITH_TAC;
+  USEH 6148 (MATCH_MP simple_arc_end_simple);
+  (* -A *)
+  TYPE_THEN `!i j. (REP3 i < REP3 j) ==> (s i INTER s j = EMPTY)` BACK_TAC ;
+  TYPE_THEN `(REP3 i = REP3 j) \/ (REP3 j <| REP3 i) \/ (REP3 i < REP3 j)` SUBAGOAL_TAC;
+  ARITH_TAC;
+  UNDH 2249 THEN REP_CASES_TAC;
+  REWRITE_TAC[three_t_eq];
+  UNDH 6857 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`]);
+  FULL_REWRITE_TAC[INTER_COMM];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* - *)
+  PROOF_BY_CONTR_TAC;
+  KILLH 1348;
+  FULL_REWRITE_TAC[INTER;EMPTY_EXISTS];
+  TYPE_THEN `s` UNABBREV_TAC;
+  USEH 4729 (REWRITE_RULE[IMAGE]);
+  USEH 9244 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `u` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `x = x'` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `!i. (&2 * &(REP3 i) + &2) / (&8) < &1`SUBAGOAL_TAC;
+  UNDH 7394 THEN SIMP_TAC[REAL_LT_LDIV_EQ];
+  REDUCE_TAC;
+  THM_INTRO_TAC[`i`] rep3_lt;
+  UNDH 1618 THEN ARITH_TAC;
+  TYPE_THEN `&0 <= x /\ &0 <= x'` SUBAGOAL_TAC;
+  ASM_MESON_TAC[REAL_LE_TRANS];
+  CONJ_TAC THEN IMATCH_MP_TAC  REAL_LET_TRANS THEN UNIFY_EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `(&2 * &(REP3 j') + &1) / &8 <= (&2 * &(REP3 i') + &2)/ &8` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS THEN UNIFY_EXISTS_TAC;
+  (* - *)
+  USEH 8118 (MATCH_MP (REAL_ARITH `x <= y ==> ~(y < x)`));
+  UNDH 4580 THEN REWRITE_TAC[];
+  ASM_SIMP_TAC[REAL_LT_RDIV];
+  REDUCE_TAC;
+  UNDH 4372 THEN ARITH_TAC;
+  (* Sun Jan  2 20:07:58 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let abs3_distinct = prove_by_refinement(
+  `~(ABS3 0 = ABS3 1) /\ ~(ABS3 0 = ABS3 2) /\ ~(ABS3 1 = ABS3 2)`,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `!i j. ~(REP3 (ABS3 i) = REP3(ABS3 j))==> ~(ABS3 i = ABS3 j)` SUBAGOAL_TAC;
+  TYPE_THEN `ABS3 i` UNABBREV_TAC;
+  REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC  THEN ASM_REWRITE_TAC[ABS3_012] THEN ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let three_t_enum = prove_by_refinement(
+  `!(a:A) b c. ?(f:three_t ->A). (f(ABS3 0) = a) /\
+         (f(ABS3 1) = b) /\ (f(ABS3 2) = c)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `f = (\ i. (if (i = ABS3 0) then a else (if (i = ABS3 1) then b else c)))` ABBREV_TAC ;
+  TYPE_THEN `f` EXISTS_TAC;
+  TYPE_THEN `f` UNABBREV_TAC;
+  REWRITE_TAC[abs3_distinct];
+  ]);;
+  (* }}} *)
+
+let three_t_univ = prove_by_refinement(
+  `!P. P (ABS3 0) /\ P(ABS3 1) /\ P(ABS3 2) ==> (!i. P i)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`i`] ABS3_onto;
+  TYPE_THEN `(j = 0) \/ (j = 1) \/ (j = 2)` SUBAGOAL_TAC;
+  UNDH 4616 THEN ARITH_TAC;
+ UNDH 2783 THEN REP_CASES_TAC  THEN (TYPE_THEN `j` UNABBREV_TAC);
+  ]);;
+  (* }}} *)
+
+let simple_arc_sep_three_t = prove_by_refinement(
+  `!C x p.
+      (!(i:three_t). simple_arc_end (C i) x (p i)) /\
+      (!i j. (C i) (p j) ==> (i = j)) ==>
+   (?C' x.
+      (!i. simple_arc_end (C' i) x (p i)) /\
+      (!i j. ~(i = j) ==> (C' i INTER C' j = {x})) /\
+      (!A. (!i. (C i) SUBSET A) ==> (!i. (C' i) SUBSET A)))  `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `A = C(ABS3 0) UNION C(ABS3 1) UNION C(ABS3 2)` ABBREV_TAC ;
+  THM_INTRO_TAC[`A`;`C(ABS3 0)`;`C(ABS3 1)`;`C(ABS3 2)`;`x`;`p(ABS3 0)`;`p(ABS3 1)`;`p(ABS3 2)`] simple_arc_sep;
+  REWRITE_TAC[SUBSET_REFL];
+  TYPE_THEN `!i j. ~(i = j) ==> ~(C i (p j))` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `!i j. ~(REP3 (ABS3 i) = REP3 (ABS3 j))  ==> ~(ABS3 i = ABS3 j)` SUBAGOAL_TAC;
+  TYPE_THEN `ABS3 i` UNABBREV_TAC;
+  REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN REWRITE_TAC[ABS3_012] THEN ARITH_TAC ;
+  THM_INTRO_TAC[`C1'`;`C2'`;`C3'`] three_t_enum;
+  TYPE_THEN `f` EXISTS_TAC;
+  TYPE_THEN `x'` EXISTS_TAC;
+  TYPE_THEN `C1'` UNABBREV_TAC;
+  TYPE_THEN `C2'` UNABBREV_TAC;
+  TYPE_THEN `C3'` UNABBREV_TAC;
+  (* - *)
+  CONJ_TAC THENL [IMATCH_MP_TAC  three_t_univ;ALL_TAC];
+  CONJ_TAC THENL [IMATCH_MP_TAC  three_t_univ THEN (REPEAT   CONJ_TAC)  THEN IMATCH_MP_TAC  three_t_univ THEN FULL_REWRITE_TAC[INTER_ACI];ALL_TAC];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `A` EXISTS_TAC;
+  FULL_REWRITE_TAC[union_subset];
+  TYPE_THEN `!i. (f i SUBSET A)` SUBAGOAL_TAC THENL [IMATCH_MP_TAC  three_t_univ;ALL_TAC];
+  (* - *)
+  UNDH 2066 THEN UNDH 915 THEN POP_ASSUM_LIST (fun t->ALL_TAC);
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[union_subset];
+  (* Sun Jan  2 21:17:07 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let old_every_step_tac = !EVERY_STEP_TAC;;
+EVERY_STEP_TAC :=
+      REP_BASIC_TAC THEN (DROP_ALL_ANT_TAC) THEN
+      (REWRITE_TAC[]) ;;
+
+let transpose = jordan_def `transpose (Q:A->B->C) i j = Q j i`;;
+
+let transpose2 = prove_by_refinement(
+  `!Q . (transpose (transpose Q))  = (Q:A->B->C) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[transpose];
+  ]);;
+  (* }}} *)
+
+let k33_planar_graph_data_expand = prove_by_refinement(
+  `(!q A CA B CB.
+      (!(i:three_t) (j:three_t) i' j'.
+          (q i j = q i' j') ==> (i = i') /\ (j = j')) /\
+      (!i j. simple_arc_end (CA i j) (A i) (q i j)) /\
+      (!i j. simple_arc_end (CB i j) (B j) (q i j)) /\
+      (!i j i' j' u. (CB i j u /\ CA i' j' u) ==>
+           (i = i') /\ (j = j') /\ (u = q i j)) /\
+      (!i j i' j'. ~(CA i j INTER CA i' j' = EMPTY) ==> (i = i')) /\
+      (!i j i' j'. ~(CB i j INTER CB i' j' = EMPTY) ==> (j = j'))
+    ==> (?A' CA' B' CB'.
+      (!i j. simple_arc_end (CA' i j) (A' i) (q i j)) /\
+      (!i j. simple_arc_end (CB' i j) (B' j) (q i j)) /\
+      (!i j i' j' u. (CB' i j u /\ CA' i' j' u) ==>
+           (i = i') /\ (j = j') /\ (u = q i j)) /\
+      (!i j i' j'. ~(CA' i j INTER CA' i' j' = EMPTY) ==> (i = i')) /\
+      (!i j i' j'. ~(CB' i j INTER CB' i' j' = EMPTY) ==> (j = j')) /\
+      (!i j k. ~(j = k) ==> (CA' i j INTER CA' i k = {(A' i)})) /\
+      (!i j k. ~(j = k) ==> (CB' j i INTER CB' k i = {(B' i)}))
+      ))
+        `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `!i. ?CA' A'. (!j. simple_arc_end (CA' j) (A') (q i j)) /\ (!j k. ~(j = k) ==> (CA' j INTER CA' k = {(A')})) /\ (!U. (!j. (CA i j SUBSET U)) ==> (!j. CA' j SUBSET U))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_sep_three_t;
+  TYPE_THEN `A i` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`q i j'`]);
+  ASM_REWRITE_TAC[];
+  UNDH 190 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`]);
+  USEH 6066 (MATCH_MP simple_arc_end_end2);
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  RIGHTH 7847 "i";
+  RIGHTH 705 "i";
+  TYPE_THEN `A'` EXISTS_TAC;
+  TYPE_THEN `CA'` EXISTS_TAC;
+  TYPE_THEN `(!i j. simple_arc_end (CA' i j) (A' i) (q i j))` SUBAGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -A *)
+  TYPE_THEN `!i j u. CA' i j u ==> (?j'. CA i j' u)` SUBAGOAL_TAC;
+  TSPECH `i` 6858;
+  TSPECH `UNIONS (IMAGE (CA i) (UNIV))` 1295;
+  UNDH 3086 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  REWRITE_TAC[SUBSET;UNIONS;IMAGE ];
+  CONV_TAC (dropq_conv ("u"));
+  UNIFY_EXISTS_TAC;
+ ASM_REWRITE_TAC[];
+  TSPECH `j` 7352;
+  USEH 4766  (REWRITE_RULE[SUBSET;UNIONS;IMAGE]);
+  TSPECH `u` 9646;
+  REP_BASIC_TAC;
+  TYPE_THEN `u'` UNABBREV_TAC;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `(!i j i' j'. ~(CA' i j INTER CA' i' j' = {}) ==> (i = i'))` SUBAGOAL_TAC;
+  USEH 3155 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
+  COPYH 6882;
+  UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]);
+  ASM_REWRITE_TAC[];
+  UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]);
+  ASM_REWRITE_TAC[];
+  KILLH 33;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `j'''` EXISTS_TAC;
+  TYPE_THEN `j''` EXISTS_TAC;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -B *)
+  TYPE_THEN `!i. ?CBt' B'. (!j. simple_arc_end (CBt' j) (B') (transpose q i j)) /\ (!j k. ~(j = k) ==> (CBt' j INTER CBt' k = {(B')})) /\ (!U. (!j. (transpose CB i j SUBSET U)) ==> (!j. CBt' j SUBSET U))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_sep_three_t;
+  TYPE_THEN `B i` EXISTS_TAC;
+  REWRITE_TAC[transpose];
+  ASM_REWRITE_TAC[];
+  UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`i`;`j'`;`i`;`q j' i`]);
+  ASM_REWRITE_TAC[];
+  UNDH 8461 THEN DISCH_THEN (THM_INTRO_TAC[`j'`;`i`]);
+  USEH 6944 (MATCH_MP simple_arc_end_end2);
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  RIGHTH 2590 "i";
+  RIGHTH 5199 "i";
+  TYPE_THEN `B'` EXISTS_TAC;
+  TYPE_THEN `CB' = transpose CBt'` ABBREV_TAC ;
+  TYPE_THEN `CBt' = transpose CB'` SUBAGOAL_TAC;
+  TYPE_THEN `CB'` UNABBREV_TAC;
+  REWRITE_TAC[transpose2];
+  TYPE_THEN `CBt'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[transpose];
+  KILLH 87;
+  TYPE_THEN `CB'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -C *)
+  TYPE_THEN `!i j u. CB' i j u ==> (?i'. CB i' j u)` SUBAGOAL_TAC;
+  TSPECH `j` 4587;
+  TSPECH `UNIONS (IMAGE (transpose CB j) (UNIV))` 6357;
+  UNDH 3701 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  REWRITE_TAC[SUBSET;UNIONS;IMAGE;transpose ];
+  CONV_TAC (dropq_conv ("u"));
+  UNIFY_EXISTS_TAC;
+ ASM_REWRITE_TAC[];
+  TSPECH `i` 8438;
+  USEH 4864  (REWRITE_RULE[SUBSET;UNIONS;IMAGE]);
+  TSPECH `u` 7999;
+  FULL_REWRITE_TAC[transpose];
+  TYPE_THEN `u'` UNABBREV_TAC;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `(!i j i' j'. ~(CB' i j INTER CB' i' j' = {}) ==> (j = j'))` SUBAGOAL_TAC;
+  USEH 541 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
+  COPYH 5811;
+  UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]);
+  ASM_REWRITE_TAC[];
+  UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]);
+  ASM_REWRITE_TAC[];
+  KILLH 3657;
+  KILLH 6409;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `i'''` EXISTS_TAC;
+  TYPE_THEN `i''` EXISTS_TAC;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -D *)
+  UNDH 6882 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`u`]);
+  ASM_REWRITE_TAC[];
+  UNDH 5811 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`u`]);
+  ASM_REWRITE_TAC[];
+  UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i''`;`j`;`i'`;`j''`;`u`]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `j''` UNABBREV_TAC;
+  TYPE_THEN `i''` UNABBREV_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  TSPECH `i'` 6858;
+  (* -- *)
+  TYPE_THEN `~(j = j')` ASM_CASES_TAC;
+  UNDH 1784 THEN DISCH_THEN (THM_INTRO_TAC[`j`;`j'`]);
+  UNDH 2577 THEN ASM_REWRITE_TAC[];
+  USEH 6310 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  TSPECH `q i' j` 3488;
+  REWRH 4791;
+  TSPECH `j` 1529;
+  COPYH 3976;
+  USEH 3976 (MATCH_MP simple_arc_end_distinct);
+  UNDH 587 THEN ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USEH 3976 (MATCH_MP  simple_arc_end_end2);
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[];
+  TYPE_THEN `j'` UNABBREV_TAC;
+  (* -E *)
+  TYPE_THEN `(i = i')` BACK_TAC;
+  TYPE_THEN `i'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  TSPECH `j` 4587;
+  UNDH 5789 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`]);
+  UNDH 3113 THEN ASM_REWRITE_TAC[];
+  USEH 3441 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  TSPECH `q i' j` 7938;
+  REWRH 5749;
+  TSPECH `i'` 7762;
+  COPYH 8730;
+  USEH 8730 (MATCH_MP simple_arc_end_distinct);
+  UNDH 586 THEN ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USEH 8730 (MATCH_MP  simple_arc_end_end2);
+  ASM_REWRITE_TAC[];
+  (* Tue Jan  4 10:50:14 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let three_t_size3 = prove_by_refinement(
+  `(UNIV:three_t->bool) HAS_SIZE 3`,
+  (* {{{ proof *)
+  [
+  ASSUME_TAC (ARITH_RULE `3 = SUC 2`);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[HAS_SIZE_SUC];
+  REWRITE_TAC[three_delete_size];
+  ]);;
+  (* }}} *)
+
+let no_k33_planar_graph_data = prove_by_refinement(
+  `(!q A CA B CB.
+      (!(i:three_t) (j:three_t) i' j'.
+          (q i j = q i' j') ==> (i = i') /\ (j = j')) /\
+      (!i j. simple_arc_end (CA i j) (A i) (q i j)) /\
+      (!i j. simple_arc_end (CB i j) (B j) (q i j)) /\
+      (!i j i' j' u. (CB i j u /\ CA i' j' u) ==>
+           (i = i') /\ (j = j') /\ (u = q i j)) /\
+      (!i j i' j'. ~(CA i j INTER CA i' j' = EMPTY) ==> (i = i')) /\
+      (!i j i' j'. ~(CB i j INTER CB i' j' = EMPTY) ==> (j = j')) ==>
+     F)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`q`;`A`;`CA`;`B`;`CB`] k33_planar_graph_data_expand;
+  ASM_REWRITE_TAC[];
+  KILLH 33 THEN KILLH 3657 THEN KILLH 8763 THEN KILLH 190 THEN KILLH 8461;
+  TYPE_THEN `CE = ( \i j. CA' i j UNION CB' i j)` ABBREV_TAC ;
+  TYPE_THEN `!i j. CE i j = CA' i j UNION CB' i j` SUBAGOAL_TAC;
+  TYPE_THEN `CE` UNABBREV_TAC;
+  TYPE_THEN `!i j. simple_arc_end (CE i j) (A' i) (B' j)` SUBAGOAL_TAC;
+  TYPE_THEN `CE` UNABBREV_TAC;
+  IMATCH_MP_TAC  simple_arc_end_trans;
+  TYPE_THEN `q i j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[INTER;SUBSET;INR IN_SING];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET;INR IN_SING;INTER];
+  TYPE_THEN `x` UNABBREV_TAC;
+  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
+  (* - *)
+  TYPE_THEN `A = IMAGE A' UNIV` ABBREV_TAC ;
+  TYPE_THEN `B = IMAGE B' UNIV` ABBREV_TAC ;
+  TYPE_THEN `E = IMAGE (\ (i,j).  (CE i j)) (cartesian UNIV UNIV)` ABBREV_TAC ;
+  (* - *)
+  TYPE_THEN `!i j. CA' i j (q i j)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end2];
+  TYPE_THEN `!i j. CB' i j (q i j)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end2];
+  TYPE_THEN `!i j. CA' i j (A' i)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end];
+  TYPE_THEN `!i j. CB' i j (B' j)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end];
+  (* - *)
+  TYPE_THEN `!i i' j. CA' i j (A' i') ==> (i = i')` SUBAGOAL_TAC;
+  KILLH 5790;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `j` EXISTS_TAC;
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  TYPE_THEN `j` EXISTS_TAC;
+  TYPE_THEN `(A' i')` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!i j j'. CB' i j (B' j') ==> (j = j')` SUBAGOAL_TAC;
+  KILLH 6409;
+  KILLH 1344;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `i` EXISTS_TAC;
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  TYPE_THEN `i` EXISTS_TAC;
+  TYPE_THEN `(B' j')` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!i i' j. ~CB' i j (A' i') ` SUBAGOAL_TAC;
+  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`;`A' i'`]);
+  ASM_REWRITE_TAC[];
+  USEH 6409 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
+  UNDH 6711 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`]);
+  TYPE_THEN `A' i'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `i'` UNABBREV_TAC;
+  ASM_MESON_TAC[simple_arc_end_distinct];
+  (* - *)
+  TYPE_THEN `!i  j j'. ~CA' i j (B' j') ` SUBAGOAL_TAC;
+  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`B' j'`]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `j'` UNABBREV_TAC;
+  ASM_MESON_TAC[simple_arc_end_distinct];
+  (* - *)
+  TYPE_THEN `!i j. CE i j INTER A = {(A' i)}` SUBAGOAL_TAC;
+  REWRITE_TAC[eq_sing;INR IN_SING;INTER];
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `CE` UNABBREV_TAC;
+  REWRITE_TAC[UNION];
+  ASM_REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  CONJ_TAC;
+  MESON_TAC[];
+  TYPE_THEN `u'` UNABBREV_TAC ;
+  TYPE_THEN `x' = i` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!i j. CE i j INTER B = {(B' j)}` SUBAGOAL_TAC;
+  REWRITE_TAC[eq_sing;INR IN_SING;INTER];
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  TYPE_THEN `CE` UNABBREV_TAC;
+  REWRITE_TAC[UNION];
+  ASM_REWRITE_TAC[];
+  NAME_CONFLICT_TAC;
+  CONJ_TAC;
+  MESON_TAC[];
+  TYPE_THEN `u'` UNABBREV_TAC ;
+  TYPE_THEN `x' = j` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -A *)
+  TYPE_THEN `!i i'. (A' i = A' i') ==> (i = i')` SUBAGOAL_TAC;
+  UNDH 1344 THEN DISCH_THEN IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!j j'. (B' j = B' j') ==> (j = j')` SUBAGOAL_TAC;
+  UNDH 6780 THEN DISCH_THEN IMATCH_MP_TAC ;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!i j i' j'. ~(CE i j INTER CE i' j' = EMPTY) ==> (i = i') \/ (j = j')` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  TYPE_THEN `CE` UNABBREV_TAC;
+  USEH 672 (REWRITE_RULE[EMPTY_EXISTS;INTER;UNION]);
+  USEH 5790  (REWRITE_RULE[EMPTY_EXISTS;INTER]);
+  USEH 6409 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
+  FIRST_ASSUM DISJ_CASES_TAC THEN KILLH 7160 THEN (FIRST_ASSUM DISJ_CASES_TAC) ;
+  UNDH 3113 THEN REWRITE_TAC[] THEN UNDH 6711 THEN DISCH_THEN IMATCH_MP_TAC ;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j'`;`u`]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`;`i`;`j`;`u`]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  UNDH 2577 THEN REWRITE_TAC[] THEN UNDH 6981 THEN DISCH_THEN IMATCH_MP_TAC ;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -B *)
+  TYPE_THEN `!i j. ~(A' i = B' j)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!i j j'. ~(j = j') ==>  (CE i j INTER CE i j' = {(A' i)})` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `CE` UNABBREV_TAC;
+  REWRITE_TAC[INTER;UNION;SUBSET;INR IN_SING];
+  FIRST_ASSUM DISJ_CASES_TAC   THEN (KILLH 2709) THEN (FIRST_ASSUM DISJ_CASES_TAC  );
+  USEH 6932  (REWRITE_RULE[INTER;eq_sing;INR IN_SING]) THEN ASM_MESON_TAC[];
+  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`j'`;`x`]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j'`;`i`;`j`;`x`]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  USEH 5790 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
+  ASM_MESON_TAC[];
+  REWRITE_TAC[INR IN_SING;SUBSET;INTER];
+  TYPE_THEN `x` UNABBREV_TAC;
+  USEH 9014 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!i i' j. ~(i = i') ==>  (CE i j INTER CE i' j = {(B' j)})` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  TYPE_THEN `CE` UNABBREV_TAC;
+  REWRITE_TAC[INTER;UNION;SUBSET;INR IN_SING];
+  FIRST_ASSUM DISJ_CASES_TAC   THEN (KILLH 3625) THEN (FIRST_ASSUM DISJ_CASES_TAC  );
+  USEH 6409  (REWRITE_RULE[EMPTY_EXISTS;INTER;eq_sing;INR IN_SING]) THEN ASM_MESON_TAC[];
+  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j`;`x`]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  UNDH 5249 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j`;`i`;`j`;`x`]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  USEH 3599 (REWRITE_RULE[INTER;eq_sing;INR IN_SING;]);
+  ASM_MESON_TAC[];
+  REWRITE_TAC[INR IN_SING;SUBSET;INTER];
+  TYPE_THEN `x` UNABBREV_TAC;
+  USEH 4144 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
+  ASM_MESON_TAC[];
+  (* -C *)
+  TYPE_THEN `g = (\ (i,j). CE i j)` ABBREV_TAC ;
+  TYPE_THEN `BIJ g (cartesian UNIV UNIV) E` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  IMATCH_MP_TAC  inj_bij;
+  REWRITE_TAC[INJ];
+  TYPE_THEN `g` UNABBREV_TAC;
+  TYPE_THEN `?i j. x = (i,j)` SUBAGOAL_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  MESON_TAC[];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `?i j. y = (i,j)` SUBAGOAL_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  MESON_TAC[];
+  TYPE_THEN `y` UNABBREV_TAC;
+(*** Removed by JRH; this happens automatically now
+  USEH 8053 (GBETA_RULE);
+ ***)
+  REWRITE_TAC[PAIR_SPLIT];
+  (* -- *)
+  TYPE_THEN `!i j. INFINITE (CE i j)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_infinite;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `(i = i') \/ (j = j')` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `CE i' j'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INTER_IDEMPOT];
+  TSPECH `i` 6411;
+  TSPECH `j` 2286;
+  FULL_REWRITE_TAC[INFINITE];
+  TYPE_THEN `CE i j` UNABBREV_TAC;
+  FULL_REWRITE_TAC[FINITE_RULES];
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  UNDH 2315 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `i'` UNABBREV_TAC;
+  TYPE_THEN `CE i j'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INTER_IDEMPOT];
+  FULL_REWRITE_TAC[INFINITE];
+  UNDH 773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `CE i j` UNABBREV_TAC;
+  FULL_REWRITE_TAC[FINITE_SING];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `j'` UNABBREV_TAC;
+  PROOF_BY_CONTR_TAC;
+  UNDH 3532 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`]);
+  ASM_MESON_TAC[];
+  TYPE_THEN `CE i' j` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INTER_IDEMPOT];
+  FULL_REWRITE_TAC[INFINITE];
+  UNDH 773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `CE i j` UNABBREV_TAC;
+  FULL_REWRITE_TAC[FINITE_SING];
+  ASM_REWRITE_TAC[];
+  (* -D *)
+  COPYH 1061;
+  USEH 1061 (MATCH_MP INVERSE_BIJ);
+  TYPE_THEN `h = INV g (cartesian UNIV UNIV) E` ABBREV_TAC ;
+  TYPE_THEN `hh = (\ x. (A' (FST (h x)), B' (SND (h x))))` ABBREV_TAC ;
+  TYPE_THEN `BIJ hh E (cartesian A B)` SUBAGOAL_TAC;
+  TYPE_THEN `hh` UNABBREV_TAC;
+  REWRITE_TAC[BIJ];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  REWRITE_TAC[cartesian];
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE;PAIR_SPLIT ];
+  MESON_TAC[];
+  FULL_REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `h x = h y` SUBAGOAL_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[BIJ;INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SURJ];
+  CONJ_TAC;
+  FULL_REWRITE_TAC[INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  USEH 807 (REWRITE_RULE[cartesian;PAIR_SPLIT]);
+  REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `FST x` UNABBREV_TAC;
+  TYPE_THEN `SND x` UNABBREV_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  USEH 6050 (REWRITE_RULE[IMAGE]);
+  USEH 2264 (REWRITE_RULE[IMAGE]);
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `y` UNABBREV_TAC;
+  TYPE_THEN `g (x'',x)` EXISTS_TAC;
+  (* -- *)
+  TYPE_THEN `h (g (x'',x)) = (x'',x)` SUBAGOAL_TAC;
+  TYPE_THEN `h` UNABBREV_TAC;
+  IMATCH_MP_TAC  inv_comp_left;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[cartesian_univ];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `E` UNABBREV_TAC;
+  IMATCH_MP_TAC  image_imp;
+  REWRITE_TAC[cartesian_univ];
+  (* -E *)
+  TYPE_THEN `G = mk_graph_t (A UNION B,E,(\ e . {(FST (hh e)), (SND (hh e)) }))` ABBREV_TAC   ;
+  TYPE_THEN `graph_isomorphic k33_graph G` SUBAGOAL_TAC;
+  TYPE_THEN `G` UNABBREV_TAC;
+  IMATCH_MP_TAC  k33_iso;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  (* -- *)
+  REWRITE_TAC[HAS_SIZE] ;
+  TYPE_THEN `FINITE (IMAGE A' UNIV) /\ FINITE (IMAGE B' UNIV)` SUBAGOAL_TAC;
+  ASSUME_TAC three_t_size3;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  CONJ_TAC THEN IMATCH_MP_TAC  FINITE_IMAGE THEN ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  ASSUME_TAC three_t_size3;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  TYPE_THEN `(CARD (IMAGE A' UNIV) = 3) /\ (CARD (IMAGE B' UNIV) = 3)` SUBAGOAL_TAC;
+  USEH 6784 SYM;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC THEN IMATCH_MP_TAC  (INR CARD_IMAGE_INJ) THEN ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USEH 9575 (REWRITE_RULE[IMAGE;INTER;EMPTY_EXISTS]);
+  TYPE_THEN `u` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  (* -F *)
+  THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_graph;
+  ASM_REWRITE_TAC[k33_isgraph];
+  THM_INTRO_TAC[] k33_nonplanar;
+  FULL_REWRITE_TAC[planar_graph];
+  UNDH 3419 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `G` EXISTS_TAC;
+  THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_symm;
+  ASM_REWRITE_TAC[k33_isgraph];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[plane_graph];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `G` UNABBREV_TAC;
+  REWRITE_TAC[graph_vertex_mk_graph];
+  REWRITE_TAC[UNION;SUBSET];
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  USEH 986 (REWRITE_RULE[IMAGE]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  UNDH 2402 THEN (ASM_MESON_TAC[simple_arc_end_simple;simple_arc_euclid;subset_imp]);
+  TYPE_THEN `x` UNABBREV_TAC;
+  UNDH 7678 THEN (ASM_MESON_TAC[simple_arc_end_simple;simple_arc_euclid;subset_imp]);
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `G` UNABBREV_TAC;
+  REWRITE_TAC[graph_edge_mk_graph];
+  TYPE_THEN `E` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE;SUBSET];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  TYPE_THEN `?i j. (x' = (i,j))` SUBAGOAL_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  MESON_TAC[];
+  TYPE_THEN `x' ` UNABBREV_TAC;
+  GBETA_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  TYPE_THEN `(A' i)` EXISTS_TAC;
+  TYPE_THEN `(B' j)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `G` UNABBREV_TAC;
+  REWRITE_TAC[graph_edge_mk_graph;graph_inc_mk_graph;graph_vertex_mk_graph];
+  KILLH 6876 THEN KILLH 5591 THEN KILLH 6365;
+  FULL_REWRITE_TAC[graph_edge_mk_graph];
+  TYPE_THEN `E` UNABBREV_TAC;
+  USEH 1953 (REWRITE_RULE[IMAGE;cartesian_univ]);
+  TYPE_THEN `e` UNABBREV_TAC;
+  TYPE_THEN `hh` UNABBREV_TAC;
+  (* -- *)
+  TYPE_THEN `h (g (x)) = x` SUBAGOAL_TAC;
+  TYPE_THEN `h` UNABBREV_TAC;
+  IMATCH_MP_TAC  inv_comp_left;
+  ASM_REWRITE_TAC[cartesian_univ];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `?i j. (x = (i,j))` SUBAGOAL_TAC;
+  REWRITE_TAC[PAIR_SPLIT] THEN MESON_TAC[];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  GBETA_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;UNION;INR in_pair];
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  FULL_REWRITE_TAC[eq_sing; INTER; INR IN_SING];
+  TYPE_THEN `x` UNABBREV_TAC;
+  GBETA_TAC;
+  ASM_MESON_TAC[];
+  (* -G *)
+  KILLH 7987 THEN KILLH 6305 THEN KILLH 5812 THEN KILLH 3738 THEN KILLH 8499;
+    TYPE_THEN `!e. E e ==> (?i j. (e = CE i j))` SUBAGOAL_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `g` UNABBREV_TAC;
+  USEH 7673 (REWRITE_RULE[cartesian_univ;IMAGE]);
+  TYPE_THEN `(? i j. x = (i,j))` SUBAGOAL_TAC;
+  REWRITE_TAC[PAIR_SPLIT] THEN MESON_TAC[];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `e''` UNABBREV_TAC;
+  GBETA_TAC;
+  MESON_TAC[];
+  (* - *)
+  TYPE_THEN `G` UNABBREV_TAC;
+  FULL_REWRITE_TAC[graph_vertex_mk_graph;graph_edge_mk_graph];
+  KILLH 4886 THEN KILLH 6107 THEN KILLH 6780 THEN KILLH 1344;
+  COPYH  1159;
+  TSPECH `e` 1159;
+  TSPECH `e'` 1159;
+  TYPE_THEN `e` UNABBREV_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  KILLH 5790 THEN KILLH 6409 THEN KILLH 5249 THEN KILLH 5804;
+  REWRITE_TAC[INTER;SUBSET;UNION];
+  TYPE_THEN `(i' = i)` ASM_CASES_TAC;
+  DISJ1_TAC;
+  FULL_REWRITE_TAC[eq_sing;INTER;INR IN_SING];
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[IMAGE];
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `i'` UNABBREV_TAC;
+  TYPE_THEN `i` EXISTS_TAC;
+  TYPE_THEN `~(j' = j)` SUBAGOAL_TAC;
+  TYPE_THEN `j'` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  UNDH 221 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`]);
+  UNDH 7790 THEN ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `(i' = i) \/ (j' = j)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USEH 5273 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  ASM_MESON_TAC[];
+  REWRH 5596;
+  TYPE_THEN `j'` UNABBREV_TAC;
+  DISJ2_TAC;
+  (* - *)
+  TYPE_THEN `x = B' j` BACK_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `B` UNABBREV_TAC;
+  IMATCH_MP_TAC  image_imp;
+  (* - *)
+  USEH 3532  (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
+  UNDH 9432 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`]);
+  UNDH 7528 THEN ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* Tue Jan  4 15:3282:39 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let simple_arc_midpoint = prove_by_refinement(
+  `!C v w. simple_arc_end C v w ==>
+        (?u. (C u /\ ~(u = v) /\ ~(u = w)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] simple_arc_infinite;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`;`{v,w}`;] INFINITE_DIFF_FINITE;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`v`;`w`] pair_size_2;
+  ASM_MESON_TAC[simple_arc_end_distinct];
+  FULL_REWRITE_TAC[HAS_SIZE];
+  ASM_REWRITE_TAC[];
+  USEH 3168 (MATCH_MP INFINITE_NONEMPTY);
+  FULL_REWRITE_TAC[DIFF;EMPTY_EXISTS;INR in_pair];
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let simple_arc_choose_end = prove_by_refinement(
+  `!C. simple_arc top2 C ==> (?v w. simple_arc_end C v w)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_arc;simple_arc_end];
+  FULL_REWRITE_TAC[top2_unions];
+  LEFT_TAC "f";
+  LEFT_TAC "f";
+  TYPE_THEN  `f` EXISTS_TAC;
+  TYPE_THEN `f(&0)` EXISTS_TAC;
+  TYPE_THEN `f(&1)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let cut_arc_replace = prove_by_refinement(
+  `!A B u v. A SUBSET B /\ simple_arc top2 A /\ simple_arc top2 B /\
+      A u /\ A v /\ ~(u = v) ==> (cut_arc B u v = cut_arc A u v)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  cut_arc_unique;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `A` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  cut_arc_subset;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let cut_arc_order = prove_by_refinement(
+  `!C u v w. simple_arc_end C v w /\ C u /\ ~(u = v) /\ ~(u = w) ==>
+     ~(cut_arc C v u w)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`;`u`;`v`;`w`] cut_arc_inter;
+  ASM_REWRITE_TAC[];
+  USEH 1187 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  TSPECH `w` 5795;
+  COPYH 1985;
+  UNDH 1985 THEN REWRITE_TAC [];
+  IMATCH_MP_TAC  EQ_SYM;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  TYPE_THEN `u` EXISTS_TAC;
+  IMATCH_MP_TAC  cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+(* First direction  of Jordan curve theorem. *)
+
+let jordan_curve_no_inj3 = prove_by_refinement(
+  `!C p.
+     simple_closed_curve top2 C /\
+     INJ p (UNIV:three_t ->bool) (euclid 2) /\
+     (!i. ~C (p i)) /\
+     (!i j A. simple_arc_end A (p i) (p j) ==> ~(A INTER C = EMPTY))
+     ==> F`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] jordan_curve_seg3;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!i. ?v w. simple_arc_end (s i) v w` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`s i`] simple_arc_choose_end;
+  ASM_MESON_TAC[];
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  LEFTH 4671 "v";
+  LEFTH 2518 "w";
+  (* - *)
+  TYPE_THEN `!i. ?B. s i B /\ ~(B = v i) /\ ~(B = w i)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`s i`;`v i`;`w i`] simple_arc_midpoint;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  LEFTH 9437 "B";
+  (* -A *)
+  TYPE_THEN `!i. euclid 2 (p i)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[INJ];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!i j. ?E. simple_arc_end E (p i) (B j) /\ (E INTER C SUBSET (s j)) /\ (!e. E e /\ ~C e /\ ~(p i = e) ==> (cut_arc E (p i) e INTER C = EMPTY))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  jordan_curve_access;
+  TYPE_THEN `v j` EXISTS_TAC;
+  TYPE_THEN `w j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`i`] three_t_not_sing;
+  TYPE_THEN `p j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UNDH 7630 THEN FULL_REWRITE_TAC[INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  LEFTH 4024 "E";
+  LEFTH 1449 "E";
+  (* -B *)
+  TYPE_THEN `!i j i' j' u. E i j u /\ E i' j' u /\ C u ==> (j = j') /\ s j u` SUBAGOAL_TAC;
+  COPYH 807;
+  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]);
+  USEH 6239 (REWRITE_RULE[INTER;SUBSET]);
+  USEH 4225 (REWRITE_RULE[INTER;SUBSET]);
+  SUBCONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USEH 9012 (REWRITE_RULE[EQ_EMPTY;INTER]);
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!i j. (p i = p j) ==> (i = j)` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[INJ];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!i j. E i j (p i)` SUBAGOAL_TAC;
+  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  USEH 3415 (MATCH_MP simple_arc_end_end);
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!i j i' j' u. E i j u /\ E i' j' u /\ ~C u ==> (i = i')` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  (* -- *)
+  TYPE_THEN `u = p i` ASM_CASES_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]);
+  UNDH 8557 THEN DISCH_THEN (THM_INTRO_TAC[`p i`]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`i`;`cut_arc (E i' j') (p i') (p i)`]);
+  IMATCH_MP_TAC  cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  UNDH 1303 THEN ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `u = p i'` ASM_CASES_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  UNDH 3041 THEN DISCH_THEN (THM_INTRO_TAC[`p i'`]);
+  ASM_REWRITE_TAC[];
+  UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`cut_arc (E i j) (p i) (p i')`]);
+  IMATCH_MP_TAC  cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UNDH 9380 THEN ASM_REWRITE_TAC[];
+  (* -- *)
+  COPYH 807;
+  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j'`]);
+  TYPE_THEN `cut_arc (E i j) (p i) u INTER C = EMPTY` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `cut_arc (E i' j') (p i') u INTER C = EMPTY` SUBAGOAL_TAC;
+  FIRST_ASSUM  IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`E i j`;`p i`;`u`] cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`E i' j'`;`p i'`;`u`] cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`cut_arc (E i j) (p i) u`;`cut_arc (E i' j') (p i') u`;`p i`;`u`;`p i'`] simple_arc_end_subset_trans;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  UNDH 3113 THEN ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  UNDH 382 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`U`]);
+  ASM_REWRITE_TAC[];
+  UNDH 3232 THEN UNDH 5860 THEN UNDH 4934 THEN UNDH 7573 THEN REWRITE_TAC[EMPTY_EXISTS;INTER;SUBSET] THEN REWRITE_TAC[EQ_EMPTY;UNION] THEN MESON_TAC[];
+  (* -C *)
+  TYPE_THEN `!i j. ?E'' u u''. E'' SUBSET E i j /\ simple_arc_end E'' u u'' /\ (E'' INTER (UNIONS (IMAGE (E i) {k | ~(k = j)})) = {u}) /\ (E'' INTER {(B j)} = {u''})` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_restriction;
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple THEN ASM_MESON_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  top_closed_unions;
+  REWRITE_TAC[top2_top];
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN   `UNIV:three_t -> bool` EXISTS_TAC ;
+  REWRITE_TAC[three_t_finite];
+  REWRITE_TAC[SUBSET;IMAGE];
+  TYPE_THEN `x` UNABBREV_TAC;
+  ASM_MESON_TAC[simple_arc_end_closed];
+  (* -- *)
+  CONJ_TAC;
+  ASM_MESON_TAC[simple_arc_end_end_closed2];
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[EQ_EMPTY;INTER;UNIONS;IMAGE;INR IN_SING ];
+  TYPE_THEN `u` UNABBREV_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  UNDH 2306 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`x'`;`B j`]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `s j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UNDH 7917 THEN ASM_REWRITE_TAC[];
+  (* -- *)
+  REWRITE_TAC[EMPTY_EXISTS];
+  CONJ_TAC;
+  TYPE_THEN `p i` EXISTS_TAC;
+  REWRITE_TAC[INTER;UNIONS;IMAGE];
+  ASM_REWRITE_TAC[];
+  CONV_TAC (dropq_conv "u");
+  THM_INTRO_TAC[`j`] three_t_not_sing;
+  TYPE_THEN `j'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INTER];
+  TYPE_THEN `B j` EXISTS_TAC;
+  ASM_REWRITE_TAC[INR IN_SING ];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  (* - *)
+  LEFTH 4870 "E''";
+  LEFTH 4064 "E''";
+  LEFTH 544 "u''";
+  LEFTH 659 "u''";
+  LEFTH 239 "u''";
+  TYPE_THEN `u'' =  (\ i j. B j)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  IMATCH_MP_TAC  EQ_EXT;
+  TSPECH `x` 3583;
+  TSPECH `x'` 7705;
+  USEH 2213 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  IMATCH_MP_TAC  EQ_SYM;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USEH 3027 SYM;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `u''` UNABBREV_TAC;
+  (* - *)
+  LEFTH 1162 "u";
+  LEFTH 3727 "u";
+  TYPE_THEN `!i j. (?E' ua u'. E' SUBSET (E'' i j) /\ simple_arc_end E' ua u' /\ (E' INTER {(u i j)} = {ua}) /\ (E' INTER (s j) = {u'}))` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_restriction;
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC [];
+  (* -- *)
+  CONJ_TAC;
+  ASM_MESON_TAC[simple_arc_end_end_closed];
+  CONJ_TAC;
+  ASM_MESON_TAC[simple_arc_end_closed];
+  (* -- *)
+  CONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  USEH 4139 (REWRITE_RULE[INTER;EMPTY_EXISTS;INR IN_SING]);
+  TYPE_THEN `u'` UNABBREV_TAC;
+  TSPECH `i` 2275;
+  TSPECH `j` 631;
+  USEH 9848 (REWRITE_RULE[eq_sing;INR IN_SING;INTER;UNIONS;IMAGE]);
+  TYPE_THEN `u''` UNABBREV_TAC;
+  UNDH 9165 THEN REWRITE_TAC[];
+  UNDH 3778 THEN DISCH_THEN IMATCH_MP_TAC ;
+  UNDH 1277 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `u i j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `C (u i j)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `s j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UNDH 2306 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i`;`x`;`u i j`]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `E'' i j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `j` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  REWRITE_TAC[EMPTY_EXISTS;INTER;INR IN_SING ];
+  CONJ_TAC;
+  TYPE_THEN `u i j` EXISTS_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `B j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  LEFTH 5131 "E'";
+  LEFTH 6920 "E'";
+  (* -D *)
+  TYPE_THEN `!i j k q x. E i k x /\ E'' i j q /\ ~(q = u i j) /\ ~(q  = B j) /\ cut_arc (E i j) (q) (B j) x ==> (j = k)` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  (* -- *)
+  TYPE_THEN `cut_arc (E i j) q (B j)   = cut_arc (E'' i j) q (B j)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cut_arc_replace;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  (* -- *)
+  REWRH 4315;
+  TYPE_THEN `E'' i j x` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `cut_arc (E'' i j) q (B j)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  cut_arc_subset;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  (* -- *)
+  UNDH 2275 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  USEH 9848 (REWRITE_RULE[INTER;UNIONS;IMAGE;eq_sing;INR IN_SING]);
+  TYPE_THEN `x = u i j` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `k` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `x` UNABBREV_TAC;
+  (* -- *)
+  THM_INTRO_TAC[`E'' i j`;`q`;`B j`;`u i j`] cut_arc_order;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  UNDH 1152 THEN ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[cut_arc_symm];
+  ASM_REWRITE_TAC[];
+  (* -Da *)
+  TYPE_THEN `?u'. !i j. E' i j SUBSET E'' i j /\ simple_arc_end (E' i j) (u i j) (u' i j) /\ (E' i j INTER s j = {(u' i j)})` SUBAGOAL_TAC;
+  LEFTH 2832 "ua";
+  LEFTH 6021 "ua";
+  LEFTH 4322 "u'";
+  LEFTH 1946 "u'";
+  TYPE_THEN `u'` EXISTS_TAC;
+  TSPECH `i` 1323;
+  TSPECH `j` 1285;
+  ASM_REWRITE_TAC[];
+  USEH 7215 (REWRITE_RULE[INTER;INR IN_SING;eq_sing;]);
+  TYPE_THEN `ua i j` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  KILLH 2832;
+  (* - *)
+  TYPE_THEN `!i j. E' i j SUBSET E i j` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `E'' i j` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!i j. ?q. (E' i j q) /\ (E'' i j q) /\ (E i j q) /\ ~(q = u i j) /\ ~(q = u' i j) /\ ~(s j q) /\ (!k. E i k q ==> (j = k))` SUBAGOAL_TAC;
+  TSPECH `i` 7629;
+  TSPECH `j` 6300;
+  THM_INTRO_TAC[`E' i j`;`u i j`;`u' i j`] simple_arc_midpoint;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `q = u''` ABBREV_TAC ;
+  TYPE_THEN `u''` UNABBREV_TAC;
+  TYPE_THEN `q` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `E' i j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `E' i j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  SUBCONJ_TAC;
+  USEH 3228 (REWRITE_RULE[INR IN_SING;eq_sing;INTER]);
+  ASM_MESON_TAC[];
+  TSPECH `i` 6619;
+  TSPECH `j` 4357;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `q` EXISTS_TAC;
+  TYPE_THEN `q` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  UNDH 9552 THEN REWRITE_TAC[];
+  TYPE_THEN `q` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`E i j`;`q`;`B j`] cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  LEFTH 7093 "q";
+  LEFTH 7917 "q";
+  (* -E *)
+  TYPE_THEN `CA = (\ i j. cut_arc (E i j) (p i) (q i j))` ABBREV_TAC ;
+  TYPE_THEN `CB = (\ i j. cut_arc (E i j) (q i j) (B j))` ABBREV_TAC ;
+  TYPE_THEN `!i j. ~(q i j = p i)` SUBAGOAL_TAC;
+  TSPECH `i` 3615;
+  TSPECH `j` 524;
+  THM_INTRO_TAC[`j`] three_t_not_sing;
+  UNDH 2577 THEN REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!i j. ~(q i j = B j)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!i j. simple_arc_end (CA i j) (p i) (q i j)` SUBAGOAL_TAC;
+  TYPE_THEN `CA` UNABBREV_TAC;
+  IMATCH_MP_TAC  cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!i j. simple_arc_end (CB i j) (q i j) (B j)` SUBAGOAL_TAC;
+  TYPE_THEN `CB` UNABBREV_TAC;
+  IMATCH_MP_TAC  cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  (* -F *)
+  THM_INTRO_TAC[`q`;`p`;`CA`;`B`;`CB`] no_k33_planar_graph_data THENL [ALL_TAC;ASM_REWRITE_TAC[]];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(!i j. simple_arc_end (CB i j) (B j) (q i j)) ` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!i j. CA i j INTER C = EMPTY` SUBAGOAL_TAC;
+  UNDH 807 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]);
+  TYPE_THEN `CA` UNABBREV_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  USEH 6239 (REWRITE_RULE[INTER;SUBSET]);
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!i j j' u. CB i j u /\ E i j' u ==> (j = j')` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `i` EXISTS_TAC;
+  TYPE_THEN `q i j` EXISTS_TAC;
+  TYPE_THEN `u''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `CB` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!i j. CB i j = cut_arc (E'' i j) (q i j) (B j)` SUBAGOAL_TAC;
+  TYPE_THEN `CB` UNABBREV_TAC;
+  IMATCH_MP_TAC  cut_arc_replace;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `simple_arc top2 (E i j)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple];
+  (* - *)
+  TYPE_THEN `!i i' j j' u. ~(i = i') /\ CB i j u /\ E i' j' u ==> (j = j') /\ s j u` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `i` EXISTS_TAC;
+  TYPE_THEN `i'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `CB` UNABBREV_TAC;
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `cut_arc (E i j) (q i j) (B j)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `E'' i j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  cut_arc_subset;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple];
+  PROOF_BY_CONTR_TAC;
+  UNDH 3113 THEN REWRITE_TAC[];
+  UNDH 6138 THEN DISCH_THEN (IMATCH_MP_TAC );
+  TYPE_THEN `j` EXISTS_TAC;
+  TYPE_THEN `j'` EXISTS_TAC;
+  TYPE_THEN `u''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -G *)
+  USEH 9121 GSYM;
+  TYPE_THEN `!i j. CB i j SUBSET E i j` SUBAGOAL_TAC;
+  TYPE_THEN `CB` UNABBREV_TAC;
+  IMATCH_MP_TAC  cut_arc_subset;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_simple];
+  (* - *)
+  TYPE_THEN `(!i j i' j'. ~(CB i j INTER CB i' j' = {}) ==> (j = j'))` SUBAGOAL_TAC;
+  USEH 2001  (REWRITE_RULE [INTER;EMPTY_EXISTS]);
+  TYPE_THEN `i = i'` ASM_CASES_TAC;
+  UNDH 758 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`;`u''`]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `CB i' j'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  UNDH 3773 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`i'`;`j`;`j'`;`u''`]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `CB i' j'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `j'` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!i j. CA i j SUBSET E i j` SUBAGOAL_TAC;
+  TYPE_THEN `CA` UNABBREV_TAC;
+  IMATCH_MP_TAC  cut_arc_subset;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_simple];
+  (* -H *)
+  TYPE_THEN `(!i j i' j' u. CB i j u /\ CA i' j' u ==> (i = i') /\ (j = j') /\ (u = q i j))` SUBAGOAL_TAC;
+  TYPE_THEN `i = i'` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `i'` UNABBREV_TAC;
+  UNDH 758 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`j'`;`u''`]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `CA i j'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `j'` UNABBREV_TAC;
+  THM_INTRO_TAC[`E i j`;`q i j`;`p i`;`B j`] cut_arc_inter;
+  ASM_REWRITE_TAC[];
+  USEH 699 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `CA` UNABBREV_TAC;
+  TYPE_THEN `CB` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  UNDH 3773 THEN DISCH_THEN (  THM_INTRO_TAC[`i`;`i'`;`j`;`j'`;`u''`]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `CA i' j'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `j'` UNABBREV_TAC;
+  (* -- *)
+  USEH 682 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  UNDH 218 THEN DISCH_THEN (THM_INTRO_TAC[`i'`;`j`;`u''`]);
+  UNDH 2186 THEN ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `s j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -I *)
+  CONJ_TAC;
+  UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`;`i'`;`j'`;`q i j`]);
+  CONJ_TAC;
+  TYPE_THEN `CB` UNABBREV_TAC;
+  ASM_MESON_TAC[simple_arc_end_end];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_end2];
+  TYPE_THEN `i'` UNABBREV_TAC;
+  TYPE_THEN `j'` UNABBREV_TAC;
+  (* - *)
+  USEH 6538 (REWRITE_RULE[EMPTY_EXISTS;INTER]);
+  UNDH 6138 THEN DISCH_THEN IMATCH_MP_TAC ;
+  TYPE_THEN `j` EXISTS_TAC;
+  TYPE_THEN `j'` EXISTS_TAC;
+  TYPE_THEN `u''` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `CA i j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `CA i' j'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UNDH 682 THEN DISCH_THEN (THM_INTRO_TAC[`i`;`j`]) THEN ASM_REWRITE_TAC[EMPTY_EXISTS;INTER ];
+  UNDH 7281 THEN REWRITE_TAC[EMPTY_EXISTS;INTER];
+ UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Sun Jan 16 08:48:56 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION CC *)
+(* ------------------------------------------------------------------ *)
+
+(* finish off Jordan curve *)
+
+let simple_closed_curve_compact = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==> compact top2 C`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[simple_closed_curve];
+  TYPE_THEN `C` UNABBREV_TAC;
+  IMATCH_MP_TAC  image_compact;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[top2_unions];
+  CONJ_TAC;
+  REWRITE_TAC[interval_compact];
+  REWRITE_TAC[IMAGE;SUBSET];
+  FULL_REWRITE_TAC[INJ];
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `x' = &1` ASM_CASES_TAC;
+  TYPE_THEN `x'` UNABBREV_TAC;
+  USEH 5825 SYM;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  REAL_ARITH_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  UNDH 6268 THEN UNDH 3324 THEN UNDH 9329 THEN REAL_ARITH_TAC;
+  (* Sun Jan 16 09:13:09 EST 2005 *)
+
+  ]);;
+
+  (* }}} *)
+
+let ymaxQexists_lemma = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==>
+         (?p. C p /\ (!q. C q ==> (q 1 <=. p 1)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`1`;`2`] continuous_euclid1;
+  FULL_REWRITE_TAC[GSYM top2];
+  THM_INTRO_TAC[`coord 1`;`top2`;`C`] compact_max_real;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_closed_curve_compact;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[simple_closed_curve];
+  TYPE_THEN `C` UNABBREV_TAC;
+  USEH 2198 GSYM;
+  USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
+  TSPECH `f (&0)` 9716;
+  UNDH 5422 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `&0` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  FULL_REWRITE_TAC[coord];
+  ASM_REWRITE_TAC[];
+  (* Sun Jan 16 09:16:3282 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let yminQexists_lemma = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==>
+         (?p. C p /\ (!q. C q ==> (p 1 <=. q 1)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`1`;`2`] continuous_euclid1;
+  FULL_REWRITE_TAC[GSYM top2];
+  THM_INTRO_TAC[`coord 1`;`top2`;`C`] compact_min_real;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_closed_curve_compact;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[simple_closed_curve];
+  TYPE_THEN `C` UNABBREV_TAC;
+  USEH 2198 GSYM;
+  USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
+  TSPECH `f (&0)` 9716;
+  UNDH 5422 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `&0` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  FULL_REWRITE_TAC[coord];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let xmaxQexists_lemma = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==>
+         (?p. C p /\ (!q. C q ==> (q 0 <=. p 0)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`0`;`2`] continuous_euclid1;
+  FULL_REWRITE_TAC[GSYM top2];
+  THM_INTRO_TAC[`coord 0`;`top2`;`C`] compact_max_real;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_closed_curve_compact;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[simple_closed_curve];
+  TYPE_THEN `C` UNABBREV_TAC;
+  USEH 2198 GSYM;
+  USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
+  TSPECH `f (&0)` 9716;
+  UNDH 5422 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `&0` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  FULL_REWRITE_TAC[coord];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let xminQexists_lemma = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==>
+         (?p. C p /\ (!q. C q ==> (p 0 <=. q 0)))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`0`;`2`] continuous_euclid1;
+  FULL_REWRITE_TAC[GSYM top2];
+  THM_INTRO_TAC[`coord 0`;`top2`;`C`] compact_min_real;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_closed_curve_compact;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[simple_closed_curve];
+  TYPE_THEN `C` UNABBREV_TAC;
+  USEH 2198 GSYM;
+  USEH 6041 (REWRITE_RULE[IMAGE;EQ_EMPTY]);
+  TSPECH `f (&0)` 9716;
+  UNDH 5422 THEN ASM_REWRITE_TAC[];
+  TYPE_THEN `&0` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  FULL_REWRITE_TAC[coord];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+(* state pSC *)
+let ymaxQ = jordan_def `ymaxQ C = supm { y | ?x. (C (point(x,y))) }`;;
+let yminQ = jordan_def `yminQ C = inf { y | ?x. (C (point(x,y))) }`;;
+let xmaxQ = jordan_def `xmaxQ C = supm { x | ?y. (C (point(x,y))) }`;;
+let xminQ = jordan_def `xminQ C = inf { x | ?y. (C (point(x,y))) }`;;
+
+let inf_unique = prove_by_refinement(
+  `!X s. X s /\ (!t. X t ==> (s <= t)) ==> (s = inf X)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`X`] inf_LB;
+  REWRITE_TAC[EMPTY_EXISTS];
+  CONJ_TAC;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `s` EXISTS_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN   `(s <= inf X) /\ (inf X <= s)` BACK_TAC;
+  UNDH 9491 THEN UNDH 1818 THEN REAL_ARITH_TAC;
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let supm_unique = prove_by_refinement(
+  `!X s. X s /\ (!t. X t ==> (t <= s)) ==> (s = supm X)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`X`] supm_UB;
+  REWRITE_TAC[EMPTY_EXISTS];
+  CONJ_TAC;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `s` EXISTS_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN   `(s <= supm X) /\ (supm X <= s)` BACK_TAC;
+  UNDH 4025 THEN UNDH 5913 THEN REAL_ARITH_TAC;
+  CONJ_TAC THEN (FIRST_ASSUM IMATCH_MP_TAC );
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* Sun Jan 16 09:42:06 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let euclid2_point = prove_by_refinement(
+  `!p. euclid 2 p ==> (point (p 0, p 1) = p)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  USEH 7802 (MATCH_MP   point_onto);
+  TYPE_THEN `p` UNABBREV_TAC;
+  REWRITE_TAC[point_inj];
+  REWRITE_TAC[coord01];
+  ]);;
+  (* }}} *)
+
+let ymaxQ_exists = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 1 = ymaxQ C))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] ymaxQexists_lemma;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[ymaxQ];
+  IMATCH_MP_TAC  supm_unique;
+  CONJ_TAC;
+  TYPE_THEN `p 0` EXISTS_TAC;
+  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_SIMP_TAC[simple_closed_curve_euclid];
+  ASM_SIMP_TAC[euclid2_point];
+  TYPE_THEN `t = point(x,t) 1` SUBAGOAL_TAC;
+  REWRITE_TAC[coord01];
+  UNDH 9068 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `A = point(x,t)` ABBREV_TAC  ;
+  REWRITE_TAC[ETA_AX];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let yminQ_exists = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 1 = yminQ C))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] yminQexists_lemma;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[yminQ];
+  IMATCH_MP_TAC  inf_unique;
+  CONJ_TAC;
+  TYPE_THEN `p 0` EXISTS_TAC;
+  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_SIMP_TAC[simple_closed_curve_euclid];
+  ASM_SIMP_TAC[euclid2_point];
+  TYPE_THEN `t = point(x,t) 1` SUBAGOAL_TAC;
+  REWRITE_TAC[coord01];
+  UNDH 9068 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `A = point(x,t)` ABBREV_TAC  ;
+  REWRITE_TAC[ETA_AX];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let xmaxQ_exists = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 0 = xmaxQ C))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] xmaxQexists_lemma;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[xmaxQ];
+  IMATCH_MP_TAC  supm_unique;
+  CONJ_TAC;
+  TYPE_THEN `p 1` EXISTS_TAC;
+  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_SIMP_TAC[simple_closed_curve_euclid];
+  ASM_SIMP_TAC[euclid2_point];
+  TYPE_THEN `t = point(t,y) 0` SUBAGOAL_TAC;
+  REWRITE_TAC[coord01];
+  UNDH 5575 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `A = point(t,y)` ABBREV_TAC  ;
+  REWRITE_TAC[ETA_AX];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let xminQ_exists = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==> (?p. C p /\ (p 0 = xminQ C))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] xminQexists_lemma;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[xminQ];
+  IMATCH_MP_TAC  inf_unique;
+  CONJ_TAC;
+  TYPE_THEN `p 1` EXISTS_TAC;
+  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_SIMP_TAC[simple_closed_curve_euclid];
+  ASM_SIMP_TAC[euclid2_point];
+  TYPE_THEN `t = point(t,y) 0` SUBAGOAL_TAC;
+  REWRITE_TAC[coord01];
+  UNDH 5575 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC[t]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `A = point(t,y)` ABBREV_TAC  ;
+  REWRITE_TAC[ETA_AX];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let ymaxQ_max = prove_by_refinement(
+  `!C p. simple_closed_curve top2 C /\ C p ==> (p 1 <= ymaxQ C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[ymaxQ];
+  THM_INTRO_TAC[`C`] ymaxQexists_lemma;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`{y | ?x. C (point(x,y))}` ] supm_UB;
+  REWRITE_TAC[EMPTY_EXISTS];
+  (* -- *)
+  CONJ_TAC;
+  TYPE_THEN `p 1` EXISTS_TAC;
+  TYPE_THEN `p 0` EXISTS_TAC;
+  ASM_SIMP_TAC[euclid2_point];
+  TYPE_THEN `p' 1` EXISTS_TAC;
+  TSPECH `point(x',x)` 1647;
+  FULL_REWRITE_TAC[coord01];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `p 0` EXISTS_TAC;
+  ASM_SIMP_TAC[euclid2_point];
+  ]);;
+  (* }}} *)
+
+let yminQ_min = prove_by_refinement(
+  `!C p. simple_closed_curve top2 C /\ C p ==> (yminQ C <= p 1)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[yminQ];
+  THM_INTRO_TAC[`C`] yminQexists_lemma;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`{y | ?x. C (point(x,y))}` ] inf_LB;
+  REWRITE_TAC[EMPTY_EXISTS];
+  (* -- *)
+  CONJ_TAC;
+  TYPE_THEN `p 1` EXISTS_TAC;
+  TYPE_THEN `p 0` EXISTS_TAC;
+  ASM_SIMP_TAC[euclid2_point];
+  TYPE_THEN `p' 1` EXISTS_TAC;
+  TSPECH `point(x',x)` 2887;
+  FULL_REWRITE_TAC[coord01];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `p 0` EXISTS_TAC;
+  ASM_SIMP_TAC[euclid2_point];
+  ]);;
+  (* }}} *)
+
+let xmaxQ_max = prove_by_refinement(
+  `!C p. simple_closed_curve top2 C /\ C p ==> (p 0 <= xmaxQ C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[xmaxQ];
+  THM_INTRO_TAC[`C`] xmaxQexists_lemma;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`{x | ?y. C (point(x,y))}` ] supm_UB;
+  REWRITE_TAC[EMPTY_EXISTS];
+  (* -- *)
+  CONJ_TAC;
+  TYPE_THEN `p 0` EXISTS_TAC;
+  TYPE_THEN `p 1` EXISTS_TAC;
+  ASM_SIMP_TAC[euclid2_point];
+  TYPE_THEN `p' 0` EXISTS_TAC;
+  TSPECH `point(x,y)` 3013;
+  FULL_REWRITE_TAC[coord01];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `p 1` EXISTS_TAC;
+  ASM_SIMP_TAC[euclid2_point];
+  ]);;
+  (* }}} *)
+
+let xminQ_min = prove_by_refinement(
+  `!C p. simple_closed_curve top2 C /\ C p ==> (xminQ C <= p 0)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[xminQ];
+  THM_INTRO_TAC[`C`] xminQexists_lemma;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `!p. C p ==> euclid 2 p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`{x | ?y. C (point(x,y))}` ] inf_LB;
+  REWRITE_TAC[EMPTY_EXISTS];
+  (* -- *)
+  CONJ_TAC;
+  TYPE_THEN `p 0` EXISTS_TAC;
+  TYPE_THEN `p 1` EXISTS_TAC;
+  ASM_SIMP_TAC[euclid2_point];
+  TYPE_THEN `p' 0` EXISTS_TAC;
+  TSPECH `point(x,y)` 4062;
+  FULL_REWRITE_TAC[coord01];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  TYPE_THEN `p 1` EXISTS_TAC;
+  ASM_SIMP_TAC[euclid2_point];
+  (* Sun Jan 16 13:15:02 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+extend_simp_rewrites[prove_by_refinement(
+  `!x. x <=. x`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REAL_ARITH_TAC;
+  ])];;
+  (* }}} *)
+
+let real012 = prove_by_refinement(
+  `&0 < &1 /\ &0 <= &1 /\ &0 <= &1 / &2 /\ &0 < &1 / &2 /\ &1/ &2 < &1 /\ &1 / &2 <= &1 `,
+  (* {{{ proof *)
+  [
+  CONJ_TAC;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_RDIV;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LT_1;
+  REAL_ARITH_TAC;
+  IMATCH_MP_TAC  REAL_LE_LDIV;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+extend_simp_rewrites[real012];;
+
+let simple_closed_curve_nonempty = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==> (?p. C p)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_closed_curve];
+  KILLH 5825;
+  TYPE_THEN `f (&0)` EXISTS_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  IMATCH_MP_TAC  image_imp;
+  ASM_RSIMP_TAC[];
+  ]);;
+  (* }}} *)
+
+let simple_closed_curve_2pt = prove_by_refinement(
+  `!C p. simple_closed_curve top2 C /\ C p ==> (?q. C q /\ ~(q = p))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_closed_curve];
+  USEH 5825 GSYM;
+  TYPE_THEN `~(f (&0) = f( &1 / &2))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[INJ];
+  TYPE_THEN `&0 = &1 / &2` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* --- *)
+  ASM_RSIMP_TAC [];
+  TYPE_THEN `&0 < &2` SUBAGOAL_TAC;
+  REAL_ARITH_TAC;
+  TYPE_THEN `&0 < &1 / &2` SUBAGOAL_TAC;
+  ASM_RSIMP_TAC[];
+  UNDH 4792 THEN UNDH 3735 THEN REAL_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `C (f (&1 / &2))` SUBAGOAL_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  IMATCH_MP_TAC  image_imp;
+  ASM_RSIMP_TAC[];
+  (* - *)
+  TYPE_THEN `p = f (&0)` ASM_CASES_TAC;
+  TYPE_THEN `p` UNABBREV_TAC;
+  TYPE_THEN `f (&1 / &2)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `f (&0)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  image_imp;
+  ASM_RSIMP_TAC[];
+  ]);;
+  (* }}} *)
+
+let xmin_le_xmax = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==> (xminQ C <= xmaxQ C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] xminQ_exists;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`;`p`] xmaxQ_max;
+  ASM_REWRITE_TAC[];
+  USEH 6458 GSYM;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let ymin_le_ymax = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==> (yminQ C <= ymaxQ C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] yminQ_exists;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`;`p`] ymaxQ_max;
+  ASM_REWRITE_TAC[];
+  USEH 4513 GSYM;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let simple_closed_curve_nsubset_arc = prove_by_refinement(
+  `!C E. simple_closed_curve top2 C /\ simple_arc top2 E ==>
+     ~(C SUBSET E)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] simple_closed_curve_nonempty;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`;`p`;`q`] simple_closed_cut;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `C' SUBSET E /\ C'' SUBSET E` SUBAGOAL_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  UNDH 6378 THEN REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
+  THM_INTRO_TAC[`E`;`p`;`q`;`C'`] cut_arc_unique;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`E`;`p`;`q`;`C''`] cut_arc_unique;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `cut_arc E p q` UNABBREV_TAC;
+  TYPE_THEN `C''` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INTER_IDEMPOT];
+  TYPE_THEN `C'` UNABBREV_TAC;
+  THM_INTRO_TAC[`{p,q}`] simple_arc_infinite;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+ UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[INFINITE];
+  FULL_REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
+  ASM_REWRITE_TAC[];
+  (* Sun Jan 16 15:22:30 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let xmin_lt_xmax = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==> (xminQ C < xmaxQ C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`];
+  ASM_SIMP_TAC [xmin_le_xmax];
+  THM_INTRO_TAC[`C`] ymin_le_ymax;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `yminQ C < ymaxQ C` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`];
+  ASM_SIMP_TAC[ymin_le_ymax];
+  TYPE_THEN `!p. C p ==> (p = point(xminQ C,yminQ C))` SUBAGOAL_TAC;
+  TYPE_THEN `euclid 2 p` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  ASM_REWRITE_TAC[];
+  USEH 7802 (MATCH_MP point_onto);
+(*** Modified by JRH for proper right associativity of "="
+  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;REAL_ARITH `x = y = (x <= y) /\ (y <= x)`];
+ ***)
+  ASM_REWRITE_TAC[point_inj;PAIR_SPLIT;GSYM REAL_LE_ANTISYM];
+  TYPE_THEN `(FST p' = p 0) /\ (SND p' = p 1)` SUBAGOAL_TAC;
+  ASM_REWRITE_TAC[coord01];
+  KILLH 5687;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  xmaxQ_max;
+  ASM_REWRITE_TAC[];
+  USEH 5418 GSYM;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  xminQ_min;
+  ASM_REWRITE_TAC[];
+  (* --- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  ymaxQ_max;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `ymaxQ C` UNABBREV_TAC;
+  IMATCH_MP_TAC  yminQ_min;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`C`] simple_closed_curve_nonempty;
+  ASM_REWRITE_TAC[];
+  COPYH 9414;
+  TSPECH `p` 9414;
+  TYPE_THEN `point(xminQ C,yminQ C)` UNABBREV_TAC;
+  THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  (* -A  BACK ON *)
+  TYPE_THEN `!p. C p ==> (euclid 2 p)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!p. C p ==> (p 0 = xmaxQ C)` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ARITH `(x = y) <=> (x <= y) /\ (y <= x)`];
+  CONJ_TAC;
+  IMATCH_MP_TAC  xmaxQ_max;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `xmaxQ C` UNABBREV_TAC;
+  IMATCH_MP_TAC  xminQ_min;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!p. C p ==> (yminQ C <= p 1 /\ p 1 <= ymaxQ C)` SUBAGOAL_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  yminQ_min;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  ymaxQ_max;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `C (point(xminQ C,yminQ C))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`C`] yminQ_exists;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p = point(xminQ C, yminQ C)` BACK_TAC ;
+  TYPE_THEN `p` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  TSPECH `p` 2734;
+  USEH 7802 (MATCH_MP point_onto);
+  TYPE_THEN `p` UNABBREV_TAC;
+  REWRITE_TAC[point_inj];
+  REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `yminQ C` UNABBREV_TAC;
+  REWRITE_TAC[coord01];
+  TSPECH `point p'` 111;
+  TYPE_THEN `xmaxQ C` UNABBREV_TAC;
+  TYPE_THEN `xminQ C` UNABBREV_TAC;
+  REWRITE_TAC[coord01];
+  (* - *)
+  TYPE_THEN `C (point(xminQ C,ymaxQ C))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`C`] ymaxQ_exists;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p = point(xminQ C, ymaxQ C)` BACK_TAC ;
+  TYPE_THEN `p` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  TSPECH `p` 2734;
+  USEH 7802 (MATCH_MP point_onto);
+  TYPE_THEN `p` UNABBREV_TAC;
+  REWRITE_TAC[point_inj];
+  REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `ymaxQ C` UNABBREV_TAC;
+  REWRITE_TAC[coord01];
+  TSPECH `point p'` 111;
+  TYPE_THEN `xmaxQ C` UNABBREV_TAC;
+  TYPE_THEN `xminQ C` UNABBREV_TAC;
+  REWRITE_TAC[coord01];
+  (* - *)
+  TYPE_THEN `C SUBSET mk_segment (point (xminQ C,yminQ C)) (point(xminQ C,ymaxQ C))` SUBAGOAL_TAC;
+  ASM_SIMP_TAC [SUBSET;mk_segment_v];
+  TYPE_THEN `x 1` EXISTS_TAC;
+  TYPE_THEN `yminQ C <= x 1 /\ x 1 <= ymaxQ C ` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  TSPECH `x` 2734;
+  USEH 1837 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  REWRITE_TAC[point_inj];
+  REWRITE_TAC[PAIR_SPLIT;coord01];
+  TYPE_THEN `FST p = point p 0` SUBAGOAL_TAC;
+  REWRITE_TAC[coord01];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `q = point p` ABBREV_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* -B *)
+  THM_INTRO_TAC[`C`;`mk_segment (point (xminQ C,yminQ C)) (point (xminQ C,ymaxQ C))`] simple_closed_curve_nsubset_arc;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  TYPE_THEN `point(xmaxQ C,yminQ C)` EXISTS_TAC;
+  TYPE_THEN `point(xmaxQ C,ymaxQ C)` EXISTS_TAC;
+  IMATCH_MP_TAC  mk_segment_simple_arc_end;
+  REWRITE_TAC[PAIR_SPLIT;point_inj ;euclid_point ];
+  UNDH 1234 THEN UNDH 5378 THEN REAL_ARITH_TAC;
+  ASM_MESON_TAC[];
+  (* Sun Jan 16 15:26:36 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let ymin_lt_ymax = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==> (yminQ C < ymaxQ C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[REAL_ARITH `x < y <=> (x <= y) /\ ~(x = y)`];
+  ASM_SIMP_TAC [ymin_le_ymax];
+  THM_INTRO_TAC[`C`] xmin_lt_xmax;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!p. C p ==> (euclid 2 p)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!p. C p ==> (p 1 = ymaxQ C)` SUBAGOAL_TAC;
+  REWRITE_TAC[REAL_ARITH `(x = y) <=> (x <= y) /\ (y <= x)`];
+  CONJ_TAC;
+  IMATCH_MP_TAC  ymaxQ_max;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `ymaxQ C` UNABBREV_TAC;
+  IMATCH_MP_TAC  yminQ_min;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!p. C p ==> (xminQ C <= p 0 /\ p 0 <= xmaxQ C)` SUBAGOAL_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  xminQ_min;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  xmaxQ_max;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `C (point(xminQ C,yminQ C))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`C`] xminQ_exists;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p = point(xminQ C, yminQ C)` BACK_TAC ;
+  TYPE_THEN `p` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  TSPECH `p` 2734;
+  USEH 7802 (MATCH_MP point_onto);
+  TYPE_THEN `p` UNABBREV_TAC;
+  REWRITE_TAC[point_inj];
+  REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `xminQ C` UNABBREV_TAC;
+  REWRITE_TAC[coord01];
+  TSPECH `point p'` 4874;
+  TYPE_THEN `ymaxQ C` UNABBREV_TAC;
+  TYPE_THEN `yminQ C` UNABBREV_TAC;
+  REWRITE_TAC[coord01];
+  (* - *)
+  TYPE_THEN `C (point(xmaxQ C,yminQ C))` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`C`] xmaxQ_exists;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p = point(xmaxQ C, yminQ C)` BACK_TAC ;
+  TYPE_THEN `p` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  TSPECH `p` 2734;
+  USEH 7802 (MATCH_MP point_onto);
+  TYPE_THEN `p` UNABBREV_TAC;
+  REWRITE_TAC[point_inj];
+  REWRITE_TAC[PAIR_SPLIT];
+  TYPE_THEN `xmaxQ C` UNABBREV_TAC;
+  REWRITE_TAC[coord01];
+  TSPECH `point p'` 4874;
+  TYPE_THEN `ymaxQ C` UNABBREV_TAC;
+  TYPE_THEN `yminQ C` UNABBREV_TAC;
+  REWRITE_TAC[coord01];
+  (* - *)
+  TYPE_THEN `C SUBSET mk_segment (point (xminQ C,yminQ C)) (point(xmaxQ C,yminQ C))` SUBAGOAL_TAC;
+  TYPE_THEN `xminQ C <= xmaxQ C` SUBAGOAL_TAC;
+  UNDH 5679 THEN REAL_ARITH_TAC;
+  ASM_SIMP_TAC [SUBSET;mk_segment_h];
+  TYPE_THEN `x 0` EXISTS_TAC;
+  TYPE_THEN `xminQ C <= x 0 /\ x 0 <= xmaxQ C ` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  TSPECH `x` 2734;
+  USEH 1837 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  REWRITE_TAC[point_inj];
+  REWRITE_TAC[PAIR_SPLIT;coord01];
+  TYPE_THEN `SND  p = point p 1` SUBAGOAL_TAC;
+  REWRITE_TAC[coord01];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `q = point p` ABBREV_TAC ;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* -B *)
+  THM_INTRO_TAC[`C`;`mk_segment (point (xminQ C,yminQ C)) (point (xmaxQ C,yminQ C))`] simple_closed_curve_nsubset_arc;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  TYPE_THEN `point(xminQ C,ymaxQ C)` EXISTS_TAC;
+  TYPE_THEN `point(xmaxQ C,ymaxQ C)` EXISTS_TAC;
+  IMATCH_MP_TAC  mk_segment_simple_arc_end;
+  REWRITE_TAC[PAIR_SPLIT;point_inj ;euclid_point ];
+  UNDH 5418 THEN UNDH 5679 THEN REAL_ARITH_TAC;
+  ASM_MESON_TAC[];
+  (* Sun Jan 16 15:39:56 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_closed_curve_closed = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==> (closed_ top2 C)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] simple_closed_curve_nonempty;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`;`p`] simple_closed_curve_2pt;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`;`p`;`q`] simple_closed_cut;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `C` UNABBREV_TAC;
+  IMATCH_MP_TAC  closed_union;
+  REWRITE_TAC[top2_top];
+  CONJ_TAC THEN IMATCH_MP_TAC  simple_arc_end_closed THEN UNIFY_EXISTS_TAC  THEN ASM_REWRITE_TAC[];
+  (* Sun Jan 16 16:43:23 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_closed_curve_mk_C = prove_by_refinement(
+  `!Q.  simple_closed_curve top2 Q ==>
+       ?C v1 v2. simple_arc_end C v1 v2 /\
+       (C INTER Q = {v1,v2}) /\
+       (v2 1 = yminQ Q) /\
+       (v1 1 = ymaxQ Q) /\
+       (!x. C x ==>
+           (x 1 = yminQ Q) \/ (x 1 = ymaxQ Q) \/ (xmaxQ Q < x 0))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `Ca = mk_segment (point(xminQ Q,yminQ Q)) (point(xmaxQ Q + &1,yminQ Q))` ABBREV_TAC ;
+  (* - *)
+  TYPE_THEN `xminQ Q <= xmaxQ Q + &1` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `xmaxQ Q` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC xmin_le_xmax;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  (* - *)
+  THM_INTRO_TAC[`Ca`;`Ca INTER Q`;`{(point(xmaxQ Q + &1,yminQ Q))}`] simple_arc_end_restriction;
+  SUBCONJ_TAC;
+  TYPE_THEN `Ca` UNABBREV_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  THM_INTRO_TAC[`point(xminQ Q,yminQ Q)`;`point(xmaxQ Q + &1,yminQ Q)`] mk_segment_simple_arc_end;
+  REWRITE_TAC[euclid_point;point_inj;PAIR_SPLIT];
+  THM_INTRO_TAC[`Q`] xmin_lt_xmax;
+  ASM_REWRITE_TAC[];
+  UNDH 2298 THEN UNDH 9105 THEN REAL_ARITH_TAC;
+  ASM_MESON_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  closed_inter2;
+  REWRITE_TAC[top2_top];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_closed;
+  ASM_MESON_TAC[simple_arc_choose_end];
+  IMATCH_MP_TAC  simple_closed_curve_closed;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  REWRITE_TAC[EMPTY_EXISTS;INTER;];
+  REWRITE_TAC[INR IN_SING;EQ_EMPTY];
+  CONJ_TAC;
+  IMATCH_MP_TAC  closed_point;
+  REWRITE_TAC[euclid_point];
+  (* -- *)
+  CONJ_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  THM_INTRO_TAC[`Q`] xmaxQ_max;
+  TSPECH  `(point (xmaxQ Q + &1, yminQ Q))` 9371;
+  REWRH 3532;
+  FULL_REWRITE_TAC[coord01];
+  UNDH 3234 THEN REAL_ARITH_TAC;
+  (* -- *)
+  CONJ_TAC;
+  THM_INTRO_TAC[`Q`] yminQ_exists;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Ca` UNABBREV_TAC;
+  ASM_SIMP_TAC[mk_segment_h];
+  TYPE_THEN `p 0` EXISTS_TAC;
+  TYPE_THEN `yminQ Q` UNABBREV_TAC;
+  (* --- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  xminQ_min;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `xmaxQ Q` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  xmaxQ_max;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  IMATCH_MP_TAC  (GSYM euclid2_point);
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `Q` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `Ca` UNABBREV_TAC;
+  ASM_SIMP_TAC[mk_segment_h];
+  REWRITE_TAC[point_inj; PAIR_SPLIT;];
+  CONV_TAC (dropq_conv "t");
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  (* -A *)
+  TYPE_THEN `Cb = mk_segment(point(xminQ Q,ymaxQ Q)) (point(xmaxQ Q + &1,ymaxQ Q))` ABBREV_TAC ;
+  THM_INTRO_TAC[`Cb`;`Cb INTER Q`;`{(point(xmaxQ Q + &1,ymaxQ Q))}`] simple_arc_end_restriction;
+  SUBCONJ_TAC;
+  TYPE_THEN `Cb` UNABBREV_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  THM_INTRO_TAC[`point(xminQ Q,ymaxQ Q)`;`point(xmaxQ Q + &1,ymaxQ Q)`] mk_segment_simple_arc_end;
+  REWRITE_TAC[euclid_point;point_inj;PAIR_SPLIT];
+  THM_INTRO_TAC[`Q`] xmin_lt_xmax;
+  ASM_REWRITE_TAC[];
+  UNDH 2298 THEN UNDH 9105 THEN REAL_ARITH_TAC;
+  ASM_MESON_TAC[];
+  (* -- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  closed_inter2;
+  REWRITE_TAC[top2_top];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_closed;
+  ASM_MESON_TAC[simple_arc_choose_end];
+  IMATCH_MP_TAC  simple_closed_curve_closed;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  REWRITE_TAC[EMPTY_EXISTS;INTER;];
+  REWRITE_TAC[INR IN_SING;EQ_EMPTY];
+  CONJ_TAC;
+  IMATCH_MP_TAC  closed_point;
+  REWRITE_TAC[euclid_point];
+  (* -- *)
+  CONJ_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  THM_INTRO_TAC[`Q`] xmaxQ_max;
+  TSPECH  `(point (xmaxQ Q + &1, ymaxQ Q))` 9371;
+  REWRH 5576;
+  FULL_REWRITE_TAC[coord01];
+  UNDH 3234 THEN REAL_ARITH_TAC;
+  (* -- *)
+  CONJ_TAC;
+  THM_INTRO_TAC[`Q`] ymaxQ_exists;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `p` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Cb` UNABBREV_TAC;
+  ASM_SIMP_TAC[mk_segment_h];
+  TYPE_THEN `p 0` EXISTS_TAC;
+  TYPE_THEN `ymaxQ Q` UNABBREV_TAC;
+  (* --- *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  xminQ_min;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LE_TRANS;
+  TYPE_THEN `xmaxQ Q` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  xmaxQ_max;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  IMATCH_MP_TAC  (GSYM euclid2_point);
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `Q` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  CONV_TAC (dropq_conv "u");
+  TYPE_THEN `Cb` UNABBREV_TAC;
+  ASM_SIMP_TAC[mk_segment_h];
+  REWRITE_TAC[point_inj; PAIR_SPLIT;];
+  CONV_TAC (dropq_conv "t");
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  (* -B *)
+  TYPE_THEN `Cu = mk_segment (point(xmaxQ Q + &1,yminQ Q)) (point(xmaxQ Q + &1, ymaxQ Q))` ABBREV_TAC ;
+  TYPE_THEN `simple_arc_end Cu (point(xmaxQ Q + &1,yminQ Q)) (point(xmaxQ Q + &1, ymaxQ Q))` SUBAGOAL_TAC;
+  TYPE_THEN `Cu` UNABBREV_TAC;
+  IMATCH_MP_TAC  mk_segment_simple_arc_end;
+  REWRITE_TAC[euclid_point];
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  THM_INTRO_TAC[`Q`] ymin_lt_ymax;
+  ASM_REWRITE_TAC[];
+  UNDH 6486 THEN UNDH 6716 THEN REAL_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `yminQ Q <= ymaxQ Q` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  ymin_le_ymax;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `v' = point (xmaxQ Q + &1,yminQ Q)` SUBAGOAL_TAC;
+  USEH 1212 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `v'` UNABBREV_TAC;
+  (* - *)
+  TYPE_THEN `v''' = point (xmaxQ Q + &1,ymaxQ Q)` SUBAGOAL_TAC;
+  USEH 7634 (REWRITE_RULE[INTER;INR IN_SING;eq_sing]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `v'''` UNABBREV_TAC;
+  (* - *)
+  THM_INTRO_TAC[`C'`;`Cu`;`v`;`point(xmaxQ Q + &1,yminQ Q)`;`point(xmaxQ Q + &1,ymaxQ Q)`] simple_arc_end_trans;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[eq_sing;INR IN_SING;INTER;];
+  CONJ_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Cu` UNABBREV_TAC;
+  REWRITE_TAC[mk_segment_end];
+  TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  USEH 2838 (MATCH_MP point_onto);
+  TYPE_THEN `u` UNABBREV_TAC;
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  CONJ_TAC;
+  TYPE_THEN `Cu` UNABBREV_TAC;
+  UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]);
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Ca (point p)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `Ca` UNABBREV_TAC;
+  UNDH 3719 THEN (ASM_SIMP_TAC[mk_segment_h]);
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  ASM_REWRITE_TAC[];
+  (* -C *)
+  TYPE_THEN `((C' UNION Cu) INTER Q = {v}) /\ ((C' UNION Cu) INTER C'' = {(point(xmaxQ Q + &1,ymaxQ Q))}) /\ (v 1 = yminQ Q) /\ (!x. (C' UNION Cu) x ==> (x 1 = yminQ Q) \/ (xmaxQ Q < x 0))` SUBAGOAL_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[INTER;eq_sing;INR IN_SING];
+  CONJ_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  USEH 2123 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  ASM_REWRITE_TAC[];
+  USEH 579 (REWRITE_RULE[UNION]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  USEH 2123 (REWRITE_RULE[eq_sing;INTER;INR IN_SING]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `Cu` UNABBREV_TAC;
+  TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `Q` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  ASM_REWRITE_TAC[];
+  USEH 2838 (MATCH_MP point_onto);
+  TYPE_THEN `u` UNABBREV_TAC;
+  UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]);
+  FULL_REWRITE_TAC[PAIR_SPLIT;point_inj];
+  THM_INTRO_TAC[`Q`] xmaxQ_max;
+  TSPECH `(point p)` 9371;
+  REWRH 375;
+  TYPE_THEN `FST p = point p 0` SUBAGOAL_TAC;
+  REWRITE_TAC[coord01];
+  TYPE_THEN `FST p` UNABBREV_TAC;
+  TYPE_THEN `point p 0` UNABBREV_TAC;
+  UNDH 3234 THEN REAL_ARITH_TAC;
+  (* -- *)
+  CONJ_TAC;
+  REWRITE_TAC[eq_sing;INR IN_SING;INTER];
+  CONJ_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[UNION];
+  DISJ2_TAC;
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  USEH 2838 (MATCH_MP point_onto);
+  TYPE_THEN `u` UNABBREV_TAC;
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  (* --- *)
+  USEH 311 (REWRITE_RULE[UNION]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `Ca (point p) /\ Cb (point p)` SUBAGOAL_TAC;
+  CONJ_TAC THEN IMATCH_MP_TAC  subset_imp THEN ASM_MESON_TAC[];
+  TYPE_THEN `Ca` UNABBREV_TAC;
+  TYPE_THEN `Cb` UNABBREV_TAC;
+  UNDH 4559 THEN UNDH 3719 THEN ASM_SIMP_TAC[mk_segment_h];
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  TYPE_THEN `SND p` UNABBREV_TAC;
+  THM_INTRO_TAC[`Q`] ymin_lt_ymax;
+  ASM_REWRITE_TAC[];
+  UNDH 6486 THEN UNDH 6716 THEN REAL_ARITH_TAC;
+  THM_INTRO_TAC[`p`] (GSYM coord01);
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `Cu` UNABBREV_TAC;
+  UNDH 5078 THEN ASM_SIMP_TAC[mk_segment_v];
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  ASM_MESON_TAC[];
+  TYPE_THEN `Cb (point p)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C''` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `Cb` UNABBREV_TAC;
+  UNDH 4559 THEN (ASM_SIMP_TAC[mk_segment_h]);
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `!x. C' x ==> (x 1 = yminQ Q)` SUBAGOAL_TAC;
+  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  USEH 1837 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `Ca (point p)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `Ca` UNABBREV_TAC;
+  UNDH 3719 THEN (ASM_SIMP_TAC[mk_segment_h]);
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  ASM_REWRITE_TAC[coord01];
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  (* -- *)
+  USEH 9465 (REWRITE_RULE[UNION]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  DISJ1_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISJ2_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH  `(u + &1  = v) ==> (u < v)`);
+  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `Cu` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  USEH 1837 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `Cu` UNABBREV_TAC;
+  UNDH 5078 THEN (ASM_SIMP_TAC[mk_segment_v]);
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  ASM_SIMP_TAC[coord01];
+  (* -D *)
+  TYPE_THEN `Cf = C' UNION Cu` ABBREV_TAC ;
+  KILLH 7427 THEN KILLH 6091 THEN KILLH 7407 THEN KILLH 1428 THEN KILLH 2123 THEN KILLH 7904 THEN KILLH 700 THEN KILLH 3022;
+  (* - *)
+  TYPE_THEN `!x. C'' x ==> (x 1 = ymaxQ Q)` SUBAGOAL_TAC;
+  TYPE_THEN `euclid 2 x` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+ USEH 1837 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `Cb (point p)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `Cb` UNABBREV_TAC;
+  UNDH 4559 THEN (ASM_SIMP_TAC[mk_segment_h]);
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  ASM_REWRITE_TAC[coord01];
+  (* - *)
+  TYPE_THEN `C'' INTER Q = {v''}` SUBAGOAL_TAC;
+  REWRITE_TAC[eq_sing;INR IN_SING;INTER;];
+  USEH 6873 (REWRITE_RULE[SUBSET]);
+  USEH 6548 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`Cf`;`C''`;`v`;`point(xmaxQ Q + &1,ymaxQ Q)`;`v''`] simple_arc_end_trans;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Cf UNION C''` EXISTS_TAC;
+  TYPE_THEN `v''` EXISTS_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -E *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  REWRITE_TAC[SUBSET;INTER ;INR in_pair;];
+  CONJ_TAC;
+  USEH 3594 (REWRITE_RULE[UNION]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  DISJ1_TAC;
+  USEH 5392 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  DISJ2_TAC;
+  USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[UNION];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  USEH 5392 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `x` UNABBREV_TAC;
+  USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  USEH 264 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  ASM_REWRITE_TAC[];
+  USEH 3594 (REWRITE_RULE[UNION]);
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* Sun Jan 16 18:43:03 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let simple_arc_end_IVT = prove_by_refinement(
+  `!C v w i y. simple_arc_end C v w /\ v i <= y /\ y <= w i ==>
+           (?u. C u /\ (u i = y)) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] simple_arc_connected;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`i`;`2`] continuous_euclid1;
+  FULL_REWRITE_TAC[GSYM top2];
+  (* - *)
+  THM_INTRO_TAC[`coord i`;`top2`;`top_of_metric(UNIV,d_real)`;`C`] connect_image;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[metric_real;GSYM top_of_metric_unions];
+  (* - *)
+  TYPE_THEN `!u. C u ==> (IMAGE (coord i) C) (u i)` SUBAGOAL_TAC;
+  TYPE_THEN `u i = coord i u` SUBAGOAL_TAC;
+  REWRITE_TAC[coord];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`IMAGE (coord i) C`;`v i`;`w i`] connected_nogap;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  (* - *)
+  USEH 9674 (REWRITE_RULE[SUBSET;IMAGE;coord]);
+  USEH 8862 GSYM;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* Mon Jan 17 07:07:14 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let simple_closed_curve_mk_ABD = prove_by_refinement(
+  `!Q v1 v2. simple_closed_curve top2 Q /\
+       Q v1 /\ Q v2 /\ (v2 1 = yminQ Q) /\ (v1 1 = ymaxQ Q) ==>
+       (?A B D w1 w2.
+          simple_arc_end A v1 v2 /\
+          simple_arc_end B v1 v2 /\
+          (A UNION B = Q) /\
+          (A INTER B = {v1,v2}) /\
+          ~(w1 = v1) /\
+          ~(w1 = v2) /\
+          ~(w2 = v1) /\
+          ~(w2 = v2) /\
+          A w1 /\ B w2 /\
+          simple_arc_end D w1 w2 /\
+          (D INTER Q = {w1,w2}) /\
+          (!x. D x ==>
+              (yminQ Q < x 1) /\ (x 1 < ymaxQ Q) /\ (x 0 <= xmaxQ Q))
+       )`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `ymid = (yminQ Q + ymaxQ Q)/(&2)` ABBREV_TAC ;
+  TYPE_THEN `yminQ Q < ymaxQ Q` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  ymin_lt_ymax;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `yminQ Q < ymid /\ ymid < ymaxQ Q` SUBAGOAL_TAC;
+  TYPE_THEN `ymid` UNABBREV_TAC;
+  CONJ_TAC THENL[IMATCH_MP_TAC  real_middle1_lt;IMATCH_MP_TAC  real_middle2_lt] THEN ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~(v1 = v2)` SUBAGOAL_TAC;
+  TYPE_THEN `v2` UNABBREV_TAC;
+  TYPE_THEN `v1 1` UNABBREV_TAC;
+  UNDH 6716 THEN UNDH 6486 THEN REAL_ARITH_TAC;
+  (* - *)
+  THM_INTRO_TAC[`Q`;`v1`;`v2`] simple_closed_cut;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `A = C'` ABBREV_TAC ;
+  TYPE_THEN `C'` UNABBREV_TAC;
+  TYPE_THEN `B = C''` ABBREV_TAC ;
+  TYPE_THEN `C''` UNABBREV_TAC;
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `B` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `C = mk_segment (point(xminQ Q,ymid)) (point(xmaxQ Q,ymid))` ABBREV_TAC ;
+  TYPE_THEN `xminQ Q <= xmaxQ Q` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  xmin_le_xmax;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`(point(xminQ Q,ymid))`;`point(xmaxQ Q,ymid)`] mk_segment_simple_arc_end;
+  REWRITE_TAC[point_inj;PAIR_SPLIT;euclid_point];
+  TYPE_THEN `xminQ Q < xmaxQ Q` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  xmin_lt_xmax;
+  ASM_REWRITE_TAC[];
+  UNDH 3331 THEN UNDH 9105 THEN REAL_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  TYPE_THEN `C` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `!x. C x ==> euclid 2 x` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_euclid;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `!x. C x ==> (x 1 = ymid)` SUBAGOAL_TAC;
+  TSPECH `x` 2734;
+  USEH 1837 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  UNDH 3980 THEN (ASM_SIMP_TAC[mk_segment_h]);
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  ASM_REWRITE_TAC[coord01];
+  (* -A *)
+  TYPE_THEN `!x. C x ==> yminQ Q < x 1 /\ x 1 < ymaxQ Q /\ x 0 <= xmaxQ Q` SUBAGOAL_TAC;
+  TSPECH `x` 2734;
+  USEH 1837 (MATCH_MP point_onto);
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `C` UNABBREV_TAC;
+  UNDH 3980 THEN UNDH 8406 THEN (SIMP_TAC[mk_segment_h]);
+  FULL_REWRITE_TAC[point_inj;PAIR_SPLIT];
+  ASM_REWRITE_TAC[coord01];
+  (* - *)
+  THM_INTRO_TAC[`C`;`A INTER C`;`B INTER C`] simple_arc_end_restriction;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[] top2_top;
+  TYPE_THEN `!E v v'. simple_arc_end E v v' ==> closed_ top2 E` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_closed;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  closed_inter2;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  closed_inter2;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[INTER;EMPTY_EXISTS];
+  REWRITE_TAC[EQ_EMPTY];
+  CONJ_TAC;
+  TYPE_THEN `(x 1 = ymid)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  TSPECH `x` 6622 ;
+  USEH 3537 (REWRITE_RULE[INTER;INR in_pair]);
+  REWRH 6257;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `v2 1` UNABBREV_TAC;
+  UNDH 3402 THEN UNDH 3172 THEN REAL_ARITH_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `v1 1` UNABBREV_TAC;
+  UNDH 9315 THEN UNDH 8976 THEN REAL_ARITH_TAC;
+  (* --  *)
+  TYPE_THEN `!E. simple_arc_end E v1 v2 /\ (E SUBSET Q) ==> (?u. C u /\ E u)` BACK_TAC;
+  CONJ_TAC;
+  UNDH 7189 THEN DISCH_THEN (THM_INTRO_TAC[`A`]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Q` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
+  ASM_MESON_TAC[];
+  UNDH 7189 THEN DISCH_THEN (THM_INTRO_TAC[`B`]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Q` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;UNION] THEN MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* --B intermediate value theorem needed *)
+  THM_INTRO_TAC[`E`;`v2`;`v1`;`1`;`ymid`] simple_arc_end_IVT;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  UNDH 3172 THEN UNDH 8976 THEN REAL_ARITH_TAC;
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `C` UNABBREV_TAC;
+  TYPE_THEN `euclid 2 u` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `E` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_euclid;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  USEH 2838 (MATCH_MP point_onto);
+  TYPE_THEN `u` UNABBREV_TAC;
+  UNDH 8406 THEN SIMP_TAC[mk_segment_h];
+  REWRITE_TAC[point_inj;PAIR_SPLIT];
+  TYPE_THEN `FST p` EXISTS_TAC;
+  USEH 6779 GSYM;
+  ASM_REWRITE_TAC[coord01];
+  (* -- *)
+  TYPE_THEN `Q (point p)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  THM_INTRO_TAC[`Q`;`point p`] xminQ_min;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`Q`;`point p`] xmaxQ_max;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[GSYM coord01];
+  (* -C *)
+  TYPE_THEN `D = C'''` ABBREV_TAC ;
+  TYPE_THEN `C'''` UNABBREV_TAC;
+  TYPE_THEN `w1 = v` ABBREV_TAC ;
+  TYPE_THEN `v` UNABBREV_TAC;
+  TYPE_THEN `w2 = v'` ABBREV_TAC ;
+  TYPE_THEN `v'` UNABBREV_TAC;
+  TYPE_THEN `D` EXISTS_TAC;
+  TYPE_THEN `w1` EXISTS_TAC;
+  TYPE_THEN `w2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `A w1 /\ B w2` SUBAGOAL_TAC;
+  USEH 5104  (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  USEH 7194  (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `D INTER Q = {w1,w2}` SUBAGOAL_TAC;
+  TYPE_THEN `Q` UNABBREV_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;UNION;INR in_pair];
+  UNDH 5104 THEN UNDH 7194 THEN UNDH 2332 THEN (REWRITE_TAC [eq_sing;INR IN_SING;INTER;SUBSET]) THEN MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `(!x. D x ==> yminQ Q < x 1 /\ x 1 < ymaxQ Q /\ x 0 <= xmaxQ Q)` SUBAGOAL_TAC;
+  TYPE_THEN `C x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -D *)
+  TYPE_THEN `~(v1 1 = ymid)` SUBAGOAL_TAC;
+  TYPE_THEN `v1 1` UNABBREV_TAC;
+  UNDH 9315 THEN UNDH 8976 THEN REAL_ARITH_TAC;
+  TYPE_THEN `~(v2 1 = ymid)` SUBAGOAL_TAC;
+  TYPE_THEN `v2 1` UNABBREV_TAC;
+  UNDH 3402 THEN UNDH 3172 THEN REAL_ARITH_TAC;
+  (* - *)
+  TYPE_THEN `!w. D w ==> (w 1 = ymid)` SUBAGOAL_TAC;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  TYPE_THEN `D w1 /\ D w2` SUBAGOAL_TAC;
+  USEH 2450 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USEH 5003 (REWRITE_RULE[INTER;INR in_pair]);
+  UNDH 6817 THEN MESON_TAC[];
+  TYPE_THEN `!w v. (D w) /\ ~(v 1 = ymid) ==> ~(w = v)` SUBAGOAL_TAC;
+  TYPE_THEN `v''` UNABBREV_TAC;
+  UNDH 5813 THEN ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  REPEAT CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC  THEN ASM_REWRITE_TAC[];
+  (* Mon Jan 17 07:35:06 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let one_sided_jordan_curve = jordan_def `one_sided_jordan_curve Q <=>
+   (!v w. euclid 2 v /\ euclid 2 w /\ ~Q v /\ ~Q w /\ ~(v = w) ==>
+       (?C. simple_arc_end C v w /\ (C INTER Q = EMPTY)))`;;
+
+let simple_closed_curve_mk_E = prove_by_refinement(
+  `!Q C D . simple_closed_curve top2 Q /\ one_sided_jordan_curve Q /\
+    ~(C SUBSET Q) /\ ~(D SUBSET Q) /\
+    simple_arc top2 C /\ simple_arc top2 D /\ (C INTER D = EMPTY) ==>
+   (?E x1 x2. simple_arc_end E x1 x2 /\
+       (E INTER C = {x2}) /\ (E INTER D = {x1}) /\ (E INTER Q = EMPTY))`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `?c. C c /\ ~Q c` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  TYPE_THEN `?d. D d /\ ~Q d` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[SUBSET];
+  ASM_MESON_TAC[];
+  (* - *)
+  FULL_REWRITE_TAC[one_sided_jordan_curve];
+  (* - *)
+  TYPE_THEN `!R x. simple_arc top2 R /\ R x ==> euclid 2 x` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `R` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_euclid;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  UNDH 8763 THEN DISCH_THEN (THM_INTRO_TAC[`c`;`d`]);
+  ASM_REWRITE_TAC[];
+  USEH 6641 (REWRITE_RULE[INTER;EQ_EMPTY]);
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`C'`;`C`;`D`] simple_arc_end_restriction;
+  ASM_REWRITE_TAC[EMPTY_EXISTS; INTER_EMPTY; ];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_closed;
+  IMATCH_MP_TAC  simple_arc_choose_end;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_closed;
+  IMATCH_MP_TAC  simple_arc_choose_end;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INTER];
+  CONJ_TAC;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -A *)
+  TYPE_THEN `E = C''` ABBREV_TAC ;
+  TYPE_THEN `C''` UNABBREV_TAC;
+  TYPE_THEN `E` EXISTS_TAC;
+  TYPE_THEN `v'` EXISTS_TAC;
+  TYPE_THEN `v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  UNDH 3420 THEN UNDH 5123 THEN (REWRITE_TAC[EQ_EMPTY;INTER;SUBSET]) THEN MESON_TAC[];
+  (* Mon Jan 17 08:50:35 EST 2005 *)
+  ]);;
+
+  (* }}} *)
+
+let jordan_curve_k33_data = jordan_def
+  `jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 <=>
+     simple_closed_curve top2 Q /\
+     simple_arc_end A v1 v2 /\
+     simple_arc_end B v1 v2 /\
+     simple_arc_end C v1 v2 /\
+     simple_arc_end D w1 w2 /\
+     simple_arc_end E x1 x2 /\
+          ~(w1 = v1) /\
+          ~(w1 = v2) /\
+          ~(w2 = v1) /\
+          ~(w2 = v2) /\
+          A w1 /\ B w2 /\
+       (A UNION B = Q) /\
+       (A INTER B = {v1,v2}) /\
+       (D INTER Q = {w1,w2}) /\
+       (C INTER D = EMPTY) /\
+       (C INTER Q = {v1,v2}) /\
+       (E INTER C = {x2}) /\
+       (E INTER D = {x1}) /\
+       (E INTER Q = EMPTY)`;;
+
+
+let jordan_curve_k33_data_exist = prove_by_refinement(
+  `!Q. simple_closed_curve top2 Q /\ one_sided_jordan_curve Q ==>
+    (?A B C D E v1 v2 w1 w2 x1 x2.
+         jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[jordan_curve_k33_data];
+  THM_INTRO_TAC[`Q`] simple_closed_curve_mk_C;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`Q`;`v1`;`v2`] simple_closed_curve_mk_ABD;
+  ASM_REWRITE_TAC[];
+  USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USEH 7606 (REWRITE_RULE[INTER;INR in_pair]);
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `B` EXISTS_TAC;
+  TYPE_THEN `C` EXISTS_TAC;
+  TYPE_THEN `D` EXISTS_TAC;
+  (* - *)
+  TYPE_THEN `C INTER D = EMPTY` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USEH 7282 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
+  TSPECH `u` 3184;
+  TSPECH `u` 9655;
+  UNDH 1134 THEN UNDH 2424 THEN UNDH 920 THEN UNDH 4468 THEN REAL_ARITH_TAC;
+  (* - *)
+  THM_INTRO_TAC[`Q`;`C`;`D`] simple_closed_curve_mk_E;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  TYPE_THEN `simple_arc top2 D` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `!R y1 y2. (R INTER Q = {y1,y2}) /\ simple_arc_end R y1 y2 ==> ~(R SUBSET Q)` SUBAGOAL_TAC;
+  TYPE_THEN `R SUBSET {y1,y2}` SUBAGOAL_TAC;
+  USEH 842 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  UNDH 4643 THEN UNDH 5847 THEN (REWRITE_TAC [SUBSET;INR in_pair;INTER]) THEN MESON_TAC[];
+  TYPE_THEN `FINITE R` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `{y1,y2}` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[FINITE_RULES;FINITE_INSERT];
+  THM_INTRO_TAC[`R`] simple_arc_infinite;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  FULL_REWRITE_TAC[INFINITE];
+  ASM_MESON_TAC[];
+  CONJ_TAC THEN FIRST_ASSUM IMATCH_MP_TAC THEN ASM_REWRITE_TAC[];
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* -A *)
+  TYPE_THEN `E` EXISTS_TAC;
+  TYPE_THEN `v1` EXISTS_TAC;
+  TYPE_THEN `v2` EXISTS_TAC;
+  TYPE_THEN `w1` EXISTS_TAC;
+  TYPE_THEN `w2` EXISTS_TAC;
+  TYPE_THEN `x1` EXISTS_TAC;
+  TYPE_THEN `x2` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Mon Jan 17 09:26:35 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let has_size_insert = prove_by_refinement(
+  `!X (x:A) n.  ~(X x) /\ X HAS_SIZE n ==>
+          (x INSERT X HAS_SIZE SUC n)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[HAS_SIZE];
+  ASM_SIMP_TAC [FINITE_RULES];
+  TYPE_THEN `n` UNABBREV_TAC;
+  IMATCH_MP_TAC  (GSYM card_suc_insert);
+  ASM_REWRITE_TAC[];
+  (* Mon Jan 17 09:33:11 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let jordan_curve_x = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+      ~(Q x1) /\ ~(Q x2) /\ ~(A x1) /\ ~(A x2) /\ ~(B x1) /\ ~(B x2) /\
+       ~C x1 /\ C x2 /\ D x1 /\ ~D x2 /\ E x1 /\ E x2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[jordan_curve_k33_data];
+  TYPE_THEN `E x1 /\ E x2` SUBAGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end2;simple_arc_end_end];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~Q x1 /\ ~Q x2` SUBAGOAL_TAC;
+  USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER]);
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~A x1 /\ ~A x2 /\ ~B x1 /\ ~B x2` SUBAGOAL_TAC;
+  TYPE_THEN `Q` UNABBREV_TAC;
+  FULL_REWRITE_TAC[UNION;DE_MORGAN_THM;];
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `D x1` SUBAGOAL_TAC;
+  USEH 4975 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `C x2` SUBAGOAL_TAC;
+  USEH 1536 (REWRITE_RULE[eq_sing;INR IN_SING;INTER]);
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`E`;`x1`;`x2`] simple_arc_end_distinct;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  USEH 1536 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  ASM_MESON_TAC[];
+  USEH 4975 (REWRITE_RULE[INTER;eq_sing;INR IN_SING]);
+  ASM_MESON_TAC[];
+  (* Mon Jan 17 09:56:00 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let jordan_curve_v = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+    Q v1 /\ Q v2 /\ A v1 /\ A v2 /\ B v1 /\ B v2 /\ C v1 /\ C v2 /\
+    ~D v1 /\ ~D v2 /\ ~E v1 /\ ~E v2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[jordan_curve_k33_data];
+  TYPE_THEN `A v1 /\ A v2 /\ B v1 /\ B v2 /\ C v1 /\ C v2` SUBAGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Q v1 /\ Q v2` SUBAGOAL_TAC;
+  TYPE_THEN `Q` UNABBREV_TAC;
+  REWRITE_TAC[UNION];
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~E v1 /\ ~E v2` SUBAGOAL_TAC;
+  USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER]);
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  USEH 2450 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USEH 5003 (REWRITE_RULE[INTER;INR in_pair]);
+  ASM_MESON_TAC[];
+  (* Mon Jan 17 10:06:12 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let jordan_curve_w = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+   Q w1 /\ Q w2 /\ A w1 /\ ~A w2 /\ ~B w1 /\ B w2 /\ ~C w1 /\ ~C w2 /\
+   D w1 /\ D w2 /\ ~E w1 /\ ~E w2`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[jordan_curve_k33_data];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Q w1 /\ Q w2` SUBAGOAL_TAC;
+  TYPE_THEN `Q` UNABBREV_TAC;
+  REWRITE_TAC[UNION];
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~E w1 /\ ~E w2` SUBAGOAL_TAC;
+  USEH 885 (REWRITE_RULE[EQ_EMPTY;INTER;]);
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `D w1 /\ D w2` SUBAGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~C w1 /\ ~C w2` SUBAGOAL_TAC;
+  USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USEH 7606 (REWRITE_RULE[INTER;INR in_pair]);
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USEH 6622 (REWRITE_RULE[INTER;INR in_pair]);
+  ASM_MESON_TAC[];
+  (* Mon Jan 17 10:14:46 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let jordan_curve_AP_size3 = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+      ({w1,w2,x2} HAS_SIZE 3)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  COPYH 2122;
+  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
+  (* - *)
+  TYPE_THEN `{w1,w2,x2} = x2 INSERT {w1,w2}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_INSERT];
+  MESON_TAC[];
+  TYPE_THEN `3 = SUC 2` SUBAGOAL_TAC;
+  ARITH_TAC ;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  has_size_insert;
+  REWRITE_TAC[INR in_pair];
+  REWRITE_TAC[DE_MORGAN_THM];
+  (* - *)
+  CONJ_TAC;
+  ASM_MESON_TAC[jordan_curve_w;jordan_curve_x];
+  (* - *)
+  IMATCH_MP_TAC  pair_size_2;
+  ASM_MESON_TAC[jordan_curve_w];
+  (* Mon Jan 17 10:18:45 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_BP_size3 = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+      ({v1,v2,x1} HAS_SIZE 3)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  COPYH 2122;
+  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
+  (* - *)
+  TYPE_THEN `{v1,v2,x1} = x1 INSERT {v1,v2}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_INSERT];
+  MESON_TAC[];
+  TYPE_THEN `3 = SUC 2` SUBAGOAL_TAC;
+  ARITH_TAC ;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  has_size_insert;
+  REWRITE_TAC[INR in_pair];
+  REWRITE_TAC[DE_MORGAN_THM];
+  (* - *)
+  CONJ_TAC;
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_v);
+  USEH 2122 (MATCH_MP jordan_curve_x);
+  UNDH 2724 THEN UNDH 3425 THEN UNDH 7579 THEN MESON_TAC[];
+  (* - *)
+  IMATCH_MP_TAC  pair_size_2;
+  USEH 2191 (MATCH_MP simple_arc_end_distinct);
+  ASM_MESON_TAC[];
+  (* Mon Jan 17 10:26:14 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_AP_BP_empty = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+      ({w1,w2,x2} INTER {v1,v2,x1} = EMPTY)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  COPYH 2122;
+  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `(u = x2) \/ (u = x1) \/ ({w1,w2} u /\ {v1,v2} u)` SUBAGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  FULL_REWRITE_TAC[INR IN_INSERT];
+  UNDH 911 THEN UNDH 96 THEN UNDH 5829 THEN UNDH 4124 THEN UNDH 8311 THEN MESON_TAC[];
+  (* - *)
+  UNDH 7992 THEN REP_CASES_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INR IN_INSERT];
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_v);
+  USEH 2122 (MATCH_MP jordan_curve_x);
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `u` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INR IN_INSERT];
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_w);
+  USEH 2122 (MATCH_MP jordan_curve_x);
+  ASM_MESON_TAC[];
+  (* - *)
+  FULL_REWRITE_TAC[INR IN_INSERT];
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_w);
+  USEH 2122 (MATCH_MP jordan_curve_v);
+  ASM_MESON_TAC[];
+  (* Mon Jan 17 10:36:27 EST 2005  *)
+
+  ]);;
+  (* }}} *)
+
+let has_size_drop_le = prove_by_refinement(
+  `!n X (x:A) . FINITE X /\ CARD X <=| n ==>
+     FINITE (x INSERT X) /\ CARD (x INSERT X) <=| SUC n`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  ASM_SIMP_TAC[CARD_CLAUSES];
+  CONJ_TAC;
+  ASM_MESON_TAC[FINITE_RULES];
+  COND_CASES_TAC;
+  UNDH 2770 THEN ARITH_TAC;
+  UNDH 2770 THEN ARITH_TAC;
+  (* Mon Jan 17 10:45:48 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let has_size_le9 = prove_by_refinement(
+  `!(x1:A) x2 x3 x4 x5 x6 x7 x8 x9.
+    CARD {x1,x2,x3,x4,x5,x6,x7,x8,x9} <=| 9 /\
+    FINITE {x1,x2,x3,x4,x5,x6,x7,x8,x9}`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`0`;`EMPTY:A->bool`;`x9`] has_size_drop_le;
+  REWRITE_TAC[FINITE_RULES;CARD_CLAUSES];
+  ARITH_TAC;
+  (* - *)
+  THM_INTRO_TAC[`SUC 0`;`{x9}`;`x8`] has_size_drop_le;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`SUC(SUC 0)`;`{x8,x9}`;`x7`] has_size_drop_le;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`SUC(SUC(SUC 0))`;`{x7,x8,x9}`;`x6`] has_size_drop_le;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`SUC(SUC(SUC(SUC 0)))`;`{x6,x7,x8,x9}`;`x5`] has_size_drop_le;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC 0))))`;`{x5,x6,x7,x8,x9}`;`x4`] has_size_drop_le;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC 0)))))`;`{x4,x5,x6,x7,x8,x9}`;`x3`] has_size_drop_le;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC(SUC 0))))))`;`{x3,x4,x5,x6,x7,x8,x9}`;`x2`] has_size_drop_le;
+  ASM_REWRITE_TAC[];
+THM_INTRO_TAC[`SUC(SUC(SUC(SUC(SUC(SUC(SUC(SUC 0)))))))`;`{x2,x3,x4,x5,x6,x7,x8,x9}`;`x1`] has_size_drop_le;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  UNDH 457 THEN ARITH_TAC;
+  (* Mon Jan 17 10:58:38 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let card_surj_bij = prove_by_refinement(
+  `!(f:A->B) X Y . FINITE X /\ CARD X <=| CARD Y /\
+     (!y. Y y ==> ?x. X x /\ (f x = y)) ==>
+      BIJ f X Y`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`f`;`X`] CARD_IMAGE_LE;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`f`;`X`] FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Y SUBSET IMAGE f X` SUBAGOAL_TAC;
+  REWRITE_TAC[SUBSET;IMAGE];
+  ASM_MESON_TAC[];
+  TYPE_THEN `FINITE Y` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `CARD Y <=| CARD (IMAGE f X)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  CARD_SUBSET;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(CARD Y = CARD (IMAGE f X)) /\ (CARD (IMAGE f X) = CARD X)` SUBAGOAL_TAC;
+  UNDH 5809 THEN UNDH 8940 THEN UNDH 3182 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `Y = IMAGE f X` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  CARD_SUBSET_EQ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  REWRITE_TAC[BIJ];
+  TYPE_THEN `SURJ f X Y` SUBAGOAL_TAC;
+  REWRITE_TAC[SURJ];
+  TYPE_THEN `Y` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  REWRITE_TAC[INJ];
+  CONJ_TAC;
+  IMATCH_MP_TAC  image_imp;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `Z = X DELETE x` ABBREV_TAC ;
+  (* -A *)
+  TYPE_THEN `IMAGE f Z = Y` SUBAGOAL_TAC;
+  TYPE_THEN `Y` UNABBREV_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  TYPE_THEN `Z` UNABBREV_TAC;
+  REWRITE_TAC[DELETE;SUBSET];
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  REWRITE_TAC[SUBSET;IMAGE];
+  TYPE_THEN `x'` UNABBREV_TAC;
+  TYPE_THEN `x'' = x` ASM_CASES_TAC;
+  TYPE_THEN `x''` UNABBREV_TAC;
+  TYPE_THEN `y` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Z` UNABBREV_TAC;
+  REWRITE_TAC[DELETE];
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `x''` EXISTS_TAC;
+  TYPE_THEN `Z` UNABBREV_TAC;
+  REWRITE_TAC[DELETE];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `FINITE Z` SUBAGOAL_TAC;
+  TYPE_THEN `Z` UNABBREV_TAC;
+  REWRITE_TAC[FINITE_DELETE];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `CARD Z <| CARD X` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`x`;`X`] CARD_SUC_DELETE;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `Z` UNABBREV_TAC;
+  UNDH 481 THEN ARITH_TAC;
+  (* - *)
+  TYPE_THEN `CARD Y <= CARD Z` SUBAGOAL_TAC;
+  TYPE_THEN `Y` UNABBREV_TAC;
+  IMATCH_MP_TAC  CARD_IMAGE_LE;
+  ASM_REWRITE_TAC[];
+  UNDH 9361 THEN UNDH 6773 THEN UNDH 7923 THEN UNDH 193 THEN ARITH_TAC;
+  (* Mon Jan 17 15:04:48 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let select_inter = jordan_def
+  `select_inter A C = @x. A (x:A) /\ C x` ;;
+
+let k33f = jordan_def
+  `k33f (A:A->bool) B E = (select_inter A E, select_inter B E)`;;
+
+let incf = jordan_def
+  `incf (f:A-> (B#B)) E = { (FST (f E)) , (SND(f E)) }`;;
+
+let k33f_value = prove_by_refinement(
+  `!(A:A->bool) B E a b. (A INTER E = {a}) /\ (B INTER E = {b}) ==>
+     (k33f A B E = (a,b))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[k33f;PAIR_SPLIT];
+  CONJ_TAC;
+  REWRITE_TAC[select_inter];
+  USEH 5597 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USEH 9224 (REWRITE_RULE[INTER;INR IN_SING]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[select_inter];
+  USEH 6985 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USEH 5555 (REWRITE_RULE[INTER;INR IN_SING]);
+  ASM_REWRITE_TAC[];
+  (* Mon Jan 17 15:18:50 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let incf_value = prove_by_refinement(
+  `!(A:A->bool) B E a b. (A INTER E = {a}) /\ (B INTER E = {b}) ==>
+    (incf (k33f A B) E = {a,b})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[incf];
+  THM_INTRO_TAC[`A`;`B`;`E`;`a`;`b`] k33f_value;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* Mon Jan 17 15:22:22 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let incf_V = prove_by_refinement(
+  `!(A:A->bool) B E . SING(A INTER E) /\ SING(B INTER E) ==>
+    (incf (k33f A B) E = E INTER (A UNION B))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SING];
+  THM_INTRO_TAC[`A`;`B`;`E`;`x`;`x'`] incf_value;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[UNION_OVER_INTER];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[UNION;INR IN_SING;INR in_pair];
+  MESON_TAC[];
+  (* Mon Jan 17 15:31:21 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let k33f_E = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+    ({w1,w2,x2} INTER E = {x2}) /\
+    ({v1,v2,x1} INTER E = {x1}) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  COPYH 2122;
+  USEH 2122(MATCH_MP jordan_curve_w);
+  COPYH 2122;
+  USEH 2122(MATCH_MP jordan_curve_x);
+  USEH 2122(MATCH_MP jordan_curve_v);
+  CONJ_TAC;
+  REWRITE_TAC[INTER;INR IN_INSERT;eq_sing];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[INTER;INR IN_INSERT;eq_sing];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  (* Mon Jan 17 15:40:01 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let k33f_cut_lemma = prove_by_refinement(
+  `!C v1 v2 w A B. simple_arc_end C v1 v2 /\
+         C w /\ ~(w = v1) /\ ~(w = v2) /\
+         (A INTER C = {v1,v2}) /\
+         (B INTER C = {w}) ==>
+         (A INTER (cut_arc C v1 w) = {v1}) /\
+         (B INTER (cut_arc C v1 w) = {w})
+         `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  USEH 8436 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  THM_INTRO_TAC[`C`;`w`;`v1`;`v2`] cut_arc_inter;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[eq_sing;INR IN_INSERT;INTER;];
+  (* - *)
+  TYPE_THEN `simple_arc top2 C` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  (* - *)
+  TYPE_THEN `C v1 /\ C v2 ` SUBAGOAL_TAC;
+  ASM_MESON_TAC[simple_arc_end_end;simple_arc_end_end2];
+  (* - *)
+  TYPE_THEN `simple_arc_end (cut_arc C v1 w) v1 w` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `simple_arc_end (cut_arc C v2 w) v2 w` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `cut_arc C v1 w SUBSET C ` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cut_arc_subset;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `cut_arc C v2 w SUBSET C ` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cut_arc_subset;
+  ASM_REWRITE_TAC[];
+  (* -A *)
+  TYPE_THEN `cut_arc C w v1 = cut_arc C v1 w` SUBAGOAL_TAC;
+  MESON_TAC [cut_arc_symm];
+  TYPE_THEN `cut_arc C w v1` UNABBREV_TAC;
+  TYPE_THEN `cut_arc C w v2 = cut_arc C v2 w` SUBAGOAL_TAC;
+  MESON_TAC [cut_arc_symm];
+  TYPE_THEN `cut_arc C w v2` UNABBREV_TAC;
+  (* - *)
+  CONJ_TAC;
+  CONJ_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  TYPE_THEN `C u` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TSPECH `u` 2825;
+  REWRH 9519;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `u` UNABBREV_TAC;
+  UNDH 6835 THEN DISCH_THEN (THM_INTRO_TAC[`v2`]);
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* - *)
+  UNDH 6153 THEN DISCH_THEN  IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[subset_imp];
+  (* Mon Jan 17 16:10:38 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let k33f_cut = prove_by_refinement(
+  `!C v1 v2 w A B. simple_arc_end C v1 v2 /\
+         C w /\ ~(w = v1) /\ ~(w = v2) /\
+         (A INTER C = {v1,v2}) /\
+         (B INTER C = {w}) ==>
+         (A INTER (cut_arc C v1 w) = {v1}) /\
+         (B INTER (cut_arc C v1 w) = {w}) /\
+         (A INTER (cut_arc C v2 w) = {v2}) /\
+         (B INTER (cut_arc C v2 w) = {w})`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`;`v1`;`v2`;`w`;`A`;`B`] k33f_cut_lemma;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`;`v2`;`v1`;`w`;`A`;`B`] k33f_cut_lemma;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INR IN_INSERT];
+  MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* Mon Jan 17 16:13:48 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_k33 = jordan_def
+    `jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2 =
+       mk_graph_t ({w1,w2,x2} UNION {v1,v2,x1},
+         {E,
+          (cut_arc A v1 w1), (cut_arc A v2 w1),
+          (cut_arc B v1 w2), (cut_arc B v2 w2),
+          (cut_arc C v1 x2), (cut_arc C v2 x2),
+          (cut_arc D w1 x1),( cut_arc D w2 x1)},
+         (\ e. {(FST (k33f {w1,w2,x2} {v1,v2,x1} e)),
+                (SND (k33f {w1,w2,x2} {v1,v2,x1} e)) }))`;;
+
+let jordan_curve_AP_euclid = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+      {w1,w2,x2} UNION {v1,v2,x1} SUBSET euclid 2`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  COPYH 2122;
+  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
+  REWRITE_TAC[UNION;SUBSET;INR IN_INSERT];
+  IMATCH_MP_TAC  subset_imp;
+  TYPE_THEN `simple_arc top2 A /\  simple_arc top2 D /\ simple_arc top2 E` SUBAGOAL_TAC;
+  REPEAT CONJ_TAC THEN IMATCH_MP_TAC  simple_arc_end_simple THEN ASM_MESON_TAC[];
+  USEH 9474 (MATCH_MP simple_arc_euclid);
+  USEH 6512 (MATCH_MP simple_arc_euclid);
+  USEH 7513 (MATCH_MP simple_arc_euclid);
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_x);
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_v);
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_w);
+  UNDH 2244 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `x` UNABBREV_TAC THEN ASM_MESON_TAC[];
+  (* Mon Jan 17 17:05:26 EST 2005 *)
+  ]);;
+
+  (* }}} *)
+
+let cut_arc_simple2 = prove_by_refinement(
+  `!C v w. simple_arc top2 C /\ C v /\ C w /\ ~(v = w) ==>
+       simple_arc top2 (cut_arc C v w)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`;`v`;`w`] cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_simple;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let jordan_curve_k33_plane_criterion = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
+     (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
+     (graph G) /\
+     (!e. graph_edge G e ==> (SING ({w1,w2,x2} INTER e)) /\
+          (SING ({v1,v2,x1} INTER e))) /\
+     (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
+        e INTER e' SUBSET graph_vertex G) ==>
+     plane_graph G
+    `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  REWRITE_TAC[plane_graph];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `G` UNABBREV_TAC;
+  FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;graph_vertex_mk_graph;graph_inc_mk_graph];
+  CONJ_TAC;
+  IMATCH_MP_TAC  jordan_curve_AP_euclid;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;INR IN_INSERT];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  FULL_REWRITE_TAC[jordan_curve_k33_data];
+  ASM_MESON_TAC[simple_arc_end_simple];
+  KILLH 8072;
+  (* -- *)
+  TYPE_THEN `simple_arc top2 A /\ simple_arc top2 B /\ simple_arc top2 C /\ simple_arc top2 D` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[jordan_curve_k33_data];
+  REPEAT CONJ_TAC THEN IMATCH_MP_TAC  simple_arc_end_simple THEN ASM_MESON_TAC[];
+  (* -- *)
+  COPYH 2122;
+  USEH  2122 (MATCH_MP jordan_curve_v);
+  COPYH 2122;
+  USEH  2122 (MATCH_MP jordan_curve_x);
+  USEH  2122 (MATCH_MP jordan_curve_w);
+  UNDH 9236 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `x` UNABBREV_TAC THEN IMATCH_MP_TAC  cut_arc_simple2 THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
+  (* -A *)
+  TYPE_THEN `{(FST (k33f {w1, w2, x2} {v1, v2, x1} e)), (SND (k33f {w1, w2, x2} {v1, v2, x1} e))} = (incf (k33f {w1, w2,x2} {v1,v2,x1} ) e)` SUBAGOAL_TAC;
+  REWRITE_TAC[incf];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  incf_V;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* Mon Jan 17 17:27:23 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* SECTION DD *)
+(* ------------------------------------------------------------------ *)
+
+
+let cartesian_size = prove_by_refinement(
+  `!(A:A->bool) (B:B->bool) m n. A HAS_SIZE m /\ B HAS_SIZE n ==>
+    cartesian A B HAS_SIZE (m *| n)`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`A`;`B`] CARD_PRODUCT;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[IN];
+  TYPE_THEN `cartesian A B = {(x,y) | A x /\ B y}` SUBAGOAL_TAC;
+  REWRITE_TAC[cartesian];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[HAS_SIZE];
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[HAS_SIZE];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  IMATCH_MP_TAC  (INR FINITE_PRODUCT);
+  ASM_REWRITE_TAC[];
+  (* Mon Jan 17 19:37:49 EST 2005 *)
+
+  ]);;
+
+  (* }}} *)
+
+let jordan_k33f_bij = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
+     (G = (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2))  ==>
+    (BIJ (k33f {w1,w2,x2} {v1,v2,x1})
+      (graph_edge G)
+      (cartesian {w1,w2,x2} {v1,v2,x1})) /\
+    (!e. graph_edge G e ==> (SING ({w1,w2,x2} INTER e)) /\
+          (SING ({v1,v2,x1} INTER e))) `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `G` UNABBREV_TAC;
+  TYPE_THEN `L = (graph_edge (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2))` ABBREV_TAC ;
+  FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph];
+  (* - *)
+  COPYH 2122;
+  USEH 2122 (MATCH_MP k33f_E);
+  (* - *)
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_x);
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_v);
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_w);
+  COPYH 2122;
+  USEH 2122 (REWRITE_RULE [jordan_curve_k33_data]);
+  (* -A *)
+  THM_INTRO_TAC[`A`;`v1`;`v2`;`w1`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut;
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[FUN_EQ_THM];
+  REWRITE_TAC[INTER;INR IN_INSERT];
+  CONJ_TAC THEN ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`B`;`v1`;`v2`;`w2`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut;
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[FUN_EQ_THM];
+  REWRITE_TAC[INTER;INR IN_INSERT];
+  CONJ_TAC THEN ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`C`;`v1`;`v2`;`x2`;`{v1,v2,x1}`;`{w1,w2,x2}`] k33f_cut;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `~(x2 = v1 ) /\ ~(x2 = v2)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[FUN_EQ_THM];
+  REWRITE_TAC[INTER;INR IN_INSERT];
+  CONJ_TAC THEN ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`D`;`w1`;`w2`;`x1`;`{w1,w2,x2}`;`{v1,v2,x1}`] k33f_cut;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `~(x1 = w1 ) /\ ~(x1 = w2)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  ONCE_REWRITE_TAC[FUN_EQ_THM];
+  REWRITE_TAC[INTER;INR IN_INSERT];
+  CONJ_TAC THEN ASM_MESON_TAC[];
+  (* -B *)
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  CONJ_TAC;
+  TYPE_THEN `L` UNABBREV_TAC;
+  USEH 3555 (REWRITE_RULE[INR IN_INSERT]);
+  TYPE_THEN `!U V (x:num->real). (U INTER V = {x}) ==> (SING (U INTER V))` SUBAGOAL_TAC;
+  REWRITE_TAC[SING];
+  UNIFY_EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  UNDH 4488 THEN DISCH_THEN (fun t-> RULE_ASSUM_TAC  (fun s -> try (MATCH_MP t s) with failure -> s));
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  KILLH 4869;
+  UNDH 3097 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN ASM_REWRITE_TAC[] ;
+  (* -C *)
+  IMATCH_MP_TAC card_surj_bij ;
+  (* - *)
+  SUBCONJ_TAC;
+  TYPE_THEN `L` UNABBREV_TAC;
+  REWRITE_TAC[FINITE_INSERT;FINITE_RULES];
+  (* - *)
+  TYPE_THEN ` (cartesian {w1, w2, x2} {v1, v2, x1}) HAS_SIZE (3 *| 3)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  cartesian_size;
+  CONJ_TAC;
+  IMATCH_MP_TAC  jordan_curve_AP_size3;
+ UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  jordan_curve_BP_size3;
+ UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  TYPE_THEN `L` UNABBREV_TAC;
+  FULL_REWRITE_TAC[HAS_SIZE];
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `3 *| 3 = 9` SUBAGOAL_TAC;
+  ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  MESON_TAC[has_size_le9];
+  (* -D *)
+  TYPE_THEN `(y = (w1,v1)) \/ (y = (w1,v2)) \/ (y = (w1,x1)) \/ (y = (w2,v1)) \/ (y = (w2,v2)) \/ (y = (w2,x1)) \/ (y = (x2,v1)) \/ (y = (x2,v2)) \/ (y = (x2,x1))` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[cartesian];
+  TYPE_THEN `y` UNABBREV_TAC;
+  REWRITE_TAC[PAIR_SPLIT];
+  USEH 8489 (REWRITE_RULE[INR IN_INSERT]);
+  USEH 7329 (REWRITE_RULE[INR IN_INSERT]);
+  UNDH 1878 THEN UNDH 8866 THEN MESON_TAC[];
+  (* - *)
+  TYPE_THEN `?x. L x /\ ({w1,w2,x2} INTER x = {(FST y)}) /\ ({v1,v2,x1} INTER x = {(SND y)})` BACK_TAC;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`{w1,w2,x2}`;`{v1,v2,x1}`;`x`;`FST y`;`SND y`] k33f_value;
+  ASM_REWRITE_TAC[];
+  USEH 5894 (REWRITE_RULE[]);
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `L` UNABBREV_TAC;
+  REWRITE_TAC[INR IN_INSERT];
+  UNDH 7966 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `y` UNABBREV_TAC THEN REWRITE_TAC[] THEN ASM_MESON_TAC[];
+  (* Mon Jan 17 20:01:06 EST 2005 *)
+  ]);;
+
+  (* }}} *)
+
+let jordan_curve_k33_isk33 = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+    graph_isomorphic k33_graph
+         (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[jordan_curve_k33];
+  IMATCH_MP_TAC  k33_iso;
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  jordan_curve_AP_size3;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  jordan_curve_BP_size3;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  CONJ_TAC;
+  IMATCH_MP_TAC  jordan_curve_AP_BP_empty;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2`] jordan_k33f_bij;
+  ASM_REWRITE_TAC[];
+  KILLH 2219;
+  FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;];
+  TYPE_THEN `fn = k33f {w1,w2,x2} {v1,v2,x1}` ABBREV_TAC ;
+  TYPE_THEN `(\ e. fn e) = fn` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  ASM_REWRITE_TAC[];
+  (* Mon Jan 17 20:12:31 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_k33_data_inter = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+     (A INTER B = {v1,v2}) /\
+     (A INTER C = {v1,v2}) /\
+     (A INTER D = {w1}) /\
+     (A INTER E = EMPTY) /\
+     (B INTER C = {v1,v2}) /\
+     (B INTER D = {w2}) /\
+     (B INTER E = EMPTY) /\
+     (C INTER D = EMPTY) /\
+     (C INTER E = {x2}) /\
+     (D INTER E = {x1})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[jordan_curve_k33_data];
+  FULL_REWRITE_TAC[INTER_COMM];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `(A INTER E = EMPTY ) /\ (B INTER E = EMPTY)` SUBAGOAL_TAC;
+  TYPE_THEN `Q` UNABBREV_TAC;
+  USEH 2576 (REWRITE_RULE[INTER;UNION;EQ_EMPTY]);
+  REWRITE_TAC[EQ_EMPTY;INTER];
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `(A INTER C = {v1, v2}) /\ (B INTER C = {v1, v2})` SUBAGOAL_TAC;
+  ONCE_REWRITE_TAC[FUN_EQ_THM];
+  REWRITE_TAC[INTER;INR IN_INSERT];
+  USEH 7697 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USEH 7606 (REWRITE_RULE[INTER;INR IN_INSERT]);
+  TYPE_THEN `Q` UNABBREV_TAC;
+  FULL_REWRITE_TAC[UNION];
+  USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USEH 6622 (REWRITE_RULE[INTER;INR IN_INSERT]);
+  CONJ_TAC THEN ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -A *)
+  REWRITE_TAC[INTER;eq_sing;INR IN_INSERT];
+  TYPE_THEN `Q` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  USEH 1691 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USEH 4348 (REWRITE_RULE[INTER;UNION;INR IN_INSERT]);
+  USEH 2195 (ONCE_REWRITE_RULE[FUN_EQ_THM]);
+  USEH 6622 (REWRITE_RULE[INTER;INR IN_INSERT]);
+  ASM_MESON_TAC[];
+  (* Mon Jan 17 20:35:28 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_edge_inter = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+    (!e e'. {A,B,C,D,E} e /\ {A,B,C,D,E} e' /\ ~(e = e') ==>
+         (e INTER e' SUBSET ({w1,w2,x2} UNION {v1,v2,x1})))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INR IN_INSERT];
+  TYPE_THEN `V = {w1, w2, x2} UNION {v1, v2, x1}` ABBREV_TAC ;
+  TYPE_THEN `{v1,v2} SUBSET V /\ {w1} SUBSET V /\ EMPTY SUBSET V /\ {w2} SUBSET V /\ {x2} SUBSET V /\ {x1} SUBSET V` SUBAGOAL_TAC;
+  TYPE_THEN `V` UNABBREV_TAC;
+  REWRITE_TAC[SUBSET;UNION;INR IN_INSERT];
+  REPEAT CONJ_TAC THEN MESON_TAC[];
+  (* - *)
+  JOIN 2 1 THEN FULL_REWRITE_TAC[RIGHT_AND_OVER_OR;LEFT_AND_OVER_OR];
+  USEH 2122 (MATCH_MP jordan_curve_k33_data_inter);
+  UNDH 4732 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN TYPE_THEN `e'` UNABBREV_TAC THEN FULL_REWRITE_TAC[] THEN ASM_REWRITE_TAC[INTER_COMM ] THEN ASM_MESON_TAC[];
+  (* Mon Jan 17 20:46:56 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_k33_plane_criterion2 = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
+     (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
+     (!e e'. graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
+        e INTER e' SUBSET graph_vertex G) ==>
+     plane_graph G`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  jordan_curve_k33_plane_criterion;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  SUBCONJ_TAC;
+  THM_INTRO_TAC[`k33_graph`;`G`] graph_isomorphic_graph;
+  REWRITE_TAC[k33_isgraph];
+  TYPE_THEN `G` UNABBREV_TAC;
+  IMATCH_MP_TAC  jordan_curve_k33_isk33;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `G` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  ASM_MESON_TAC[jordan_k33f_bij];
+  (* Tue Jan 18 06:14:19 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let jordan_curve_edge_arc = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 G e.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
+    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
+    (graph_edge G e) ==> (simple_arc top2 e)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `G` UNABBREV_TAC;
+  FULL_REWRITE_TAC[graph_edge_mk_graph;jordan_curve_k33];
+  FULL_REWRITE_TAC[INR IN_INSERT];
+  COPYH 2122;
+  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
+  RULE_ASSUM_TAC   (fun s-> try (MATCH_MP simple_arc_end_simple s) with failure -> s);
+  (* - *)
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `e` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  KILLH 4869;
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_x);
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_v);
+  COPYH 2122;
+  USEH 2122 (MATCH_MP jordan_curve_w);
+  UNDH 3097 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN IMATCH_MP_TAC  cut_arc_simple2 THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
+  (* Tue Jan 18 06:28:31 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let jordan_curve_guider_inj = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 G e U V.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
+    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
+    (graph_edge G e) /\ {A,B,C,D,E} U /\ {A,B,C,D,E} V /\
+     (e SUBSET U) /\ (e SUBSET V) ==> (U = V)  `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `INFINITE e` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_infinite;
+  IMATCH_MP_TAC  jordan_curve_edge_arc;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `(U INTER V) SUBSET ({w1,w2,x2} UNION {v1,v2,x1})` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_edge_inter;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `e SUBSET {w1, w2, x2} UNION {v1, v2, x1}` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `U INTER V` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC [SUBSET;INTER];
+  ASM_MESON_TAC[subset_imp];
+  (* - *)
+  TYPE_THEN `FINITE ({w1, w2, x2} UNION {v1, v2, x1})` SUBAGOAL_TAC;
+  REWRITE_TAC[  FINITE_UNION];
+  REWRITE_TAC[FINITE_RULES;FINITE_INSERT];
+  TYPE_THEN `FINITE e` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `{w1, w2, x2} UNION {v1, v2, x1}` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[INFINITE];
+  ASM_MESON_TAC[];
+  (* Tue Jan 18 06:3282:02 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_guider_disj = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+     ~(A = B) /\ ~(A = C) /\ ~(A = D) /\ ~(A = E) /\ ~(B = C) /\
+     ~(B = D) /\ ~(B = E) /\ ~(C = D) /\ ~(C = E) /\ ~(D = E)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_k33_data_inter;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[DE_MORGAN_THM];
+  (* - *)
+  TYPE_THEN `INFINITE A /\ INFINITE B /\ INFINITE C /\ INFINITE D /\ INFINITE E` SUBAGOAL_TAC;
+  FULL_REWRITE_TAC[jordan_curve_k33_data];
+  RULE_ASSUM_TAC  (fun s -> try (MATCH_MP simple_arc_end_simple s) with failure -> s);
+  RULE_ASSUM_TAC  (fun s -> try (MATCH_MP simple_arc_infinite s) with failure -> s);
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `FINITE (A INTER B) /\ FINITE (A INTER C) /\ FINITE (A INTER D) /\ FINITE (A INTER E) /\ FINITE (B INTER C) /\ FINITE (B INTER D) /\ FINITE (B INTER E) /\ FINITE (C INTER D) /\ FINITE(C INTER E) /\ FINITE (D INTER E)` SUBAGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[FINITE_RULES;FINITE_INSERT];
+  FULL_REWRITE_TAC[INFINITE];
+  (* - *)
+  KILLH 3523 THEN KILLH 1286 THEN KILLH 6641 THEN KILLH 4962 THEN KILLH 3223 THEN KILLH 6941 THEN KILLH 9399 THEN KILLH 3259 THEN KILLH 8436 THEN KILLH 2195 THEN KILLH 2122;
+  UNDH 5285 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TRY (TYPE_THEN `A` UNABBREV_TAC) THEN TRY (TYPE_THEN `B` UNABBREV_TAC) THEN TRY (TYPE_THEN `C` UNABBREV_TAC) THEN TRY (TYPE_THEN `D` UNABBREV_TAC) THEN FULL_REWRITE_TAC[INTER_IDEMPOT] THEN ASM_MESON_TAC[];
+  (* Tue Jan 18 07:01:04 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let jordan_curve_guider_enum = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 .
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 ==>
+    (E SUBSET E) /\
+    (cut_arc A v1 w1 SUBSET A) /\
+    (cut_arc A v2 w1 SUBSET A) /\
+    (cut_arc B v1 w2 SUBSET B) /\
+    (cut_arc B v2 w2 SUBSET B) /\
+    (cut_arc C v1 x2 SUBSET C) /\
+    (cut_arc C v2 x2 SUBSET C) /\
+    (cut_arc D w1 x1 SUBSET D) /\
+    (cut_arc D w2 x1 SUBSET D)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET_REFL];
+  COPYH 2122;
+  USEH 2122 (REWRITE_RULE[jordan_curve_k33_data]);
+  RULE_ASSUM_TAC  (fun s -> try (MATCH_MP simple_arc_end_simple s) with failure -> s);
+  COPYH 2122 ;
+  USEH 2122 (MATCH_MP jordan_curve_x);
+  COPYH 2122 ;
+  USEH 2122 (MATCH_MP jordan_curve_v);
+  COPYH 2122 ;
+  USEH 2122 (MATCH_MP jordan_curve_w);
+  REPEAT CONJ_TAC THEN IMATCH_MP_TAC  cut_arc_subset THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[];
+  (* Tue Jan 18 07:12:33 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_guider_exists = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 G e.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
+    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
+    graph_edge G e ==>
+   (?U. {A,B,C,D,E} U /\ e SUBSET U)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INR IN_INSERT];
+  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_enum;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `G` UNABBREV_TAC;
+  FULL_REWRITE_TAC[graph_edge_mk_graph;jordan_curve_k33];
+  FULL_REWRITE_TAC[INR IN_INSERT];
+  UNDH 4869 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN UNIFY_EXISTS_TAC THEN ASM_REWRITE_TAC[];
+  (* Tue Jan 18 07:43:50 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_guider_sep_lemma = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 G e .
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
+    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
+    graph_edge G e  ==>
+   (((e SUBSET A) ==> (e = cut_arc A v1 w1) \/ (e = cut_arc A v2 w1)) /\
+    ((e SUBSET B) ==> (e = cut_arc B v1 w2) \/ (e = cut_arc B v2 w2)) /\
+    ((e SUBSET C) ==> (e = cut_arc C v1 x2) \/ (e = cut_arc C v2 x2)) /\
+    ((e SUBSET D) ==> (e = cut_arc D w1 x1) \/ (e = cut_arc D w2 x1)) /\
+    ((e SUBSET E) ==> (e = E)))
+    `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_enum;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`] jordan_curve_guider_disj;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e`] jordan_curve_guider_inj;
+  REWRH 1245;
+  TYPE_THEN `G` UNABBREV_TAC;
+  FULL_REWRITE_TAC[jordan_curve_k33;graph_edge_mk_graph;INR IN_INSERT];
+  REPEAT CONJ_TAC THEN UNDH 4869 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `e` UNABBREV_TAC THEN ASM_MESON_TAC[];
+  (* Tue Jan 18 09:38:07 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let cut_arc_inter_lemma = prove_by_refinement(
+  `!X R u v w.  X u /\
+     simple_arc_end R v w /\ R u /\ ~(u = v) /\ ~(u = w) ==>
+    (cut_arc R v u INTER cut_arc R w u SUBSET X)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`R`;`u`;`v`;`w`] cut_arc_inter;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `cut_arc R u w = cut_arc R w u` SUBAGOAL_TAC;
+  MESON_TAC[cut_arc_symm];
+  TYPE_THEN `cut_arc R u w` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET;INR IN_SING];
+  TYPE_THEN `x` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  (* Tue Jan 18 09:55:17 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_cut_inter = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 G.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
+   (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==>
+    (cut_arc A v1 w1 INTER cut_arc A v2 w1 SUBSET graph_vertex G) /\
+    (cut_arc B v1 w2 INTER cut_arc B v2 w2 SUBSET graph_vertex G) /\
+    (cut_arc C v1 x2 INTER cut_arc C v2 x2 SUBSET graph_vertex G) /\
+    (cut_arc D w1 x1 INTER cut_arc D w2 x1 SUBSET graph_vertex G)
+   `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `G` UNABBREV_TAC;
+  FULL_REWRITE_TAC[graph_vertex_mk_graph;jordan_curve_k33];
+  COPYH 2122 ;
+  COPYH 2122 ;
+  COPYH 2122 ;
+  USEH 2122 (MATCH_MP jordan_curve_x);
+  USEH 2122 (MATCH_MP jordan_curve_v);
+  USEH 2122 (MATCH_MP jordan_curve_w);
+  FULL_REWRITE_TAC[jordan_curve_k33_data];
+  REPEAT CONJ_TAC THEN IMATCH_MP_TAC  cut_arc_inter_lemma THEN ASM_REWRITE_TAC[UNION;INR IN_INSERT ] THEN ASM_MESON_TAC[] ;
+  (* Tue Jan 18 10:00:14 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_guider_separate = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 G U e e'.
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
+    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) /\
+    {A,B,C,D,E} U /\ e SUBSET U /\ e' SUBSET U /\
+    graph_edge G e /\ graph_edge G e' /\ ~(e = e') ==>
+    (e INTER e' SUBSET graph_vertex G)
+   `,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  TYPE_THEN `?a b. ((e = a) \/ (e = b)) /\ ((e' = a) \/ (e' = b)) /\ (a INTER b SUBSET graph_vertex G)` BACK_TAC;
+  TYPE_THEN `((e = a) /\ (e' = b)) \/ ((e = b) /\ (e' = a))` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `e` UNABBREV_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INTER_COMM];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`] jordan_curve_cut_inter;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e`]  jordan_curve_guider_sep_lemma ;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`Q`;`A`;`B`;`C`;`D`;`E`;`v1`;`v2`;`w1`;`w2`;`x1`;`x2`;`G`;`e'`]  jordan_curve_guider_sep_lemma ;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[INR IN_INSERT];
+  TYPE_THEN `U = E` ASM_CASES_TAC;
+  TYPE_THEN `U` UNABBREV_TAC;
+  TYPE_THEN `E` UNABBREV_TAC;
+  TYPE_THEN `e'` UNABBREV_TAC;
+  UNDH 4836 THEN MESON_TAC[];
+  REWRH 4440;
+  TYPE_THEN `G` UNABBREV_TAC;
+  UNDH 7811 THEN REP_CASES_TAC THEN REP_BASIC_TAC THEN TYPE_THEN `U` UNABBREV_TAC THEN REP_BASIC_TAC;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  KILLH 2881;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  KILLH 2881 THEN KILLH 1255;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  KILLH 2881 THEN KILLH 1255 THEN KILLH 2514;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* Tue Jan 18 10:22:53 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_k33_plane = prove_by_refinement(
+  `!Q A B C D E v1 v2 w1 w2 x1 x2 G .
+      jordan_curve_k33_data Q A B C D E v1 v2 w1 w2 x1 x2 /\
+    (G =   (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)) ==>
+    plane_graph G`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  IMATCH_MP_TAC  jordan_curve_k33_plane_criterion2;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `(?U. {A,B,C,D,E} U /\ e SUBSET U)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  jordan_curve_guider_exists;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+TYPE_THEN `(?U'. {A,B,C,D,E} U' /\ e' SUBSET U')` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  jordan_curve_guider_exists;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `U = U'` ASM_CASES_TAC;
+  TYPE_THEN `U'` UNABBREV_TAC;
+  IMATCH_MP_TAC  jordan_curve_guider_separate;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `U INTER U'` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  subset_inter_pair;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[jordan_curve_k33;graph_vertex_mk_graph];
+  ASM_MESON_TAC[jordan_curve_edge_inter];
+  (* Tue Jan 18 10:32:34 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let jordan_curve_not_one_sided = prove_by_refinement(
+  `!Q. simple_closed_curve top2 Q ==> ~(one_sided_jordan_curve Q)`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`Q`] jordan_curve_k33_data_exist;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `plane_graph (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  jordan_curve_k33_plane;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `graph_isomorphic k33_graph (jordan_curve_k33 A B C D E v1 v2 w1 w2 x1 x2)` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  jordan_curve_k33_isk33;
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[] k33_nonplanar;
+  FULL_REWRITE_TAC[planar_graph];
+  UNDH 3419 THEN ASM_REWRITE_TAC[];
+  UNIFY_EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  graph_isomorphic_symm;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[k33_isgraph];
+  (* Tue Jan 18 10:43:40 EST 2005 *)
+  ]);;
+
+  (* }}} *)
+
+(*
+Tue Jan 18 10:44:07 EST 2005
+
+I'M DONE! The Jordan Curve Theorem is proved.
+
+The statements jordan_curve_not_one_sided
+  and jordan_curve_no_inj3 give a form of the Jordan Curve Theorem.
+
+Now lets put it in a simple form.
+
+*)
+
+let component_simple_arc_ver2 = prove_by_refinement(
+  `!G x y. (closed_ top2 G ) /\ ~(x = y) ==>
+      (component  (induced_top top2 (euclid 2 DIFF G)) x y <=>
+        (?C. simple_arc_end C x y /\
+             (C INTER G = EMPTY)))`,
+  (* {{{ proof *)
+  [
+  (*
+   string together :component-imp-connected, connected-induced2,
+                    p_conn_conn, p_conn_hv_finite;
+   other_direction : simple_arc_connected, connected-induced,
+                    connected-component; *)
+  REP_BASIC_TAC;
+  ASSUME_TAC top2_top;
+  THM_INTRO_TAC[`top2`;`(euclid 2 DIFF G)`] induced_top_top;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `top2 (euclid 2 DIFF G)` SUBAGOAL_TAC;
+  USEH 4142 (MATCH_MP closed_open);
+  FULL_REWRITE_TAC[top2_unions;open_DEF ];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `A = euclid 2 DIFF G` ABBREV_TAC ;
+  TYPE_THEN `UNIONS (induced_top top2 A) = A` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`top2`;`A`] induced_top_support;
+  ASM_REWRITE_TAC[top2_unions;];
+  TYPE_THEN `A` UNABBREV_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;DIFF];
+  MESON_TAC[];
+  (* - *)
+  IMATCH_MP_TAC  EQ_ANTISYM;
+  CONJ_TAC;
+  THM_INTRO_TAC[`induced_top top2 A`;`x`] component_imp_connected;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`(top2)`;`A`;`(component  (induced_top top2 A) x)`] connected_induced2;
+  ASM_REWRITE_TAC[top2_unions];
+  IMATCH_MP_TAC  SUBSET_TRANS;
+  TYPE_THEN `UNIONS (induced_top top2 A)` EXISTS_TAC;
+  CONJ_TAC;
+  KILLH 9392;
+  REWRITE_TAC[component_unions];
+  UNDH 250 THEN DISCH_THEN (fun t-> ONCE_REWRITE_TAC [t]);
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  ASM_REWRITE_TAC[];
+  REWRH 486;
+  (* --A *)
+  TYPE_THEN `B = component  (induced_top top2 A) x` ABBREV_TAC ;
+  TYPE_THEN `B x /\ B y` SUBAGOAL_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`(induced_top top2 A)`;`x`;`y`] component_replace;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  component_symm;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  ASSUME_TAC loc_path_conn_top2;
+  TYPE_THEN `top_of_metric(A,d_euclid) = (induced_top top2 A)` SUBAGOAL_TAC;
+  REWRITE_TAC[top2];
+  ONCE_REWRITE_TAC[EQ_SYM_EQ];
+  IMATCH_MP_TAC  top_of_metric_induced;
+  TYPE_THEN `A` UNABBREV_TAC;
+  REWRITE_TAC[DIFF;SUBSET];
+  MESON_TAC[metric_euclid];
+  (* -- *)
+  TYPE_THEN `loc_path_conn (induced_top top2 A)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`2`;`A`] loc_path_conn_euclid;
+  FULL_REWRITE_TAC[top2];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`top2`] loc_path_conn;
+  REWRH 6586;
+  TSPECH `A` 7522;
+  REWRH 4569;
+  TSPECH `x` 6750;
+  TYPE_THEN `A x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `top2 B` SUBAGOAL_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  ASM_MESON_TAC[path_eq_conn];
+  (* --B *)
+  THM_INTRO_TAC[`B`;`x`;`y`] p_conn_conn;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  THM_INTRO_TAC[`B`;`x`;`y`] p_conn_hv_finite;
+  ASM_MESON_TAC[];
+  REWRH 7914;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  FULL_REWRITE_TAC[EMPTY_EXISTS;INTER];
+  TYPE_THEN `B u` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `A u` SUBAGOAL_TAC;
+  ASM_MESON_TAC[subset_imp];
+  TYPE_THEN `A` UNABBREV_TAC;
+  USEH 1911 (REWRITE_RULE[DIFF]);
+  ASM_MESON_TAC[];
+  (* -C *)
+  (* other_direction : simple_arc_connected, connected-induced,
+                    connected-component; *)
+  THM_INTRO_TAC[`C`;`x`;`y`] simple_arc_end_simple;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`] simple_arc_connected;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `C SUBSET euclid 2` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  simple_arc_euclid;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`top2`;`A`;`C`] connected_induced2;
+  ASM_REWRITE_TAC[top2_unions];
+  REWRH 8620;
+  (* - *)
+  TYPE_THEN `C SUBSET A` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  ASM_REWRITE_TAC[DIFF_SUBSET];
+  REWRH 9619;
+  (* - *)
+  THM_INTRO_TAC[`induced_top top2 A`;`C`;`x`] connected_component;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  USEH 5951(REWRITE_RULE[SUBSET]);
+  TSPECH `y` 4625;
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  (* Tue Jan 18 12:54:06 EST 2005 *)
+
+  ]);;
+  (* }}} *)
+
+let component_properties = prove_by_refinement(
+  `!C A v. closed_ top2 C /\ (euclid 2 v) /\ ~C v /\
+      (A = component  (induced_top top2 (euclid 2 DIFF C)) v) ==>
+      top2 A /\ connected top2 A /\
+     ~(A = EMPTY) /\ (A INTER C = EMPTY) /\ A v /\
+      (A SUBSET euclid 2) /\
+    (!w. ~(w = v) ==>
+     (A w = (?P. simple_arc_end P v w /\ (P INTER C = EMPTY))))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  (* - *)
+  ASSUME_TAC top2_top;
+  (* -A *)
+  THM_INTRO_TAC[`top2`;`(euclid 2 DIFF C)`] induced_top_support;
+  FULL_REWRITE_TAC[top2_unions];
+  (* - *)
+  TYPE_THEN `euclid 2 INTER (euclid 2 DIFF C) = euclid 2 DIFF C` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[INTER;DIFF];
+  MESON_TAC[];
+  REWRH 972;
+  KILLH 105;
+  (* - *)
+  TYPE_THEN `top2 (euclid 2 DIFF C)` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`top2`;`C`] (REWRITE_RULE[open_DEF] closed_open);
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[top2_unions];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`2`;`(euclid 2 DIFF C)`] loc_path_conn_euclid;
+  REWRITE_TAC[GSYM top2];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`2`;`euclid 2`] loc_path_conn_euclid;
+  REWRITE_TAC[GSYM top2];
+  THM_INTRO_TAC[`top2`] top_univ;
+  REWRITE_TAC[top2_top];
+  FULL_REWRITE_TAC[top2_unions];
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[GSYM top2];
+  (* - *)
+  USEH 7343 GSYM;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `A v` SUBAGOAL_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  IMATCH_MP_TAC  component_refl THEN ASM_REWRITE_TAC[] THEN ASM_REWRITE_TAC[DIFF];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `~(A = EMPTY)` SUBAGOAL_TAC THENL[ REWRITE_TAC[EMPTY_EXISTS];ALL_TAC];
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* -B *)
+  TYPE_THEN `A INTER C = EMPTY` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`(induced_top top2 (euclid 2 DIFF C))`;`v`] component_unions;
+  REWRH 7860;
+  UNDH 4798 THEN REWRITE_TAC[INTER;SUBSET;DIFF;EQ_EMPTY] THEN MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `A SUBSET euclid 2` SUBAGOAL_TAC;
+  THM_INTRO_TAC[`(induced_top top2 (euclid 2 DIFF C))`;`v`] component_unions;
+  REWRH 7860;
+  UNDH 4798 THEN REWRITE_TAC[SUBSET;DIFF] THEN MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `top_of_metric(euclid 2 DIFF C,d_euclid) = induced_top top2 (euclid 2 DIFF C)` SUBAGOAL_TAC;
+  REWRITE_TAC[top2];
+  IMATCH_MP_TAC  (GSYM top_of_metric_induced);
+  REWRITE_TAC[metric_euclid];
+  REWRITE_TAC[DIFF;SUBSET] THEN MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`2`;`euclid 2 DIFF C`] loc_path_euclid_cor;
+  REWRITE_TAC[GSYM top2];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`top2`] loc_path_conn;
+  REWRH 6586;
+  SUBCONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  USEH 7626 GSYM;
+  USEH 4421 GSYM;
+  ASM_REWRITE_TAC[];
+  USEH 1238 GSYM;
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[DIFF];
+  ASM_REWRITE_TAC[];
+  (* -C *)
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  SUBCONJ_TAC;
+  TYPE_THEN `A` UNABBREV_TAC;
+  IMATCH_MP_TAC  component_simple_arc_ver2;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  TYPE_THEN `A = UNIONS ({v} INSERT {P | (?w. simple_arc_end P v w) /\ (P INTER C = {}) })` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNIONS];
+  TYPE_THEN `x = v` ASM_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  TYPE_THEN `{v}` EXISTS_TAC;
+  REWRITE_TAC[INR IN_INSERT];
+  TSPECH `x` 9360;
+  REWRH 8744;
+  TYPE_THEN`P` EXISTS_TAC;
+  REWRITE_TAC[INR IN_INSERT];
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  DISJ2_TAC;
+  ASM_MESON_TAC[simple_arc_end_simple];
+  IMATCH_MP_TAC  simple_arc_end_end2;
+  ASM_MESON_TAC[];
+  (* -- *)
+  REWRITE_TAC[UNIONS;INR IN_INSERT;SUBSET];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  FULL_REWRITE_TAC[INR IN_INSERT];
+  TYPE_THEN `x` UNABBREV_TAC;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `x = v` ASM_CASES_TAC;
+  ASM_MESON_TAC[];
+  TSPECH `x` 9360;
+  ASM_REWRITE_TAC[];
+  (* -- *)
+  TYPE_THEN `x = w` ASM_CASES_TAC;
+  TYPE_THEN `x` UNABBREV_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `cut_arc u v x` EXISTS_TAC;
+  (* -- *)
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  cut_arc_simple;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_simple;simple_arc_end_end];
+  (* -- *)
+  THM_INTRO_TAC[`u`;`v`;`x`] cut_arc_subset;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[simple_arc_end_simple;simple_arc_end_end];
+  ASM_REWRITE_TAC[];
+  UNDH 4401 THEN UNDH 2627 THEN REWRITE_TAC[SUBSET;INTER;EQ_EMPTY] THEN MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  connected_unions_common;
+  (* -D *)
+  CONJ_TAC;
+  FULL_REWRITE_TAC[INR IN_INSERT];
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `Z` UNABBREV_TAC;
+  IMATCH_MP_TAC  connected_sing;
+  ASM_REWRITE_TAC[top2_unions];
+  IMATCH_MP_TAC  simple_arc_connected;
+  ASM_MESON_TAC[simple_arc_end_simple];
+  (* - *)
+  UNDH 281 THEN REWRITE_TAC[INTER;EMPTY_EXISTS];
+  TYPE_THEN `v` EXISTS_TAC;
+  FULL_REWRITE_TAC[INR IN_INSERT];
+  TYPE_THEN `!Z. (Z = {v}) \/ (?w. simple_arc_end Z v w) /\ (Z INTER C = EMPTY) ==> Z v` SUBAGOAL_TAC;
+  FIRST_ASSUM DISJ_CASES_TAC;
+  TYPE_THEN `Z''` UNABBREV_TAC;
+  REWRITE_TAC[INR IN_SING];
+  IMATCH_MP_TAC  simple_arc_end_end;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* Tue Jan 18 19:38:27 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+let JORDAN_CURVE_THEOREM = prove_by_refinement(
+  `!C. simple_closed_curve top2 C ==>
+     (?A B.  top2 A /\ top2 B /\
+       connected top2 A /\ connected top2 B /\
+     ~(A = EMPTY) /\ ~(B = EMPTY) /\
+      (A INTER B = EMPTY) /\ (A INTER C = EMPTY) /\
+          (B INTER C = EMPTY) /\
+         (A UNION B UNION C = euclid 2))`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  THM_INTRO_TAC[`C`] jordan_curve_not_one_sided;
+  ASM_REWRITE_TAC[];
+  FULL_REWRITE_TAC[one_sided_jordan_curve];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  LEFTH  1701 "v";
+  LEFTH  7038 "w";
+  TYPE_THEN `euclid 2 v /\ euclid 2 w /\ ~C v /\ ~C w /\ ~(v = w) /\ (!C'. simple_arc_end C' v w ==> ~(C' INTER C = EMPTY))` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  KILLH 9332;
+  (* - *)
+  TYPE_THEN `A = component  (induced_top top2 (euclid 2 DIFF C)) v` ABBREV_TAC ;
+  TYPE_THEN `A` EXISTS_TAC;
+  TYPE_THEN `B = component  (induced_top top2 (euclid 2 DIFF C)) w` ABBREV_TAC ;
+  TYPE_THEN `B` EXISTS_TAC;
+  (* - *)
+  ASSUME_TAC top2_top;
+  (* -A *)
+  THM_INTRO_TAC[`C`] simple_closed_curve_closed;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`;`A`;`v`] component_properties;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`C`;`B`;`w`] component_properties;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  (* - *)
+  SUBCONJ_TAC;
+  PROOF_BY_CONTR_TAC;
+  USEH 2797 (REWRITE_RULE[INTER;EMPTY_EXISTS]);
+  TYPE_THEN `u = v` ASM_CASES_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  TSPECH `v` 8396;
+  REWRH 1610;
+  TSPECH `P` 3407;
+  UNDH 3395 THEN DISCH_THEN (THM_INTRO_TAC[]);
+  IMATCH_MP_TAC  simple_arc_end_symm;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  (* -- *)
+  TYPE_THEN `u = w` ASM_CASES_TAC;
+  TYPE_THEN `u` UNABBREV_TAC;
+  TSPECH `w` 9360;
+  REWRH 3625;
+  ASM_MESON_TAC[simple_arc_end_symm];
+  (* -- *)
+  TYPE_THEN `A` UNABBREV_TAC;
+  TYPE_THEN `B` UNABBREV_TAC;
+  USEH 9617 (MATCH_MP component_replace);
+  USEH 8370 (MATCH_MP component_replace);
+  TSPECH `v` 2427;
+  TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) w` UNABBREV_TAC;
+  TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) u` UNABBREV_TAC;
+  TYPE_THEN `component (induced_top top2 (euclid 2 DIFF C)) v v` SUBAGOAL_TAC;
+  IMATCH_MP_TAC  component_refl;
+  ASM_REWRITE_TAC[];
+  THM_INTRO_TAC[`top2`;`(euclid 2 DIFF C)`] induced_top_support;
+  FULL_REWRITE_TAC[top2_unions];
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC [INTER;DIFF];
+  REWRH 4538;
+  USEH 1851 (MATCH_MP simple_arc_end_symm);
+  ASM_MESON_TAC[];
+  (* -B *)
+  IMATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[union_subset];
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  simple_closed_curve_euclid;
+  ASM_REWRITE_TAC[];
+  (* - *)
+  PROOF_BY_CONTR_TAC;
+  USEH 2025 (REWRITE_RULE[SUBSET;UNION]);
+  LEFTH 2615 "x";
+  TYPE_THEN `euclid 2 x /\ ~A x /\ ~ B x /\ ~ C x` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  (* - *)
+  THM_INTRO_TAC[`v`;`w`;`x`] three_t_enum;
+  TYPE_THEN `INJ f UNIV (euclid 2) /\ (!i. ~C (f i)) /\ (!i j A. simple_arc_end A (f i) (f j) ==> ~(A INTER C = {}))` ASM_CASES_TAC ;
+  ASM_MESON_TAC[jordan_curve_no_inj3];
+  UNDH 6935 THEN ASM_REWRITE_TAC[];
+  (* -C *)
+  TYPE_THEN `~(x = w) /\ ~(x = v) /\ ~(v = w)` SUBAGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  SUBCONJ_TAC;
+  REWRITE_TAC[INJ];
+  CONJ_TAC THENL [IMATCH_MP_TAC  three_t_univ THEN ASM_MESON_TAC[]; IMATCH_MP_TAC  three_t_univ THEN REPEAT CONJ_TAC THEN IMATCH_MP_TAC  three_t_univ THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]];
+  (* - *)
+  TYPE_THEN `!C'. simple_arc_end C' v x ==> ~(C' INTER C = EMPTY)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `!C'. simple_arc_end C' w x ==> ~(C' INTER C = EMPTY)` SUBAGOAL_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `!x A. ~simple_arc_end A x x` SUBAGOAL_TAC;
+  USEH 3186 (MATCH_MP simple_arc_end_distinct);
+  ASM_MESON_TAC[];
+  KILLH 8396 THEN KILLH 9360 THEN KILLH 3221 THEN KILLH 4325;
+  IMATCH_MP_TAC  (TAUT `a /\ b ==> b /\ a`);
+  (* - *)
+  TYPE_THEN `!C' w v. simple_arc_end C' w v = simple_arc_end C' v w` SUBAGOAL_TAC;
+  MESON_TAC[simple_arc_end_symm];
+  CONJ_TAC THENL [IMATCH_MP_TAC  three_t_univ THEN REPEAT CONJ_TAC THEN IMATCH_MP_TAC  three_t_univ THEN REP_BASIC_TAC THEN ASM_REWRITE_TAC[] ; ALL_TAC];
+  TYPE_THEN `!i. ~(C (f i))` SUBAGOAL_TAC THENL [IMATCH_MP_TAC  three_t_univ THEN ASM_REWRITE_TAC[];ALL_TAC];
+  ASM_MESON_TAC[];
+  (* Tue Jan 18 20:44:12 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+(* collect together the definitions in a single theorem.
+   We leave out the definitions in the HOL-light distribution
+   such as abs , sqrt, sum,
+           IMAGE, INJ, INTER, EMPTY, UNION, SUBSET, UNIONS. *)
+
+let JORDAN_CURVE_DEFS = prove_by_refinement(
+  `(!x. euclid 2 x = (!n. 2 <=| n ==> (x n = &0))) /\
+   (top2 = top_of_metric (euclid 2,d_euclid)) /\
+   (!(X:A->bool) d. top_of_metric (X,d) =
+         {A | ?F. F SUBSET open_balls (X,d) /\ (A = UNIONS F) }) /\
+   (!(X:A->bool) d. open_balls(X,d) =
+         {B | ?x r. (B = open_ball (X,d) x r) }) /\
+   (!X d (x:A) r. open_ball (X,d) x r =
+         {y | X x /\ X y /\ d x y < r}) /\
+   (!U (Z:A->bool). connected U Z <=>
+         Z SUBSET UNIONS U /\
+         (!A B.
+              U A /\ U B /\ (A INTER B = {}) /\ Z SUBSET A UNION B
+              ==> Z SUBSET A \/ Z SUBSET B)) /\
+   (!(C:A->bool) U. simple_closed_curve U C =
+             (?f. (C = IMAGE f {x | &0 <= x /\ x <= &1}) /\
+              continuous f (top_of_metric (UNIV,d_real)) U /\
+              INJ f {x | &0 <= x /\ x < &1} (UNIONS U) /\
+              (f (&0) = f (&1)))) /\
+   (!(f:A->B) U V. continuous f U V =
+         (!v. V v ==> U  { x | (UNIONS U) x /\ v (f x) })) /\
+   (!x y. d_real x y = abs  (x - y)) /\
+   (!x y. euclid 2 x /\ euclid 2 y
+         ==> (d_euclid x y =
+              sqrt (sum (0,2) (\i. (x i - y i) * (x i - y i)))))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[simple_closed_curve;continuous;preimage;d_real;];
+  REWRITE_TAC[d_euclid_n];
+  REWRITE_TAC[euclid;top2;top_of_metric;open_balls;open_ball;connected;];
+  (* Tue Jan 18 21:10:10 EST 2005 *)
+  ]);;
+  (* }}} *)
+
+(* The interesting thing about these definitions is how the
+   standard mathematical definitions are made total, as required
+   by HOL.
+
+   "continuous": There is no requirement that the IMAGE of f is
+   a subset of UNIONS V.  This is contrary to the common mathematical
+   requirement that a function f:X->Y maps X to Y.  The constraint
+   on the IMAGE for a simple_closed_curve is contained in the definition
+   of INJ.
+
+   "simple_closed_curve": Continuity is required on the full real
+   line, but injectivity is required only on the unit interval.
+
+   "connected": Here there is a requirement that Z is a subset of
+   UNIONS U
+
+   "open_ball": If x is not in X, then the open ball is empty.
+
+*)

diff --git a/Jordan/lib_ext.ml b/Jordan/lib_ext.ml
new file mode 100644 (file)
index 0000000..2216dae
--- /dev/null
+++ b/Jordan/lib_ext.ml
@@ -0,0 +1,99 @@
+
+
+let rec drop i list =
+        match (i,list) with (_,[]) -> failwith "drop null"
+                | (0,a::b) -> b
+                | (i,a::b) -> a::(drop (i-1) b);;
+
+let rec take i j =
+  function
+  [] -> [] |
+  a::b -> match (i,j) with
+      (0,0) -> [] |
+      (0,j) -> a::(take 0 (j-1) b) |
+      _ -> take (i-1) (j-1) b;;
+
+let cannot f x = try (f x; false) with Failure _ -> true;;
+
+(* ------------------------------------------------------------------ *)
+(* UNIT TESTS *)
+(* ------------------------------------------------------------------ *)
+
+let new_test_suite() =
+  let t = ref ([]:(string*bool) list) in
+  let add_test (s,f) = (t:= ((s,f)::!t)) in
+  let eval (s,f) = if f then () else failwith ("test suite: "^s) in
+  let test() = (ignore (List.map eval  (!t));()) in
+  add_test,test;;
+
+let add_test,test = new_test_suite();;
+
+
+(* ------------------------------------------------------------------ *)
+(* LOCAL DEFINITIONS *)
+(* ------------------------------------------------------------------ *)
+
+let local_defs = ref ([]:(string * (string * term)) list);;
+
+let add_interface (sym,tm) =
+  if (can (assoc sym) (!the_overload_skeletons)) then
+    (overload_interface (sym,tm))
+  else (override_interface(sym,tm));;
+
+let local_definition package_name tm =
+  let list_mk_forall(vars,bod) = itlist (curry mk_forall) vars bod in
+  let avs,bod = strip_forall tm in
+  let l,r = try dest_eq bod
+    with Failure _ -> failwith "new_local_definition: Not an equation" in
+  let lv,largs = strip_comb l in
+  let cname,ty = dest_var lv in
+  let cname' = package_name^"'"^cname in
+  let lv' = mk_var(cname',ty) in
+  let l' = list_mk_comb(lv',largs) in
+  let bod' = mk_eq(l',r) in
+  let tm'= list_mk_forall(avs,bod') in
+  let thm = new_definition tm' in
+  let _ = (local_defs := (package_name,(cname,lv'))::(!local_defs)) in
+  let _ = add_interface(cname,lv') in
+  thm;;
+
+let reduce_local_interface(package_name) =
+  map (reduce_interface o snd)
+    (filter (fun x -> ((fst x) = package_name)) !local_defs);;
+
+let mk_local_interface(package_name) =
+  map (add_interface o snd)
+    (filter (fun x -> ((fst x) = package_name)) !local_defs);;
+
+
+
+(* ------------------------------------------------------------------ *)
+(* SAVING STATE *)
+(* ------------------------------------------------------------------ *)
+
+(****** Removed for now by JRH
+
+let (save_state,get_state) =
+  let state_array = ref [] in
+  let save_state (key:string) =
+    state_array :=
+    (key,(!EVERY_STEP_TAC,!local_defs,!the_interface,
+        !the_term_constants,!the_type_constants,
+                        !the_overload_skeletons,
+                 !the_axioms,!the_definitions))::!state_array in
+  let get_state key =
+    let (et,ld,i,tc,tyc,os,ax,def) = assoc key !state_array in
+      (
+        EVERY_STEP_TAC := et;
+        local_defs := ld;
+        the_interface := i;
+        the_term_constants:= tc;
+        the_type_constants:= tyc;
+        the_overload_skeletons:= os;
+        the_axioms:= ax;
+        the_definitions:= def)
+  in (save_state,get_state);;
+
+save_state "lib_ext";;
+
+*****)

diff --git a/Jordan/metric_spaces.ml b/Jordan/metric_spaces.ml
new file mode 100644 (file)
index 0000000..f21940a
--- /dev/null
+++ b/Jordan/metric_spaces.ml
@@ -0,0 +1,9170 @@
+
+
+(* ------------------------------------------------------------------ *)
+(*
+   Topological Spaces, Metric Spaces,
+   Connectedness, Totally bounded spaces, compactness,
+   Hausdorff property, completeness, properties of Euclidean space,
+
+   Author: Thomas Hales 2004
+
+*)
+
+(* ------------------------------------------------------------------ *)
+
+
+(* prioritize_real (or num) *)
+
+(* ------------------------------------------------------------------ *)
+(* Logical Preliminaries *)
+(* ------------------------------------------------------------------ *)
+
+
+let Q_ELIM_THM = prove_by_refinement(
+  `!P Q R . (?(u:B). (?(x:A). (u = P x) /\ (Q x)) /\ (R u)) <=>
+    (?x. (Q x) /\ R( P x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let Q_ELIM_THM' = prove_by_refinement(
+  `!P Q R. (!(t:B). (?(x:A). P x /\ (t = Q x)) ==> R t) <=>
+    (!x. P x ==> R (Q x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let Q_ELIM_THM'' = prove_by_refinement(
+  `!P Q R. (!(t:B). (?(x:A).  (t = Q x) /\ P x ) ==> R t) <=>
+    (!x. P x ==> R (Q x))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Set Preliminaries *)
+(* ------------------------------------------------------------------ *)
+
+let DIFF_SUBSET = prove_by_refinement(
+  `!X A (B:A->bool). A SUBSET (X DIFF B) <=>
+         (A SUBSET X) /\ (A INTER B = EMPTY)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[SUBSET;DIFF;INTER;IN];
+  EQ_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  DISCH_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM';EMPTY];
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  CONJ_TAC;
+  ASM_MESON_TAC[];
+  USE 1 (fun t-> AP_THM t `x:A`);
+  USE 1 (REWRITE_RULE[IN_ELIM_THM';EMPTY]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let SUBSET_INTERS = prove_by_refinement(
+  `!X (A:A->bool). A SUBSET (INTERS X) <=> (!x. X x ==> (A SUBSET x))`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[SUBSET;INTERS];
+  REWRITE_TAC [IN_ELIM_THM'];
+  MESON_TAC[IN];
+  ]);;
+  (* }}} *)
+
+let EQ_EMPTY = prove_by_refinement(
+  `!P. ({(x:A) | P x} = {}) <=> (!x. ~P x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  (USE 0 (fun t-> AP_THM t `x:A`));
+  USE 0 (REWRITE_RULE[IN_ELIM_THM';EMPTY]);
+  USE 0 (GEN_ALL);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM';EMPTY];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let DIFF_INTER = prove_by_refinement(
+  `!A B (C:A->bool). ((A DIFF B) INTER C = EMPTY) <=>
+         ((A INTER C) SUBSET B)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[DIFF;INTER;SUBSET;IN_ELIM_THM'];
+  REWRITE_TAC[IN;EQ_EMPTY];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let SUB_IMP_INTER = prove_by_refinement(
+  `!A B (C:A->bool). ((A SUBSET B) ==> (A INTER C) SUBSET B) /\
+        ((A SUBSET B) ==> (C INTER A) SUBSET B)`,
+  (* {{{ proof *)
+  [
+    DISCH_ALL_TAC;
+    SUBCONJ_TAC;
+    REWRITE_TAC[INTER;SUBSET;IN;IN_ELIM_THM'];
+    MESON_TAC[];
+    MESON_TAC[INTER_COMM];
+  ]);;
+  (* }}} *)
+
+let SUBSET_UNIONS_INSERT = prove_by_refinement(
+  `!(A:A->bool) B C. A SUBSET (UNIONS (B INSERT C)) <=>
+           (A DIFF B) SUBSET (UNIONS C)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  SET_TAC[UNIONS;SUBSET;INSERT];
+  ]);;
+  (* }}} *)
+
+let UNIONS_DELETE2 = prove_by_refinement(
+  `!(A:A->bool) B C. (A SUBSET (UNIONS B)) /\ (A INTER C = EMPTY) ==>
+                (A SUBSET (UNIONS (B DELETE (C))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASM SET_TAC[SUBSET;UNIONS;INTER;EMPTY;DELETE];
+  ]);;
+  (* }}} *)
+
+
+(* this generalizes to arbitrary cardinalities *)
+let finite_subset = prove_by_refinement(
+  `!A (f:A->B) B. (B SUBSET (IMAGE f A)) /\ (FINITE B) ==>
+     (?C. (C SUBSET A) /\ (FINITE C) /\ (B = IMAGE f C))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  USE 0 (REWRITE_RULE[SUBSET;IN_IMAGE]);
+  USE 0 (CONV_RULE NAME_CONFLICT_CONV);
+  USE 0 (CONV_RULE (quant_left_CONV "x'"));
+  USE 0 (CONV_RULE (quant_left_CONV "x'"));
+  CHO 0;
+  TYPE_THEN `IMAGE x' B` EXISTS_TAC ;
+  SUBCONJ_TAC;
+  REWRITE_TAC[SUBSET;IN_IMAGE];
+  NAME_CONFLICT_TAC;
+  GEN_TAC;
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[ FINITE_IMAGE];
+  MATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;IN_IMAGE];
+  GEN_TAC;
+  TYPE_THEN `x` (USE 0 o SPEC);
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET;IN_IMAGE];
+  NAME_CONFLICT_TAC;
+  GEN_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  ASM_REWRITE_TAC[];
+  AND 3;
+  CHO 3;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let inters_singleton = prove_by_refinement(
+  `!(A:A->bool). INTERS {A} = A`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INSERT;INTERS];
+  REWRITE_TAC[IN_ELIM_THM';NOT_IN_EMPTY];
+  GEN_TAC;
+  MATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  ASM_MESON_TAC[IN];
+  ]);;
+  (* }}} *)
+
+let delete_empty = prove_by_refinement(
+  `!(A:A->bool) x. (A DELETE x = EMPTY) <=> (~(A = EMPTY) ==> (A = {x}))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[DELETE];
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  USE 1 (fun t-> AP_THM t `u:A`);
+  USE 1 (REWRITE_RULE[IN_ELIM_THM';EMPTY]);
+  REWRITE_TAC[EMPTY;INSERT;IN];
+  USE 0 (REWRITE_RULE[EMPTY_EXISTS]);
+  USE 1 (GEN `u:A`);
+  MATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  ASM_MESON_TAC[IN];
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM';EMPTY];
+  USE 0 (REWRITE_RULE[EMPTY_EXISTS]);
+  USE 0 (REWRITE_RULE[EMPTY;INSERT;IN]);
+  REWRITE_TAC[IN];
+  USE 0 (CONV_RULE (quant_left_CONV "u"));
+  USE 0 (SPEC `x':A`);
+  MATCH_MP_TAC  (TAUT `(a ==> b) ==> ~(a /\ ~b)`);
+  DISCH_ALL_TAC;
+  REWR 0;
+  UND  1;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IN_ELIM_THM'];
+  ]);;
+
+  (* }}} *)
+
+let inters_subset = prove_by_refinement(
+  `!A (B:(A->bool)->bool). A SUBSET B ==> INTERS B SUBSET INTERS A`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[INTERS;SUBSET;IN_ELIM_THM'];
+  ASM_MESON_TAC[SUBSET;IN];
+  ]);;
+  (* }}} *)
+
+let delete_inters = prove_by_refinement(
+  `!V (u:A->bool). V u ==> (INTERS V = (INTERS (V DELETE u)) INTER u)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET_INTER];
+  CONJ_TAC;
+  MATCH_MP_TAC  inters_subset;
+  REWRITE_TAC [DELETE_SUBSET];
+  USE 0 (ONCE_REWRITE_RULE[GSYM IN]);
+  USE 0 (MATCH_MP INTERS_SUBSET);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `INTERS (V DELETE u) INTER u SUBSET u` SUBGOAL_TAC;
+  REWRITE_TAC[INTER_SUBSET];
+  REWRITE_TAC[SUBSET_INTERS];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `x = u` ASM_CASES_TAC;
+  ASM_MESON_TAC[];
+  TYPE_THEN `INTERS (V DELETE u) INTER u SUBSET INTERS (V DELETE u) ` SUBGOAL_TAC;
+  REWRITE_TAC[INTER_SUBSET];
+  TYPE_THEN `INTERS (V DELETE u) SUBSET x` SUBGOAL_TAC;
+  MATCH_MP_TAC  INTERS_SUBSET;
+  ASM_REWRITE_TAC [IN;DELETE;IN_ELIM_THM'];
+  ASM_MESON_TAC[SUBSET_TRANS];
+  ]);;
+  (* }}} *)
+
+let EQ_EMPTY = prove_by_refinement(
+  `!(A:A->bool) . (A = EMPTY) <=> (!x. ~(A x))`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[EMPTY_EXISTS;IN];
+  ]);;
+  (* }}} *)
+
+let UNIONS_EQ_EMPTY = prove_by_refinement(
+  `!(U:(A->bool)->bool). (UNIONS U = {}) <=>
+     ((U = EMPTY) \/ (U = {EMPTY}))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[EQ_EMPTY;UNIONS;IN_ELIM_THM';INSERT;EMPTY];
+  REWRITE_TAC [IN];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `!x. ~U x` ASM_CASES_TAC ;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  MATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  NAME_CONFLICT_TAC;
+  USE 1 (CONV_RULE (quant_left_CONV "x"));
+  CHO 1;
+  USE 0 (CONV_RULE (quant_left_CONV "u"));
+  USE 0 (CONV_RULE (quant_left_CONV "u"));
+  EQ_TAC;
+  DISCH_TAC;
+  TYPE_THEN `x` (USE 0 o SPEC);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  COPY 0;
+  TYPE_THEN `x` (USE 0 o SPEC);
+  TYPE_THEN `x'` (USE 3 o SPEC);
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `x' = {}` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 5 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 5;
+  USE 5 (REWRITE_RULE[IN]);
+  ASM_MESON_TAC[];
+  USE 2 (CONV_RULE (quant_right_CONV "x'"));
+  ASM_MESON_TAC[IN;EMPTY_EXISTS];
+  DISCH_THEN DISJ_CASES_TAC;
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[IN_ELIM_THM'];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let INTERS_EQ_EMPTY = prove_by_refinement(
+  `!((A:(A->bool)->bool)). ((INTERS A) = EMPTY) <=>
+    (!x . ?a.  (A a) /\ ~(a x))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INTERS;EQ_EMPTY;IN_ELIM_THM'];
+  REWRITE_TAC[IN];
+  MESON_TAC[];
+   ]);;
+  (* }}} *)
+
+let CARD_SING_CONV = prove_by_refinement(
+  `!X:A->bool. (X HAS_SIZE 1) ==> (SING X)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[HAS_SIZE ;SING ];
+  DISCH_ALL_TAC;
+  TYPE_THEN `CHOICE X` EXISTS_TAC;
+  TYPE_THEN `~(X = {})` SUBGOAL_TAC;
+  ASM_MESON_TAC[CARD_CLAUSES;ARITH_RULE`~(0=1)`];
+  DISCH_ALL_TAC;
+  TYPE_THEN `SUC (CARD (X DELETE (CHOICE X)))=1` SUBGOAL_TAC ;
+  ASM_SIMP_TAC[CARD_DELETE_CHOICE];
+  REWRITE_TAC[ARITH_RULE`(SUC a = 1) <=> (a=0)`];
+  ASSUME_TAC HAS_SIZE_0;
+  USE 3 (REWRITE_RULE [HAS_SIZE ]);
+  ASSUME_TAC FINITE_DELETE_IMP;
+  ASM_MESON_TAC[delete_empty];
+  ]);;
+
+  (* }}} *)
+
+let countable_prod = prove_by_refinement(
+  `!(A:A->bool) (B:B->bool). (COUNTABLE A) /\ (COUNTABLE B) ==>
+   (COUNTABLE {(a,b) | (A a) /\ (B b) })`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  (INST_TYPE [`:num#num`,`:A`] COUNTABLE_IMAGE);
+  USE 0 (REWRITE_RULE [COUNTABLE;GE_C;IN_UNIV]);
+  USE 1 (REWRITE_RULE [COUNTABLE;GE_C;IN_UNIV]);
+  CHO 0;
+  CHO 1;
+  TYPE_THEN `{(m:num,n:num) | T}` EXISTS_TAC;
+  REWRITE_TAC[NUM2_COUNTABLE;SUBSET;IN_IMAGE];
+  REWRITE_TAC[IN_ELIM_THM];
+  TYPE_THEN `(\ (u,v) . (f u,f' v))` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  CHO 2;
+  CHO 2;
+  AND 2;
+  TYPE_THEN `a` (USE 0 o SPEC);
+  TYPE_THEN `b` (USE 1 o SPEC);
+  IN_OUT_TAC;
+  REWR 2;
+  REWR 3;
+  CHO 3;
+  CHO 2;
+  TYPE_THEN `(x',x'')` EXISTS_TAC;
+  (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let IMAGE_I = prove_by_refinement(
+  `!(A:A->bool). IMAGE I A = A`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[IMAGE;IN;I_DEF];
+  GEN_TAC;
+  MATCH_MP_TAC EQ_EXT THEN GEN_TAC ;
+  REWRITE_TAC[IN_ELIM_THM'];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let EMPTY_NOT_EXISTS = prove_by_refinement(
+  `!X. (X = {}) <=> (~(?(u:A). X u))`,
+  (* {{{ proof *)
+  [
+  MESON_TAC [IN;EMPTY_EXISTS];
+  ]);;
+  (* }}} *)
+
+let DIFF_SURJ = prove_by_refinement(
+  `!(f : A->B) X Y. (BIJ f X Y) ==>
+  (! t. (t SUBSET X) ==> ((IMAGE f (X DIFF t)) = (Y DIFF (IMAGE f t))))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[BIJ;INJ;SURJ;IN  ];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[IMAGE;IN];
+  IMATCH_MP_TAC  EQ_EXT ;
+  REWRITE_TAC[IN_ELIM_THM'];
+  NAME_CONFLICT_TAC;
+  X_GEN_TAC `y:B`;
+  REWRITE_TAC[REWRITE_RULE[IN] IN_DIFF];
+  REWRITE_TAC[IN_ELIM_THM'];
+  ASM_MESON_TAC[SUBSET;IN ];
+  ]);;
+
+  (* }}} *)
+
+let union_subset = prove_by_refinement(
+  `!Z1 Z2 A. ((Z1 UNION Z2) SUBSET (A:A->bool)) <=>
+     (Z1 SUBSET A) /\ (Z2 SUBSET A)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[UNION;SUBSET;IN;IN_ELIM_THM'];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let preimage_disjoint = prove_by_refinement(
+  `!(f:A->B) A B X. (A INTER B = EMPTY) ==>
+    (preimage X f A INTER (preimage X f B) = EMPTY )`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[preimage];
+  REWRITE_TAC[EQ_EMPTY];
+  DISCH_ALL_TAC;
+  USE 1( REWRITE_RULE[INTER;IN;IN_ELIM_THM']);
+  USE 0 (REWRITE_RULE[EQ_EMPTY;INTER;IN;IN_ELIM_THM']);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let preimage_union = prove_by_refinement(
+  `!(f:A->B) A B X Z.
+       (Z SUBSET ((preimage X f A) UNION (preimage X f B))) <=>
+     (Z SUBSET X) /\ (IMAGE f Z SUBSET (A UNION B))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[preimage;IMAGE;UNION;SUBSET;IN;IN_ELIM_THM' ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let subset_preimage = prove_by_refinement(
+  `!(f:A->B) A X Z. (Z SUBSET (preimage X f A)) <=> (Z SUBSET X) /\
+        (IMAGE f Z SUBSET A)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;preimage;IMAGE;IN;IN_ELIM_THM'];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let preimage_unions = prove_by_refinement(
+  `!dom (f:A->B) C. preimage dom f (UNIONS C) =
+     (UNIONS (IMAGE (preimage dom f) C))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[preimage;IN_UNIONS ];
+  REWRITE_TAC[UNIONS;IN_IMAGE ];
+  REWRITE_TAC[preimage;IN];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT ;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  REWRITE_TAC[Q_ELIM_THM;IN_ELIM_THM' ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let preimage_subset = prove_by_refinement(
+  `!(f:A->B) X  A B. (A SUBSET B) ==>
+   (preimage X f A SUBSET (preimage X f B))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;in_preimage];
+  REWRITE_TAC[IN];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* to fix two varying descriptions of ((INTER) Y): *)
+let INTER_THM = prove_by_refinement(
+  `!(X:A->bool). ((\B. B INTER X) = ((INTER) X)) /\
+    ((\B. X INTER B) = ((INTER) X))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INTER_COMM];
+  GEN_TAC;
+  MATCH_MP_TAC EQ_EXT THEN BETA_TAC;
+  REWRITE_TAC[INTER_COMM];
+]);;
+ (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Real Preliminaries *)
+(* ------------------------------------------------------------------ *)
+
+let REAL_SUM_SQUARE_POS = prove_by_refinement(
+  `!m n x . &.0 <=. sum(m,n) (\i. (x i)*.(x i))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC SUM_POS_GEN;
+  DISCH_ALL_TAC;
+  BETA_TAC;
+  REWRITE_TAC[REAL_LE_SQUARE];
+  ]);;
+  (* }}} *)
+
+(* twopow , DUPLICATE OF TWOPOW_MK_POS *)
+let twopow_pos = prove_by_refinement(
+  `!n. (&.0 <. twopow(n))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  DISJ_CASES_TAC (SPEC `n:int` INT_IMAGE);
+  CHO 0;
+  ASM_REWRITE_TAC[TWOPOW_POS];
+  REDUCE_TAC;
+  ARITH_TAC;
+  CHO 0;
+  ASM_REWRITE_TAC[TWOPOW_NEG];
+  REDUCE_TAC;
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let twopow_double = prove_by_refinement(
+  `!n. &.2 * (twopow (--: (&: (n+1)))) = twopow (--: (&:n))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[TWOPOW_NEG;REAL_POW_ADD;POW_1;REAL_INV_MUL    ];
+  REWRITE_TAC [REAL_ARITH `a*b*cc = (a*cc)*b`];
+  REWRITE_TAC [REAL_RINV_2 ];
+  REAL_ARITH_TAC ;
+  ]);;
+  (* }}} *)
+
+
+let min_finite = prove_by_refinement(
+  `!X.  (FINITE X) /\ (~(X = EMPTY )) ==>
+     (?delta. (X delta) /\ (!x. (X x) ==> (delta <=. x)))`,
+  (* {{{ proof *)
+
+  [
+  TYPE_THEN `(!X k. FINITE X /\ (~(X = EMPTY )) /\ (X HAS_SIZE k) ==> (?delta. X delta /\ (!x. X x ==> delta <= x))) ==>(!X. FINITE X /\ (~(X = EMPTY )) ==> (?delta. X delta /\ (!x. X x ==> delta <= x)))` SUBGOAL_TAC ;
+  DISCH_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `X` (USE 0 o SPEC);
+  TYPE_THEN `CARD X` (USE 0 o SPEC);
+  UND 0;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[HAS_SIZE ];
+  DISCH_THEN IMATCH_MP_TAC ;
+  CONV_TAC (quant_left_CONV "k");
+  INDUCT_TAC;
+  REWRITE_TAC[HAS_SIZE_0];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[EMPTY];
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  USE 3(REWRITE_RULE[HAS_SIZE]);
+  TYPE_THEN `X DELETE (CHOICE X)` (USE 0 o SPEC);
+  ASM_CASES_TAC `k=0`;
+  REWR 3;
+  USE 3 (REWRITE_RULE [ARITH_RULE `SUC 0=1`]);
+  TYPE_THEN `SING X` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  CARD_SING_CONV;
+  ASM_MESON_TAC [HAS_SIZE];
+  REWRITE_TAC[SING];
+  DISCH_TAC ;
+  CHO 5;
+  TYPE_THEN `x` EXISTS_TAC ;
+  ASM_REWRITE_TAC[REWRITE_RULE[IN] IN_SING ];
+  REAL_ARITH_TAC;
+  TYPE_THEN `FINITE (X DELETE CHOICE X) /\ ~(X DELETE CHOICE X = {}) /\ (X DELETE CHOICE X HAS_SIZE k ) ` SUBGOAL_TAC;
+  REWRITE_TAC[FINITE_DELETE;HAS_SIZE ];
+  ASM_REWRITE_TAC[];
+  REWR 3;
+  IMATCH_MP_TAC  (TAUT `(a /\ b) ==> (b /\ a)`);
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  (ARITH_RULE `(SUC x = SUC y) ==> (x = y)`);
+  COPY 3;
+  UND 3;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  IMATCH_MP_TAC  CARD_DELETE_CHOICE;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  (TAUT `(b ==> ~a ) ==> (a ==> ~b)`);
+  DISCH_THEN (fun t-> ASM_REWRITE_TAC[t;CARD_CLAUSES]);
+  DISCH_TAC;
+  REWR 0;
+  CHO 0;
+  ALL_TAC; (* "ccx" *)
+  TYPE_THEN `if (delta < (CHOICE X)) then delta else (CHOICE X)` EXISTS_TAC;
+  (* REWRITE_TAC[min_real]; *)
+  COND_CASES_TAC ;
+  CONJ_TAC;
+  UND 0;
+  REWRITE_TAC[DELETE;IN ;IN_ELIM_THM' ];
+  MESON_TAC[];
+  GEN_TAC;
+  UND 0;
+  REWRITE_TAC[DELETE;IN ;IN_ELIM_THM' ];
+  DISCH_ALL_TAC;
+  TYPE_THEN  `x = CHOICE X` ASM_CASES_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 6;
+  REAL_ARITH_TAC;
+  ASM_MESON_TAC[];
+  SUBCONJ_TAC;
+  IMATCH_MP_TAC  (REWRITE_RULE[IN ] CHOICE_DEF);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `x = CHOICE X` ASM_CASES_TAC ;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  UND 0;
+    REWRITE_TAC[DELETE;IN ;IN_ELIM_THM' ];
+  DISCH_ALL_TAC;
+  TYPE_THEN `x` (USE 11 o SPEC);
+  REWR 11;
+  UND 11;
+  UND 6;
+  REAL_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let min_finite_delta = prove_by_refinement(
+  `!c X.  (FINITE X) /\ ( !x. (X x) ==> (c <. x) ) ==>
+     (?delta. (c <. delta) /\ (!x. (X x) ==> (delta <=. x)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `~(X = EMPTY)` ASM_CASES_TAC;
+  JOIN 0 2;
+  USE 0 (MATCH_MP min_finite);
+  CHO 0;
+  TYPE_THEN `delta` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  REWR 2;
+  ASM_REWRITE_TAC[EMPTY];
+  TYPE_THEN `c +. (&.1)` EXISTS_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let union_closed_interval = prove_by_refinement(
+  `!a b c. (a <=. b) /\ (b <=. c) ==>
+    ({x | a <= x /\ x < b} UNION {x | b <= x /\ x <= c} =
+     { x | a <= x /\ x <= c})`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[UNION;IN;IN_ELIM_THM'];
+  IMATCH_MP_TAC  EQ_EXT ;
+  REWRITE_TAC[IN_ELIM_THM'];
+  UND 0;
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let real_half_LT = prove_by_refinement(
+  `!x y z. ((x < z/(&.2)) /\ (y < z/(&.2)) ==> (x + y < z))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE];
+  UND 0;
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let real_half_LE = prove_by_refinement(
+  `!x y z. ((x < z/(&.2)) /\ (y <= z/(&.2)) ==> (x + y < z))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE];
+  UND 0;
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let real_half_EL = prove_by_refinement(
+  `!x y z. ((x <= z/(&.2)) /\ (y < z/(&.2)) ==> (x + y < z))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE];
+  UND 0;
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let real_half_LLE = prove_by_refinement(
+  `!x y z. ((x <= z/(&.2)) /\ (y <= z/(&.2)) ==> (x + y <= z))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  (GEN_REWRITE_TAC RAND_CONV) [GSYM REAL_HALF_DOUBLE];
+  UND 0;
+  UND 1;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let interval_finite = prove_by_refinement(
+  `!N. FINITE {x | ?j. (abs x = &.j) /\ (j <=| N)}`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  ABBREV_TAC `inter = {n | n <=| N}`;
+  SUBGOAL_TAC `FINITE {y | ?x. (x IN inter /\ (y = (&. x)))}`;
+  MATCH_MP_TAC FINITE_IMAGE_EXPAND;
+  EXPAND_TAC "inter";
+  REWRITE_TAC[FINITE_NUMSEG_LE];
+  SUBGOAL_TAC `FINITE {y | ?x. (x IN inter /\ (y = --.(&. x)))}`;
+  MATCH_MP_TAC FINITE_IMAGE_EXPAND;
+  EXPAND_TAC "inter";
+  REWRITE_TAC[FINITE_NUMSEG_LE];
+  DISCH_ALL_TAC;
+  JOIN 1 2;
+  USE 1 (REWRITE_RULE[GSYM FINITE_UNION]);
+  UND 1;
+  SUBGOAL_TAC `!a b. ((a:real->bool) = b) ==> (FINITE a ==> FINITE b)`;
+  REP_GEN_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  DISCH_THEN (fun t-> MATCH_MP_TAC t);
+  MATCH_MP_TAC EQ_EXT;
+  X_GEN_TAC `c:real`;
+  REWRITE_TAC[IN_ELIM_THM';UNION];
+  EXPAND_TAC "inter";
+  REWRITE_TAC[IN_ELIM_THM'];
+  REWRITE_TAC[real_abs];
+  EQ_TAC;
+  MATCH_MP_TAC (TAUT `(a==>b) /\ (c==>b) ==> (a \/ c ==> b)`);
+  CONJ_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  AND 1;
+  ASM_REWRITE_TAC[];
+  EXISTS_TAC `x:num`;
+  ASM_REWRITE_TAC [REAL_LE;LE_0];
+  DISCH_THEN CHOOSE_TAC;
+  AND 1;
+  EXISTS_TAC `x:num`;
+  ASM_REWRITE_TAC[REAL_NEG_NEG];
+  COND_CASES_TAC;
+  UND 3;
+  REDUCE_TAC;
+  ARITH_TAC;
+  REDUCE_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  AND 1;
+  UND 2;
+  COND_CASES_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  DISJ2_TAC;
+  EXISTS_TAC `j:num`;
+  ASM_REWRITE_TAC[];
+  UND 3;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Euclidean Space *)
+(* ------------------------------------------------------------------ *)
+
+let euclid_add_closure = prove_by_refinement(
+  `!f g n. (euclid n f) /\ (euclid n g) ==> (euclid n (f + g))`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclid;euclid_plus];
+  ASM_MESON_TAC[REAL_ARITH `&0 +. (&.0) = (&.0)`];
+  ]);;
+(* }}} *)
+
+let euclid_scale_closure = prove_by_refinement(
+  `!n t f. (euclid n f) ==> (euclid n ((t:real) *# f))`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclid;euclid_scale];
+  MESON_TAC[REAL_ARITH `t *.(&.0) = (&.0)`];
+  ]);;
+(* }}} *)
+
+let euclid_neg_closure = prove_by_refinement(
+  `!f n. (euclid n f) ==> (euclid n (-- f))`,
+(* {{{ *)
+
+  [
+  REWRITE_TAC[euclid;euclid_neg];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[REAL_ARITH `(--x = &.0) <=> (x = &.0)`];
+  ]);;
+
+(* }}} *)
+
+let euclid_sub_closure = prove_by_refinement(
+  `!f g n. (euclid n f ) /\ (euclid n g) ==> (euclid n (f - g))`,
+(* {{{ *)
+
+  [
+  REWRITE_TAC[euclid;euclid_minus];
+  ASM_MESON_TAC[REAL_ARITH `&.0 -. (&.0) = (&.0)`];
+  ]);;
+
+(* }}} *)
+
+let neg_dim = prove_by_refinement(
+  `!f n. (euclid n f) = (euclid n (--f))`,
+(* {{{ *)
+
+  [
+  REPEAT GEN_TAC;
+  EQ_TAC;
+  REWRITE_TAC[euclid_neg_closure];
+  REWRITE_TAC[euclid;euclid_neg];
+  DISCH_ALL_TAC;
+  ONCE_REWRITE_TAC[REAL_ARITH `(x = &.0) <=> (--x = &.0)`];
+  ASM_REWRITE_TAC[];
+  ]);;
+
+(* }}} *)
+
+let euclid_updim = prove_by_refinement (
+ `!f m n. (m <=| n) /\ (euclid m f) ==> (euclid n f)`,
+(* {{{ *)
+ [
+ REWRITE_TAC[euclid];
+ MESON_TAC[LE_TRANS];
+ ]);;
+(* }}} *)
+
+let euclidean_add_closure = prove_by_refinement(
+ `!f g. (euclidean f) /\ (euclidean g) ==> (euclidean (f+g))`,
+(* {{{ *)
+
+  [
+  REWRITE_TAC[euclidean];
+  DISCH_ALL_TAC;
+  UNDISCH_FIND_THEN `euclid` CHOOSE_TAC;
+  UNDISCH_FIND_THEN `(?)` CHOOSE_TAC;
+  EXISTS_TAC `n+|n'`;
+  ASSUME_TAC (ARITH_RULE `n <=| n+n'`);
+  ASSUME_TAC (ARITH_RULE `n' <=| n+n'`);
+  ASM_MESON_TAC[euclid_add_closure;euclid_updim];
+  ]);;
+
+(* }}} *)
+
+let euclidean_sub_closure = prove_by_refinement(
+  `!f g. (euclidean f) /\ (euclidean g) ==> (euclidean (f-g))`,
+(* {{{ *)
+
+  [
+  REWRITE_TAC[euclidean];
+  DISCH_ALL_TAC;
+  UNDISCH_FIND_THEN `euclid` CHOOSE_TAC;
+  UNDISCH_FIND_THEN `(?)` CHOOSE_TAC;
+  EXISTS_TAC `n+|n'`;
+  ASSUME_TAC (ARITH_RULE `n <=| n+n'`);
+  ASSUME_TAC (ARITH_RULE `n' <=| n+n'`);
+  ASM_MESON_TAC[euclid_sub_closure;euclid_updim];
+  ]);;
+
+(* }}} *)
+
+let euclidean_scale_closure = prove_by_refinement(
+  `!s f. (euclidean f) ==> (euclidean (s *# f))`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclidean];
+  REPEAT GEN_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `n:num`;
+  ASM_MESON_TAC[euclid_scale_closure];
+  ]);;
+(* }}} *)
+
+let euclidean_neg_closure = prove_by_refinement(
+  `!f. (euclidean f) ==> (euclidean (-- f))`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclidean];
+  GEN_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `n:num`;
+  ASM_MESON_TAC[euclid_neg_closure];
+  ]);;
+(* }}} *)
+
+let euclid_add_comm = prove_by_refinement(
+  `!(f:num->real) g. (f + g = g + f)`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclid_plus;REAL_ARITH `a+.b = b+.a`]
+  ]);;
+(* }}} *)
+
+let euclid_add_assoc = prove_by_refinement(
+  `!(f:num->real) g h. (f + g)+h = f + g + h`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclid_plus;REAL_ARITH `(a+.b)+.c = a+b+c`];
+  ]);;
+(* }}} *)
+
+let euclid_lzero = prove_by_refinement(
+  `!f. euclid0 + f = f`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclid_plus;euclid0;REAL_ARITH `&.0+a=a`];
+  ACCEPT_TAC (INST_TYPE [(`:num`,`:A`);(`:real`,`:B`)] ETA_AX);
+  ]);;
+(* }}} *)
+
+let euclid_rzero = prove_by_refinement(
+  `!f. f + euclid0  = f`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclid_plus;euclid0;REAL_ARITH `a+(&.0)=a`];
+  ACCEPT_TAC (INST_TYPE [(`:num`,`:A`);(`:real`,`:B`)] ETA_AX);
+  ]);;
+(* }}} *)
+
+let euclid_ldistrib = prove_by_refinement(
+  `!f g r. r *# (f + g) = (r *# f) + (r *# g)`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclid_plus;euclid_scale;REAL_ARITH `a*(b+.c)=a*b+a*c`];
+  ]);;
+(* }}} *)
+
+let euclid_rdistrib = prove_by_refinement(
+  `!f r s.  (r+s)*# f  = (r *# f) + (s *# f)`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclid_plus;euclid_scale;REAL_ARITH `(a+b)*c= a*c+b*c`];
+  ]);;
+(* }}} *)
+
+let euclid_scale_act = prove_by_refinement(
+  `!r s f. r *# (s *# f) = (r *s) *# f`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclid_scale;REAL_ARITH `(a*b)*c = a*(b*c)`];
+  ]);;
+(* }}} *)
+
+let euclid_scale_one = prove_by_refinement(
+  `!f. (&.1) *# f = f`,
+(* {{{ proof *)
+  [
+  REWRITE_TAC[euclid_scale];
+  REDUCE_TAC;
+  MESON_TAC[ETA_AX];
+  ]);;
+(* }}} *)
+
+let euclid_neg_sum = prove_by_refinement(
+  `!x y .  euclid_minus (--x) (--y) = -- (euclid_minus x y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[euclid_neg;euclid_minus];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  BETA_TAC;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let trivial_lin_combo = prove_by_refinement(
+  `!x t.  ((t *# x) + (&.1 - t) *# x = x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[euclid_plus;euclid_scale;];
+  IMATCH_MP_TAC  EQ_EXT  THEN BETA_TAC;
+  REAL_ARITH_TAC ;
+  ]);;
+  (* }}} *)
+
+
+(* DOT PRODUCT  *)
+
+let dot_euclid = prove_by_refinement(
+ `!p f g. (euclid p f) /\ (euclid p g) ==>
+   (dot f g = sum (0,p) (\i. (f i)* (g i)))`,
+(* {{{ *)
+
+  [
+  REWRITE_TAC[dot];
+    LET_TAC;
+  REPEAT GEN_TAC;
+  ABBREV_TAC `(P:num->bool) = \m. (euclid m f) /\ (euclid m g)`;
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `(P:num->bool) (p:num)`;
+  EXPAND_TAC "P";
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  SUBGOAL_TAC `min_num P <=| p`;
+  ASM_MESON_TAC[min_least];
+  DISCH_TAC;
+  SUBGOAL_TAC
+    `euclid (min_num (P:num->bool)) f /\ (euclid (min_num (P:num->bool)) g)`;
+  ASM_MESON_TAC[min_least];
+  DISCH_ALL_TAC;
+  ABBREV_TAC `q = min_num P`;
+  MP_TAC (SPECL [`q:num`;`p:num`] LE_EXISTS);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  ASM_REWRITE_TAC[GSYM SUM_TWO];
+  MATCH_MP_TAC (REAL_ARITH `(u = (&.0)) ==> (x = x + u)`);
+  SUBGOAL_THEN `!n. n>=| q  ==> ((\i. f i *. g i) n = (&.0))` (fun th -> MATCH_MP_TAC (MATCH_MP SUM_ZERO th));
+  GEN_TAC THEN BETA_TAC;
+  DISCH_TAC;
+  SUBGOAL_THEN `(f:num->real) n = (&.0)` (fun th -> REWRITE_TAC[th;REAL_ARITH `(&.0)*.a =(&.0)`]);
+  UNDISCH_TAC `euclid q f`;
+  UNDISCH_TAC `n >=| q`;
+  MESON_TAC[euclid;ARITH_RULE `(a<=|b) <=> (b >=| a)`];
+  ACCEPT_TAC (ARITH_RULE `q >=| q`);
+  ]);;
+
+(* }}} *)
+
+let dot_updim = prove_by_refinement (
+ `!f g m n. (m <=|n) /\ (euclid m f) /\ (euclid m g) ==>
+   (dot f g = sum (0,n) (\i. (f i)* (g i)))`,
+(* {{{ *)
+ [
+ REPEAT GEN_TAC;
+ DISCH_ALL_TAC;
+   SUBGOAL_TAC `(euclid n f) /\ (euclid n g)`;
+ ASM_MESON_TAC[euclid_updim];
+ MATCH_ACCEPT_TAC dot_euclid]
+);;
+(* }}} *)
+
+let dot_nonneg = prove_by_refinement(
+ `!f. (&.0 <= (dot f f))`,
+(* {{{ *)
+ [
+ REWRITE_TAC[dot];
+   LET_TAC;
+ GEN_TAC;
+ SUBGOAL_TAC `(!n. (&.0 <=. (\(i:num). f i *. f i) n))`;
+ BETA_TAC;
+ REWRITE_TAC[REAL_LE_SQUARE];
+ ASSUME_TAC(SPEC `\i. (f:num->real) i *. f i` SUM_POS);
+ ASM_MESON_TAC[]]);;
+(* }}} *)
+
+let dot_comm = prove_by_refinement(
+  `!f g. (dot f g = dot g f)`,
+(* {{{ *)
+ [
+ REWRITE_TAC[dot];
+ REWRITE_TAC[REAL_ARITH `a*.b = b*.a`;TAUT `a/\b <=> b/\a`]
+ ]);;
+(* }}} *)
+
+let dot_neg = prove_by_refinement(
+  `!f g. (dot (--f) g) = --. (dot f g)`,
+(* {{{ *)
+ [
+ REWRITE_TAC[dot];
+   LET_TAC;
+  REWRITE_TAC [GSYM neg_dim];
+  ONCE_REWRITE_TAC[GSYM SUM_NEG];
+  REWRITE_TAC[euclid_neg];
+  REPEAT GEN_TAC;
+  AP_TERM_TAC;
+  MATCH_MP_TAC EQ_EXT;
+  BETA_TAC;
+  GEN_TAC;
+  REWRITE_TAC[REAL_ARITH `(--x) * y = --. (x *y)`];
+ ]);;
+(* }}} *)
+
+let dot_neg2 = prove_by_refinement(
+  `!f g. (dot f (--g)) = --. (dot f g)`,
+(* {{{ *)
+  [
+  ONCE_REWRITE_TAC[dot_comm];
+  REWRITE_TAC[dot_neg];
+  ]);;
+(* }}} *)
+
+let dot_scale = prove_by_refinement(
+ `!n f g s. (euclid n f) /\ (euclid n g) ==>
+  (dot (s *# f) g = s *. (dot f g))`,
+(* {{{ *)
+ [
+ REWRITE_TAC[euclid_scale];
+ REPEAT GEN_TAC;
+   DISCH_THEN (fun th -> ASSUME_TAC th THEN ASSUME_TAC (MATCH_MP dot_euclid th));
+   SUBGOAL_THEN (`euclid n (\ (i:num). (s *. f i) ) /\ (euclid n g)`) ASSUME_TAC;
+ ASM_REWRITE_TAC[];
+ ASSUME_TAC(REWRITE_RULE[euclid_scale](SPECL [`n:num`;`s:real`;`f:num->real`] euclid_scale_closure));
+ ASM_MESON_TAC[];
+ IMP_RES_THEN ASSUME_TAC dot_euclid;
+ ASM_REWRITE_TAC[];
+ REWRITE_TAC[GSYM SUM_CMUL];
+ AP_TERM_TAC;
+ MATCH_MP_TAC EQ_EXT;
+ GEN_TAC;
+ BETA_TAC;
+ REWRITE_TAC[REAL_ARITH `a*.(b*.c) = (a*b)*c`];
+ ]);;
+(* }}} *)
+
+let dot_scale_euclidean = prove_by_refinement(
+  `!f g s. (euclidean f) /\ (euclidean g) ==>
+  (dot (s *# f) g = s *. (dot f g))`,
+(* {{{ *)
+
+ [
+ REWRITE_TAC[euclidean];
+ DISCH_ALL_TAC;
+ REPEAT (UNDISCH_FIND_THEN  `euclid` (CHOOSE_THEN MP_TAC));
+ DISCH_ALL_TAC;
+ ASSUME_TAC (ARITH_RULE `(n' <=| n+n')`);
+ ASSUME_TAC (ARITH_RULE `(n <=| n+n')`);
+ SUBGOAL_TAC `euclid (n+|n') f /\ euclid (n+n') g`;
+ ASM_MESON_TAC[euclid_updim];
+ MESON_TAC[dot_scale];
+ ]);;
+
+(* }}} *)
+
+let dot_scale2 = prove_by_refinement(
+ `!n f g s. (euclid n f) /\ (euclid n g) ==>
+  (dot f (s *# g) = s *. (dot f g))`,
+(* {{{ *)
+ [
+ ONCE_REWRITE_TAC[dot_comm];
+ MESON_TAC[dot_scale]
+ ]);;
+(* }}} *)
+
+let dot_scale2_euclidean = prove_by_refinement(
+  `!f g s. (euclidean f) /\ (euclidean g) ==>
+  (dot f (s *# g) = s *. (dot f g))`,
+(* {{{ *)
+ [
+ ONCE_REWRITE_TAC[dot_comm];
+ MESON_TAC[dot_scale_euclidean];
+ ]);;
+(* }}} *)
+
+let dot_linear = prove_by_refinement(
+ `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==>
+    ((dot (f + g) h ) = (dot f h) +. (dot g h))`,
+(* {{{ *)
+  [
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `euclid n (f+g)`;
+  ASM_MESON_TAC[euclid_add_closure];
+  DISCH_TAC;
+  MP_TAC (SPECL [`n:num`;`f:num->real`;`h:num->real`] dot_euclid);
+  MP_TAC (SPECL [`n:num`;`g:num->real`;`h:num->real`] dot_euclid);
+  MP_TAC (SPECL [`n:num`;`(f+g):num->real`;`h:num->real`] dot_euclid);  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[GSYM SUM_ADD];
+  AP_TERM_TAC;
+  MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC;
+  REWRITE_TAC[euclid_plus];
+  REWRITE_TAC[REAL_ARITH `(a+.b)*.c = a*c + b*c`];
+  ]);;
+(* }}} *)
+
+let dot_minus_linear = prove_by_refinement(
+ `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==>
+    ((dot (f - g) h ) = (dot f h) -. (dot g h))`,
+(* {{{ *)
+
+  [
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `euclid n (f-g)`;
+  ASM_MESON_TAC[euclid_sub_closure];
+  DISCH_TAC;
+  MP_TAC (SPECL [`n:num`;`f:num->real`;`h:num->real`] dot_euclid);
+  MP_TAC (SPECL [`n:num`;`g:num->real`;`h:num->real`] dot_euclid);
+  MP_TAC (SPECL [`n:num`;`(f-g):num->real`;`h:num->real`] dot_euclid);
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[GSYM SUM_SUB];
+  AP_TERM_TAC;
+  MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC;
+  REWRITE_TAC[euclid_minus];
+  REWRITE_TAC[REAL_ARITH `(a-.b)*.c = a*c - b*c`];
+  ]);;
+
+(* }}} *)
+
+let dot_linear_euclidean = prove_by_refinement(
+ `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==>
+    ((dot (f + g) h ) = (dot f h) +. (dot g h))`,
+(* {{{ *)
+  [
+  REWRITE_TAC[euclidean];
+  DISCH_ALL_TAC;
+  REPEAT (UNDISCH_FIND_THEN `euclid` (CHOOSE_THEN MP_TAC));
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `(euclid (n+n'+n'') f)`;
+  ASM_MESON_TAC[ARITH_RULE `n <=| n+n'+n''`;euclid_updim];
+  SUBGOAL_TAC `(euclid (n+n'+n'') g)`;
+  ASM_MESON_TAC[ARITH_RULE `n' <=| n+n'+n''`;euclid_updim];
+  SUBGOAL_TAC `(euclid (n+n'+n'') h)`;
+  ASM_MESON_TAC[ARITH_RULE `n'' <=| n+n'+n''`;euclid_updim];
+  MESON_TAC[dot_linear]]);;
+(* }}} *)
+
+let dot_minus_linear_euclidean = prove_by_refinement(
+ `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==>
+    ((dot (f - g) h ) = (dot f h) -. (dot g h))`,
+(* {{{ *)
+
+  [
+  REWRITE_TAC[euclidean];
+  DISCH_ALL_TAC;
+  REPEAT (UNDISCH_FIND_THEN `euclid` (CHOOSE_THEN MP_TAC));
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `(euclid (n+n'+n'') f)`;
+  ASM_MESON_TAC[ARITH_RULE `n <=| n+n'+n''`;euclid_updim];
+  SUBGOAL_TAC `(euclid (n+n'+n'') g)`;
+  ASM_MESON_TAC[ARITH_RULE `n' <=| n+n'+n''`;euclid_updim];
+  SUBGOAL_TAC `(euclid (n+n'+n'') h)`;
+  ASM_MESON_TAC[ARITH_RULE `n'' <=| n+n'+n''`;euclid_updim];
+  MESON_TAC[dot_minus_linear];
+]);;
+
+(* }}} *)
+
+let dot_linear2 = prove_by_refinement(
+  `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==>
+    ((dot h (f + g)) = (dot h f) +. (dot h g))`,
+(* {{{ *)
+
+  [
+  REPEAT GEN_TAC;
+  ONCE_REWRITE_TAC[dot_comm];
+  MESON_TAC[dot_linear]
+  ]);;
+
+(* }}} *)
+
+let dot_linear2_euclidean = prove_by_refinement(
+  `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==>
+    ((dot h (f + g)) = (dot h f) +. (dot h g))`,
+(* {{{ *)
+  [
+  REPEAT GEN_TAC;
+  ONCE_REWRITE_TAC[dot_comm];
+  MESON_TAC[dot_linear_euclidean]
+  ]);;
+(* }}} *)
+
+let dot_minus_linear2 = prove_by_refinement(
+  `!n f g h. (euclid n f) /\ (euclid n g) /\ (euclid n h) ==>
+    ((dot h (f - g)) = (dot h f) -. (dot h g))`,
+(* {{{ *)
+
+  [
+  REPEAT GEN_TAC;
+  ONCE_REWRITE_TAC[dot_comm];
+  MESON_TAC[dot_minus_linear]
+  ]);;
+
+(* }}} *)
+
+let dot_minus_linear2_euclidean = prove_by_refinement(
+  `!f g h. (euclidean f) /\ (euclidean g) /\ (euclidean h) ==>
+    ((dot h (f - g)) = (dot h f) -. (dot h g))`,
+(* {{{ *)
+
+  [
+  REPEAT GEN_TAC;
+  ONCE_REWRITE_TAC[dot_comm];
+  MESON_TAC[dot_minus_linear_euclidean]
+  ]);;
+
+(* }}} *)
+
+let dot_rzero = prove_by_refinement(
+  `!f. (dot f euclid0) = &.0`,
+(* {{{ *)
+   [
+     REWRITE_TAC[dot;euclid0];
+     LET_TAC;
+     GEN_TAC;
+     SUBGOAL_THEN `(\ (i:num). (f i *. (&.0))) = (\ (r:num). (&.0))` (fun t -> REWRITE_TAC[t]);
+   REWRITE_TAC[REAL_ARITH `a*.(&.0) = (&.0)`];
+   MESON_TAC[SUM_0];
+   ]);;
+(* }}} *)
+
+let dot_lzero = prove_by_refinement(
+   `!f. (dot euclid0 f ) = &.0`,
+(* {{{ *)
+   [
+   ONCE_REWRITE_TAC[dot_comm];
+   REWRITE_TAC[dot_rzero];
+   ]);;
+(* }}} *)
+
+let dot_zero = prove_by_refinement(
+  `!f n. (euclid n f) /\ (dot f f = (&.0)) ==> (f = euclid0)`,
+(* {{{ *)
+   [
+   DISCH_ALL_TAC;
+   UNDISCH_TAC `dot f f = (&.0)`;
+   MP_TAC (SPECL [`n:num`;`f:num->real`;`f:num->real`] dot_euclid);
+   ASM_REWRITE_TAC[];
+   DISCH_THEN (fun th -> REWRITE_TAC[th]);
+   REWRITE_TAC[euclid0];
+   DISCH_TAC;
+   MATCH_MP_TAC EQ_EXT;
+   GEN_TAC THEN BETA_TAC;
+   DISJ_CASES_TAC (ARITH_RULE `x <| n \/ (n <=| x)`);
+   CLEAN_ASSUME_TAC (ARITH_RULE `(x <|n) ==> (SUC x <=| n)`);
+   CLEAN_THEN (SPECL [`SUC x`;`n:num`] LE_EXISTS) CHOOSE_TAC;
+   UNDISCH_TAC `sum(0,n) (\ (i:num). f i *. f i) = (&.0)`;
+   ASM_REWRITE_TAC[];
+   REWRITE_TAC[GSYM SUM_TWO;sum;ARITH_RULE `0+| x = x`];
+   SUBGOAL_TAC `!a b. (&.0 <=. sum(a,b) (\ (i:num). f i *. f i))`;
+   REPEAT GEN_TAC;
+   MP_TAC (SPEC `\ (i:num). f i *. f i` SUM_POS);
+   BETA_TAC;
+   REWRITE_TAC[REAL_LE_SQUARE];
+   MESON_TAC[];
+   DISCH_ALL_TAC;
+   IMP_RES_THEN MP_TAC (REAL_ARITH `(a+.b = &.0) ==> ((&.0 <=. b) ==> (a <=. (&.0)))`);
+   ASM_REWRITE_TAC[];
+   DISCH_TAC;
+   IMP_RES_THEN MP_TAC (REAL_ARITH `(a+b <=. &.0) ==> ((&.0 <=. a) ==> (b <=. (&.0)))`);
+   ASM_REWRITE_TAC[];
+   ABBREV_TAC `a = (f:num->real) x`;
+   MESON_TAC[REAL_LE_SQUARE;REAL_ARITH `a <=. (&.0) /\ (&.0 <=. a) ==> (a = (&.0))`;REAL_ENTIRE];
+   UNDISCH_TAC `euclid n f`;
+   REWRITE_TAC[euclid];
+   ASM_MESON_TAC[];
+   ]);;
+(* }}} *)
+
+let dot_zero_euclidean = prove_by_refinement(
+  `!f. (euclidean f) /\ (dot f f = (&.0)) ==> (f = euclid0)`,
+(* {{{ *)
+   [
+   REWRITE_TAC[euclidean];
+   DISCH_ALL_TAC;
+   UNDISCH_FIND_THEN `euclid` CHOOSE_TAC;
+   ASM_MESON_TAC[dot_zero];
+   ]);;
+(* }}} *)
+
+(* norm *)
+
+let norm_nonneg = prove_by_refinement(
+   `!f. (&.0 <=. norm f)`,
+(* {{{ *)
+   [
+   REWRITE_TAC[norm];
+   ONCE_REWRITE_TAC[GSYM SQRT_0];
+   GEN_TAC;
+   MATCH_MP_TAC SQRT_MONO_LE;
+   REWRITE_TAC[dot_nonneg];
+   REAL_ARITH_TAC;
+   ]);;
+(* }}} *)
+
+let norm_neg = prove_by_refinement(
+  `!f. norm (--f) = norm f`,
+(* {{{ *)
+
+  [
+  REWRITE_TAC[norm;dot_neg;dot_neg2];
+  REWRITE_TAC[REAL_ARITH `--(--. x) = x`];
+  ]);;
+
+(* }}} *)
+
+let cauchy_schwartz = prove_by_refinement(
+  `!f g. (euclidean f) /\ (euclidean g) ==>
+   ((abs(dot f g)) <=. (norm f)*. (norm g))`,
+(* {{{ *)
+  [
+  DISCH_ALL_TAC;
+  DISJ_CASES_TAC (TAUT `(f = euclid0 ) \/ ~(f = euclid0)`);
+  ASM_REWRITE_TAC[dot_lzero;norm;SQRT_0;REAL_ARITH`&.0 *. x = (&.0)`];
+  REWRITE_TAC[ABS_0;REAL_ARITH `x <=. x`];
+  SUBGOAL_THEN `!a b. (dot (a *# f + b *# g) (a *# f + b *# g)) = a*a*(dot f f) + (&.2)*a*b*(dot f g) + b*b*(dot g g)` ASSUME_TAC;
+  REPEAT GEN_TAC;
+  ASM_SIMP_TAC[euclidean_scale_closure;euclidean_add_closure;dot_linear_euclidean;dot_linear2_euclidean;dot_scale_euclidean;dot_scale2_euclidean];
+  REWRITE_TAC[REAL_MUL_AC;REAL_ADD_AC;REAL_ADD_LDISTRIB];
+  MATCH_MP_TAC (REAL_ARITH`(b+. c=e) ==> (a+b+c+d = a+ e+d)`);
+  REWRITE_TAC[GSYM REAL_LDISTRIB];
+  REPEAT AP_TERM_TAC;
+  MATCH_MP_TAC (REAL_ARITH `(a=b)==> (a+.b = a*(&.2))`);
+  REWRITE_TAC[dot_comm];
+  FIRST_ASSUM (fun th -> ASSUME_TAC (SPECL[` --. (dot f g)`;`dot f f`] th));
+  CLEAN_THEN (SPEC `(--.(dot f g)) *# f + (dot f f)*# g` dot_nonneg) ASSUME_TAC;
+  REWRITE_TAC[norm];
+  ASSUME_TAC(SPEC `f:num->real` dot_nonneg);
+  ASSUME_TAC(SPEC `g:num->real` dot_nonneg);
+  ASM_SIMP_TAC[GSYM SQRT_MUL];
+  REWRITE_TAC[GSYM POW_2_SQRT_ABS;POW_2];
+  MATCH_MP_TAC SQRT_MONO_LE;
+  REWRITE_TAC[REAL_LE_SQUARE];
+  SUBGOAL_TAC `&.0 <. dot f f`;
+  MATCH_MP_TAC (REAL_ARITH `~(x = &.0) /\ (&.0 <=. x) ==> (&.0 <. x)`);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[dot_zero_euclidean];
+  REPEAT (UNDISCH_FIND_TAC `(<=.)` );
+  ABBREV_TAC `a = dot f f`;
+  ABBREV_TAC `b = dot f g`;
+  ABBREV_TAC `c = dot g g`;
+  POP_ASSUM_LIST (fun t -> ALL_TAC);
+  REWRITE_TAC[REAL_ARITH `(&.2 *. x = x + x)`;REAL_ADD_AC];
+  REWRITE_TAC[REAL_ARITH `(a *. ((--. b)*.c) = --. (a *. (b*.c)))/\ (--. ((--. a) *. b) = a *.b )`];
+  REWRITE_TAC[REAL_ARITH `(--. b) *. a*. b + b*.b*.a = (&.0)`];
+  REWRITE_TAC[REAL_ARITH `x +. (&.0) = x`];
+  REWRITE_TAC[REAL_ARITH `(&.0 <=. (a*.a*.c +. (--.b)*.a*.b)) <=> (a*b*b <=. a*a*c)`];
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC (SPEC `a:real` REAL_LE_LCANCEL_IMP);
+  ASM_REWRITE_TAC[];
+  ]);;
+(* }}} *)
+
+let norm_dot = prove_by_refinement(
+  `!h. norm(h) * norm(h) = (dot h h)`,
+(* {{{ *)
+  [
+  REWRITE_TAC[norm];
+  ONCE_REWRITE_TAC[GSYM POW_2];
+  REWRITE_TAC[SQRT_POW2;dot_nonneg];
+  ]);;
+(* }}} *)
+
+let norm_triangle = prove_by_refinement(
+  `!f g. (euclidean f) /\ (euclidean g) ==>
+    (norm (f+g) <=. norm(f) + norm(g))`,
+(* {{{ *)
+  [
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC square_le;
+  REWRITE_TAC[norm_nonneg];
+  CONJ_TAC;
+  MATCH_MP_TAC (REAL_ARITH `(&.0 <=. x) /\ (&.0 <=. y) ==> (&.0 <= x+y)`);
+  REWRITE_TAC[norm_nonneg];
+  REWRITE_TAC[REAL_ADD_LDISTRIB;REAL_ADD_RDISTRIB;REAL_ADD_AC];
+  REWRITE_TAC[norm_dot];
+ASM_SIMP_TAC[euclidean_add_closure;dot_linear_euclidean;dot_linear2_euclidean];
+  REWRITE_TAC[REAL_MUL_AC];
+  REWRITE_TAC[REAL_ADD_AC];
+  MATCH_MP_TAC (REAL_ARITH `(b<=.c)==>((a+.b) <=. (a+c))`);
+  MATCH_MP_TAC (REAL_ARITH `(a=b)/\ (a<=. e) ==>((a+b+c) <= (c+e+e))`);
+  CONJ_TAC;
+  REWRITE_TAC[dot_comm];
+  ASM_MESON_TAC[cauchy_schwartz;REAL_LE_TRANS;REAL_ARITH `x <=. ||. x`];
+  ]);;
+(* }}} *)
+
+
+
+(* ------------------------------------------------------------------ *)
+(* Metric Space *)
+(* ------------------------------------------------------------------ *)
+
+let metric_space_zero = prove_by_refinement(
+ `!(X:A->bool) d a. (metric_space(X,d) /\ (X a) ==> (d a a = (&.0)))`,
+(* {{{ *)
+  [MESON_TAC[metric_space]
+  ]);;
+(* }}} *)
+
+let metric_space_symm = prove_by_refinement(
+ `!(X:A->bool) d a b. (metric_space(X,d) /\ (X a) /\ (X b) ==>
+   (d a b = d b a))`,
+(* {{{ *)
+  [
+  MESON_TAC[metric_space];
+  ]);;
+(* }}} *)
+
+let metric_space_triangle = prove_by_refinement(
+ `!(X:A->bool) d a b c. (metric_space(X,d) /\ (X a) /\ (X b) /\ (X c)
+   ==> (d a c <=. d a b +. d b c))`,
+(* {{{ *)
+  [
+  MESON_TAC[metric_space];
+  ]);;
+(* }}} *)
+
+let metric_subspace = prove_by_refinement(
+  `!X Y d. (Y SUBSET (X:A->bool)) /\ (metric_space (X,d)) ==>
+    (metric_space (Y,d))`,
+(* {{{ *)
+  [
+  REWRITE_TAC[SUBSET;metric_space;IN];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  UNDISCH_FIND_THEN `( /\ )` (fun t -> MP_TAC (SPECL[`x:A`;`y:A`;`z:A`] t));
+  ASM_SIMP_TAC[];
+  ]);;
+(* }}} *)
+
+let metric_euclidean = prove_by_refinement(
+  `metric_space (euclidean,d_euclid)`,
+(* {{{ *)
+  [
+  REWRITE_TAC[metric_space;d_euclid];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[norm_nonneg];
+  CONJ_TAC;
+  EQ_TAC;
+  REWRITE_TAC[norm];
+  ONCE_REWRITE_TAC[REAL_ARITH `(&.0 = x) <=> (x = (&.0))`];
+  ASM_SIMP_TAC[dot_nonneg;SQRT_EQ_0];
+  DISCH_TAC;
+  SUBGOAL_TAC `x - y = euclid0`;
+  ASM_MESON_TAC[dot_zero_euclidean;euclidean_sub_closure];
+  REWRITE_TAC[euclid_minus;euclid0];
+  DISCH_TAC THEN (MATCH_MP_TAC EQ_EXT);
+  X_GEN_TAC `n:num`;
+  FIRST_ASSUM  (fun t -> ASSUME_TAC (BETA_RULE (AP_THM t `n:num`)));
+  ASM_MESON_TAC [REAL_ARITH `(a = b) <=> (a-.b = (&.0))`];
+  DISCH_THEN (fun t->REWRITE_TAC[t]);
+  SUBGOAL_THEN `(y:num->real) - y = euclid0` (fun t-> REWRITE_TAC[t]);
+  REWRITE_TAC[euclid0;euclid_minus];
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC THEN BETA_TAC;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[norm;dot_lzero;SQRT_0];
+  CONJ_TAC;
+  SUBGOAL_THEN `x - y = (euclid_neg (y-x))` ASSUME_TAC;
+  REWRITE_TAC[euclid_neg;euclid_minus];
+  MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC;
+  REAL_ARITH_TAC;
+  ASM_MESON_TAC[norm_neg];
+  SUBGOAL_THEN `(x-z) = euclid_plus(x - y)  (y-z)` (fun t -> REWRITE_TAC[t]);
+  REWRITE_TAC[euclid_plus;euclid_minus];
+  MATCH_MP_TAC EQ_EXT THEN GEN_TAC THEN BETA_TAC THEN REAL_ARITH_TAC;
+  ASM_SIMP_TAC[norm_triangle;euclidean_sub_closure;euclidean_sub_closure];
+  ]);;
+(* }}} *)
+
+let metric_euclid = prove_by_refinement(
+  `!n. metric_space (euclid n,d_euclid)`,
+(* {{{ *)
+  [
+  GEN_TAC;
+  MATCH_MP_TAC (ISPEC `euclidean` metric_subspace);
+  REWRITE_TAC[metric_euclidean;SUBSET;IN];
+  MESON_TAC[euclidean];
+  ]);;
+(* }}} *)
+
+let euclid1_abs = prove_by_refinement(
+  `!x y. (euclid 1 x) /\ (euclid 1 y) ==>
+     ((d_euclid x y) = (abs ((x 0) -. (y 0))))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[d_euclid;norm];
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `euclid 1 (x - y)`;
+  ASM_MESON_TAC[euclid_sub_closure];
+  DISCH_TAC;
+  ASSUME_TAC (prove(`1 <= 1`,ARITH_TAC));
+  MP_TAC (SPECL[`(x-y):num->real`;`(x-y):num->real`;`1`;`1`] dot_updim);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  REWRITE_TAC[prove(`1 = SUC 0`,ARITH_TAC)];
+  REWRITE_TAC[sum];
+  REWRITE_TAC[REAL_ARITH `&.0 + x = x`];
+  REWRITE_TAC[ARITH_RULE `0 +| 0 = 0`];
+  REWRITE_TAC[euclid_minus];
+  ASM_MESON_TAC[REAL_POW_2;POW_2_SQRT_ABS];
+  ]);;
+  (* }}} *)
+
+let coord_dirac = prove_by_refinement(
+  `!i t. coord i (t *# dirac_delta i ) = t`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[coord;dirac_delta;euclid_scale];
+  ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let dirac_0 = prove_by_refinement(
+  `!x. (x *# dirac_delta 0) 0 = x`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[dirac_delta;euclid_scale;];
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let euclid1_dirac = prove_by_refinement(
+  `!x. euclid 1 x <=> (x = (x 0) *# (dirac_delta 0))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[euclid; euclid_scale;dirac_delta ];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  X_GEN_TAC `n:num`;
+  BETA_TAC;
+  COND_CASES_TAC;
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ASM_SIMP_TAC[ARITH_RULE  `(~(0=m))==>(1<=| m)`];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  USE 1 (MATCH_MP (ARITH_RULE `1<= m ==> (~(0=m))`));
+  ASM ONCE_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC ;
+  ]);;
+  (* }}} *)
+
+(* projection onto the ith coordinate, as a euclidean vector *)
+let proj = euclid_def
+  `proj i x = (\j. (if (j=0) then (x (i:num)) else (&.0)))`;;
+
+let proj_euclid1 = prove_by_refinement(
+  `!i x. euclid 1 (proj i x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[proj;euclid];
+  REPEAT GEN_TAC;
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let d_euclid_n = prove_by_refinement(
+  `!n x y. ((euclid n x) /\ (euclid n y)) ==> ((d_euclid x y) =
+     sqrt(sum (0,n) (\i. (x i - y i) * (x i - y i))))`,
+  (* {{{ proof *)
+
+  [
+  REPEAT GEN_TAC;
+  REWRITE_TAC[d_euclid;norm];
+  DISCH_ALL_TAC;
+  ASSUME_TAC (ARITH_RULE `n <=| n`);
+  SUBGOAL_TAC `euclid n (x - y)`;
+  ASM_SIMP_TAC[euclid_sub_closure];
+  DISCH_TAC;
+  CLEAN_ASSUME_TAC (SPECL[`(x-y):num->real`;`(x-y):num->real`;`n:num`;`n:num`]dot_updim);
+  ASM_REWRITE_TAC[euclid_minus];
+  ]);;
+
+  (* }}} *)
+
+let norm_n = prove_by_refinement(
+  `!n x. ((euclid n x) ) ==> ((norm x) =
+     sqrt(sum (0,n) (\i. (x i ) * (x i ))))`,
+  (* {{{ proof *)
+  [
+  REPEAT GEN_TAC;
+  TYPEL_THEN [`x`;`x`;`n`;`n`] (fun t-> SIMP_TAC  [norm;ISPECL t dot_updim;ARITH_RULE `n <=| n`;]);
+  ]);;
+  (* }}} *)
+
+let proj_d_euclid = prove_by_refinement(
+  `!i x y. d_euclid (proj i x) (proj i y) = abs (x i -. y i)`,
+  (* {{{ proof *)
+  [
+  REPEAT GEN_TAC;
+  SIMP_TAC[SPEC `1` d_euclid_n;proj_euclid1];
+  REWRITE_TAC[ARITH_RULE `1 = SUC 0`;sum];
+  NUM_REDUCE_TAC;
+  REWRITE_TAC[proj];
+  REWRITE_TAC[REAL_ARITH `&.0 + x = x`];
+  MESON_TAC[POW_2_SQRT_ABS;REAL_POW_2];
+  ]);;
+  (* }}} *)
+
+let d_euclid_pos = prove_by_refinement(
+  `!x y n. (euclid n x) /\ (euclid n y) ==> (&.0 <=. d_euclid x y)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  MP_TAC metric_euclid;
+  REWRITE_TAC[metric_space;euclidean];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let proj_contraction = prove_by_refinement(
+  `!n x y i. (euclid n x) /\ (euclid n y) ==>
+     abs (x i - (y i)) <=. d_euclid x y`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC REAL_POW_2_LE;
+  REWRITE_TAC[REAL_ABS_POS];
+  CONJ_TAC;
+  ASM_MESON_TAC[d_euclid_pos];
+  ASM_SIMP_TAC[SPEC `n:num` d_euclid_n];
+  REWRITE_TAC[REAL_POW2_ABS];
+  SUBGOAL_TAC `euclid n (x - y)`; (* why does MESON fail here??? *)
+  MATCH_MP_TAC euclid_sub_closure;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  SUBGOAL_TAC `&.0 <=. sum (0,n) (\i. (x i - y i)*. (x i - y i))`;
+  MATCH_MP_TAC SUM_POS_GEN;
+  DISCH_ALL_TAC THEN BETA_TAC;
+  REWRITE_TAC[REAL_LE_SQUARE];
+  SIMP_TAC[SQRT_POW_2];
+  DISCH_TAC;
+  ASM_CASES_TAC `n <=| i`;
+  MATCH_MP_TAC (REAL_ARITH `(x = (&.0)) /\ (&.0 <=. y) ==> (x <=. y)`);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_PROP_ZERO_POW];
+  NUM_REDUCE_TAC;
+  ASM_MESON_TAC[euclid;euclid_minus];
+  MP_TAC (ARITH_RULE `~(n <=| i) ==> (i < n) /\ (n = (SUC i) + (n-i-1))`);
+  ASM_REWRITE_TAC[] THEN DISCH_ALL_TAC;
+  ASM ONCE_REWRITE_TAC[];
+  REWRITE_TAC[GSYM SUM_TWO];
+  MATCH_MP_TAC (REAL_ARITH `(a <=. b) /\ (&.0 <=. c)   ==> (a <=. (b +c))`);
+  CONJ_TAC;
+  REWRITE_TAC[sum_DEF];
+  REWRITE_TAC[ARITH_RULE `0 +| i = i`];
+  MATCH_MP_TAC (REAL_ARITH `(a = c) /\ (&.0 <=. b) ==> (a <=. b+c)`);
+  REWRITE_TAC[REAL_POW_2];
+  MP_TAC (SPECL [`0:num`;`i:num`;`(x:num->real)- y`] REAL_SUM_SQUARE_POS);
+  BETA_TAC;
+  REWRITE_TAC[euclid_minus];
+  MP_TAC (SPECL [`SUC i`;`(n:num)-i-1`;`(x:num->real)- y`] REAL_SUM_SQUARE_POS);
+  BETA_TAC;
+  REWRITE_TAC[euclid_minus];
+  ]);;
+  (* }}} *)
+
+let euclid_dirac = prove_by_refinement(
+  `!x. (euclid 1 (x *# (dirac_delta 0)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[euclid;dirac_delta ;euclid_scale];
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP (ARITH_RULE  `1 <=| m ==> (~(0=m))`));
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let d_euclid_pow2 = prove_by_refinement(
+  `!n x y. (euclid n x) /\ (euclid n y) ==>
+     ((d_euclid x y) pow 2 = sum (0,n) (\i. (x i - y i) * (x i - y i)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[d_euclid_n];
+  REWRITE_TAC[SQRT_POW2];
+  MATCH_MP_TAC SUM_POS_GEN;
+  BETA_TAC;
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let D_EUCLID_BOUND = prove_by_refinement(
+  `!n x y eps. ((euclid n x) /\ (euclid n y) /\
+     (!i. (abs (x i -. y i) <=. eps))) ==>
+    ( d_euclid x y <=. sqrt(&.n)*. eps )`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  SQUARE_TAC;
+  SUBCONJ_TAC;
+  JOIN 0 1;
+  USE 0 (MATCH_MP d_euclid_pos);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  WITH 2 (SPEC `0`);
+  USE 4 (MATCH_MP (REAL_ARITH `abs (x) <=. eps ==> &.0 <=. eps`));
+  SUBCONJ_TAC;
+  ALL_TAC;
+  REWRITE_TAC[REAL_MUL_NN];
+  DISJ1_TAC;
+  CONJ_TAC;
+  MATCH_MP_TAC SQRT_POS_LE ;
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ASM_SIMP_TAC[d_euclid_pow2];
+  SUBGOAL_TAC `!i. ((x:num->real) i -. y i) *. (x i -. y i) <=. eps* eps`;
+  GEN_TAC;
+  ALL_TAC;
+  USE 2 (SPEC `i:num`);
+  ABBREV_TAC `t = x i - (y:num->real) i`;
+  UND 2;
+  REWRITE_TAC[ABS_SQUARE_LE];
+  REWRITE_TAC[REAL_POW_MUL];
+  ASSUME_TAC (REWRITE_RULE[] ((REDUCE_CONV `&.0 <= &.n`)));
+  USE 6 (REWRITE_RULE[GSYM SQRT_POW2]);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ALL_TAC;
+  MATCH_MP_TAC SUM_BOUND;
+  GEN_TAC;
+  DISCH_TAC;
+  BETA_TAC;
+  REWRITE_TAC[POW_2];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let metric_translate = prove_by_refinement(
+  `!n x y z . (euclid n x) /\ (euclid n y) /\ (euclid n z) ==>
+   (d_euclid (x + z) (y + z) = d_euclid x y)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[d_euclid;norm];
+  DISCH_ALL_TAC;
+  TYPE_THEN `euclid n (euclid_minus x y)` SUBGOAL_TAC;
+  ASM_SIMP_TAC[euclid_sub_closure];
+  DISCH_TAC;
+  TYPE_THEN `euclid n (euclid_minus (euclid_plus x z) (euclid_plus y z))` SUBGOAL_TAC;
+  ASM_SIMP_TAC[euclid_sub_closure; euclid_add_closure];
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[SPEC `n:num` dot_euclid];
+  TYPE_THEN `(x + z) - (y + z) = ((x:num->real) - y)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  X_GEN_TAC `i:num`;
+  REWRITE_TAC[euclid_minus;euclid_plus];
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  ]);;
+
+  (* }}} *)
+
+let metric_translate_LEFT = prove_by_refinement(
+  `!n x y z . (euclid n x) /\ (euclid n y) /\ (euclid n z) ==>
+   (d_euclid (z + x ) (z + y) = d_euclid x y)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[d_euclid;norm];
+  DISCH_ALL_TAC;
+  TYPE_THEN `euclid n (euclid_minus x y)` SUBGOAL_TAC;
+  ASM_SIMP_TAC[euclid_sub_closure];
+  DISCH_TAC;
+  TYPE_THEN `euclid n (euclid_minus (euclid_plus z x) (euclid_plus z y))` SUBGOAL_TAC;
+  ASM_SIMP_TAC[euclid_sub_closure; euclid_add_closure];
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[SPEC `n:num` dot_euclid];
+  TYPE_THEN `(z + x) - (z + y) = ((x:num->real) - y)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  X_GEN_TAC `i:num`;
+  REWRITE_TAC[euclid_minus;euclid_plus];
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  ]);;
+
+  (* }}} *)
+
+let norm_scale = prove_by_refinement(
+  `!t t' x . (euclidean x) ==>
+   (d_euclid (t *# x) (t' *# x) =
+        ||. (t - t') * norm(x))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[euclidean];
+  LEFT_TAC "n";
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[d_euclid_n;norm_n;euclid_scale_closure;euclid_scale;GSYM REAL_SUB_RDISTRIB;REAL_MUL_AC;];
+  REWRITE_TAC[GSYM REAL_POW_2   ];
+  REWRITE_TAC[REAL_ARITH `a * a * b = b * (a * a)`;SUM_CMUL;];
+  ASM_SIMP_TAC[SQRT_MUL;REAL_SUM_SQUARE_POS;REAL_LE_SQUARE_POW;POW_2_SQRT_ABS  ];
+  REWRITE_TAC[REAL_POW_2];
+  ]);;
+
+  (* }}} *)
+
+let norm_scale_vec = prove_by_refinement(
+  `!n t x x' . (euclid n x) /\ (euclid n x') ==>
+   (d_euclid (t *# x) (t *# x') = ||. t * d_euclid x x')`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[d_euclid_n;norm_n;euclid_scale_closure;euclid_scale;GSYM REAL_SUB_LDISTRIB;REAL_MUL_AC;];
+  REWRITE_TAC[REAL_ARITH `t*t*b = (t*t)*b`];
+  REWRITE_TAC[GSYM REAL_POW_2 ;SUM_CMUL   ];
+  GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV o ONCE_DEPTH_CONV) [REAL_POW_2];
+  ASM_SIMP_TAC[SQRT_MUL;REAL_SUM_SQUARE_POS;REAL_LE_SQUARE_POW;POW_2_SQRT_ABS  ];
+  REWRITE_TAC[REAL_POW_2];
+    ]);;
+
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Topological Spaces *)
+(* ------------------------------------------------------------------ *)
+
+
+(* Definitions *)
+(* underscore is necessary to avoid Harrison's global "topology" *)
+(* carrier of topology is UNIONS U *)
+
+let topology = euclid_def `topology_ (U:(A->bool)->bool) <=>
+  (!A B V.  (U EMPTY) /\
+      ((U A) /\ (U B) ==> (U (A INTER B))) /\
+      ((V SUBSET U) ==> (U (UNIONS V))))`;;
+
+let open_DEF = euclid_def `open_ (U:(A->bool)->bool) A = (U A)`;;
+
+let closed = euclid_def `closed_ (U:(A->bool)->bool) B <=>
+    (B SUBSET (UNIONS U)) /\
+    (open_ U ((UNIONS U) DIFF B))`;;
+
+let closure = euclid_def `closure (U:(A->bool)->bool) A =
+    INTERS { B | (closed_ U B) /\ (A SUBSET B) }`;;
+
+let induced_top  = euclid_def `induced_top U (A:A->bool) =
+  IMAGE ( \B. (B INTER A)) U`;;
+
+let open_ball = euclid_def
+  `open_ball(X,d) (x:A) r = { y | (X x) /\ (X y) /\ (d x y <. r) }`;;
+
+let closed_ball =euclid_def
+  `closed_ball (X,d) (x:A) r = { y | (X x) /\ (X y) /\ (d x y <=. r) }`;;
+
+let open_balls = euclid_def
+  `open_balls (X,d) = { B | ?(x:A) r. B = open_ball (X,d) x r}`;;
+
+let top_of_metric = euclid_def
+  `top_of_metric ((X:A->bool),d) =
+      { A | ?F. (F SUBSET (open_balls (X,d)))/\
+     (A = UNIONS F) }`;;
+
+(* basic properties *)
+
+let open_EMPTY = prove_by_refinement(
+  `!(U:(A->bool)->bool). (topology_ U ==> open_ U EMPTY)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[topology;open_DEF];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let open_closed = prove_by_refinement(
+  `!U A. (topology_ (U:(A->bool)->bool)) /\ (open_ U A) ==>
+     (closed_ U ((UNIONS U) DIFF A))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closed;open_DEF];
+  DISCH_ALL_TAC;
+  SUBGOAL_THEN `(A:A->bool) SUBSET (UNIONS U)` ASSUME_TAC;
+  ASM_MESON_TAC[sub_union];
+  ASM_SIMP_TAC[DIFF_DIFF2];
+  REWRITE_TAC[SUBSET_DIFF];
+  ]);;
+(* }}} *)
+
+let closed_UNIV = prove_by_refinement(
+  `!(U:(A->bool)->bool). (topology_ U ==> closed_ U (UNIONS U))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[open_closed];
+  REWRITE_TAC[closed;open_DEF];
+  TYPE_THEN `a = UNIONS U` ABBREV_TAC;
+  USE 0 (REWRITE_RULE[topology]);
+  CONJ_TAC;
+  MESON_TAC[SUBSET];
+  USE 0 (CONV_RULE (quant_right_CONV "V"));
+  USE 0 (CONV_RULE (quant_right_CONV "B"));
+  USE 0 (CONV_RULE (quant_right_CONV "A"));
+  AND 0;
+  UND 2;
+  MESON_TAC[DIFF_EQ_EMPTY];
+  ]);;
+
+  (* }}} *)
+
+let top_univ = prove_by_refinement(
+  `!(U:(A->bool)->bool). (topology_ U) ==> (U (UNIONS U))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[topology];
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[SUBSET_REFL];
+  ]);;
+  (* }}} *)
+
+let empty_closed = prove_by_refinement(
+  `!(U:(A->bool)->bool).
+     (topology_ U) ==> closed_ U EMPTY`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[closed;EMPTY_SUBSET;DIFF_EMPTY;open_DEF];
+  ASM_MESON_TAC[top_univ];
+  ]);;
+  (* }}} *)
+
+let closed_open = prove_by_refinement(
+  `!(U:(A->bool)->bool) A.  (closed_ U A) ==>
+    (open_ U ((UNIONS U) DIFF A))`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[closed];
+  ]);;
+(* }}} *)
+
+let closed_inter = prove_by_refinement (
+  `!U V. (topology_ (U:(A->bool)->bool)) /\ (!a. (V a) ==> (closed_ U a))
+    /\ ~(V = EMPTY)
+     ==> (closed_ U (INTERS V))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closed];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  MATCH_MP_TAC  INTERS_SUBSET2;
+  USE 2 (REWRITE_RULE[ EMPTY_EXISTS]);
+  USE 2 (REWRITE_RULE[IN]);
+  CHO 2;
+  EXISTS_TAC `u:A->bool`;
+  ASM_MESON_TAC[ ];
+  ABBREV_TAC `VCOMP = IMAGE ((DIFF) (UNIONS (U:(A->bool)->bool))) V`;
+  UNDISCH_FIND_THEN `VCOMP` (fun t -> ASSUME_TAC (GSYM t));
+  SUBGOAL_THEN `(VCOMP:(A->bool)->bool) SUBSET U` ASSUME_TAC;
+  ASM_REWRITE_TAC[SUBSET;IN_ELIM_THM;IMAGE];
+  REWRITE_TAC[IN];
+  GEN_TAC;
+  ASM_MESON_TAC[open_DEF];
+  SUBGOAL_THEN `open_ U (UNIONS (VCOMP:(A->bool)->bool))` ASSUME_TAC;
+  ASM_MESON_TAC[topology;open_DEF];
+  SUBGOAL_THEN ` (UNIONS U DIFF INTERS V)= (UNIONS (VCOMP:(A->bool)->bool))` (fun t-> (REWRITE_TAC[t]));
+  ASM_REWRITE_TAC[UNIONS_INTERS];
+  UNDISCH_FIND_TAC `(open_)`;
+  REWRITE_TAC[];
+  ]);;
+(* }}} *)
+
+let open_nbd = prove_by_refinement(
+  `!U (A:A->bool). (topology_ U) ==>
+    ((U A) = (!x. ?B. (A x ) ==> ((B SUBSET A) /\ (B x) /\ (U B))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  GEN_TAC;
+  EXISTS_TAC `A:A->bool`;
+  ASM_MESON_TAC[SUBSET];
+  CONV_TAC (quant_left_CONV "B");
+  DISCH_THEN CHOOSE_TAC;
+  USE 1 (CONV_RULE NAME_CONFLICT_CONV);
+  TYPE_THEN `UNIONS (IMAGE B A)  = A` SUBGOAL_TAC;
+  MATCH_MP_TAC  SUBSET_ANTISYM;
+  CONJ_TAC;
+  MATCH_MP_TAC  UNIONS_SUBSET;
+  REWRITE_TAC[IN_IMAGE];
+  ASM_MESON_TAC[IN];
+  REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE];
+  DISCH_ALL_TAC;
+  NAME_CONFLICT_TAC;
+  CONV_TAC (quant_left_CONV "x'");
+  CONV_TAC (quant_left_CONV "x'");
+  EXISTS_TAC `x:A`;
+  TYPE_THEN `B x` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[IN];
+  (* on 1*)
+  TYPE_THEN `(IMAGE B A) SUBSET U` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;IN_IMAGE;];
+  REWRITE_TAC[IN];
+  NAME_CONFLICT_TAC;
+  GEN_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  TYPE_THEN `W = IMAGE B A` ABBREV_TAC;
+  KILL 2;
+  ASM_MESON_TAC[topology];
+  ]);;
+  (* }}} *)
+
+let open_inters = prove_by_refinement(
+  `!U (V:(A->bool)->bool). (topology_ U) /\ (V SUBSET U) /\
+    (FINITE V) /\ ~(V = EMPTY)  ==>
+                        (U (INTERS V))`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `(?n. V HAS_SIZE n)` SUBGOAL_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  UND 0;
+  UND 1;
+  UND 2;
+  UND 3;
+  UND 4;
+  CONV_TAC (quant_left_CONV "n");
+  TYPE_THEN `V` SPEC2_TAC ;
+  TYPE_THEN `U` SPEC2_TAC ;
+  CONV_TAC (quant_left_CONV "n");
+  CONV_TAC (quant_left_CONV "n");
+  INDUCT_TAC;
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[HAS_SIZE_0];
+  DISCH_ALL_TAC;
+  TYPE_THEN `U` (USE 0 o SPEC);
+  USE 5 (REWRITE_RULE[HAS_SIZE_SUC;EMPTY_EXISTS]);
+  AND 5;
+  CHO 6;
+  TYPE_THEN `u` (USE 5 o SPEC);
+  REWR 5;
+  TYPE_THEN `V DELETE u` (USE  0 o SPEC);
+  REWR 0;
+  TYPE_THEN `V={u}` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[inters_singleton];
+  UND 6;
+  UND 2;
+  REWRITE_TAC [SUBSET;IN];
+  MESON_TAC[];
+  ALL_TAC; (* oi1 *)
+  USE 0 (REWRITE_RULE[delete_empty]);
+  REWR 0;
+  USE 0 (REWRITE_RULE[FINITE_DELETE]);
+  REWR 0;
+  TYPE_THEN `V DELETE u SUBSET U ` SUBGOAL_TAC;
+  ASM_MESON_TAC[DELETE_SUBSET;SUBSET_TRANS];
+  DISCH_ALL_TAC;
+  REWR 0;
+  ALL_TAC; (* oi2 *)
+  COPY 6;
+  USE 9 (REWRITE_RULE[IN]);
+  USE 9 (MATCH_MP delete_inters);
+  ASM_REWRITE_TAC[];
+  USE 1 (REWRITE_RULE[topology]);
+  TYPEL_THEN [`(INTERS (V DELETE u))`;`u`;`U`] (USE 1 o ISPECL);
+  AND 1;
+  AND 1;
+  UND 11;
+  DISCH_THEN MATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 6;
+  UND 2;
+  REWRITE_TAC [SUBSET;IN];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let top_unions = prove_by_refinement(
+  `!(U:(A->bool)->bool) V. topology_ U /\ (V SUBSET U) ==> U (UNIONS V)`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[topology];
+  ]);;
+  (* }}} *)
+
+let top_inter = prove_by_refinement(
+  `!(U:(A->bool)-> bool) A B. topology_ U /\ (U A) /\ (U B) ==> (U (A INTER B))`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[topology];
+  ]);;
+  (* }}} *)
+
+
+(* open and closed balls in  metric spaces *)
+
+let open_ball_nonempty = prove_by_refinement(
+ `!(X:A->bool) d a r. (metric_space (X,d)) /\ (&.0 <. r) /\ (X a) ==>
+    (a IN (open_ball(X,d) a r))`,
+ (* {{{ proof *)
+ [
+ REWRITE_TAC[metric_space;IN_ELIM_THM;open_ball];
+ DISCH_ALL_TAC;
+ UNDISCH_FIND_THEN `( /\ )` (ASSUME_TAC o (SPECL [`a:A`;`a:A`;`a:A`]));
+ ASM_MESON_TAC[];
+ ]);;
+ (* }}} *)
+
+let open_ball_subset = prove_by_refinement(
+ `!(X:A->bool) d a r. (open_ball (X,d) a r SUBSET X)`,
+(* {{{ proof *)
+ [
+ REWRITE_TAC[SUBSET;open_ball;IN_ELIM_THM];
+ MESON_TAC[IN];
+ ]);;
+(* }}} *)
+
+let open_ball_subspace = prove_by_refinement(
+  `!(X:A->bool) Y d a r. (Y SUBSET X) ==>
+    (open_ball(Y,d) a r SUBSET open_ball(X,d) a r)`,
+(* {{{ proof *)
+ [
+ REWRITE_TAC[SUBSET;open_ball;IN_ELIM_THM];
+ MESON_TAC[IN];
+ ]);;
+(* }}} *)
+
+let open_ball_empty = prove_by_refinement(
+  `!(X:A->bool) d a r. ~(a IN X) ==> (EMPTY = open_ball (X,d) a r)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[open_ball];
+  MATCH_MP_TAC EQ_EXT;
+  REWRITE_TAC[IN_ELIM_THM;EMPTY];
+  ASM_MESON_TAC[IN];
+  ]);;
+  (* }}} *)
+
+(*** Old proof modified by JRH to avoid GSPEC
+
+let open_ball_intersect = prove_by_refinement(
+  `!(X:A->bool) Y d a r. (Y SUBSET X) /\ (a IN Y) ==>
+   (open_ball(Y,d) a r = (open_ball(X,d) a r INTER Y))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;IN;INTER;open_ball];
+  REWRITE_TAC[GSPEC_THM];
+  REWRITE_TAC[IN_ELIM_THM];
+  REWRITE_TAC[GSPEC];
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  BETA_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+***)
+
+let open_ball_intersect = prove_by_refinement(
+  `!(X:A->bool) Y d a r. (Y SUBSET X) /\ (a IN Y) ==>
+   (open_ball(Y,d) a r = (open_ball(X,d) a r INTER Y))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;IN;INTER;open_ball];
+  REWRITE_TAC[EXTENSION; IN_ELIM_THM];
+  MESON_TAC[]
+  ]);;
+  (* }}} *)
+
+let open_ball_center = prove_by_refinement(
+ `!(X:A->bool) d a b r. (metric_space (X,d)) /\
+      (a IN (open_ball (X,d) b r)) ==>
+     (?r'. (&.0 <. r') /\
+         ((open_ball(X,d) a r') SUBSET (open_ball(X,d) b r)))`,
+(* {{{ proof *)
+ [
+ REWRITE_TAC[metric_space;open_ball];
+ DISCH_ALL_TAC;
+ EXISTS_TAC `r -. (d (a:A) (b:A))`;
+ REWRITE_TAC[SUBSET;IN_ELIM_THM];
+ UNDISCH_FIND_TAC `(IN)`;
+ REWRITE_TAC[IN_ELIM_THM];
+ DISCH_ALL_TAC;
+ CONJ_TAC;
+ REWRITE_TAC[REAL_ARITH `(&.0 < r -. s)= (s <. r)`];
+ ASM_MESON_TAC[];
+ GEN_TAC;
+ ASM_REWRITE_TAC[];
+ REWRITE_TAC[REAL_ARITH `(u <. v-.w) <=> (w +. u <. v)`];
+ DISCH_ALL_TAC;
+ ASM_REWRITE_TAC[];
+ UNDISCH_FIND_TAC `(!)`;
+ DISCH_THEN (fun t-> (MP_TAC (SPECL [`b:A`;`a:A`;`x:A`] t)));
+ ASM_REWRITE_TAC[];
+ ASM_MESON_TAC[REAL_LET_TRANS;REAL_LTE_TRANS];
+ ]);;
+(* }}} *)
+
+let open_ball_nonempty_center = prove_by_refinement(
+ `!(X:A->bool) d a r. (metric_space(X,d)) ==>
+    ((a IN (open_ball(X,d) a r)) =
+    ~(open_ball(X,d) a r = EMPTY))`,
+(* {{{ proof *)
+ [
+ REWRITE_TAC[metric_space];
+ DISCH_ALL_TAC;
+ REWRITE_TAC[open_ball];
+ REWRITE_TAC[REWRITE_CONV[IN_ELIM_THM] `(a:A) IN { y | X a /\ X y /\ (d a y <. r)}`];
+ REWRITE_TAC[EXTENSION];
+ REWRITE_TAC[IN_ELIM_THM;NOT_IN_EMPTY;NOT_FORALL_THM];
+ EQ_TAC;
+ MESON_TAC[];
+ DISCH_THEN CHOOSE_TAC;
+ ASM_REWRITE_TAC[];
+ FIRST_ASSUM  (fun t -> MP_TAC (SPECL [`a:A`;`x:A`;`a:A`] t));
+ UNDISCH_FIND_THEN `(+.)`  (fun t -> MP_TAC (SPECL [`a:A`;`a:A`;`a:A`] t));
+ ASM_MESON_TAC[REAL_LET_TRANS;REAL_LTE_TRANS];
+ ]);;
+(* }}} *)
+
+(*** Old proof modified by JRH to remove apparent misnamed quantifier
+
+let open_ball_neg_radius = prove_by_refinement(
+  `!(X:A->bool) d a r. metric_space(X,d) /\ (r <. (&.0)) ==>
+    (EMPTY = open_ball(X,d) a r)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[open_ball;metric_space];
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[EMPTY;IN_ELIM_THM];
+  FIRST_ASSUM  (fun t -> MP_TAC (SPECL [`a:A`;`x:A`;`a:A`] t));
+  ASSUME_TAC (REAL_ARITH `!u r. ~((dd <. r) /\ (r <. (&.0)) /\ (&.0 <=. dd))`);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+***)
+
+let open_ball_neg_radius = prove_by_refinement(
+  `!(X:A->bool) d a r. metric_space(X,d) /\ (r <. (&.0)) ==>
+    (EMPTY = open_ball(X,d) a r)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[open_ball;metric_space];
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[EMPTY;IN_ELIM_THM];
+  FIRST_ASSUM  (fun t -> MP_TAC (SPECL [`a:A`;`x:A`;`a:A`] t));
+  ASSUME_TAC (REAL_ARITH `!d r. ~((d <. r) /\ (r <. (&.0)) /\ (&.0 <=. d))`);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+let open_ball_nest = prove_by_refinement(
+ `!(X:A->bool) d a r r'. (r <. r') ==>
+   ((open_ball (X,d) a r) SUBSET (open_ball(X,d) a r'))`,
+(* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;open_ball;IN_ELIM_THM];
+  MESON_TAC[REAL_ARITH `(r<. r') /\ (a <. r) ==> (a <. r')`];
+  ]);;
+(* }}} *)
+
+(* intersection of open balls contains an open ball *)
+let open_ball_inter = prove_by_refinement(
+ `!(X:A->bool) d a b c r r'. (metric_space (X,d)) /\ (X a) /\ (X b) /\
+  (c IN (open_ball(X,d) a r INTER (open_ball(X,d) b r'))) ==>
+  (?r''. (&.0 <. r'') /\ (open_ball(X,d) c r'') SUBSET
+    (open_ball(X,d) a r INTER (open_ball(X,d) b r')))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+    UNDISCH_FIND_THEN `(INTER)` (fun t-> MP_TAC (REWRITE_RULE[IN_INTER] t) THEN DISCH_ALL_TAC);
+  SUBGOAL_TAC `(X:A->bool) (c:A)`;
+  ASM_MESON_TAC[SUBSET;open_ball_subset;IN];
+  DISCH_TAC;
+  MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`;`c:A`;`b:A`;`r':real`] open_ball_center) THEN (ASM_REWRITE_TAC[]) THEN (DISCH_THEN CHOOSE_TAC);
+  MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`;`c:A`;`a:A`;`r:real`] open_ball_center) THEN (ASM_REWRITE_TAC[]) THEN (DISCH_THEN CHOOSE_TAC);
+  REWRITE_TAC[SUBSET_INTER];
+  EXISTS_TAC `(if (r'' <. r''') then (r'') else (r'''))`;
+  COND_CASES_TAC;
+  ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS];
+  IMP_RES_THEN DISJ_CASES_TAC (REAL_ARITH `(~(r'' <. r''')) ==> ((r''' <. r'') \/ (r'''=r''))`);
+  ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS];
+  ASM_MESON_TAC[];
+  ]);;
+(* }}} *)
+
+let BALL_DIST = prove_by_refinement(
+  `!X d x y (z:A) r. metric_space(X,d) /\ open_ball(X,d) z r x /\
+  open_ball(X,d) z r y ==> d x y <. (&.2 * r)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[metric_space;open_ball;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  USE 0 (SPECL [`x:A`;`z:A`;`y:A`]);
+  REWR 0;
+  UND 0 THEN DISCH_ALL_TAC;
+  UND 9;
+  UND 6;
+  ASM_REWRITE_TAC[];
+  UND 3;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let BALL_DIST_CLOSED = prove_by_refinement(
+  `!X d x y (z:A) r. metric_space(X,d) /\ closed_ball(X,d) z r x /\
+  closed_ball(X,d) z r y ==> d x y <=. (&.2 * r)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[metric_space;closed_ball;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  USE 0 (SPECL [`x:A`;`z:A`;`y:A`]);
+  REWR 0;
+  UND 0 THEN DISCH_ALL_TAC;
+  UND 9;
+  UND 6;
+  ASM_REWRITE_TAC[];
+  UND 3;
+  REAL_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+
+let open_ball_sub_closed = prove_by_refinement(
+  `!X d (x:A) r.
+     (open_ball(X,d) x r SUBSET (closed_ball(X,d) x r))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[SUBSET;IN;open_ball;closed_ball;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  UND 2;
+  REAL_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let ball_symm = prove_by_refinement(
+  `!X d (x:A) y r. metric_space(X,d) /\ (X x) /\ (X y) ==>
+       (open_ball(X,d) x r y = open_ball(X,d) y r x)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC [open_ball;IN_ELIM_THM'];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC [metric_space_symm];
+  ]);;
+  (* }}} *)
+
+let ball_subset_ball = prove_by_refinement(
+  `!X d (x:A) z r. metric_space(X,d) /\
+       (open_ball(X,d) x r z ) ==>
+    (open_ball(X,d) z r SUBSET (open_ball(X,d) x (&.2 * r)))`,
+  (* {{{ proof *)
+  [
+    DISCH_ALL_TAC;
+    REWRITE_TAC[SUBSET;IN];
+    DISCH_ALL_TAC;
+    REWRITE_TAC[open_ball;IN_ELIM_THM'];
+    TYPE_THEN `X z /\ X x' /\ X x` SUBGOAL_TAC ;
+    UND 2;
+    UND 1;
+    REWRITE_TAC[open_ball;IN_ELIM_THM'];
+    MESON_TAC[];
+    DISCH_ALL_TAC;
+    TYPE_THEN `open_ball(X,d) z r x` SUBGOAL_TAC;
+    ASM_MESON_TAC[ball_symm];
+    ASM_MESON_TAC[BALL_DIST];
+  ]);;
+  (* }}} *)
+
+
+(* top_of_metric *)
+
+let top_of_metric_unions = prove_by_refinement(
+ `!(X:A->bool) d. (metric_space (X,d)) ==>
+    (X = UNIONS (top_of_metric (X,d)))`,
+  (* {{{ proof *)
+ [
+ REPEAT GEN_TAC;
+ DISCH_TAC;
+ MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC;
+ REWRITE_TAC[SUBSET];
+ REWRITE_TAC[IN_UNIONS;top_of_metric];
+ DISCH_ALL_TAC;
+ EXISTS_TAC `open_ball(X,d) (x:A) (&.1)`;
+ UNDISCH_TAC `(x:A) IN X` THEN (REWRITE_TAC[IN_ELIM_THM]);
+ DISCH_ALL_TAC;
+ CONJ_TAC;
+ EXISTS_TAC `{(open_ball(X,d) (x:A) (&.1))}`;
+ REWRITE_TAC[GSYM UNIONS_1;INSERT_SUBSET;EMPTY_SUBSET];
+ REWRITE_TAC[open_balls;IN_ELIM_THM];
+ MESON_TAC[];
+ REWRITE_TAC[IN_ELIM_THM;open_ball];
+ UNDISCH_FIND_TAC `(IN)`;
+ ASM_REWRITE_TAC[IN];
+ DISCH_TAC;
+ ASM_REWRITE_TAC[];
+ UNDISCH_FIND_TAC `metric_space`;
+ REWRITE_TAC[metric_space];
+ DISCH_THEN (fun t -> MP_TAC (ISPECL [`x:A`;`x:A`;`x:A`] t));
+ ASM_MESON_TAC[REAL_ARITH `(&.0) <. (&.1)`];
+ MATCH_MP_TAC UNIONS_SUBSET;
+ GEN_TAC;
+ REWRITE_TAC[top_of_metric;IN_ELIM_THM];
+ DISCH_THEN CHOOSE_TAC;
+ ASM_REWRITE_TAC[];
+ MATCH_MP_TAC UNIONS_SUBSET;
+ X_GEN_TAC `B:A->bool`;
+ DISCH_TAC;
+ SUBGOAL_TAC `(B:A->bool) IN open_balls (X,d)`;
+ ASM SET_TAC[];
+ REWRITE_TAC[open_balls;IN_ELIM_THM];
+ DISCH_THEN (CHOOSE_THEN MP_TAC);
+ DISCH_THEN (CHOOSE_THEN ASSUME_TAC);
+ ASM_REWRITE_TAC[];
+ REWRITE_TAC[open_ball;SUBSET;IN_ELIM_THM];
+ MESON_TAC[IN];
+ ]);;
+(* }}} *)
+
+let top_of_metric_empty = prove_by_refinement(
+ `!(X:A->bool) d.
+   ( (top_of_metric (X,d)) EMPTY)`,
+  (* {{{ proof  *)
+ [
+ REWRITE_TAC[top_of_metric];
+ REPEAT GEN_TAC;
+ REWRITE_TAC[IN_ELIM_THM];
+ EXISTS_TAC `EMPTY:(A->bool)->bool`;
+ REWRITE_TAC[UNIONS_0;EMPTY_SUBSET];
+ ]);;
+(* }}} *)
+
+let top_of_metric_open = prove_by_refinement(
+ `!(X:A->bool) d F.
+    (F SUBSET (open_balls (X,d))) ==>
+    ((UNIONS F) IN (top_of_metric(X,d)))`,
+ (* {{{ proof *)
+ [
+ REWRITE_TAC[top_of_metric;IN_ELIM_THM];
+ MESON_TAC[];
+ ]);;
+ (* }}} *)
+
+let top_of_metric_open_balls = prove_by_refinement(
+ `!(X:A->bool) d.
+    (open_balls (X,d)) SUBSET (top_of_metric(X,d))`,
+ (* {{{ proof *)
+ [
+ REWRITE_TAC[SUBSET];
+ REWRITE_TAC[top_of_metric;IN_ELIM_THM];
+ DISCH_ALL_TAC;
+ EXISTS_TAC `{(x:A->bool)}`;
+ ASM SET_TAC[];
+ ]);;
+  (* }}} *)
+
+let open_ball_open = prove_by_refinement(
+  `! (X:A->bool) d x r. (metric_space(X,d)) ==>
+   (top_of_metric (X,d) (open_ball (X,d) x r)) `,
+  (* {{{ proof *)
+  [
+    DISCH_ALL_TAC;
+  TYPEL_THEN [`X`;`d`] (fun t-> ASSUME_TAC ( ISPECL t top_of_metric_open_balls));
+  USE 1 (REWRITE_RULE[open_balls;SUBSET;IN_ELIM_THM']);
+  ASM_MESON_TAC[IN];
+  ]);;
+  (* }}} *)
+
+(* a set is open then every point contains a ball *)
+let top_of_metric_nbd = prove_by_refinement(
+ `!(X:A->bool) d A. (metric_space (X,d)) ==>
+     ((top_of_metric (X,d) A) <=> ((A SUBSET X) /\
+    (!a. (a IN A) ==>
+    (?r. (&.0 <. r) /\ (open_ball(X,d) a r SUBSET A)))))`,
+(* {{{ proof *)
+
+ [
+ (DISCH_ALL_TAC);
+ EQ_TAC;
+ REWRITE_TAC[top_of_metric;IN_ELIM_THM];
+ DISCH_THEN (CHOOSE_THEN MP_TAC);
+ DISCH_ALL_TAC;
+ CONJ_TAC;
+ IMP_RES_THEN ASSUME_TAC top_of_metric_unions;
+ ASM_REWRITE_TAC[];
+ IMP_RES_THEN ASSUME_TAC top_of_metric_open;
+ ASM ONCE_REWRITE_TAC[];
+ MATCH_MP_TAC UNIONS_UNIONS;
+ ASM_MESON_TAC[SUBSET_TRANS;top_of_metric_open_balls];
+ DISCH_ALL_TAC THEN (ASM_REWRITE_TAC[]);
+ REWRITE_TAC[IN_UNIONS;UNIONS_SUBSET];
+ UNDISCH_FIND_TAC `(IN)`;
+ ASM_REWRITE_TAC[];
+ REWRITE_TAC[IN_UNIONS];
+ DISCH_THEN (CHOOSE_THEN ASSUME_TAC);
+ SUBGOAL_TAC `(t IN open_balls (X:A->bool,d))`;
+ ASM_MESON_TAC[SUBSET];
+ REWRITE_TAC[open_balls;IN_ELIM_THM];
+ REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC));
+ DISCH_TAC;
+ MP_TAC (SPECL[`(X:A->bool)`; `d:A->A->real`;`a:A`;`x:A`;`r:real`] open_ball_center);
+ ASM_REWRITE_TAC[];
+ SUBGOAL_TAC `(a:A) IN open_ball(X,d) x r`;
+ ASM_MESON_TAC[];
+ DISCH_TAC THEN (ASM_REWRITE_TAC[]);
+ DISCH_THEN CHOOSE_TAC;
+ EXISTS_TAC `r':real`;
+ ASM_REWRITE_TAC[];
+ (* to here *)
+ SUBGOAL_TAC `!s. ((s:A->bool) IN F') ==> (s SUBSET (UNIONS F'))`;
+ SET_TAC[];
+ ASM_MESON_TAC[SUBSET_TRANS] ; (*second direction: *)
+ DISCH_THEN (fun t -> ASSUME_TAC (CONJUNCT1 t) THEN MP_TAC (CONJUNCT2 t));
+ DISCH_THEN (fun t -> MP_TAC (REWRITE_RULE[RIGHT_IMP_EXISTS_THM] t));
+ REWRITE_TAC[SKOLEM_THM];
+ DISCH_THEN CHOOSE_TAC;
+ REWRITE_TAC[top_of_metric;IN_ELIM_THM];
+ EXISTS_TAC `IMAGE (\b. (open_ball(X,d) b (r b))) (A:A->bool)`;
+ CONJ_TAC;
+ REWRITE_TAC[IMAGE;SUBSET];
+ REWRITE_TAC[IN_ELIM_THM;open_balls];
+ MESON_TAC[IN];
+ REWRITE_TAC[IMAGE];
+ GEN_REWRITE_TAC I [EXTENSION];
+ X_GEN_TAC `a:A`;
+ REWRITE_TAC[IN_UNIONS];
+ REWRITE_TAC[IN_ELIM_THM];
+ EQ_TAC;
+ DISCH_TAC;
+ EXISTS_TAC `open_ball (X,d) (a:A) (r a)`;
+ CONJ_TAC;
+ EXISTS_TAC `a:A`;
+ ASM_REWRITE_TAC[];
+ REWRITE_TAC[IN;open_ball];
+ REWRITE_TAC[IN_ELIM_THM];
+ ASM_MESON_TAC[metric_space_zero;IN;SUBSET];  (* last: *)
+ DISCH_THEN (CHOOSE_THEN MP_TAC);
+ DISCH_ALL_TAC;
+ UNDISCH_FIND_TAC `(?)` ;
+ DISCH_THEN (CHOOSE_THEN MP_TAC);
+ DISCH_ALL_TAC;
+ UNDISCH_FIND_TAC `(!)`;
+ DISCH_THEN (fun t -> MP_TAC(SPEC `x:A` t));
+ ASM_REWRITE_TAC[];
+ DISCH_ALL_TAC;
+ ASM_MESON_TAC[SUBSET;IN];
+ ]);;
+
+(* }}} *)
+
+let top_of_metric_inter = prove_by_refinement(
+ `!(X:A->bool) d. (metric_space (X,d)) ==>
+   (!A B. (top_of_metric (X,d) A) /\ (top_of_metric (X,d) B) ==>
+      (top_of_metric (X,d) (A INTER B)))`,
+(* {{{ proof *)
+ [
+ DISCH_ALL_TAC;
+ DISCH_ALL_TAC;
+ IMP_RES_THEN ASSUME_TAC (SPECL [`X:A->bool`;`d:A->A->real`] top_of_metric_nbd);
+ UNDISCH_TAC `(top_of_metric (X,d) (B:A->bool))`;
+ UNDISCH_TAC `(top_of_metric (X,d) (A:A->bool))`;
+ ASM_REWRITE_TAC[];
+ DISCH_ALL_TAC;
+ DISCH_ALL_TAC;
+ CONJ_TAC;
+ ASM SET_TAC[];
+ DISCH_ALL_TAC;
+ UNDISCH_FIND_THEN `(INTER)` (fun t-> (MP_TAC (REWRITE_RULE[IN_INTER]t)) THEN DISCH_ALL_TAC );
+ UNDISCH_FIND_THEN `(IN)` (fun t-> ANTE_RES_THEN MP_TAC t);
+ UNDISCH_FIND_THEN `(IN)` (fun t-> ANTE_RES_THEN MP_TAC t);
+ DISCH_THEN CHOOSE_TAC;
+ DISCH_THEN CHOOSE_TAC;
+ EXISTS_TAC `if (r<. r') then r else r'`;
+ COND_CASES_TAC;
+ ASM_REWRITE_TAC[SUBSET_INTER];
+ ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS];
+ MP_TAC (ARITH_RULE `~(r<.r') ==> ((r'<. r) \/ (r'=r))`) THEN (ASM_REWRITE_TAC[]);
+ DISCH_THEN DISJ_CASES_TAC;
+ ASM_REWRITE_TAC[SUBSET_INTER];
+ ASM_MESON_TAC[open_ball_nest;SUBSET_TRANS];
+ ASM_MESON_TAC[SUBSET_INTER];
+ ]);;
+(* }}} *)
+
+let top_of_metric_union = prove_by_refinement(
+  `!(X:A->bool) d. (metric_space(X,d)) ==>
+   (!V. (V SUBSET top_of_metric(X,d)) ==>
+      (top_of_metric(X,d) (UNIONS V)))`,
+(* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`] top_of_metric_nbd);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[UNIONS_UNIONS;top_of_metric_unions];
+  GEN_TAC;
+  REWRITE_TAC[IN_UNIONS];
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `(top_of_metric (X,d)) (t:A->bool)`;
+  ASM_MESON_TAC[IN;SUBSET];
+  MP_TAC (SPECL[`X:A->bool`;`d:A->A->real`] top_of_metric_nbd);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  UNDISCH_FIND_THEN `(!)` (fun t -> MP_TAC (SPEC `a:A` t));
+  ASM_REWRITE_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `r:real`;
+  ASM_REWRITE_TAC[];
+  ASM SET_TAC[UNIONS];
+  ]);;
+(* }}} *)
+
+let top_of_metric_top = prove_by_refinement(
+ `!(X:A->bool) d. ( (metric_space (X,d))) ==>
+    (topology_ (top_of_metric (X,d)))`,
+(* {{{ proof *)
+ [
+ DISCH_ALL_TAC;
+ REWRITE_TAC[topology];
+ REPEAT GEN_TAC;
+ ASM_SIMP_TAC[top_of_metric_empty;top_of_metric_inter;top_of_metric_union];
+ ]);;
+(* }}} *)
+
+let closed_ball_closed = prove_by_refinement(
+  `!X d (x:A) r. (metric_space (X,d)) ==>
+     (closed_ (top_of_metric(X,d)) (closed_ball(X,d) x r))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `X x`  ASM_CASES_TAC ;
+  REWRITE_TAC[closed];
+  ASM_SIMP_TAC [GSYM top_of_metric_unions];
+  SUBCONJ_TAC;
+  REWRITE_TAC[closed_ball;SUBSET;IN;IN_ELIM_THM'];
+  MESON_TAC[];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[open_DEF];
+  COPY 0;
+  USE 0 (MATCH_MP top_of_metric_top);
+  ONCE_ASM_SIMP_TAC[open_nbd];
+  GEN_TAC;
+  TYPE_THEN `open_ball(X,d) x' (d x x' -. r)` EXISTS_TAC;
+  TYPE_THEN `R = (d x x' -. r)` ABBREV_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `X x'` SUBGOAL_TAC;
+  USE 5 (REWRITE_RULE[INR IN_DIFF]);
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  SUBCONJ_TAC;
+  REWRITE_TAC[DIFF_SUBSET;open_ball_subset;INTER;EQ_EMPTY;IN_ELIM_THM'];
+  X_GEN_TAC `y:A`;
+  REWRITE_TAC[IN];
+  ASM_REWRITE_TAC[open_ball;closed_ball];
+  REWRITE_TAC[IN_ELIM_THM';GSYM CONJ_ASSOC];
+  PROOF_BY_CONTR_TAC;
+  USE 7 (REWRITE_RULE[]);
+  AND 7;
+  REWR 7;
+  COPY 3;
+  USE 3 (REWRITE_RULE[metric_space]);
+  TYPEL_THEN [`x`;`y`;`x'`] (USE 3 o SPECL);
+  REWR 3;
+  ALL_TAC; (* "bb"; *)
+  TYPE_THEN `d x' y = d y x'` SUBGOAL_TAC;
+  TYPEL_THEN [`X`;`d`] (fun t-> MATCH_MP_TAC  (SPECL t metric_space_symm));
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  UND 7;
+  UND 10;
+  AND 3;
+  AND 3;
+  AND 3;
+  UND 3;
+  EXPAND_TAC "R";
+  ALL_TAC; (* "cb" *)
+  REAL_ARITH_TAC;
+  ALL_TAC; (* "cbc" *)
+  DISCH_TAC;
+  ASM_SIMP_TAC [open_ball_open];
+  MATCH_MP_TAC  (INR open_ball_nonempty);
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "R";
+  PROOF_BY_CONTR_TAC;
+  USE 8 (MATCH_MP (REAL_ARITH `~(&.0 < d x x' - r) ==> (d x x' <=. r)`));
+  USE 5 (REWRITE_RULE[INR IN_DIFF;closed_ball;IN_ELIM_THM']);
+  ASM_MESON_TAC[];
+  TYPE_THEN `(closed_ball (X,d) x r) = EMPTY` SUBGOAL_TAC;
+(**** Old step changed by JRH for modified set comprehensions
+  ASM_REWRITE_TAC[closed_ball;EMPTY;GSPEC];
+ ***)
+  ASM_REWRITE_TAC[closed_ball;IN_ELIM_THM; EXTENSION; NOT_IN_EMPTY];
+  DISCH_THEN (REWRT_TAC);
+  ALL_TAC; (* "cbc1" *)
+  ASM_MESON_TAC[empty_closed;top_of_metric_top];
+  ]);;
+  (* }}} *)
+
+let open_ball_nbd = prove_by_refinement(
+  `!X d C x. ?e. (metric_space((X:A->bool),d)) /\ (C x) /\
+    (top_of_metric (X,d) C) ==>
+   ((&.0 < e) /\ (open_ball (X,d) x e SUBSET C))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  RIGHT_TAC "e";
+  DISCH_ALL_TAC;
+  USE 2 (REWRITE_RULE[top_of_metric;open_balls;IN_ELIM_THM';SUBSET;IN  ]);
+  CHO 2;
+  AND 2;
+  ASM_REWRITE_TAC[];
+  REWR 1;
+  USE 1 (REWRITE_RULE[UNIONS;IN;IN_ELIM_THM'  ]);
+  CHO 1;
+  TYPE_THEN `u` (USE 3 o SPEC);
+  REWR 3;
+  CHO 3;
+  CHO 3;
+  REWR 1;
+  TYPEL_THEN [`X`;`d`;`x`;`x'`;`r`] (fun t-> (ASSUME_TAC (ISPECL t open_ball_center)));
+  USE 4 (REWRITE_RULE[IN ]);
+  REWR 4;
+  CHO 4;
+  TYPE_THEN `r'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET;UNIONS;IN;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  AND 4;
+  USE 4 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM']);
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+
+(* closure *)
+
+let closure_closed = prove_by_refinement(
+  `!U (A:A->bool). (topology_ U) /\ (A SUBSET (UNIONS U))  ==>
+    (closed_ U (closure U A))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[closure];
+  MATCH_MP_TAC closed_inter;
+  REWRITE_TAC[IN_ELIM_THM];
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  MESON_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `UNIONS U` EXISTS_TAC;
+  ASM_REWRITE_TAC[IN_ELIM_THM'];
+  ASM_SIMP_TAC[closed_UNIV];
+  ]);;
+(* }}} *)
+
+let subset_closure = prove_by_refinement(
+  `!U (A:A->bool). (topology_ U) ==> (A SUBSET (closure U A))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[closure;SUBSET;IN_INTERS;IN_ELIM_THM];
+  X_GEN_TAC `a:A`;
+  MESON_TAC[IN];
+  ]);;
+  (* }}} *)
+
+let closure_subset = prove_by_refinement(
+  `!U (A:A->bool) B. (topology_ U) /\ (closed_ U B) /\ (A SUBSET B)
+    ==> (closure U A SUBSET B)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[closure];
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC INTERS_SUBSET;
+  ASM_REWRITE_TAC[IN_ELIM_THM];
+  ]);;
+  (* }}} *)
+
+let closure_self = prove_by_refinement(
+  `!U (A:A->bool). (topology_ U) /\ (closed_ U A) ==>
+     (closure U A = A)`,
+  (* {{{ proof *)
+ [
+ DISCH_ALL_TAC;
+ MATCH_MP_TAC SUBSET_ANTISYM;
+ ASM_SIMP_TAC[subset_closure];
+ ASM_SIMP_TAC[closure_subset;SUBSET_REFL];
+ ]);;
+ (* }}} *)
+
+let closure_close = prove_by_refinement(
+  `!U Z (A:A->bool). (topology_ U) /\ (Z SUBSET (UNIONS U)) ==>
+     ((A = closure U Z) = ((Z SUBSET A) /\ (closed_ U A) /\
+         (!B. (closed_ U B) /\ ((Z SUBSET B)) ==>
+             (A SUBSET B))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_THEN (REWRT_TAC);
+  ASM_SIMP_TAC[subset_closure;closure_closed;closure_subset];
+  DISCH_ALL_TAC;
+  REWRITE_TAC [closure];
+  MATCH_MP_TAC (SUBSET_ANTISYM);
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET_INTERS];
+  REWRITE_TAC[IN_ELIM_THM'];
+  ASM_MESON_TAC[];
+  MATCH_MP_TAC  INTERS_SUBSET;
+  REWRITE_TAC[IN_ELIM_THM'];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let closure_open = prove_by_refinement(
+  `!U Z (A:A->bool). (topology_ U) /\ (Z SUBSET (UNIONS U)) ==>
+     ((A = closure U Z) = ((Z SUBSET A) /\ (closed_ U A) /\
+            (!B. (open_ U B) /\ ((B INTER Z) = EMPTY) ==>
+             ((B INTER A) = EMPTY))))`,
+  (* {{{ proof *)
+
+  [
+  REP_GEN_TAC;
+  DISCH_TAC;
+  ASM_SIMP_TAC[closure_close];
+  MATCH_MP_TAC (TAUT `( A ==> (B <=> C)) ==>   (A /\ B <=> A /\ C)`);
+  DISCH_TAC;
+  MATCH_MP_TAC (TAUT `( A ==> (B <=> C)) ==>   (A /\ B <=> A /\ C)`);
+  DISCH_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  USE 2 (REWRITE_RULE[closed]);
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  USE 3 (SPEC `(UNIONS U) DIFF (B:A->bool)`);
+  DISCH_ALL_TAC;
+  UND 3;
+  ASM_SIMP_TAC[open_closed];
+  ASM_REWRITE_TAC[DIFF_SUBSET];
+  DISCH_TAC;
+  UND 5;
+  UND 3;
+  REWRITE_TAC[INTER_COMM];
+  ALL_TAC; (* co1 *)
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  USE 3 (SPEC `(UNIONS U) DIFF (B:A->bool)`);
+  UND 3;
+  ASM_SIMP_TAC[closed_open];
+  REWRITE_TAC[DIFF_INTER];
+  ASM_SIMP_TAC[SUB_IMP_INTER];
+  TYPE_THEN `A SUBSET (UNIONS U INTER A)` SUBGOAL_TAC;
+  USE 2 (REWRITE_RULE[closed]);
+  AND 2;
+  UND 3;
+  ALL_TAC; (* co2 *)
+  SET_TAC[SUBSET;INTER];
+  MESON_TAC [SUBSET_TRANS];
+  ]);;
+
+  (* }}} *)
+
+
+(* induced topology *)
+
+let image_top = prove_by_refinement(
+ `!(U:(A->bool)->bool) (f:(A->bool)->(B->bool)).
+    ((topology_ U) /\ (EMPTY = f EMPTY) /\
+    (!a b. (a IN U) /\ (b IN U) ==>
+      (((f a) INTER (f b)) = f (a INTER b))) /\
+    (!V. (V SUBSET U) ==> (UNIONS (IMAGE f V) =f (UNIONS V) )))
+    ==> (topology_ (IMAGE f U))`,
+  (* {{{ proof *)
+
+ [
+ REWRITE_TAC[topology];
+ DISCH_ALL_TAC;
+ DISCH_ALL_TAC;
+ CONJ_TAC;
+ REWRITE_TAC[IMAGE;IN];
+ REWRITE_TAC[IN_ELIM_THM];
+ ASM_MESON_TAC[];
+ CONJ_TAC;
+ REWRITE_TAC[IMAGE;IN];
+ REWRITE_TAC[IN_ELIM_THM];
+ DISCH_ALL_TAC;
+ REPEAT (UNDISCH_FIND_THEN `(?)` CHOOSE_TAC);
+ ASM_REWRITE_TAC[];
+ EXISTS_TAC `(x:A->bool) INTER x'`;
+ ASM_SIMP_TAC[IN];
+ DISCH_THEN (fun t-> MP_TAC (MATCH_MP SUBSET_PREIMAGE t));
+ DISCH_THEN CHOOSE_TAC;
+ ASM_REWRITE_TAC[];
+ ASM_SIMP_TAC[];
+ REWRITE_TAC[IMAGE;IN_ELIM_THM];
+ EXISTS_TAC `UNIONS (Z:(A->bool)->bool)`;
+ ASM_SIMP_TAC[IN];
+ ]);;
+
+(* }}} *)
+
+let induced_top_support = prove_by_refinement(
+ `!U (C:A->bool). (UNIONS (induced_top U C) = ((UNIONS U) INTER C))`,
+  (* {{{ proof *)
+ [
+ REWRITE_TAC[UNIONS_INTER];
+ DISCH_ALL_TAC;
+ AP_TERM_TAC;
+ REWRITE_TAC[induced_top];
+ AP_THM_TAC;
+ AP_TERM_TAC;
+ MATCH_MP_TAC EQ_EXT THEN BETA_TAC;
+ SET_TAC[];
+ ]);;
+(* }}} *)
+
+let induced_top_top = prove_by_refinement(
+  `!U (C:A->bool). (topology_ U) ==> (topology_ (induced_top U C))`,
+  (* {{{ proof *)
+  [
+  REPEAT GEN_TAC;
+  DISCH_TAC;
+  REWRITE_TAC[induced_top];
+  MATCH_MP_TAC image_top;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  SET_TAC[];
+  CONJ_TAC;
+  SET_TAC[];
+  REWRITE_TAC[UNIONS_INTER];
+  DISCH_ALL_TAC;
+  AP_TERM_TAC;
+  AP_THM_TAC;
+  AP_TERM_TAC;
+  MATCH_MP_TAC EQ_EXT THEN BETA_TAC;
+  SET_TAC[];
+  ]);;
+(* }}} *)
+
+let induced_top_open = prove_by_refinement(
+ `!U (C:A->bool) A. (topology_ U) ==> (induced_top U C A =
+     (?B. (U B) /\ ((B INTER C) = A)))`,
+  (* {{{ proof *)
+ [
+ DISCH_ALL_TAC;
+ REWRITE_TAC[induced_top;IMAGE];
+ REWRITE_TAC[IN_ELIM_THM];
+ MESON_TAC[IN];
+ ]);;
+(* }}} *)
+
+let induced_trans = prove_by_refinement(
+  `! U (A:A->bool) B. (topology_ U) /\ U A /\ (induced_top U A B) ==>
+    (U B)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[induced_top;IMAGE;IN ;IN_ELIM_THM'  ];
+  DISCH_ALL_TAC;
+  CHO 2;
+  ASM_MESON_TAC[top_inter];
+  ]);;
+  (* }}} *)
+
+let induced_top_unions = prove_by_refinement(
+  `!(U:(A->bool)->bool). (topology_ U) ==>
+        ((induced_top U (UNIONS U)) = U)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  ASM_SIMP_TAC[induced_top_open];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 1;
+  USE 0 (REWRITE_RULE[topology]);
+  TYPE_THEN `B SUBSET (UNIONS U)` SUBGOAL_TAC;
+  ASM_MESON_TAC[sub_union ];
+  REWRITE_TAC[SUBSET_INTER_ABSORPTION];
+  DISCH_TAC ;
+  ASM_MESON_TAC[];
+  DISCH_TAC ;
+  TYPE_THEN `x` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `x SUBSET (UNIONS U)` SUBGOAL_TAC;
+  ASM_MESON_TAC[sub_union ];
+  REWRITE_TAC[SUBSET_INTER_ABSORPTION];
+  ]);;
+
+  (* }}} *)
+
+(* induced metric *)
+
+let gen = euclid_def `gen (X:(A->bool)->bool)
+  = {A | ?Y. (Y SUBSET X) /\ (A = UNIONS Y)}`;;
+
+let top_of_metric_gen = prove_by_refinement(
+  `!(X:(A)->bool) d. gen (open_balls(X,d))= (top_of_metric(X,d))`,
+(* {{{ proof *)
+  [
+  REWRITE_TAC[gen;top_of_metric];
+  ]);;
+(* }}} *)
+
+let gen_subset = prove_by_refinement(
+  `!U (V:(A->bool)->bool).  (U SUBSET V) /\
+     (!A. (A IN V) ==> (?Y. (Y SUBSET U) /\ (A = UNIONS Y)))
+    ==> (gen U = (gen V))`,
+(* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[EXTENSION];
+  GEN_TAC THEN EQ_TAC;
+  REWRITE_TAC[IN_ELIM_THM;gen];
+  DISCH_THEN CHOOSE_TAC;
+  ASM_MESON_TAC[SUBSET_TRANS];
+  REWRITE_TAC[IN_ELIM_THM;gen];
+  DISCH_THEN CHOOSE_TAC;
+  UNDISCH_FIND_THEN `(?)` (fun t-> MP_TAC(REWRITE_RULE[RIGHT_IMP_EXISTS_THM;SKOLEM_THM]t));
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `UNIONS (IMAGE (Y':(A->bool)->((A->bool)->bool)) (Y:(A->bool)->bool))`;
+  CONJ_TAC;
+  MATCH_MP_TAC UNIONS_SUBSET;
+  REWRITE_TAC[IN_IMAGE];
+  GEN_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  ASM_MESON_TAC[IN;SUBSET];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[UNIONS_IMAGE_UNIONS];
+  AP_TERM_TAC;
+  REWRITE_TAC[GSYM IMAGE_o];
+  REWRITE_TAC[EXTENSION];
+  X_GEN_TAC `A:(A->bool)`;
+  REWRITE_TAC[IN_IMAGE;o_THM];
+  ASM_MESON_TAC[SUBSET;IN];
+  ]);;
+(* }}} *)
+
+let gen_subspace = prove_by_refinement(
+  `!(X:A->bool) Y d. (Y SUBSET X) /\ (metric_space(X,d)) ==>
+     (induced_top (top_of_metric(X,d)) Y =
+         gen (induced_top (open_balls(X,d)) Y))`,
+(* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[induced_top];
+  REWRITE_TAC[EXTENSION];
+  X_GEN_TAC `B:A->bool`;
+  REWRITE_TAC[IN_IMAGE];
+  EQ_TAC;
+  DISCH_THEN (X_CHOOSE_TAC `C:A->bool`);
+  FIRST_ASSUM MP_TAC;
+  REWRITE_TAC[top_of_metric];
+  REWRITE_TAC[IN_ELIM_THM];
+  DISCH_ALL_TAC;
+  UNDISCH_FIND_TAC `(?)`;
+  DISCH_THEN (CHOOSE_TAC);
+  UNDISCH_FIND_TAC `(INTER)`;
+  ASM_REWRITE_TAC[UNIONS_INTER];
+  REWRITE_TAC[gen;IN_ELIM_THM];
+  EXISTS_TAC `IMAGE ((INTER) Y) (F':(A->bool)->bool)`;
+  CONJ_TAC;
+  REWRITE_TAC[INTER_THM];
+  MATCH_MP_TAC IMAGE_SUBSET;
+  ASM_REWRITE_TAC[];
+  REFL_TAC;
+  REWRITE_TAC[gen;IN_ELIM_THM];
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_ALL_TAC;
+  IMP_RES_THEN MP_TAC SUBSET_PREIMAGE;
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `UNIONS (Z:(A->bool)->bool)`;
+  CONJ_TAC;
+  REWRITE_TAC[UNIONS_INTER];
+  UNDISCH_FIND_THEN `(UNIONS)` (fun t -> REWRITE_TAC[t]);
+  AP_TERM_TAC;
+  UNDISCH_FIND_TAC `(SUBSET)`;
+  REWRITE_TAC[INTER_THM];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[top_of_metric;IN_ELIM_THM];
+  ASM_MESON_TAC[];
+  ]);;
+(* }}} *)
+
+let gen_induced = prove_by_refinement(
+ `!(X:A->bool) Y d. (Y SUBSET X) /\ (metric_space (X,d)) ==>
+    (gen (open_balls(Y,d)) = gen (induced_top (open_balls(X,d)) Y))`,
+(* {{{ proof *)
+ [
+ DISCH_ALL_TAC;
+ MATCH_MP_TAC gen_subset;
+ CONJ_TAC;
+ REWRITE_TAC[induced_top;SUBSET;open_balls];
+ REWRITE_TAC [IN_IMAGE];
+ X_GEN_TAC `A:(A->bool)`;
+ REWRITE_TAC[IN_ELIM_THM];
+ REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC));
+ DISCH_TAC;
+ ASM_REWRITE_TAC[];
+ ASM_CASES_TAC `(Y:A->bool) (x:A)`;
+ CONV_TAC (relabel_bound_conv);
+ EXISTS_TAC `open_ball (X,d) (x:A) r`;
+ CONJ_TAC;
+ MATCH_MP_TAC open_ball_intersect;
+ ASM_MESON_TAC[IN];
+ MESON_TAC[];
+ EXISTS_TAC `open_ball (X,d) (x:A) (--. (&.1))`;
+ CONJ_TAC;
+ ASM_MESON_TAC[IN;INTER_EMPTY;open_ball_empty;open_ball_neg_radius;REAL_ARITH `(--.(&.1) <. (&.0))`];
+ MESON_TAC[];  (* end of first half *)
+ REWRITE_TAC[induced_top;IN_IMAGE];
+ GEN_TAC;
+ DISCH_THEN (CHOOSE_THEN MP_TAC);
+ NAME_CONFLICT_TAC;
+ REWRITE_TAC[IN;open_balls];
+ REWRITE_TAC[IN_ELIM_THM'];
+ NAME_CONFLICT_TAC;
+ DISCH_ALL_TAC;
+ ASM_REWRITE_TAC[];
+ FIRST_ASSUM (CHOOSE_THEN ASSUME_TAC);
+ FIRST_ASSUM (CHOOSE_THEN ASSUME_TAC);
+ SUBGOAL_TAC `!(a:A). (a IN x INTER Y) ==> (?r. ((&.0) <. r) /\ open_ball(Y,d) a r SUBSET (x INTER Y))`;
+ DISCH_ALL_TAC;
+ TYPEL_THEN [`X`;`d`;`a`;`x'`;`r'`] (fun t -> (CLEAN_ASSUME_TAC (ISPECL t open_ball_center)));
+ SUBGOAL_TAC `(a:A) IN open_ball(X,d) x' r'`;
+ ASM_MESON_TAC[IN_INTER];
+ DISCH_THEN (fun t -> ANTE_RES_THEN (MP_TAC) t);
+ DISCH_THEN (CHOOSE_TAC);
+ EXISTS_TAC `r'':real`;
+ ASM_REWRITE_TAC[SUBSET_INTER;open_ball_subset];
+ ASM_MESON_TAC[open_ball_subspace;SUBSET_TRANS];
+ DISCH_THEN (fun t -> MP_TAC (REWRITE_RULE[RIGHT_IMP_EXISTS_THM;SKOLEM_THM] t));
+ DISCH_THEN CHOOSE_TAC;
+ EXISTS_TAC `IMAGE (\t. open_ball(Y,d) t (r t) ) ((x:A->bool) INTER Y)`;
+ REWRITE_TAC[SUBSET_INTER];
+ CONJ_TAC;
+ REWRITE_TAC[SUBSET;IN_ELIM_THM'];
+ REWRITE_TAC[IN_IMAGE];
+ GEN_TAC;
+ MESON_TAC[];
+ MATCH_MP_TAC SUBSET_ANTISYM;
+ CONJ_TAC;
+ REWRITE_TAC[SUBSET];
+ GEN_TAC;
+ REWRITE_TAC[IN_UNIONS];
+ DISCH_TAC;
+ EXISTS_TAC `open_ball (Y,d) (x'':A) (r x'')`;
+ REWRITE_TAC[IN_IMAGE];
+ CONJ_TAC;
+ NAME_CONFLICT_TAC;
+ EXISTS_TAC `x'':A`;
+ ASM_REWRITE_TAC[];
+ MATCH_MP_TAC open_ball_nonempty;
+ ASM_SIMP_TAC[metric_subspace];
+ ASM_MESON_TAC[IN_INTER;IN;metric_subspace];
+ MATCH_MP_TAC UNIONS_SUBSET;
+ GEN_TAC;
+ REWRITE_TAC[IN_IMAGE];
+ DISCH_THEN CHOOSE_TAC;
+ ASM_MESON_TAC[];
+ ]);;
+(* }}} *)
+
+let top_of_metric_induced = prove_by_refinement(
+  `!(X:A->bool) Y d. (Y SUBSET X) /\ (metric_space(X,d)) ==>
+    (induced_top (top_of_metric(X,d)) Y = (top_of_metric(Y,d)))`,
+(* {{{ proof *)
+  [
+  SIMP_TAC[gen_subspace];
+  REPEAT GEN_TAC;
+  REWRITE_TAC[GSYM top_of_metric_gen];
+  MESON_TAC[gen_induced];
+  ]);;
+(* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* Continuity *)
+(* ------------------------------------------------------------------ *)
+
+
+let continuous = euclid_def `continuous (f:A->B) U V <=> !v.
+  (v IN V) ==> (preimage (UNIONS U) f v) IN U`;;
+
+let metric_continuous_pt = euclid_def
+  `metric_continuous_pt (f:A->B) (X,dX) ((Y:B->bool),dY) x =
+  !epsilon. ?delta. (((&.0) < epsilon) ==> ((&.0) <. delta) /\
+    (!y. ((x IN X) /\ (y IN X) /\ (dX x y) <. delta) ==>
+     (dY (f x) (f y) <. epsilon)))`;;
+
+let metric_continuous = euclid_def
+  `metric_continuous (f:A->B) (X,dX) (Y,dY) <=> !x.
+    metric_continuous_pt f (X,dX) (Y,dY) x`;;
+
+let metric_continuous_pt_domain = prove_by_refinement(`!f X dX Y dY x .
+   ~(x IN X) ==> (metric_continuous_pt (f:A->B) (X,dX) (Y,dY) x)`,
+  (* {{{ proof *)
+
+ [
+ REWRITE_TAC[metric_continuous_pt];
+ MESON_TAC[];
+ ]);;
+
+ (* }}} *)
+
+let metric_continuous_continuous = prove_by_refinement(
+  `!f X Y dX dY. (IMAGE f X SUBSET Y) /\ (metric_space(X,dX)) /\ (metric_space(Y,dY))
+    ==>
+   (continuous (f:A->B) (top_of_metric(X,dX)) (top_of_metric(Y,dY))
+   <=> (metric_continuous f (X,dX) (Y,dY)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  REWRITE_TAC[continuous;metric_continuous];
+  DISCH_TAC;
+  GEN_TAC;
+  ASM_CASES_TAC `(x:A) IN X` THENL[ALL_TAC;ASM_SIMP_TAC[metric_continuous_pt_domain]];
+  REWRITE_TAC[metric_continuous_pt];
+  GEN_TAC;
+  SUBGOAL_TAC `(open_ball (Y,dY) ((f:A->B) x) epsilon) IN (top_of_metric(Y,dY))`;
+  MATCH_MP_TAC (prove_by_refinement(`!(x:A) B. (?A. (x IN A /\ A SUBSET B)) ==> (x IN B)`,[SET_TAC[]]));
+  EXISTS_TAC `open_balls((Y:B->bool),dY)`;
+  REWRITE_TAC[top_of_metric_open_balls];
+  REWRITE_TAC[open_balls;IN_ELIM_THM'];
+  MESON_TAC[];
+  DISCH_THEN (ANTE_RES_THEN ASSUME_TAC);
+  REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM];
+  DISCH_TAC;
+  SUBGOAL_TAC `(x:A) IN preimage (UNIONS (top_of_metric (X,dX))) f (open_ball (Y,dY) ((f:A->B) x) epsilon)`;
+  REWRITE_TAC[in_preimage];
+  SUBGOAL_TAC `(Y:B->bool) ((f:A->B) x )`;
+  UNDISCH_FIND_TAC `IMAGE`;
+  UNDISCH_TAC `(x:A) IN X`;
+  REWRITE_TAC[SUBSET;IMAGE];
+  REWRITE_TAC[IN_ELIM_THM'];
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[IN];
+  MESON_TAC[];
+  ASM_MESON_TAC[top_of_metric_unions;open_ball_nonempty];
+  ABBREV_TAC `B = preimage (UNIONS (top_of_metric (X,dX))) (f:A->B) (open_ball (Y,dY) (f x) epsilon)`;
+  DISCH_TAC;
+  SUBGOAL_TAC `?r. (&.0 <. r) /\ (open_ball(X,dX) (x:A) r SUBSET B)`;
+  ASSUME_TAC top_of_metric_nbd;
+  ASM_MESON_TAC[IN];
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `r:real`;
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `y:A IN B`;
+  MATCH_MP_TAC (prove_by_refinement(`!(x:A) B. (?A. (x IN A /\ A SUBSET B)) ==> (x IN B)`,[SET_TAC[]]));
+  EXISTS_TAC `open_ball(X,dX) (x:A) r`;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[open_ball;IN_ELIM_THM'];
+  ASM_MESON_TAC[IN];
+  UNDISCH_FIND_TAC `preimage`;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[in_preimage];
+  REWRITE_TAC[open_ball;IN_ELIM_THM'];
+  MESON_TAC[]; (* first half done *)
+  REWRITE_TAC[metric_continuous];
+  DISCH_TAC;
+  REWRITE_TAC[continuous];
+  GEN_TAC;
+  DISCH_TAC;
+  REWRITE_TAC[IN];
+  ASM_SIMP_TAC[top_of_metric_nbd];
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;in_preimage];
+  MESON_TAC[];
+  GEN_TAC;
+  DISCH_THEN (fun t -> ASSUME_TAC t THEN (MP_TAC (REWRITE_RULE[in_preimage] t)));
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `?eps. (&.0 <. eps) /\ (open_ball(Y,dY) ((f:A->B) a) eps SUBSET v)`;
+  UNDISCH_FIND_TAC `v IN top_of_metric (Y,dY)`;
+  REWRITE_TAC[IN];
+  ASM_SIMP_TAC[top_of_metric_nbd];
+  DISCH_THEN CHOOSE_TAC;
+  FIRST_ASSUM (fun t -> MP_TAC (SPEC `a:A` t));
+  REWRITE_TAC[metric_continuous_pt];
+  DISCH_THEN (fun t-> MP_TAC (SPEC `eps:real` t));
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  EXISTS_TAC `delta:real`;
+  ASM_REWRITE_TAC[SUBSET];
+  REWRITE_TAC[in_preimage;open_ball];
+  REWRITE_TAC[IN_ELIM_THM'];
+  X_GEN_TAC `y:A`;
+  DISCH_ALL_TAC;
+  CONJ_TAC THENL [(ASM_REWRITE_TAC[IN]);ALL_TAC];
+  FIRST_ASSUM (fun t -> (MP_TAC (SPEC `y:A` t)));
+  ASM_REWRITE_TAC[IN];
+  UNDISCH_FIND_TAC `open_ball`;
+  REWRITE_TAC[open_ball];
+  DISCH_THEN (fun t  -> (MP_TAC (CONJUNCT2 t)));
+  REWRITE_TAC[SUBSET];
+  DISCH_THEN (fun t-> (MP_TAC (SPEC `(f:A->B) y` t)));
+  ASM_REWRITE_TAC[IN_ELIM_THM'];
+  SUBGOAL_TAC `!x. (X x) ==> (Y ((f:A->B) x))`;
+  UNDISCH_FIND_TAC `IMAGE`;
+  REWRITE_TAC[SUBSET;IN_IMAGE];
+  NAME_CONFLICT_TAC;
+  ASM_MESON_TAC[IN];
+  ASM_MESON_TAC[IN];
+  ]);;
+  (* }}} *)
+
+let continuous_induced = prove_by_refinement(
+  `!(f:A->B) U V A. (topology_ V) /\ (continuous f U V) /\ (V A) ==>
+       (continuous f U (induced_top V A)) `,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[continuous;induced_top;IN_IMAGE;Q_ELIM_THM''  ];
+  ASM_MESON_TAC[top_inter;IN ];
+  ]);;
+  (* }}} *)
+
+let metric_cont = prove_by_refinement(
+  `!U X d f. (metric_space(X,d)) /\ (topology_ U) ==>
+    ((continuous (f:A->B) U (top_of_metric(X,d))) =
+      (!(x:B) r. U (preimage (UNIONS U) f (open_ball (X,d) x r))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  USE 2 (REWRITE_RULE[continuous;IN]);
+  UND 2 THEN (DISCH_THEN MATCH_MP_TAC );
+  ASM_MESON_TAC [open_ball_open];
+  REWRITE_TAC[continuous;IN];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[top_of_metric;IN_ELIM_THM' ];
+  DISCH_ALL_TAC;
+  CHO 3;
+  AND 3;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[preimage_unions];
+  IMATCH_MP_TAC  top_unions ;
+  ASM_REWRITE_TAC[IMAGE;SUBSET;IN;IN_ELIM_THM' ];
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[Q_ELIM_THM'];
+  USE 4 (REWRITE_RULE[SUBSET;IN]);
+  DISCH_ALL_TAC;
+  TYPE_THEN `x'` (USE 4 o SPEC);
+  REWR 4;
+  USE 4 (REWRITE_RULE[open_balls;IN_ELIM_THM' ]);
+  CHO 4;
+  CHO 4;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let continuous_sum = prove_by_refinement(
+  `!U (f:A->(num->real)) g n. (topology_ U) /\
+   (continuous f U (top_of_metric(euclid n,d_euclid))) /\
+   (continuous g U (top_of_metric(euclid n,d_euclid))) /\
+   (IMAGE f (UNIONS U) SUBSET (euclid n)) /\
+   (IMAGE g (UNIONS U) SUBSET (euclid n)) ==>
+   (continuous (\t. (f t + g t))  U (top_of_metric(euclid n,d_euclid)))`,
+  (* {{{ proof *)
+  [
+  ASSUME_TAC metric_euclid;
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[metric_cont];
+  DISCH_ALL_TAC;
+  ONCE_ASM_SIMP_TAC[open_nbd];
+  X_GEN_TAC `t:A`;
+  RIGHT_TAC "B";
+  DISCH_ALL_TAC;
+  USE 6 (REWRITE_RULE[REWRITE_RULE[IN] in_preimage]);
+  USE 2 (REWRITE_RULE[continuous]);
+  USE 3 (REWRITE_RULE[continuous]);
+  AND 6;
+  TYPE_THEN `n` (USE 0 o SPEC);
+  COPY 0;
+  JOIN 8 6;
+  USE 6 (MATCH_MP (REWRITE_RULE[IN] open_ball_center));
+  CHO 6;
+  AND 6;
+  TYPE_THEN `open_ball(euclid n,d_euclid) (f t) (r'/(&.2))` (USE 2 o SPEC);
+  TYPE_THEN `open_ball(euclid n,d_euclid) (g t) (r'/(&.2))` (USE 3 o SPEC);
+  UND 3;
+  UND 2;
+  REWRITE_TAC[IN];
+  ASM_SIMP_TAC[open_ball_open];
+  DISCH_ALL_TAC;
+  TYPE_THEN `B = (preimage (UNIONS U) f (open_ball (euclid n,d_euclid) (f t) (r' / &2))) INTER (preimage (UNIONS U) g (open_ball (euclid n,d_euclid) (g t) (r' / &2)))` ABBREV_TAC ;
+  TYPE_THEN `B` EXISTS_TAC;
+  CONJ_TAC;
+  (* cs1 *)
+  USE 6 (MATCH_MP preimage_subset );
+  TYPEL_THEN [`(\t. euclid_plus (f t) (g t))`;`UNIONS U`] (USE 6 o ISPECL);
+  UND 6;
+  IMATCH_MP_TAC  (prove_by_refinement(`!D B C. ((B:A->bool) SUBSET D) ==> ((D SUBSET C) ==> (B SUBSET C))`,[MESON_TAC [SUBSET_TRANS]]));
+  REWRITE_TAC[subset_preimage];
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM'];
+  EXPAND_TAC "B";
+  REWRITE_TAC[INTER;in_preimage;IN ;IN_ELIM_THM'  ];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[IMAGE;SUBSET;IN;IN_ELIM_THM'];
+  REWRITE_TAC[Q_ELIM_THM'];
+  EXPAND_TAC "B";
+  REWRITE_TAC[INTER;in_preimage;IN ;IN_ELIM_THM'  ];
+  REWRITE_TAC[open_ball;IN_ELIM_THM' ];
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[euclid_add_closure];
+  TYPE_THEN `d_euclid (f t + (g t)) (f x' + g x') <=. (d_euclid (f t + (g t)) (f x' + g t)) + (d_euclid (f x' + g t) (f x' + g x'))` SUBGOAL_TAC;
+  TYPEL_THEN [`euclid n`;`d_euclid`] (fun t-> ASSUME_TAC (ISPECL t metric_space_triangle));
+  REWR 17;
+  UND 17 THEN DISCH_THEN IMATCH_MP_TAC  ;
+  ASM_SIMP_TAC[euclid_add_closure];
+  IMATCH_MP_TAC  (REAL_ARITH `b + C < d ==> (a <= b + C ==> (a < d))`);
+  (* cs2 *)
+  IMATCH_MP_TAC real_half_LT;
+  CONJ_TAC;
+  ASM_MESON_TAC  [euclid_add_closure;SPEC `n:num` metric_translate];
+  ASM_MESON_TAC[euclid_add_closure;metric_translate_LEFT];
+  CONJ_TAC;
+  EXPAND_TAC "B";
+  REWRITE_TAC[INTER;in_preimage ;IN_ELIM_THM];
+  ASM_REWRITE_TAC[IN];
+  UND 4;
+  UND 5;
+  REWRITE_TAC[SUBSET;IN;IN_IMAGE ;IN_ELIM_THM'];
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[Q_ELIM_THM''];
+  USE 8 (ONCE_REWRITE_RULE [GSYM REAL_LT_HALF1]);
+  ASM_MESON_TAC[REWRITE_RULE[IN] open_ball_nonempty];
+  EXPAND_TAC "B";
+  IMATCH_MP_TAC  top_inter;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Cauchy sequences and completeness *)
+(* ------------------------------------------------------------------ *)
+
+
+let sequence = euclid_def
+  `sequence X (f:num->A) <=> (IMAGE f UNIV) SUBSET X`;;
+
+let converge = euclid_def
+  `converge (X,d) (f:num -> A) <=> (?x. (x IN (X:A->bool)) /\
+   (!eps. ?n. (&.0 <. eps) ==>
+        (!i. (n <=| i) ==> (d x (f i) <. eps))))`;;
+
+let cauchy_seq = euclid_def
+  `cauchy_seq (X,d) (f:num->A) <=> (sequence X f) /\
+    (!eps. ?n. !i j. (&.0 <. eps) /\
+        (n <= i) /\ (n <= j) ==> (d (f i) (f j) <. eps))`;;
+
+let complete = euclid_def
+  `complete (X,d) <=> !(f:num->A). cauchy_seq (X,d) f ==>
+    converge (X,d) f`;;
+
+let converge_cauchy = prove_by_refinement(
+  `!X d f. metric_space(X,d) /\ (sequence X f) /\ (converge((X:A->bool),d) f)
+    ==> cauchy_seq(X,d) f`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[converge;metric_space];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[cauchy_seq];
+  ASM_REWRITE_TAC[];
+  FIRST_ASSUM CHOOSE_TAC;
+  GEN_TAC;
+  UNDISCH_FIND_TAC `(IN)`;
+  DISCH_ALL_TAC;
+  FIRST_ASSUM (fun t-> MP_TAC (SPEC `eps/(&.2)` t));
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `n:num`;
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC ` (&.0 <. (eps/(&.2)))`;
+  MATCH_MP_TAC REAL_LT_DIV;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_THEN (ANTE_RES_THEN ASSUME_TAC);
+  UNDISCH_TAC `n <=| i`;
+  DISCH_THEN (ANTE_RES_THEN ASSUME_TAC);
+  UNDISCH_TAC `n <=| j`;
+  DISCH_THEN (ANTE_RES_THEN ASSUME_TAC);
+  FIRST_ASSUM (fun t-> MP_TAC (SPECL [`(f:num->A) i`;`x:A`;`(f:num->A) j`] t));
+  UNDISCH_FIND_TAC `sequence`;
+  REWRITE_TAC[sequence;SUBSET;IN_IMAGE;IN_UNIV];
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[IN];
+  DISCH_TAC;
+  SUBGOAL_TAC `X ((f:num->A) i) /\ X x /\ X (f j)`;
+  ASM_MESON_TAC[IN];
+  DISCH_THEN (fun t->REWRITE_TAC[t]);
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[REAL_LET_TRANS;REAL_LT_ADD2;REAL_HALF_DOUBLE];
+  ]);;
+
+  (* }}} *)
+
+
+(* relate the metric space version to the real numbers version *)
+let cauchy_seq_cauchy = prove_by_refinement(
+  `!f. (cauchy_seq(euclid 1,d_euclid) f) ==> (cauchy (\x. (f x 0)))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[cauchy_seq;cauchy;sequence;SUBSET;IN_IMAGE;IN_UNIV];
+  REWRITE_TAC[IN];
+  NAME_CONFLICT_TAC;
+  DISCH_ALL_TAC;
+  GEN_TAC;
+  DISCH_TAC;
+  FIRST_ASSUM (fun t -> MP_TAC (SPEC `e':real` t));
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `n':num`;
+  REPEAT GEN_TAC;
+  REWRITE_TAC[ARITH_RULE `a >=| b <=> b <=| a`];
+  SUBGOAL_TAC `euclid 1 (f (m':num)) /\ euclid 1 (f (n'':num))`;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[euclid1_abs];
+  ]);;
+  (* }}} *)
+
+(* a variant of SEQ_CAUCHY *)
+let complete_real = prove_by_refinement(
+  `complete (euclid 1,d_euclid)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[complete;converge];
+  GEN_TAC;
+  DISCH_THEN (fun t-> ASSUME_TAC t THEN MP_TAC t);
+  DISCH_THEN (fun t -> MP_TAC (MATCH_MP cauchy_seq_cauchy t));
+  REWRITE_TAC[SEQ_CAUCHY;SEQ_LIM;tends_num_real;SEQ_TENDS];
+  ABBREV_TAC `z = lim (\x. f x 0)`;
+  REWRITE_TAC[MR1_DEF];
+  DISCH_TAC;
+  ABBREV_TAC `c = \j. (if (j=0) then (z:real) else (&.0))`;
+  EXISTS_TAC `(c:num->real)`;
+  SUBGOAL_TAC `c IN (euclid 1)`;
+  REWRITE_TAC[IN;euclid];
+  EXPAND_TAC "c";
+  GEN_TAC;
+  COND_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  ARITH_TAC;
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  REWRITE_TAC[GSYM RIGHT_IMP_EXISTS_THM];
+  DISCH_TAC;
+  FIRST_ASSUM (fun t-> (MP_TAC (SPEC `eps:real` t)));
+  FIRST_ASSUM (fun t-> REWRITE_TAC[t]);
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `N:num`;
+  GEN_TAC;
+  SUBGOAL_TAC `euclid 1 (f (i:num))`;
+  UNDISCH_FIND_TAC `cauchy_seq`;
+  REWRITE_TAC[cauchy_seq;sequence;SUBSET;IN_IMAGE;IN_UNIV];
+  DISCH_THEN (fun t-> MP_TAC (CONJUNCT1 t));
+  REWRITE_TAC[IN];
+  MESON_TAC[];
+  UNDISCH_FIND_TAC `(IN)`;
+  REWRITE_TAC[IN];
+  SIMP_TAC[euclid1_abs];
+  DISCH_ALL_TAC;
+  EXPAND_TAC "c";
+  COND_CASES_TAC;
+  ASM_MESON_TAC[ARITH_RULE `n >=| N <=> N <= n`];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let sequence_in = prove_by_refinement(
+  `!X (f:num->A) i. sequence X f ==> X (f i)`,
+  (* {{{ proof *)
+
+  [
+  REPEAT GEN_TAC;
+  REWRITE_TAC[sequence;SUBSET;IN_IMAGE;IN_UNIV];
+  REWRITE_TAC[IN];
+  MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let proj_cauchy = prove_by_refinement(
+  `!i f n. cauchy_seq (euclid n,d_euclid) f ==>
+     (cauchy_seq (euclid 1,d_euclid) ((proj i) o f))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[cauchy_seq];
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `sequence (euclid 1) (proj (i:num) o f)`;
+  REWRITE_TAC[sequence;SUBSET;IN_IMAGE;o_DEF;IN_UNIV];
+  NAME_CONFLICT_TAC;
+  MESON_TAC[IN;proj_euclid1];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  FIRST_ASSUM (fun t -> CHOOSE_TAC (SPEC `eps:real` t));
+  EXISTS_TAC `n':num`;
+  DISCH_ALL_TAC;
+  FIRST_ASSUM (fun t-> MP_TAC(SPECL [`i':num`;`j:num`] t));
+  UNDISCH_FIND_THEN `d_euclid` (fun t-> ALL_TAC);
+  ASM_REWRITE_TAC[];
+  MATCH_MP_TAC (REAL_ARITH `a <=. b ==> (b <. eps ==> a <. eps)`);
+  REWRITE_TAC[o_DEF;proj_d_euclid];
+  MATCH_MP_TAC proj_contraction;
+  EXISTS_TAC `n:num`;
+  ASM_MESON_TAC[sequence_in];
+  ]);;
+
+  (* }}} *)
+
+let complete_euclid = prove_by_refinement(
+  `!n. complete (euclid n,d_euclid)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[complete;IN];
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  IMP_RES_THEN MP_TAC proj_cauchy;
+  DISCH_TAC;
+  SUBGOAL_TAC `!i. converge (euclid 1,d_euclid) (proj i o f)`;
+  GEN_TAC;
+  ASM_MESON_TAC[complete;complete_real];
+  REWRITE_TAC[converge;IN];
+  DISCH_THEN (fun t-> MP_TAC (ONCE_REWRITE_RULE[SKOLEM_THM] t));
+  DISCH_THEN (X_CHOOSE_TAC `L:num->(num->real)`);
+  EXISTS_TAC `(\j. ((L:num->num->real) j 0))`;
+  SUBCONJ_TAC;
+  REWRITE_TAC[euclid];
+  GEN_TAC;
+  FIRST_ASSUM (fun t->(MP_TAC (SPEC `m:num` t)));
+  DISCH_ALL_TAC;
+  FIRST_ASSUM (fun t-> (MP_TAC (SPEC `abs((L:num->num->real) m 0)` t)));
+  DISCH_THEN CHOOSE_TAC;
+  PROOF_BY_CONTR_TAC;
+  ASSUME_TAC (REAL_ARITH `!x. ~(x=(&.0)) ==> (&.0 <. abs(x))`);
+  UNDISCH_FIND_TAC `d_euclid`;
+  ASM_SIMP_TAC[];
+  REWRITE_TAC[GSYM EXISTS_NOT_THM];
+  EXISTS_TAC `(n:num)+n'`;
+  REWRITE_TAC[o_DEF];
+  REWRITE_TAC[ARITH_RULE `n' <=| n+| n'`];
+  MATCH_MP_TAC(REAL_ARITH `(x = y) ==> ~(x<y)`);
+  ALL_TAC; (* #buffer "CE1"; *)
+  SUBGOAL_TAC `euclid 1 (proj m (f (n +| n')))`;
+  REWRITE_TAC[proj_euclid1];
+  ASM_SIMP_TAC[euclid1_abs];
+  DISCH_TAC;
+  MATCH_MP_TAC (REAL_ARITH `(&.0 = x) ==> (abs(u - x) = abs(u))`);
+  REWRITE_TAC[proj];
+  SUBGOAL_TAC `euclid n (f (n+| n'))`;
+  ASM_MESON_TAC[cauchy_seq;sequence_in];
+  REWRITE_TAC[euclid];
+  DISCH_THEN (fun t->  ASM_SIMP_TAC[t]);
+  ALL_TAC; (* #buffer "CE2"; *)
+  DISCH_TAC;
+  GEN_TAC;
+  CONV_TAC (quant_right_CONV "n");
+  DISCH_TAC;
+  USE 2 (CONV_RULE (quant_left_CONV "eps"));
+  USE 2 (CONV_RULE (quant_left_CONV "eps"));
+  USE 2 (SPEC `eps/(&.1 +. &. n)`);
+  USE 2 (CONV_RULE (quant_left_CONV "n'"));
+  USE 2 (CONV_RULE (quant_left_CONV "n'"));
+  CHO 2;
+  SUBGOAL_TAC `&.0 <. eps/ (&.1 +. &.n)`;
+  MATCH_MP_TAC REAL_LT_DIV;
+  ASM_REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_LT];
+  ARITH_TAC;
+  DISCH_THEN (fun t-> (USE 2 (REWRITE_RULE[t])));
+  SUBGOAL_TAC `!i j. euclid 1 ((proj i o f) (j:num))`;
+  ASM_MESON_TAC[cauchy_seq;sequence_in];
+  DISCH_TAC;
+  SUBGOAL_TAC `!i. euclid n (f (i:num))`;
+  GEN_TAC;
+  ASM_MESON_TAC[cauchy_seq;sequence_in];
+  DISCH_TAC;
+  ASM_SIMP_TAC[d_euclid_n];
+  SUBGOAL_TAC `!(j:num). ?c. !i. (c <=| i) ==> ||. (L j 0 -. f i j) <. eps/(&.1 + &. n)`;
+  CONV_TAC (quant_left_CONV "c");
+  EXISTS_TAC `n':num->num`;
+  REPEAT GEN_TAC;
+  USE 2 ((SPEC `j:num`));
+  UND 2;
+  DISCH_ALL_TAC;
+  USE 8 (SPEC `i:num`);
+  UND 8;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[euclid1_abs];
+  REWRITE_TAC[proj;o_DEF];
+  CONV_TAC (quant_left_CONV "c");
+  DISCH_THEN CHOOSE_TAC;
+  ABBREV_TAC `t = (\u. (if (u <| n) then (c u) else (0)))`;
+  SUBGOAL_TAC `?M. (!j. (t:num->num) j <=| M)`;
+  MATCH_MP_TAC max_num_sequence;
+  EXISTS_TAC `n:num`;
+  GEN_TAC;
+  EXPAND_TAC "t";
+  COND_CASES_TAC;
+  ASM_MESON_TAC[ARITH_RULE `m <| n ==> ~(n <= m)`];
+  REWRITE_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `M:num`;
+  GEN_TAC;
+  ALL_TAC; (* #set "CE3"; *)
+  DISCH_TAC;
+  MATCH_MP_TAC REAL_POW_2_LT;
+  CONJ_TAC;
+  MATCH_MP_TAC SQRT_POS_LE;
+  REWRITE_TAC[REAL_SUM_SQUARE_POS];
+  CONJ_TAC;
+  UND 4;
+  REAL_ARITH_TAC;
+  SIMP_TAC[REAL_SUM_SQUARE_POS;SQRT_POW_2];
+  SUBGOAL_TAC `sum (0,n) (\i'. (L i' 0 - f (i:num) i') * (L i' 0 - f i i')) <=. sum (0,n) (\i'. (eps/(&.1 + &.n)) * (eps/(&.1 + &.n)))`;
+  MATCH_MP_TAC SUM_LE;
+  BETA_TAC;
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `c (r:num) = (t:num->num) r`;
+  EXPAND_TAC "t";
+  COND_CASES_TAC;
+  REFL_TAC;
+  ASM_MESON_TAC[ARITH_RULE `n +| 0 = n`];
+  DISCH_TAC;
+  SUBGOAL_TAC `(abs (L r 0 - f (i:num) (r:num)) < eps/(&.1 + &.n))`;
+  USE 7 (SPECL [`r:num`;`i:num`]);
+  UND 7;
+  DISCH_THEN MATCH_MP_TAC;
+  ASM_REWRITE_TAC[];
+  USE 9 (SPEC `r:num`);
+  JOIN 7 10;
+  UND 7;
+  REWRITE_TAC[LE_TRANS];
+  ALL_TAC; (* "CE4" *)
+  ABBREV_TAC `b = eps/(&1 + &n)`;
+  ABBREV_TAC `a = (L r 0 - (f:num->num->real) i r)`;
+  REWRITE_TAC[GSYM REAL_POW_2];
+  REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS];
+  REAL_ARITH_TAC;
+  MATCH_MP_TAC (REAL_ARITH `(b <. c)   ==> ((a <=. b) ==> (a <. c))`);
+  REWRITE_TAC[SUM_CONST];
+  REWRITE_TAC[REAL_MUL_AC;real_div];
+  SUBGOAL_TAC `eps pow 2 = eps*eps*(&. 1)`;
+  REWRITE_TAC[REAL_POW_2];
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t->REWRITE_TAC[t]);
+  MATCH_MP_TAC REAL_PROP_LT_LMUL;
+  ASM_REWRITE_TAC[];
+  MATCH_MP_TAC REAL_PROP_LT_LMUL;
+  ASM_REWRITE_TAC[];
+  SUBGOAL_TAC `&.0 <. &.1 + &.n `;
+  REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_LT];
+  ARITH_TAC;
+  ALL_TAC; (*  "CE5" *)
+  SIMP_TAC[REAL_INV_LT];
+  DISCH_TAC;
+  REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_LT;REAL_OF_NUM_MUL];
+  REWRITE_TAC[ARITH_RULE `(1+n)*(1+n)*1 = 1+n+n+n*n`];
+  MATCH_MP_TAC (ARITH_RULE `(0<=a)/\(0<=b) /\(0<1)  ==> (a <| 1 + a + a + b)`);
+  CONJ_TAC;
+  ARITH_TAC;
+  CONJ_TAC;
+  ONCE_REWRITE_TAC [ARITH_RULE `0 = n *| 0`];
+  REWRITE_TAC[LE_MULT_LCANCEL];
+  ARITH_TAC;
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let subset_sequence = prove_by_refinement(
+  `!(X:A->bool) S f. S SUBSET X /\ sequence S f ==>
+         sequence X f`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[sequence];
+  SET_TAC[];
+  ]);;
+  (* }}} *)
+
+let subset_cauchy = prove_by_refinement(
+  `!(X:A->bool) S d f. S SUBSET X /\ cauchy_seq(S,d) f ==>
+         cauchy_seq(X,d) f`,
+  (* {{{ proof *)
+  [
+  REPEAT GEN_TAC;
+  REWRITE_TAC[cauchy_seq];
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[subset_sequence];
+  ]);;
+  (* }}} *)
+
+let complete_closed = prove_by_refinement(
+  `!n S. (closed_ (top_of_metric (euclid n,d_euclid)) S) /\
+    (S SUBSET (euclid n)) ==>
+     (complete (S,d_euclid))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[complete];
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  GEN_TAC;
+  DISCH_TAC;
+  USE 0 (MATCH_MP closed_open);
+  UND 0;
+  SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
+  DISCH_TAC;
+  SUBGOAL_TAC `cauchy_seq(euclid n,d_euclid) f`;
+  ASM_MESON_TAC[subset_cauchy];
+  DISCH_TAC;
+  SUBGOAL_TAC `converge(euclid n,d_euclid) f`;
+  ASM_MESON_TAC[complete_euclid;complete];
+  REWRITE_TAC[converge];
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `(x:num->real)`;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  SUBGOAL_TAC `~(x IN S) ==> (x IN (euclid n DIFF S))`;
+  ASM SET_TAC[];
+  DISCH_TAC;
+  H_MATCH_MP (HYP "6") (HYP "5");
+  USE 0 (REWRITE_RULE[open_DEF]);
+  USE 0 (REWRITE_RULE[(MATCH_MP (CONV_RULE (quant_right_CONV "A") top_of_metric_nbd) (SPEC `n:num` metric_euclid))]);
+  USE 0 (CONV_RULE (quant_left_CONV "a"));
+  USE 0 (SPEC `x:num->real`);
+  UND 0;
+  ASM_REWRITE_TAC[SUBSET_DIFF];
+  ALL_TAC; (* #CC1; *)
+  PROOF_BY_CONTR_TAC;
+  USE 0 (REWRITE_RULE[]);
+  CHO 0;
+  USE 0 (REWRITE_RULE[SUBSET;IN_ELIM_THM';open_ball]);
+  AND 0;
+  AND 4;
+  USE 4 (SPEC `r:real`);
+  CHO 4;
+  H_MATCH_MP (HYP "4") (HYP "8");
+  USE 10 (SPEC `n':num`);
+  USE 10 (REWRITE_RULE[ARITH_RULE `n <=| n`]);
+  USE 0 (SPEC `(f:num->num->real) n'`);
+  UND 0;
+  USE 9 (REWRITE_RULE[IN]);
+  ASM_REWRITE_TAC[];
+  SUBGOAL_TAC `(S:(num->real)->bool) ((f:num->num->real) n')`;
+  ASM_MESON_TAC[cauchy_seq;sequence_in];
+  UND 1;
+  ABBREV_TAC `X = euclid n`;
+  ABBREV_TAC `a = (f:num->num->real) n'`;
+  REWRITE_TAC[IN_DIFF];
+  REWRITE_TAC[IN;SUBSET];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Totally bounded metric spaces *)
+(* ------------------------------------------------------------------ *)
+
+
+let totally_bounded = euclid_def `totally_bounded ((X:A->bool),d) =
+  (!eps. ?B.  (&.0 <. eps) ==>
+    (FINITE B) /\
+    (!b. (B b) ==> ?x. b = open_ball(X,d) x eps) /\
+    (X = UNIONS B))`;;
+
+let totally_bounded_subset = prove_by_refinement(
+  `!(X:A->bool) d S. (metric_space (X,d)) /\ (totally_bounded(X,d))
+      /\ (S SUBSET X)  ==>
+     (totally_bounded (S,d)) `,
+  (* {{{ proof *)
+
+  [
+  REPEAT GEN_TAC;
+  REWRITE_TAC[totally_bounded];
+  DISCH_ALL_TAC;
+  GEN_TAC;
+  USE 1 (SPEC `eps/(&.2)`);
+  CHO 1;
+  CONV_TAC (quant_right_CONV "B");
+  DISCH_TAC;
+  SUBGOAL_TAC `&.0 <. eps ==> &.0 <. eps/(&.2)`;
+  DISCH_THEN (fun t-> MP_TAC (ONCE_REWRITE_RULE[GSYM REAL_HALF_DOUBLE] t));
+  REWRITE_TAC[REAL_DIV_LZERO];
+  REAL_ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (UND 1) THEN (ASM_REWRITE_TAC[]) THEN DISCH_ALL_TAC;
+  SUBGOAL_TAC `!b. ?s. (?t. (t IN (b:A->bool) INTER S)) ==> (s IN b INTER S)`;
+  GEN_TAC;
+  CONV_TAC (quant_left_CONV "t");
+  MESON_TAC[IN];
+  CONV_TAC (quant_left_CONV "s");
+  DISCH_THEN CHOOSE_TAC;
+  ALL_TAC; (* #set "TB1"; *)
+  EXISTS_TAC `IMAGE (\c. (open_ball ((S:A->bool),d) ((s) c) eps)) (B:(A->bool)->bool)`;
+  CONJ_TAC;
+  MATCH_MP_TAC FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  GEN_TAC;
+  REWRITE_TAC[IMAGE;IN_ELIM_THM'];
+  NAME_CONFLICT_TAC;
+  DISCH_THEN (X_CHOOSE_TAC `c:A->bool`);
+  ASM_MESON_TAC[];
+  MATCH_MP_TAC EQ_EXT;
+  X_GEN_TAC `u:A`;
+  EQ_TAC;
+  DISCH_TAC;
+  SUBGOAL_TAC `(X:A->bool) (u:A)`;
+  ASM_MESON_TAC[SUBSET;IN];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REWRITE_RULE[IN] IN_UNIONS];
+  DISCH_THEN (X_CHOOSE_TAC `b':A->bool`);
+  USE 7 (SPEC `b':A->bool`);
+  REWRITE_TAC[IMAGE];
+  REWRITE_TAC[IN_ELIM_THM'];
+  CONV_TAC (quant_left_CONV "x");
+  CONV_TAC (quant_left_CONV "x");
+  EXISTS_TAC `b':A->bool`;
+  EXISTS_TAC `open_ball((S:A->bool),d) (s (b':A->bool)) eps`;
+  ASM_REWRITE_TAC[IN];
+  REWRITE_TAC[open_ball];
+  REWRITE_TAC[IN_ELIM_THM'];
+  ALL_TAC; (* #set "TB2"; *)
+  SUBGOAL_TAC `(u:A) IN (b' INTER S)`;
+  REWRITE_TAC[IN_INTER];
+  ASM_MESON_TAC[IN];
+  UND 7;
+  CONV_TAC (quant_left_CONV "t");
+  CONV_TAC (quant_left_CONV "t");
+  EXISTS_TAC `u:A`;
+  DISCH_TAC;
+  DISCH_TAC;
+  SUBGOAL_TAC `(S:A->bool) ((s:(A->bool)->A) b')`;
+  UND 7;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IN_INTER];
+  MESON_TAC[IN];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  SUBGOAL_TAC `(b':A->bool) ((s:(A->bool)->A) b')`;
+  UND 11;
+  UND 7;
+  REWRITE_TAC[IN_INTER];
+  ASM_MESON_TAC[IN];
+  ALL_TAC; (* #set "TB3"; *)
+  DISCH_TAC;
+  AND 9;
+  USE 5 (SPEC `b':A->bool`);
+  H_MATCH_MP (HYP "5") (HYP "13");
+  CHO 14;
+  ABBREV_TAC `v = (s:(A->bool)->A) b'`;
+  COPY 9;
+  UND 9;
+  UND 12;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[open_ball;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `(X x) /\ ((X:A->bool) u) /\ (X v)`;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[SUBSET;IN];
+  DISCH_ALL_TAC;
+  USE 0 (REWRITE_RULE[metric_space]);
+  COPY 16;
+  KILL 1;
+  KILL 7;
+  KILL 11;
+  UND 21;
+  KILL 6;
+  UND 14;
+  DISCH_THEN (fun t-> ASSUME_TAC t THEN (REWRITE_TAC[t]));
+  REWRITE_TAC[open_ball;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  USE 0 (SPECL [`v:A`;`x:A`;`u:A`]);
+  UND 0;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 22 (MATCH_MP (REAL_ARITH `(a <=. b + c) ==> !e. (b + c <. e ==> (a <. e))`));
+  USE 22 (SPEC `eps:real`);
+  UND 22 THEN (DISCH_THEN (MATCH_MP_TAC));
+  ASM_REWRITE_TAC[];
+  UND 11;
+  UND 17;
+  MP_TAC (SPEC `eps:real` REAL_HALF_DOUBLE);
+  REAL_ARITH_TAC;
+  REWRITE_TAC[IMAGE;IN_ELIM_THM'];
+  REWRITE_TAC[UNIONS;IN_ELIM_THM'];
+  CONV_TAC (quant_left_CONV "x");
+  CONV_TAC (quant_left_CONV "x");
+  NAME_CONFLICT_TAC;
+  CONV_TAC (quant_left_CONV "x'");
+  X_GEN_TAC `c:A->bool`;
+  CONV_TAC (quant_left_CONV "u'");
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  UND 10;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[open_ball;IN_ELIM_THM'];
+  MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let integer_cube_finite = prove_by_refinement(
+  `!n N. FINITE { f | (euclid n f) /\
+       (!i. (?j. (abs(f i) = &.j) /\ (j <=| N)))}`,
+  (* {{{ proof *)
+
+  [
+  REP_GEN_TAC;
+  ABBREV_TAC `fs = FUN {m | m <| n} {x |  ?j. (abs x = &.j) /\ (j <=| N)}`;
+  ABBREV_TAC `gs = { f | (euclid n f) /\ (!i. (?j. (abs(f i) = &.j) /\ (j <=| N)))}`;
+  SUBGOAL_TAC `FINITE (fs:(num->real)->bool)`;
+  EXPAND_TAC "fs";
+  MP_TAC(prove(`!(a:num->bool) (b:real->bool). FINITE a /\ FINITE b ==> (FINITE (FUN a b))`,MESON_TAC[HAS_SIZE;FUN_SIZE]));
+  DISCH_THEN MATCH_MP_TAC;
+  REWRITE_TAC[interval_finite;FINITE_NUMSEG_LT];
+  DISCH_TAC;
+  ABBREV_TAC `G = (\ u. (\ j. if (n <=| j) then (&.0) else (u j)))`;
+  SUBGOAL_TAC `FINITE { y | ?x. x IN fs /\ (y:(num->real) = G (x:num->real))}`;
+  MATCH_MP_TAC FINITE_IMAGE_EXPAND;
+  ASM_REWRITE_TAC[];
+  SUBGOAL_TAC `!a b. ((a:(num->real)->bool) = b) ==> (FINITE a ==> FINITE b)`;
+  REP_GEN_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  DISCH_THEN (fun t-> MATCH_MP_TAC t);
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  EXPAND_TAC "gs";
+  REWRITE_TAC[IN_ELIM_THM'];
+  EXPAND_TAC "fs";
+  REWRITE_TAC[FUN;IN_ELIM_THM'];
+  NAME_CONFLICT_TAC;
+  EQ_TAC;
+  DISCH_THEN (CHOOSE_TAC );
+  SUBGOAL_TAC `euclid n x`;
+  REWRITE_TAC[euclid];
+  GEN_TAC;
+  AND 4;
+  UND 4;
+  EXPAND_TAC "G";
+  DISCH_THEN (fun t->REWRITE_TAC[t]);
+  DISCH_THEN (fun t->REWRITE_TAC[t]);
+  DISCH_TAC THEN (ASM_REWRITE_TAC[]);
+  GEN_TAC;
+  AND 4;
+  EXPAND_TAC "G";
+  COND_CASES_TAC;
+  REDUCE_TAC;
+  EXISTS_TAC `0`;
+  REDUCE_TAC;
+  AND 6;
+  USE 8 (SPEC `i':num`);
+  ASM_MESON_TAC[ARITH_RULE `~(n <=| i') ==> (i' <| n)`];
+  DISCH_ALL_TAC;
+  EXISTS_TAC `\p. (if (p <| n) then ((x:num->real) p) else (CHOICE UNIV))`;
+  CONJ_TAC;
+  REWRITE_TAC[SUPP;SUBSET;IN_ELIM_THM'];
+  NAME_CONFLICT_TAC;
+  CONJ_TAC;
+  GEN_TAC;
+  DISCH_THEN (fun t->REWRITE_TAC[t]);
+  UND 5;
+  MESON_TAC[];
+  GEN_TAC;
+  COND_CASES_TAC;
+  REWRITE_TAC[];
+  REWRITE_TAC[];
+  MATCH_MP_TAC EQ_EXT;
+  X_GEN_TAC `q:num`;
+  EXPAND_TAC "G";
+  COND_CASES_TAC;
+  ASM_MESON_TAC[euclid];
+  USE 6 (MATCH_MP (ARITH_RULE `~(n <=| q) ==> (q <| n)`));
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let FINITE_scaled_lattice = prove_by_refinement(
+  `!n N s. (&.0 <. s) ==> FINITE {x | euclid n x /\ (!i. (?j. abs(x i) = s*(&.j)) /\ (abs(x i) <=. (&.N) ) ) }`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  ABBREV_TAC `map  = ( *# ) s`;
+  ASSUME_TAC REAL_ARCH_SIMPLE;
+  USE 2 (SPEC `inv(s)*(&.N)`);
+  UND 2 THEN (DISCH_THEN (X_CHOOSE_TAC `M:num`));
+  ASSUME_TAC integer_cube_finite;
+  USE 3 (SPECL [`n:num`;`M:num`]);
+  USE 3 (MATCH_MP (ISPEC `map:(num->real)->(num->real)` FINITE_IMAGE_EXPAND));
+  UND 3;
+  MATCH_MP_TAC (prove_by_refinement (`!a b. ((b:A->bool) SUBSET a) ==> (FINITE a ==> FINITE b)`,[MESON_TAC[FINITE_SUBSET]]));
+  REWRITE_TAC[SUBSET];
+  X_GEN_TAC `c:num->real`;
+  REWRITE_TAC[IN_ELIM_THM'];
+  EXPAND_TAC "map";
+  DISCH_ALL_TAC;
+  EXISTS_TAC `inv(s) *# c`;
+  REWRITE_TAC[euclid_scale_act];
+  ASM_SIMP_TAC[euclid_scale_closure];
+  WITH 0 (MATCH_MP (REAL_ARITH `&.0 < s ==> ~(s = &.0)`));
+  ASM_SIMP_TAC[REAL_MUL_RINV];
+  CONJ_TAC;
+  GEN_TAC;
+  USE 4 (SPEC `i:num`);
+  AND 4;
+  CHO 6;
+  REWRITE_TAC[euclid_scale;REAL_ABS_MUL;REAL_ABS_INV];
+  SUBGOAL_TAC `abs s = s`;
+  UND 0;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  EXISTS_TAC `j:num`;
+  ALL_TAC; (* save_goal "C" *)
+  SUBCONJ_TAC;
+  ASM_REWRITE_TAC[];
+  UND 5;
+  REWRITE_TAC[GSYM (CONJUNCT1 (CONJUNCT2 (REAL_MUL_AC)))];
+  SIMP_TAC[REAL_MUL_LINV];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  REWRITE_TAC[GSYM REAL_OF_NUM_LE];
+  USE 7 (GSYM);
+  UND 7 THEN DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  USE 0 (MATCH_MP REAL_LT_INV);
+  ABBREV_TAC `s' = inv(s)`;
+  USE 0 (MATCH_MP (REAL_ARITH `&.0 < s' ==> &.0 <=. s'`));
+  JOIN 0 4;
+  USE 0 (MATCH_MP REAL_LE_LMUL);
+  JOIN 0 2;
+  UND 0;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[euclid_scale_one];
+  ]);;
+
+  (* }}} *)
+
+let totally_bounded_cube = prove_by_refinement(
+  `!n N. totally_bounded
+        ({x | euclid n x /\ (!i. abs(x i) <=. (&.N))},d_euclid)`,
+  (* {{{ proof *)
+  [
+  REP_GEN_TAC;
+  REWRITE_TAC[totally_bounded];
+  GEN_TAC;
+  CONV_TAC (quant_right_CONV "B");
+  DISCH_TAC;
+  ABBREV_TAC `cent = {x | euclid n x /\ (!i. (?j. abs(x i) = (eps/(&.n+. &.1))*(&.j)) /\ (abs(x i) <=. (&.N) ) ) }`;
+  SUBGOAL_TAC `&.0 <. (&.n +. &.1)`;
+  REDUCE_TAC;
+  ARITH_TAC;
+  DISCH_TAC;
+  ABBREV_TAC `s = eps/(&.n +. &.1)`;
+  SUBGOAL_TAC `&.0 < s`;
+  EXPAND_TAC "s";
+  ASM_SIMP_TAC[REAL_LT_DIV];
+  DISCH_TAC;
+  SUBGOAL_TAC `FINITE (cent:(num->real)->bool)`;
+  EXPAND_TAC "cent";
+  ASM_SIMP_TAC[FINITE_scaled_lattice];
+  DISCH_TAC;
+  ABBREV_TAC `cube = {x | euclid n x /\ (!i. abs(x i) <=. (&.N))}`;
+  EXISTS_TAC `IMAGE (\c. open_ball(cube,d_euclid) c eps) cent`;
+  SUBCONJ_TAC;
+  ASM_MESON_TAC[FINITE_IMAGE];
+  DISCH_TAC;
+  SUBCONJ_TAC;
+  GEN_TAC;
+  REWRITE_TAC[IMAGE;IN_ELIM_THM'];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  ALL_TAC; (* # TB1; *)
+  SUBGOAL_TAC `cent SUBSET (cube:(num->real)->bool)`;
+  REWRITE_TAC[SUBSET];
+  EXPAND_TAC "cent";
+  EXPAND_TAC "cube";
+  REWRITE_TAC[IN_ELIM_THM'];
+  MESON_TAC[];
+  DISCH_TAC;
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM'];
+  ASSUME_TAC REAL_ARCH_LEAST;
+  USE 11 (SPEC `s:real`);
+  UND 11 THEN (ASM_REWRITE_TAC[]) THEN DISCH_TAC;
+  USE 11 (CONV_RULE (quant_left_CONV "n"));
+  USE 11 (CONV_RULE (quant_left_CONV "n"));
+  UND 11 THEN (DISCH_THEN (X_CHOOSE_TAC `cs:real->num`));
+  NAME_CONFLICT_TAC;
+  CONV_TAC (quant_left_CONV "x'");
+  CONV_TAC (quant_left_CONV "x'");
+  ABBREV_TAC `cx = \ (i:num) . if (&.0 <=. (x i)) then &(cs (x i))* s else --. (&.(cs (--. (x i))) * s )`;
+  EXISTS_TAC `cx:num->real`;
+  EXISTS_TAC `open_ball(cube,d_euclid) cx eps`;
+  ASM_REWRITE_TAC[];
+  ALL_TAC; (* # TB2; *)
+  SUBGOAL_TAC `euclid n x`;
+  UND 10;
+  EXPAND_TAC "cube";
+  REWRITE_TAC[IN_ELIM_THM'];
+  MESON_TAC[];
+  DISCH_TAC;
+  SUBGOAL_TAC `cx IN (euclid n)`;
+  REWRITE_TAC[IN;euclid;];
+  DISCH_ALL_TAC;
+  EXPAND_TAC "cx";
+  UND 13;
+  REWRITE_TAC[euclid];
+  DISCH_THEN (fun t-> MP_TAC(SPEC `m:num` t));
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  REDUCE_TAC;
+  USE 11 (SPEC `&.0`);
+  UND 11;
+  REDUCE_TAC;
+  ABBREV_TAC `(a:num) = (cs (&.0))`;
+  SUBGOAL_TAC `&.0 <=. &.a *s`;
+  REWRITE_TAC[REAL_MUL_NN];
+  DISJ1_TAC;
+  REDUCE_TAC;
+  UND 4;
+  REAL_ARITH_TAC;
+  ABBREV_TAC `q = (&.a)*. s`;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  ALL_TAC; (* # TB3; *)
+  SUBCONJ_TAC;
+  EXPAND_TAC "cent";
+  REWRITE_TAC[IN_ELIM_THM'];
+  USE 14 (REWRITE_RULE[IN]);
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  EXPAND_TAC "cx";
+  BETA_TAC;
+  COND_CASES_TAC;
+  SUBCONJ_TAC;
+  EXISTS_TAC `((cs:real->num) (x (i:num)))`;
+  REWRITE_TAC[REAL_ABS_MUL];
+  REDUCE_TAC;
+  REWRITE_TAC[REAL_MUL_AC];
+  AP_THM_TAC;
+  AP_TERM_TAC;
+  UND 4;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  ALL_TAC; (* # TB4; *)
+  SUBGOAL_TAC `(&.0 <=. &.(cs ((x:num->real) i)) * s)`;
+  REWRITE_TAC[REAL_MUL_NN];
+  DISJ1_TAC;
+  REDUCE_TAC;
+  UND 4 THEN REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> MP_TAC (REWRITE_RULE[GSYM REAL_ABS_REFL] t));
+  DISCH_THEN (fun t-> REWRITE_TAC [t]);
+  USE 11 (SPEC `(x:num->real) i`);
+  UND 11;
+  ASM_REWRITE_TAC [];
+  UND 10;
+  EXPAND_TAC "cube";
+  REWRITE_TAC [IN_ELIM_THM'];
+  DISCH_THEN (fun t -> ASSUME_TAC (CONJUNCT2 t));
+  USE 10 (SPEC `i:num`);
+  UND 10;
+  ASSUME_TAC(prove(`&.0 <= x ==> (abs x = x)`,MESON_TAC[REAL_ABS_REFL]));
+  ASM_SIMP_TAC[];
+  MESON_TAC[REAL_LE_TRANS];
+  ALL_TAC ; (* #TB5; *)
+  REWRITE_TAC[REAL_ABS_NEG];
+  SUBCONJ_TAC;
+  EXISTS_TAC `((cs:real->num) (--. (x (i:num))))`;
+  REWRITE_TAC [REAL_ABS_MUL];
+  REDUCE_TAC;
+  ASSUME_TAC(prove(`&.0 <= x ==> (abs x = x)`,MESON_TAC[REAL_ABS_REFL]));
+  ASSUME_TAC(REAL_ARITH `&.0 < x ==> &. 0 <=. x`);
+  ASM_SIMP_TAC[];
+  REWRITE_TAC [REAL_MUL_AC];
+  DISCH_TAC;
+  USE 11 (SPEC `--. (x (i:num))`);
+  UND 11;
+  ASSUME_TAC (REAL_ARITH `!x. ~(&.0 <= x) ==> (&.0 <= --. x)`);
+  ASM_SIMP_TAC[];
+  UND 10;
+  EXPAND_TAC "cube";
+  REWRITE_TAC[IN_ELIM_THM'];
+  DISCH_THEN (fun t -> ASSUME_TAC (CONJUNCT2 t));
+  USE 10 (SPEC `i:num`);
+  UND 10;
+  MP_TAC(prove(`!v. (-- v <=. abs(v))`,REAL_ARITH_TAC));
+  REWRITE_TAC [REAL_ABS_MUL];
+  REDUCE_TAC;
+  ASSUME_TAC(prove(`&.0 <= x ==> (abs x = x)`,MESON_TAC[REAL_ABS_REFL]));
+  ASSUME_TAC(REAL_ARITH `&.0 < x ==> &. 0 <=. x`);
+  ASM_SIMP_TAC[];
+  MESON_TAC[REAL_LE_TRANS];
+  ALL_TAC;  (* #TB6; *)
+  DISCH_TAC;
+  REWRITE_TAC[open_ball;IN_ELIM_THM'];
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 15;
+  UND 9;
+  REWRITE_TAC[SUBSET;IN];
+  MESON_TAC[];
+  SUBGOAL_TAC `d_euclid cx x <= sqrt(&.n)*s`;
+  MATCH_MP_TAC D_EUCLID_BOUND;
+  USE 14 (REWRITE_RULE[IN]);
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  EXPAND_TAC "cx";
+  BETA_TAC;
+  ASSUME_TAC (REAL_ARITH `!x a b. a <=. x /\ x <. b ==> abs(a - x) <= b -a`);
+  SUBGOAL_TAC `!x. &.0 <=. x ==> abs(&.(cs x)*.s -. x) <=. s`;
+  DISCH_ALL_TAC;
+  USE 11 (SPEC `x':real`);
+  H_MATCH_MP (HYP "11") (HYP "17");
+  H_MATCH_MP (HYP "16") (HYP "18");
+  USE 19 (REWRITE_RULE [GSYM REAL_SUB_RDISTRIB]);
+  ALL_TAC; (* # TB7; *)
+  USE 19 (CONV_RULE REDUCE_CONV);
+  ASM_REWRITE_TAC [];
+  DISCH_TAC;
+  COND_CASES_TAC;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[REAL_ARITH `--x - y = --(x+.y)`;REAL_ABS_NEG];
+  REWRITE_TAC[REAL_ARITH `x+. y = (x -. (--. y))`];
+  ASM_MESON_TAC[REAL_ARITH `!u. ~(&.0 <=. u) ==> (&.0 <=. (--. u))`];
+  ALL_TAC; (* # TB8; *)
+  MATCH_MP_TAC(REAL_ARITH `b < c ==> ((a<=b) ==> (a < c))`);
+  EXPAND_TAC "s";
+  REWRITE_TAC[real_div;REAL_MUL_AC];
+  MATCH_MP_TAC(REAL_ARITH`(t < e *(&.1)) ==> (t <. e)`);
+  MATCH_MP_TAC (REAL_LT_LMUL);
+  ASM_REWRITE_TAC[];
+  ASSUME_TAC REAL_PROP_LT_LCANCEL ;
+  USE 16 (SPEC `&.n +. &.1`);
+  UND 16;
+  DISCH_THEN (MATCH_MP_TAC);
+  REDUCE_TAC;
+  SUBGOAL_TAC `~(&.(n+1) = &.0)`;
+  REDUCE_TAC;
+  ARITH_TAC;
+  REWRITE_TAC[REAL_ARITH`a*b*c = (a*b)*c`];
+  ALL_TAC; (* # TB8; *)
+  SIMP_TAC[REAL_MUL_RINV];
+  REDUCE_TAC;
+  DISCH_TAC;
+  CONJ_TAC;
+  ARITH_TAC;
+  SQUARE_TAC;
+  SUBCONJ_TAC;
+  MATCH_MP_TAC SQRT_POS_LE;
+  REDUCE_TAC;
+  DISCH_TAC;
+  SUBCONJ_TAC;
+  REDUCE_TAC;
+  DISCH_TAC;
+  SUBGOAL_TAC `&.0 <=. &.n`;
+  REDUCE_TAC;
+  SIMP_TAC[prove(`!x. (&.0 <=. x) ==> (sqrt(x) pow 2 = x)`,MESON_TAC[SQRT_POW2])];
+  DISCH_TAC;
+  REWRITE_TAC[REAL_POW_2];
+  REDUCE_TAC;
+  REWRITE_TAC[LEFT_ADD_DISTRIB;RIGHT_ADD_DISTRIB];
+  REDUCE_TAC;
+  ABBREV_TAC `m = n*|n +| n`;
+  ARITH_TAC;
+  ALL_TAC; (* # TB9;  *)
+  REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM'];
+  DISCH_THEN CHOOSE_TAC;
+  AND 10;
+  CHO 11;
+  AND 11;
+  UND 10;
+  ASM_REWRITE_TAC[];
+  MP_TAC (ISPEC `cube:(num->real)->bool` open_ball_subset);
+  REWRITE_TAC[SUBSET];
+  REWRITE_TAC[IN];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let center_FINITE = prove_by_refinement(
+  `!X d  . metric_space ((X:A->bool),d) /\ (totally_bounded (X,d))
+   ==> (!eps. (&.0 < eps) ==> (?C. (C SUBSET X) /\ (FINITE C) /\ (X = UNIONS (IMAGE (\x. open_ball(X,d) x eps) C))))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[totally_bounded];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  USE 1 (SPEC `eps:real`);
+  CHO 1;
+  REWR 1;
+  AND 1;
+  AND 1;
+  USE 4 (CONV_RULE ((quant_left_CONV "x")));
+  USE 4 (CONV_RULE ((quant_left_CONV "x")));
+  CHO 4;
+  ABBREV_TAC `C'={z | (X (z:A)) /\ (?b. (B (b:A->bool)) /\ (z = x b))}`;
+  EXISTS_TAC `C':A->bool`;
+  SUBCONJ_TAC;
+  EXPAND_TAC"C'";
+  REWRITE_TAC[SUBSET;IN_ELIM_THM'];
+  REWRITE_TAC[IN];
+  MESON_TAC[];
+  DISCH_TAC;
+  CONJ_TAC;
+  SUBGOAL_TAC `C' SUBSET (IMAGE (x:(A->bool)->A) B)`;
+  EXPAND_TAC"C'";
+  REWRITE_TAC[SUBSET;IN_IMAGE;IN_ELIM_THM'];
+  NAME_CONFLICT_TAC;
+  MESON_TAC[IN];
+  DISCH_TAC;
+  SUBGOAL_TAC `FINITE (IMAGE (x:(A->bool)->A) B)`;
+  ASM_MESON_TAC[FINITE_IMAGE];
+  ASM_MESON_TAC[FINITE_SUBSET];
+  ALL_TAC; (* #g1; *)
+  (ASM (GEN_REWRITE_TAC LAND_CONV)) [];
+  ( (GEN_REWRITE_TAC LAND_CONV)) [UNIONS_DELETE];
+  AP_TERM_TAC;
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[DELETE;IN_ELIM_THM';IMAGE];
+  EXPAND_TAC "C'";
+  REWRITE_TAC[IN_ELIM_THM'];
+  NAME_CONFLICT_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  USE 4 (SPEC `x':A->bool`);
+  CONV_TAC (quant_left_CONV "b'");
+  CONV_TAC (quant_left_CONV "b'");
+  CONV_TAC (quant_left_CONV "b'");
+  EXISTS_TAC `x':(A->bool)`;
+  EXISTS_TAC `(x:(A->bool)->A) x'`;
+  REWRITE_TAC[];
+  USE 7 (REWRITE_RULE[IN]);
+  H_MATCH_MP (HYP "4") (HYP"7");
+  ALL_TAC; (* #g2 *)
+  ABBREV_TAC `a = (x:(A->bool)->A) x'`;
+  KILL 1;
+  ASM_REWRITE_TAC[];
+  UND 8;
+  ASM_REWRITE_TAC[];
+  MESON_TAC[open_ball_empty;IN];
+  ALL_TAC; (* #g3 *)
+  DISCH_THEN CHOOSE_TAC;
+  UND 7;
+  DISCH_ALL_TAC;
+  CHO 8;
+  AND 8;
+  CONJ_TAC;
+  KILL 1;
+  ASM_REWRITE_TAC[];
+  KILL 9;
+  USE 4 (SPEC `b':A->bool`);
+  REWR 1;
+  ASM_MESON_TAC[IN];
+  KILL 1;
+  ASM_REWRITE_TAC[];
+  UND 7;
+  ASM_REWRITE_TAC[];
+  ABBREV_TAC `a = (x:(A->bool)->A) b'`;
+  DISCH_TAC;
+  JOIN 2 7;
+  JOIN 0 2;
+  USE 0 (MATCH_MP open_ball_nonempty);
+  UND 0;
+  ABBREV_TAC `E= open_ball(X,d) (a:A) eps `;
+  MESON_TAC[IN;EMPTY];
+  ]);;
+  (* }}} *)
+
+let open_ball_dist = prove_by_refinement(
+  `!X d x y r. (open_ball(X,d) x r y) ==> (d (x:A) y <. r)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[open_ball;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let totally_bounded_bounded = prove_by_refinement(
+  `!(X:A->bool) d. metric_space(X,d) /\ totally_bounded (X,d) ==>
+    (?a r. X SUBSET (open_ball(X,d) a r))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  COPY 0;
+  JOIN 0 1;
+  USE 0 (MATCH_MP center_FINITE);
+  USE 0 (SPEC `&.1`);
+  USE 0 (CONV_RULE REDUCE_CONV);
+  CHO 0;
+  EXISTS_TAC `CHOICE (X:A->bool)`;
+  ASM_CASES_TAC `(X:A->bool) = EMPTY`;
+  ASM_REWRITE_TAC[EMPTY_SUBSET];
+  USE 1 (MATCH_MP CHOICE_DEF);
+  UND 0 THEN DISCH_ALL_TAC;
+  ABBREV_TAC `(dset:real->bool) = IMAGE (\c. (d (CHOICE (X:A->bool)) (c:A))) C`;
+  SUBGOAL_TAC `FINITE (dset:real->bool)`;
+  EXPAND_TAC"dset";
+  MATCH_MP_TAC FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  USE 6 (MATCH_MP real_FINITE);
+  CHO 6;
+  EXISTS_TAC `a +. &.1`;
+  REWRITE_TAC[SUBSET];
+  GEN_TAC;
+  REWRITE_TAC[open_ball;IN_ELIM_THM'];
+  UND 1;
+  REWRITE_TAC[IN];
+  DISCH_ALL_TAC;
+  UND 4;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  (* ASM (GEN_REWRITE_TAC LAND_CONV) []; *)
+  USE 4(REWRITE_RULE[UNIONS;IN_IMAGE;IN_ELIM_THM']);
+  USE 4(fun t -> AP_THM t `x:A`);
+  UND 1;
+  DISCH_THEN (fun t-> ((MP_TAC t) THEN (ASM_REWRITE_TAC[])) THEN ASSUME_TAC t);
+  DISCH_TAC;
+  USE 8 (REWRITE_RULE[IN_ELIM_THM']);
+  CHO 8;
+  AND 8;
+  USE 9 (CONV_RULE NAME_CONFLICT_CONV);
+  CHO 9;
+  ALL_TAC; (* # "tbb"; *)
+  REWR 8;
+  USE 8(REWRITE_RULE[IN]);
+  USE 8 (MATCH_MP open_ball_dist);
+  AND 9;
+  SUBGOAL_TAC `d (CHOICE (X:A->bool)) (x':A) IN (dset:real->bool)`;
+  EXPAND_TAC"dset";
+  REWRITE_TAC[IN_IMAGE];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  H_MATCH_MP (HYP"6") (HYP"11");
+  USE 2 (REWRITE_RULE[metric_space]);
+  USE 2 (SPECL[`(CHOICE (X:A->bool))`;`(x':A)`;`x:A`]);
+  KILL 4;
+  REWR 2;
+  SUBGOAL_TAC `(X:A->bool) x'`;
+  UND 9;
+  UND 0;
+  SET_TAC[IN;SUBSET];
+  DISCH_TAC;
+  REWR 2;
+  UND 2 THEN DISCH_ALL_TAC;
+  UND 8;
+  UND 12;
+  UND 15;
+  ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let subsequence_rec = prove_by_refinement(
+  `!(X:A->bool) d f C s n r.
+   metric_space(X,d) /\ (totally_bounded(X,d)) /\ (sequence X f) /\
+   (C SUBSET X) /\ (&.0 < r) /\
+   (~FINITE{j| C (f j)} /\ C(f s) /\ (!x y. (C x /\ C y) ==>
+       d x y <. r*twopow(--: (&:n)))) ==>
+   (? C' s'. ((C' SUBSET C) /\ (s < s') /\
+   (~FINITE{j| C' (f j)} /\ C'(f s') /\ (!x y. (C' x /\ C' y) ==>
+        d x y <. r*twopow(--: (&:(SUC n)))))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  USE 1 (REWRITE_RULE[totally_bounded]);
+  USE 1 (SPEC `r*twopow(--: (&:(n+| 2)))`);
+  CHO 1;
+  ASSUME_TAC twopow_pos;
+  USE 8 (SPEC `--: (&: (n+| 2))`);
+  ALL_TAC; (* ## need a few lines here to match Z8 with Z1. *)
+  COPY 4;
+  JOIN 9 8;
+  USE 8 (MATCH_MP REAL_LT_MUL);
+  REWR 1;
+  UND 1 THEN DISCH_ALL_TAC;
+  ALL_TAC ; (* "sr1"  OK TO HERE *)
+  ASSUME_TAC (ISPECL [`UNIV:num->bool`;`f:num->A`;`B:(A->bool)->bool`;`C:A->bool`] INFINITE_PIGEONHOLE);
+  UND 11;
+  ASM_SIMP_TAC[UNIV];
+  H_REWRITE_RULE[HYP "10"] (HYP "3");
+  ASM_REWRITE_TAC [];
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `C INTER (b:A->bool)`;
+  CONV_TAC (quant_right_CONV "s'");
+  SUBCONJ_TAC;
+  REWRITE_TAC[INTER_SUBSET];
+  DISCH_TAC;
+  AND 12;
+  ASM_REWRITE_TAC[];
+  SUBGOAL_TAC `~(FINITE ({i | (C INTER b) ((f:num->A) i)} INTER {i | s <| i}))`;
+  PROOF_BY_CONTR_TAC;
+  (USE 15) (REWRITE_RULE[]);
+  USE 15 (MATCH_MP num_above_finite);
+  UND 12;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ABBREV_TAC `J = ({i | (C INTER b) ((f:num->A) i)} INTER {i | s <| i})`;
+  EXISTS_TAC `CHOICE (J:num->bool)`; (* ok to here *)
+  SUBGOAL_TAC `J (CHOICE (J:num->bool))`;
+  MATCH_MP_TAC (REWRITE_RULE [IN] CHOICE_DEF);
+  PROOF_BY_CONTR_TAC;
+  USE 17 (REWRITE_RULE[]);
+  H_REWRITE_RULE[(HYP "17")] (HYP "15");
+  UND 18;
+  REWRITE_TAC[FINITE_RULES];
+  ALL_TAC; (* "sr2" *)
+  ABBREV_TAC `s' = (CHOICE (J:num->bool))`;
+  EXPAND_TAC "J";
+  REWRITE_TAC[INTER;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  KILL 5 THEN (KILL 2) THEN (KILL 1) THEN (KILL 13) THEN (KILL 12);
+  SUBGOAL_TAC `(X x) /\ (X (y:A))`;
+  UND 21 THEN UND 23 THEN UND 3;
+  MESON_TAC[SUBSET;IN];
+  USE 9 (SPEC `b:A->bool`);
+  H_REWRITE_RULE[HYP "14"] (HYP "1");
+  CHO 2;
+  ALL_TAC; (* #"gg1" *)
+  JOIN 22 24;
+  JOIN 0 5;
+  H_REWRITE_RULE[(HYP "2")] (HYP "0");
+  USE 5 (REWRITE_RULE[IN]);
+  USE 5 (MATCH_MP BALL_DIST);
+  DISCH_ALL_TAC;
+  UND 5;
+  MATCH_MP_TAC (REAL_ARITH `(b = c) ==> ((a<. b) ==> (a<c))`);
+  ALL_TAC;  (* insert here *)
+  REWRITE_TAC[REAL_MUL_ASSOC];
+  REWRITE_TAC[REAL_ARITH `&.2 *.r = r*. (&.2)`];
+  REWRITE_TAC[GSYM REAL_MUL_ASSOC];
+  REWRITE_TAC[REAL_EQ_LMUL];
+  USE 4 (MATCH_MP (REAL_ARITH `&.0 <. r ==> ~(r = &.0)`));
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[TWOPOW_NEG];
+  REWRITE_TAC[ARITH_RULE `(n+|2) = 1 + (SUC n)`];
+  REWRITE_TAC[REAL_POW_ADD;REAL_INV_MUL];
+  REWRITE_TAC [REAL_MUL_ASSOC];
+  REWRITE_TAC[REAL_INV2;REAL_POW_1];
+  REDUCE_TAC;
+  ]);;
+  (* }}} *)
+
+let sequence_subseq = prove_by_refinement(
+  `!(X:A->bool) f (ss:num->num). (sequence X f) ==>
+    (sequence X (f o ss))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[sequence;IMAGE;IN_UNIV;SUBSET;IN_ELIM_THM';o_DEF];
+  REWRITE_TAC[IN];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let cauchy_subseq = prove_by_refinement(
+  `!(X:A->bool) d f. ((metric_space(X,d))/\(totally_bounded(X,d)) /\
+        (sequence X f)) ==>
+     (?ss. (subseq ss) /\ (cauchy_seq(X,d) (f o ss)))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  COPY 0 THEN COPY 1;
+  JOIN 4 3;
+  USE 3 (MATCH_MP totally_bounded_bounded);
+  CHO 3;
+  CHO 3;
+  ALL_TAC; (* {{{ xxx *)
+  ALL_TAC; (* make r pos *)
+  ASSUME_TAC (REAL_ARITH `r <. (&.1 + abs(r))`);
+  ASSUME_TAC (REAL_ARITH `&.0 <. (&.1 + abs(r))`);
+  ABBREV_TAC (`r' = &.1 +. abs(r)`);
+  SUBGOAL_TAC `open_ball(X,d) a r SUBSET open_ball(X,d) (a:A) r'`;
+  ASM_SIMP_TAC[open_ball_nest];
+  DISCH_TAC;
+  JOIN 3 7;
+  USE 3 (MATCH_MP SUBSET_TRANS);
+  KILL 6;
+  KILL 4;
+  ALL_TAC; (* "cs1" *)
+  SUBGOAL_TAC `( !(x:A) y.  (X x) /\ (X y) ==> (d x y <. &.2 *. r'))`;
+  DISCH_ALL_TAC;
+  USE 3 (REWRITE_RULE[SUBSET;IN]);
+  COPY 3;
+  USE 7 (SPEC `x:A`);
+  USE 3 (SPEC `y:A`);
+  H_MATCH_MP (HYP "3") (HYP "6");
+  H_MATCH_MP (HYP "7") (HYP "4");
+  JOIN 9 8;
+  JOIN 0 8;
+  USE 0 (MATCH_MP BALL_DIST);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ABBREV_TAC `cond = (\ ((C:A->bool),(s:num)) n. ~FINITE{j| C (f j)} /\ (C(f s)) /\ (!x y. (C x /\ C y) ==> d x y <. (&.2*.r')*. twopow(--: (&:n))))`;
+  ABBREV_TAC `R = (&.2)*r'`;
+  ALL_TAC ; (* 0 case of recursio *)
+  ALL_TAC; (* cs2 *)
+  SUBGOAL_TAC ` (X SUBSET X) /\ (cond ((X:A->bool),0) 0)`;
+  REWRITE_TAC[SUBSET_REFL];
+  EXPAND_TAC "cond";
+  CONV_TAC (TOP_DEPTH_CONV  GEN_BETA_CONV);
+  USE 2 (REWRITE_RULE[sequence;SUBSET;IN_IMAGE;IN_UNIV]);
+  USE 2 (REWRITE_RULE[IN]);
+  USE 2 (CONV_RULE (NAME_CONFLICT_CONV));
+  SUBGOAL_TAC `!x. X((f:num->A) x)`;
+  ASM_MESON_TAC[];
+  REDUCE_TAC;
+  REWRITE_TAC[TWOPOW_0] THEN REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  SUBGOAL_TAC `{ j | (X:A->bool) (f j) } = (UNIV:num->bool)`;
+  MATCH_MP_TAC EQ_EXT;
+  REWRITE_TAC[IN_ELIM_THM;UNIV];
+  ASM_REWRITE_TAC[];
+  DISCH_THEN REWRT_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[num_infinite];
+  ALL_TAC; (* #save_goal "cs3" *)
+  SUBGOAL_TAC `&.0 <. R`;
+  EXPAND_TAC "R";
+  UND 5;
+  REAL_ARITH_TAC;
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `!cs n. ?cs' . (FST cs SUBSET X) /\ (cond cs n)==>( (FST cs' SUBSET (FST cs)) /\(SND cs <| ((SND:((A->bool)#num)->num) cs') /\ (cond cs' (SUC n))) )`;
+  DISCH_ALL_TAC;
+  CONV_TAC (quant_right_CONV "cs'");
+  DISCH_TAC;
+  AND 11;
+  H_REWRITE_RULE[GSYM o (HYP "6")] (HYP "11");
+  USE 13 (CONV_RULE (SUBS_CONV[GSYM(ISPEC `cs:(A->bool)#num` PAIR)]));
+  USE 13 (CONV_RULE (TOP_DEPTH_CONV GEN_BETA_CONV));
+  JOIN 10 13;
+  JOIN 12 10;
+  JOIN 2 10;
+  JOIN 1 2;
+  JOIN 0 1;
+  USE 0 (MATCH_MP subsequence_rec);
+  CHO 0;
+  CHO 0;
+  EXISTS_TAC `(C':A->bool,s':num)`;
+  ASM_REWRITE_TAC[FST;SND];
+  EXPAND_TAC "cond";
+  (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ALL_TAC; (* "cs4" *)
+  USE 11 (REWRITE_RULE[SKOLEM_THM]);
+  CHO 11;
+  ASSUME_TAC (ISPECL[`((X:A->bool),0)`;`cs':(((A->bool)#num)->(num->(A->bool)#num))`] num_RECURSION);
+  CHO 12;
+  EXISTS_TAC `\i. (SND ((fn : num->(A->bool)#num) i))`;
+  USE 11 (CONV_RULE (quant_left_CONV "n"));
+  USE 11 (SPEC `n:num`);
+  USE 11 (SPEC `(fn:num->(A->bool)#num) n`);
+  AND 12;
+  H_REWRITE_RULE[GSYM o (HYP "12")] (HYP "11");
+  USE 14 (GEN_ALL);
+  ABBREV_TAC `sn = (\i. SND ((fn:num->(A->bool)#num) i))`;
+  ABBREV_TAC `Cn = (\i. FST ((fn:num->(A->bool)#num) i))`;
+  SUBGOAL_TAC `((sn:num->num) 0 = 0) /\ (Cn 0 = (X:A->bool))`;
+  EXPAND_TAC "sn";
+  EXPAND_TAC "Cn";
+  UND 13;
+  MESON_TAC[FST;SND];
+  DISCH_TAC;
+  KILL 13;
+  KILL 11;
+  SUBGOAL_TAC `!(n:num). ((fn n):(A->bool)#num) = (Cn n,sn n)`;
+  EXPAND_TAC "sn";
+  EXPAND_TAC "Cn";
+  REWRITE_TAC[PAIR];
+  DISCH_TAC;
+  H_REWRITE_RULE[(HYP "11")] (HYP"14");
+  KILL 12;
+  KILL 14;
+  KILL 11;
+  KILL 16;
+  KILL 15;
+  ALL_TAC; (* }}} *)
+  ALL_TAC; (* KILL 10; cs4m *)
+  KILL 8;
+  KILL 7;
+  KILL 3;
+  KILL 5;
+  ALL_TAC; (* cs5 *)
+  TYPE_THEN `!n. (Cn n SUBSET X) /\ (cond (Cn n,sn n) n)` SUBGOAL_TAC;
+  INDUCT_TAC;
+  ASM_REWRITE_TAC[];
+  SET_TAC[SUBSET];
+  USE 13 (SPEC `n:num`);
+  REWR 5;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[SUBSET_TRANS];
+  DISCH_TAC;
+  REWR 13;
+  SUBCONJ_TAC;
+  ASM_REWRITE_TAC[SUBSEQ_SUC];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[cauchy_seq];
+  ASM_SIMP_TAC[sequence_subseq];
+  GEN_TAC;
+  TYPE_THEN `!i j. (i <=| j) ==> (Cn j SUBSET (Cn i))` SUBGOAL_TAC;
+  MATCH_MP_TAC SUBSET_SUC2;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ALL_TAC; (* cs6 *)
+  SUBGOAL_TAC `!R e. ?n. (&.0 <. R)/\ (&.0 <. e) ==> R*(twopow(--: (&:n))) <. e`;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[TWOPOW_NEG]; (* cs6b *)
+  ASSUME_TAC (prove(`!n. &.0 < &.2 pow n`,REDUCE_TAC THEN ARITH_TAC));
+  ONCE_REWRITE_TAC[REAL_MUL_AC];
+  ASM_SIMP_TAC[REAL_INV_LT];
+  ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ];
+  CONV_TAC (quant_right_CONV "n");
+  DISCH_ALL_TAC;
+  ASSUME_TAC (SPEC `R'/e` REAL_ARCH_SIMPLE);
+  CHO 14;
+  EXISTS_TAC `n:num`;
+  UND 14;
+  MESON_TAC[POW_2_LT;REAL_LET_TRANS];
+  DISCH_TAC;
+  USE 11 (SPECL [`R:real`;`eps:real`]);
+  CHO 11;
+  EXISTS_TAC `n:num`;
+  DISCH_ALL_TAC;
+  REWR 11;
+  ALL_TAC; (* cs7 *)
+  COPY 3;
+  USE 3 (SPEC `n:num`);
+  AND 3;
+  UND 3;
+  EXPAND_TAC "cond";
+  (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));
+  DISCH_ALL_TAC;
+  COPY 15;
+  USE 15 (SPEC `i:num`);
+  AND 15;
+  UND 15;
+  EXPAND_TAC "cond";
+  (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));
+  DISCH_ALL_TAC;
+  COPY 20;
+  USE 20 (SPEC `j:num`);
+  AND 20;
+  UND 20;
+  EXPAND_TAC "cond";
+  (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));
+  DISCH_ALL_TAC;
+  ABBREV_TAC `e2 = R * twopow (--: (&:n))`;
+  REWRITE_TAC[o_DEF];
+  TYPEL_THEN [`f (sn i)`;`f (sn j)`] (fun t-> (USE 19 (SPECL t)));
+  KILL 27;
+  KILL 23;
+  KILL 25;
+  KILL 21;
+  KILL 16;
+  KILL 9;
+  KILL 6;
+  KILL 28;
+  COPY 8;
+  USE 8 (SPECL [`n:num`;`i:num`]);
+  USE 6 (SPECL [`n:num`;`j:num`]);
+  UND 11;
+  MATCH_MP_TAC (REAL_ARITH `(c < a) ==> ((a < b) ==> (c < b))`);
+  UND 19;
+  DISCH_THEN (MATCH_MP_TAC);
+  UND 6;
+  UND 8;
+  ASM_REWRITE_TAC[];
+  UND 22;
+  UND 26;
+  MESON_TAC[IN;SUBSET];
+  ]);;
+
+  (* }}} *)
+
+let convergent_subseq = prove_by_refinement(
+  `!(X:A->bool) d f. metric_space(X,d) /\ (totally_bounded(X,d)) /\
+     (complete (X,d)) /\ (sequence X f)  ==>
+     ((?(ss:num->num). (subseq ss) /\ (converge (X,d) (f o ss))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+    TYPE_THEN `?ss. (subseq ss) /\ (cauchy_seq(X,d) (f o ss))` SUBGOAL_TAC;
+  ASM_MESON_TAC[cauchy_subseq];
+  DISCH_ALL_TAC;
+  CHO 4;
+  EXISTS_TAC `ss:num->num`;
+  USE 2 (REWRITE_RULE[complete]);
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let dense = euclid_def `!U Z. dense U Z <=>
+  (closure U (Z:A->bool) = UNIONS U)`;;
+
+let hausdorff = euclid_def `hausdorff U  <=> (!x y.
+   (UNIONS U (x:A) /\ UNIONS U y /\ ~(x = y)) ==>
+   (?A B. (U A) /\ (U B) /\ (A x) /\ (B y) /\ (A INTER B = EMPTY)))`;;
+
+let dense_subset = prove_by_refinement(
+  `!U Z. (topology_ U) /\ (dense U (Z:A->bool)) ==>
+      (Z SUBSET (UNIONS U))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[dense];
+  MESON_TAC[subset_closure];
+  ]);;
+  (* }}} *)
+
+let dense_open = prove_by_refinement(
+  `!U Z. (topology_ U) /\ (Z SUBSET (UNIONS U)) ==>
+   (dense U (Z:A->bool) <=>
+    (!A. (open_ U A) /\ ( (A INTER Z) = EMPTY) ==> (A = EMPTY)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_TAC;
+  DISCH_ALL_TAC;
+  COPY 3;
+  COPY 0;
+  JOIN 0 3;
+  USE 0 (MATCH_MP (open_closed));
+  TYPE_THEN `Z SUBSET (UNIONS U DIFF A)` SUBGOAL_TAC;
+  ALL_TAC ; (* do1 *)
+  REWRITE_TAC[DIFF_SUBSET];
+  ONCE_REWRITE_TAC[INTER_COMM];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  JOIN 0 3;
+  JOIN 6 0;
+  USE 0 (MATCH_MP closure_subset);
+  USE 0 (REWRITE_RULE[DIFF_SUBSET]);
+  AND 0;
+  USE 2 (REWRITE_RULE[dense]);
+  H_REWRITE_RULE [(HYP "2")] (HYP "0");
+  (USE 5 (REWRITE_RULE[open_DEF]));
+  USE 5 (MATCH_MP sub_union);
+  USE 5 (REWRITE_RULE[ SUBSET_INTER_ABSORPTION]);
+  USE 5 (ONCE_REWRITE_RULE[INTER_COMM]);
+  ASM_MESON_TAC[];
+  REWRITE_TAC[dense];
+  DISCH_TAC ;
+  MATCH_MP_TAC  EQ_SYM;
+  UND 0;
+  UND 1;
+  SIMP_TAC [closure_open];
+  DISCH_TAC ;
+  SIMP_TAC[closed_UNIV];
+  DISCH_TAC ;
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  USE 2 (SPEC `B:A->bool`);
+  REWR 2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[INTER_EMPTY];
+   ]);;
+  (* }}} *)
+
+let countable_dense = prove_by_refinement(
+  `!(X:A->bool) d. (metric_space(X,d)) /\ (totally_bounded(X,d)) ==>
+     ?Z. (COUNTABLE Z) /\ (dense (top_of_metric(X,d)) Z)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `!r. ?z. (COUNTABLE z) /\ (z SUBSET X) /\ (X = UNIONS (IMAGE (\x. open_ball(X,d) x (twopow(--: (&:r)))) z))` SUBGOAL_TAC;
+  GEN_TAC;
+  COPY 0;
+  COPY 1;
+  JOIN 2 3;
+  USE 2 (MATCH_MP center_FINITE);
+  USE 2 (SPEC `twopow (--: (&:r))`);
+  H_MATCH_MP (HYP "2") (THM (SPEC `(--: (&:r))` twopow_pos));
+  X_CHO 3 `z:A->bool`;
+  EXISTS_TAC `z:A->bool`;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[FINITE_COUNTABLE];
+  ASM_MESON_TAC[];
+  CONV_TAC (quant_left_CONV "z");
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN  `UNIONS (IMAGE z (UNIV:num->bool))` EXISTS_TAC;
+  CONJ_TAC;
+  MATCH_MP_TAC  COUNTABLE_UNIONS;
+  CONJ_TAC;
+  MATCH_MP_TAC  (ISPEC `UNIV:num->bool` COUNTABLE_IMAGE);
+  REWRITE_TAC[NUM_COUNTABLE];
+  TYPE_THEN `z` EXISTS_TAC ;
+  SET_TAC[];
+  GEN_TAC;
+  REWRITE_TAC[IN_IMAGE;IN_UNIV];
+  ASM_MESON_TAC[ ];
+  TYPE_THEN `U = top_of_metric (X,d)` ABBREV_TAC;
+  TYPE_THEN `Z = UNIONS (IMAGE z UNIV)` ABBREV_TAC;
+  TYPE_THEN `topology_ U /\ (Z SUBSET (UNIONS U))` SUBGOAL_TAC;
+  EXPAND_TAC "U";
+  KILL 3;
+  ASM_SIMP_TAC[top_of_metric_top;GSYM top_of_metric_unions];
+  EXPAND_TAC "Z";
+  MATCH_MP_TAC  UNIONS_SUBSET;
+  REWRITE_TAC[IN_IMAGE;IN_UNIV];
+  ASM_MESON_TAC[];
+  SIMP_TAC[dense_open];
+  DISCH_ALL_TAC;
+  GEN_TAC;
+  REWRITE_TAC[open_DEF];
+  MATCH_MP_TAC  (TAUT `( a /\ ~b ==> ~c) ==> (a /\ c ==> b)`);
+  EXPAND_TAC "U";
+  ASM_SIMP_TAC [top_of_metric_nbd];
+  REWRITE_TAC[GSYM MEMBER_NOT_EMPTY];
+  DISCH_ALL_TAC;
+  CHO 9;
+  TYPE_THEN `x` (fun t-> (USE 8 (SPEC t)));
+  REWR 8;
+  X_CHO 8 `eps:real`;
+  ALL_TAC; (*"cd5"*)
+  SUBGOAL_TAC `?r. twopow(--: (&:r)) < eps`;
+  ASSUME_TAC (SPECL [`&.1`;`eps:real`] twopow_eps);
+  USE 10 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  USE 2 (SPEC `r:num`);
+  AND 2;
+  AND 2;
+  TYPE_THEN `x IN X` SUBGOAL_TAC;
+  ASM SET_TAC[IN;SUBSET];
+  ASM ONCE_REWRITE_TAC[];
+  REWRITE_TAC[UNIONS;IN_ELIM_THM';IN_IMAGE];
+  DISCH_THEN CHOOSE_TAC;
+  AND 13;
+  X_CHO 14 `z0:A`;
+  REWR 13;
+  AND 14;
+  EXISTS_TAC `z0:A`;
+  REWRITE_TAC[IN_INTER];
+  USE 13  (REWRITE_RULE[IN]);
+  USE 13 (MATCH_MP open_ball_dist);
+  CONJ_TAC;
+  USE 8 (REWRITE_RULE [open_ball;SUBSET]);
+  AND 8;
+  USE 8 (SPEC `z0:A`);
+  USE 8 (REWRITE_RULE [IN_ELIM_THM']);
+  UND 8;
+  DISCH_THEN (MATCH_MP_TAC  );
+  ALL_TAC; (* "cd6" *)
+  SUBCONJ_TAC;
+  ASM SET_TAC[IN;SUBSET];
+  DISCH_TAC;
+  SUBCONJ_TAC;
+  ASM SET_TAC[IN;SUBSET];
+  DISCH_TAC;
+  UND 13;
+  UND 10;
+  USE 0 (REWRITE_RULE[metric_space]);
+  TYPEL_THEN [`z0`;`x`;`z0`] (fun t-> USE 0 (SPECL t));
+  REWR 0;
+  UND 0;
+  REAL_ARITH_TAC;
+  EXPAND_TAC "Z";
+  REWRITE_TAC[IN_UNIONS;IN_IMAGE;IN_UNIV];
+  UND 14;
+  MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let metric_hausdorff = prove_by_refinement(
+  `! (X:A->bool) d. (metric_space(X,d))==>
+    (hausdorff (top_of_metric(X,d)))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[hausdorff;];
+  ASM_SIMP_TAC [GSYM top_of_metric_unions];
+  DISCH_ALL_TAC;
+  COPY 0;
+  USE 4 (REWRITE_RULE[metric_space]);
+  TYPEL_THEN [`x`;`y`;`x`] (USE 4 o SPECL);
+  REWR 4;
+  TYPE_THEN  `r = d x y` ABBREV_TAC;
+  SUBGOAL_TAC `&.0 <. r`;
+  UND 4;
+  ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN  `open_ball(X,d) x (r/(&.2))`   EXISTS_TAC;
+  TYPE_THEN  `open_ball(X,d) y (r/(&.2))`   EXISTS_TAC;
+  ALL_TAC; (* mh1 *)
+  KILL 4;
+  ASM_SIMP_TAC[open_ball_open];
+  COPY 6;
+  USE 4 (ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1]);
+  ASM_SIMP_TAC[REWRITE_RULE[IN] open_ball_nonempty];
+  PROOF_BY_CONTR_TAC;
+  USE 7 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 7;
+  USE 7 (REWRITE_RULE[IN_INTER]);
+  USE 7 (REWRITE_RULE[IN]);
+  ALL_TAC; (* mh2 *)
+  AND 7;
+  COPY 7;
+  COPY 8;
+  USE 7 (MATCH_MP open_ball_dist);
+  USE 8 (MATCH_MP open_ball_dist);
+  USE 0 (REWRITE_RULE[metric_space]);
+  COPY 0;
+  TYPEL_THEN [`x`;`u`;`y`] (fun t-> (USE 0 (ISPECL t)));
+  TYPEL_THEN [`y`;`u`;`y`] (fun t-> (USE 11 (ISPECL t)));
+  UND 11;
+  UND 0;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `X u` SUBGOAL_TAC;
+  ASM_MESON_TAC[ open_ball_subset;IN;SUBSET];
+  DISCH_THEN (REWRT_TAC);
+  DISCH_ALL_TAC;
+  UND 14;
+  UND 0;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  JOIN 7 8;
+  USE 0 (MATCH_MP (REAL_ARITH `(a <. c) /\ (b < c) ==> b+a < c + c`));
+  USE 0 (CONV_RULE REDUCE_CONV);
+  ASM_MESON_TAC[real_lt];
+  ]);;
+
+  (* }}} *)
+
+(* compactness *)
+
+let compact = euclid_def `compact U (K:A->bool) <=>
+     (K SUBSET UNIONS U) /\ (!V. (K SUBSET UNIONS V ) /\ (V SUBSET U) ==>
+        (?W. (W SUBSET V) /\ (FINITE W) /\ (K SUBSET UNIONS W )))`;;
+
+let closed_compact = prove_by_refinement(
+  `!U K (S:A->bool). ((topology_ U) /\ (compact U K) /\
+     (closed_ U S) /\ (S SUBSET K)) ==> (compact U S)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[compact];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  SUBCONJ_TAC;
+  ASM_MESON_TAC[ SUBSET_TRANS];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `A = UNIONS U DIFF S` ABBREV_TAC;
+  TYPE_THEN `open_ U A` SUBGOAL_TAC ;
+  ASM_MESON_TAC[ closed_open];
+  TYPE_THEN `V' = (A INSERT V)` ABBREV_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `V'` (USE 2 o SPEC);
+  ALL_TAC; (* cc1 *)
+  TYPE_THEN `K SUBSET UNIONS V'` SUBGOAL_TAC;
+  EXPAND_TAC "V'";
+  EXPAND_TAC "A";
+  UND 6;
+  UND 4;
+  UND  1;
+  TYPE_THEN `X = UNIONS U ` ABBREV_TAC;
+  ALL_TAC; (* cc2 *)
+  REWRITE_TAC[SUBSET_UNIONS_INSERT];
+  SET_TAC[SUBSET;UNIONS;DIFF];
+  DISCH_ALL_TAC;
+  TYPE_THEN `V' SUBSET U` SUBGOAL_TAC;
+  EXPAND_TAC "V'";
+  EXPAND_TAC "A";
+  REWRITE_TAC[INSERT_SUBSET];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[IN;open_DEF];
+  DISCH_ALL_TAC;
+  REWR 2;
+  CHO 2;
+  TYPE_THEN `W DELETE A` EXISTS_TAC;
+  CONJ_TAC;
+  AND 2;
+  UND 13;
+  EXPAND_TAC "V'";
+  SET_TAC[SUBSET;INSERT;DELETE];
+  ASM_REWRITE_TAC[FINITE_DELETE];
+  AND 2;
+  AND 2;
+  UND 2;
+  UND 4;
+  UND 1;
+  EXPAND_TAC "A";
+  TYPE_THEN `X = UNIONS U ` ABBREV_TAC;
+  ALL_TAC; (* cc3 *)
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC  UNIONS_DELETE2;
+  CONJ_TAC;
+  ASM_MESON_TAC[SUBSET_TRANS];
+  SET_TAC[INTER;DIFF];
+  ]);;
+  (* }}} *)
+
+
+let compact_closed = prove_by_refinement(
+  `!U (K:A->bool). (topology_ U) /\ (hausdorff U) /\ (compact U K) ==>
+     (closed_ U K)`,
+  (* {{{ proof *)
+
+  [
+   REWRITE_TAC[hausdorff;compact;closed];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[open_DEF];
+  ONCE_ASM_SIMP_TAC[open_nbd];
+  TYPE_THEN `C = UNIONS U DIFF K` ABBREV_TAC;
+  GEN_TAC;
+  CONV_TAC (quant_right_CONV "B");
+  DISCH_ALL_TAC;
+  (* cc1 *)
+  TYPE_THEN `!y. (K y) ==> (?A B. (U A /\ U B /\ A x /\ B y /\ (A INTER B = {})))` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  UND 1;
+  DISCH_THEN MATCH_MP_TAC;
+  CONJ_TAC;
+  UND 5;
+  EXPAND_TAC "C";
+  REWRITE_TAC[DIFF;IN_ELIM_THM'];
+  REWRITE_TAC [IN];
+  MESON_TAC[];
+  CONJ_TAC;
+  UND 6;
+  UND 2;
+  REWRITE_TAC[SUBSET;IN];
+  MESON_TAC[];
+  PROOF_BY_CONTR_TAC;
+  REWR 1;
+  REWR 5;
+  UND 5;
+  UND 6;
+  EXPAND_TAC "C";
+  REWRITE_TAC[DIFF;IN_ELIM_THM'];
+  MESON_TAC[IN];
+  (* cc2 *)
+  DISCH_ALL_TAC;
+  USE 6 (CONV_RULE (quant_left_CONV "B"));
+  USE 6 (CONV_RULE (quant_left_CONV "B"));
+  USE 6 (CONV_RULE (quant_left_CONV "B"));
+  CHO 6;
+  TYPE_THEN `IMAGE B K` (USE 3 o SPEC);
+  TYPE_THEN `K SUBSET UNIONS (IMAGE B K) /\ IMAGE B K SUBSET U` SUBGOAL_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;UNIONS;IN_IMAGE;IN_ELIM_THM'];
+  X_GEN_TAC `y:A`;
+  REWRITE_TAC[IN];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET;IN_IMAGE];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (quant_left_CONV "x'");
+  CONV_TAC (quant_left_CONV "x'");
+  ASM_MESON_TAC[IN];
+  DISCH_TAC;
+  REWR 3;
+  CHO 3;
+  (* cc3 *)
+  AND 3;
+  AND 3;
+  JOIN 8 9;
+  USE 8 (MATCH_MP finite_subset);
+  X_CHO 8 `kc:A->bool`;
+  USE 6 (CONV_RULE (quant_left_CONV "A"));
+  USE 6 (CONV_RULE (quant_left_CONV "A"));
+  CHO 6;
+  (* cc4 *)
+  TYPE_THEN  `K = EMPTY` ASM_CASES_TAC;
+  REWR 4;
+  USE 4 (REWRITE_RULE[DIFF_EMPTY]);
+  EXISTS_TAC `C:A->bool`;
+  ASM_REWRITE_TAC[SUBSET_REFL];
+  EXPAND_TAC "C";
+  USE 0 (REWRITE_RULE[topology]);
+  UND 0;
+  MESON_TAC[topology;IN;SUBSET_REFL];
+  TYPE_THEN `~(kc = EMPTY)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 10 (REWRITE_RULE[]);
+  REWR 8;
+  USE 8 (REWRITE_RULE[IMAGE_CLAUSES]);
+  REWR 3;
+  USE 3 (REWRITE_RULE[UNIONS_0;SUBSET_EMPTY]);
+  ASM_MESON_TAC[ ];
+  REWRITE_TAC[EMPTY_EXISTS];
+  DISCH_THEN CHOOSE_TAC;
+  ALL_TAC; (* cc5 *)
+  TYPE_THEN `INTERS (IMAGE A kc)` EXISTS_TAC;
+  TYPE_THEN `INTERS (IMAGE A kc) INTER (UNIONS (IMAGE B kc)) = EMPTY` SUBGOAL_TAC;
+  REWRITE_TAC[INTER;UNIONS];
+  MATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM';EMPTY];
+  MATCH_MP_TAC  (TAUT `(a ==> ~b )==> ~(a /\ b)`);
+  REWRITE_TAC[IN_INTERS;IN_IMAGE];
+  DISCH_ALL_TAC;
+  CHO 11;
+  AND 11;
+  CHO 13;
+  IN_ELIM 13;
+  REWR 11;
+  USE  12 (CONV_RULE (quant_left_CONV "x"));
+  USE  12 (CONV_RULE (quant_left_CONV "x"));
+  TYPE_THEN `x''` (USE 12 o SPEC);
+  TYPE_THEN `A x''` (USE 12 o SPEC);
+  IN_ELIM 12;
+  REWR 12;
+  TYPE_THEN `x''` (USE 6 o SPEC);
+  TYPE_THEN `K x''` SUBGOAL_TAC;
+  UND 13;
+  AND 8;
+  UND 13;
+  MESON_TAC[SUBSET;IN];
+  DISCH_TAC;
+  REWR 6;
+  USE 6 (REWRITE_RULE [INTER]);
+  (AND 6);
+  (AND 6);
+  (AND 6);
+  (AND 6);
+  USE 6 (fun t-> AP_THM t `x':A`);
+  USE 6 (REWRITE_RULE[IN_ELIM_THM';EMPTY]);
+  ASM_MESON_TAC[IN];
+  DISCH_TAC;
+  ALL_TAC; (* cc6 *)
+  SUBCONJ_TAC;
+  EXPAND_TAC "C";
+  REWRITE_TAC[DIFF_SUBSET];
+  CONJ_TAC;
+  MATCH_MP_TAC  INTERS_SUBSET2;
+  TYPE_THEN `A u` EXISTS_TAC ;
+  REWRITE_TAC[IMAGE;IN_ELIM_THM'];
+  CONJ_TAC;
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  MATCH_MP_TAC  sub_union;
+  TYPE_THEN `u` (USE 6 o SPEC);
+  AND 8;
+  USE 12 (REWRITE_RULE[SUBSET;IN]);
+  ASM_MESON_TAC[IN];
+  UND 3;
+  ASM_REWRITE_TAC[];
+  UND 11;
+  TYPE_THEN `a' = INTERS (IMAGE A kc)` ABBREV_TAC;
+  TYPE_THEN `b' = UNIONS (IMAGE B kc)` ABBREV_TAC;
+  SET_TAC[INTER;SUBSET;EMPTY];
+  DISCH_TAC;
+  ALL_TAC; (* cc7 *)
+  CONJ_TAC;
+  REWRITE_TAC[INTERS;IN_IMAGE;IN_ELIM_THM'];
+  GEN_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  TYPE_THEN `x'` (USE 6 o SPEC);
+  ASM_REWRITE_TAC[];
+  USE 8 (REWRITE_RULE[SUBSET;IN]);
+  ASM_MESON_TAC[IN];
+  MATCH_MP_TAC  open_inters;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;IN_IMAGE;];
+  NAME_CONFLICT_TAC;
+  GEN_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  USE 6 (SPEC `x':A`);
+  USE 8 (REWRITE_RULE[SUBSET;IN]);
+  ASM_MESON_TAC[IN];
+  CONJ_TAC;
+  ASM_MESON_TAC[FINITE_IMAGE];
+  REWRITE_TAC[EMPTY_EXISTS];
+  TYPE_THEN `A u` EXISTS_TAC;
+  REWRITE_TAC[IN_IMAGE];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let compact_totally_bounded = prove_by_refinement(
+  `!(X:A->bool) d.( metric_space(X,d)) /\ (compact (top_of_metric(X,d)) X)
+    ==> (totally_bounded (X,d))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[totally_bounded;compact];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  CONV_TAC (quant_right_CONV "B");
+  DISCH_TAC;
+  TYPE_THEN `IMAGE (\x. open_ball(X,d) x eps) X` (USE 2 o SPEC);
+  TYPE_THEN `X SUBSET UNIONS (IMAGE (\x. open_ball (X,d) x eps) X)` SUBGOAL_TAC;
+  (REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE]);
+  GEN_TAC;
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[IN];
+  DISCH_TAC;
+  CONV_TAC (quant_left_CONV "x'");
+  CONV_TAC (quant_left_CONV "x'");
+  TYPE_THEN `x` EXISTS_TAC;
+  TYPE_THEN `open_ball (X,d) x eps` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[open_ball_nonempty;IN];
+  DISCH_TAC;
+  REWR 2;
+  ALL_TAC; (* ctb1 *)
+  TYPE_THEN `IMAGE (\x. open_ball (X,d) x eps) X SUBSET top_of_metric (X,d)` SUBGOAL_TAC;
+  TYPE_THEN `IMAGE (\x. open_ball (X,d) x eps) X SUBSET open_balls(X,d)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;IN_IMAGE;open_balls;IN_ELIM_THM'];
+  MESON_TAC[IN];
+  MESON_TAC[SUBSET_TRANS;top_of_metric_open_balls];
+  DISCH_TAC;
+  REWR 2;
+  CHO 2;
+  TYPE_THEN `W` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  DISCH_ALL_TAC;
+  AND 2;
+  USE  7 (REWRITE_RULE [SUBSET;IN_IMAGE]);
+  ASM_MESON_TAC[IN];
+  MATCH_MP_TAC  SUBSET_ANTISYM;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `W SUBSET top_of_metric (X,d)` SUBGOAL_TAC;
+  ASM_MESON_TAC[SUBSET_TRANS];
+  DISCH_ALL_TAC;
+  USE 6 (MATCH_MP UNIONS_UNIONS);
+  ASM_MESON_TAC[top_of_metric_unions];
+  ]);;
+  (* }}} *)
+
+(*
+   If W is empty then INTERS W = UNIV, rather than EMPTY.
+   Thus, extra arguments must be provided for this case. *)
+
+let finite_inters = prove_by_refinement(
+  `!U V . (topology_ U) /\ (compact U (UNIONS U)) /\ (INTERS V = EMPTY) /\
+        (!(u:A->bool). (V u) ==> (closed_ U u))
+    ==> (?W. (W SUBSET V) /\ (FINITE W) /\ (INTERS W = EMPTY))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[compact;SUBSET_REFL];
+  DISCH_ALL_TAC;
+  (* {{{ proof *)
+
+  TYPE_THEN `IMAGE (\r. ((UNIONS U) DIFF r)) V` (USE 1 o SPEC);
+  TYPE_THEN `IMAGE (\r. UNIONS U DIFF r) V SUBSET U` SUBGOAL_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;IN_ELIM_THM'];
+  GEN_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[top_univ;IN;SUBSET_DIFF];
+  IN_ELIM 4;
+  TYPE_THEN `x'` (USE 3 o SPEC);
+  REWR 3;
+  USE 3 (REWRITE_RULE[closed;open_DEF]);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  REWR 1;
+  ALL_TAC; (* fi1 *)
+  TYPE_THEN `UNIONS U SUBSET UNIONS (IMAGE (\r. UNIONS U DIFF r) V)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE];
+  GEN_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  NAME_CONFLICT_TAC;
+  USE 2 (REWRITE_RULE[INTERS_EQ_EMPTY]);
+  TYPE_THEN `x` (USE 2 o SPEC);
+  CHO 2;
+  CONV_TAC (quant_left_CONV "x'");
+  CONV_TAC (quant_left_CONV "x'");
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `UNIONS U DIFF a` EXISTS_TAC ;
+  ASM_REWRITE_TAC[IN];
+  REWRITE_TAC[DIFF;IN_ELIM_THM';IN_UNIONS];
+  ASM_MESON_TAC[IN];
+  DISCH_TAC;
+  REWR 1;
+  CHO 1;
+  AND 1;
+  AND 1;
+  JOIN 7 6;
+(*** Modified by JRH for changed theorem name
+  USE 6 (MATCH_MP FINITE_SUBSET_IMAGE);
+ ****)
+  USE 6 (MATCH_MP FINITE_SUBSET_IMAGE_IMP);
+  CHO 6;
+  ALL_TAC; (* fi2*)
+  TYPE_THEN `s'={}` ASM_CASES_TAC ;
+  REWR 6;
+  USE  6 (REWRITE_RULE[IMAGE_CLAUSES;SUBSET_EMPTY]);
+  REWR 1;
+  USE 1 (REWRITE_RULE[UNIONS_0;SUBSET_EMPTY]);
+  USE 1 (REWRITE_RULE [UNIONS_EQ_EMPTY]);
+  UND 1;
+  DISCH_THEN DISJ_CASES_TAC;
+  REWR 4;
+  USE 4 (REWRITE_RULE[SUBSET_EMPTY;IMAGE;EQ_EMPTY;IN_ELIM_THM']);
+  TYPE_THEN `V = {}` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 8 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 8;
+  USE 4 (CONV_RULE (quant_left_CONV "x'"));
+  USE 4 (CONV_RULE (quant_left_CONV "x'"));
+  TYPE_THEN `u` (USE 4 o SPEC);
+  TYPE_THEN `UNIONS {} DIFF u` (USE 4 o SPEC);
+  ASM_MESON_TAC[];
+  USE 2 (REWRITE_RULE[INTERS_EQ_EMPTY]);
+  REWRITE_TAC[EQ_EMPTY];
+  ASM_MESON_TAC[];
+  ALL_TAC; (* fi3*)
+  TYPE_THEN `V` EXISTS_TAC;
+  ASM_REWRITE_TAC[SUBSET_REFL];
+  USE 3 (REWRITE_RULE[closed;open_DEF]);
+  REWR 3;
+  USE 3 (REWRITE_RULE[REWRITE_RULE[IN] IN_SING]);
+  TYPE_THEN `!u. V u ==> (u = EMPTY)` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `u` (USE 3 o SPEC);
+  REWR 3;
+  AND 3;
+  ASM_MESON_TAC[ SUBSET_EMPTY;UNIONS_EQ_EMPTY];
+  DISCH_TAC;
+  TYPE_THEN `V SUBSET {EMPTY}` SUBGOAL_TAC;
+  REWRITE_TAC[INSERT_DEF];
+  REWRITE_TAC[IN_ELIM_THM'];
+  REWRITE_TAC[IN;EMPTY;SUBSET];
+  ASM_MESON_TAC[IN;EMPTY];
+
+  (* }}} *)
+  MESON_TAC[FINITE_SING;FINITE_SUBSET];
+  ALL_TAC; (* fi4*)
+  TYPE_THEN `s'` EXISTS_TAC;
+  ASM_REWRITE_TAC[INTERS_EQ_EMPTY];
+  GEN_TAC;
+  USE 7 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 7;
+  TYPE_THEN `UNIONS U x` ASM_CASES_TAC ;
+  TYPE_THEN `UNIONS W x` SUBGOAL_TAC;
+  USE 1 (REWRITE_RULE[SUBSET;IN]);
+  UND 8;
+  UND 1;
+  MESON_TAC[];
+  DISCH_ALL_TAC;
+  TYPE_THEN `UNIONS (IMAGE (\r. UNIONS U DIFF r) s') x` SUBGOAL_TAC;
+  AND 6;
+  AND 6;
+  USE 6 (MATCH_MP UNIONS_UNIONS);
+  USE 6 (REWRITE_RULE[SUBSET;IN]);
+  ASM_MESON_TAC[];
+  REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM'];
+  REWRITE_TAC[IN];
+  DISCH_ALL_TAC;
+  LEFT 10 "x";
+  LEFT 10 "x";
+  TYPE_THEN `S:A->bool` (X_CHO 10) ;
+  CHO 10;
+  AND 10;
+  REWR 10;
+  TYPE_THEN `S` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  USE 10(REWRITE_RULE[REWRITE_RULE[IN] IN_DIFF]);
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `u` EXISTS_TAC;
+  IN_ELIM 7;
+  ASM_REWRITE_TAC[];
+  PROOF_BY_CONTR_TAC;
+  USE 9 (REWRITE_RULE[]);
+  TYPE_THEN `V u` SUBGOAL_TAC;
+  AND 6;
+  AND 6;
+  USE 11 (REWRITE_RULE[SUBSET;IN]);
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  H_MATCH_MP (HYP "3") (HYP "10");
+  USE 11(REWRITE_RULE[closed;open_DEF]);
+  USE 11 (REWRITE_RULE [SUBSET;IN]);
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+
+(* first part of the proof of cauchy_subseq *)
+let cauchy_subseq_sublemma = prove_by_refinement(
+  `!(X:A->bool) d f. ((metric_space(X,d))/\(totally_bounded(X,d)) /\
+        (sequence X f)) ==>
+    (?R Cn sn cond.
+       (&0 < R) /\
+       (!x y. X x /\ X y ==> d x y < R) /\
+       (cond (X,0) 0) /\
+       (sn 0 = 0) /\ (Cn 0 = X) /\
+       (!n. Cn n SUBSET X /\ cond (Cn n,sn n) n) /\
+       (!n. Cn (SUC n) SUBSET Cn n /\ sn n <| sn (SUC n)) /\
+       (((\ (C,s). \n.
+            (~FINITE {j | C (f j)}) /\
+            (C (f s)) /\
+           (!x y. (C x /\ C y) ==> d x y < R * (twopow (--: (&:n))))) =
+       cond)
+    ))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  COPY 0 THEN COPY 1;
+  JOIN 4 3;
+  USE 3 (MATCH_MP totally_bounded_bounded);
+  CHO 3;
+  CHO 3;
+  ALL_TAC; (* {{{ xxx *)
+  ALL_TAC; (* make r pos *)
+  ASSUME_TAC (REAL_ARITH `r <. (&.1 + abs(r))`);
+  ASSUME_TAC (REAL_ARITH `&.0 <. (&.1 + abs(r))`);
+  ABBREV_TAC (`r' = &.1 +. abs(r)`);
+  SUBGOAL_TAC `open_ball(X,d) a r SUBSET open_ball(X,d) (a:A) r'`;
+  ASM_SIMP_TAC[open_ball_nest];
+  DISCH_TAC;
+  JOIN 3 7;
+  USE 3 (MATCH_MP SUBSET_TRANS);
+  KILL 6;
+  KILL 4;
+  ALL_TAC; (* "cs1" *)
+  SUBGOAL_TAC `( !(x:A) y.  (X x) /\ (X y) ==> (d x y <. &.2 *. r'))`;
+  DISCH_ALL_TAC;
+  USE 3 (REWRITE_RULE[SUBSET;IN]);
+  COPY 3;
+  USE 7 (SPEC `x:A`);
+  USE 3 (SPEC `y:A`);
+  H_MATCH_MP (HYP "3") (HYP "6");
+  H_MATCH_MP (HYP "7") (HYP "4");
+  JOIN 9 8;
+  JOIN 0 8;
+  USE 0 (MATCH_MP BALL_DIST);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ABBREV_TAC `cond = (\ ((C:A->bool),(s:num)) n. ~FINITE{j| C (f j)} /\ (C(f s)) /\ (!x y. (C x /\ C y) ==> d x y <. (&.2*.r')*. twopow(--: (&:n))))`;
+  ABBREV_TAC `R = (&.2)*r'`;
+  ALL_TAC ; (* 0 case of recursio *)
+  ALL_TAC; (* cs2 *)
+  SUBGOAL_TAC ` (X SUBSET X) /\ (cond ((X:A->bool),0) 0)`;
+  REWRITE_TAC[SUBSET_REFL];
+  EXPAND_TAC "cond";
+  CONV_TAC (TOP_DEPTH_CONV  GEN_BETA_CONV);
+  USE 2 (REWRITE_RULE[sequence;SUBSET;IN_IMAGE;IN_UNIV]);
+  USE 2 (REWRITE_RULE[IN]);
+  USE 2 (CONV_RULE (NAME_CONFLICT_CONV));
+  SUBGOAL_TAC `!x. X((f:num->A) x)`;
+  ASM_MESON_TAC[];
+  REDUCE_TAC;
+  REWRITE_TAC[TWOPOW_0] THEN REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  SUBGOAL_TAC `{ j | (X:A->bool) (f j) } = (UNIV:num->bool)`;
+  MATCH_MP_TAC EQ_EXT;
+  REWRITE_TAC[IN_ELIM_THM;UNIV];
+  ASM_REWRITE_TAC[];
+  DISCH_THEN REWRT_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[num_infinite];
+  ALL_TAC; (* #save_goal "cs3" *)
+  SUBGOAL_TAC `&.0 <. R`;
+  EXPAND_TAC "R";
+  UND 5;
+  REAL_ARITH_TAC;
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `!cs n. ?cs' . (FST cs SUBSET X) /\ (cond cs n)==>( (FST cs' SUBSET (FST cs)) /\(SND cs <| ((SND:((A->bool)#num)->num) cs') /\ (cond cs' (SUC n))) )`;
+  DISCH_ALL_TAC;
+  CONV_TAC (quant_right_CONV "cs'");
+  DISCH_TAC;
+  AND 11;
+  H_REWRITE_RULE[GSYM o (HYP "6")] (HYP "11");
+  USE 13 (CONV_RULE (SUBS_CONV[GSYM(ISPEC `cs:(A->bool)#num` PAIR)]));
+  USE 13 (CONV_RULE (TOP_DEPTH_CONV GEN_BETA_CONV));
+  JOIN 10 13;
+  JOIN 12 10;
+  JOIN 2 10;
+  JOIN 1 2;
+  JOIN 0 1;
+  USE 0 (MATCH_MP subsequence_rec);
+  CHO 0;
+  CHO 0;
+  EXISTS_TAC `(C':A->bool,s':num)`;
+  ASM_REWRITE_TAC[FST;SND];
+  EXPAND_TAC "cond";
+  (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ALL_TAC; (* "cs4" *)
+  USE 11 (REWRITE_RULE[SKOLEM_THM]);
+  CHO 11;
+  ASSUME_TAC (ISPECL[`((X:A->bool),0)`;`cs':(((A->bool)#num)->(num->(A->bool)#num))`] num_RECURSION);
+  CHO 12;
+  ALL_TAC;(* EXISTS_TAC `\i. (SND ((fn : num->(A->bool)#num) i))`; *)
+  USE 11 (CONV_RULE (quant_left_CONV "n"));
+  USE 11 (SPEC `n:num`);
+  USE 11 (SPEC `(fn:num->(A->bool)#num) n`);
+  AND 12;
+  H_REWRITE_RULE[GSYM o (HYP "12")] (HYP "11");
+  USE 14 (GEN_ALL);
+  ABBREV_TAC `sn = (\i. SND ((fn:num->(A->bool)#num) i))`;
+  ABBREV_TAC `Cn = (\i. FST ((fn:num->(A->bool)#num) i))`;
+  SUBGOAL_TAC `((sn:num->num) 0 = 0) /\ (Cn 0 = (X:A->bool))`;
+  EXPAND_TAC "sn";
+  EXPAND_TAC "Cn";
+  UND 13;
+  MESON_TAC[FST;SND];
+  DISCH_TAC;
+  KILL 13;
+  KILL 11;
+  SUBGOAL_TAC `!(n:num). ((fn n):(A->bool)#num) = (Cn n,sn n)`;
+  EXPAND_TAC "sn";
+  EXPAND_TAC "Cn";
+  REWRITE_TAC[PAIR];
+  DISCH_TAC;
+  H_REWRITE_RULE[(HYP "11")] (HYP"14");
+  KILL 12;
+  KILL 14;
+  KILL 11;
+  KILL 16;
+  KILL 15;
+  ALL_TAC; (* }}} *)
+  ALL_TAC; (* KILL 10; cs4m *)
+  KILL 8;
+  KILL 7;
+  KILL 3;
+  KILL 5;
+  ALL_TAC; (* cs5 *)
+  TYPE_THEN `!n. (Cn n SUBSET X) /\ (cond (Cn n,sn n) n)` SUBGOAL_TAC;
+  INDUCT_TAC;
+  ASM_REWRITE_TAC[];
+  SET_TAC[SUBSET];
+  USE 13 (SPEC `n:num`);
+  REWR 5;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[SUBSET_TRANS];
+  DISCH_TAC;
+  REWR 13;
+  ALL_TAC; (* TO HERE EVERYTHING WORKS GENERALLY *)
+  TYPE_THEN `R` EXISTS_TAC;
+  TYPE_THEN `Cn` EXISTS_TAC;
+  TYPE_THEN `sn` EXISTS_TAC;
+  TYPE_THEN `cond` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+(* more on metric spaces and topology *)
+
+let subseq_cauchy = prove_by_refinement(
+  `!(X:A->bool) d f s. (metric_space(X,d)) /\
+    (cauchy_seq (X,d) f) /\ (subseq s) /\
+    (converge(X,d) (f o s)) ==> (converge(X,d) f)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[cauchy_seq;converge;sequence_in];
+  DISCH_ALL_TAC;
+  CHO 4;
+  TYPE_THEN `x` EXISTS_TAC ;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  AND 4;
+  TYPE_THEN `eps/(&.2)` (USE 2 o SPEC);
+  TYPE_THEN `eps/(&.2)` (USE 4 o SPEC);
+  CHO 4;
+  CHO 2;
+  CONV_TAC (quant_right_CONV "n");
+  DISCH_ALL_TAC;
+  USE 2 (REWRITE_RULE[REAL_LT_HALF1]);
+  USE 4 (REWRITE_RULE[REAL_LT_HALF1]);
+  REWR 2;
+  REWR 4;
+  TYPE_THEN `n'` EXISTS_TAC ;
+  DISCH_ALL_TAC;
+  TYPE_THEN `n +| n'` (USE 4 o SPEC);
+  USE 4 (REWRITE_RULE[ARITH_RULE `n  <=| n +| n'`]);
+  TYPE_THEN `s(n +| n')` (USE 2 o SPEC);
+  TYPE_THEN `i` (USE 2 o SPEC);
+  TYPE_THEN `n' <=| s (n +| n')` SUBGOAL_TAC;
+  USE 3 (MATCH_MP SEQ_SUBLE);
+  TYPE_THEN `n +| n'` (USE 3 o SPEC);
+  ASM_MESON_TAC[ LE_TRANS; ARITH_RULE `n' <=| n +| n'`];
+  DISCH_TAC;
+  REWR 2;
+  USE 4 (REWRITE_RULE[o_DEF]);
+  (* save_goal"sc1"; *)
+  TYPEL_THEN [`X`;`d`;`x`;`f (s(n +| n'))`;`f i`] (fun t-> ASSUME_TAC (ISPECL t metric_space_triangle));
+  USE 5 (REWRITE_RULE[IN]);
+  REWR 9;
+  USE 1 (MATCH_MP sequence_in);
+  REWR 9;
+  UND 9;
+  UND 4;
+  UND 2;
+  MP_TAC (SPEC `eps:real` REAL_HALF_DOUBLE);
+  TYPE_THEN `a = d (f (s (n +| n'))) (f i)` ABBREV_TAC ;
+  TYPE_THEN `b = d x (f (s (n +| n')))` ABBREV_TAC ;
+  TYPE_THEN `c = d x (f i)` ABBREV_TAC ;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let compact_complete = prove_by_refinement(
+  `!(X:A->bool) d. metric_space(X,d) /\
+     (compact (top_of_metric(X,d)) X) ==>
+     (complete(X,d))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC [complete];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  COPY 0;
+  COPY 1;
+  JOIN 3 4;
+  USE 3 (MATCH_MP compact_totally_bounded);
+  COPY 2;
+  USE 4 (REWRITE_RULE[cauchy_seq]);
+  AND 4;
+  COPY 0;
+  COPY 3;
+  COPY 5;
+  JOIN 7 8;
+  JOIN 6 7;
+  USE 6 (MATCH_MP cauchy_subseq_sublemma);
+  CHO 6;
+  CHO 6;
+  CHO 6;
+  CHO 6;
+  (AND 6);
+  (AND 6);
+  (AND 6);
+  (AND 6);
+  (AND 6);
+  (AND 6);
+  (AND 6);
+  ALL_TAC ; (* cc1 *)
+  MATCH_MP_TAC subseq_cauchy;
+  TYPE_THEN `sn` EXISTS_TAC;
+  ASM_REWRITE_TAC [converge];
+  SUBCONJ_TAC;
+  REWRITE_TAC[SUBSEQ_SUC];
+  ASM_MESON_TAC[ ];
+  DISCH_ALL_TAC;
+  TYPE_THEN `~(INTERS {z | ?n. z = closed_ball(X,d) (f (sn n)) (R* twopow(--: (&:n)))} =EMPTY)` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC ;
+  REWR 15;
+  TYPEL_THEN [`top_of_metric(X,d)`;`{z | ?n. z = closed_ball (X,d) (f(sn n)) (R * twopow (--: (&:n)))}`] (fun t-> ASSUME_TAC (ISPECL t finite_inters));
+  REWR 16;
+  TYPE_THEN `topology_ (top_of_metric (X,d)) /\ compact (top_of_metric (X,d)) (UNIONS (top_of_metric (X,d))) /\ (!u. {z | ?n. z = closed_ball (X,d) (f(sn n)) (R * twopow (--: (&:n)))} u ==> closed_ (top_of_metric (X,d)) u)` SUBGOAL_TAC ;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;];
+  ASM_SIMP_TAC[top_of_metric_top];
+  REWRITE_TAC[IN_ELIM_THM'];
+  ASM_MESON_TAC[closed_ball_closed];
+  DISCH_TAC;
+  REWR 16;
+  CHO 16;
+  ALL_TAC ; (* cc2 *)
+  TYPE_THEN `{z | ?n. z = closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))} = IMAGE (\n. closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))) (UNIV)` SUBGOAL_TAC ;
+  MATCH_MP_TAC  EQ_EXT;
+  GEN_TAC ;
+  REWRITE_TAC[IN_ELIM_THM';INR IN_IMAGE;UNIV];
+  DISCH_TAC;
+  REWR 16;
+  AND 16;
+  AND 16;
+  JOIN 20 19;
+(*** Modified by JRH for new theorem name
+  USE 19 (MATCH_MP FINITE_SUBSET_IMAGE);
+ ***)
+  USE 19 (MATCH_MP FINITE_SUBSET_IMAGE_IMP);
+  CHO 19;
+  AND 19;
+  AND 19;
+(*** JRH --- originally for implicational num_FINITE:
+  USE 20 (MATCH_MP num_FINITE);
+ ***)
+  USE 20 (CONV_RULE (REWR_CONV num_FINITE));
+  CHO 20;
+  TYPE_THEN `f (sn a) IN (INTERS W)` SUBGOAL_TAC ;
+  REWRITE_TAC[IN_INTERS];
+  REWRITE_TAC[IN];
+  DISCH_ALL_TAC;
+  USE 19 (REWRITE_RULE [SUBSET;IN_IMAGE]);
+  TYPE_THEN `t` (USE 19 o SPEC);
+  USE 19 (REWRITE_RULE [IN]);
+  REWR 19;
+  X_CHO 19 `m:num`;
+  USE 20 (SPEC `m:num`);
+  USE 20 (REWRITE_RULE[IN]);
+  REWR 20;
+  TYPE_THEN `Cn m SUBSET closed_ball (X,d) (f (sn m)) (R * twopow (--: (&:m)))` SUBGOAL_TAC ;
+  REWRITE_TAC[SUBSET;closed_ball;IN_ELIM_THM'];
+  USE 12 (SPEC `m:num`);
+  UND 12;
+  EXPAND_TAC "cond";
+  (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[IN;REAL_ARITH `x <. y ==> x <=. y`];
+  REWRITE_TAC[SUBSET;IN];
+  DISCH_THEN (MATCH_MP_TAC  );
+  ALL_TAC ; (* cc3 *)
+  TYPE_THEN `Cn a SUBSET Cn m` SUBGOAL_TAC ;
+  UND 13;
+  UND 20;
+  MESON_TAC [SUBSET_SUC2];
+  REWRITE_TAC[SUBSET;IN];
+  DISCH_THEN (MATCH_MP_TAC  );
+  USE 12 (SPEC `a:num`);
+  AND 12;
+  UND 12;
+  EXPAND_TAC "cond";
+  (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));
+  MESON_TAC[];
+  ASM_REWRITE_TAC [NOT_IN_EMPTY];
+  DISCH_TAC;
+  ALL_TAC ; (* cc4 *)
+  USE 15 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 15;
+  TYPE_THEN `u` EXISTS_TAC ;
+  REWRITE_TAC[IN];
+  SUBCONJ_TAC;
+  USE 15 (REWRITE_RULE [IN_INTERS]);
+  TYPE_THEN `closed_ball (X,d) (f (sn 0)) (R * twopow (--: (&:0)))` (USE 15 o SPEC);
+  USE 15 (REWRITE_RULE[IN_ELIM_THM']);
+  LEFT 15 "n";
+  TYPE_THEN `0` (USE 15 o SPEC);
+  USE 15 (REWRITE_RULE[IN;closed_ball]);
+  USE 15 (REWRITE_RULE [IN_ELIM_THM']);
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  CONV_TAC (quant_right_CONV "n");
+  DISCH_ALL_TAC;
+  TYPEL_THEN [`(&.2)*R`;`eps`] (fun t-> ASSUME_TAC (ISPECL t twopow_eps));
+  CHO 18;
+  REWR 18;
+  TYPE_THEN `n` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `&0 < &2 * R ` SUBGOAL_TAC;
+  MATCH_MP_TAC  REAL_PROP_POS_MUL2;
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  DISCH_ALL_TAC;
+  REWR 18;
+  UND 18;
+  MATCH_MP_TAC  (REAL_ARITH `x <= a ==> ((a < b) ==> (x < b))`);
+  USE 15 (REWRITE_RULE[IN_INTERS]);
+  TYPE_THEN `closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))` (USE 15 o SPEC);
+  USE 15 (REWRITE_RULE[IN_ELIM_THM']);
+  LEFT 15 "n'";
+  USE 15 (SPEC `n:num`);
+  REWR 15;
+  TYPE_THEN `Cn n SUBSET closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))`  SUBGOAL_TAC ;
+  REWRITE_TAC[SUBSET;closed_ball;IN_ELIM_THM'];
+  USE 12 (SPEC `n:num`);
+  UND 12;
+  EXPAND_TAC "cond";
+  (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));
+  REWRITE_TAC[SUBSET];
+  MESON_TAC[IN;REAL_ARITH `x <. y ==> x <=. y`];
+  DISCH_TAC;
+  TYPE_THEN `Cn i SUBSET Cn n` SUBGOAL_TAC ;
+  UND 13;
+  UND 19;
+  MESON_TAC [SUBSET_SUC2];
+  ALL_TAC ; (* REWRITE_TAC[SUBSET;IN];*)
+  DISCH_ALL_TAC;
+  USE 12 (SPEC `i:num`);
+  AND 12;
+  UND 12;
+  EXPAND_TAC "cond";
+  (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));
+  DISCH_ALL_TAC;
+  TYPE_THEN `((f o sn) i)  IN closed_ball (X,d) (f (sn n)) (R * twopow (--: (&:n)))` SUBGOAL_TAC;
+  KILL 1;
+  KILL 0;
+  KILL 2;
+  KILL 3;
+  KILL 5;
+  KILL 4;
+  JOIN  21 18;
+  USE 0 (MATCH_MP SUBSET_TRANS);
+  ALL_TAC; (* "CC5"; *)
+  ASM_MESON_TAC[IN;o_DEF;SUBSET];
+  REWRITE_TAC[GSYM REAL_MUL_ASSOC];
+  UND 15;
+  TYPE_THEN  `r = R * twopow (--: (&:n))` ABBREV_TAC;
+  UND 0;
+  REWRITE_TAC[IN];
+  MESON_TAC[BALL_DIST_CLOSED];
+  ]);;
+
+  (* }}} *)
+
+let countable_cover = prove_by_refinement(
+  `!(X:A->bool) d U. (metric_space(X,d)) /\ (totally_bounded(X,d)) /\
+       (X SUBSET (UNIONS U)) /\ (U SUBSET (top_of_metric(X,d))) ==>
+     (?V. (V SUBSET U) /\ (X SUBSET (UNIONS V)) /\ (COUNTABLE V))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `(?Z. COUNTABLE Z /\ dense (top_of_metric (X,d)) Z)` SUBGOAL_TAC;
+  ASM_MESON_TAC[countable_dense];
+  DISCH_ALL_TAC;
+  CHO 4;
+  TYPE_THEN  `S = {(z,n) | ?A. (Z z) /\ (open_ball(X,d) z (twopow(--: (&:n))) SUBSET A) /\ U A}` ABBREV_TAC ;
+  TYPE_THEN `COUNTABLE S` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (INST_TYPE [`:A#num`,`:A`] COUNTABLE_IMAGE);
+  TYPE_THEN `{(z,(n:num)) | (Z z) /\ (UNIV n)}` EXISTS_TAC ;
+  CONJ_TAC ;
+  IMATCH_MP_TAC  countable_prod;
+  ASM_REWRITE_TAC [NUM_COUNTABLE];
+  TYPE_THEN `I:(A#num) -> (A#num)` EXISTS_TAC;
+  REWRITE_TAC[IMAGE_I;UNIV;SUBSET];
+  IN_OUT_TAC;
+  EXPAND_TAC "S";
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  ASM_MESON_TAC[GSPEC];
+  DISCH_TAC;
+  TYPE_THEN `!z n. (S (z,n) ==> ?A. Z z /\ open_ball (X,d) z (twopow (--: (&:n))) SUBSET A /\ U A)` SUBGOAL_TAC;
+  EXPAND_TAC "S";
+  REWRITE_TAC[IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  CHO 7;
+  CHO 7;
+  AND 7;
+  CHO 8;
+  TYPE_THEN `A` EXISTS_TAC;
+  ASM_MESON_TAC[PAIR_EQ];
+  DISCH_TAC ;
+  LEFT 7 "A";
+  LEFT 7 "A";
+  LEFT 7 "A";
+  CHO 7;
+  ALL_TAC ; (* "cc1"; *)
+  TYPE_THEN `IMAGE (\ (z,n). A z n) S` EXISTS_TAC;
+  SUBCONJ_TAC ;
+  REWRITE_TAC[SUBSET;IN_IMAGE];
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `Azn:A->bool`  X_GEN_TAC;
+  DISCH_THEN (X_CHOOSE_TAC `zn:A#num`);
+  USE 8 (SUBS [(ISPEC `zn:A#num` (GSYM PAIR))]);
+  USE 8 (GBETA_RULE);
+  TYPE_THEN `z = FST zn`  ABBREV_TAC ;
+  TYPE_THEN `n = SND zn`  ABBREV_TAC ;
+  IN_OUT_TAC;
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  CONJ_TAC ;
+  REWRITE_TAC[SUBSET];
+  USE 2 (REWRITE_RULE[SUBSET;IN_UNIONS]);
+  IN_OUT_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `x` (  USE 6 o SPEC);
+  REWR 6;
+  CHO 6;
+  TYPE_THEN `top_of_metric (X,d) t` SUBGOAL_TAC;
+  AND 6;
+  UND 10;
+  UND 5;
+  REWRITE_TAC[SUBSET;IN];
+  MESON_TAC[];
+  ASM_SIMP_TAC[top_of_metric_nbd];
+  DISCH_ALL_TAC;
+  TYPE_THEN `x` (USE 11 o SPEC);
+  IN_OUT_TAC;
+  REWR 0;
+  CHO 0;
+  AND 0;
+  ASSUME_TAC (SPECL[`&.1`;`r:real`] twopow_eps);
+  CHO 13;
+  USE 13 (CONV_RULE REDUCE_CONV);
+  REWR 13;
+  TYPEL_THEN [`X`;`d`;`x`] (fun t-> USE 13 (MATCH_MP (SPECL t open_ball_nest)));
+  JOIN 13 0;
+  USE 0 (MATCH_MP SUBSET_TRANS);
+  ASSUME_TAC (SPEC `(--: (&:n))` twopow_pos);
+  WITH 3 (MATCH_MP top_of_metric_top);
+  AND 7;
+  COPY 7;
+  COPY 14;
+  JOIN  14 7;
+  USE 7 (MATCH_MP dense_subset);
+  UND 16;
+  ASM_SIMP_TAC [dense_open];
+  DISCH_TAC ;
+  TYPE_THEN `(open_ball(X,d) x (twopow (--: (&:(n+1)))))` (USE 14 o SPEC);
+  ALL_TAC ; (* "cc2"; *)
+  TYPE_THEN `open_ball (X,d) x (twopow (--: (&:(n +| 1)))) x` SUBGOAL_TAC;
+  IMATCH_MP_TAC  open_ball_nonempty;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `?z. (Z z) /\ (open_ball(X,d) x (twopow (--: (&:(n+1)))) z)` SUBGOAL_TAC;
+  UND 14;
+  REWRITE_TAC[open_DEF];
+  ASM_SIMP_TAC[open_ball_open];
+  UND 16;
+  TYPE_THEN `B = open_ball (X,d) x (twopow (--: (&:(n +| 1))))` ABBREV_TAC ;
+  REWRITE_TAC[INTER;IN];
+  POP_ASSUM_LIST (fun t->ALL_TAC);
+  REWRITE_TAC[EMPTY_NOT_EXISTS];
+  REWRITE_TAC[IN_ELIM_THM'];
+  MESON_TAC[];
+  DISCH_TAC;
+  CHO 18;
+  AND 18;
+  WITH 3 (MATCH_MP top_of_metric_unions);
+  USE 20 (SYM);
+  REWR 7;
+  TYPE_THEN `X z` SUBGOAL_TAC;
+  UND 7;
+  UND 19;
+  MESON_TAC[SUBSET;IN];
+  DISCH_TAC;
+  TYPE_THEN `open_ball (X,d) z (twopow (--: (&:(n +| 1)))) x` SUBGOAL_TAC;
+  ASM_MESON_TAC[ball_symm];
+  DISCH_TAC;
+  ALL_TAC ; (* "cc3"; *)
+  REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM'];
+  REWRITE_TAC[IN];
+  LEFT_TAC "x";
+  LEFT_TAC "x";
+  TYPE_THEN `(z,n+1)` EXISTS_TAC;
+  TYPE_THEN `A z (n+1)` EXISTS_TAC;
+  GBETA_TAC;
+  EXPAND_TAC "S";
+  REWRITE_TAC[IN_ELIM_THM'];
+  LEFT_TAC "z'";
+  TYPE_THEN `z` EXISTS_TAC;
+  LEFT_TAC "n'";
+  TYPE_THEN `n + 1` EXISTS_TAC;
+  REWRITE_TAC[];
+  LEFT_TAC "A";
+  TYPE_THEN `t` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ALL_TAC ; (* "cc4"; *)
+  SUBCONJ_TAC ;
+  TYPE_THEN `open_ball (X,d) z (twopow (--: (&:(n +| 1)))) SUBSET (open_ball (X,d) x (twopow (--: (&:n))))`  SUBGOAL_TAC ;
+  CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [(GSYM twopow_double)]));
+  IMATCH_MP_TAC  ball_subset_ball;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  MESON_TAC[SUBSET_TRANS];
+  DISCH_TAC ;
+  TYPEL_THEN [`z`;`n+1`] (fun t -> USE 10 (SPECL t));
+  USE 10 (REWRITE_RULE [SUBSET ]);
+  IN_OUT_TAC ;
+  ALL_TAC ; (* "cc5" *)
+  TYPE_THEN `S (z,n +| 1)` SUBGOAL_TAC ;
+  EXPAND_TAC "S";
+  REWRITE_TAC[IN_ELIM_THM' ];
+  TYPE_THEN `z` EXISTS_TAC ;
+  TYPE_THEN `n + 1` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `t` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC ;
+  REWR 13;
+  AND  13;
+  TYPE_THEN `x` (USE 25 o SPEC );
+  UND 25;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `S` ( fun t-> IMATCH_MP_TAC  ( ISPEC t COUNTABLE_IMAGE)) ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `\ (z,n). A z n` EXISTS_TAC;
+  REWRITE_TAC[SUBSET_REFL ];
+  ]);;
+
+  (* }}} *)
+
+let complete_compact = prove_by_refinement(
+  `!(X:A->bool) d . (metric_space(X,d)) /\ (totally_bounded(X,d)) /\
+  (complete (X,d)) ==> (compact (top_of_metric(X,d)) X)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[compact];
+  CONJ_TAC ;
+  UND 0;
+  SIMP_TAC[GSYM   top_of_metric_unions ];
+  REWRITE_TAC[SUBSET_REFL];
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `(?V'. (V' SUBSET V) /\ (X SUBSET (UNIONS V')) /\ (COUNTABLE V'))` SUBGOAL_TAC ;
+  IMATCH_MP_TAC  countable_cover;
+  TYPE_THEN `d` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_ALL_TAC;
+  ALL_TAC; (* ASM_MESON_TAC[]; *)
+  ALL_TAC; (* DISCH_THEN (CHOOSE_THEN MP_TAC); *)
+  ALL_TAC; (* DISCH_ALL_TAC;  *)
+  USE 7 (REWRITE_RULE[COUNTABLE;GE_C;UNIV]);
+  IN_OUT_TAC;
+  CHO 0;
+  TYPE_THEN `B = \i. (IMAGE f { u | (u <=| i )  /\ V' (f u)}) ` ABBREV_TAC ;
+  TYPE_THEN `?i . UNIONS (B i ) = X ` ASM_CASES_TAC;
+  CHO 9;
+  TYPE_THEN `B i ` EXISTS_TAC;
+  EXPAND_TAC "B";
+  CONJ_TAC;
+  REWRITE_TAC[IMAGE;SUBSET ;IN  ];
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  NAME_CONFLICT_TAC;
+  UND 2;
+  REWRITE_TAC[SUBSET;IN ];
+  MESON_TAC[];
+  CONJ_TAC ;
+  IMATCH_MP_TAC  FINITE_IMAGE;
+  IMATCH_MP_TAC  FINITE_SUBSET;
+  TYPE_THEN `{u | u <=| i }` EXISTS_TAC;
+  REWRITE_TAC[FINITE_NUMSEG_LE;SUBSET;IN ;IN_ELIM_THM' ];
+  MESON_TAC[];
+  UND 9;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  EXPAND_TAC "B";
+  REWRITE_TAC[SUBSET_REFL ];
+  ALL_TAC ; (* "sv1" *)
+  LEFT 9 "i";
+  TYPE_THEN `UNIONS V' SUBSET X` SUBGOAL_TAC;
+  JOIN 2 3;
+  USE 2 (MATCH_MP SUBSET_TRANS );
+  USE 2 (MATCH_MP UNIONS_UNIONS );
+  UND 2;
+  ASM_MESON_TAC[top_of_metric_unions ];
+  DISCH_TAC ;
+  TYPE_THEN `!i. UNIONS (B i) SUBSET X` SUBGOAL_TAC;
+  GEN_TAC;
+  UND 10;
+  EXPAND_TAC "B";
+  REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE  ];
+  REWRITE_TAC[IN;IN_ELIM_THM'  ];
+  MESON_TAC[];
+  DISCH_TAC ;
+  COPY 11;
+  COPY 9;
+  JOIN 12 13;
+  LEFT 12 "i";
+  USE 12 (REWRITE_RULE [GSYM PSUBSET ;PSUBSET_MEMBER;IN  ]);
+  LEFT 12 "y";
+  LEFT 12 "y";
+  CHO 12;
+  ALL_TAC ; (* "sv2" *)
+  TYPE_THEN `(?ss. subseq ss /\ converge (X,d) (y o ss))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  convergent_subseq ;
+  ASM_REWRITE_TAC[sequence];
+  REWRITE_TAC[SUBSET;UNIV;IN_IMAGE  ];
+  REWRITE_TAC[IN];
+  ASM_MESON_TAC[];
+  DISCH_TAC;
+  CHO 13;
+  AND 13;
+  COPY 13;
+  USE 13 (REWRITE_RULE[converge;IN ]);
+  CHO 13;
+  AND 13;
+  USE 1 (REWRITE_RULE[SUBSET;UNIONS;IN;IN_ELIM_THM' ]);
+  TYPE_THEN `x` (USE 1 o SPEC);
+  REWR 1;
+  CHO 1;
+  TYPE_THEN `u` (USE 0 o SPEC);
+  REWR 0;
+  X_CHO 0 `j:num`;
+  TYPE_THEN `(UNIONS (B j)) x` SUBGOAL_TAC;
+  EXPAND_TAC "B";
+  REWRITE_TAC[UNIONS;IN_IMAGE ];
+  REWRITE_TAC[IN;IN_ELIM_THM'  ];
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `j` EXISTS_TAC;
+  ASM_MESON_TAC[ARITH_RULE `j <=| j`];
+  DISCH_TAC;
+  TYPE_THEN `u SUBSET (UNIONS (B j))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  sub_union;
+  EXPAND_TAC "B";
+  REWRITE_TAC[IMAGE;IN;IN_ELIM_THM'  ];
+  TYPE_THEN `j` EXISTS_TAC;
+  ASM_MESON_TAC[ARITH_RULE `j <=| j`];
+  DISCH_TAC;
+  JOIN 2 3;
+  USE 2 (MATCH_MP SUBSET_TRANS);
+  ALL_TAC ; (* "sv3" *)
+  TYPE_THEN `top_of_metric(X,d) u` SUBGOAL_TAC;
+  USE 2 (REWRITE_RULE[SUBSET;IN ]);
+  ASM_MESON_TAC[];
+  ASM_SIMP_TAC[top_of_metric_nbd];
+  REWRITE_TAC[IN ];
+  DISCH_ALL_TAC;
+  TYPE_THEN `x` (USE 19 o SPEC);
+  REWR 1;
+  REWR 19;
+  CHO 19;
+  TYPE_THEN `r` (USE 13 o SPEC);
+  CHO 13;
+  REWR 13;
+  REWR 0;
+  TYPE_THEN `n +| (j)` (USE 13 o SPEC);
+  USE 13 (REWRITE_RULE[ARITH_RULE `n<=| (n+| a)`]);
+  AND 19;
+  TYPE_THEN `u ((y o ss) (n +| j) )` SUBGOAL_TAC;
+  USE 19 (REWRITE_RULE[SUBSET;open_ball;IN ;IN_ELIM_THM' ]);
+  TYPE_THEN `((y o ss) (n +| j))` (USE 19 o SPEC);
+  ASM_REWRITE_TAC[];
+  UND 19;
+  DISCH_THEN IMATCH_MP_TAC  ;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(ss (n +| j))` (USE 12 o SPEC);
+  ASM_REWRITE_TAC[o_DEF ];
+  DISCH_TAC;
+  TYPE_THEN `z = ((y o ss) (n +| j))` ABBREV_TAC;
+  TYPE_THEN `UNIONS (B (ss (n+| j))) ((y o ss) (n +| j))` SUBGOAL_TAC;
+  EXPAND_TAC "B";
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[UNIONS;IN_IMAGE];
+  REWRITE_TAC[IN; IN_ELIM_THM'];
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `j` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  (ARITH_RULE `j <= a /\ a <= ss(a) ==> (j <=| (ss (a)))`);
+  ASM_SIMP_TAC[SEQ_SUBLE];
+  ARITH_TAC;
+  REWRITE_TAC[o_DEF];
+  TYPE_THEN `ss(n +| j)` (USE 12 o SPEC);
+  UND 12;
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let uniformly_continuous = euclid_def
+  `uniformly_continuous (f:A->B) ((X:A->bool),dX) ((Y:B->bool),dY) <=>
+  (!epsilon. ?delta. (&.0 < epsilon) ==> (&.0 <. delta) /\
+    (!x y. (X x) /\ (X y) /\
+         (dX x y < delta) ==> (dY (f x) (f y) < epsilon)))`;;
+
+(* NB. It is not part of the hypothesis on metric_continuous
+   that the IMAGE of f on X is contained in Y.  Hence the
+   extra hypothesis.  *)
+
+let compact_uniformly_continuous = prove_by_refinement(
+  `!f X dX Y dY. metric_continuous f (X,dX) (Y,dY) /\ (metric_space(X,dX))
+    /\ (metric_space(Y,dY)) /\ (compact(top_of_metric(X,dX)) X) /\
+    (IMAGE f X SUBSET Y) ==>
+    uniformly_continuous (f:A->B) ((X:A->bool),dX) ((Y:B->bool),dY)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[uniformly_continuous;metric_continuous;metric_continuous_pt];
+  DISCH_ALL_TAC;
+  GEN_TAC;
+  LEFT 0 "epsilon";
+  TYPE_THEN `epsilon/(&.2)` (USE 0 o SPEC);
+  LEFT 0 "delta";
+  CHO 0;
+  TYPE_THEN `cov = IMAGE (\x. open_ball (X,dX) x ((delta x)/(&.2))) X` ABBREV_TAC;
+  USE 3 (REWRITE_RULE[compact]);
+  UND 3;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;SUBSET_REFL ];
+  DISCH_TAC;
+  TYPE_THEN `cov` (USE 3 o SPEC);
+  CONV_TAC (quant_right_CONV  "delta");
+  DISCH_TAC;
+  WITH 6 (ONCE_REWRITE_RULE [GSYM REAL_LT_HALF1]);
+  REWR 0;
+  TYPE_THEN `!x. (&.0 < (delta x)/(&.2))` SUBGOAL_TAC;
+  ASM_MESON_TAC[REAL_LT_HALF1];
+  DISCH_TAC;
+  TYPE_THEN `X SUBSET UNIONS cov /\ cov SUBSET top_of_metric (X,dX)` SUBGOAL_TAC;
+  SUBCONJ_TAC;
+  REWRITE_TAC[SUBSET;UNIONS;IN;IN_ELIM_THM' ];
+  DISCH_ALL_TAC;
+  TYPE_THEN `open_ball (X,dX) x ((delta x)/(&.2))` EXISTS_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "cov";
+  REWRITE_TAC[IMAGE;IN ;IN_ELIM_THM'  ];
+  ASM_MESON_TAC[];
+  IMATCH_MP_TAC  (REWRITE_RULE[IN] open_ball_nonempty);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC ;
+  REWRITE_TAC[SUBSET;IN ];
+  EXPAND_TAC "cov";
+  REWRITE_TAC[IMAGE;IN;IN_ELIM_THM' ];
+  NAME_CONFLICT_TAC;
+  DISCH_ALL_TAC;
+  CHO 10;
+  AND 10;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[open_ball_open];
+  DISCH_TAC;
+  REWR 3;
+  CHO 3;
+  ALL_TAC; (* "cc1"; *)
+  AND 3;
+  AND 3;
+  JOIN 11 10;
+  UND 10;
+  EXPAND_TAC "cov";
+  DISCH_TAC;
+(*** Modified by JRH for changed theorem name
+  USE 10 (MATCH_MP FINITE_SUBSET_IMAGE);
+ ***)
+  USE 10 (MATCH_MP FINITE_SUBSET_IMAGE_IMP);
+  X_CHO 10 `S:A->bool`;
+  TYPE_THEN `ds = IMAGE delta S` ABBREV_TAC ;
+  TYPE_THEN `(FINITE ds) /\ ( !x. (ds x) ==> (&.0 <. x) )` SUBGOAL_TAC;
+  EXPAND_TAC "ds";
+  CONJ_TAC;
+  IMATCH_MP_TAC  FINITE_IMAGE ;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE;IN;IN_ELIM_THM' ];
+  NAME_CONFLICT_TAC ;
+  DISCH_ALL_TAC;
+  CHO 12;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  USE 12 (MATCH_MP min_finite_delta);
+  CHO 12;
+  TYPE_THEN `delta'/(&.2)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ALL_TAC ; (* "cc2" *)
+  ASM_REWRITE_TAC[REAL_LT_HALF1];
+  DISCH_ALL_TAC;
+  AND 10;
+  AND 10;
+  USE 10(  MATCH_MP UNIONS_UNIONS );
+  JOIN 3 10;
+  USE 3 (MATCH_MP SUBSET_TRANS);
+  USE 3 (REWRITE_RULE [SUBSET;IN;UNIONS;IN_ELIM_THM'  ]);
+  USE 3 (REWRITE_RULE[IMAGE;IN ;IN_ELIM_THM' ]);
+  TYPE_THEN `x` (WITH 3 o SPEC);
+  TYPE_THEN `y` (WITH 3 o SPEC);
+  KILL 3; (* start of yest *)
+  H_MATCH_MP (HYP "18")(HYP "14");
+  H_MATCH_MP (HYP "10") (HYP "13");
+  CHO 19;
+  CHO 3;
+  AND 19;
+  CHO 20;
+  AND 20;
+  USE 20 (REWRITE_RULE [open_ball]);
+  REWR 19;
+  USE 19 (REWRITE_RULE [IN_ELIM_THM']);
+  AND 19;
+  AND 19;
+  TYPE_THEN `dX x' x < delta x'` SUBGOAL_TAC;
+  UND 19;
+  IMATCH_MP_TAC  (REAL_ARITH `((u <. v) ==> (a< u)==>(a <v))`);
+  TYPE_THEN `x'` (USE 8 o SPEC);
+  UND 8;
+  REWRITE_TAC[REAL_LT_HALF2;REAL_LT_HALF1 ];
+  DISCH_TAC;
+  ALL_TAC ; (* cc3 *)
+  TYPE_THEN `dX x' y < delta x'` SUBGOAL_TAC;
+  CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [GSYM REAL_HALF_DOUBLE]));
+  IMATCH_MP_TAC  (REAL_ARITH `(dX x' x <. u) /\ (dX x y <. u) /\ (dX x' y <= dX x' x +. dX x y) ==> (dX x' y <. u + u)`);
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 15;
+  IMATCH_MP_TAC  (REAL_ARITH `((u <=. v) ==> (a< u)==>(a <v))`);
+  IMATCH_MP_TAC  (REAL_ARITH `(u + u) <= (v +. v) ==> (u <= v)`);
+  REWRITE_TAC[REAL_HALF_DOUBLE];
+  AND 12;
+  UND 12;
+  DISCH_THEN (MATCH_MP_TAC);
+  EXPAND_TAC "ds";
+  REWRITE_TAC[IMAGE;IN; IN_ELIM_THM' ];
+  UND 21;
+  MESON_TAC[];
+  IMATCH_MP_TAC  metric_space_triangle;
+  TYPE_THEN `X` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  CONV_TAC (RAND_CONV (ONCE_REWRITE_CONV [GSYM REAL_HALF_DOUBLE]));
+  TYPE_THEN `(dY (f x) (f x') <. u0) /\ (dY (f x') (f y) <. u0) /\ (dY (f x) (f y) <= (dY (f x) (f x')) + (dY (f x') (f y))) ==> ((dY (f x) (f y)) < u0 + u0)` (fun t-> (IMATCH_MP_TAC    (REAL_ARITH t)));
+  TYPE_THEN `x'` (USE 0 o SPEC);
+  AND 0;
+  USE 0 (REWRITE_RULE[IN ]);
+  TYPE_THEN `y` (WITH  0  o SPEC);
+  TYPE_THEN `x` (USE 0 o  SPEC);
+  ALL_TAC; (* cc4 *)
+  TYPE_THEN `Y (f x) /\ Y (f y) /\ Y (f x')` SUBGOAL_TAC;
+  UND 4;
+  REWRITE_TAC[SUBSET;IN_IMAGE;  ];
+  REWRITE_TAC[IN ];
+  UND 13;
+  UND 14;
+  UND 22;
+  MESON_TAC[];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  TYPE_THEN `dY (f x) (f x') = dY (f x') (f x)` SUBGOAL_TAC;
+  UND 2;
+  UND 28;
+  UND 30;
+  TYPEL_THEN [`Y`;`dY`;`f x`;`f x'`] (fun t-> MP_TAC(ISPECL t metric_space_symm));
+  MESON_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  UND 0;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 27;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  TYPEL_THEN [`Y`;`dY`;`f x`;`f x'`;`f y`] (fun t-> MP_TAC(ISPECL t metric_space_triangle));
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+(* I'm rather surprised that this lemma did not need the
+   hypothesis that U and- V are topologies. *)
+
+let image_compact = prove_by_refinement(
+  `!U V (f:A->B) K. (continuous f U V ) /\
+      (compact U K) /\ (IMAGE f K SUBSET (UNIONS V))
+  ==> (compact V (IMAGE f K))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[compact];
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  TYPE_THEN `cov = IMAGE (\v. preimage (UNIONS U) f v ) V'`  ABBREV_TAC ;
+  TYPE_THEN `cov SUBSET U` SUBGOAL_TAC ;
+  EXPAND_TAC "cov";
+  REWRITE_TAC[SUBSET;IN_IMAGE ];
+  NAME_CONFLICT_TAC;
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  CHO 6;
+  AND 6;
+  ASM_REWRITE_TAC[];
+  USE 4 (REWRITE_RULE[SUBSET]);
+  TYPE_THEN `x'` (USE 4 o SPEC);
+  REWR 4;
+  UND 4;
+  UND 0;
+  REWRITE_TAC[continuous];
+  MESON_TAC[];
+  TYPE_THEN `K SUBSET UNIONS cov` SUBGOAL_TAC;
+  ALL_TAC; (* ic1 *)
+  UND 3;
+  REWRITE_TAC[SUBSET;IN_IMAGE ];
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[IN];
+  DISCH_ALL_TAC;
+  LEFT 3 "x'";
+  DISCH_ALL_TAC;
+  LEFT 3 "x'";
+  TYPE_THEN `x'` (USE 3 o SPEC);
+  TYPE_THEN `f x'` (USE 3 o SPEC);
+  REWR 3;
+  UND 3;
+  REWRITE_TAC[UNIONS;IN;IN_ELIM_THM'  ];
+  USE 5 (REWRITE_RULE[IMAGE]);
+  EXPAND_TAC "cov";
+  REWRITE_TAC[IN_ELIM_THM';IN ];
+  DISCH_ALL_TAC;
+  CHO 5;
+  CONV_TAC (quant_left_CONV "x");
+  CONV_TAC (quant_left_CONV "x");
+  TYPE_THEN `u` EXISTS_TAC;
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `preimage (UNIONS U) f u` EXISTS_TAC;
+  ASM_REWRITE_TAC[preimage;IN_ELIM_THM' ;IN ];
+  USE 1 (REWRITE_RULE[compact;SUBSET;IN  ]);
+  AND 1;
+  UND 7;
+  UND 6;
+  MESON_TAC[];
+  DISCH_ALL_TAC;
+  USE 1 (REWRITE_RULE[compact]);
+  AND 1;
+  TYPE_THEN `cov` (USE 1 o SPEC);
+  REWR 1;
+  CHO 1;
+  ALL_TAC ; (* ic2 *)
+  TYPE_THEN `(?V''. V'' SUBSET V' /\ FINITE V'' /\ (W = IMAGE (\v. preimage (UNIONS U) f v) V''))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  finite_subset ;
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  CHO 9;
+  TYPE_THEN `V''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[SUBSET;IN_IMAGE];
+  REWRITE_TAC[IN;UNIONS;IN_ELIM_THM' ];
+  NAME_CONFLICT_TAC;
+  CONV_TAC (quant_left_CONV "x'");
+  CONV_TAC (quant_left_CONV "x'");
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  AND 1;
+  AND 1;
+  USE 1 (REWRITE_RULE[SUBSET;UNIONS;IN;IN_ELIM_THM'  ]);
+  TYPE_THEN `x'` (USE 1 o SPEC);
+  REWR 1;
+  CHO 1;
+  AND 1;
+  USE 14 (REWRITE_RULE[IMAGE;IN ;IN_ELIM_THM' ]);
+  TYPE_THEN `u':B->bool` (X_CHO 14);
+  TYPE_THEN `u'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 1;
+  ASM_REWRITE_TAC[preimage;IN;IN_ELIM_THM' ];
+  MESON_TAC [];
+  ]);;
+  (* }}} *)
+
+let metric_bounded = euclid_def
+  `metric_bounded (X,d) <=>
+     ?(x:A) r. X SUBSET (open_ball(X,d) x r)`;;
+
+let euclid_ball_cube = prove_by_refinement(
+  `!n x r. ?N. (open_ball(euclid n,d_euclid) x r) SUBSET
+      {x | euclid n x /\ (!i. abs (x i) <= &N)}`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM';open_ball; ];
+  ASSUME_TAC  REAL_ARCH_SIMPLE;
+  TYPE_THEN ` (d_euclid x (\i. &.0) +. r)` (USE 0 o SPEC);
+  X_CHO 0 `N:num`;
+  TYPE_THEN `N` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  GEN_TAC ;
+  ASSUME_TAC proj_contraction;
+  TYPEL_THEN [`n`;`x'`;`(\(i :num). &.0)`;`i`] (USE 4 o SPECL);
+  USE 4 BETA_RULE ;
+  USE 4 (CONV_RULE REDUCE_CONV );
+  TYPE_THEN `euclid n (\i. &.0)` SUBGOAL_TAC ;
+  REWRITE_TAC[euclid];
+  DISCH_TAC;
+  REWR 4;
+  ASSUME_TAC metric_euclid;
+  TYPE_THEN `n` (USE 6 o SPEC);
+  TYPE_THEN `d_euclid x' (\i. &.0) <=. d_euclid x' x + d_euclid x (\i. &0)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_triangle;
+  TYPE_THEN `euclid n` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `d_euclid x' x = d_euclid x x'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_space_symm;
+  TYPE_THEN `euclid n` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  UND 3;
+  UND 4;
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let totally_bounded_euclid = prove_by_refinement(
+  `!X n. (metric_bounded (X,d_euclid) /\
+    (X SUBSET (euclid n))) ==>
+   (totally_bounded (X,d_euclid))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[metric_bounded];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  totally_bounded_subset;
+  CHO 0;
+  CHO 0;
+  ASSUME_TAC euclid_ball_cube;
+  TYPEL_THEN [`n`;`x`;`r`] (USE 2 o SPECL);
+  CHO 2;
+  ASSUME_TAC open_ball_subspace;
+  TYPEL_THEN [`euclid n`;`X`;`d_euclid`;`x`;`r`] (USE 3 o ISPECL);
+  REWR 3;
+  JOIN 0 3;
+  USE 0 (MATCH_MP SUBSET_TRANS);
+  JOIN 0 2;
+  USE 0 (MATCH_MP SUBSET_TRANS);
+  TYPE_THEN `{x | euclid n x /\ (!i. abs (x i) <= &N)}` EXISTS_TAC;
+  ASM_REWRITE_TAC[totally_bounded_cube ];
+  IMATCH_MP_TAC  metric_subspace;
+  TYPE_THEN `euclid n` EXISTS_TAC;
+  REWRITE_TAC[metric_euclid];
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM' ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* topology  is not needed as an assumption here!  *)
+let induced_compact = prove_by_refinement(
+  `!U (K:A->bool). (K SUBSET (UNIONS U)) ==>
+     (compact U K <=> (compact (induced_top U K) K))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[compact];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[induced_top_support;SUBSET_INTER;SUBSET_REFL  ];
+  DISCH_ALL_TAC;
+  USE 3 (REWRITE_RULE[induced_top;SUBSET;IN_IMAGE  ]);
+  LEFT 3 "x'";
+  LEFT 3 "x'";
+  X_CHO 3 `u:(A->bool)->(A->bool)`;
+  TYPE_THEN `IMAGE u V` (USE 1 o SPEC);
+  TYPE_THEN `K SUBSET UNIONS (IMAGE u V) /\ IMAGE u V SUBSET U` SUBGOAL_TAC;
+  REWRITE_TAC[IMAGE;SUBSET;IN_UNIONS;IN_ELIM_THM'  ];
+  CONJ_TAC;
+  REWRITE_TAC[IN];
+  DISCH_ALL_TAC;
+  USE 2 (REWRITE_RULE[SUBSET;IN_UNIONS ]);
+  USE 2 (REWRITE_RULE[IN ]);
+  TYPE_THEN `x` (USE 2 o SPEC);
+  REWR 2;
+  X_CHO 2 `v:A->bool`;
+  NAME_CONFLICT_TAC;
+  CONV_TAC (quant_left_CONV "x'");
+  CONV_TAC (quant_left_CONV "x'");
+  TYPE_THEN `v` EXISTS_TAC;
+  TYPE_THEN `u v` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `v` (USE 3 o SPEC);
+  USE 3 (REWRITE_RULE[IN]);
+  REWR 3;
+  ASSUME_TAC INTER_SUBSET;
+  USE 5 (CONJUNCT1);
+  TYPEL_THEN [`u v`;`K`] (USE 5 o ISPECL);
+  ASM_MESON_TAC[SUBSET;IN];
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[IN ];
+  ASM_MESON_TAC[IN];
+  DISCH_TAC;
+  REWR 1;
+  CHO 1;
+  AND 1;
+  AND 1;
+  JOIN 6 5;
+(*** Modified by JRH for changed theorem name
+  USE 5 (MATCH_MP FINITE_SUBSET_IMAGE);
+ ***)
+  USE 5 (MATCH_MP FINITE_SUBSET_IMAGE_IMP);
+  X_CHO 5 `W':(A->bool)->bool`;
+  TYPE_THEN `W'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `K SUBSET UNIONS (IMAGE u W')` SUBGOAL_TAC;
+  ASM_MESON_TAC[UNIONS_UNIONS ;SUBSET_TRANS];
+  REWRITE_TAC[SUBSET;IN_UNIONS;IN_IMAGE; ];
+  NAME_CONFLICT_TAC;
+  REWRITE_TAC[IN];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `x'` (USE 6 o SPEC);
+  REWR 6;
+  CHO 6;
+  AND 6;
+  CHO 8;
+  AND 5;
+  AND 5;
+  USE 10 (REWRITE_RULE[SUBSET;IN ]);
+  TYPE_THEN `x''` (USE 10 o SPEC);
+  REWR 10;
+  USE 3 (REWRITE_RULE[IN]);
+  TYPE_THEN `x''` (USE 3 o SPEC);
+  REWR 3;
+  TYPE_THEN `x''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM ONCE_REWRITE_TAC[];
+  REWRITE_TAC[INTER;IN;IN_ELIM_THM' ];
+  ASM_MESON_TAC[];
+  ALL_TAC ; (* dd1*)
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN  `VK = IMAGE (\b. (b INTER K)) V` ABBREV_TAC ;
+  TYPE_THEN `VK` (USE 2 o SPEC);
+  TYPE_THEN `K SUBSET UNIONS VK /\ VK SUBSET induced_top U K` SUBGOAL_TAC;
+  CONJ_TAC;
+  EXPAND_TAC "VK";
+  REWRITE_TAC[INTER_THM;GSYM UNIONS_INTER ];
+  ASM_REWRITE_TAC[SUBSET_INTER;SUBSET_REFL  ]; (* end of branch *)
+  REWRITE_TAC[induced_top];
+  EXPAND_TAC "VK";
+  REWRITE_TAC[INTER_THM ];
+  IMATCH_MP_TAC  IMAGE_SUBSET;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  REWR 2;
+  X_CHO 2 `WK:(A->bool)->bool`;
+  TYPEL_THEN [`V`;`(INTER) K`;`WK`] (fun t-> MP_TAC (ISPECL t finite_subset ));
+  ASM_REWRITE_TAC[];
+  AND 2;
+  UND 8;
+  EXPAND_TAC "VK";
+  REWRITE_TAC[INTER_THM];
+  DISCH_ALL_TAC;
+  REWR 8;
+  CHO 8;
+  TYPE_THEN `C` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWR 2;
+  AND 2;
+  USE 2 (REWRITE_RULE[GSYM UNIONS_INTER]);
+  UND 2;
+  TYPE_THEN `R = UNIONS C` ABBREV_TAC;
+  SET_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let compact_euclid = prove_by_refinement(
+  `!X n. (X SUBSET euclid n) ==>
+        (compact (top_of_metric(euclid n,d_euclid)) X <=>
+        (closed_ (top_of_metric(euclid n,d_euclid)) X /\
+        (metric_bounded(X,d_euclid))))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `top_of_metric (X,d_euclid) = induced_top (top_of_metric(euclid n,d_euclid)) X` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM top_of_metric_induced);
+  ASM_REWRITE_TAC[metric_euclid];
+  DISCH_TAC;
+  TYPE_THEN `metric_space (X,d_euclid)` SUBGOAL_TAC ;
+  ASM_MESON_TAC [metric_euclid;metric_subspace];
+  DISCH_TAC ;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  compact_closed;
+  SIMP_TAC [metric_euclid;metric_hausdorff;top_of_metric_top ];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[metric_bounded];
+  IMATCH_MP_TAC  totally_bounded_bounded;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  compact_totally_bounded ;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[induced_compact;top_of_metric_unions;metric_euclid ];
+  DISCH_ALL_TAC;
+  TYPE_THEN `X SUBSET (UNIONS (top_of_metric (euclid n,d_euclid)))` SUBGOAL_TAC;
+  ASM_MESON_TAC[top_of_metric_unions ; metric_euclid];
+  ASM_SIMP_TAC [induced_compact ];
+  ASSUME_TAC metric_euclid;
+  DISCH_TAC;
+  TYPE_THEN `induced_top (top_of_metric(euclid n,d_euclid)) X = top_of_metric(X,d_euclid)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  top_of_metric_induced;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN REWRT_TAC;
+  IMATCH_MP_TAC  complete_compact;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC ;
+  ASM_MESON_TAC[totally_bounded_euclid];
+  IMATCH_MP_TAC  complete_closed;
+  TYPE_THEN `n` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+
+let neg_continuous = prove_by_refinement(
+  `!n. metric_continuous (euclid_neg) (euclid n,d_euclid) (euclid n,d_euclid)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  DISCH_ALL_TAC;
+  RIGHT_TAC "delta";
+  DISCH_TAC;
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  ASM_REWRITE_TAC[IN ];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[d_euclid];
+  REWRITE_TAC[euclid_neg_sum];
+  REWRITE_TAC[norm_neg];
+  REWRITE_TAC[GSYM d_euclid];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let continuous_comp = prove_by_refinement(
+  `!(f:A->B) (g:B->C) U V W.
+      continuous f U V /\ continuous g V W /\
+      (IMAGE f (UNIONS U) SUBSET (UNIONS V)) ==>
+     continuous (g o f) U W`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[continuous;IN;preimage];
+  DISCH_ALL_TAC;
+  X_GEN_TAC `w :C->bool`;
+  DISCH_TAC;
+  TYPE_THEN `w ` (USE  1 o SPEC);
+  REWR 1;
+  TYPE_THEN `{x | UNIONS V x /\ w (g x)}` (USE 0 o SPEC);
+  REWR 0;
+  USE 0 (REWRITE_RULE[IN_ELIM_THM' ]);
+  REWRITE_TAC[o_DEF ];
+  TYPE_THEN `U {x | UNIONS U x /\ UNIONS V (f x) /\ w (g (f x))} = U {x | UNIONS U x /\ w (g (f x))}` SUBGOAL_TAC;
+  AP_TERM_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  IMATCH_MP_TAC  (TAUT `(a ==> b) ==> ((a /\ b /\ c) <=> (a /\ c ))`);
+  TYPE_THEN  `UU = UNIONS U ` ABBREV_TAC;
+  TYPE_THEN `VV = UNIONS V` ABBREV_TAC ;
+  USE 2 (REWRITE_RULE[SUBSET;IN_IMAGE ]);
+  ASM_MESON_TAC[IN];
+  DISCH_THEN (fun  t-> (USE 0 ( REWRITE_RULE[t])));
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+
+let compact_max = prove_by_refinement(
+  `!(f:A->(num->real)) U K.
+       (continuous f U (top_of_metric(euclid 1,d_euclid))) /\
+       (IMAGE f K SUBSET (euclid 1)) /\
+        (compact U K) /\ ~(K=EMPTY)==>
+     (?x. K x /\ (!y. (K y) ==> (f y 0 <= f x 0)))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  COPY 2;
+  COPY 1;
+  TYPE_THEN `euclid 1 = UNIONS (top_of_metric (euclid 1,d_euclid))` SUBGOAL_TAC;
+  MESON_TAC[top_of_metric_unions;metric_euclid];
+  DISCH_THEN (fun t-> USE 5 (ONCE_REWRITE_RULE[t]));
+  JOIN 4 5;
+  COPY 0;
+  JOIN 0 4;
+  WITH  0 (MATCH_MP image_compact);
+  UND 4;
+  ASM_SIMP_TAC[compact_euclid];
+  DISCH_ALL_TAC;
+  TYPE_THEN `P = (IMAGE (coord 0) (IMAGE f K))` ABBREV_TAC ;
+  TYPE_THEN `(?s. !y. (?x. P x /\ y <. x) <=> y <. s)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  REAL_SUP_EXISTS;
+  CONJ_TAC;
+  USE 3 (REWRITE_RULE[EMPTY_EXISTS;IN ]);
+  CHO 3;
+  TYPE_THEN `f u 0` EXISTS_TAC;
+  EXPAND_TAC "P";
+  REWRITE_TAC[IMAGE;IN;IN_ELIM_THM';coord ];
+  NAME_CONFLICT_TAC;
+  LEFT_TAC "x'";
+  LEFT_TAC "x'";
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_MESON_TAC[];
+  USE 6 (REWRITE_RULE[metric_bounded;open_ball;SUBSET;IN_IMAGE  ]);
+  X_CHO 6 `x0:num->real`;
+  X_CHO 6 `r:real`;
+  USE 6 (REWRITE_RULE[IN;IN_ELIM_THM' ]);
+  EXPAND_TAC "P";
+  REWRITE_TAC[IMAGE;IN;IN_ELIM_THM';coord];
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `x0 0 +. r` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  X_CHO 8 `fx:num->real`;
+  AND 8;
+  ASM_REWRITE_TAC[];
+  KILL 8;
+  X_CHO 9 `x:A`;
+  LEFT 6 "x";
+  LEFT 6 "x";
+  TYPE_THEN `x` (USE 6 o SPEC);
+  TYPE_THEN `fx` (USE 6 o SPEC);
+  REWR 6;
+  TYPE_THEN `(d_euclid x0 (f x) = abs (x0 0 - (f x 0)))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  euclid1_abs;
+  USE 1 (REWRITE_RULE[SUBSET;IN ]);
+  ASM_MESON_TAC[];
+  AND 6;
+  AND 6;
+  DISCH_TAC;
+  REWR 6;
+  UND 6;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  ALL_TAC ; (* cc1 *)
+  TYPE_THEN `(!u. (P u) ==> (u <=. sup P)) /\ (P (sup P))` SUBGOAL_TAC;
+  REWRITE_TAC[sup];
+  SELECT_TAC;
+  CHO 8;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  TYPE_THEN `s = t` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 10 (MATCH_MP  (REAL_ARITH `~(s=t) ==> (s<. t) \/ (t <. s)`));
+  TYPE_THEN `s ` (WITH 9 o SPEC);
+  TYPE_THEN `t` (WITH 9 o SPEC);
+  ASM_MESON_TAC[REAL_ARITH `~(x <. x)`];
+  DISCH_TAC;
+  REWR 8;
+  SUBCONJ_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `t` (USE 8 o SPEC);
+  UND 8;
+  REWRITE_TAC[REAL_ARITH `~(x <. x)`];
+  LEFT_TAC "x";
+  LEFT_TAC "x";
+  TYPE_THEN `u` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_ALL_TAC;
+  PROOF_BY_CONTR_TAC;
+  TYPE_THEN `~ (IMAGE f K) (t *# (dirac_delta 0))` SUBGOAL_TAC;
+  PROOF_BY_CONTR_TAC;
+  REWR 13;
+  UND 12;
+  EXPAND_TAC "P";
+  ONCE_REWRITE_TAC[IMAGE];
+  ONCE_REWRITE_TAC[IMAGE];
+  ONCE_REWRITE_TAC[IMAGE];
+  REWRITE_TAC[IN_ELIM_THM';IN];
+  TYPE_THEN `t *# (dirac_delta 0)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ALL_TAC ; (* cc2 *)
+  REWRITE_TAC[coord_dirac];
+  DISCH_TAC;
+  USE 4 (MATCH_MP closed_open);
+  ASSUME_TAC (SPEC `1` metric_euclid);
+  WITH 14 (MATCH_MP top_of_metric_unions);
+  WITH 15 (GSYM);
+  REWR 4;
+  TYPE_THEN `z = t *# dirac_delta 0`  ABBREV_TAC ;
+  TYPE_THEN `(euclid 1 DIFF (IMAGE f K)) z` SUBGOAL_TAC ;
+  REWRITE_TAC[REWRITE_RULE[IN] IN_DIFF];
+  ASM_REWRITE_TAC[];
+  EXPAND_TAC "z";
+  REWRITE_TAC[euclid;euclid_scale;dirac_delta];
+  DISCH_ALL_TAC;
+  ASSUME_TAC (ARITH_RULE `1 <=| m ==> (~(0=m))`);
+  REWR 19;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  REWRITE_TAC[];
+  UND 16;
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC [GSYM t]);
+  UND 4;
+  REWRITE_TAC[open_DEF];
+    ASM_SIMP_TAC[top_of_metric_nbd];
+  DISCH_ALL_TAC;
+  IN_OUT_TAC ;
+  TYPE_THEN `z` (USE  0 o SPEC);
+  KILL 12;
+  KILL 13;
+  KILL 9;
+  UND 14;
+  UND 3;
+  REWRITE_TAC[];
+  DISCH_THEN (fun t-> ONCE_REWRITE_TAC[GSYM t]);
+  DISCH_ALL_TAC;
+  REWR 0;
+  CHO 0;
+  AND 0;
+  USE 0 (REWRITE_RULE[SUBSET;IN; open_ball;IN_ELIM_THM' ]);
+  COPY 0;
+  TYPE_THEN `(t- (r/(&.2)))*# (dirac_delta 0)` (USE 0 o SPEC);
+  TYPE_THEN `euclid 1 z /\ euclid 1 ((t - r / &2) *# dirac_delta 0) /\ d_euclid z ((t - r / &2) *# dirac_delta 0) < r` SUBGOAL_TAC;
+  EXPAND_TAC "z";
+  SUBCONJ_TAC;
+  REWRITE_TAC[euclid;dirac_delta;euclid_scale];
+  GEN_TAC;
+  SIMP_TAC [ (ARITH_RULE `1 <=| m ==> (~(0=m))`)];
+  REWRITE_TAC[REAL_ARITH `t*(&.0) = (&.0)`];
+  DISCH_ALL_TAC;
+  SUBCONJ_TAC;
+  REWRITE_TAC[euclid;dirac_delta;euclid_scale];
+  GEN_TAC;
+  SIMP_TAC [ (ARITH_RULE `1 <=| m ==> (~(0=m))`)];
+  REWRITE_TAC[REAL_ARITH `t*(&.0) = (&.0)`];
+  ALL_TAC ; (* cc3 *)
+  UND 13 ;
+  SIMP_TAC[euclid1_abs];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[euclid_minus ; euclid_scale;dirac_delta ];
+  REDUCE_TAC ;
+  REWRITE_TAC[REAL_ARITH `t - (t - (r/(&.2))) = r/(&.2)`];
+  WITH  9 (ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1]);
+  WITH 19 (MATCH_MP (REAL_ARITH `&.0 < x ==> (&.0 <= x)`));
+  WITH 20 (REWRITE_RULE[GSYM REAL_ABS_REFL]);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REAL_LT_HALF2];
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> (USE 0 (REWRITE_RULE[t])));
+  ALL_TAC ; (* cc4 *)
+  TYPE_THEN `t - (r/(&.2)) ` (USE 10 o SPEC);
+  TYPE_THEN `t - r / &2 < t` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (REAL_ARITH `&.0 < x ==> (t - x < t)`);
+  WITH  9 (ONCE_REWRITE_RULE[GSYM REAL_LT_HALF1]);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC ;
+  REWR 10;
+  X_CHO 10 `u:real`;
+  TYPE_THEN `u` (USE 7 o SPEC);
+  REWR 7;
+  TYPE_THEN `(euclid 1 DIFF IMAGE f K) (u *# (dirac_delta 0))` SUBGOAL_TAC ;
+  UND 12;
+  DISCH_THEN (IMATCH_MP_TAC  );
+  EXPAND_TAC "z";
+  SUBCONJ_TAC;
+  REWRITE_TAC[euclid;euclid_scale;dirac_delta];
+  REWRITE_TAC[ (ARITH_RULE `1 <=| m <=> (~(0=m))`)];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_ALL_TAC;
+  SUBCONJ_TAC;
+  REWRITE_TAC[euclid;euclid_scale;dirac_delta];
+  REWRITE_TAC[ (ARITH_RULE `1 <=| m <=> (~(0=m))`)];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[euclid1_abs];
+  EXPAND_TAC "z";
+  REWRITE_TAC[dirac_delta;euclid_scale;euclid_minus];
+  REDUCE_TAC;
+  AND 10;
+  REWRITE_TAC[GSYM ABS_BETWEEN];
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 7;
+  UND 9;
+  REAL_ARITH_TAC;
+  UND 10;
+  IMATCH_MP_TAC  (REAL_ARITH `y <. x ==> ((t - y <. u) ==> (t <. u + x))`);
+  REWRITE_TAC[REAL_LT_HALF2];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[REWRITE_RULE[IN] IN_DIFF];
+  IMATCH_MP_TAC  (TAUT `B ==> (~(A /\ ~B))`);
+  AND 10;
+  UND 14;
+  EXPAND_TAC "P";
+  TYPE_THEN  `B = IMAGE f K` ABBREV_TAC ;
+  ALL_TAC ; (* cc5 *)
+  REWRITE_TAC[IMAGE;coord;IN;IN_ELIM_THM' ];
+  DISCH_TAC;
+  CHO 19;
+  AND 19;
+  ASM_REWRITE_TAC[];
+  USE 17 (REWRITE_RULE[SUBSET;IN]);
+  TYPE_THEN `x` (USE 17 o SPEC);
+  REWR 17;
+  USE 17 (REWRITE_RULE[euclid1_dirac]);
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  TYPE_THEN `t = sup P` ABBREV_TAC;
+  DISCH_ALL_TAC;
+  UND 11;
+  EXPAND_TAC "P";
+  REWRITE_TAC[];
+  ONCE_REWRITE_TAC[IMAGE];
+  REWRITE_TAC[IN_IMAGE;IN_ELIM_THM';IN ];
+  NAME_CONFLICT_TAC;
+  DISCH_ALL_TAC;
+  CHO 11;
+  AND 11;
+  CHO 12;
+  REWR 11;
+  TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  UND 10;
+  EXPAND_TAC "P";
+  REWRITE_TAC[];
+  ONCE_REWRITE_TAC[IMAGE];
+  REWRITE_TAC[IN_IMAGE;IN_ELIM_THM' ];
+  REWRITE_TAC[IN];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[coord];
+  NAME_CONFLICT_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `f y' 0` (USE 10 o SPEC);
+  UND 10;
+  DISCH_THEN IMATCH_MP_TAC  ;
+  LEFT_TAC "x'";
+  LEFT_TAC "x'";
+  ASM_MESON_TAC[];
+  (* finish *)
+  ]);;
+
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* homeomorphisms *)
+(* ------------------------------------------------------------------ *)
+
+let homeomorphism = euclid_def `homeomorphism (f:A->B) U V <=>
+  (BIJ f (UNIONS U) (UNIONS V) ) /\ (continuous f U V) /\
+  (!A. (U A) ==> (V (IMAGE f A)))`;;
+
+let INV_homeomorphism  = prove_by_refinement(
+  `!f U V. homeomorphism (f:A-> B) U V ==>
+    (continuous (INV f (UNIONS U) (UNIONS V)) V U)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[continuous;IN;preimage];
+  REWRITE_TAC[homeomorphism];
+  DISCH_ALL_TAC;
+  X_GEN_TAC `u:A->bool`;
+  DISCH_ALL_TAC;
+  TYPE_THEN `{ x | UNIONS V x /\ u (INV f (UNIONS U) (UNIONS V) x)} = IMAGE f u` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT ;
+  X_GEN_TAC `t:B`;
+  REWRITE_TAC[IN_ELIM_THM';IMAGE ;IN ];
+  EQ_TAC ;
+  DISCH_ALL_TAC;
+  TYPE_THEN `(INV f (UNIONS U) (UNIONS V) t)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[INVERSE_DEF;IN;BIJ ];
+  DISCH_ALL_TAC;
+  CHO 4;
+  SUBCONJ_TAC;
+  USE 0 (REWRITE_RULE[BIJ;INJ]);
+  IN_OUT_TAC ;
+  ASM_REWRITE_TAC[];
+  AND 4;
+  AND 5;
+  TYPE_THEN `x` (USE 6 o SPEC);
+  UND 6;
+  DISCH_THEN (IMATCH_MP_TAC );
+  REWRITE_TAC[UNIONS;IN;IN_ELIM_THM' ];
+  ASM_MESON_TAC[];
+  DISCH_TAC ;
+  TYPE_THEN `INV f (UNIONS U) (UNIONS V) t = x` SUBGOAL_TAC;
+  (* stop here this is an example that ASM_MESON_TAC should catch *)
+  (* ASM_MESON_TAC[INVERSE_XY;IN ;UNIONS ]; *)
+  TYPE_THEN `(UNIONS U x)` SUBGOAL_TAC;
+  REWRITE_TAC[UNIONS;IN_ELIM_THM';IN   ];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[INVERSE_XY;IN ];
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  UND 2;
+  DISCH_THEN IMATCH_MP_TAC ;
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let bicont_homeomorphism = prove_by_refinement(
+  `!f U V. (BIJ (f:A->B) (UNIONS U) (UNIONS V)) /\ (continuous f U V) /\
+    (continuous (INV  f (UNIONS U) (UNIONS V)) V U) ==>
+     (homeomorphism f U V)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[homeomorphism];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  UND 2;
+  REWRITE_TAC[continuous;IN;preimage ];
+  DISCH_ALL_TAC;
+  TYPE_THEN `A` (USE 2 o SPEC);
+  REWR 2;
+  TYPE_THEN `{x | UNIONS V x /\ A (INV f (UNIONS U) (UNIONS V) x)}= (IMAGE f A) ` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT ;
+  X_GEN_TAC `t:B`;
+  REWRITE_TAC[IN_ELIM_THM';IMAGE ;IN ];
+  EQ_TAC ;
+  DISCH_ALL_TAC;
+  TYPE_THEN `(INV f (UNIONS U) (UNIONS V) t)` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[INVERSE_DEF;IN;BIJ ];
+  DISCH_ALL_TAC;
+  CHO 4;
+  SUBCONJ_TAC;
+  USE 0 (REWRITE_RULE[BIJ;INJ]);
+  IN_OUT_TAC ;
+  ASM_REWRITE_TAC[];
+  AND 4;
+  AND 5;
+  TYPE_THEN `x` (USE 6 o SPEC);
+  UND 6;
+  DISCH_THEN (IMATCH_MP_TAC );
+  REWRITE_TAC[UNIONS;IN;IN_ELIM_THM' ];
+  ASM_MESON_TAC[];
+  DISCH_TAC ;
+  TYPE_THEN `INV f (UNIONS U) (UNIONS V) t = x` SUBGOAL_TAC;
+  TYPE_THEN `(UNIONS U x)` SUBGOAL_TAC;
+  REWRITE_TAC[UNIONS;IN_ELIM_THM';IN   ];
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[INVERSE_XY;IN ];
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let open_and_closed = prove_by_refinement(
+  `!(f:A->B) U V. (topology_ U) /\ (topology_ V) /\
+     (BIJ f (UNIONS U) (UNIONS V)) ==>
+     ((!A. (U A ==> V (IMAGE f A))) <=>
+    (!B. (closed_ U B) ==> (closed_ V (IMAGE f B))))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[closed];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  SUBCONJ_TAC;
+  UND 4;
+  UND 2;
+  (* should have worked:
+    ASM_MESON_TAC[SUBSET;IN;BIJ;INJ;IMAGE;IN_ELIM_THM'  ];
+    bug found?  *)
+  REWRITE_TAC[BIJ;IN;INJ;SUBSET;IMAGE;IN_ELIM_THM'  ];
+  DISCH_ALL_TAC;
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `y:B`  X_GEN_TAC;
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[open_DEF];
+  USE 5 (REWRITE_RULE[open_DEF]);
+  TYPE_THEN `UNIONS U DIFF B` (USE 3 o SPEC);
+  REWR 3;
+  TYPE_THEN `IMAGE f (UNIONS U DIFF B) = (UNIONS V DIFF IMAGE f B)` SUBGOAL_TAC;
+  ASM_MESON_TAC[DIFF_SURJ];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[open_DEF];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `UNIONS U DIFF A` (USE 3 o SPEC);
+  TYPE_THEN `UNIONS U DIFF A SUBSET UNIONS U /\ U (UNIONS U DIFF (UNIONS U DIFF A))` SUBGOAL_TAC;
+  ASM_SIMP_TAC[sub_union ; DIFF_DIFF2 ];
+  ASM_REWRITE_TAC[SUBSET_DIFF];
+  DISCH_TAC ;
+  REWR 3;
+  TYPE_THEN `UNIONS V DIFF IMAGE f (UNIONS U DIFF A) = IMAGE f A` SUBGOAL_TAC;
+  ASM_MESON_TAC[DIFF_SURJ; sub_union; DIFF_DIFF2];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let hausdorff_homeomorphsim = prove_by_refinement(
+  `!f U V. (BIJ (f:A->B) (UNIONS U) (UNIONS V)) /\ (continuous f U V) /\
+    (compact U (UNIONS U)) /\ (hausdorff V) /\ (topology_ U) /\
+    (topology_ V) ==> (homeomorphism f U V)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[homeomorphism];
+  ASM_SIMP_TAC[open_and_closed];
+  DISCH_ALL_TAC;
+  TYPEL_THEN [`U`;`UNIONS U`;`B`] (fun t-> ASSUME_TAC (SPECL t closed_compact));
+  REWR 7;
+  WITH 6 (REWRITE_RULE[closed]);
+  REWR 7;
+  IMATCH_MP_TAC  compact_closed ;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC image_compact;
+  TYPE_THEN `U` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  AND 8;
+  USE 0 (REWRITE_RULE[BIJ;INJ;IN ]);
+  AND 0;
+  AND 10;
+  REWRITE_TAC[SUBSET;IN_IMAGE];
+  REWRITE_TAC[IN];
+  USE 9 (REWRITE_RULE[SUBSET;IN]);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* the metric and topology on the real numbers *)
+(* ------------------------------------------------------------------ *)
+
+let d_real = euclid_def `d_real x y = ||. (x -. y)`;;
+
+(*
+let real_topology = euclid_def
+     `real_topology = top_of_metric (UNIV,d_real)`;;
+*)
+
+let metric_real = prove_by_refinement(
+  `metric_space (UNIV,d_real)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[metric_space;UNIV;d_real ];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let continuous_euclid1 = prove_by_refinement(
+  `!i  n. continuous (coord i)
+    (top_of_metric (euclid n,d_euclid))
+    (top_of_metric (UNIV,d_real))`,
+  (* {{{ proof *)
+
+  [
+  TYPE_THEN `!i  n . IMAGE (coord i) (euclid n) SUBSET (UNIV) /\ metric_space (euclid n,d_euclid) /\ metric_space (UNIV,d_real)` SUBGOAL_TAC;
+  REP_GEN_TAC;
+  REWRITE_TAC[UNIV ;SUBSET;IN];
+  REWRITE_TAC[metric_euclid;metric_real;GSYM UNIV];
+  DISCH_TAC;
+  DISCH_ALL_TAC;
+  TYPEL_THEN [`i`;`n`] (USE 0 o SPECL);
+  USE 0 (IMATCH_MP metric_continuous_continuous);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  DISCH_ALL_TAC;
+  RIGHT_TAC "delta";
+  DISCH_ALL_TAC;
+  REWRITE_TAC[d_real;IN;coord];
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  UND 4;
+  IMATCH_MP_TAC  (REAL_ARITH  `(a <=. b) ==> ((b <. e) ==> (a <. e))`);
+  ASM_MESON_TAC[proj_contraction];
+  ]);;
+
+  (* }}} *)
+
+
+let interval_closed_ball = prove_by_refinement(
+   `!a b . ? x r. (a <=. b) ==>
+   ({x | euclid 1 x /\ a <= x 0 /\ x 0 <= b} =
+    (closed_ball(euclid 1,d_euclid)) x r)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `((a +b)/(&.2)) *# (dirac_delta 0)` EXISTS_TAC;
+  TYPE_THEN `((b -a)/(&.2))` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[closed_ball;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  (TAUT `(a ==> (b <=> d /\ c))  ==> (a /\ b <=> d /\ a /\ c)`);
+  DISCH_ALL_TAC;
+  TYPE_THEN `z = ((a + b) / &2 *# dirac_delta 0)` ABBREV_TAC;
+  TYPE_THEN `euclid 1 z` SUBGOAL_TAC;
+  EXPAND_TAC "z";
+  MESON_TAC[euclid_dirac];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[euclid1_abs];
+  EXPAND_TAC "z";
+  TYPE_THEN `t = x 0` ABBREV_TAC ;
+  REWRITE_TAC[dirac_delta;euclid_scale];
+  REDUCE_TAC ;
+  REWRITE_TAC[GSYM INTERVAL_ABS ];
+  IMATCH_MP_TAC  (TAUT `((a = d) /\ (b = C))    ==> ((a /\ b) <=> (C /\ d))`);
+  ONCE_REWRITE_TAC[REAL_ARITH `((x <=. u + v) <=> (x - v <=. u)) /\ ((x - u <= v) <=> (x <=. v + u))`];
+  CONJ_TAC;
+  TYPE_THEN `(a + b) / &2 - (b - a) / &2 = a` SUBGOAL_TAC ;
+  REWRITE_TAC[real_div];
+  REWRITE_TAC[REAL_ARITH `(a+b)*C - (b-a)*C  = a*(&.2*C) `];
+  REDUCE_TAC ;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  TYPE_THEN `(a+ b) /(&.2) + (b - a)/(&.2) = b` SUBGOAL_TAC;
+  REWRITE_TAC[real_div];
+  REWRITE_TAC[REAL_ARITH `(a+b) * C + (b - a) * C = b *(&.2*C)`];
+  REDUCE_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+   ]);;
+  (* }}} *)
+
+let interval_euclid1_closed = prove_by_refinement(
+  `!a b. closed_ (top_of_metric (euclid 1,d_euclid))
+ {x | euclid 1 x /\ a <= x 0 /\ x 0 <= b}`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASM_CASES_TAC `a <=. b`;
+  ASSUME_TAC interval_closed_ball;
+  TYPEL_THEN [`a`;`b`] (USE 1 o SPECL);
+  (CHO 1);
+  CHO 1;
+  REWR 1;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC closed_ball_closed;
+  REWRITE_TAC[metric_euclid];
+  TYPE_THEN `{x | euclid 1 x /\ a <= x 0 /\ x 0 <= b}= EMPTY ` SUBGOAL_TAC ;
+  REWRITE_TAC[EQ_EMPTY;IN_ELIM_THM' ];
+  GEN_TAC;
+  TYPE_THEN `t = x 0 ` ABBREV_TAC;
+  KILL 1;
+  IMATCH_MP_TAC  (TAUT `~(b /\ C) ==> ~( a /\ b/\ C)`);
+  UND 0;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  IMATCH_MP_TAC  empty_closed;
+  IMATCH_MP_TAC  top_of_metric_top  ;
+  REWRITE_TAC[metric_euclid];
+  ]);;
+  (* }}} *)
+
+let interval_euclid1_bounded = prove_by_refinement(
+  `!a b. metric_bounded
+    ({x | euclid 1 x /\ a <= x 0 /\ x 0 <= b},d_euclid)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[metric_bounded];
+  ASSUME_TAC interval_closed_ball;
+  TYPEL_THEN [`a`;`b`] (USE 0 o SPECL);
+  CHO 0;
+  CHO 0;
+  ASM_CASES_TAC `a <=. b`;
+  REWR 0;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `x` EXISTS_TAC;
+  TYPE_THEN `r + (&.1) ` EXISTS_TAC;
+  REWRITE_TAC[open_ball;SUBSET;IN ;IN_ELIM_THM' ];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  UND 2;
+  REWRITE_TAC[closed_ball;IN_ELIM_THM' ];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  UND 4;
+  ASM_SIMP_TAC[euclid1_abs ];
+  TYPE_THEN  `t = x 0` ABBREV_TAC;
+  TYPE_THEN `s = x' 0` ABBREV_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `&.0 <=. r` SUBGOAL_TAC;
+  UND 6;
+  REAL_ARITH_TAC;
+  DISCH_ALL_TAC;
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  UND 6;
+  UND 7;
+  REAL_ARITH_TAC ;
+  TYPE_THEN `{x | euclid 1 x /\ a <= x 0 /\ x 0 <= b} = EMPTY` SUBGOAL_TAC;
+  REWRITE_TAC[EQ_EMPTY;IN_ELIM_THM' ];
+  GEN_TAC;
+  TYPE_THEN `t = x 0 ` ABBREV_TAC;
+  KILL 2;
+  IMATCH_MP_TAC  (TAUT `~(b /\ C) ==> ~( a /\ b/\ C)`);
+  UND 1;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  REWRITE_TAC[EMPTY_SUBSET];
+  ]);;
+  (* }}} *)
+
+let interval_euclid1_compact = prove_by_refinement(
+  `!a b. compact (top_of_metric(euclid 1,d_euclid))
+    {x | (euclid 1 x) /\ (a <=. (x 0)) /\ (x 0 <= b)}`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  TYPE_THEN `{x | euclid 1 x /\ a <= x 0 /\ x 0 <= b} SUBSET (euclid 1)` SUBGOAL_TAC;
+  REWRITE_TAC [SUBSET;IN;IN_ELIM_THM' ];
+  MESON_TAC[];
+  DISCH_TAC;
+  ASM_SIMP_TAC[compact_euclid];
+  CONJ_TAC;
+  MATCH_ACCEPT_TAC interval_euclid1_closed;
+  MATCH_ACCEPT_TAC interval_euclid1_bounded;
+  ]);;
+  (* }}} *)
+
+let interval_image = prove_by_refinement(
+  `!a b. {x | a <=. x /\ (x <= b)} =
+    IMAGE (coord 0) {x | euclid 1 x /\ a <= x 0 /\ x 0 <= b}`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IN_ELIM_THM';IMAGE];
+  GEN_TAC;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `x *# (dirac_delta 0)` EXISTS_TAC;
+  REWRITE_TAC[coord_dirac;euclid_dirac;dirac_0];
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  CHO 0;
+  USE 0 (REWRITE_RULE[coord]);
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let interval_compact = prove_by_refinement(
+  `!a b. compact (top_of_metric (UNIV,d_real))
+        {x | a <=. x /\ (x <=. b)} `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[interval_image];
+  IMATCH_MP_TAC  image_compact;
+  TYPE_THEN `(top_of_metric (euclid 1,d_euclid))` EXISTS_TAC;
+  REWRITE_TAC[continuous_euclid1;interval_euclid1_compact];
+  SIMP_TAC[GSYM top_of_metric_unions;metric_real];
+  REWRITE_TAC[UNIV;SUBSET;IN];
+  ]);;
+  (* }}} *)
+
+let half_open = prove_by_refinement(
+  `!a. top_of_metric(UNIV,d_real ) { x | x <. a}`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  ASSUME_TAC open_nbd ;
+  TYPEL_THEN [`top_of_metric (UNIV,d_real)`;` {x | x < a}`] (USE 0 o ISPECL);
+  USE 0 (SIMP_RULE[top_of_metric_top;metric_real ]);
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  TYPE_THEN `open_ball (UNIV,d_real) x (a - x)` EXISTS_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[open_ball;d_real ;IN;IN_ELIM_THM';UNIV ;SUBSET ];
+  GEN_TAC ;
+  UND 1;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  (REWRITE_RULE[IN] open_ball_nonempty);
+  REWRITE_TAC[metric_real; UNIV ];
+  UND 1;
+  REAL_ARITH_TAC;
+  IMATCH_MP_TAC  open_ball_open;
+  REWRITE_TAC[metric_real];
+  ]);;
+  (* }}} *)
+
+let half_open_above = prove_by_refinement(
+  `!a. top_of_metric(UNIV,d_real ) { x | a <. x}`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  ASSUME_TAC open_nbd ;
+  TYPEL_THEN [`top_of_metric (UNIV,d_real)`;` {x | a <. x}`] (USE 0 o ISPECL);
+  USE 0 (SIMP_RULE[top_of_metric_top;metric_real ]);
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  TYPE_THEN `open_ball (UNIV,d_real) x (x -. a)` EXISTS_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[open_ball;d_real ;IN;IN_ELIM_THM';UNIV ;SUBSET ];
+  GEN_TAC ;
+  UND 1;
+  REAL_ARITH_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  (REWRITE_RULE[IN] open_ball_nonempty);
+  REWRITE_TAC[metric_real; UNIV ];
+  UND 1;
+  REAL_ARITH_TAC;
+  IMATCH_MP_TAC  open_ball_open;
+  REWRITE_TAC[metric_real];
+  ]);;
+  (* }}} *)
+
+let joinf = euclid_def `joinf (f:real -> A)  g a =
+  (\ x . (if (x <. a) then (f x) else (g x)))`;;
+
+let joinf_cont = prove_by_refinement(
+  `!U a  (f:real -> A) g.
+   (continuous f (top_of_metric(UNIV,d_real)) U) /\
+   (continuous g (top_of_metric(UNIV,d_real)) U) /\
+   (f a = (g a)) ==>
+   ( (continuous (joinf f g a) (top_of_metric(UNIV,d_real)) U))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[continuous];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  REWRITE_TAC[IN ];
+  ASSUME_TAC open_nbd;
+  TYPEL_THEN [`top_of_metric (UNIV,d_real)`;`(preimage (UNIONS (top_of_metric (UNIV,d_real))) (joinf f g a) v)`] (USE 4 o ISPECL);
+  USE 4 (SIMP_RULE [top_of_metric_top;metric_real  ]);
+  ASM_REWRITE_TAC[];
+  GEN_TAC;
+  REWRITE_TAC[subset_preimage];
+  RIGHT_TAC "B";
+  DISCH_TAC;
+  SIMP_TAC[GSYM top_of_metric_unions; metric_real];
+  REWRITE_TAC[SUBSET_UNIV];
+  MP_TAC (REAL_ARITH `(x = a) \/ (x <. a) \/ (a <. x)`);
+  REP_CASES_TAC;
+  TYPE_THEN `B = (preimage (UNIONS (top_of_metric (UNIV,d_real))) f  v) INTER (preimage (UNIONS (top_of_metric (UNIV,d_real)))  g v)` ABBREV_TAC ;
+  TYPE_THEN `B` EXISTS_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;IN_IMAGE;IN  ];
+  GEN_TAC;
+  LEFT_TAC "x";
+  GEN_TAC ;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  UND 9;
+  EXPAND_TAC "B";
+  REWRITE_TAC[INTER;IN_ELIM_THM';IN  ];
+  REWRITE_TAC[REWRITE_RULE[IN] in_preimage;joinf ];
+  COND_CASES_TAC;
+  MESON_TAC[];
+  MESON_TAC[];
+  CONJ_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 5;
+  EXPAND_TAC "B";
+  REWRITE_TAC[INTER;IN;IN_ELIM_THM'];
+  REWRITE_TAC[REWRITE_RULE[IN] in_preimage];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[joinf];
+  REWRITE_TAC[REAL_ARITH `~(a<. a)`];
+  ASSUME_TAC top_of_metric_top;
+  TYPEL_THEN [`UNIV:real -> bool`;`d_real `] (USE 8 o ISPECL);
+  USE 8 (REWRITE_RULE[metric_real ]);
+  USE 8 (REWRITE_RULE[topology]);
+  EXPAND_TAC "B";
+  KILL 7;
+  TYPE_THEN `v` (USE 0 o SPEC);
+  TYPE_THEN `v` (USE 1 o SPEC);
+  ASM_MESON_TAC[IN ];
+  (* 2nd case x < a *)
+  TYPE_THEN `B = { x | x <. a } INTER (preimage (UNIONS (top_of_metric (UNIV,d_real))) f v)` ABBREV_TAC ;
+  TYPE_THEN `B` EXISTS_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[SUBSET;IN_IMAGE ; IN;joinf ];
+  GEN_TAC ;
+  LEFT_TAC "x";
+  GEN_TAC ;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  UND 9;
+  EXPAND_TAC "B";
+  REWRITE_TAC[INTER ;IN ;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  USE 10 (REWRITE_RULE[REWRITE_RULE[IN] in_preimage]);
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 5;
+  EXPAND_TAC "B";
+  REWRITE_TAC[INTER;IN;IN_ELIM_THM'];
+  REWRITE_TAC[REWRITE_RULE[IN] in_preimage];
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  UND 8;
+  REWRITE_TAC[joinf];
+  ASM_REWRITE_TAC[];
+  ASSUME_TAC top_of_metric_top;
+  TYPEL_THEN [`UNIV:real -> bool`;`d_real `] (USE 8 o ISPECL);
+  USE 8 (REWRITE_RULE[metric_real ]);
+  USE 8 (REWRITE_RULE[topology]);
+  TYPE_THEN `v` (USE 0 o SPEC);
+  TYPE_THEN `v` (USE 1 o SPEC);
+  EXPAND_TAC "B";
+  KILL 7;
+  KILL 5;
+  KILL 4;
+  KILL 1;
+  KILL 6;
+  TYPEL_THEN [`{x | x < a}`;`preimage (UNIONS (top_of_metric (UNIV,d_real))) f v`] (USE 8 o ISPECL);
+  RIGHT 1 "V";
+  RIGHT 1 "V";
+  AND 1;
+  AND 1;
+  REWR 0;
+  USE 0 (REWRITE_RULE[IN]);
+  REWR 5;
+  USE 5 (REWRITE_RULE[half_open]);
+  ASM_REWRITE_TAC[];
+  (* case 3 a < x *)
+  TYPE_THEN `B = { x | a <. x } INTER (preimage (UNIONS (top_of_metric (UNIV,d_real))) g v)` ABBREV_TAC ;
+  TYPE_THEN `B` EXISTS_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[SUBSET;IN_IMAGE ; IN;joinf ];
+  GEN_TAC ;
+  LEFT_TAC "x";
+  GEN_TAC ;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  UND 9;
+  EXPAND_TAC "B";
+  REWRITE_TAC[INTER ;IN ;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  USE 10 (REWRITE_RULE[REWRITE_RULE[IN] in_preimage]);
+  ASM_REWRITE_TAC[];
+  USE 9 (MATCH_MP (REAL_ARITH `a < x'' ==> (~(x'' <. a))`));
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  UND 5;
+  EXPAND_TAC "B";
+  REWRITE_TAC[INTER;IN;IN_ELIM_THM'];
+  REWRITE_TAC[REWRITE_RULE[IN] in_preimage];
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  UND 8;
+  REWRITE_TAC[joinf];
+  USE 6 (MATCH_MP (REAL_ARITH `a < x'' ==> (~(x'' <. a))`));
+  ASM_REWRITE_TAC[];
+  ASSUME_TAC top_of_metric_top;
+  TYPEL_THEN [`UNIV:real -> bool`;`d_real `] (USE 8 o ISPECL);
+  USE 8 (REWRITE_RULE[metric_real ]);
+  USE 8 (REWRITE_RULE[topology]);
+  TYPE_THEN `v` (USE 0 o SPEC);
+  TYPE_THEN `v` (USE 1 o SPEC);
+  EXPAND_TAC "B";
+  KILL 7;
+  KILL 5;
+  KILL 4;
+  KILL 0;
+  KILL 6;
+  TYPEL_THEN [`{x | a < x}`;`preimage (UNIONS (top_of_metric (UNIV,d_real))) g v`] (USE 8 o ISPECL);
+  RIGHT 0 "V";
+  RIGHT 0 "V";
+  AND 0;
+  AND 0;
+  REWR 1;
+  USE 1 (REWRITE_RULE[IN]);
+  REWR 5;
+  USE 5 (REWRITE_RULE[half_open_above]);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let neg_cont = prove_by_refinement(
+  `continuous ( --.)
+     (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real))  `,
+  (* {{{ proof *)
+  [
+  TYPE_THEN `IMAGE ( --. ) (UNIV) SUBSET (UNIV)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;IN;UNION;UNIV ];
+  DISCH_TAC;
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_real ];
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  DISCH_ALL_TAC;
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[UNIV;IN;d_real  ];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let add_cont = prove_by_refinement(
+  `!u. (continuous ( (+.) u))
+      (top_of_metric(UNIV,d_real)) (top_of_metric(UNIV,d_real))  `,
+  (* {{{ proof *)
+
+  [
+  GEN_TAC;
+  TYPE_THEN `IMAGE ( (+.) u ) (UNIV) SUBSET (UNIV)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;IN;UNION;UNIV ];
+  DISCH_TAC;
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_real ];
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  DISCH_ALL_TAC;
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[UNIV;IN;d_real  ];
+  REAL_ARITH_TAC;
+  ]);;
+
+  (* }}} *)
+
+let continuous_scale = prove_by_refinement(
+  `!x n. (euclid n x) ==>
+     (continuous (\t. (t *# x)) (top_of_metric(UNIV,d_real))
+     (top_of_metric(euclid n,d_euclid)))`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  ASSUME_TAC metric_euclid;
+  ASSUME_TAC metric_real ;
+  TYPE_THEN `IMAGE (\t. (t *# x)) (UNIV) SUBSET (euclid n)` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;IN_IMAGE;IN_ELIM_THM'];
+  REWRITE_TAC[Q_ELIM_THM'';IN ; UNIV ];
+  ASM_MESON_TAC[euclid_scale_closure];
+  ASM_SIMP_TAC[metric_continuous_continuous];
+  DISCH_TAC;
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[IN;UNIV];
+  TYPE_THEN `euclidean x` SUBGOAL_TAC;
+  ASM_MESON_TAC[euclidean];
+  ASM_SIMP_TAC[norm_scale;d_real];
+  DISCH_TAC;
+  TYPE_THEN `norm x <=. &.1`  ASM_CASES_TAC ;
+  TYPE_THEN `epsilon` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  MP_TAC (SPEC `x' -. y` REAL_ABS_POS);
+  DISCH_TAC ;
+  USE 5 (MATCH_MP (SPEC `x' -. y` REAL_PROP_LE_LABS));
+  USE 5 (CONV_RULE REDUCE_CONV);
+  UND 5;
+  UND 7;
+  REAL_ARITH_TAC ;
+  TYPE_THEN `epsilon / norm x` EXISTS_TAC;
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  REAL_LT_DIV;
+  ASM_REWRITE_TAC[];
+  UND 5;
+  REAL_ARITH_TAC;
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[REAL_ARITH `~(x <= &.1) ==> (&.0 <. x)`;REAL_LT_RDIV_EQ];
+  ]);;
+
+  (* }}} *)
+
+let continuous_lin_combo = prove_by_refinement(
+  `! x y n. (euclid n x) /\ (euclid n y) ==>
+    (continuous (\t. (t *# x + (&.1 - t) *# y))
+     (top_of_metric(UNIV,d_real))
+     (top_of_metric(euclid n,d_euclid)))`,
+  (* {{{ proof *)
+
+  let comp_elim_tac = (  IMATCH_MP_TAC  continuous_comp THEN
+  TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC THEN
+  ASM_SIMP_TAC[add_cont;neg_cont;continuous_scale] THEN
+  REWRITE_TAC[SUBSET;IN_IMAGE;Q_ELIM_THM''] THEN
+  SIMP_TAC[GSYM top_of_metric_unions ;metric_real;IN_UNIV ] ) in
+  [
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  continuous_sum;
+  ASM_SIMP_TAC[metric_real;metric_euclid;top_of_metric_top;continuous_scale;SUBSET ;IN_IMAGE;Q_ELIM_THM'' ];
+  ASM_SIMP_TAC[IN;euclid_scale_closure;continuous_scale];
+  TYPE_THEN `(\t . (&. 1 - t) *# y) = (\t. t *# y) o ((--.) o ((+.) (--. (&.1))))` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[o_DEF;REAL_ARITH `--.(--. u +. v) = (u -. v)`];
+  DISCH_THEN (fun t-> REWRITE_TAC [t]);
+  REPEAT comp_elim_tac;
+  ]);;
+
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Connected Sets  *)
+(* ------------------------------------------------------------------ *)
+
+let connected = euclid_def `connected U (Z:A->bool) <=>
+   (Z SUBSET (UNIONS U)) /\
+   (!A B. (U A) /\ (U B) /\ (A INTER B = EMPTY ) /\
+    (Z SUBSET (A UNION B)) ==> ((Z SUBSET A) \/ (Z SUBSET B)))`;;
+
+let connected_unions = prove_by_refinement(
+  `!U (Z1:A->bool) Z2. (connected U Z1) /\ (connected U Z2) /\
+    ~(Z1 INTER Z2 = EMPTY) ==> (connected U (Z1 UNION Z2))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[connected];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  SUBCONJ_TAC;
+  REWRITE_TAC[UNION;SUBSET;IN;IN_ELIM_THM'   ];
+  ASM_MESON_TAC[SUBSET ;IN];
+  DISCH_TAC ;
+  DISCH_ALL_TAC;
+  TYPEL_THEN [`A`;`B`] (USE 1 o SPECL);
+  REWR 1;
+  TYPEL_THEN [`A`;`B`] (USE 3 o SPECL);
+  REWR 3;
+  WITH 9 (REWRITE_RULE[union_subset]);
+  REWR 1;
+  REWR 3;
+  IMATCH_MP_TAC (TAUT  `(~b ==> a)   ==> (a \/ b)`);
+  DISCH_ALL_TAC;
+  USE 11 (REWRITE_RULE[union_subset]);
+  (* start a case *)
+  USE 4 (REWRITE_RULE[EMPTY_EXISTS]);
+  CHO 4;
+  USE 4 (REWRITE_RULE[IN;INTER;IN_ELIM_THM'  ]);
+  REWRITE_TAC[union_subset];
+  TYPE_THEN `~((Z1 SUBSET A) /\ (Z2 SUBSET B))` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  USE 8 (REWRITE_RULE[EQ_EMPTY]);
+  USE 8 (REWRITE_RULE[INTER;IN;IN_ELIM_THM' ]);
+  ASM_MESON_TAC[SUBSET;IN];
+  TYPE_THEN `~((Z2 SUBSET A) /\ (Z1 SUBSET B))` SUBGOAL_TAC;
+  DISCH_ALL_TAC;
+  USE 8 (REWRITE_RULE[EQ_EMPTY]);
+  USE 8 (REWRITE_RULE[INTER;IN;IN_ELIM_THM' ]);
+  ASM_MESON_TAC[SUBSET;IN];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let component_DEF = euclid_def `component U (x:A) y <=>
+  (?Z. (connected U Z) /\ (Z x) /\ (Z y))`;;
+
+let connected_sing = prove_by_refinement(
+  `!U (x:A). (UNIONS U x) ==> (connected U {x})`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[connected];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;IN_SING ];
+  ASM_MESON_TAC[IN];
+  DISCH_ALL_TAC;
+  UND 4;
+  SET_TAC[];
+  ]);;
+  (* }}} *)
+
+let component_refl = prove_by_refinement(
+  `!U x. (UNIONS U x) ==> (component U x (x:A))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[component_DEF];
+  ASM_MESON_TAC[IN_SING;IN;connected_sing];
+  ]);;
+  (* }}} *)
+
+let component_symm = prove_by_refinement(
+  `!U x y.  (component U x y) ==>
+   (component U (y:A) x)`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[component_DEF];
+  ]);;
+  (* }}} *)
+
+let component_trans = prove_by_refinement(
+  `!U (x:A) y z. (component U x y) /\ (component U y z) ==>
+   (component U x z)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[component_DEF];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 1;
+  TYPE_THEN `connected U (Z UNION Z')` SUBGOAL_TAC;
+  IMATCH_MP_TAC connected_unions;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[EMPTY_EXISTS ];
+  REWRITE_TAC[IN;INTER;IN_ELIM_THM' ];
+  TYPE_THEN `y` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  TYPE_THEN `Z UNION Z'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[UNION;IN;IN_ELIM_THM' ];
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+(* based on the Bolzano lemma *)
+
+let connect_real = prove_by_refinement(
+  `!a b. connected (top_of_metric (UNIV,d_real))
+    {x | a <=. x /\ x <=. b }`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[connected];
+  ASSUME_TAC metric_real;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  SUBCONJ_TAC;
+  REWRITE_TAC[UNIV;SUBSET;IN ];
+  DISCH_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `\ (u ,v ). ( u <. a) \/ (b <. v) \/ ({x | u <=. x /\ x <=. v } SUBSET A) \/ ({x | u <=. x /\ x <=. v } SUBSET B)` (fun t-> ASSUME_TAC (SPEC t BOLZANO_LEMMA ));
+  UND 6;
+  GBETA_TAC ;
+  IMATCH_MP_TAC  (TAUT `((b ==> c ) /\ a ) ==> ((a ==> b) ==> c  )`);
+  CONJ_TAC;
+  DISCH_ALL_TAC;
+  TYPEL_THEN [`a`;`b`] ((USE 6 o SPECL));
+  USE 6 (REWRITE_RULE[ARITH_RULE `~(a <. a)`]);
+  ASM_CASES_TAC `a <=. b`;
+  REWR 6;
+  TYPE_THEN `{x | a <=. x /\ x <=. b} = EMPTY ` SUBGOAL_TAC;
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IN_ELIM_THM';EMPTY];
+  GEN_TAC;
+  UND 7;
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  REWRITE_TAC[EMPTY_SUBSET];
+  CONJ_TAC;
+  DISCH_ALL_TAC;
+  UND 8;
+  UND 9;
+  (* c1 *)
+  USE 4 (REWRITE_RULE[EQ_EMPTY;INTER;IN;IN_ELIM_THM' ]);
+  TYPE_THEN `b'` (USE 4 o SPEC);
+  TYPE_THEN `{x | a' <=. x /\ x <=. b' } b'` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[IN_ELIM_THM'];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `{x | b' <=. x /\ x <=. c  } b'` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[IN_ELIM_THM'];
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  TYPE_THEN `{x | a' <=. x /\ x <=. b' } UNION {x | b' <=. x /\ x <= c  } = { x | a' <=. x /\ x <=. c }` SUBGOAL_TAC;
+  REWRITE_TAC[UNION;IN;IN_ELIM_THM'];
+  IMATCH_MP_TAC  EQ_EXT ;
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  UND 6;
+  UND 7;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* cr 1*)
+  REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC)) THEN ASM_REWRITE_TAC[] THEN (TRY (GEN_MESON_TAC 0 7 1[REAL_ARITH `(b < b' /\ b' <=. c ==> b <. c ) /\ (a' <=. b' /\ b' <. a ==> a' <. a)`]));
+  IMATCH_MP_TAC  (TAUT `c  ==> (a \/ b \/ c \/ d)`);
+  UND 10;
+  DISCH_THEN (fun t-> REWRITE_TAC [GSYM t]);
+  ASM_REWRITE_TAC[union_subset];
+  (* ASM_MESON_TAC[SUBSET;IN]; should have worked *)
+  PROOF_BY_CONTR_TAC;
+  UND 11;
+  UND 12;
+  UND 9;
+  UND 8;
+  UND 4;
+  REWRITE_TAC[SUBSET;IN];
+  TYPE_THEN `R ={x | a' <=. x /\ x <=. b'}` ABBREV_TAC;
+  TYPE_THEN `S = {x | b' <=. x /\ x <=. c}` ABBREV_TAC;
+  MESON_TAC[]; (* ok now it works *)
+  PROOF_BY_CONTR_TAC;
+  UND 11;
+  UND 12;
+  UND 9;
+  UND 8;
+  UND 4;
+  REWRITE_TAC[SUBSET;IN];
+  TYPE_THEN `R ={x | a' <=. x /\ x <=. b'}` ABBREV_TAC;
+  TYPE_THEN `S = {x | b' <=. x /\ x <=. c}` ABBREV_TAC;
+  MESON_TAC[]; (* ok now it works *)
+  IMATCH_MP_TAC  (TAUT `d  ==> (a \/ b \/ c \/ d)`);
+  UND 10;
+  DISCH_THEN (fun t-> REWRITE_TAC [GSYM t]);
+  ASM_REWRITE_TAC[union_subset];
+  (* cr 2*)
+  DISCH_ALL_TAC;
+  ASM_CASES_TAC `x <. a`;
+  TYPE_THEN `&.1` EXISTS_TAC;
+  REDUCE_TAC;
+  DISCH_ALL_TAC;
+  DISJ1_TAC ;
+  UND 7;
+  UND 6;
+  REAL_ARITH_TAC;
+  ASM_CASES_TAC `b <. x`;
+  TYPE_THEN `&.1` EXISTS_TAC;
+  REDUCE_TAC;
+  DISCH_ALL_TAC;
+  DISJ2_TAC;
+  DISJ1_TAC;
+  UND 9;
+  UND 7;
+  REAL_ARITH_TAC;
+  TYPE_THEN ` (A UNION B) x` SUBGOAL_TAC;
+  USE 5 (REWRITE_RULE[SUBSET;IN]);
+  UND 5;
+  DISCH_THEN (IMATCH_MP_TAC );
+   REWRITE_TAC[IN_ELIM_THM'];
+  UND 7;
+  UND 6;
+  REAL_ARITH_TAC;
+  DISCH_TAC;
+  (* cr3 *)
+  TYPEL_THEN [`UNIV:real -> bool`;`d_real`] (fun t-> (ASSUME_TAC (ISPECL t open_ball_nbd)));  (* --//-- *)
+  USE 8 (REWRITE_RULE[REWRITE_RULE[IN] IN_UNION]);
+  TYPE_THEN `A x` ASM_CASES_TAC; (*   *)
+  TYPE_THEN `A` (USE 9 o SPEC);
+  TYPE_THEN `x` (USE 9 o SPEC);  (* --//-- *)
+  CHO 9;
+  REWR 9;
+  USE 9 (REWRITE_RULE[open_ball;d_real;UNIV ]);
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  (TAUT `C ==> (a \/ b \/ C\/ d)`);
+  AND 9;
+  UND 9;
+  TYPE_THEN `{x | a' <=. x /\ x <=. b'} SUBSET {y | abs (x - y) <. e}` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM'];
+  GEN_TAC;
+  UND 11;
+  UND 12;
+  UND 13;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM' ];
+  MESON_TAC[];
+  REWR 8;
+  TYPE_THEN `B` (USE 9 o SPEC);
+  TYPE_THEN `x` (USE 9 o SPEC);  (* --//-- *)
+  CHO 9;
+  REWR 9;
+  USE 9 (REWRITE_RULE[open_ball;d_real;UNIV ]);
+  TYPE_THEN `e` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  IMATCH_MP_TAC  (TAUT `d ==> (a \/ b \/ C\/ d)`);
+  AND 9;
+  UND 9;
+  TYPE_THEN `{x | a' <=. x /\ x <=. b'} SUBSET {y | abs (x - y) <. e}` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM'];
+  GEN_TAC;
+  UND 11;
+  UND 12;
+  UND 13;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM' ];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let connect_image = prove_by_refinement(
+  `!f U V Z. (continuous (f:A->B) U V) /\
+    (IMAGE f Z SUBSET (UNIONS V)) /\ (connected U Z) ==>
+    (connected V (IMAGE f Z))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[connected];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  USE 0 (REWRITE_RULE[continuous;IN ]);
+  TYPE_THEN `A` (WITH 0 o SPEC);
+  TYPE_THEN `B` (USE  0 o SPEC);
+  TYPE_THEN `(preimage (UNIONS U) f A)` (USE 3 o SPEC);
+  TYPE_THEN `(preimage (UNIONS U) f B)` (USE 3 o SPEC);
+  USE 6 (MATCH_MP preimage_disjoint  );
+  TYPE_THEN `Z SUBSET preimage (UNIONS U) f A UNION preimage (UNIONS U) f B` SUBGOAL_TAC;
+  REWRITE_TAC[preimage_union];
+  ASM_REWRITE_TAC[];
+  USE 3 (REWRITE_RULE[subset_preimage ]);
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let path = euclid_def `path U x y <=>
+  (?f a b. (continuous f (top_of_metric(UNIV,d_real )) U ) /\
+    (f a = (x:A)) /\ (f b = y))`;;
+
+(**** Old proof modified by JRH to avoid use of GSPEC
+
+let const_continuous = prove_by_refinement(
+  `!U V y. (topology_ U)  ==>
+    (continuous (\ (x:A). (y:B)) U V)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[continuous];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[IN];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[preimage;IN ];
+  TYPE_THEN `v y` ASM_CASES_TAC ;
+  ASM_REWRITE_TAC[IN_ELIM_THM;GSPEC  ];
+  USE 0 (MATCH_MP top_univ);
+  TYPE_THEN`t = UNIONS U`  ABBREV_TAC;
+  UND 0;
+  REWRITE_TAC[ETA_AX];
+  ASM_REWRITE_TAC[GSPEC ];
+  USE 0 (MATCH_MP open_EMPTY);
+  USE 0 (REWRITE_RULE[open_DEF ;EMPTY]);
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+****)
+
+let const_continuous = prove_by_refinement(
+  `!U V y. (topology_ U)  ==>
+    (continuous (\ (x:A). (y:B)) U V)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[continuous];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[IN];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[preimage;IN ];
+  TYPE_THEN `v y` ASM_CASES_TAC ;
+  ASM_REWRITE_TAC[IN_ELIM_THM];
+  USE 0 (MATCH_MP top_univ);
+  TYPE_THEN`t = UNIONS U`  ABBREV_TAC;
+  UND 0;
+  MATCH_MP_TAC(TAUT `(a <=> b) ==> a ==> b`);
+  AP_TERM_TAC;
+  REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN];
+  USE 0 (MATCH_MP open_EMPTY);
+  USE 0 (REWRITE_RULE[open_DEF ;EMPTY]);
+  ASM_REWRITE_TAC[];
+  SUBGOAL_THEN `{x:A | F} = \x. F` SUBST1_TAC;
+  REWRITE_TAC[EXTENSION; IN; IN_ELIM_THM];
+  ASM_REWRITE_TAC[]
+  ]);;
+  (* }}} *)
+
+let path_component = euclid_def `path_component U x y <=>
+  (?f a b. (continuous f (top_of_metric(UNIV,d_real )) U ) /\ (a <. b) /\
+    (f a = (x:A)) /\ (f b = y) /\
+    (IMAGE f { t | a <=. t /\ t <=. b } SUBSET (UNIONS U)))`;;
+
+let path_refl = prove_by_refinement(
+  `!U x.  (UNIONS U x) ==> (path_component U x (x:A))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASSUME_TAC (top_of_metric_top );
+  TYPEL_THEN [`UNIV:real ->bool`;`d_real`] (USE 1 o ISPECL);
+  USE 1 (REWRITE_RULE[metric_real ]);
+  USE 1 (MATCH_MP const_continuous);
+  REWRITE_TAC[path_component];
+  TYPE_THEN `(\ (t:real). x)` EXISTS_TAC;
+  ASM_REWRITE_TAC[IMAGE;IN;];
+  TYPE_THEN `&.0` EXISTS_TAC;
+  TYPE_THEN `&.1` EXISTS_TAC;
+  CONJ_TAC;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[SUBSET;IN;IN_ELIM_THM'];
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+let path_symm = prove_by_refinement(
+`!U x y . (path_component U x (y:A)) ==> (path_component U y (x:A))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[path_component];
+  DISCH_ALL_TAC;
+  (CHO 0);
+  (CHO 0);
+  (CHO 0);
+  TYPE_THEN `f o (--.)` EXISTS_TAC;
+  TYPE_THEN `--. b` EXISTS_TAC;
+  TYPE_THEN `--. a` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  continuous_comp;
+  TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC;
+  REWRITE_TAC[neg_cont];
+  SIMP_TAC[top_of_metric_top;  metric_real;  metric_euclidean;  metric_euclid;  metric_hausdorff;  GSYM top_of_metric_unions;  open_ball_open;];
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[UNIV;IN;SUBSET  ];
+  CONJ_TAC ;
+  AND 0;
+  AND 0;
+  UND 2;
+  REAL_ARITH_TAC ;
+  REWRITE_TAC[o_DEF ;];
+  REDUCE_TAC ;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  REWRITE_TAC[IMAGE;IN;SUBSET;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  DISCH_ALL_TAC;
+  CHO 5;
+  USE 4 (CONV_RULE NAME_CONFLICT_CONV );
+  TYPE_THEN `x'` (USE 4 o SPEC);
+  UND 4;
+  DISCH_THEN IMATCH_MP_TAC ;
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `--. x''` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 5;
+  REAL_ARITH_TAC ;
+  ]);;
+
+  (* }}} *)
+
+let path_symm_eq = prove_by_refinement(
+`!U x y . (path_component U x (y:A)) <=> (path_component U y (x:A))`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[path_symm];
+  ]);;
+  (* }}} *)
+
+
+let path_trans = prove_by_refinement(
+  `!U x y (z:A). (path_component U x y) /\ (path_component U y z) ==>
+  (path_component U x z)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[path_component];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  CHO 0;
+  CHO 1;
+  CHO 1;
+  CHO 1;
+  TYPE_THEN `joinf f (f' o ((+.) (a' -. b))) b` EXISTS_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b' +. (b - a')` EXISTS_TAC;
+  CONJ_TAC; (* start of continuity *)
+  IMATCH_MP_TAC  joinf_cont;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  continuous_comp;
+  TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC;
+  ASM_REWRITE_TAC [top_of_metric_top;  metric_real;  metric_euclidean;  metric_euclid;  metric_hausdorff;  GSYM top_of_metric_unions;  open_ball_open;];
+  REWRITE_TAC[add_cont];
+  ASM_SIMP_TAC [top_of_metric_top;  metric_real;  metric_euclidean;  metric_euclid;  metric_hausdorff;  GSYM top_of_metric_unions;  open_ball_open;];
+  REWRITE_TAC[SUBSET;UNIV;IN;IN_ELIM_THM'];
+  REWRITE_TAC[o_DEF];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[]; (* end of continuity *)
+  CONJ_TAC; (* start real ineq *)
+  AND 1;
+  AND 1;
+  AND 0;
+  AND 0;
+  UND 5;
+  UND 3;
+  REAL_ARITH_TAC; (* end of real ineq *)
+  CONJ_TAC;
+  REWRITE_TAC[joinf;o_DEF];
+  ASM_REWRITE_TAC[]; (* end of JOIN statement *)
+  CONJ_TAC; (* next JOIN statement *)
+  REWRITE_TAC[joinf;o_DEF];
+  TYPE_THEN `~(b' +. b -. a' <. b)` SUBGOAL_TAC;
+  TYPE_THEN `(a' <. b') /\ (a <. b)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  TYPE_THEN ` a' -. b +. b' +. b -. a' = b'` SUBGOAL_TAC;
+  REAL_ARITH_TAC ;
+    DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  ASM_REWRITE_TAC[]; (* end of next joinf *)
+  TYPE_THEN `(a <=. b) /\ (b <=. (b' + b - a'))` SUBGOAL_TAC; (* subreal *)
+  TYPE_THEN `(a' <. b') /\ (a <. b)` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_TAC; (* end of subreal *)
+  USE 2 (MATCH_MP union_closed_interval);
+  UND 2;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  REWRITE_TAC[IMAGE_UNION;union_subset];
+  CONJ_TAC; (* start of FIRST interval *)
+  TYPE_THEN `IMAGE (joinf f (f' o (+.) (a' -. b)) b) {t | a <=. t /\ t <. b} = IMAGE f {t | a <=. t /\ t <. b}` SUBGOAL_TAC;
+  REWRITE_TAC[joinf;IMAGE;IN_IMAGE ];
+  IMATCH_MP_TAC  EQ_EXT;
+  X_GEN_TAC `t:A`;
+  REWRITE_TAC[IN_ELIM_THM'];
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 2;
+  UND 2;
+  DISCH_ALL_TAC;
+  REWR 4;
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  CHO 2;
+  UND 2;
+  DISCH_ALL_TAC;
+ TYPE_THEN `x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (fun t-> REWRITE_TAC[t]); (* FIRST interval still *)
+  TYPE_THEN `IMAGE f {t | a <=. t /\ t <. b} SUBSET IMAGE f {t | a <=. t /\ t <=. b} ` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;IN_IMAGE ;IN_ELIM_THM'];
+  GEN_TAC;
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  MESON_TAC[REAL_ARITH `a <. b ==> a<=. b`];
+  KILL 1;
+  UND 0;
+  DISCH_ALL_TAC;
+  JOIN 0 5;
+  USE 0 (MATCH_MP SUBSET_TRANS );
+  ASM_REWRITE_TAC[]; (* end of FIRST interval *)
+  (* lc 1*)
+  TYPE_THEN `IMAGE (joinf f (f' o (+.) (a' -. b)) b) {t | b <=. t /\ t <=. b' + b -. a'}  = IMAGE f' {t | a' <=. t /\ t <=. b'}` SUBGOAL_TAC;
+  REWRITE_TAC[joinf;IMAGE;IN_IMAGE ];
+  IMATCH_MP_TAC  EQ_EXT;
+  REWRITE_TAC[IN_ELIM_THM'];
+  NAME_CONFLICT_TAC ;
+  X_GEN_TAC `t:A`;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  CHO 2;
+  UND 2;
+  DISCH_ALL_TAC;
+  TYPE_THEN `~(x' <. b)` SUBGOAL_TAC;
+  UND 2;
+  REAL_ARITH_TAC ;
+  DISCH_TAC ;
+  REWR 4;
+  USE 4 (REWRITE_RULE[o_DEF]);
+  TYPE_THEN `a' -. b +. x'` EXISTS_TAC; (* * *)
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `(a' <. b') /\ (a <. b) /\ (b <=. x') /\ (x' <=. b' +. b -. a')` SUBGOAL_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  DISCH_ALL_TAC;
+  CHO 2;
+  UND 2;
+  DISCH_ALL_TAC;
+  TYPE_THEN `x' +. b -. a'` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  SUBCONJ_TAC;
+  UND 2;
+  UND 3;
+  REAL_ARITH_TAC;
+  DISCH_ALL_TAC;
+  TYPE_THEN `~(x' +. b -. a' <. b)` SUBGOAL_TAC;
+  UND 5;
+  REAL_ARITH_TAC ;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  REWRITE_TAC[o_DEF];
+  AP_TERM_TAC;
+  REAL_ARITH_TAC ;
+  DISCH_THEN (fun t -> REWRITE_TAC [t]);
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let loc_path_conn = euclid_def `loc_path_conn U <=>
+  !A x. (U A) /\ (A (x:A)) ==>
+       (U (path_component (induced_top U A) x))`;;
+
+
+let path_eq_conn = prove_by_refinement(
+  `!U (x:A). (loc_path_conn U) /\ (topology_ U) ==>
+    (path_component U x = component U x)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC EQ_EXT;
+  X_GEN_TAC `y:A`;
+  EQ_TAC ;
+  REWRITE_TAC[path_component];
+  DISCH_ALL_TAC;
+  CHO 2;
+  CHO 2;
+  CHO 2;
+  UND 2 THEN DISCH_ALL_TAC;
+  REWRITE_TAC[component_DEF];
+  TYPE_THEN `IMAGE f {t | a <= t /\ t <= b}` EXISTS_TAC;
+  CONJ_TAC;
+  IMATCH_MP_TAC  connect_image ;
+  NAME_CONFLICT_TAC;
+  TYPE_THEN `(top_of_metric (UNIV,d_real))` EXISTS_TAC ;
+  ASM_REWRITE_TAC[connect_real ];
+  REWRITE_TAC[IMAGE;IN;IN_ELIM_THM' ];
+  CONJ_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 3;
+  REAL_ARITH_TAC ;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 3;
+  REAL_ARITH_TAC;
+  REWRITE_TAC[component_DEF];
+  DISCH_ALL_TAC;
+  CHO 2;
+  UND 2 THEN DISCH_ALL_TAC;
+  USE 2 (REWRITE_RULE[connected]);
+  UND 2 THEN DISCH_ALL_TAC;
+  TYPE_THEN `path_component U x` (USE 5 o SPEC);
+  TYPE_THEN `A = path_component U x` ABBREV_TAC;
+  TYPE_THEN `B = UNIONS (IMAGE (\z. (path_component U z)) (Z DIFF A))` ABBREV_TAC ;
+  TYPE_THEN `B` (USE 5 o SPEC);
+  TYPE_THEN `U A /\ U B /\ (A INTER B = {}) /\ Z SUBSET A UNION B` SUBGOAL_TAC;
+  WITH  0 (REWRITE_RULE[loc_path_conn]);
+  TYPE_THEN `(UNIONS U)` (USE 8 o SPEC);
+  TYPE_THEN `x` (USE   8 o SPEC);
+  UND 8;
+  ASM_SIMP_TAC[induced_top_unions];
+  ASM_SIMP_TAC[top_univ];
+  TYPE_THEN `UNIONS U x` SUBGOAL_TAC;
+  USE 2 (REWRITE_RULE[SUBSET;IN;]);
+  ASM_MESON_TAC[];
+  DISCH_ALL_TAC;
+  REWR 8;
+  ASM_REWRITE_TAC[];
+  (* dd *)
+  CONJ_TAC;
+  EXPAND_TAC "B";
+  WITH  1 (REWRITE_RULE[topology]);
+  TYPEL_THEN [`EMPTY:A->bool`;`EMPTY:A->bool`;`(IMAGE (\z. path_component U z) (Z DIFF A))`] (USE 10 o ISPECL);
+  UND 10 THEN DISCH_ALL_TAC;
+  UND 12 THEN (DISCH_THEN IMATCH_MP_TAC );
+  REWRITE_TAC[SUBSET;IN_IMAGE];
+  REWRITE_TAC[IN];
+  NAME_CONFLICT_TAC;
+  DISCH_ALL_TAC;
+  CHO 12;
+  ASM_REWRITE_TAC[];
+  USE 0 (REWRITE_RULE[loc_path_conn]);
+  TYPE_THEN `(UNIONS U)` (USE 0 o SPEC);
+  USE 0 (  CONV_RULE NAME_CONFLICT_CONV);
+  TYPE_THEN `x'` (USE   0 o SPEC);
+  UND 0;
+  ASM_SIMP_TAC[induced_top_unions];
+  DISCH_THEN MATCH_MP_TAC;
+  ASM_SIMP_TAC[top_univ];
+  AND 12;
+  USE 2 (REWRITE_RULE[SUBSET;IN]);
+  USE 0 (REWRITE_RULE[DIFF;IN;IN_ELIM_THM' ]);
+  ASM_MESON_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[EQ_EMPTY];
+  DISCH_ALL_TAC;
+  USE 10 (REWRITE_RULE[INTER;IN;IN_ELIM_THM' ]);
+  AND 10;
+  UND 10;
+  EXPAND_TAC "B";
+  REWRITE_TAC[UNIONS;IN_IMAGE ;IN_ELIM_THM' ];
+  REWRITE_TAC[IN];
+  LEFT_TAC "u";
+  DISCH_ALL_TAC;
+  AND 10;
+  CHO 12;
+  AND 12;
+  REWR 10;
+  UND 11;
+  EXPAND_TAC "A";
+  USE 10 (ONCE_REWRITE_RULE [path_symm_eq]);
+  DISCH_TAC;
+  JOIN 11 10;
+  USE 10 (MATCH_MP path_trans);
+  REWR 10;
+  UND 10;
+  UND 12;
+  REWRITE_TAC[DIFF;IN;IN_ELIM_THM'];
+  MESON_TAC[];
+  REWRITE_TAC[SUBSET;IN;UNION;IN_ELIM_THM'];
+  DISCH_ALL_TAC;
+  TYPE_THEN `A x'` ASM_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  DISJ2_TAC ;
+  EXPAND_TAC "B";
+  REWRITE_TAC[UNIONS;IN_IMAGE;IN_ELIM_THM' ];
+  REWRITE_TAC[IN];
+  LEFT_TAC "x";
+  LEFT_TAC "x";
+  TYPE_THEN `x'` EXISTS_TAC;
+  TYPE_THEN `path_component U x'` EXISTS_TAC;
+  ASM_REWRITE_TAC[DIFF;IN;IN_ELIM_THM' ];
+  IMATCH_MP_TAC  path_refl;
+  USE 2 (REWRITE_RULE[SUBSET;IN]);
+  ASM_MESON_TAC[];
+  DISCH_TAC ;
+  REWR 5;
+  UND 5;
+  DISCH_THEN DISJ_CASES_TAC ;
+  USE 5 (REWRITE_RULE[SUBSET;IN ;]);
+  ASM_MESON_TAC[];
+  UND 8 THEN DISCH_ALL_TAC;
+  USE 10 (REWRITE_RULE[EQ_EMPTY]);
+  TYPE_THEN `x` (USE 10 o SPEC);
+  USE 10 (REWRITE_RULE[INTER;IN;IN_ELIM_THM']);
+  USE 5 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM']);
+  TYPE_THEN `A x` SUBGOAL_TAC;
+  EXPAND_TAC "A";
+  IMATCH_MP_TAC  path_refl ;
+  USE 2 (REWRITE_RULE[SUBSET;IN;IN_ELIM_THM']);
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+
+let open_ball_star = prove_by_refinement(
+  `!x r y t n. (open_ball(euclid n,d_euclid) x r y) /\
+    (&.0 <=. t) /\ (t <=. &.1) ==>
+   (open_ball(euclid n,d_euclid) x r ((t *# x + (&.1-t)*#y)))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[open_ball;IN_ELIM_THM' ];
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[euclid_scale_closure;euclid_add_closure];
+  GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [GSYM trivial_lin_combo];
+  ASSUME_TAC (SPEC `n:num` metric_translate_LEFT);
+  TYPEL_THEN [`(&.1 - t) *# x`;`(&.1 - t)*# y`;`t *# x`] (USE 5 o ISPECL);
+  UND 5;
+  ASM_SIMP_TAC [euclid_scale_closure];
+  ASM_MESON_TAC[norm_scale_vec;REAL_ARITH  `(&.0 <=. t) /\ (t <=. (&.1)) ==> (||. (&.1 - t) <=. &.1)`;REAL_ARITH `(b <= a) ==> ((a < C) ==> (b < C))`;GSYM REAL_MUL_LID;REAL_LE_RMUL;d_euclid_pos];
+  ]);;
+
+  (* }}} *)
+
+let open_ball_path = prove_by_refinement(
+  `!x r y n. (open_ball(euclid n,d_euclid) x r y) ==>
+    (path_component
+      (top_of_metric(open_ball(euclid n,d_euclid) x r,d_euclid)) y x)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[path_component ;];
+  DISCH_ALL_TAC;
+  TYPE_THEN `(\t. (t *# x + (&.1 - t) *# y))` EXISTS_TAC;
+  EXISTS_TAC `&.0`;
+  EXISTS_TAC `&.1`;
+  REDUCE_TAC;
+  TYPE_THEN `top_of_metric (open_ball (euclid n,d_euclid) x r,d_euclid) = (induced_top(top_of_metric(euclid n,d_euclid)) (open_ball (euclid n,d_euclid) x r))` SUBGOAL_TAC;
+  ASM_MESON_TAC[open_ball_subset;metric_euclid;top_of_metric_induced ];
+  DISCH_TAC ;
+  TYPE_THEN `euclid n x /\ euclid n y` SUBGOAL_TAC;
+  USE 0 (REWRITE_RULE[open_ball;IN_ELIM_THM' ]);
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC continuous_induced;
+  ASM_SIMP_TAC [top_of_metric_top;metric_euclid;open_ball_open];
+  IMATCH_MP_TAC  continuous_lin_combo ;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  REWRITE_TAC[euclid_plus;euclid_scale];
+  IMATCH_MP_TAC  EQ_EXT THEN BETA_TAC ;
+  REDUCE_TAC;
+  CONJ_TAC;
+  REWRITE_TAC[euclid_plus;euclid_scale];
+  IMATCH_MP_TAC  EQ_EXT THEN BETA_TAC ;
+  REDUCE_TAC;
+  REWRITE_TAC[SUBSET;IN_IMAGE;Q_ELIM_THM'' ];
+  REWRITE_TAC[IN;IN_ELIM_THM'];
+  TYPE_THEN `(UNIONS (top_of_metric (open_ball (euclid n,d_euclid) x r,d_euclid))) = (open_ball(euclid n,d_euclid) x r)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  (GSYM top_of_metric_unions);
+  IMATCH_MP_TAC  metric_subspace;
+  ASM_MESON_TAC[metric_euclid;open_ball_subset];
+  DISCH_THEN (fun t->REWRITE_TAC[t]);
+  ASM_MESON_TAC [open_ball_star];
+  ]);;
+
+  (* }}} *)
+
+let path_domain = prove_by_refinement(
+  `!U x (y:A). path_component U x y <=>
+  (?f a b. (continuous f (top_of_metric(UNIV,d_real )) U ) /\ (a <. b) /\
+    (f a = (x:A)) /\ (f b = y) /\
+    (IMAGE f UNIV SUBSET (UNIONS U)))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[path_component];
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  DISCH_TAC ;
+  CHO 0;
+  CHO 0;
+  CHO 0;
+  TYPE_THEN `joinf (\t. (f a)) (joinf f (\t. (f b)) b) a` EXISTS_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  IMATCH_MP_TAC  joinf_cont;
+  ASM_SIMP_TAC[const_continuous;top_of_metric_top;metric_real];
+  CONJ_TAC;
+  IMATCH_MP_TAC  joinf_cont;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[const_continuous;top_of_metric_top;metric_real];
+  REWRITE_TAC[joinf];
+  ASM_REWRITE_TAC[];
+  CONJ_TAC;
+  ASM_REWRITE_TAC[joinf;REAL_ARITH `~(a<a)`];
+  CONJ_TAC;
+  UND 0;
+  DISCH_ALL_TAC;
+  USE 1 (MATCH_MP (REAL_ARITH `(a < b) ==> (~(b < a))`));
+  ASM_REWRITE_TAC  [joinf;REAL_ARITH `~(b < b)`];
+  REWRITE_TAC[SUBSET;IN_IMAGE;Q_ELIM_THM'';joinf   ];
+  REWRITE_TAC[IN_UNIV];
+  GEN_TAC;
+  UND 0;
+  DISCH_ALL_TAC;
+  USE 4 (REWRITE_RULE[SUBSET;IN_IMAGE;Q_ELIM_THM'';]);
+  USE 4 (REWRITE_RULE[IN;IN_ELIM_THM' ]);
+  (* cc1 *)
+  TYPE_THEN `a` (WITH 4 o SPEC);
+  TYPE_THEN `b` (WITH  4 o SPEC);
+  TYPE_THEN `x'` (USE 4 o SPEC);
+  DISJ_CASES_TAC (REAL_ARITH `x' < a \/ (a <= x')`);
+  ASM_REWRITE_TAC[IN];
+  ASM_MESON_TAC[REAL_ARITH `(a <=a) /\ ((a < b) ==> (a <= b))`];
+  DISJ_CASES_TAC (REAL_ARITH `x' < b \/ (b <= x')`);
+  REWR 4;
+  USE 7 (MATCH_MP (REAL_ARITH `a <= x' ==> (~(x' < a))`));
+  ASM_REWRITE_TAC[IN ];
+  ASM_MESON_TAC[REAL_ARITH `x' < b ==> x' <= b`];
+  USE 7 (MATCH_MP (REAL_ARITH `a <= x' ==> (~(x' < a))`));
+  ASM_REWRITE_TAC[];
+  USE 8 (MATCH_MP (REAL_ARITH `b <= x' ==> ~(x' < b)`));
+  ASM_REWRITE_TAC[IN];
+  ASM_MESON_TAC[REAL_ARITH `b <=b /\ ((a < b) ==> (a <= b))`];
+  DISCH_TAC ;
+  CHO 0;
+  CHO 0;
+  CHO 0;
+  TYPE_THEN `f` EXISTS_TAC;
+  TYPE_THEN `a ` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  UND 0;
+  REWRITE_TAC[SUBSET;IN_IMAGE ;Q_ELIM_THM''];
+  REWRITE_TAC[IN_UNIV];
+  REWRITE_TAC[IN;IN_ELIM_THM'];
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let path_component_subspace = prove_by_refinement(
+  `!X Y d (y:A). ((Y SUBSET X) /\ (metric_space(X,d) /\ (Y y))) ==>
+    ((path_component(top_of_metric(Y,d)) y) SUBSET
+      (path_component(top_of_metric(X,d)) y))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[SUBSET;IN;path_domain];
+  DISCH_ALL_TAC;
+  CHO 3;
+  CHO 3;
+  CHO 3;
+  TYPE_THEN `f` EXISTS_TAC;
+  TYPE_THEN `a` EXISTS_TAC;
+  TYPE_THEN `b` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `metric_space(Y,d)` SUBGOAL_TAC;
+  ASM_MESON_TAC[metric_subspace];
+  DISCH_TAC;
+  UND 3;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions];
+  DISCH_ALL_TAC;
+  CONJ_TAC;
+  UND 3;
+  TYPE_THEN `IMAGE f UNIV SUBSET X /\ IMAGE f UNIV SUBSET Y` SUBGOAL_TAC;
+  ASM_MESON_TAC[SUBSET;IN];
+  DISCH_TAC;
+  ASM_SIMP_TAC[metric_continuous_continuous;metric_real];
+  REWRITE_TAC[metric_continuous;metric_continuous_pt];
+  ASM_MESON_TAC[SUBSET;IN];
+  ]);;
+  (* }}} *)
+
+let path_component_in  = prove_by_refinement(
+  `!x (y:A) U. (path_component U x y) ==> (UNIONS U y)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[path_component];
+  DISCH_ALL_TAC;
+  CHO 0;
+  CHO 0;
+  CHO 0;
+  UND 0;
+  DISCH_ALL_TAC;
+  USE 4 (REWRITE_RULE[SUBSET;IN_IMAGE;Q_ELIM_THM'']);
+  USE 4 (REWRITE_RULE[IN_ELIM_THM';IN]);
+  TYPE_THEN `b` (USE 4 o SPEC);
+  ASM_MESON_TAC[REAL_ARITH `(a < b) ==> ((a<=. b) /\ (b <= b))`];
+  ]);;
+  (* }}} *)
+
+let loc_path_conn_euclid = prove_by_refinement(
+  `!n A. (top_of_metric(euclid n,d_euclid)) A ==>
+   (loc_path_conn (top_of_metric(A,d_euclid)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[loc_path_conn];
+  DISCH_ALL_TAC;
+  TYPE_THEN `metric_space (A,d_euclid)` SUBGOAL_TAC;
+  IMATCH_MP_TAC  metric_subspace;
+  TYPE_THEN `euclid n` EXISTS_TAC;
+  REWRITE_TAC[metric_euclid];
+  USE 0 (MATCH_MP sub_union);
+  ASM_MESON_TAC[top_of_metric_unions;metric_euclid];
+  DISCH_ALL_TAC;
+  WITH  3 (MATCH_MP top_of_metric_nbd);
+  UND 4;
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  TYPE_THEN `A' SUBSET A` SUBGOAL_TAC;
+  USE 1 (MATCH_MP sub_union);
+  ASM_MESON_TAC[top_of_metric_unions];
+  DISCH_TAC;
+  ASM_SIMP_TAC[top_of_metric_induced];
+  TYPE_THEN `metric_space(A',d_euclid)` SUBGOAL_TAC;
+  ASM_MESON_TAC[metric_subspace];
+  DISCH_TAC ;
+  SUBCONJ_TAC;
+  REWRITE_TAC[SUBSET;IN];
+  REWRITE_TAC[path_component];
+  DISCH_ALL_TAC;
+  CHO 6;
+  CHO 6;
+  CHO 6;
+  USE 6 (REWRITE_RULE[SUBSET;IN_IMAGE ;IN_ELIM_THM';Q_ELIM_THM'']);
+  UND 6;
+  DISCH_ALL_TAC;
+  TYPE_THEN `b` (USE 10 o SPEC);
+  USE 4 (REWRITE_RULE[SUBSET;IN]);
+  UND 4;
+  DISCH_THEN IMATCH_MP_TAC ;
+  USE 5 (MATCH_MP top_of_metric_unions);
+  UND 10;
+  UND 4;
+  DISCH_THEN (fun t -> ONCE_REWRITE_TAC[GSYM t]);
+  ASM_REWRITE_TAC[IN];
+  ASM_MESON_TAC[REAL_ARITH `b <=. b /\ ((a < b)==> (a <=. b))`];
+  DISCH_TAC;
+  REWRITE_TAC[IN];
+  DISCH_ALL_TAC;
+  (* c2 *)
+  WITH 7 (MATCH_MP path_component_in);
+  TYPE_THEN `A' a` SUBGOAL_TAC;
+  UND 8;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;];
+  DISCH_TAC;
+  TYPE_THEN `A SUBSET (euclid n)` SUBGOAL_TAC;
+  USE 0 (MATCH_MP sub_union);
+  UND 0;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions;metric_euclid];
+  DISCH_TAC;
+  TYPE_THEN `top_of_metric(euclid n,d_euclid) A'` SUBGOAL_TAC;
+  IMATCH_MP_TAC  induced_trans;
+  TYPE_THEN `A` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[top_of_metric_top;metric_euclid;top_of_metric_induced ];
+  DISCH_TAC;
+  COPY 11;
+  UND 12;
+  SIMP_TAC[top_of_metric_nbd;metric_euclid];
+  DISCH_ALL_TAC;
+  TYPE_THEN `a` (USE 13 o SPEC);
+  USE 13 (REWRITE_RULE[IN]);
+  REWR 13;
+  CHO 13;
+  TYPE_THEN `r` EXISTS_TAC;
+  ASM_REWRITE_TAC[];
+  TYPE_THEN `open_ball (A,d_euclid) a r SUBSET path_component (top_of_metric (A',d_euclid)) a` SUBGOAL_TAC ;
+  TYPE_THEN `open_ball (euclid n,d_euclid) a r SUBSET path_component (top_of_metric (A',d_euclid)) a` SUBGOAL_TAC ;
+  TYPE_THEN `open_ball (euclid n,d_euclid) a r SUBSET  path_component (top_of_metric ((open_ball(euclid n,d_euclid) a r),d_euclid)) a` SUBGOAL_TAC;
+  REWRITE_TAC[SUBSET;IN];
+  MESON_TAC[open_ball_path;SUBSET;IN;path_symm];
+  IMATCH_MP_TAC  (prove_by_refinement(`!A B C. (B:A->bool) SUBSET C ==> (A SUBSET B ==> A SUBSET C)`,[MESON_TAC[SUBSET_TRANS]]));
+  IMATCH_MP_TAC  path_component_subspace;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  (REWRITE_RULE[IN] open_ball_nonempty);
+  ASM_SIMP_TAC[metric_euclid];
+  ASM_MESON_TAC[SUBSET;IN];
+  IMATCH_MP_TAC  (prove_by_refinement (`!A B C. (A:A->bool) SUBSET B ==> (B SUBSET C ==> A SUBSET C)`,[MESON_TAC[SUBSET_TRANS]]));
+  ASM_SIMP_TAC[open_ball_subspace];
+  IMATCH_MP_TAC  (prove_by_refinement(`!A B C. (B:A->bool) SUBSET C ==> (A SUBSET B ==> A SUBSET C)`,[MESON_TAC[SUBSET_TRANS]]));
+  REWRITE_TAC[SUBSET;IN];
+  GEN_TAC;
+  UND 7;
+  MESON_TAC[path_trans];
+  ]);;
+  (* }}} *)
+
+let loc_path_euclid_cor = prove_by_refinement(
+  `!n A . (top_of_metric(euclid n,d_euclid)) A ==>
+     (path_component (top_of_metric(A,d_euclid)) =
+      component (top_of_metric(A,d_euclid)))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  WITH 0 (MATCH_MP loc_path_conn_euclid);
+  IMATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  IMATCH_MP_TAC path_eq_conn;
+  ASM_REWRITE_TAC[];
+  IMATCH_MP_TAC  top_of_metric_top;
+  USE 0 (MATCH_MP sub_union);
+  UND 0;
+  ASM_SIMP_TAC[GSYM top_of_metric_unions ;metric_euclid];
+  ASM_MESON_TAC[metric_subspace;metric_euclid];
+  ]);;
+  (* }}} *)

diff --git a/Jordan/misc_defs_and_lemmas.ml b/Jordan/misc_defs_and_lemmas.ml
new file mode 100644 (file)
index 0000000..af43e93
--- /dev/null
+++ b/Jordan/misc_defs_and_lemmas.ml
@@ -0,0 +1,2285 @@
+
+labels_flag:= true;;
+
+let dirac_delta = new_definition `dirac_delta (i:num) =
+     (\j. if (i=j) then (&.1) else (&.0))`;;
+
+let min_num = new_definition
+  `min_num (X:num->bool) = @m. (m IN X) /\ (!n. (n IN X) ==> (m <= n))`;;
+
+let min_least = prove_by_refinement (
+  `!(X:num->bool) c. (X c) ==> (X (min_num X) /\ (min_num X <=| c))`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[min_num;IN];
+  REPEAT GEN_TAC;
+  DISCH_TAC;
+  SUBGOAL_THEN `?n. (X:num->bool) n /\ (!m. m <| n ==> ~X m)` MP_TAC;
+    REWRITE_TAC[(GSYM (ISPEC `X:num->bool` num_WOP))];
+    ASM_MESON_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  ASSUME_TAC (select_thm `\m. (X:num->bool) m /\ (!n. X n ==> m <=| n)` `n:num`);
+  ABBREV_TAC `r = @m. (X:num->bool) m /\ (!n. X n ==> m <=| n)`;
+  ASM_MESON_TAC[ ARITH_RULE `~(n' < n) ==> (n <=| n') `]
+  ]);;
+
+  (* }}} *)
+
+let max_real = new_definition(`max_real x y =
+        if (y <. x) then x else y`);;
+
+let min_real = new_definition(`min_real x y =
+        if (x <. y) then x else y`);;
+
+let deriv = new_definition(`deriv f x = @d. (f diffl d)(x)`);;
+let deriv2 = new_definition(`deriv2 f = (deriv (deriv f))`);;
+
+let square_le = prove_by_refinement(
+  `!x y. (&.0 <=. x) /\ (&.0 <=. y) /\ (x*.x <=. y*.y) ==> (x <=. y)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  UNDISCH_FIND_TAC `( *. )` ;
+  ONCE_REWRITE_TAC[REAL_ARITH `(a <=. b) <=> (&.0 <= (b - a))`];
+  REWRITE_TAC[GSYM REAL_DIFFSQ];
+  DISCH_TAC;
+  DISJ_CASES_TAC (REAL_ARITH `&.0 < (y+x) \/ (y+x <=. (&.0))`);
+  MATCH_MP_TAC (SPEC `(y+x):real` REAL_LE_LCANCEL_IMP);
+  ASM_REWRITE_TAC [REAL_ARITH `x * (&.0) = (&.0)`];
+  CLEAN_ASSUME_TAC (REAL_ARITH `(&.0 <= y) /\ (&.0 <=. x) /\ (y+x <= (&.0)) ==> ((x= &.0) /\ (y= &.0))`);
+  ASM_REWRITE_TAC[REAL_ARITH `&.0 <=. (&.0 -. (&.0))`];
+  ]);;
+
+  (* }}} *)
+
+let max_num_sequence = prove_by_refinement(
+  `!(t:num->num). (?n. !m. (n <=| m) ==> (t m = 0)) ==>
+      (?M. !i. (t i <=| M))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[GSYM LEFT_FORALL_IMP_THM];
+  GEN_TAC;
+  SPEC_TAC (`t:num->num`,`t:num->num`);
+  SPEC_TAC (`n:num`,`n:num`);
+  INDUCT_TAC;
+  GEN_TAC;
+  REWRITE_TAC[ARITH_RULE `0<=|m`];
+  DISCH_TAC;
+  EXISTS_TAC `0`;
+  ASM_MESON_TAC[ARITH_RULE`(a=0) ==> (a <=|0)`];
+  DISCH_ALL_TAC;
+  ABBREV_TAC `b = \m. (if (m=n) then 0 else (t (m:num)) )`;
+  FIRST_ASSUM (fun t-> ASSUME_TAC (SPEC `b:num->num` t));
+  SUBGOAL_TAC `((b:num->num) (n) = 0) /\ (!m. ~(m=n) ==> (b m = t m))`;
+  EXPAND_TAC "b";
+  CONJ_TAC;
+  COND_CASES_TAC;
+  REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  GEN_TAC;
+  COND_CASES_TAC;
+  REWRITE_TAC[];
+  REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  FIRST_ASSUM (fun t-> MP_TAC(SPEC `b:num->num` t));
+  SUBGOAL_TAC `!m. (n<=|m) ==> (b m =0)`;
+  GEN_TAC;
+  ASM_CASES_TAC `m = (n:num)`;
+  ASM_REWRITE_TAC[];
+  SUBGOAL_TAC ( `(n <=| m) /\ (~(m = n)) ==> (SUC n <=| m)`);
+  ARITH_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  ASM_MESON_TAC[]; (* good *)
+  DISCH_THEN (fun t-> REWRITE_TAC[t]);
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `(M:num) + (t:num->num) n`;
+  GEN_TAC;
+  ASM_CASES_TAC `(i:num) = n`;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  MATCH_MP_TAC (ARITH_RULE `x <=| M ==> (x <=| M+ u)`);
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let REAL_INV_LT = prove_by_refinement(
+  `!x y z. (&.0 <. x) ==> ((inv(x)*y < z) <=> (y <. x*z))`,
+  (* {{{ proof *)
+  [
+  REPEAT GEN_TAC;
+  DISCH_TAC;
+  REWRITE_TAC[REAL_ARITH `inv x * y = y* inv x`];
+  REWRITE_TAC[GSYM real_div];
+  ASM_SIMP_TAC[REAL_LT_LDIV_EQ];
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let REAL_MUL_NN = prove_by_refinement(
+  `!x y. (&.0 <= x*y) <=>
+    ((&.0 <= x /\ (&.0 <=. y)) \/ ((x <= &.0) /\ (y <= &.0) ))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `! x y. ((&.0 < x) ==> ((&.0 <= x*y) <=> ((&.0 <= x /\ (&.0 <=. y)) \/ ((x <= &.0) /\ (y <= &.0) ))))`;
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[REAL_ARITH `((&.0 <. x) ==> (&.0 <=. x))`;REAL_ARITH `(&.0 <. x) ==> ~(x <=. &.0)`];
+  EQ_TAC;
+  ASM_MESON_TAC[REAL_PROP_NN_LCANCEL];
+  ASM_MESON_TAC[REAL_LE_MUL;REAL_LT_IMP_LE];
+  DISCH_TAC;
+  DISJ_CASES_TAC (REAL_ARITH `(&.0 < x) \/ (x = &.0) \/ (x < &.0)`);
+  ASM_MESON_TAC[];
+  UND 1 THEN DISCH_THEN  DISJ_CASES_TAC;
+  ASM_REWRITE_TAC[];
+  REAL_ARITH_TAC;
+  ASM_SIMP_TAC[REAL_ARITH `((x <. &.0) ==> ~(&.0 <=. x))`;REAL_ARITH `(x <. &.0) ==> (x <=. &.0)`];
+  USE 0 (SPECL [`--. (x:real)`;`--. (y:real)`]);
+  UND 0;
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[REAL_ARITH `((x <. &.0) ==> ~(&.0 <=. x))`;REAL_ARITH `(x <. &.0) ==> (x <=. &.0)`];
+  ]);;
+  (* }}} *)
+
+let ABS_SQUARE = prove_by_refinement(
+  `!t u. abs(t) <. u ==> t*t <. u*u`,
+  (* {{{ proof *)
+
+  [
+  REP_GEN_TAC;
+  CONV_TAC (SUBS_CONV[SPEC `t:real` (REWRITE_RULE[POW_2] (GSYM REAL_POW2_ABS))]);
+  ASSUME_TAC REAL_ABS_POS;
+  USE 0 (SPEC `t:real`);
+  ABBREV_TAC `(b:real) = (abs t)`;
+  KILL 1;
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC REAL_PROP_LT_LRMUL;
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let ABS_SQUARE_LE = prove_by_refinement(
+  `!t u. abs(t) <=. u ==> t*t <=. u*u`,
+  (* {{{ proof *)
+
+  [
+  REP_GEN_TAC;
+  CONV_TAC (SUBS_CONV[SPEC `t:real` (REWRITE_RULE[POW_2] (GSYM REAL_POW2_ABS))]);
+  ASSUME_TAC REAL_ABS_POS;
+  USE 0 (SPEC `t:real`);
+  ABBREV_TAC `(b:real) = (abs t)`;
+  KILL 1;
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC REAL_PROP_LE_LRMUL;
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let twopow_eps = prove_by_refinement(
+  `!R e. ?n. (&.0 <. R)/\ (&.0 <. e) ==> R*(twopow(--: (&:n))) <. e`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  REWRITE_TAC[TWOPOW_NEG]; (* cs6b *)
+  ASSUME_TAC (prove(`!n. &.0 < &.2 pow n`,REDUCE_TAC THEN ARITH_TAC));
+  ONCE_REWRITE_TAC[REAL_MUL_AC];
+  ASM_SIMP_TAC[REAL_INV_LT];
+  ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ];
+  CONV_TAC (quant_right_CONV "n");
+  DISCH_ALL_TAC;
+  ASSUME_TAC (SPEC `R/e` REAL_ARCH_SIMPLE);
+  CHO 3;
+  EXISTS_TAC `n:num`;
+  UND 3;
+  MESON_TAC[POW_2_LT;REAL_LET_TRANS];
+  ]);;
+
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* finite products, in imitation of finite sums *)
+(* ------------------------------------------------------------------ *)
+
+let prod_EXISTS = prove_by_refinement(
+  `?prod. (!f n.  prod(n,0) f = &1) /\
+         (!f m n. prod(n,SUC m) f = prod(n,m) f * f(n + m))`,
+(* {{{ proof *)
+  [
+  (CHOOSE_TAC o prove_recursive_functions_exist num_RECURSION) `(!f n. sm n 0 f = &1) /\ (!f m n. sm  n (SUC m) f = sm n m f * f(n + m))` ;
+  EXISTS_TAC `\(n,m) f. (sm:num->num->(num->real)->real) n m f`;
+  CONV_TAC(DEPTH_CONV GEN_BETA_CONV) THEN ASM_REWRITE_TAC[]
+  ]);;
+(* }}} *)
+
+let prod_DEF = new_specification ["prod"] prod_EXISTS;;
+
+let prod = prove
+ (`!n m. (prod(n,0) f = &1) /\
+   (prod(n,SUC m) f = prod(n,m) f * f(n + m))`,
+(* {{{ proof *)
+  REWRITE_TAC[prod_DEF]);;
+(* }}} *)
+
+let PROD_TWO = prove_by_refinement(
+ `!f n p. prod(0,n) f * prod(n,p) f = prod(0,n + p) f`,
+(* {{{ proof *)
+  [
+  GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[prod; REAL_MUL_RID; MULT_CLAUSES;ADD_0];
+  REWRITE_TAC[ARITH_RULE `n+| (SUC p) = (SUC (n+|p))`;prod;ARITH_RULE `0+|n = n`];
+  ASM_REWRITE_TAC[REAL_MUL_ASSOC];
+]);;
+(* }}} *)
+
+
+let ABS_PROD = prove_by_refinement(
+ `!f m n. abs(prod(m,n) f) = prod(m,n) (\n. abs(f n))`,
+(* {{{ proof *)
+  [
+  GEN_TAC THEN GEN_TAC THEN INDUCT_TAC;
+  REWRITE_TAC[prod];
+  REAL_ARITH_TAC;
+  ASM_REWRITE_TAC[prod;ABS_MUL]
+  ]);;
+(* }}} *)
+
+let PROD_EQ = prove_by_refinement
+ (`!f g m n. (!r. m <= r /\ r < (n + m) ==> (f(r) = g(r)))
+        ==> (prod(m,n) f = prod(m,n) g)`,
+(* {{{ proof *)
+
+  [
+  GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[prod];
+  REWRITE_TAC[prod];
+  DISCH_THEN (fun th -> MP_TAC th THEN (MP_TAC (SPEC `m+|n` th)));
+  REWRITE_TAC[ARITH_RULE `(m<=| (m+|n))/\ (m +| n <| (SUC n +| m))`];
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  AP_THM_TAC THEN AP_TERM_TAC;
+  FIRST_X_ASSUM MATCH_MP_TAC;
+  GEN_TAC THEN DISCH_TAC;
+  FIRST_X_ASSUM MATCH_MP_TAC;
+  ASM_MESON_TAC[ARITH_RULE `r <| (n+| m) ==> (r <| (SUC n +| m))`]
+  ]);;
+
+(* }}} *)
+
+let PROD_POS = prove_by_refinement
+ (`!f. (!n. &0 <= f(n)) ==> !m n. &0 <= prod(m,n) f`,
+(* {{{ proof *)
+
+  [
+  GEN_TAC THEN DISCH_TAC THEN GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[prod];
+  REAL_ARITH_TAC;
+  ASM_MESON_TAC[REAL_LE_MUL]
+  ]);;
+(* }}} *)
+
+let PROD_POS_GEN = prove_by_refinement
+ (`!f m n.
+     (!n. m <= n ==> &0 <= f(n))
+     ==> &0 <= prod(m,n) f`,
+(* {{{ proof *)
+
+  [
+  REPEAT STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THEN REWRITE_TAC[prod];
+  REAL_ARITH_TAC;
+  ASM_MESON_TAC[REAL_LE_MUL;ARITH_RULE `m <=| (m +| n)`]
+  ]);;
+(* }}} *)
+
+
+let PROD_ABS = prove
+ (`!f m n. abs(prod(m,n) (\m. abs(f m))) = prod(m,n) (\m. abs(f m))`,
+(* {{{ proof *)
+  REWRITE_TAC[ABS_PROD;REAL_ARITH `||. (||. x) = (||. x)`]);;
+(* }}} *)
+
+let PROD_ZERO = prove_by_refinement
+ (`!f m n. (?p. (m <= p /\ (p < (n+| m)) /\ (f p = (&.0)))) ==>
+         (prod(m,n) f = &0)`,
+(* {{{ proof *)
+  [
+  GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN (REWRITE_TAC[prod]);
+  ARITH_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  ASM_CASES_TAC `p <| (n+| m)`;
+  MATCH_MP_TAC (prove (`(x = (&.0)) ==> (x *. y = (&.0))`,(DISCH_THEN (fun th -> (REWRITE_TAC[th]))) THEN REAL_ARITH_TAC));
+  FIRST_X_ASSUM MATCH_MP_TAC;
+  ASM_MESON_TAC[];
+  POP_ASSUM (fun th -> ASSUME_TAC (MATCH_MP (ARITH_RULE `(~(p <| (n+|m)) ==> ((p <| ((SUC n) +| m)) ==> (p = ((m +| n)))))`) th));
+  MATCH_MP_TAC (prove (`(x = (&.0)) ==> (y *. x = (&.0))`,(DISCH_THEN (fun th -> (REWRITE_TAC[th]))) THEN REAL_ARITH_TAC));
+  ASM_MESON_TAC[]
+ ]);;
+(* }}} *)
+
+let PROD_MUL = prove_by_refinement(
+  `!f g m n. prod(m,n) (\n. f(n) * g(n)) = prod(m,n) f * prod(m,n) g`,
+  (* {{{ proof *)
+  [
+  EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[prod];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_MUL_AC];
+  ]);;
+  (* }}} *)
+
+let PROD_CMUL = prove_by_refinement(
+  `!f c m n. prod(m,n) (\n. c * f(n)) = (c **. n) * prod(m,n) f`,
+  (* {{{ proof *)
+  [
+  EVERY(replicate GEN_TAC 3) THEN INDUCT_TAC THEN ASM_REWRITE_TAC[prod;pow];
+  REAL_ARITH_TAC;
+  REWRITE_TAC[REAL_MUL_AC];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(*  LEMMAS ABOUT SETS                                                 *)
+(* ------------------------------------------------------------------ *)
+
+(* IN_ELIM_THM produces garbled results at times. I like this better: *)
+
+(*** JRH replaced this with the "new" IN_ELIM_THM; see how it works.
+
+let IN_ELIM_THM' = prove_by_refinement(
+ `(!P. !x:A. x IN (GSPEC P) <=> P x) /\
+   (!P. !x:A. x IN (\x. P x) <=> P x) /\
+   (!P. !x:A. (GSPEC P) x <=> P x) /\
+   (!P (x:A) (t:A). (\t. (?y:A. P y /\ (t = y))) x <=> P x)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[IN; GSPEC];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+ ****)
+
+let IN_ELIM_THM' = IN_ELIM_THM;;
+
+let SURJ_IMAGE = prove_by_refinement(
+  `!(f:A->B) a b. SURJ f a b ==> (b = (IMAGE f a))`,
+(* {{{ proof *)
+
+  [
+  REPEAT GEN_TAC;
+  REWRITE_TAC[SURJ;IMAGE];
+  DISCH_ALL_TAC;
+  REWRITE_TAC[EXTENSION];
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM];
+  ASM_MESON_TAC[]]
+
+(* }}} *)
+);;
+
+
+let SURJ_FINITE = prove_by_refinement(
+  `!a b (f:A->B). FINITE a /\ (SURJ f a b) ==> FINITE b`,
+(* {{{ *)
+
+  [
+  ASM_MESON_TAC[SURJ_IMAGE;FINITE_IMAGE]
+  ]);;
+
+(* }}} *)
+
+let BIJ_INVERSE = prove_by_refinement(
+  `!a b (f:A->B). (SURJ f a b) ==> (?(g:B->A). (INJ g b a))`,
+(* {{{ proof *)
+
+  [
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  SUBGOAL_THEN `!y. ?u. ((y IN b) ==> ((u IN a) /\ ((f:A->B) u = y)))` ASSUME_TAC;
+  ASM_MESON_TAC[SURJ];
+  LABEL_ALL_TAC;
+  H_REWRITE_RULE[THM SKOLEM_THM] (HYP "1");
+  LABEL_ALL_TAC;
+  H_UNDISCH_TAC (HYP"2");
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `u:B->A`;
+  REWRITE_TAC[INJ] THEN  CONJ_TAC THEN (ASM_MESON_TAC[])
+  ]
+
+(* }}} *)
+);;
+
+(* complement of an intersection is a union of complements *)
+let UNIONS_INTERS = prove_by_refinement(
+  `!(X:A->bool)  V.
+     (X DIFF (INTERS V) = UNIONS (IMAGE ((DIFF) X) V))`,
+(* {{{ proof *)
+
+  [
+  REPEAT GEN_TAC;
+  MATCH_MP_TAC SUBSET_ANTISYM;
+  CONJ_TAC;
+  REWRITE_TAC[SUBSET;IMAGE;IN_ELIM_THM];
+  X_GEN_TAC `c:A`;
+  REWRITE_TAC[IN_DIFF;IN_INTERS;IN_UNIONS;NOT_FORALL_THM];
+  DISCH_ALL_TAC;
+  UNDISCH_FIND_THEN `(?)` CHOOSE_TAC;
+  EXISTS_TAC `(X DIFF t):A->bool`;
+  REWRITE_TAC[IN_ELIM_THM];
+  CONJ_TAC;
+  EXISTS_TAC `t:A->bool`;
+  ASM_MESON_TAC[];
+  REWRITE_TAC[IN_DIFF];
+  ASM_MESON_TAC[];
+  REWRITE_TAC[SUBSET;IMAGE;IN_ELIM_THM];
+  X_GEN_TAC `c:A`;
+  REWRITE_TAC[IN_DIFF;IN_UNIONS];
+  DISCH_THEN CHOOSE_TAC;
+  UNDISCH_FIND_TAC `(IN)`;
+  REWRITE_TAC[IN_INTERS;IN_ELIM_THM];
+  DISCH_ALL_TAC;
+  UNDISCH_FIND_THEN `(?)` CHOOSE_TAC;
+  CONJ_TAC;
+  ASM_MESON_TAC[SUBSET_DIFF;SUBSET];
+  REWRITE_TAC[NOT_FORALL_THM];
+  EXISTS_TAC `x:A->bool`;
+  ASM_MESON_TAC[IN_DIFF];
+  ]);;
+
+(* }}} *)
+
+let INTERS_SUBSET = prove_by_refinement (
+   `!X (A:A->bool).  (A IN X) ==> (INTERS X SUBSET A)`,
+(* {{{ *)
+  [
+  REPEAT GEN_TAC;
+  REWRITE_TAC[SUBSET;IN_INTERS];
+  MESON_TAC[IN];
+  ]);;
+(* }}} *)
+
+let sub_union = prove_by_refinement(
+  `!X (U:(A->bool)->bool). (U X) ==> (X SUBSET (UNIONS U))`,
+(* {{{ *)
+ [
+ DISCH_ALL_TAC;
+ REWRITE_TAC[SUBSET;IN_ELIM_THM;UNIONS];
+ REWRITE_TAC[IN];
+ DISCH_ALL_TAC;
+ EXISTS_TAC `X:A->bool`;
+ ASM_REWRITE_TAC[];
+ ]);;
+(* }}} *)
+
+let IMAGE_SURJ = prove_by_refinement(
+ `!(f:A->B) a. SURJ f a (IMAGE f a)`,
+(* {{{ *)
+ [
+ REWRITE_TAC[SURJ;IMAGE;IN_ELIM_THM];
+ MESON_TAC[IN];
+ ]);;
+(* }}} *)
+
+let SUBSET_PREIMAGE = prove_by_refinement(
+  `!(f:A->B) X Y. (Y SUBSET (IMAGE f X)) ==>
+    (?Z. (Z SUBSET X) /\ (Y = IMAGE f Z))`,
+(* {{{ proof *)
+ [
+ DISCH_ALL_TAC;
+ EXISTS_TAC `{x | (x IN (X:A->bool))/\ (f x IN (Y:B->bool)) }`;
+ CONJ_TAC;
+ REWRITE_TAC[SUBSET;IN_ELIM_THM];
+ MESON_TAC[];
+ REWRITE_TAC[EXTENSION];
+ X_GEN_TAC `y:B`;
+ UNDISCH_FIND_TAC `(SUBSET)`;
+ REWRITE_TAC[SUBSET;IN_IMAGE];
+ REWRITE_TAC[IN_ELIM_THM];
+ DISCH_THEN (fun t-> MP_TAC (SPEC `y:B` t));
+ MESON_TAC[];
+ ]);;
+(* }}} *)
+
+let UNIONS_INTER = prove_by_refinement(
+  `!(U:(A->bool)->bool) A. (((UNIONS U) INTER A) =
+       (UNIONS (IMAGE ((INTER) A) U)))`,
+ (* {{{ proof *)
+ [
+ REPEAT GEN_TAC;
+ MATCH_MP_TAC (prove(`((C SUBSET (B:A->bool)) /\ (C SUBSET A) /\ ((A INTER B) SUBSET C)) ==> ((B INTER A) = C)`,SET_TAC[]));
+ CONJ_TAC;
+ REWRITE_TAC[SUBSET;UNIONS;IN_ELIM_THM];
+ REWRITE_TAC[IN_IMAGE];
+ SET_TAC[];
+ REWRITE_TAC[SUBSET;UNIONS;IN_IMAGE];
+ CONJ_TAC;
+ REWRITE_TAC[IN_ELIM_THM];
+ X_GEN_TAC `y:A`;
+ DISCH_THEN CHOOSE_TAC;
+ ASM_MESON_TAC[IN_INTER];
+ REWRITE_TAC[IN_INTER];
+ REWRITE_TAC[IN_ELIM_THM];
+ X_GEN_TAC `y:A`;
+ DISCH_ALL_TAC;
+ UNDISCH_FIND_THEN `(?)` CHOOSE_TAC;
+ EXISTS_TAC `A INTER (u:A->bool)`;
+ ASM SET_TAC[];
+ ]);;
+(* }}} *)
+
+let UNIONS_SUBSET = prove_by_refinement(
+ `!U (X:A->bool). (!A. (A IN U) ==> (A SUBSET X))  ==> (UNIONS U SUBSET X)`,
+(* {{{ *)
+ [
+ REPEAT GEN_TAC;
+ SET_TAC[];
+ ]);;
+(* }}} *)
+
+let SUBSET_INTER = prove_by_refinement(
+ `!X A (B:A->bool). (X SUBSET (A INTER B)) <=> (X SUBSET A) /\ (X SUBSET B)`,
+(* {{{ *)
+ [
+ REWRITE_TAC[SUBSET;INTER;IN_ELIM_THM];
+ MESON_TAC[IN];
+ ]);;
+(* }}} *)
+
+let EMPTY_EXISTS = prove_by_refinement(
+ `!X. ~(X = {}) <=> (? (u:A). (u IN X))`,
+(* {{{ *)
+ [
+ REWRITE_TAC[EXTENSION];
+ REWRITE_TAC[IN;EMPTY];
+ MESON_TAC[];
+ ]);;
+(* }}} *)
+
+let UNIONS_UNIONS = prove_by_refinement(
+ `!A B. (A SUBSET B) ==>(UNIONS (A:(A->bool)->bool) SUBSET (UNIONS B))`,
+(* {{{ *)
+ [
+ REWRITE_TAC[SUBSET;UNIONS;IN_ELIM_THM];
+ MESON_TAC[IN];
+ ]);;
+(* }}} *)
+
+
+(* nested union can flatten from outside in, or inside out *)
+let UNIONS_IMAGE_UNIONS = prove_by_refinement(
+  `!(X:((A->bool)->bool)->bool).
+    UNIONS (UNIONS X) = (UNIONS (IMAGE UNIONS X))`,
+ (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[EXTENSION;IN_UNIONS];
+  GEN_TAC;
+  REWRITE_TAC[EXTENSION;IN_UNIONS];
+  EQ_TAC;
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_ALL_TAC;
+  FIRST_ASSUM MP_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `UNIONS (t':(A->bool)->bool)`;
+  REWRITE_TAC[IN_UNIONS;IN_IMAGE];
+  CONJ_TAC;
+  EXISTS_TAC `(t':(A->bool)->bool)`;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  FIRST_ASSUM MP_TAC;
+  REWRITE_TAC[IN_IMAGE];
+  DISCH_ALL_TAC;
+  FIRST_ASSUM MP_TAC;
+  DISCH_THEN CHOOSE_TAC;
+  UNDISCH_TAC `(x:A) IN t`;
+  FIRST_ASSUM (fun t-> REWRITE_TAC[t]);
+  REWRITE_TAC[IN_UNIONS];
+  DISCH_THEN (CHOOSE_TAC);
+  EXISTS_TAC `t':(A->bool)`;
+  CONJ_TAC;
+  EXISTS_TAC `x':(A->bool)->bool`;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  ]);;
+(* }}} *)
+
+
+let INTERS_SUBSET2 = prove_by_refinement(
+  `!X A. (?(x:A->bool). (A x /\ (x SUBSET X))) ==> ((INTERS A) SUBSET X)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[SUBSET;INTERS;IN_ELIM_THM'];
+  REWRITE_TAC[IN];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(**** New proof by JRH; old one breaks because of new set comprehensions
+
+let INTERS_EMPTY = prove_by_refinement(
+  `INTERS EMPTY = (UNIV:A->bool)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[INTERS;NOT_IN_EMPTY;IN_ELIM_THM';];
+  REWRITE_TAC[UNIV;GSPEC];
+  MATCH_MP_TAC  EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+ ****)
+
+let INTERS_EMPTY = prove_by_refinement(
+  `INTERS EMPTY = (UNIV:A->bool)`,
+  [SET_TAC[]]);;
+
+let preimage = new_definition `preimage dom (f:A->B)
+  Z = {x | (x IN dom) /\ (f x IN Z)}`;;
+
+let in_preimage = prove_by_refinement(
+  `!f x Z dom. x IN (preimage dom (f:A->B) Z) <=> (x IN dom) /\ (f x IN Z)`,
+(* {{{ *)
+  [
+  REWRITE_TAC[preimage];
+  REWRITE_TAC[IN_ELIM_THM']
+  ]);;
+(* }}} *)
+
+(* Partial functions, which we identify with functions that
+   take the canonical choice of element outside the domain. *)
+
+let supp = new_definition
+  `supp (f:A->B) = \ x.  ~(f x = (CHOICE (UNIV:B ->bool)) )`;;
+
+let func = new_definition
+  `func a b = (\ (f:A->B). ((!x. (x IN a) ==> (f x IN b)) /\
+              ((supp f) SUBSET a))) `;;
+
+
+(* relations *)
+let reflexive = new_definition
+  `reflexive (f:A->A->bool) <=> (!x. f x x)`;;
+
+let symmetric = new_definition
+  `symmetric (f:A->A->bool) <=> (!x y. f x y ==> f y x)`;;
+
+let transitive = new_definition
+  `transitive (f:A->A->bool) <=> (!x y z. f x y /\ f y z ==> f x z)`;;
+
+let equivalence_relation = new_definition
+  `equivalence_relation (f:A->A->bool) <=>
+    (reflexive f) /\ (symmetric f) /\ (transitive f)`;;
+
+(* We do not introduce the equivalence class of f explicitly, because
+   it is represented directly in HOL by (f a) *)
+
+let partition_DEF = new_definition
+  `partition (A:A->bool) SA <=> (UNIONS SA = A) /\
+   (!a b. ((a IN SA) /\ (b IN SA) /\ (~(a = b)) ==> ({} = (a INTER b))))`;;
+
+let DIFF_DIFF2 = prove_by_refinement(
+  `!X (A:A->bool). (A SUBSET X) ==> ((X DIFF (X DIFF A)) = A)`,
+  [
+  SET_TAC[]
+  ]);;
+
+(*** Old proof replaced by JRH: no longer UNWIND_THM[12] clause in IN_ELIM_THM
+
+let GSPEC_THM = prove_by_refinement(
+  `!P (x:A). (?y. P y /\ (x = y)) <=> P x`,
+  [REWRITE_TAC[IN_ELIM_THM]]);;
+
+***)
+
+let GSPEC_THM = prove_by_refinement(
+  `!P (x:A). (?y. P y /\ (x = y)) <=> P x`,
+  [MESON_TAC[]]);;
+
+let CARD_GE_REFL = prove
+ (`!s:A->bool. s >=_c s`,
+  GEN_TAC THEN REWRITE_TAC[GE_C] THEN
+  EXISTS_TAC `\x:A. x` THEN MESON_TAC[]);;
+
+let FINITE_HAS_SIZE_LEMMA = prove
+ (`!s:A->bool. FINITE s ==> ?n:num. {x | x < n} >=_c s`,
+  MATCH_MP_TAC FINITE_INDUCT THEN CONJ_TAC THENL
+   [EXISTS_TAC `0` THEN REWRITE_TAC[NOT_IN_EMPTY; GE_C; IN_ELIM_THM];
+    REPEAT GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN
+    EXISTS_TAC `SUC N` THEN POP_ASSUM MP_TAC THEN PURE_REWRITE_TAC[GE_C] THEN
+    DISCH_THEN(X_CHOOSE_TAC `f:num->A`) THEN
+    EXISTS_TAC `\n:num. if n = N then x:A else f n` THEN
+    X_GEN_TAC `y:A` THEN PURE_REWRITE_TAC[IN_INSERT] THEN
+    DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC (ANTE_RES_THEN MP_TAC)) THENL
+     [EXISTS_TAC `N:num` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN ARITH_TAC;
+      DISCH_THEN(X_CHOOSE_THEN `n:num` MP_TAC) THEN
+      REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN
+      EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN
+      UNDISCH_TAC `n:num < N` THEN COND_CASES_TAC THEN
+      ASM_REWRITE_TAC[LT_REFL] THEN ARITH_TAC]]);;
+
+let NUM_COUNTABLE = prove_by_refinement(
+  `COUNTABLE (UNIV:num->bool)`,
+  (* {{{ proof *)
+
+  [
+  REWRITE_TAC[COUNTABLE;CARD_GE_REFL];
+  ]);;
+
+  (* }}} *)
+
+let NUM2_COUNTABLE = prove_by_refinement(
+  `COUNTABLE {((x:num),(y:num)) | T}`,
+  (* {{{ proof *)
+  [
+  CHOOSE_TAC (ISPECL[`(0,0)`;`(\ (a:num,b:num) (n:num) . if (b=0) then (0,a+b+1) else (a+1,b-1))`] num_RECURSION);
+  REWRITE_TAC[COUNTABLE;GE_C;IN_ELIM_THM'];
+  NAME_CONFLICT_TAC;
+  EXISTS_TAC `fn:num -> (num#num)`;
+  X_GEN_TAC `p:num#num`;
+  REPEAT (DISCH_THEN (CHOOSE_THEN MP_TAC));
+  DISCH_THEN (fun t->REWRITE_TAC[t]);
+  REWRITE_TAC[IN_UNIV];
+  SUBGOAL_TAC `?t. t = x'+|y'`;
+  MESON_TAC[];
+  SPEC_TAC (`x':num`,`a:num`);
+  SPEC_TAC (`y':num`,`b:num`);
+  CONV_TAC (quant_left_CONV "t");
+  CONV_TAC (quant_left_CONV "t");
+  CONV_TAC (quant_left_CONV "t");
+  INDUCT_TAC;
+  REDUCE_TAC;
+  REP_GEN_TAC;
+  DISCH_THEN (fun t -> REWRITE_TAC[t]);
+  EXISTS_TAC `0`;
+  ASM_REWRITE_TAC[];
+  CONV_TAC (quant_left_CONV "a");
+  INDUCT_TAC;
+  REDUCE_TAC;
+  GEN_TAC;
+  USE 1 (SPECL [`0`;`t:num`]);
+  UND 1 THEN REDUCE_TAC;
+  DISCH_THEN (X_CHOOSE_TAC `n:num`);
+  AND 0;
+  USE 0 (SPEC `n:num`);
+  UND 0;
+  UND 1;
+  DISCH_THEN (fun t-> REWRITE_TAC[GSYM t]);
+  CONV_TAC (ONCE_DEPTH_CONV GEN_BETA_CONV);
+  BETA_TAC;
+  REDUCE_TAC;
+  DISCH_ALL_TAC;
+  EXISTS_TAC `SUC n`;
+  EXPAND_TAC "b";
+  KILL 0;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC [ARITH_RULE `SUC t = t+|1`];
+  GEN_TAC;
+  ABBREV_TAC `t'  = SUC t`;
+  USE 2 (SPEC `SUC b`);
+  DISCH_TAC;
+  UND 2;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[ARITH_RULE `SUC a +| b = a +| SUC b`];
+  DISCH_THEN (X_CHOOSE_TAC `n:num`);
+  EXISTS_TAC `SUC n`;
+  AND 0;
+  USE 0 (SPEC `n:num`);
+  UND 0;
+  UND 2;
+  DISCH_THEN (fun t->REWRITE_TAC[GSYM t]);
+  CONV_TAC (ONCE_DEPTH_CONV GEN_BETA_CONV);
+  BETA_TAC;
+  REDUCE_TAC;
+  DISCH_THEN (fun t->REWRITE_TAC[t]);
+  REWRITE_TAC[ARITH_RULE `SUC a = a+| 1`];
+  ]);;
+  (* }}} *)
+
+let COUNTABLE_UNIONS = prove_by_refinement(
+  `!A:(A->bool)->bool. (COUNTABLE A) /\
+      (!a. (a IN A) ==> (COUNTABLE a)) ==> (COUNTABLE (UNIONS A))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  USE 0 (REWRITE_RULE[COUNTABLE;GE_C;IN_UNIV]);
+  CHO 0;
+  USE 0 (CONV_RULE (quant_left_CONV "x"));
+  USE 0 (CONV_RULE (quant_left_CONV "x"));
+  CHO 0;
+  USE 1 (REWRITE_RULE[COUNTABLE;GE_C;IN_UNIV]);
+  USE 1 (CONV_RULE (quant_left_CONV "f"));
+  USE 1 (CONV_RULE (quant_left_CONV "f"));
+  UND 1;
+  DISCH_THEN (X_CHOOSE_TAC `g:(A->bool)->num->A`);
+  SUBGOAL_TAC `!a y. (a IN (A:(A->bool)->bool)) /\ (y IN a) ==> (? (u:num) (v:num). ( a = f u) /\ (y = g a v))`;
+  REP_GEN_TAC;
+  DISCH_ALL_TAC;
+  USE 1 (SPEC `a:A->bool`);
+  USE 0 (SPEC `a:A->bool`);
+  EXISTS_TAC `(x:(A->bool)->num) a`;
+  ASM_SIMP_TAC[];
+  ASSUME_TAC NUM2_COUNTABLE;
+  USE 2 (REWRITE_RULE[COUNTABLE;GE_C;IN_ELIM_THM';IN_UNIV]);
+  USE 2 (CONV_RULE NAME_CONFLICT_CONV);
+  UND 2 THEN (DISCH_THEN (X_CHOOSE_TAC `h:num->(num#num)`));
+  DISCH_TAC;
+  REWRITE_TAC[COUNTABLE;GE_C;IN_ELIM_THM';IN_UNIV;IN_UNIONS];
+  EXISTS_TAC `(\p. (g:(A->bool)->num->A) ((f:num->(A->bool)) (FST ((h:num->(num#num)) p))) (SND (h p)))`;
+  BETA_TAC;
+  GEN_TAC;
+  DISCH_THEN (CHOOSE_THEN MP_TAC);
+  DISCH_ALL_TAC;
+  USE 3 (SPEC `t:A->bool`);
+  USE 3 (SPEC `y:A`);
+  UND 3 THEN (ASM_REWRITE_TAC[]);
+  REPEAT (DISCH_THEN(CHOOSE_THEN (MP_TAC)));
+  DISCH_ALL_TAC;
+  USE 2 (SPEC `(u:num,v:num)`);
+  SUBGOAL_TAC `?x' y'. (u:num,v:num) = (x',y')`;
+  MESON_TAC[];
+  DISCH_TAC;
+  UND 2;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN (CHOOSE_THEN (ASSUME_TAC o GSYM));
+  EXISTS_TAC `x':num`;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let COUNTABLE_IMAGE = prove_by_refinement(
+  `!(A:A->bool) (B:B->bool) . (COUNTABLE A) /\ (?f. (B SUBSET IMAGE f A)) ==>
+        (COUNTABLE B)`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[COUNTABLE;GE_C;IN_UNIV;IN_ELIM_THM';SUBSET];
+  DISCH_ALL_TAC;
+  CHO 0;
+  USE 1 (REWRITE_RULE[IMAGE;IN_ELIM_THM']);
+  CHO 1;
+  USE 1 (REWRITE_RULE[IN_ELIM_THM']);
+  USE 1 (CONV_RULE NAME_CONFLICT_CONV);
+  EXISTS_TAC `(f':A->B) o (f:num->A)`;
+  REWRITE_TAC[o_DEF];
+  DISCH_ALL_TAC;
+  USE 1 (SPEC `y:B`);
+  UND 1;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  USE 0 (SPEC `x':A`);
+  UND 0 THEN (ASM_REWRITE_TAC[]) THEN DISCH_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let COUNTABLE_CARD = prove_by_refinement(
+  `!(A:A->bool) (B:B->bool). (COUNTABLE A) /\ (A >=_c B) ==>
+     (COUNTABLE B)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC COUNTABLE_IMAGE;
+  EXISTS_TAC `A:A->bool`;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IMAGE;SUBSET;IN_ELIM_THM'];
+  USE 1 (REWRITE_RULE[GE_C]);
+  CHO 1;
+  EXISTS_TAC `f:A->B`;
+  ASM_REWRITE_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let COUNTABLE_NUMSEG = prove_by_refinement(
+  `!n. COUNTABLE {x | x <| n}`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[COUNTABLE;GE_C;IN_UNIV];
+  EXISTS_TAC `I:num->num`;
+  REDUCE_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let FINITE_COUNTABLE = prove_by_refinement(
+  `!(A:A->bool). (FINITE A) ==> (COUNTABLE A)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  USE 0 (MATCH_MP FINITE_HAS_SIZE_LEMMA);
+  CHO 0;
+  ASSUME_TAC(SPEC `n:num` COUNTABLE_NUMSEG);
+  JOIN 1 0;
+  USE 0 (MATCH_MP COUNTABLE_CARD);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let num_infinite = prove_by_refinement(
+  `~ (FINITE (UNIV:num->bool))`,
+  (* {{{ proof *)
+  [
+  PROOF_BY_CONTR_TAC;
+  USE 0 (REWRITE_RULE[]);
+  USE 0 (MATCH_MP num_FINITE_AVOID);
+  USE 0 (REWRITE_RULE[IN_UNIV]);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let num_SEG_UNION = prove_by_refinement(
+  `!i. ({u | i <| u} UNION {m | m <=| i}) = UNIV`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  SUBGOAL_TAC `({u | i <| u} UNION {m | m <=| i}) = UNIV`;
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[UNIV;UNION;IN_ELIM_THM'];
+  ARITH_TAC;
+  REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let num_above_infinite = prove_by_refinement(
+  `!i. ~ (FINITE {u | i <| u})`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 0 (REWRITE_RULE[]);
+  ASSUME_TAC(SPEC `i:num` FINITE_NUMSEG_LE);
+  JOIN 0 1;
+  USE 0 (MATCH_MP FINITE_UNION_IMP);
+  SUBGOAL_TAC `({u | i <| u} UNION {m | m <=| i}) = UNIV`;
+  REWRITE_TAC[num_SEG_UNION];
+  DISCH_TAC;
+  UND 0;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[num_infinite];
+  ]);;
+  (* }}} *)
+
+let INTER_FINITE = prove_by_refinement(
+  `!s (t:A->bool). (FINITE s ==> FINITE(s INTER t)) /\ (FINITE t ==> FINITE (s INTER t))`,
+  (* {{{ proof *)
+
+  [
+  CONV_TAC (quant_right_CONV "t");
+  CONV_TAC (quant_right_CONV "s");
+  SUBCONJ_TAC;
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `s INTER t SUBSET (s:A->bool)`;
+  SET_TAC[];
+  ASM_MESON_TAC[FINITE_SUBSET];
+  MESON_TAC[INTER_COMM];
+  ]);;
+
+  (* }}} *)
+
+let num_above_finite = prove_by_refinement(
+  `!i J. (FINITE (J INTER {u | (i <| u)})) ==> (FINITE J)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `J = (J INTER {u | (i <| u)}) UNION (J INTER {m | m <=| i})`;
+  REWRITE_TAC[GSYM UNION_OVER_INTER;num_SEG_UNION;INTER_UNIV];
+  DISCH_TAC;
+  ASM (ONCE_REWRITE_TAC)[];
+  REWRITE_TAC[FINITE_UNION];
+  ASM_REWRITE_TAC[];
+  MP_TAC (SPEC `i:num` FINITE_NUMSEG_LE);
+  REWRITE_TAC[INTER_FINITE];
+  ]);;
+  (* }}} *)
+
+let SUBSET_SUC = prove_by_refinement(
+  `!(f:num->A->bool). (!i. f i SUBSET f (SUC i)) ==> (! i j. ( i <=| j) ==> (f i SUBSET f j))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  DISCH_TAC;
+  REP_GEN_TAC;
+  MP_TAC (prove( `?n. n = j -| i`,MESON_TAC[]));
+  CONV_TAC (quant_left_CONV "n");
+  SPEC_TAC (`i:num`,`i:num`);
+  SPEC_TAC (`j:num`,`j:num`);
+  REP 2(  CONV_TAC (quant_left_CONV "n"));
+  INDUCT_TAC;
+  REP_GEN_TAC;
+  DISCH_ALL_TAC;
+  JOIN 1 2;
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_REWRITE_TAC[SUBSET];
+  REP_GEN_TAC;
+  DISCH_TAC;
+  SUBGOAL_TAC `?j'. j = SUC j'`;
+  DISJ_CASES_TAC (SPEC `j:num` num_CASES);
+  UND 2;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  ASM_REWRITE_TAC[];
+  USE 0 (SPEC `j':num`);
+  USE 1(SPECL [`j':num`;`i:num`]);
+  DISCH_TAC;
+  SUBGOAL_TAC `(n = j'-|i)`;
+  UND 2;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  DISCH_TAC;
+  SUBGOAL_TAC `(i<=| j')`;
+  USE 2 (MATCH_MP(ARITH_RULE `(SUC n = j -| i) ==> (0 < j -| i)`));
+  UND 2;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  UND 1;
+  ASM_REWRITE_TAC [];
+  DISCH_ALL_TAC;
+  REWR 6;
+  ASM_MESON_TAC[SUBSET_TRANS];
+  ]);;
+  (* }}} *)
+
+let SUBSET_SUC2 = prove_by_refinement(
+  `!(f:num->A->bool). (!i. f (SUC i) SUBSET (f i)) ==> (! i j. ( i <=| j) ==> (f j SUBSET f i))`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  DISCH_TAC;
+  REP_GEN_TAC;
+  MP_TAC (prove( `?n. n = j -| i`,MESON_TAC[]));
+  CONV_TAC (quant_left_CONV "n");
+  SPEC_TAC (`i:num`,`i:num`);
+  SPEC_TAC (`j:num`,`j:num`);
+  REP 2(  CONV_TAC (quant_left_CONV "n"));
+  INDUCT_TAC;
+  REP_GEN_TAC;
+  DISCH_ALL_TAC;
+  JOIN 1 2;
+  USE 1 (CONV_RULE REDUCE_CONV);
+  ASM_REWRITE_TAC[SUBSET];
+  REP_GEN_TAC;
+  DISCH_TAC;
+  SUBGOAL_TAC `?j'. j = SUC j'`;
+  DISJ_CASES_TAC (SPEC `j:num` num_CASES);
+  UND 2;
+  ASM_REWRITE_TAC[];
+  REDUCE_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  ASM_REWRITE_TAC[];
+  USE 0 (SPEC `j':num`);
+  USE 1(SPECL [`j':num`;`i:num`]);
+  DISCH_TAC;
+  SUBGOAL_TAC `(n = j'-|i)`;
+  UND 2;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  DISCH_TAC;
+  SUBGOAL_TAC `(i<=| j')`;
+  USE 2 (MATCH_MP(ARITH_RULE `(SUC n = j -| i) ==> (0 < j -| i)`));
+  UND 2;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  UND 1;
+  ASM_REWRITE_TAC [];
+  DISCH_ALL_TAC;
+  REWR 6;
+  ASM_MESON_TAC[SUBSET_TRANS];
+  ]);;
+  (* }}} *)
+
+let INFINITE_PIGEONHOLE = prove_by_refinement(
+  `!I (f:A->B) B C. (~(FINITE {i | (I i) /\ (C (f i))})) /\ (FINITE B) /\
+    (C SUBSET (UNIONS B)) ==>
+    (?b. (B b) /\ ~(FINITE {i | (I i) /\ (C INTER b) (f i) }))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  PROOF_BY_CONTR_TAC;
+  USE 3 (  CONV_RULE (quant_left_CONV "b"));
+  UND 0;
+  TAUT_TAC `P ==> (~P ==> F)`;
+  SUBGOAL_TAC `{i | I' i /\ (C ((f:A->B) i))} = UNIONS (IMAGE (\b. {i | I' i /\ ((C INTER b) (f i))}) B)`;
+  REWRITE_TAC[UNIONS;IN_IMAGE];
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  REWRITE_TAC[IN_ELIM_THM'];
+  ABBREV_TAC `j = (x:A)`;
+  EQ_TAC;
+  DISCH_ALL_TAC;
+  USE 2 (REWRITE_RULE [SUBSET;UNIONS]);
+  USE 2 (REWRITE_RULE[IN_ELIM_THM']);
+  USE 2 (SPEC `(f:A->B) j`);
+  USE 2 (REWRITE_RULE[IN]);
+  REWR 2;
+  CHO 2;
+  CONV_TAC (quant_left_CONV "x");
+  CONV_TAC (quant_left_CONV "x");
+  EXISTS_TAC (`u:B->bool`);
+  NAME_CONFLICT_TAC;
+  EXISTS_TAC (`{i' | I' i' /\ (C INTER u) ((f:A->B) i')}`);
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC[IN_ELIM_THM';INTER];
+  REWRITE_TAC[IN];
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  CHO 4;
+  AND 4;
+  CHO 5;
+  REWR 4;
+  USE 4 (REWRITE_RULE[IN_ELIM_THM';INTER]);
+  USE 4 (REWRITE_RULE[IN]);
+  ASM_REWRITE_TAC[];
+  DISCH_TAC;
+  ASM_REWRITE_TAC[];
+  SUBGOAL_TAC `FINITE (IMAGE (\b. {i | I' i /\ (C INTER b) ((f:A->B) i)}) B)`;
+  MATCH_MP_TAC FINITE_IMAGE;
+  ASM_REWRITE_TAC[];
+  SIMP_TAC[FINITE_UNIONS];
+  DISCH_TAC;
+  GEN_TAC;
+  REWRITE_TAC[IN_IMAGE];
+  DISCH_THEN (X_CHOOSE_TAC `b:B->bool`);
+  ASM_REWRITE_TAC[];
+  USE 3 (SPEC `b:B->bool`);
+  UND 3;
+  AND 5;
+  UND 3;
+  ABBREV_TAC `r = {i | I' i /\ (C INTER b) ((f:A->B) i)}`;
+  MESON_TAC[IN];
+  ]);;
+  (* }}} *)
+
+let real_FINITE = prove_by_refinement(
+  `!(s:real->bool). FINITE s ==> (?a. !x. x IN s ==> (x <=. a))`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ASSUME_TAC REAL_ARCH_SIMPLE;
+  USE 1 (CONV_RULE (quant_left_CONV "n"));
+  CHO 1;
+  SUBGOAL_TAC `FINITE (IMAGE (n:real->num) s)`;
+  ASM_MESON_TAC[FINITE_IMAGE];
+(*** JRH -- num_FINITE is now an equivalence not an implication
+  ASSUME_TAC (SPEC `IMAGE (n:real->num) s` num_FINITE);
+ ***)
+  ASSUME_TAC(fst(EQ_IMP_RULE(SPEC `IMAGE (n:real->num) s` num_FINITE)));
+  DISCH_TAC;
+  REWR 2;
+  CHO 2;
+  USE 2 (REWRITE_RULE[IN_IMAGE]);
+  USE 2 (CONV_RULE NAME_CONFLICT_CONV);
+  EXISTS_TAC `&.a`;
+  GEN_TAC;
+  USE 2 (CONV_RULE (quant_left_CONV "x'"));
+  USE 2 (CONV_RULE (quant_left_CONV "x'"));
+  USE 2 (SPEC `x:real`);
+  USE 2 (SPEC `(n:real->num) x`);
+  DISCH_TAC;
+  REWR 2;
+  USE 1 (SPEC `x:real`);
+  UND 1;
+  MATCH_MP_TAC (REAL_ARITH `a<=b ==> ((x <= a) ==> (x <=. b))`);
+  REDUCE_TAC;
+  ASM_REWRITE_TAC [];
+  ]);;
+  (* }}} *)
+
+let UNIONS_DELETE = prove_by_refinement(
+  `!s. (UNIONS (s:(A->bool)->bool)) = (UNIONS (s DELETE (EMPTY)))`,
+  (* {{{ proof *)
+  [
+  REWRITE_TAC[UNIONS;DELETE;EMPTY];
+  GEN_TAC;
+  MATCH_MP_TAC EQ_EXT;
+  REWRITE_TAC[IN_ELIM_THM'];
+  GEN_TAC;
+  REWRITE_TAC[IN];
+  MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Partial functions, which we identify with functions that
+   take the canonical choice of element outside the domain. *)
+(* ------------------------------------------------------------------ *)
+
+let SUPP = new_definition
+  `SUPP (f:A->B) = \ x.  ~(f x = (CHOICE (UNIV:B ->bool)) )`;;
+
+let FUN = new_definition
+  `FUN a b = (\ (f:A->B). ((!x. (x IN a) ==> (f x IN b)) /\
+              ((SUPP f) SUBSET a))) `;;
+
+(* ------------------------------------------------------------------ *)
+(* compositions *)
+(* ------------------------------------------------------------------ *)
+
+let compose = new_definition
+  `compose f g = \x. (f (g x))`;;
+
+let COMP_ASSOC = prove_by_refinement(
+   `!(f:num ->num) (g:num->num) (h:num->num).
+      (compose f (compose g h)) = (compose (compose f g) h)`,
+(* {{{ proof *)
+
+   [
+   REPEAT GEN_TAC THEN REWRITE_TAC[compose];
+   ]);;
+(* }}} *)
+
+let COMP_INJ = prove (`!(f:A->B) (g:B->C) s t u.
+      INJ f s t /\ (INJ g t u) ==>
+  (INJ (compose g f) s u)`,
+(* {{{ proof *)
+
+   EVERY[REPEAT GEN_TAC;
+   REWRITE_TAC[INJ;compose];
+   DISCH_ALL_TAC;
+   ASM_MESON_TAC[]]);;
+(* }}} *)
+
+let COMP_SURJ = prove (`!(f:A->B) (g:B->C) s t u.
+   SURJ f s t /\ (SURJ g t u) ==> (SURJ (compose g f) s u)`,
+(* {{{ proof *)
+
+   EVERY[REWRITE_TAC[SURJ;compose];
+   DISCH_ALL_TAC;
+   ASM_MESON_TAC[]]);;
+(* }}} *)
+
+let COMP_BIJ = prove (`!(f:A->B) s t (g:B->C) u.
+    BIJ f s t /\ (BIJ g t u) ==> (BIJ (compose g f) s u)`,
+(* {{{ proof *)
+
+   EVERY[
+   REPEAT GEN_TAC;
+   REWRITE_TAC[BIJ];
+   DISCH_ALL_TAC;
+   ASM_MESON_TAC[COMP_INJ;COMP_SURJ]]);;
+
+(* }}} *)
+
+
+(* ------------------------------------------------------------------ *)
+(* general construction of an inverse function on a domain *)
+(* ------------------------------------------------------------------ *)
+
+let INVERSE_FN = prove_by_refinement(
+  `?INV. (! (f:A->B) a b. (SURJ f a b) ==> ((INJ (INV f a b) b a) /\
+       (!(x:B). (x IN b) ==> (f ((INV f a b) x) = x))))`,
+(* {{{ proof *)
+
+  [
+  REWRITE_TAC[GSYM SKOLEM_THM];
+  REPEAT GEN_TAC;
+  MATCH_MP_TAC (prove_by_refinement( `!A B. (A ==> (?x. (B x))) ==> (?(x:B->A). (A ==> (B x)))`,[MESON_TAC[]])) ;
+  REWRITE_TAC[SURJ;INJ];
+  DISCH_ALL_TAC;
+  SUBGOAL_TAC `?u. !y. ((y IN b)==> ((u y IN a) /\ ((f:A->B) (u y) = y)))`;
+  REWRITE_TAC[GSYM SKOLEM_THM];
+  GEN_TAC;
+  ASM_MESON_TAC[];
+  DISCH_THEN CHOOSE_TAC;
+  EXISTS_TAC `u:B->A`;
+  REPEAT CONJ_TAC;
+  ASM_MESON_TAC[];
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  FIRST_X_ASSUM (fun th -> ASSUME_TAC (AP_TERM `f:A->B` th));
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[]
+  ]);;
+
+(* }}} *)
+
+let INVERSE_DEF = new_specification ["INV"] INVERSE_FN;;
+
+let INVERSE_BIJ = prove_by_refinement(
+  `!(f:A->B) a b. (BIJ f a b) ==> ((BIJ (INV f a b) b a))`,
+(* {{{ proof *)
+  [
+  REPEAT GEN_TAC;
+  REWRITE_TAC[BIJ];
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[INVERSE_DEF];
+  REWRITE_TAC[SURJ];
+  CONJ_TAC;
+  ASM_MESON_TAC[INVERSE_DEF;INJ];
+  GEN_TAC THEN DISCH_TAC;
+  EXISTS_TAC `(f:A->B) x`;
+  CONJ_TAC;
+  ASM_MESON_TAC[INJ];
+  SUBGOAL_THEN `((f:A->B) x) IN b` ASSUME_TAC;
+  ASM_MESON_TAC[INJ];
+  SUBGOAL_THEN `(f:A->B) (INV f a b (f x)) = (f x)` ASSUME_TAC;
+  ASM_MESON_TAC[INVERSE_DEF];
+  H_UNDISCH_TAC (HYP "0");
+  REWRITE_TAC[INJ];
+  DISCH_ALL_TAC;
+  FIRST_X_ASSUM (fun th -> MP_TAC (SPECL [`INV (f:A->B) a b (f x)`;`x:A`] th));
+  ASM_REWRITE_TAC[];
+  DISCH_ALL_TAC;
+  SUBGOAL_THEN `INV (f:A->B) a b (f x) IN a` ASSUME_TAC;
+  ASM_MESON_TAC[INVERSE_DEF;INJ];
+  ASM_MESON_TAC[];
+  ]);;
+(* }}} *)
+
+let INVERSE_XY = prove_by_refinement(
+  `!(f:A->B) a b x y. (BIJ f a b) /\ (x IN a) /\ (y IN b) ==> ((INV f a b y = x) <=> (f x = y))`,
+(* {{{ proof *)
+  [
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  EQ_TAC;
+  FIRST_X_ASSUM (fun th -> (ASSUME_TAC th THEN (ASSUME_TAC (MATCH_MP INVERSE_DEF (CONJUNCT2 (REWRITE_RULE[BIJ] th))))));
+  ASM_MESON_TAC[];
+  POP_ASSUM (fun th -> (ASSUME_TAC th THEN (ASSUME_TAC (CONJUNCT2 (REWRITE_RULE[INJ] (CONJUNCT1 (REWRITE_RULE[BIJ] th)))))));
+  DISCH_THEN (fun th -> ASSUME_TAC th THEN (REWRITE_TAC[GSYM th]));
+  FIRST_X_ASSUM  MATCH_MP_TAC;
+  REPEAT CONJ_TAC;
+  ASM_REWRITE_TAC[];
+  IMP_RES_THEN ASSUME_TAC INVERSE_BIJ;
+  ASM_MESON_TAC[BIJ;INJ];
+  ASM_REWRITE_TAC[];
+  FIRST_X_ASSUM (fun th -> (ASSUME_TAC (CONJUNCT2 (REWRITE_RULE[BIJ] th))));
+  IMP_RES_THEN (fun th -> ASSUME_TAC (CONJUNCT2 th)) INVERSE_DEF;
+  ASM_MESON_TAC[];
+  ]);;
+(* }}} *)
+
+let FINITE_BIJ = prove(
+  `!a b (f:A->B). FINITE a /\ (BIJ f a b) ==> (FINITE b)`,
+(* {{{ proof *)
+
+  MESON_TAC[SURJ_IMAGE;BIJ;INJ;FINITE_IMAGE]
+);;
+
+(* }}} *)
+
+let FINITE_INJ = prove_by_refinement(
+  `!a b (f:A->B). FINITE b /\ (INJ f a b) ==> (FINITE a)`,
+(* {{{ proof *)
+
+  [
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  MP_TAC (SPECL [`f:A->B`;`b:B->bool`;`a:A->bool`] FINITE_IMAGE_INJ_GENERAL);
+  DISCH_ALL_TAC;
+  SUBGOAL_THEN `(a:A->bool) SUBSET ({x | (x IN a) /\ ((f:A->B) x IN b)})` ASSUME_TAC;
+  REWRITE_TAC[SUBSET];
+  GEN_TAC ;
+  REWRITE_TAC[IN_ELIM_THM];
+  POPL_TAC[0;1];
+  ASM_MESON_TAC[BIJ;INJ];
+  MATCH_MP_TAC FINITE_SUBSET;
+  EXISTS_TAC `({x | (x IN a) /\ ((f:A->B) x IN b)})` ;
+  CONJ_TAC;
+  FIRST_X_ASSUM (fun th -> MATCH_MP_TAC th);
+  CONJ_TAC;
+  ASM_MESON_TAC[BIJ;INJ];
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  ]
+);;
+
+(* }}} *)
+
+let FINITE_BIJ2 = prove_by_refinement(
+  `!a b (f:A->B). FINITE b /\ (BIJ f a b) ==> (FINITE a)`,
+(* {{{ proof *)
+
+  [
+  MESON_TAC[BIJ;FINITE_INJ]
+  ]);;
+(* }}} *)
+
+let BIJ_CARD = prove_by_refinement(
+  `!a b (f:A->B). FINITE a /\ (BIJ f a b) ==> (CARD a = (CARD b))`,
+(* {{{ proof *)
+
+  [
+  ASM_MESON_TAC[SURJ_IMAGE;BIJ;INJ;CARD_IMAGE_INJ];
+  ]);;
+
+(* }}} *)
+
+let PAIR_LEMMA = prove_by_refinement(
+   `!(x:num#num) i j. ((FST x = i) /\ (SND x = j)) <=> (x = (i,j))` ,
+(* {{{ proof *)
+
+   [
+   MESON_TAC[FST;SND;PAIR];
+   ]);;
+(* }}} *)
+
+let CARD_SING = prove_by_refinement(
+      `!(u:A->bool). (SING u ) ==> (CARD u = 1)`,
+(* {{{ proof *)
+   [
+   REWRITE_TAC[SING];
+   GEN_TAC;
+   DISCH_THEN (CHOOSE_TAC);
+   ASM_REWRITE_TAC[];
+   ASSUME_TAC FINITE_RULES;
+   ASM_SIMP_TAC[CARD_CLAUSES;NOT_IN_EMPTY];
+   ACCEPT_TAC (NUM_RED_CONV `SUC 0`)
+   ]);;
+(* }}} *)
+
+let FINITE_SING = prove_by_refinement(
+    `!(x:A). FINITE ({x})`,
+(* {{{ proof *)
+
+    [
+    MESON_TAC[FINITE_RULES]
+    ]);;
+(* }}} *)
+
+let NUM_INTRO = prove_by_refinement(
+  `!f P.((!(n:num). !(g:A). (f g = n) ==> (P g)) ==> (!g. (P g)))`,
+(* {{{ proof *)
+
+  [
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  GEN_TAC;
+  H_VAL (SPECL [`(f:A->num) (g:A)`; `g:A`]) (HYP "0");
+  ASM_MESON_TAC[];
+  ]);;
+(* }}} *)
+
+
+
+(* ------------------------------------------------------------------ *)
+(* Lemmas about the support of a function *)
+(* ------------------------------------------------------------------ *)
+
+
+(* Law of cardinal exponents B^0 = 1 *)
+let DOMAIN_EMPTY = prove_by_refinement(
+  `!b. FUN (EMPTY:A->bool) b = { (\ (u:A). (CHOICE (UNIV:B->bool))) }`,
+(* {{{ proof *)
+  [
+  GEN_TAC;
+  REWRITE_TAC[EXTENSION;FUN];
+  X_GEN_TAC `f:A->B`;
+  REWRITE_TAC[IN_ELIM_THM;INSERT;NOT_IN_EMPTY;SUBSET_EMPTY;SUPP];
+  REWRITE_TAC[EMPTY];
+  ONCE_REWRITE_TAC[EXTENSION];
+  REWRITE_TAC[IN];
+  EQ_TAC;
+  DISCH_TAC THEN (MATCH_MP_TAC EQ_EXT);
+  BETA_TAC;
+  ASM_REWRITE_TAC[];
+  DISCH_TAC THEN (ASM_REWRITE_TAC[]) THEN BETA_TAC;
+  ]);;
+(* }}} *)
+
+(* Law of cardinal exponents B^A * B = B^(A+1) *)
+let DOMAIN_INSERT = prove_by_refinement(
+  `!a b s. (~((s:A) IN a) ==>
+      (?F.   (BIJ F (FUN (s INSERT a) b)
+           { (u,v) | (u IN (FUN a b)) /\ ((v:B) IN b) }
+           )))`,
+(* {{{ proof *)
+  [
+  REPEAT GEN_TAC;
+  DISCH_TAC;
+  EXISTS_TAC  `\ f. ((\ x. (if (x=(s:A)) then (CHOICE (UNIV:B->bool)) else (f x))),(f s))`;
+  REWRITE_TAC[BIJ;INJ;SURJ];
+  TAUT_TAC `(A /\ (A ==> B) /\ (A ==>C))  ==> ((A/\ B) /\ (A /\ C))`;
+  REPEAT CONJ_TAC;
+  X_GEN_TAC `(f:A->B)`;
+  REWRITE_TAC[FUN;IN_ELIM_THM];
+  REWRITE_TAC[INSERT;SUBSET];
+  REWRITE_TAC[IN_ELIM_THM;SUPP];
+  STRIP_TAC;
+  ABBREV_TAC `g = \ x. (if (x=(s:A)) then (CHOICE (UNIV:B->bool)) else (f x)) `;
+  EXISTS_TAC `g:A->B`;
+  EXISTS_TAC `(f:A->B) s`;
+  REWRITE_TAC[];
+  REPEAT CONJ_TAC;
+  EXPAND_TAC "g" THEN BETA_TAC;
+  GEN_TAC;
+  REWRITE_TAC[IN;COND_ELIM_THM];
+  ASM_MESON_TAC[IN];
+  (* next *) ALL_TAC;
+  EXPAND_TAC "g" THEN BETA_TAC;
+  GEN_TAC;
+  ASM_CASES_TAC `(x:A) = s`;
+  ASM_REWRITE_TAC[];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[];
+  (* next *) ALL_TAC;
+  ASM_MESON_TAC[];
+  (* INJ *)  ALL_TAC;
+  REWRITE_TAC[FUN;SUPP];
+  DISCH_TAC;
+  X_GEN_TAC `f1:A->B`;
+  X_GEN_TAC `f2:A->B`;
+  REWRITE_TAC[IN];
+  DISCH_ALL_TAC;
+  MATCH_MP_TAC EQ_EXT;
+  GEN_TAC;
+  ASM_CASES_TAC `(x:A) = s`;
+  POPL_TAC[1;2;3;4;6;7];
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[PAIR;FST;SND];
+  POPL_TAC[1;2;3;4;6;7];
+  FIRST_X_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[FST] (AP_TERM `FST:((A->B)#B)->(A->B)` th))) ;
+  FIRST_X_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[COND_ELIM_THM] (BETA_RULE (AP_THM th `x:A`))));
+  LABEL_ALL_TAC;
+  H_UNDISCH_TAC (HYP "0");
+  COND_CASES_TAC;
+  ASM_MESON_TAC[];
+  ASM_MESON_TAC[];
+  (* SURJ *) ALL_TAC;
+  REWRITE_TAC[FUN;SUPP;IN_ELIM_THM];
+  REWRITE_TAC[IN;INSERT;SUBSET];
+  DISCH_ALL_TAC;
+  X_GEN_TAC `p:(A->B)#B`;
+  DISCH_THEN CHOOSE_TAC;
+  FIRST_X_ASSUM (fun th -> MP_TAC th);
+  DISCH_THEN CHOOSE_TAC;
+  FIRST_X_ASSUM MP_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  EXISTS_TAC `\ (x:A). if (x = s) then (v:B) else (u x)`;
+  REPEAT CONJ_TAC;
+  X_GEN_TAC `t:A`;
+  BETA_TAC;
+  REWRITE_TAC[IN_ELIM_THM;COND_ELIM_THM];
+  POPL_TAC[1;3;4;5];
+  ASM_MESON_TAC[];
+  X_GEN_TAC `t:A`;
+  BETA_TAC;
+  REWRITE_TAC[IN_ELIM_THM;COND_ELIM_THM];
+  ASM_CASES_TAC `(t:A) = s`;
+  POPL_TAC[1;3;4;5;6];
+  ASM_REWRITE_TAC[];
+  POPL_TAC[1;3;4;5;6];
+  FIRST_X_ASSUM (fun th -> ASSUME_TAC (SPEC `t:A` th));
+  ASM_SIMP_TAC[prove(`~((t:A)=s) ==> ((t=s)=F)`,MESON_TAC[])];
+  BETA_TAC;
+  REWRITE_TAC[];
+  POPL_TAC[0;2;3;4];
+  AP_THM_TAC;
+  AP_TERM_TAC;
+  MATCH_MP_TAC EQ_EXT;
+  X_GEN_TAC `t:A`;
+  BETA_TAC;
+  DISJ_CASES_TAC (prove(`(((t:A)=s) <=> T) \/ ((t=s) <=> F)`,MESON_TAC[]));
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[IN];
+  ASM_REWRITE_TAC[]
+  ]);;
+(* }}} *)
+
+let CARD_DELETE_CHOICE = prove_by_refinement(
+  `!(a:(A->bool)). ((FINITE a) /\ (~(a=EMPTY))) ==>
+   (SUC (CARD (a DELETE (CHOICE a))) = (CARD a))`,
+(* {{{ proof *)
+  [
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  ASM_SIMP_TAC[CARD_DELETE];
+  ASM_SIMP_TAC[CHOICE_DEF];
+  MATCH_MP_TAC (ARITH_RULE `~(x=0) ==> (SUC (x -| 1) = x)`);
+  ASM_MESON_TAC[HAS_SIZE_0;HAS_SIZE];
+  ]);;
+(* }}} *)
+
+
+(*
+let dets_flag = ref true;;
+dets_flag:= !labels_flag;;
+*)
+
+
+labels_flag:=false;;
+
+(* Law of cardinals |B^A| = |B|^|A| *)
+let FUN_SIZE = prove_by_refinement(
+  `!b a. (FINITE (a:A->bool)) /\ (FINITE (b:B->bool))
+          ==> ((FUN a b) HAS_SIZE ((CARD b) EXP (CARD a)))`,
+(* {{{ proof *)
+  [
+  GEN_TAC;
+  MATCH_MP_TAC (SPEC `CARD:(A->bool)->num` ((INST_TYPE) [`:A->bool`,`:A`]  NUM_INTRO));
+  INDUCT_TAC;
+  GEN_TAC;
+  DISCH_ALL_TAC;
+  ASM_REWRITE_TAC[];
+  REWRITE_TAC [EXP];
+  SUBGOAL_THEN `(a:A->bool) = EMPTY` ASSUME_TAC;
+  ASM_REWRITE_TAC[GSYM HAS_SIZE_0;HAS_SIZE];
+  ASM_REWRITE_TAC[HAS_SIZE;DOMAIN_EMPTY];
+  CONJ_TAC;
+  REWRITE_TAC[FINITE_SING];
+  MATCH_MP_TAC CARD_SING;
+  REWRITE_TAC[SING];
+  MESON_TAC[];
+  GEN_TAC;
+  FIRST_X_ASSUM (fun th -> ASSUME_TAC (SPEC `(a:A->bool) DELETE (CHOICE a)` th)) ;
+  DISCH_ALL_TAC;
+  SUBGOAL_THEN `CARD ((a:A->bool) DELETE (CHOICE a)) = n` ASSUME_TAC;
+  ASM_SIMP_TAC[CARD_DELETE];
+  SUBGOAL_THEN `CHOICE (a:A->bool) IN a` ASSUME_TAC;
+  MATCH_MP_TAC CHOICE_DEF;
+  ASSUME_TAC( ARITH_RULE `!x. (x = (SUC n)) ==> (~(x = 0))`);
+  REWRITE_TAC[GSYM HAS_SIZE_0;HAS_SIZE];
+  ASM_MESON_TAC[];
+  ASM_REWRITE_TAC[];
+  MESON_TAC[ ( ARITH_RULE `!n. (SUC n -| 1) = n`)];
+  LABEL_ALL_TAC;
+  H_MATCH_MP (HYP "3") (HYP "4");
+  SUBGOAL_THEN `FUN ((a:A->bool) DELETE CHOICE a) (b:B->bool) HAS_SIZE CARD b **| CARD (a DELETE CHOICE a)` ASSUME_TAC;
+  ASM_MESON_TAC[FINITE_DELETE];
+  ASSUME_TAC (SPECL [`((a:A->bool) DELETE (CHOICE a))`;`b:B->bool`;`(CHOICE (a:A->bool))` ] DOMAIN_INSERT);
+  LABEL_ALL_TAC;
+  H_UNDISCH_TAC (HYP "5");
+  REWRITE_TAC[IN_DELETE];
+  SUBGOAL_THEN `~((a:A->bool) = EMPTY)` ASSUME_TAC;
+  REWRITE_TAC[GSYM HAS_SIZE_0;HAS_SIZE];
+  ASSUME_TAC( ARITH_RULE `!x. (x = (SUC n)) ==> (~(x = 0))`);
+  ASM_MESON_TAC[];
+  ASM_SIMP_TAC[INSERT_DELETE;CHOICE_DEF];
+  DISCH_THEN CHOOSE_TAC;
+  REWRITE_TAC[HAS_SIZE];
+  SUBGOAL_THEN `FINITE (FUN (a:A->bool) (b:B->bool))` ASSUME_TAC;
+  (* CONJ_TAC; *) ALL_TAC;
+  MATCH_MP_TAC (SPEC `FUN (a:A->bool) (b:B->bool)` (PINST[(`:A->B`,`:A`);(`:(A->B)#B`,`:B`)] [] FINITE_BIJ2));
+  EXISTS_TAC `{u,v | (u:A->B) IN FUN (a DELETE CHOICE a) b /\ (v:B) IN b}`;
+  EXISTS_TAC `F':(A->B)->((A->B)#B)`;
+  ASM_REWRITE_TAC[];
+  MATCH_MP_TAC FINITE_PRODUCT;
+  ASM_REWRITE_TAC[];
+  ASM_MESON_TAC[HAS_SIZE];
+  ASM_REWRITE_TAC[];
+  SUBGOAL_THEN `CARD (FUN (a:A->bool) (b:B->bool)) = (CARD {u,v | (u:A->B) IN FUN (a DELETE CHOICE a) b /\ (v:B) IN b})` ASSUME_TAC;
+  MATCH_MP_TAC BIJ_CARD;
+  EXISTS_TAC `F':(A->B)->((A->B)#B)`;
+  ASM_REWRITE_TAC[];
+  (* *) ALL_TAC;
+  ASM_REWRITE_TAC[];
+  SUBGOAL_THEN `FINITE (a DELETE CHOICE (a:A->bool))` ASSUME_TAC;
+  ASM_MESON_TAC[FINITE_DELETE];
+  SUBGOAL_THEN `(FUN ((a:A->bool) DELETE CHOICE a) (b:B->bool)) HAS_SIZE (CARD b **| (CARD (a DELETE CHOICE a)))` ASSUME_TAC;
+  POPL_TAC[1;2;3;4;5;10;11];
+  ASM_MESON_TAC[CARD_DELETE];
+  POP_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[HAS_SIZE] th) THEN (ASSUME_TAC th));
+  ASM_SIMP_TAC[CARD_PRODUCT];
+  REWRITE_TAC[EXP;MULT_AC]
+  ]);;
+(* }}} *)
+
+labels_flag:= true;;
+
+
+(* ------------------------------------------------------------------ *)
+(* ------------------------------------------------------------------ *)
+
+
+
+(* Definitions in math tend to be n-tuples of data.  Let's make it
+   easy to pick out the individual components of a definition *)
+
+(* pick out the rest of n-tuples. Indexing consistent with lib.drop *)
+let drop0 = new_definition(`drop0 (u:A#B) = SND u`);;
+let drop1 = new_definition(`drop1 (u:A#B#C) = SND (SND u)`);;
+let drop2 = new_definition(`drop2 (u:A#B#C#D) = SND (SND (SND u))`);;
+let drop3 = new_definition(`drop3 (u:A#B#C#D#E) = SND (SND (SND (SND u)))`);;
+
+(* pick out parts of n-tuples *)
+
+let part0 = new_definition(`part0 (u:A#B) = FST u`);;
+let part1 = new_definition(`part1 (u:A#B#C) = FST (drop0 u)`);;
+let part2 = new_definition(`part2 (u:A#B#C#D) = FST (drop1 u)`);;
+let part3 = new_definition(`part3 (u:A#B#C#D#E) = FST (drop2 u)`);;
+let part4 = new_definition(`part4 (u:A#B#C#D#E#F) = FST (drop3 u)`);;
+let part5 = new_definition(`part5 (u:A#B#C#D#E#F#G) =
+   FST (SND (SND (SND (SND (SND u)))))`);;
+let part6 = new_definition(`part6 (u:A#B#C#D#E#F#G#H) =
+   FST (SND (SND (SND (SND (SND (SND u))))))`);;
+let part7 = new_definition(`part7 (u:A#B#C#D#E#F#G#H#I) =
+   FST (SND (SND (SND (SND (SND (SND (SND u)))))))`);;
+
+
+(* ------------------------------------------------------------------ *)
+(* Basic Definitions of Euclidean Space, Metric Spaces, and Topology *)
+(* ------------------------------------------------------------------ *)
+
+(* ------------------------------------------------------------------ *)
+(* Interface *)
+(* ------------------------------------------------------------------ *)
+
+let euclid_def = local_definition "euclid";;
+mk_local_interface "euclid";;
+
+overload_interface
+ ("+", `euclid'euclid_plus:(num->real)->(num->real)->(num->real)`);;
+
+make_overloadable "*#" `:A -> B -> B`;;
+
+let euclid_scale = euclid_def
+  `euclid_scale t f = \ (i:num). (t*. (f i))`;;
+
+overload_interface ("*#",`euclid'euclid_scale`);;
+
+parse_as_infix("*#",(20,"right"));;
+
+let euclid_neg = euclid_def `euclid_neg f = \ (i:num). (--. (f i))`;;
+
+(* This is highly ambiguous: -- f x can be read as
+   (-- f) x or as -- (f x).  *)
+overload_interface ("--",`euclid'euclid_neg`);;
+
+overload_interface
+  ("-", `euclid'euclid_minus:(num->real)->(num->real)->(num->real)`);;
+
+(* ------------------------------------------------------------------ *)
+(* Euclidean Space *)
+(* ------------------------------------------------------------------ *)
+
+let euclid_plus = euclid_def
+  `euclid_plus f g = \ (i:num). (f i) +. (g i)`;;
+
+let euclid = euclid_def `euclid n v <=> !m. (n <=| m) ==> (v m = &.0)`;;
+
+let euclidean = euclid_def `euclidean v <=> ?n. euclid n v`;;
+
+let euclid_minus = euclid_def
+  `euclid_minus f g = \(i:num). (f i) -. (g i)`;;
+
+let euclid0 = euclid_def `euclid0 = \(i:num). &.0`;;
+
+let coord = euclid_def `coord i (f:num->real) = f i`;;
+
+let dot = euclid_def `dot f g =
+  let (n = (min_num (\m. (euclid m f) /\ (euclid m g)))) in
+  sum (0,n) (\i. (f i)*(g i))`;;
+
+let norm = euclid_def `norm f = sqrt(dot f f)`;;
+
+let d_euclid = euclid_def `d_euclid f g = norm (f - g)`;;
+
+
+
+(* ------------------------------------------------------------------ *)
+(* Euclidean and Convex geometry *)
+(* ------------------------------------------------------------------ *)
+
+
+let sum_vector_EXISTS = prove_by_refinement(
+  `?sum_vector. (!f n. sum_vector(n,0) f = (\n. &.0)) /\
+    (!f m n. sum_vector(n,SUC m) f = sum_vector(n,m) f + f(n + m))`,
+  (* {{{ proof *)
+  [
+  (CHOOSE_TAC o prove_recursive_functions_exist num_RECURSION) `(!f n. sm n 0 f = (\n. &0)) /\ (!f m n. sm  n (SUC m) f = sm n m f + f(n + m))`;
+  EXISTS_TAC `\(n,m) f. (sm:num->num->(num->(num->real))->(num->real)) n m f`;
+  CONV_TAC(DEPTH_CONV GEN_BETA_CONV);
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+let sum_vector = new_specification ["sum_vector"] sum_vector_EXISTS;;
+
+let mk_segment = euclid_def
+  `mk_segment x y = { u | ?a. (&.0 <=. a) /\ (a <=. &.1) /\
+        (u = a *# x + (&.1 - a) *# y) }`;;
+
+let mk_open_segment = euclid_def
+  `mk_open_segment x y = { u | ?a. (&.0 <. a) /\ (a <. &.1) /\
+        (u = a *# x + (&.1 - a) *# y) }`;;
+
+let convex = euclid_def
+  `convex S <=> !x y. (S x) /\ (S y) ==> (mk_segment x y SUBSET S)`;;
+
+let convex_hull = euclid_def
+  `convex_hull S = { u | ?f alpha m. (!n. (n< m) ==> (S (f n))) /\
+    (sum(0,m) alpha = &.1) /\ (!n. (n< m) ==> (&.0 <=. (alpha n))) /\
+    (u = sum_vector(0,m) (\n. (alpha n) *# (f n)))}`;;
+
+let affine_hull = euclid_def
+  `affine_hull S = { u | ?f alpha m. (!n. (n< m) ==> (S (f n))) /\
+    (sum(0,m) alpha = &.1) /\
+    (u = sum_vector(0,m) (\n. (alpha n) *# (f n)))}`;;
+
+let mk_line = euclid_def `mk_line x y =
+   {z| ?t. (z = (t *# x) + ((&.1 - t) *# y)) }`;;
+
+let affine = euclid_def
+  `affine S <=> !x y. (S x ) /\ (S y) ==> (mk_line x y SUBSET S)`;;
+
+let affine_dim = euclid_def
+  `affine_dim n S <=>
+    (?T. (T HAS_SIZE (SUC n)) /\ (affine_hull T = affine_hull S)) /\
+    (!T m. (T HAS_SIZE (SUC m)) /\ (m < n) ==> ~(affine_hull T = affine_hull S))`;;
+
+let collinear = euclid_def
+  `collinear S <=> (?n. affine_dim n S /\ (n < 2))`;;
+
+let coplanar = euclid_def
+  `coplanar S <=> (?n. affine_dim n S /\ (n < 3))`;;
+
+let line = euclid_def
+  `line L <=> (affine L) /\ (affine_dim 1 L)`;;
+
+let plane = euclid_def
+  `plane P <=> (affine P) /\ (affine_dim 2 P)`;;
+
+let space = euclid_def
+  `space R <=> (affine R) /\ (affine_dim 3 R)`;;
+
+(*
+
+General constructor of conical objects, including
+  rays, cones, half-planes, etc.
+
+L is the edge.  C is the set of generators in the positive
+direction.
+
+If L is a line, and C = {c}, we get the half-plane bounded by
+L and containing c.
+
+If L is a point, and C is general, we get the cone at L generated
+by C.
+
+If L and C are both singletons, we get the ray ending at L.
+
+  *)
+
+let mk_open_half_set = euclid_def
+  `mk_open_half_set L S  =
+   { u | ?t v c. (L v) /\ (S c) /\ (&.0 < t) /\
+      (u = (t *# (c - v) + (&.1 - t) *# v)) }`;;
+
+let mk_half_set = euclid_def
+  `mk_half_set L S  =
+   { u | ?t v c. (L v) /\ (S c) /\ (&.0 <=. t) /\
+      (u = (t *# (c - v) + (&.1 - t) *# v)) }`;;
+
+
+let mk_angle = euclid_def `mk_angle x y z =
+   (mk_half_set {x} {y}) UNION (mk_half_set {x} {z})`;;
+
+let mk_signed_angle = euclid_def `mk_signed_angle x y z =
+   (mk_half_set {x} {y} , mk_half_set {x} {z})`;;
+
+let mk_convex_cone = euclid_def
+  `mk_convex_cone v (S:(num->real)->bool) =
+    mk_half_set {v} (convex_hull S)`;;
+
+(* we always normalize the radius of balls in a packing to 1 *)
+let packing = euclid_def(`packing (S:(num->real)->bool) <=>
+        !x y. ( ((S x) /\ (S y) /\ ((d_euclid x y) < (&.2))) ==>
+                (x = y))`);;
+
+let saturated_packing = euclid_def(`saturated_packing S <=>
+        (( packing S) /\
+        (!z. (affine_hull S z)  ==>
+               (?x. ((S x) /\ ((d_euclid x z) < (&.2))))))`);;
+
+
+(* 3 dimensions specific:  *)
+let cross_product3 = euclid_def(`cross_product3 v1 v2 =
+        let (x1 = v1 0) and (x2 = v1 1) and (x3 = v1 2) in
+        let (y1 = v2 0) and (y2 = v2 1) and (y3 = v2 2) in
+        (\k.
+                (if (k=0) then (x2*y3-x3*y2)
+                else if (k=1) then (x3*y1-x1*y3)
+                else if (k=2) then (x1*y2-x2*y1)
+                else (&0)))`);;
+
+let triple_product = euclid_def(`triple_product v1 v2 v3 =
+        dot v1 (cross_product3 v2 v3)`);;
+
+(* the bounding edge *)
+let mk_triangle = euclid_def `mk_triangle v1 v2 v3 =
+  (mk_segment v1 v2) UNION (mk_segment v2 v3) UNION (mk_segment v3 v1)`;;
+
+(* the interior *)
+let mk_interior_triangle = euclid_def
+  `mk_interior_triangle v1 v2 v3 =
+     mk_open_half_set (mk_line v1 v2) {v3} INTER
+       (mk_open_half_set (mk_line v2 v3) {v1}) INTER
+       (mk_open_half_set (mk_line v3 v1) {v2})`;;
+
+let mk_triangular_region = euclid_def
+  `mk_triangular_region v1 v2 v3 =
+    (mk_triangle v1 v2 v3) UNION (mk_interior_triangle v1 v2 v3)`;;
+
+
+(* ------------------------------------------------------------------ *)
+(* Statements of Theorems in Euclidean Geometry (no proofs *)
+(* ------------------------------------------------------------------ *)
+
+let half_set_convex = `!L S. convex (mk_half_set L S)`;;
+
+let open_half_set_convex = `!L S . convex (mk_open_half_set L S )`;;
+
+let affine_dim0 = `!S. (affine_dim 0 S) = (SING S)`;;
+
+let hull_convex = `!S. (convex (convex_hull S))`;;
+
+let hull_minimal = `!S T. (convex T) /\ (S SUBSET T) ==>
+     (convex_hull S) SUBSET T`;;
+
+let affine_hull_affine = `!S. (affine (affine_hull S))`;;
+
+let affine_hull_minimal = `!S T. (affine T) /\ (S SUBSET T) ==>
+     (affine_hull S) SUBSET T`;;
+
+let mk_line_dim = `!x y. ~(x = y) ==> affine_dim 1 (mk_line x y)`;;
+
+let affine_convex_hull = `!S. (affine_hull S) = (affine_hull (convex_hull S))`;;
+
+let convex_hull_hull = `!S. (convex_hull S) = (convex_hull (convex_hull S))`;;
+
+let euclid_affine_dim = `!n. affine_dim n (euclid n)`;;
+
+let affine_dim_subset = `!m n T S.
+  (affine_dim m T) /\ (affine_dim n S) /\ (T SUBSET S) ==> (m <= n)`;;
+
+(* A few of the Birkhoff postulates of Geometry (incomplete) *)
+
+let line_postulate = `!x y. ~(x = y) ==>
+   (?!L. (L x) /\ (L y) /\ (line L))`;;
+
+let ruler_postulate = `!L. (line L) ==>
+  (?f. (BIJ f L UNIV) /\
+  (!x y. (L x /\ L y ==> (d_euclid x y = abs(f x -. f y)))))`;;
+
+let affine_postulate = `!n. (affine_dim n P) ==> (?S.
+  (S SUBSET P) /\ (S HAS_SIZE n) /\ (affine_dim n S))`;;
+
+let line_plane = `!P x y. (plane P) /\ (P x) /\ (P y) ==>
+  (mk_line x y SUBSET P)`;;
+
+let plane_of_pt = `!S. (S HAS_SIZE 3) ==> (?P. (plane P) /\
+   (S SUBSET P))`;;
+
+let plane_of_pt_unique = `!S. (S HAS_SIZE 3) ==> (collinear S) \/
+  (?! P. (plane P) /\ (S SUBSET P))`;;
+
+let plane_inter = `!P Q. (plane P) /\ (plane Q) ==>
+  (P INTER Q = EMPTY) \/ (line (P INTER Q)) \/ (P = Q)`;;
+
+(* each line separates a plane into two half-planes *)
+let plane_separation =
+  `!P L. (plane P) /\ (line L) /\ (L SUBSET P) ==>
+  (?A B. (A INTER B = EMPTY) /\ (A INTER L = EMPTY) /\
+    (B INTER L = EMPTY) /\ (L UNION A UNION B = P) /\
+   (!c u. (P c) /\ (u = mk_open_half_set L {c}) ==>
+      (u = A) \/ (u = B) \/ (u = L)) /\
+   (!a b. (A a) /\ (B b) ==> ~(segment a b INTER L = EMPTY)))`;;
+
+let space_separation =
+  `!R P. (space R) /\ (plane P) /\ (P SUBSET R) ==>
+  (?A B. (A INTER B = EMRTY) /\ (A INTER P = EMRTY) /\
+    (B INTER P = EMRTY) /\ (P UNION A UNION B = R) /\
+   (!c u. (R c) /\ (u = mk_open_half_set P {c}) ==>
+      (u = A) \/ (u = B) \/ (u = P)) /\
+     (!a b. (A a) /\ (B b) ==> ~(segment a b INTER L = EMPTY)))`;;
+
+(* ------------------------------------------------------------------ *)
+(* Metric Space *)
+(* ------------------------------------------------------------------ *)
+
+let metric_space = euclid_def `metric_space (X:A->bool,d:A->A->real)
+   <=>
+   !x y z.
+      (X x) /\ (X y) /\ (X z) ==>
+         (((&.0) <=. (d x y)) /\
+          ((&.0 = d x y) = (x = y)) /\
+          (d x y = d y x) /\
+          (d x z <=. d x y + d y z))`;;
+
+(* ------------------------------------------------------------------ *)
+(* Measure *)
+(* ------------------------------------------------------------------ *)
+
+let set_translate = euclid_def
+  `set_translate v X = { z | ?x. (X x) /\ (z = v + x) }`;;
+
+let set_scale = euclid_def
+  `set_scale r X = { z | ?x. (X x) /\ (z = r *# x) }`;;
+
+let mk_rectangle = euclid_def
+  `mk_rectangle a b = { z | !(i:num). (a i <=. z i) /\ (z i <. b i) }`;;
+
+let one_vec = euclid_def
+  `one_vec n = (\i. if (i<| n) then (&.1) else (&.0))`;;
+
+let mk_cube = euclid_def
+  `mk_cube n k v =
+    let (r = twopow (--: (&: k))) in
+    let (vv = (\i. (real_of_int (v i)))) in
+     mk_rectangle (r *# vv) (r *# (vv + (one_vec n)))`;;
+
+let inner_cube = euclid_def
+  `inner_cube n k A =
+    { v | (mk_cube n k v SUBSET A) /\
+      (!i. (n <| i) ==> (&:0 = v i)) }`;;
+
+let outer_cube = euclid_def
+  `outer_cube n k A =
+    { v | ~((mk_cube n k v) INTER A = EMPTY) /\
+      (!i. (n <| i) ==> (&:0 = v i)) }`;;
+
+let inner_vol = euclid_def
+  `inner_vol n k A =
+    (&. (CARD (inner_cube n k A)))*(twopow (--: (&: (n*k))))`;;
+
+let outer_vol = euclid_def
+  `outer_vol n k A =
+    (&. (CARD (outer_cube n k A)))*(twopow (--: (&: (n*k))))`;;
+
+let euclid_bounded = euclid_def
+  `euclid_bounded A = (?R. !(x:num->real) i. (A x) ==> (x i <. R))`;;
+
+let vol = euclid_def
+  `vol n A = lim (\k. outer_vol n k A)`;;
+
+(* ------------------------------------------------------------------ *)
+(* COMPUTING PI *)
+(* ------------------------------------------------------------------ *)
+
+unambiguous_interface();;
+prioritize_real();;
+
+(* ------------------------------------------------------------------ *)
+(* general series approximations *)
+(* ------------------------------------------------------------------ *)
+
+let SER_APPROX1 = prove_by_refinement(
+  `!s f g.  (f sums s) /\ (summable g) ==>
+    (!k. ((!n. (||. (f (n+k)) <=. (g (n+k)))) ==>
+    ( (s - (sum(0,k) f)) <=. (suminf (\n. (g (n +| k)))))))`,
+  (* {{{ proof *)
+  [
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  GEN_TAC;
+  DISCH_TAC;
+  IMP_RES_THEN ASSUME_TAC SUM_SUMMABLE;
+  IMP_RES_THEN (fun th -> (ASSUME_TAC (SPEC `k:num` th))) SER_OFFSET;
+  IMP_RES_THEN ASSUME_TAC SUM_UNIQ;
+  SUBGOAL_THEN `(\n. (f (n+ k))) sums (s - (sum(0,k) f))` ASSUME_TAC;
+  ASM_MESON_TAC[];
+  SUBGOAL_THEN `summable (\n. (f (n+k))) /\ (suminf (\n. (f (n+k))) <=. (suminf (\n. (g (n+k)))))` ASSUME_TAC;
+  MATCH_MP_TAC SER_LE2;
+  BETA_TAC;
+  ASM_REWRITE_TAC[];
+  IMP_RES_THEN ASSUME_TAC SER_OFFSET;
+  FIRST_X_ASSUM (fun th -> ACCEPT_TAC (MATCH_MP SUM_SUMMABLE (((SPEC `k:num`) th))));
+  ASM_MESON_TAC[SUM_UNIQ]
+  ]);;
+  (* }}} *)
+
+let SER_APPROX = prove_by_refinement(
+  `!s f g.  (f sums s) /\ (!n. (||. (f n) <=. (g n))) /\
+       (summable g) ==>
+    (!k. (abs (s - (sum(0,k) f)) <=. (suminf (\n. (g (n +| k))))))`,
+  (* {{{ proof *)
+  [
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  GEN_TAC;
+  REWRITE_TAC[REAL_ABS_BOUNDS];
+  CONJ_TAC;
+  SUBGOAL_THEN `(!k. ((!n. (||. ((\p. (--. (f p))) (n+k))) <=. (g (n+k)))) ==> ((--.s) - (sum(0,k) (\p. (--. (f p)))) <=. (suminf (\n. (g (n +k))))))` ASSUME_TAC;
+  MATCH_MP_TAC SER_APPROX1;
+  ASM_REWRITE_TAC[];
+  MATCH_MP_TAC SER_NEG ;
+  ASM_REWRITE_TAC[];
+  MATCH_MP_TAC (REAL_ARITH (`(--. s -. (--. u) <=. x) ==> (--. x <=. (s -. u))`));
+  ONCE_REWRITE_TAC[GSYM SUM_NEG];
+  FIRST_X_ASSUM (fun th -> (MATCH_MP_TAC th));
+  BETA_TAC;
+  ASM_REWRITE_TAC[REAL_ABS_NEG];
+  H_VAL2 CONJ (HYP "0") (HYP "2");
+  IMP_RES_THEN MATCH_MP_TAC SER_APPROX1 ;
+  GEN_TAC;
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* now for pi calculation stuff *)
+(* ------------------------------------------------------------------ *)
+
+
+let local_def = local_definition "trig";;
+
+
+let PI_EST = prove_by_refinement(
+               `!n. (1 <=| n) ==> (abs(&4 / &(8 * n + 1) -
+            &2 / &(8 * n + 4) -
+            &1 / &(8 * n + 5) -
+            &1 / &(8 * n + 6)) <= &.622/(&.819))`,
+  (* {{{ proof *)
+   [
+   GEN_TAC THEN DISCH_ALL_TAC;
+   REWRITE_TAC[real_div];
+   MATCH_MP_TAC (REWRITE_RULE[real_div] (REWRITE_RULE[REAL_RAT_REDUCE_CONV `(&.4/(&.9) +(&.2/(&.12)) + (&.1/(&.13))+ (&.1/(&.14)))`] (REAL_ARITH `(abs((&.4)*.u)<=. (&.4)/(&.9)) /\ (abs((&.2)*.v)<=. (&.2)/(&.12)) /\ (abs((&.1)*w) <=. (&.1)/(&.13)) /\ (abs((&.1)*x) <=. (&.1)/(&.14)) ==> (abs((&.4)*u -(&.2)*v - (&.1)*w - (&.1)*x) <= (&.4/(&.9) +(&.2/(&.12)) + (&.1/(&.13))+ (&.1/(&.14))))`)));
+   IMP_RES_THEN ASSUME_TAC (ARITH_RULE `1 <=| n ==> (0 < n)`);
+   FIRST_X_ASSUM (fun th -> ASSUME_TAC (REWRITE_RULE[GSYM REAL_OF_NUM_LT] th));
+   ASSUME_TAC (prove(`(a<=.b) ==> (&.n*a <=. (&.n)*b)`,MESON_TAC[REAL_PROP_LE_LMUL;REAL_POS]));
+   REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_INV;prove(`||.(&.n) = (&.n)`,MESON_TAC[REAL_POS;REAL_ABS_REFL])];
+   REPEAT CONJ_TAC THEN (POP_ASSUM (fun th -> MATCH_MP_TAC th)) THEN (MATCH_MP_TAC (prove(`((&.0 <. (&.n)) /\ (&.n <=. a)) ==> (inv(a)<=. (inv(&.n)))`,MESON_TAC[REAL_ABS_REFL;REAL_ABS_INV;REAL_LE_INV2]))) THEN
+   REWRITE_TAC[REAL_LT;REAL_LE] THEN (H_UNDISCH_TAC (HYP"0")) THEN
+   ARITH_TAC]);;
+  (* }}} *)
+
+let pi_fun = local_def `pi_fun n = inv (&.16 **. n) *.
+          (&.4 / &.(8 *| n +| 1) -.
+           &.2 / &.(8 *| n +| 4) -.
+           &.1 / &.(8 *| n +| 5) -.
+           &.1 / &.(8 *| n +| 6))`;;
+
+let pi_bound_fun = local_def `pi_bound_fun n = if (n=0) then (&.8) else
+    (((&.15)/(&.16))*(inv(&.16 **. n))) `;;
+
+let PI_EST2 = prove_by_refinement(
+    `!k. abs(pi_fun k) <=. (pi_bound_fun k)`,
+  (* {{{ proof *)
+   [
+   GEN_TAC;
+   REWRITE_TAC[pi_fun;pi_bound_fun];
+   COND_CASES_TAC;
+   ASM_REWRITE_TAC[];
+   CONV_TAC (NUM_REDUCE_CONV);
+   (CONV_TAC (REAL_RAT_REDUCE_CONV));
+   CONV_TAC (RAND_CONV (REWR_CONV (REAL_ARITH `a*b = b*.a`)));
+   REWRITE_TAC[REAL_ABS_MUL;REAL_ABS_INV;REAL_ABS_POW;prove(`||.(&.n) = (&.n)`,MESON_TAC[REAL_POS;REAL_ABS_REFL])];
+   MATCH_MP_TAC (prove(`!x y z. (&.0 <. z /\ (y <=. x) ==> (z*y <=. (z*x)))`,MESON_TAC[REAL_LE_LMUL_EQ]));
+   ASSUME_TAC (REWRITE_RULE[] (REAL_RAT_REDUCE_CONV `(&.622)/(&.819) <=. (&.15)/(&.16)`));
+   IMP_RES_THEN ASSUME_TAC (ARITH_RULE `~(k=0) ==> (1<=| k)`);
+   IMP_RES_THEN ASSUME_TAC (PI_EST);
+   CONJ_TAC;
+   SIMP_TAC[REAL_POW_LT;REAL_LT_INV;ARITH_RULE `&.0 < (&.16)`];
+   ASM_MESON_TAC[REAL_LE_TRANS];
+   ]);;
+  (* }}} *)
+
+let GP16 = prove_by_refinement(
+  `!k. (\n. inv (&16 pow k) * inv (&16 pow n)) sums
+         inv (&16 pow k) * &16 / &15`,
+  (* {{{ proof *)
+  [
+  GEN_TAC;
+  ASSUME_TAC (REWRITE_RULE[] (REAL_RAT_REDUCE_CONV `abs (&.1 / (&. 16)) <. (&.1)`));
+  IMP_RES_THEN (fun th -> ASSUME_TAC (CONV_RULE REAL_RAT_REDUCE_CONV th)) GP;
+  MATCH_MP_TAC SER_CMUL;
+  ASM_REWRITE_TAC[GSYM REAL_POW_INV;REAL_INV_1OVER];
+  ]);;
+  (* }}} *)
+
+let GP16a = prove_by_refinement(
+   `!k. (0<|k) ==> (\n. (pi_bound_fun (n+k))) sums (inv(&.16 **. k))`,
+  (* {{{ proof *)
+   [
+   GEN_TAC;
+   DISCH_TAC;
+   SUBGOAL_THEN `(\n. pi_bound_fun (n+k)) = (\n. ((&.15/(&.16))* (inv(&.16)**. k) *. inv(&.16 **. n)))` (fun th-> REWRITE_TAC[th]);
+   MATCH_MP_TAC EQ_EXT;
+   X_GEN_TAC `n:num` THEN BETA_TAC;
+   REWRITE_TAC[pi_bound_fun];
+   COND_CASES_TAC;
+   ASM_MESON_TAC[ARITH_RULE `0<| k ==> (~(n+k = 0))`];
+   REWRITE_TAC[GSYM REAL_MUL_ASSOC];
+   AP_TERM_TAC;
+   REWRITE_TAC[REAL_INV_MUL;REAL_POW_ADD;REAL_POW_INV;REAL_MUL_AC];
+   SUBGOAL_THEN `(\n. (&.15/(&.16)) *. ((inv(&.16)**. k)*. inv(&.16 **. n))) sums ((&.15/(&.16)) *.(inv(&.16**. k)*. ((&.16)/(&.15))))` ASSUME_TAC;
+   MATCH_MP_TAC SER_CMUL;
+   REWRITE_TAC[REAL_POW_INV];
+   ACCEPT_TAC (SPEC `k:num` GP16);
+   FIRST_X_ASSUM MP_TAC;
+   REWRITE_TAC[REAL_MUL_ASSOC];
+   MATCH_MP_TAC (prove (`(x=y) ==> ((a sums x) ==> (a sums y))`,MESON_TAC[]));
+   MATCH_MP_TAC (REAL_ARITH `(b*(a*c) = (b*(&.1))) ==> ((a*b)*c = b)`);
+   AP_TERM_TAC;
+   CONV_TAC (REAL_RAT_REDUCE_CONV);
+   ]);;
+  (* }}} *)
+
+let PI_SER = prove_by_refinement(
+  `!k. (0<|k) ==> (abs(pi - (sum(0,k) pi_fun)) <=. (inv(&.16 **. (k))))`,
+  (* {{{ proof *)
+   [
+   GEN_TAC THEN DISCH_TAC;
+   ASSUME_TAC (ONCE_REWRITE_RULE[ETA_AX] (REWRITE_RULE[GSYM pi_fun] POLYLOG_THM));
+   ASSUME_TAC PI_EST2;
+   IMP_RES_THEN (ASSUME_TAC) GP16a;
+   IMP_RES_THEN (ASSUME_TAC) SUM_SUMMABLE;
+   IMP_RES_THEN (ASSUME_TAC) SER_OFFSET_REV;
+   IMP_RES_THEN (ASSUME_TAC) SUM_SUMMABLE;
+   MP_TAC (SPECL [`pi`;`pi_fun`;`pi_bound_fun` ] SER_APPROX);
+   ASM_REWRITE_TAC[];
+   DISCH_THEN (fun th -> MP_TAC (SPEC `k:num` th));
+   SUBGOAL_THEN `suminf (\n. pi_bound_fun (n + k)) = inv (&.16 **. k)` (fun th -> (MESON_TAC[th]));
+   ASM_MESON_TAC[SUM_UNIQ];
+   ]);;
+  (* }}} *)
+
+(* replace 3 by SUC (SUC (SUC 0)) *)
+let SUC_EXPAND_CONV tm =
+   let count = dest_numeral tm in
+   let rec add_suc i r =
+     if (i <=/ (Int 0)) then r
+     else add_suc (i -/ (Int 1)) (mk_comb (`SUC`,r)) in
+   let tm' = add_suc count `0` in
+   REWRITE_RULE[] (ARITH_REWRITE_CONV[] (mk_eq (tm,tm')));;
+
+let inv_twopow = prove(
+  `!n. inv (&.16 **. n) = (twopow (--: (&:(4*n)))) `,
+    REWRITE_TAC[TWOPOW_NEG;GSYM (NUM_RED_CONV `2 EXP 4`);
+    REAL_OF_NUM_POW;EXP_MULT]);;
+
+let PI_SERn n =
+   let SUM_EXPAND_CONV =
+           (ARITH_REWRITE_CONV[]) THENC
+           (TOP_DEPTH_CONV SUC_EXPAND_CONV) THENC
+           (REWRITE_CONV[sum]) THENC
+           (ARITH_REWRITE_CONV[REAL_ADD_LID;GSYM REAL_ADD_ASSOC]) in
+   let sum_thm = SUM_EXPAND_CONV (vsubst [n,`i:num`] `sum(0,i) f`) in
+   let gt_thm = ARITH_RULE (vsubst [n,`i:num`] `0 <| i`) in
+   ((* CONV_RULE REAL_RAT_REDUCE_CONV *)(CONV_RULE (ARITH_REWRITE_CONV[]) (BETA_RULE (REWRITE_RULE[sum_thm;pi_fun;inv_twopow] (MATCH_MP PI_SER gt_thm)))));;
+
+(* abs(pi - u ) < e *)
+let recompute_pi bprec =
+   let n = (bprec /4) in
+   let pi_ser = PI_SERn (mk_numeral (Int n)) in
+   let _ = remove_real_constant `pi` in
+   (add_real_constant pi_ser; INTERVAL_OF_TERM bprec `pi`);;
+
+(* ------------------------------------------------------------------ *)
+(* restore defaults *)
+(* ------------------------------------------------------------------ *)
+
+reduce_local_interface("trig");;
+pop_priority();;
+
+
+
+
+
+
+

diff --git a/Jordan/num_ext_gcd.ml b/Jordan/num_ext_gcd.ml
new file mode 100644 (file)
index 0000000..42a0d36
--- /dev/null
+++ b/Jordan/num_ext_gcd.ml
@@ -0,0 +1,249 @@
+(* 
+        Author: Thomas C. Hales, 2003
+
+        GCD_CONV takes two HOL-light terms (NUMERALs) a and b and
+        produces a theorem of the form
+                |- GCD a b = g
+
+        (In particular, the arguments cannot be negative.)
+
+*)
+
+
+prioritize_num();;
+
+let DIVIDE = new_definition(`DIVIDE a b = ?m. (b = m*a )`);; 
+
+parse_as_infix("||",(16,"right"));;
+
+override_interface("||",`DIVIDE:num->num->bool`);;
+
+(* Now prove the lemmas *)
+
+let DIV_TAC t =   EVERY[ REP_GEN_TAC;
+   REWRITE_TAC[DIVIDE];
+   DISCH_ALL_TAC;
+   REPEAT (FIRST_X_ASSUM CHOOSE_TAC); 
+   TRY (EXISTS_TAC t)];;
+
+
+let DIVIDE_DIVIDE = prove_by_refinement(
+  `!a b c. (((a || b) /\ (b || c)) ==> (a || c))`,
+   [
+   DIV_TAC `m'*m`;
+   ASM_REWRITE_TAC[MULT_ASSOC]
+   ]);;
+
+let DIVIDE_EQ = prove_by_refinement( 
+   `! a b. (((a || b) /\ (b || a)) ==> (a = b))`,
+  [
+  DIV_TAC `1`;
+  FIRST_X_ASSUM (fun th -> (POP_ASSUM MP_TAC) THEN REWRITE_TAC[th]);
+  ASM_CASES_TAC `b=0`;
+  ASM_REWRITE_TAC[];
+  ARITH_TAC;
+  REWRITE_TAC[ARITH_RULE `(b = m*m'*b) = (1*b = m*m'*b)`];
+  ASM_REWRITE_TAC[MULT_ASSOC;EQ_MULT_RCANCEL];
+  DISCH_THEN (fun th -> MP_TAC (REWRITE_RULE[MULT_EQ_1] (GSYM th)) );
+  DISCH_THEN (fun th -> REWRITE_TAC[CONJUNCT2 th] THEN ARITH_TAC);
+  ]);;
+
+let DIVIDE_SUM = prove_by_refinement(
+  `!a b h. (((h || a) /\ (h||b)) ==> (h || (a+b)))`,
+  [
+  DIV_TAC `m+m'`;
+  ASM_REWRITE_TAC[ARITH;RIGHT_ADD_DISTRIB];
+  ]);;
+
+let DIVIDE_SUMMAND = prove_by_refinement(
+  `!a b h. (((h|| b) /\ (h || (a+b))) ==> (h|| a))`,
+   [
+   DIV_TAC `m'-m`;
+   REWRITE_TAC[RIGHT_SUB_DISTRIB];
+   REPEAT (FIRST_X_ASSUM  (fun th -> REWRITE_TAC[GSYM th]));
+   ARITH_TAC;
+   ]);;
+
+let DIVIDE_PROD = prove_by_refinement(
+   `!a b h. (((h|| a) ==> (h || (b*a))))`,
+   [
+   DIV_TAC `b*m`;
+   ASM_REWRITE_TAC[MULT_ASSOC];
+   ]);;
+
+let DIVIDE_PROD2 = prove_by_refinement(
+   `!a b h. (((h|| a) ==> (h || (a*b))))`,
+   [
+   DIV_TAC `b*m`;
+   ASM_REWRITE_TAC[MULT_AC]
+   ]);;
+
+let GCD = new_definition(`GCD a b = @g. 
+        ((g || a) /\ (g || b) /\
+        (!h. (((h || a) /\ (h || b)) ==> (h || g))))`);;
+
+let gcd_certificate = prove(`!a b g. ((? r s r' s' a' b'.
+        ((a = a'*g) /\ (b = b'*g) /\ (g +r'*a+s'*b= r*a + s*b)))
+        ==> (GCD a b = g))`,
+        let tac1 = (
+        (REPEAT GEN_TAC)
+        THEN (DISCH_TAC)
+        THEN (REPEAT (POP_ASSUM CHOOSE_TAC))
+        THEN (REWRITE_TAC[GCD])
+        THEN (MATCH_MP_TAC SELECT_UNIQUE)
+        THEN BETA_TAC
+        THEN GEN_TAC
+        THEN EQ_TAC) and
+
+        ygbranch = (
+        DISCH_TAC
+        THEN (MATCH_MP_TAC DIVIDE_EQ)
+        THEN CONJ_TAC) and
+
+        ydivg_branch = (
+        (SUBGOAL_TAC (` (y || (r*a + s*b))/\ (y || (r'*a +s'*b))`))
+        THENL [((ASM MESON_TAC)[DIVIDE_SUM;DIVIDE_PROD]);
+        ((ASM MESON_TAC)[DIVIDE_SUMMAND])]
+        ) and
+
+        gdivy_branch = (
+        (UNDISCH_TAC 
+          (`(y||a) /\ (y ||b) /\ (!h. (((h||a)/\(h||b))==> (h||y)))`))
+        THEN (TAUT_TAC (` (A ==> B) ==> ((C /\ D/\ A)==> B)`))
+        THEN (DISCH_TAC)
+        THEN (POP_ASSUM MATCH_MP_TAC)
+        THEN (REWRITE_TAC[DIVIDE])
+        THEN (CONJ_TAC)
+        THEN ((ASM MESON_TAC)[])
+                ) and
+
+        yghyp_branch = (
+        (DISCH_TAC)
+        THEN (let x t = REWRITE_TAC[t] in (POP_ASSUM x))
+        THEN (CONJ_TAC)
+        THENL [((ASM MESON_TAC)[DIVIDE]);ALL_TAC]
+        THEN (CONJ_TAC)
+        THENL [((ASM MESON_TAC)[DIVIDE]);ALL_TAC]
+        THEN GEN_TAC
+        THEN DISCH_TAC
+        THEN (SUBGOAL_TAC (` (h || (r*a + s*b))/\ (h || (r'*a+s'*b))`))
+        THENL [((ASM MESON_TAC)[DIVIDE_SUM;DIVIDE_PROD]);
+                ((ASM MESON_TAC)[DIVIDE_SUMMAND])]
+                ) in
+        tac1 THENL [ygbranch THENL [ydivg_branch;gdivy_branch];yghyp_branch]);;
+
+(* Now compute gcd with CAML num calculations, 
+   then check the answer in HOL-light *)
+let gcd_num x1 x2 =
+        let rec gcd_data (a1,b1,x1,a2,b2,x2) = 
+        if (x1 < (Int 0)) then 
+                gcd_data(minus_num a1,minus_num b1,minus_num x1,a2,b2,x2)
+        else if (x2 < (Int 0)) then gcd_data(a1,b1,x1,minus_num a2,minus_num
+        b2,minus_num x2)
+        else if (x1 = (Int 0)) then (a2,b2,x2)
+        else if (x1>x2) then gcd_data (a2,b2,x2,a1,b1,x1)
+        else (
+                let r = (quo_num x2 x1) in
+                gcd_data (a1,b1,x1,a2 -/ r*/ a1,b2 -/ r*/ b1, x2 -/ r*/ x1)
+             ) in
+        gcd_data ((Int 1),(Int 0),x1,(Int 0),(Int 1),x2);;
+
+let gcd_num x1 x2 =
+        let rec gcd_data (a1,b1,x1,a2,b2,x2) = 
+        if (x1 < (Int 0)) then 
+                gcd_data(minus_num a1,minus_num b1,minus_num x1,a2,b2,x2)
+        else if (x2 < (Int 0)) then gcd_data(a1,b1,x1,minus_num a2,minus_num
+        b2,minus_num x2)
+        else if (x1 = (Int 0)) then (a2,b2,x2)
+        else if (x1>x2) then gcd_data (a2,b2,x2,a1,b1,x1)
+        else (
+                let r = (quo_num x2 x1) in
+                gcd_data (a1,b1,x1,a2 -/ r*/ a1,b2 -/ r*/ b1, x2 -/ r*/ x1)
+             ) in
+        gcd_data ((Int 1),(Int 0),x1,(Int 0),(Int 1),x2);;
+
+        (* g = gcd, (a',b') = (a,b)/g, g +r1'*a+s1'*b = r1*a+s1*b *)
+let gcd_numdata a b = 
+        let a = abs_num a in
+        let b = abs_num b in
+        let Z = Int 0 in
+        let (r,s,g) = gcd_num a b in
+        let a' = if (g=Z) then Z else round_num(a//g) in
+        let b' = if (g=Z) then Z else round_num(b//g) in
+        let _ = if not(a=a'*/g) then failwith "GCD_CONV a" else 0 in
+        let _ = if not(b=b'*/g) then failwith "GCD_CONV b" else 0 in
+        let _ = if not(g=r*/a+/s*/b) then failwith "GCD_CONV g" else 0 in
+        let (r1,r1') = if (r >/ Z) then (r,Z) else (Z,minus_num r) in
+        let (s1,s1') = if (s >/ Z) then (s,Z) else (Z,minus_num s) in
+        (g,a,b,a',b',r1',s1',r1,s1);;
+
+(* Here is the conversion.  
+        Example:
+                GCD_CONV (`66`) (`144`)
+
+*)
+let GCD_CONV at bt =
+        let a = dest_numeral at in
+        let b = dest_numeral bt in
+        let (g,a,b,a',b',r1',s1',r1,s1) = gcd_numdata a b in
+        prove(parse_term("GCD "^(string_of_num a)^" "^(string_of_num b)^" = "^
+                (string_of_num g)),
+                (MATCH_MP_TAC gcd_certificate)
+                THEN (EXISTS_TAC (mk_numeral r1))
+                THEN (EXISTS_TAC (mk_numeral s1))
+                THEN (EXISTS_TAC (mk_numeral r1'))
+                THEN (EXISTS_TAC (mk_numeral s1'))
+                THEN (EXISTS_TAC (mk_numeral a'))
+                THEN (EXISTS_TAC (mk_numeral b'))
+                THEN (ARITH_TAC));;
+
+(* Example:
+        hol_gcd 66 144
+
+   This version can overflow on CAML integers before it reaches hol-light.
+   Example:
+        hol_gcd 1000000000000000000 10000000000000000000000
+        - : thm = |- GCD 660865024 843055104 = 262144
+*)
+
+let hol_gcd a b = GCD_CONV (mk_small_numeral a) (mk_small_numeral b);;
+
+remove_interface ("||");;
+pop_priority();;
+
+
+(* test code *)
+
+exception Test_suite_num_ext_gcd of string;; 
+
+(* For the tests we use integers a and b.  These can overflow if
+   a and b are too large, so that we should confine ourselves to
+   tests that are not too large.
+*)
+
+let test_num_ext_gcd (a, b) = 
+  let a1 = string_of_int (abs a) in
+  let b1 = string_of_int (abs b) in
+  let c = gcd a b in
+  let c1 = string_of_int (abs c) in
+  let th = GCD_CONV (mk_small_numeral a) (mk_small_numeral b) in
+  if (not (hyp th = ([]:term list))) then raise
+    (failwith ("num_ext_gcd test suite failure "^a1^" "^b1))
+  else if (not (concl th = (parse_term ("GCD "^a1^" "^b1^"="^c1))))
+    then raise (failwith ("num_ext_gcd test suite failure "^a1^" "^b1))
+  else ();;
+ 
+
+let test_suite_num_ext_gcd  = 
+  let _ =
+    map test_num_ext_gcd
+      [(0,0);(0,1);(1,0);(-0,-0);
+       (2,3);(4,6);
+       (0,2);(2,0);
+       (10,100);(100,10);(17,100);(100,17)] in
+   print_string "num_ext_gcd loaded\n";;
+
+let divide = DIVIDE and
+    gcd = GCD and
+    gcd_conv = GCD_CONV;;
+  

diff --git a/Jordan/num_ext_nabs.ml b/Jordan/num_ext_nabs.ml
new file mode 100644 (file)
index 0000000..0ebedc6
--- /dev/null
+++ b/Jordan/num_ext_nabs.ml
@@ -0,0 +1,96 @@
+unambiguous_interface();;
+
+let INT_NUM = prove(`!u. (integer (real_of_num u))`,
+        (REWRITE_TAC[is_int]) THEN GEN_TAC THEN
+        (EXISTS_TAC (`u:num`)) THEN (MESON_TAC[]));;
+
+let INT_NUM_REAL = prove(`!u. (real_of_int (int_of_num u) = real_of_num u)`,
+        (REWRITE_TAC[int_of_num]) THEN
+        GEN_TAC THEN (MESON_TAC[INT_NUM;int_rep]));;
+
+let INT_IS_INT = prove(`!(a:int). (integer (real_of_int a))`,
+        REWRITE_TAC[int_rep;int_abstr]);;
+
+let INT_OF_NUM_DEST = prove(`!a n. ((real_of_int a = (real_of_num n)) =
+                (a = int_of_num n))`,
+        (REWRITE_TAC[int_eq])
+        THEN (REPEAT GEN_TAC)
+        THEN (REWRITE_TAC[int_of_num])
+        THEN (ASSUME_TAC (SPEC (`n:num`) INT_NUM))
+        THEN (UNDISCH_EL_TAC 0)
+        THEN (SIMP_TAC[int_rep]));;
+
+let INT_REP = prove(`!a. ?n m. (a = (int_of_num n) - (int_of_num m))`,
+        GEN_TAC
+        THEN (let tt =(REWRITE_RULE[is_int] (SPEC (`a:int`) INT_IS_INT)) in
+                (CHOOSE_TAC tt))
+        THEN (POP_ASSUM DISJ_CASES_TAC)
+        THENL [
+         (EXISTS_TAC (`n:num`)) THEN (EXISTS_TAC (`0`)) THEN
+         (ASM_REWRITE_TAC[INT_SUB_RZERO;GSYM INT_OF_NUM_DEST]);
+         (EXISTS_TAC (`0`)) THEN (EXISTS_TAC (`n:num`)) THEN
+         (REWRITE_TAC[INT_SUB_LZERO]) THEN
+         (UNDISCH_EL_TAC 0) THEN
+         (REWRITE_TAC[GSYM REAL_NEG_EQ;GSYM INT_NEG_EQ;GSYM int_neg_th;GSYM
+        INT_OF_NUM_DEST])]);;
+
+let INT_REP2 = prove( `!a. ?n. ((a = (&: n)) \/ (a = (--: (&: n))))`,
+(GEN_TAC)
+   THEN ((let tt =(REWRITE_RULE[is_int] (SPEC (`a:int`) INT_IS_INT)) in
+      (CHOOSE_TAC tt)))
+   THEN ((POP_ASSUM DISJ_CASES_TAC))
+   THENL
+   [ ((EXISTS_TAC (`n:num`)))
+   THEN ((ASM_REWRITE_TAC[GSYM INT_OF_NUM_DEST]));
+     ((EXISTS_TAC (`n:num`)))
+   (* THEN ((RULE_EL 0 (REWRITE_RULE[GSYM REAL_NEG_EQ;GSYM int_neg_th]))) *)
+   THEN (H_REWRITE_RULE[THM (GSYM REAL_NEG_EQ);THM (GSYM int_neg_th)] (HYP_INT 0))
+   THEN ((ASM_REWRITE_TAC[GSYM INT_NEG_EQ;GSYM INT_OF_NUM_DEST]))]);;
+
+
+
+(* ------------------------------------------------------------------ *)
+(* nabs : int -> num gives the natural number abs. value of an int *)
+(* ------------------------------------------------------------------ *)
+
+
+let nabs = new_definition(`nabs n = @u. ((n = int_of_num u) \/ (n =
+        int_neg (int_of_num u)))`);;
+
+let NABS_POS = prove(`!u. (nabs (int_of_num u)) = u`,
+        GEN_TAC
+        THEN (REWRITE_TAC [nabs])
+        THEN (MATCH_MP_TAC SELECT_UNIQUE)
+        THEN (GEN_TAC THEN BETA_TAC)
+        THEN (EQ_TAC)
+        THENL [(TAUT_TAC (` ((A==>C)/\ (B==>C)) ==> (A\/B ==>C) `));
+                MESON_TAC[]]
+        THEN CONJ_TAC THENL
+        (let branch2 =  (REWRITE_TAC[int_eq;int_neg_th;INT_NUM_REAL])
+        THEN (REWRITE_TAC[prove (`! u y.(((real_of_num u) = --(real_of_num y))=
+                ((real_of_num u) +(real_of_num y) = (&0)))`,REAL_ARITH_TAC)])
+        THEN (REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_EQ])
+        THEN (MESON_TAC[ADD_EQ_0]) in
+        [(REWRITE_TAC[int_eq;INT_NUM_REAL]);branch2])
+        THEN (REWRITE_TAC[INT_NUM_REAL])
+        THEN (MESON_TAC[REAL_OF_NUM_EQ]));;
+
+let NABS_NEG = prove(`!n. (nabs (-- (int_of_num n))) = n`,
+        GEN_TAC
+        THEN (REWRITE_TAC [nabs])
+        THEN (MATCH_MP_TAC SELECT_UNIQUE)
+        THEN (GEN_TAC THEN BETA_TAC)
+        THEN (EQ_TAC)
+        THENL [(TAUT_TAC (` ((A==>C)/\ (B==>C)) ==> (A\/B ==>C) `));
+                MESON_TAC[]]
+        THEN CONJ_TAC THENL
+        (let branch1 =  (REWRITE_TAC[int_eq;int_neg_th;INT_NUM_REAL])
+        THEN (REWRITE_TAC[prove (`! u y.((--(real_of_num u) = (real_of_num y))=
+                ((real_of_num u) +(real_of_num y) = (&0)))`,REAL_ARITH_TAC)])
+        THEN (REWRITE_TAC[REAL_OF_NUM_ADD;REAL_OF_NUM_EQ])
+        THEN (MESON_TAC[ADD_EQ_0]) in
+        [branch1;(REWRITE_TAC[int_eq;INT_NUM_REAL])])
+        THEN (REWRITE_TAC[INT_NUM_REAL;int_neg_th;REAL_NEG_EQ;REAL_NEGNEG])
+        THEN (MESON_TAC[REAL_OF_NUM_EQ]));;
+
+

diff --git a/Jordan/parse_ext_override_interface.ml b/Jordan/parse_ext_override_interface.ml
new file mode 100644 (file)
index 0000000..10d1a2d
--- /dev/null
+++ b/Jordan/parse_ext_override_interface.ml
@@ -0,0 +1,204 @@
+(*
+        Author: Thomas C. Hales
+
+        As a new user of HOL-light, I have had a difficult time distinguishing
+        between the different uses of overloaded operators such as
+        (+), ( * ), (abs) (&), and so forth.
+
+        Their interpretation is context dependent, according to which of
+        prioritize_num, prioritize_int, and prioritize_real was most
+        recently called.
+
+        This file removes all ambiguities in notation.
+        Following the usage of CAML, we append a dot to operations on real
+        numbers so that addition is (+.), etc.
+
+        In the same way, we remove ambiguities between natural numbers and
+        integers by appending a character.  We have chosen to use
+        the character `|` for natural number operations 
+        and the character `:` for integer operations.
+
+        The character `&` continues to denote the embedding of 
+        natural numbers into the integers or reals.
+
+        HOL-light parsing does not permit an operator mixing alphanumeric
+        characters with symbols.  Thus, we were not able to use (abs.)
+        and (abs:) for the absolute value.  Instead we adapt the usual notation
+        |x| for absolute value and write it in prefix notation ||: and
+        ||. for the integer and real absolute value functions respectively.
+
+        In deference to HOL-light notation, we use ** for the exponential
+        function.  There are three versions: ( **| ), ( **: ), and ( **. ).
+
+*)
+
+(* natural number operations *)
+
+
+
+let unambiguous_interface() = 
+parse_as_infix("+|",(16,"right"));
+parse_as_infix("-|",(18,"left"));
+parse_as_infix("*|",(20,"right"));
+parse_as_infix("**|",(24,"left")); (* EXP *)
+parse_as_infix("/|",(22,"right")); (* DIV *)
+parse_as_infix("%|",(22,"left"));  (* MOD *)
+parse_as_infix("<|",(12,"right"));
+parse_as_infix("<=|",(12,"right"));
+parse_as_infix(">|",(12,"right"));
+parse_as_infix(">=|",(12,"right"));
+override_interface("+|",`(+):num->(num->num)`);
+override_interface("-|",`(-):num->(num->num)`);
+override_interface("*|",`( * ):num->(num->num)`);
+override_interface("**|",`(EXP):num->(num->num)`);
+override_interface("/|",`(DIV):num->(num->num)`);
+override_interface("%|",`(MOD):num->(num->num)`);
+override_interface("<|",`(<):num->(num->bool)`);
+override_interface("<=|",`(<=):num->(num->bool)`);
+override_interface(">|",`(>):num->(num->bool)`);
+override_interface(">=|",`(>=):num->(num->bool)`);
+(* integer operations *)
+parse_as_infix("+:",(16,"right"));
+parse_as_infix("-:",(18,"left"));
+parse_as_infix("*:",(20,"right"));
+parse_as_infix("**:",(24,"left")); 
+parse_as_infix("<:",(12,"right"));
+parse_as_infix("<=:",(12,"right"));
+parse_as_infix(">:",(12,"right"));
+parse_as_infix(">=:",(12,"right"));
+override_interface("+:",`int_add:int->int->int`);
+override_interface("-:",`int_sub:int->int->int`);
+override_interface("*:",`int_mul:int->int->int`);
+override_interface("**:",`int_pow:int->num->int`);
+(* boolean *)
+override_interface("<:",`int_lt:int->int->bool`);
+override_interface("<=:",`int_le:int->int->bool`);
+override_interface(">:",`int_gt:int->int->bool`);
+override_interface(">=:",`int_ge:int->int->bool`);
+(* unary *)
+override_interface("--:",`int_neg:int->int`);
+override_interface("&:",`int_of_num:num->int`);
+override_interface("||:",`int_abs:int->int`);
+(* real number operations *)
+parse_as_infix("+.",(16,"right"));
+parse_as_infix("-.",(18,"left"));
+parse_as_infix("*.",(20,"right"));
+parse_as_infix("**.",(24,"left")); 
+parse_as_infix("<.",(12,"right"));
+parse_as_infix("<=.",(12,"right"));
+parse_as_infix(">.",(12,"right"));
+parse_as_infix(">=.",(12,"right"));
+override_interface("+.",`real_add:real->real->real`);
+override_interface("-.",`real_sub:real->real->real`);
+override_interface("*.",`real_mul:real->real->real`);
+override_interface("**.",`real_pow:real->num->real`);
+(* boolean *)
+override_interface("<.",`real_lt:real->real->bool`);
+override_interface("<=.",`real_le:real->real->bool`);
+override_interface(">.",`real_gt:real->real->bool`);
+override_interface(">=.",`real_ge:real->real->bool`);
+(* unary *)
+override_interface("--.",`real_neg:real->real`);
+override_interface("&.",`real_of_num:num->real`);
+override_interface("||.",`real_abs:real->real`);;
+
+let ambiguous_interface() = 
+reduce_interface("+|",`(+):num->(num->num)`);
+reduce_interface("-|",`(-):num->(num->num)`);
+reduce_interface("*|",`( * ):num->(num->num)`);
+reduce_interface("**|",`(EXP):num->(num->num)`);
+reduce_interface("/|",`(DIV):num->(num->num)`);
+reduce_interface("%|",`(MOD):num->(num->num)`);
+reduce_interface("<|",`(<):num->(num->bool)`);
+reduce_interface("<=|",`(<=):num->(num->bool)`);
+reduce_interface(">|",`(>):num->(num->bool)`);
+reduce_interface(">=|",`(>=):num->(num->bool)`);
+(* integer operations *)
+reduce_interface("+:",`int_add:int->int->int`);
+reduce_interface("-:",`int_sub:int->int->int`);
+reduce_interface("*:",`int_mul:int->int->int`);
+reduce_interface("**:",`int_pow:int->num->int`);
+(* boolean *)
+reduce_interface("<:",`int_lt:int->int->bool`);
+reduce_interface("<=:",`int_le:int->int->bool`);
+reduce_interface(">:",`int_gt:int->int->bool`);
+reduce_interface(">=:",`int_ge:int->int->bool`);
+(* unary *)
+reduce_interface("--:",`int_neg:int->int`);
+reduce_interface("&:",`int_of_num:num->int`);
+reduce_interface("||:",`int_abs:int->int`);
+(* real *)
+reduce_interface("+.",`real_add:real->real->real`);
+reduce_interface("-.",`real_sub:real->real->real`);
+reduce_interface("*.",`real_mul:real->real->real`);
+reduce_interface("**.",`real_pow:real->num->real`);
+(* boolean *)
+reduce_interface("<.",`real_lt:real->real->bool`);
+reduce_interface("<=.",`real_le:real->real->bool`);
+reduce_interface(">.",`real_gt:real->real->bool`);
+reduce_interface(">=.",`real_ge:real->real->bool`);
+(* unary *)
+reduce_interface("--.",`real_neg:real->real`);
+reduce_interface("&.",`real_of_num:num->real`);
+reduce_interface("||.",`real_abs:real->real`);;
+
+(* add to Harrison's priorities the functions pop_priority and get_priority *)
+let prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority = 
+  let v = ref ([]:string list) in
+  let prioritize_int() = 
+  v:= "int"::!v;
+  overload_interface ("+",`int_add:int->int->int`);
+  overload_interface ("-",`int_sub:int->int->int`);
+  overload_interface ("*",`int_mul:int->int->int`);
+  overload_interface ("<",`int_lt:int->int->bool`);
+  overload_interface ("<=",`int_le:int->int->bool`);
+  overload_interface (">",`int_gt:int->int->bool`);
+  overload_interface (">=",`int_ge:int->int->bool`);
+  overload_interface ("--",`int_neg:int->int`);
+  overload_interface ("pow",`int_pow:int->num->int`);
+  overload_interface ("abs",`int_abs:int->int`);
+  override_interface ("&",`int_of_num:num->int`) and
+  prioritize_num() = 
+  v:= "num"::!v;
+  overload_interface ("+",`(+):num->num->num`);
+  overload_interface ("-",`(-):num->num->num`);
+  overload_interface ("*",`(*):num->num->num`);
+  overload_interface ("<",`(<):num->num->bool`);
+  overload_interface ("<=",`(<=):num->num->bool`);
+  overload_interface (">",`(>):num->num->bool`);
+  overload_interface (">=",`(>=):num->num->bool`) and
+  prioritize_real() =
+  v:= "real"::!v;
+  overload_interface ("+",`real_add:real->real->real`);
+  overload_interface ("-",`real_sub:real->real->real`);
+  overload_interface ("*",`real_mul:real->real->real`);
+  overload_interface ("/",`real_div:real->real->real`);
+  overload_interface ("<",`real_lt:real->real->bool`);
+  overload_interface ("<=",`real_le:real->real->bool`);
+  overload_interface (">",`real_gt:real->real->bool`);
+  overload_interface (">=",`real_ge:real->real->bool`);
+  overload_interface ("--",`real_neg:real->real`);
+  overload_interface ("pow",`real_pow:real->num->real`);
+  overload_interface ("inv",`real_inv:real->real`);
+  overload_interface ("abs",`real_abs:real->real`);
+  override_interface ("&",`real_of_num:num->real`) and
+  pop_priority() = 
+  if (length !v <= 1) then (print_string "priority unchanged\n") else
+  let (a::b::c) = !v in
+  v:= (b::c);
+  print_string ("priority is now "^b^"\n");
+  match a with
+    "num" -> prioritize_num() |
+    "int" -> prioritize_int() |
+    "real"-> prioritize_real()|
+    _ -> () and
+  get_priority() = 
+  if (!v=[]) then "unknown" else
+  let (a::b) = !v in a
+  in
+  prioritize_int,prioritize_num,prioritize_real,pop_priority,get_priority;;
+
+
+
+
+

diff --git a/Jordan/real_ext.ml b/Jordan/real_ext.ml
new file mode 100644 (file)
index 0000000..2fccc26
--- /dev/null
+++ b/Jordan/real_ext.ml
@@ -0,0 +1,218 @@
+
+
+
+
+(* ------------------------------------------------------------------ *)
+(*   Theorems that construct and propagate equality and inequality    *)
+(* ------------------------------------------------------------------ *)
+
+(* ------------------------------------------------------------------ *)
+(* Propagation of =EQUAL=  *)
+(* ------------------------------------------------------------------ *)
+
+unambiguous_interface();;
+prioritize_num();;
+
+let REAL_MUL_LTIMES = prove (`!x a b. (x*.a = x*.b) ==> (~(x=(&.0))) ==> (a =b)`,
+   MESON_TAC[REAL_EQ_MUL_LCANCEL]);;
+
+let REAL_MUL_RTIMES = prove (`!x a b. (a*.x = b*.x) ==> (~(x=(&.0))) ==> (a =b)`,
+   MESON_TAC[REAL_EQ_MUL_RCANCEL]);;
+
+let REAL_PROP_EQ_LMUL = REAL_MUL_LTIMES;;
+let REAL_PROP_EQ_RMUL = REAL_MUL_RTIMES;;
+
+let REAL_PROP_EQ_LMUL_' = REAL_EQ_MUL_LCANCEL (* |- !x y z. (x * y = x * z) = (x = &0) \/ (y = z) *);;
+let REAL_PROP_EQ_RMUL_' = REAL_EQ_MUL_LCANCEL (* |- !x y z. (x * z = y * z) = (x = y) \/ (z = &0) *);;
+(* see also minor variations REAL_LT_LMUL_EQ, REAL_LT_RMUL_EQ *)
+
+let REAL_PROP_EQ_SQRT = SQRT_INJ;; (* |- !x y. &0 <= x /\ &0 <= y ==> ((sqrt x = sqrt y) = x = y) *)
+
+(* ------------------------------------------------------------------ *)
+(* Construction of <=. *)
+(* ------------------------------------------------------------------ *)
+let REAL_MK_LE_SQUARE = REAL_LE_SQUARE_POW ;; (*  |- !x. &0 <= x pow 2 *)
+
+(* ------------------------------------------------------------------ *)
+(* Propagation of <=. *)
+(* ------------------------------------------------------------------ *)
+
+let REAL_MUL_LTIMES_LE = prove (`!x a b. (x*.a <=. x*.b) ==> (&.0 < x) ==> (a <=. b)`,
+   MESON_TAC[REAL_LE_LMUL_EQ]);;
+  (* virtually identical to REAL_LE_LCANCEL_IMP, REAL_LE_LMUL_EQ *)
+
+let REAL_MUL_RTIMES_LE = prove (`!x a b. (a*.x <=. b*.x) ==> (&.0 < x) ==> (a <=. b)`,
+   MESON_TAC[REAL_LE_RMUL_EQ]);;
+  (* virtually identical to REAL_LE_RCANCEL_IMP, REAL_LE_RMUL_EQ *)
+
+let REAL_PROP_LE_LCANCEL = REAL_MUL_LTIMES_LE;;
+let REAL_PROP_LE_RCANCEL = REAL_MUL_RTIMES_LE;;
+let REAL_PROP_LE_LMUL = REAL_LE_LMUL (* |- !x y z. &0 <= x /\ y <= z ==> x * y <= x * z *);;
+let REAL_PROP_LE_RMUL = REAL_LE_RMUL (* |- !x y z. x <= y /\ &0 <= z ==> x * z <= y * z *);;
+let REAL_PROP_LE_LRMUL = REAL_LE_MUL2;; (* |- !w x y z. &0 <= w /\ w <= x /\ &0 <= y /\ y <= z ==> w * y <= x * z *)
+let REAL_PROP_LE_POW = POW_LE;; (* |- !n x y. &0 <= x /\ x <= y ==> x pow n <= y pow n *)
+let REAL_PROP_LE_SQRT = SQRT_MONO_LE_EQ;; (* |- !x y. &0 <= x /\ &0 <= y ==> (sqrt x <= sqrt y = x <= y) *)
+
+(* ------------------------------------------------------------------ *)
+(* Construction of LT *)
+(* ------------------------------------------------------------------ *)
+
+let REAL_MK_LT_SQUARE  = REAL_LT_SQUARE;; (* |- !x. &0 < x * x = ~(x = &0) *)
+
+(* ------------------------------------------------------------------ *)
+(* Propagation of LT *)
+(* ------------------------------------------------------------------ *)
+
+let REAL_PROP_LT_LCANCEL = REAL_LT_LCANCEL_IMP (* |- !x y z. &0 < x /\ x * y < x * z ==> y < z *);;
+let REAL_PROP_LT_RCANCEL = REAL_LT_RCANCEL_IMP (* |- !x y z. &0 < z /\ x * z < y * z ==> x < y *);;
+let REAL_PROP_LT_LMUL = REAL_LT_LMUL (* |- !x y z. &0 < x /\ y < z ==> x * y < x * z *);;
+let REAL_PROP_LT_RMUL = REAL_LT_RMUL (* |- !x y z. x < y /\ &0 < z ==> x * z < y * z *);;
+(* minor variation REAL_LT_LMUL_IMP, REAL_LT_RMUL_IMP *)
+
+let REAL_PROP_LT_LRMUL= REAL_LT_MUL2;; (* |- !w x y z. &0 <= w /\ w < x /\ &0 <= y /\ y < z ==> w * y < x * z *)
+let REAL_PROP_LT_SQRT = SQRT_MONO_LT_EQ;; (* |- !x y. &0 <= x /\ &0 <= y ==> (sqrt x < sqrt y = x < y) *)
+
+(* ------------------------------------------------------------------ *)
+(* Constructors of Non-negative *)
+(* ------------------------------------------------------------------ *)
+
+let REAL_MK_NN_SQUARE = REAL_LE_SQUARE;; (* |- !x. &0 <= x * x *)
+let REAL_MK_NN_ABS = ABS_POS;; (* |- !x. &0 <= abs x *)
+
+(* ------------------------------------------------------------------ *)
+(* Propagation of Non-negative *)
+(* ------------------------------------------------------------------ *)
+
+let REAL_PROP_NN_POS = prove(`! x y. x<. y ==> x <= y`,MESON_TAC[REAL_LT_LE]);;
+let REAL_PROP_NN_ADD2 = REAL_LE_ADD (* |- !x y. &0 <= x /\ &0 <= y ==> &0 <= x + y *);;
+let REAL_PROP_NN_DOUBLE = REAL_LE_DOUBLE (* |- !x. &0 <= x + x <=> &0 <= x *);;
+let REAL_PROP_NN_RCANCEL= prove(`!x y. &.0 <. x /\ (&.0) <=. y*.x ==> ((&.0) <=. y)`,
+  MESON_TAC[REAL_PROP_LE_RCANCEL;REAL_MUL_LZERO]);;
+let REAL_PROP_NN_LCANCEL= prove(`!x y. &.0 <. x /\ (&.0) <=. x*.y ==> ((&.0) <=. y)`,
+  MESON_TAC[REAL_PROP_LE_LCANCEL;REAL_MUL_RZERO]);;
+let REAL_PROP_NN_MUL2 = REAL_LE_MUL (* |- !x y. &0 <= x /\ &0 <= y ==> &0 <= x * y *);;
+let REAL_PROP_NN_POW = REAL_POW_LE (* |- !x n. &0 <= x ==> &0 <= x pow n *);;
+let REAL_PROP_NN_SQUARE = REAL_LE_POW_2;; (* |- !x. &0 <= x pow 2 *)
+let REAL_PROP_NN_SQRT = SQRT_POS_LE;; (* |- !x. &0 <= x ==> &0 <= sqrt x *)
+let REAL_PROP_NN_INV = REAL_LE_INV_EQ (* |- !x. &0 <= inv x = &0 <= x *);;
+let REAL_PROP_NN_SIN = SIN_POS_PI_LE;; (* |- !x. &0 <= x /\ x <= pi ==> &0 <= sin x *)
+let REAL_PROP_NN_ATN = ATN_POS_LE;; (* |- &0 <= atn x = &0 <= x *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Constructor of POS *)
+(* ------------------------------------------------------------------ *)
+
+let REAL_MK_POS_ABS = REAL_ABS_NZ (* |- !x. ~(x = &0) = &0 < abs x *);;
+let REAL_MK_POS_EXP = REAL_EXP_POS_LT;; (* |- !x. &0 < exp x *)
+let REAL_MK_POS_LN = LN_POS_LT;; (* |- !x. &1 < x ==> &0 < ln x *)
+let REAL_MK_POS_PI = PI_POS;; (* |- &0 < pi *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Propagation of POS *)
+(* ------------------------------------------------------------------ *)
+
+let REAL_PROP_POS_ADD2 = REAL_LT_ADD (* |- !x y. &0 < x /\ &0 < y ==> &0 < x + y *);;
+let REAL_PROP_POS_LADD = REAL_LET_ADD (* |- !x y. &0 <= x /\ &0 < y ==> &0 < x + y *);;
+let REAL_PROP_POS_RADD = REAL_LTE_ADD (* |- !x y. &0 < x /\ &0 <= y ==> &0 < x + y *);;
+let REAL_PROP_POS_LMUL = REAL_LT_LMUL_0;; (* |- !x y. &0 < x ==> (&0 < x * y = &0 < y) *)
+let REAL_PROP_POS_RMUL = REAL_LT_RMUL_0;; (* |- !x y. &0 < y ==> (&0 < x * y = &0 < x) *)
+let REAL_PROP_POS_MUL2 = REAL_LT_MUL (* |- !x y. &0 < x /\ &0 < y ==> &0 < x * y *);;
+let REAL_PROP_POS_SQRT = SQRT_POS_LT;; (* |- !x. &0 < x ==> &0 < sqrt x *)
+let REAL_PROP_POS_POW =  REAL_POW_LT (*  |- !x n. &0 < x ==> &0 < x pow n *);;
+let REAL_PROP_POS_INV = REAL_LT_INV (* |- !x. &0 < x ==> &0 < inv x *);;
+let REAL_PROP_POS_SIN = SIN_POS_PI;; (*  |- !x. &0 < x /\ x < pi ==> &0 < sin x *)
+let REAL_PROP_POS_TAN = TAN_POS_PI2;; (* |- !x. &0 < x /\ x < pi / &2 ==> &0 < tan x *)
+let REAL_PROP_POS_ATN = ATN_POS_LT;; (* |- &0 < atn x = &0 < x *)
+
+(* ------------------------------------------------------------------ *)
+(* Construction of NZ *)
+(* ------------------------------------------------------------------ *)
+
+(* renamed from REAL_MK_NZ_OF_POS *)
+let REAL_MK_NZ_POS = REAL_POS_NZ (* |- !x. &0 < x ==> ~(x = &0) *);;
+let REAL_MK_NZ_EXP = REAL_EXP_NZ;; (*  |- !x. ~(exp x = &0) *)
+
+(* ------------------------------------------------------------------ *)
+(* Propagation of NZ *)
+(* ------------------------------------------------------------------ *)
+
+(* renamed from REAL_ABS_NZ, moved from float.ml *)
+let REAL_PROP_NZ_ABS =  prove(`!x. (~(x = (&.0))) ==> (~(abs(x) = (&.0)))`,
+    REWRITE_TAC[ABS_ZERO]);;
+let REAL_PROP_NZ_POW = REAL_POW_NZ (*  |- !x n. ~(x = &0) ==> ~(x pow n = &0) *);;
+let REAL_PROP_NZ_INV = REAL_INV_NZ;; (* |- !x. ~(x = &0) ==> ~(inv x = &0) *)
+
+
+(* ------------------------------------------------------------------ *)
+(* Propagation of ZERO *)
+(* ------------------------------------------------------------------ *)
+
+let REAL_PROP_ZERO_ABS = REAL_ABS_ZERO (* |- !x. (abs x = &0) = x = &0); *);;
+let REAL_PROP_ZERO_NEG = REAL_NEG_EQ_0 ;; (*  |- !x. (--x = &0) = x = &0 *)
+let REAL_PROP_ZERO_INV = REAL_INV_EQ_0 (* |- !x. (inv x = &0) = x = &0 *);;
+let REAL_PROP_ZERO_NEG = REAL_NEG_EQ0;; (* |- !x. (--x = &0) = x = &0 *)
+let REAL_PROP_ZERO_SUMSQ = REAL_SUMSQ;; (* |- !x y. (x * x + y * y = &0) = (x = &0) /\ (y = &0) *)
+let REAL_PROP_ZERO_POW = REAL_POW_EQ_0;; (* |- !x n. (x pow n = &0) = (x = &0) /\ ~(n = 0) *)
+let REAL_PROP_ZERO_SQRT = SQRT_EQ_0;; (* |- !x. &0 <= x ==> (x / sqrt x = sqrt x) *)
+
+(* ------------------------------------------------------------------ *)
+(* Special values of functions *)
+(* ------------------------------------------------------------------ *)
+
+let REAL_SV_LADD_0 = REAL_ADD_LID (* |- !x. &0 + x = x); *);;
+let REAL_SV_INV_0 = REAL_INV_0 (*  |- inv (&0) = &0 *);;
+let REAL_SV_RMUL_0 = REAL_MUL_RZERO (* |- !x. x * &0 = &0 *);;
+let REAL_SV_LMUL_0 = REAL_MUL_LZERO (* |- !x. &0 * x = &0 *);;
+let REAL_SV_NEG_0 = REAL_NEG_0 (*  |- -- &0 = &0 *);;
+let REAL_SV_ABS_0 = REAL_ABS_0 (* |- abs (&0) = &0 *);;
+let REAL_SV_EXP_0 = REAL_EXP_0;; (* |- exp (&0) = &1 *)
+let REAL_SV_LN_1 = LN_1;; (* |- ln (&1) = &0 *)
+let REAL_SV_SQRT_0 = SQRT_0;; (* |- sqrt (&0) = &0 *)
+let REAL_SV_TAN_0 = TAN_0;; (*  |- tan (&0) = &0 *)
+let REAL_SV_TAN_PI = TAN_PI;; (* |- tan pi = &0 *)
+
+(* ------------------------------------------------------------------ *)
+(* A tactic that multiplies a real on the left *)
+(* ------------------------------------------------------------------ *)
+
+(**
+#g `a:real = b:real`;;
+#e (REAL_LMUL_TAC `c:real`);;
+it : goalstack = 2 subgoals (2 total)
+`~(c = &0)`
+
+`c * a = c * b`
+
+ 0 [`~(c = &0)`]
+#
+**)
+(* ------------------------------------------------------------------ *)
+
+
+
+let REAL_LMUL_TAC t =
+  let REAL_MUL_LTIMES =
+        prove ((`!x a b.
+        (((~(x=(&0)) ==> (x*a = x*b)) /\ ~(x=(&0))) ==>  (a = b))`),
+                MESON_TAC[REAL_EQ_MUL_LCANCEL]) in
+   (MATCH_MP_TAC (SPEC t REAL_MUL_LTIMES))
+   THEN CONJ_TAC
+   THENL [DISCH_TAC; ALL_TAC];;
+
+(* ------------------------------------------------------------------ *)
+(* Right multiply by a real *)
+(* ------------------------------------------------------------------ *)
+
+let REAL_RMUL_TAC t =
+  let REAL_MUL_RTIMES =
+        prove (`!x a b.
+                ((~(x=(&0))==>(a*x = b*x)) /\ ~(x=(&0))) ==>  (a = b)`,
+                MESON_TAC[REAL_EQ_MUL_RCANCEL]) in
+   (MATCH_MP_TAC (SPEC t REAL_MUL_RTIMES))
+   THEN CONJ_TAC
+   THENL [DISCH_TAC; ALL_TAC];;
+
+
+pop_priority();;

diff --git a/Jordan/real_ext_geom_series.ml b/Jordan/real_ext_geom_series.ml
new file mode 100644 (file)
index 0000000..46e8565
--- /dev/null
+++ b/Jordan/real_ext_geom_series.ml
@@ -0,0 +1,49 @@
+
+prioritize_real();;
+
+let (TRY_RULE:(thm->thm) -> (thm->thm)) = 
+        fun rl t -> try (rl t) with _ -> t;;
+
+
+let REAL_MUL_RTIMES =
+        prove ((`!x a b. 
+                (((~(x=(&0))==>(a*x = b*x)) /\ ~(x=(&0))) ==>  (a = b))`),
+                MESON_TAC[REAL_EQ_MUL_RCANCEL]);;
+
+
+let GEOMETRIC_SUM = prove(
+        `!m n x.(~(x=(&1)) ==> 
+        (sum(m,n) (\k.(x pow k)) = ((x pow m) - (x pow (m+n)))/((&1)-x)))`,
+        let tac1 = 
+        GEN_TAC
+        THEN INDUCT_TAC
+        THEN GEN_TAC
+        THEN DISCH_TAC
+        THEN (REWRITE_TAC
+          [sum_DEF;real_pow;ADD_CLAUSES;real_div;REAL_SUB_RDISTRIB; 
+                REAL_SUB_REFL]) in
+        let tac2 = 
+         (RULE_ASSUM_TAC (TRY_RULE (SPEC (`x:real`))))
+        THEN (UNDISCH_EL_TAC 1)
+        THEN (UNDISCH_EL_TAC 0)
+        THEN (TAUT_TAC (`(A==>(B==>C))    ==> (A ==> ((A==>B) ==>C))`))
+        THEN (REPEAT DISCH_TAC)
+        THEN (ASM_REWRITE_TAC[real_div])
+        THEN (ABBREV_TAC (`a:real = x pow m`))
+        THEN (ABBREV_TAC (`b:real = x pow (m+n)`)) in
+        let tac3 =
+             (MATCH_MP_TAC (SPEC (`&1 - x`) REAL_MUL_RTIMES))
+        THEN CONJ_TAC 
+        THENL [ALL_TAC; (UNDISCH_TAC (`~(x = (&1))`))
+          THEN (ACCEPT_TAC (REAL_ARITH (`~(x=(&1)) ==> ~((&1 - x = (&0)))`)))]
+        THEN (REWRITE_TAC
+          [GSYM REAL_MUL_ASSOC;REAL_ADD_RDISTRIB;REAL_SUB_RDISTRIB])
+        THEN (SIMP_TAC[REAL_MUL_LINV])
+        THEN DISCH_TAC
+        THEN (REWRITE_TAC
+          [REAL_SUB_LDISTRIB;REAL_MUL_LID;REAL_MUL_RID;REAL_MUL_ASSOC])
+        THEN (ACCEPT_TAC (REAL_ARITH (`a - b + b - b*x = a - x*b`))) in
+        (tac1 THEN tac2 THEN tac3));;
+
+
+pop_priority();;

diff --git a/Jordan/tactics_ext.ml b/Jordan/tactics_ext.ml
new file mode 100644 (file)
index 0000000..7d96e89
--- /dev/null
+++ b/Jordan/tactics_ext.ml
@@ -0,0 +1,203 @@
+(* This file is in severe need of a rewrite! *)
+
+unambiguous_interface();;
+prioritize_real();;
+
+(* ------------------------------------------------------------------------- *)
+(* A printer that reverses the assumption list *)
+(* ------------------------------------------------------------------------- *)
+
+(*
+
+   Objective version of HOL-light uses (rev asl) in the method print_goal.
+   This means that the numbers printed next to the assumptions
+   are the reverse of the numbering in the list.
+
+   I want it the opposite way.
+   This reverses the numbering on the assumption list,
+   so that the printed numbers match the list order.
+
+   To use, type
+   #install_printer print_rev_goal;;
+   #install_printer print_rev_goalstack;;
+
+   To restore HOL-light defaults, type
+   #install_printer print_goal;;
+   #install_printer print_goalstack;;
+
+*)
+
+let (print_rev_goal:goal->unit) =
+  fun (asl,w) ->
+    print_newline();
+    if asl <> [] then (print_hyps 0 (asl); print_newline()) else ();
+    print_qterm w; print_newline();;
+
+let (print_rev_goalstate:int->goalstate->unit) =
+  fun k gs -> let (_,gl,_) = gs in
+              let n = length gl in
+              let s = if n = 0 then "No subgoals" else
+                        (string_of_int k)^" subgoal"^(if k > 1 then "s" else "")
+                     ^" ("^(string_of_int n)^" total)" in
+              print_string s; print_newline();
+              if gl = [] then () else
+              do_list (print_rev_goal o C el gl) (rev(0--(k-1)));;
+
+let (print_rev_goalstack:goalstack->unit) =
+  fun l ->
+    if l = [] then print_string "Empty goalstack"
+    else if tl l = [] then
+      let (_,gl,_ as gs) = hd l in
+      print_rev_goalstate 1 gs
+    else
+      let (_,gl,_ as gs) = hd l
+      and (_,gl0,_) = hd(tl l) in
+      let p = length gl - length gl0 in
+      let p' = if p < 1 then 1 else p + 1 in
+      print_rev_goalstate p' gs;;
+
+#install_printer print_rev_goal;;
+#install_printer print_rev_goalstack;;
+
+
+
+
+(* ------------------------------------------------------------------ *)
+(* SOME EASY TACTICS *)
+(* ------------------------------------------------------------------ *)
+
+let TAUT_TAC t = (MATCH_MP_TAC (TAUT t));;
+
+let REP_GEN_TAC = REPEAT GEN_TAC;;
+
+let SUBGOAL_TAC t = SUBGOAL_THEN t MP_TAC;;
+
+let DISCH_ALL_TAC = REP_GEN_TAC THEN
+  let tac = TAUT_TAC `(b ==> a==> c) ==> (a /\ b ==> c)` in
+  (REPEAT ((REPEAT tac) THEN DISCH_TAC)) THEN LABEL_ALL_TAC;;
+
+(* ------------------------------------------------------------------ *)
+(* TACTICS BY NUMBER. These are probably best avoided.
+   NB:
+   The numbering is that in the asm list -- not the printed numbers!  *)
+(* ------------------------------------------------------------------ *)
+
+let (UNDISCH_EL_TAC:int -> tactic) =
+ fun i (asl,w) ->
+   try let sthm,asl' = (el i asl),(drop i asl) in
+        let tm = concl (snd (el i asl)) in
+       let thm = snd sthm in
+       null_meta,[asl',mk_imp(tm,w)],
+       fun i [th] -> MP th (INSTANTIATE_ALL i thm)
+   with Failure _ -> failwith "UNDISCH_EL_TAC";;
+
+(* remove hypotheses by number *)
+let rec (POPL_TAC:int list ->tactic) =
+  let (POP_TAC:int->tactic) =
+    fun i -> (UNDISCH_EL_TAC i) THEN (TAUT_TAC `B ==> (A==>B)`) in
+  let renumber i =
+    map(fun j -> if j<=i then j else (j-1)) in
+  function [] -> ALL_TAC |
+      (i::b) -> (POP_TAC i) THEN (POPL_TAC (renumber i b));;
+
+let rec (UNDISCH_LIST:int list -> tactic) =
+  let renumber i =
+    map(fun j -> if j<=i then j else (j-1)) in
+  function [] -> ALL_TAC |
+      (i::b) -> (UNDISCH_EL_TAC i) THEN (UNDISCH_LIST (renumber i b));;
+
+(* ------------------------------------------------------------------ *)
+(*   Transformations of Hypothesis List by LABELS                     *)
+(* ------------------------------------------------------------------ *)
+
+type goalthm = goal -> thm;;
+
+let (HYP_INT:int->goalthm) =
+     fun i->
+     fun ((asl,_):goal) ->
+     snd (el i asl);;
+
+let (HYP:string->goalthm) =
+  fun s (asl,w) ->
+    try assoc s asl
+      with Failure _ -> assoc ("Z-"^s) asl;;
+
+let (THM:thm->goalthm) =
+     fun thm ->
+     fun (_:goal) -> thm;;
+
+let (H_RULER: (thm list->thm->thm)->(goalthm list)-> goalthm -> tactic) =
+     fun rule gthl gthm ->
+     fun ((asl,w) as g:goal) ->
+     let thl =  map (fun x-> (x g)) gthl in
+     let th = rule thl  (gthm g) in
+     ASSUME_TAC th g;;
+
+(* The next few term rules into goal_rules *)
+(* H_type (x:type) should return an object
+   similar to x but with thms made into goalthms *)
+
+let (H_RULE_LIST: (thm list->thm->thm)->(goalthm list)-> goalthm -> goalthm) =
+     fun rule gthl gthm g ->
+     let thl =  map (fun x-> (x g)) gthl in
+     rule thl  (gthm g);;
+
+let H_RULE2 (rule:thm->thm->thm) =
+  fun gthm1 gthm2 -> H_RULE_LIST (fun thl th -> rule (hd thl) th) [gthm1] gthm2;;
+
+let H_RULE (rule:thm->thm) =  fun gthm -> H_RULE_LIST (fun _ th -> rule th) [] gthm;;
+
+let (H_TTAC : thm_tactic -> goalthm -> tactic ) =
+  fun ttac gthm g -> (ttac (gthm g) g);;
+
+let H_ASSUME_TAC = H_TTAC ASSUME_TAC;;
+let INPUT = fun gth -> (H_ASSUME_TAC gth) THEN LABEL_ALL_TAC;;
+
+let H_VAL2 (rule:thm->thm->thm) =
+  fun gthm1 gthm2 -> H_RULER (fun thl th -> rule (hd thl) th) [gthm1] gthm2;;
+
+let H_CONJ = H_VAL2(CONJ);;
+let H_MATCH_MP = H_VAL2(MATCH_MP);;
+
+let H_REWRITE_RULE gthml gth = H_RULER REWRITE_RULE gthml gth;;
+let H_ONCE_REWRITE_RULE gthml gth = H_RULER ONCE_REWRITE_RULE gthml gth;;
+let H_SIMP_RULE = H_RULER SIMP_RULE;;
+
+let H_VAL (rule:thm->thm) = fun gthm -> H_RULER (fun _ th -> rule th) [] gthm;;
+let H = H_VAL;;
+
+let H_CONJUNCT1 = H_VAL CONJUNCT1;;
+let H_CONJUNCT2 = H_VAL CONJUNCT2;;
+let H_EQT_INTRO = H_VAL EQT_INTRO;;
+let H_EQT_ELIM  = H_VAL EQT_ELIM;;
+let H_SPEC = fun t -> H_VAL(SPEC t);;
+let H_GEN = fun t -> H_VAL(GEN t);;
+let H_DISJ1 = C (fun t -> H_VAL ((C DISJ1) t));;
+let H_DISJ2 =  (fun t -> H_VAL (( DISJ2) t));;
+  (* beware! One is inverted here. *)
+let H_NOT_ELIM = H_VAL (NOT_ELIM);;
+let H_NOT_INTRO = H_VAL (NOT_INTRO);;
+let H_EQF_ELIM = H_VAL (EQF_ELIM);;
+let H_EQF_INTRO = H_VAL (EQF_INTRO);;
+let (&&&) = H_RULE2 CONJ;;
+
+let (H_UNDISCH_TAC:goalthm -> tactic) =
+  fun gthm g ->
+    let tm = concl(gthm g) in
+    UNDISCH_TAC tm g;;
+
+
+
+(* let upgs tac gs = by tac gs;; *)
+
+let (thm_op:goalthm->goalthm->goalthm) =
+  fun gt1 gt2 g ->
+    if (is_eq (snd (strip_forall (concl (gt1 g)))))
+    then REWRITE_RULE[gt1 g] (gt2 g) else
+    MATCH_MP (gt1 g) (gt2 g);;
+
+let (COMBO:goalthm list-> goalthm) =
+  fun gthl -> end_itlist thm_op gthl;;
+
+let INPUT_COMBO = INPUT o COMBO;;
+

diff --git a/Jordan/tactics_ext2.ml b/Jordan/tactics_ext2.ml
new file mode 100644 (file)
index 0000000..989150b
--- /dev/null
+++ b/Jordan/tactics_ext2.ml
@@ -0,0 +1,1486 @@
+
+(* ------------------------------------------------------------------ *)
+(* MORE RECENT ADDITIONS *)
+(* ------------------------------------------------------------------ *)
+
+
+
+(* abbrev_type copied from definitions_group.ml *)
+
+let pthm = prove_by_refinement(
+  `(\ (x:A) .T) (@(x:A). T)`,
+  [BETA_TAC]);;
+
+let abbrev_type ty s = let (a,b) = new_basic_type_definition s
+   ("mk_"^s,"dest_"^s)
+   (INST_TYPE [ty,`:A`] pthm) in
+   let abst t = list_mk_forall ((frees t), t) in
+   let a' = abst (concl a) in
+   let b' = abst (rhs (concl b)) in
+   (
+   prove_by_refinement(a',[REWRITE_TAC[a]]),
+   prove_by_refinement(b',[REWRITE_TAC[GSYM b]]));;
+
+
+(* ------------------------------------------------------------------ *)
+(* KILL IN *)
+(* ------------------------------------------------------------------ *)
+
+let un = REWRITE_RULE[IN];;
+
+(* ------------------------------------------------------------------ *)
+
+let SUBCONJ_TAC =
+  MATCH_MP_TAC (TAUT `A /\ (A ==>B) ==> (A /\ B)`) THEN CONJ_TAC;;
+
+let PROOF_BY_CONTR_TAC =
+  MATCH_MP_TAC (TAUT `(~A ==> F) ==> A`) THEN DISCH_TAC;;
+
+
+
+(* ------------------------------------------------------------------ *)
+(* some general tactics *)
+(* ------------------------------------------------------------------ *)
+
+(* before adding assumption to hypothesis list, cleanse it
+   of unnecessary conditions *)
+
+
+let CLEAN_ASSUME_TAC th =
+   MP_TAC th THEN ASM_REWRITE_TAC[] THEN DISCH_TAC;;
+
+let CLEAN_THEN th ttac =
+   MP_TAC th THEN ASM_REWRITE_TAC[] THEN DISCH_THEN ttac;;
+
+(* looks for a hypothesis by matching a subterm *)
+let (UNDISCH_FIND_TAC: term -> tactic) =
+ fun tm (asl,w) ->
+   let p = can (term_match[] tm)  in
+   try let sthm,_ = remove
+     (fun (_,asm) -> can (find_term p) (concl ( asm))) asl in
+     UNDISCH_TAC (concl (snd sthm)) (asl,w)
+   with Failure _ -> failwith "UNDISCH_FIND_TAC";;
+
+let (UNDISCH_FIND_THEN: term -> thm_tactic -> tactic) =
+ fun tm ttac (asl,w) ->
+   let p = can (term_match[] tm)  in
+   try let sthm,_ = remove
+     (fun (_,asm) -> can (find_term p) (concl ( asm))) asl in
+     UNDISCH_THEN (concl (snd sthm)) ttac (asl,w)
+   with Failure _ -> failwith "UNDISCH_FIND_TAC";;
+
+(* ------------------------------------------------------------------ *)
+(* NAME_CONFLICT_TAC : eliminate name conflicts in a term *)
+(* ------------------------------------------------------------------ *)
+
+let relabel_bound_conv tm =
+ let rec vars_and_constants tm acc =
+   match tm with
+    | Var _ -> tm::acc
+    | Const _ -> tm::acc
+    | Comb(a,b) -> vars_and_constants b (vars_and_constants a acc)
+    | Abs(a,b) -> a::(vars_and_constants b acc) in
+ let relabel_bound tm =
+   match tm with
+    | Abs(x,t) ->
+        let avoids = filter ((!=) x) (vars_and_constants tm []) in
+        let x' = mk_primed_var avoids x in
+        if (x=x') then failwith "relabel_bound" else (alpha x' tm)
+    | _ -> failwith "relabel_bound" in
+ DEPTH_CONV (fun t -> ALPHA t (relabel_bound t)) tm;;
+
+(* example *)
+let _ =
+  let bad_term = mk_abs (`x:bool`,`(x:num)+1=2`) in
+  relabel_bound_conv bad_term;;
+
+let NAME_CONFLICT_CONV = relabel_bound_conv;;
+
+let NAME_CONFLICT_TAC =  CONV_TAC (relabel_bound_conv);;
+
+(* renames  given bound variables *)
+let alpha_conv env tm = ALPHA tm (deep_alpha env tm);;
+
+(* replaces given alpha-equivalent terms with- the term itself *)
+let unify_alpha_tac = SUBST_ALL_TAC o REFL;;
+
+let rec get_abs tm acc = match tm with
+   Abs(u,v) -> get_abs v (tm::acc)
+  |Comb(u,v) -> get_abs u (get_abs v acc)
+  |_ -> acc;;
+
+(* for purposes such as sorting, it helps if ALL ALPHA-equiv
+   abstractions are replaced by equal abstractions *)
+let (alpha_tac:tactic) =
+  fun  (asl,w' ) ->
+  EVERY (map unify_alpha_tac (get_abs w' [])) (asl,w');;
+
+(* ------------------------------------------------------------------ *)
+(* SELECT ELIMINATION.
+   SELECT_TAC should work whenever there is a single predicate selected.
+   Something more sophisticated might be needed when there
+   is (@)A and (@)B
+   in the same formula.
+   Useful for proving statements such as  `1 + (@x. (x=3)) = 4` *)
+(* ------------------------------------------------------------------ *)
+
+(* spec form of SELECT_AX *)
+let select_thm select_fn select_exist =
+  BETA_RULE (ISPECL [select_fn;select_exist]
+             SELECT_AX);;
+
+(* example *)
+select_thm
+    `\m. (X:num->bool) m /\ (!n. X n ==> m <=| n)` `n:num`;;
+
+let SELECT_EXIST = prove_by_refinement(
+  `!(P:A->bool) Q. (?y. P y) /\ (!t. (P t ==> Q t)) ==> Q ((@) P)`,
+  (* {{{ proof *)
+
+  [
+  REPEAT GEN_TAC;
+  DISCH_ALL_TAC;
+  UNDISCH_FIND_TAC `(?)`;
+  DISCH_THEN CHOOSE_TAC;
+  ASSUME_TAC (ISPECL[`P:(A->bool)`;`y:A`] SELECT_AX);
+  ASM_MESON_TAC[];
+  ]);;
+
+  (* }}} *)
+
+let SELECT_THM = prove_by_refinement(
+  `!(P:A->bool) Q. (((?y. P y) ==> (!t. (P t ==> Q t))) /\ ((~(?y. P y)) ==>
+     (!t. Q t))) ==> Q ((@) P)`,
+  (* {{{ proof *)
+  [
+  MESON_TAC[SELECT_EXIST];
+  ]);;
+  (* }}} *)
+
+let SELECT_TAC  =
+  (* explicitly pull apart the clause Q((@) P),
+     because MATCH_MP_TAC isn't powerful
+     enough to do this by itself. *)
+  let unbeta = prove(
+  `!(P:A->bool) (Q:A->bool). (Q ((@) P)) <=> (\t. Q t) ((@) P)`,MESON_TAC[]) in
+  let unbeta_tac = CONV_TAC (HIGHER_REWRITE_CONV[unbeta] true) in
+  unbeta_tac THEN (MATCH_MP_TAC SELECT_THM) THEN BETA_TAC THEN CONJ_TAC
+   THENL[
+     (DISCH_THEN (fun t-> ALL_TAC)) THEN GEN_TAC;
+     DISCH_TAC THEN GEN_TAC];;
+
+(* EXAMPLE:
+
+# g `(R:A->bool) ((@) S)`;;
+val it : Core.goalstack = 1 subgoal (1 total)
+
+`R ((@) S)`
+
+# e SELECT_TAC ;;
+val it : Core.goalstack = 2 subgoals (2 total)
+
+ 0 [`~(?y. S y)`]
+
+`R t`
+
+`S t ==> R t`
+
+*)
+
+
+(* ------------------------------------------------------------------ *)
+(* TYPE_THEN and TYPEL_THEN  calculate the types of the terms supplied
+   in a proof, avoiding the hassle of working them out by hand.
+   It locates the terms among the free variables in the goal.
+   Ambiguious if a free variables have name conflicts.
+
+   Now TYPE_THEN handles general terms.
+*)
+(* ------------------------------------------------------------------ *)
+
+
+let rec type_set: (string*term) list  -> (term list*term) -> (term list*term)=
+  fun typinfo (acclist,utm) -> match acclist with
+    | [] -> (acclist,utm)
+    | (Var(s,_) as a)::rest ->
+         let a' = (assocd s typinfo a) in
+           if (a = a') then type_set typinfo (rest,utm)
+           else let inst = instantiate (term_match [] a a') in
+             type_set typinfo ((map inst rest),inst utm)
+    | _ -> failwith "type_set: variable expected"
+  ;;
+
+let has_stv t =
+  let typ = (type_vars_in_term t) in
+  can (find (fun ty -> (is_vartype ty) && ((dest_vartype ty).[0] = '?'))) typ;;
+
+
+let TYPE_THEN: term  -> (term -> tactic) -> tactic =
+  fun t (tac:term->tactic) (asl,w) ->
+  let avoids = itlist (union o frees o concl o snd) asl
+                               (frees w) in
+  let strip  = fun t-> (match t with
+       |Var(s,_) -> (s,t) | _ -> failwith "TYPE_THEN" ) in
+  let typinfo = map strip avoids in
+  let t' = (snd (type_set typinfo ((frees t),t))) in
+    (warn ((has_stv t')) "TYPE_THEN: unresolved type variables");
+    tac t' (asl,w);;
+
+(* this version must take variables *)
+let TYPEL_THEN: term list -> (term list -> tactic) -> tactic =
+  fun t (tac:term list->tactic) (asl,w) ->
+  let avoids = itlist (union o frees o concl o snd) asl
+                               (frees w) in
+  let strip  = fun t-> (match t with
+       |Var(s,_) -> (s,t) | _ -> failwith "TYPE_THEN" ) in
+  let typinfo = map strip avoids in
+  let t' = map (fun u -> snd (type_set typinfo ((frees u),u))) t in
+    (warn ((can (find has_stv) t')) "TYPEL_THEN: unresolved type vars");
+     tac t' (asl,w);;
+
+(* trivial example *)
+
+let _ = prove_by_refinement(`!y. y:num = y`,
+ [
+   GEN_TAC;
+   TYPE_THEN `y:A` (fun t -> ASSUME_TAC(ISPEC t (TAUT `!x:B. x=x`)));
+   UNDISCH_TAC `y:num = y`; (* evidence that `y:A` was retyped as `y:num` *)
+   MESON_TAC[];
+ ]);;
+
+
+(* ------------------------------------------------------------------ *)
+(* SAVE the goalstate, and retrieve later *)
+(* ------------------------------------------------------------------ *)
+
+let (save_goal,get_goal) =
+  let goal_buffer  = ref [] in
+  let save_goal s =
+     goal_buffer := (s,!current_goalstack )::!goal_buffer in
+  let get_goal (s:string) = (current_goalstack:= assoc s !goal_buffer) in
+  (save_goal,get_goal);;
+
+
+(* ------------------------------------------------------------------ *)
+(* ordered rewrites with general ord function .
+   This allows rewrites with an arbitrary condition
+    -- adapted from simp.ml *)
+(* ------------------------------------------------------------------ *)
+
+
+
+let net_of_thm_ord ord rep force th =
+  let t = concl th in
+  let lconsts = freesl (hyp th) in
+  let matchable = can o term_match lconsts in
+  try let l,r = dest_eq t in
+      if rep & free_in l r then
+       let th' = EQT_INTRO th in
+       enter lconsts (l,(1,REWR_CONV th'))
+      else if rep & matchable l r & matchable r l then
+        enter lconsts (l,(1,ORDERED_REWR_CONV ord th))
+      else if force then
+        enter lconsts (l,(1,ORDERED_REWR_CONV ord th))
+      else enter lconsts (l,(1,REWR_CONV th))
+  with Failure _ ->
+      let l,r = dest_eq(rand t) in
+      if rep & free_in l r then
+       let tm = lhand t in
+       let th' = DISCH tm (EQT_INTRO(UNDISCH th)) in
+       enter lconsts (l,(3,IMP_REWR_CONV th'))
+      else if rep &  matchable l r & matchable r l then
+        enter lconsts (l,(3,ORDERED_IMP_REWR_CONV ord th))
+      else enter lconsts(l,(3,IMP_REWR_CONV th));;
+
+let GENERAL_REWRITE_ORD_CONV ord rep force (cnvl:conv->conv) (builtin_net:gconv net) thl =
+  let thl_canon = itlist (mk_rewrites false) thl [] in
+  let final_net = itlist (net_of_thm_ord ord rep force ) thl_canon builtin_net in
+  cnvl (REWRITES_CONV final_net);;
+
+let GEN_REWRITE_ORD_CONV ord force (cnvl:conv->conv) thl =
+  GENERAL_REWRITE_ORD_CONV ord false force cnvl empty_net thl;;
+
+let PURE_REWRITE_ORD_CONV ord force thl =
+  GENERAL_REWRITE_ORD_CONV ord true force TOP_DEPTH_CONV empty_net thl;;
+
+let REWRITE_ORD_CONV ord force thl =
+  GENERAL_REWRITE_ORD_CONV ord true force TOP_DEPTH_CONV (basic_net()) thl;;
+
+let PURE_ONCE_REWRITE_ORD_CONV ord force thl =
+  GENERAL_REWRITE_ORD_CONV ord false force ONCE_DEPTH_CONV empty_net thl;;
+
+let ONCE_REWRITE_ORD_CONV ord force thl =
+  GENERAL_REWRITE_ORD_CONV ord false force ONCE_DEPTH_CONV (basic_net()) thl;;
+
+let REWRITE_ORD_TAC ord force thl = CONV_TAC(REWRITE_ORD_CONV ord force thl);;
+
+
+
+
+(* ------------------------------------------------------------------ *)
+(* poly reduction *)
+(* ------------------------------------------------------------------ *)
+
+
+(* move vars  leftward *)
+(* if ord old_lhs new_rhs THEN swap *)
+
+
+let new_factor_order t1 t2 =
+  try let t1v = fst(dest_binop `( *. )` t1) in
+      let t2v = fst(dest_binop `( *. )` t2) in
+  if (is_var t1v) & (is_var t2v) then term_order t1v t2v
+  else if (is_var t2v) then true else false
+  with Failure _  -> false ;;
+
+(* false if it contains a variable or abstraction. *)
+let rec is_arith_const tm =
+  if is_var tm then false else
+  if is_abs tm then false else
+  if is_comb tm then
+     let (a,b) = (dest_comb tm) in
+     is_arith_const (a) & is_arith_const (b)
+  else true;;
+
+(* const leftward *)
+let new_factor_order2 t1 t2 =
+  try let t1v = fst(dest_binop `( *. )` t1) in
+      let t2v = fst(dest_binop `( *. )` t2) in
+  if (is_var t1v) & (is_var t2v) then term_order t1v t2v
+  else if (is_arith_const t2v) then true else false
+  with Failure _  -> false ;;
+
+let rec mon_sz tm =
+  if is_var tm then
+    Int (Hashtbl.hash tm)
+  else
+  try let (a,b) = dest_binop `( *. )` tm in
+    (mon_sz a) */ (mon_sz b)
+  with Failure _ -> Int 1;;
+
+let rec new_summand_order t1 t2 =
+  try let t1v = fst(dest_binop `( +. )` t1) in
+      let t2v = fst(dest_binop `( +. )` t2) in
+  (mon_sz t2v >/ mon_sz t1v)
+  with Failure _  -> false ;;
+
+let rec new_distrib_order t1 t2 =
+  try let t2v = fst(dest_binop `( *. )` t2) in
+  if (is_arith_const t2v) then true else false
+  with Failure _  ->
+    try
+      let t2' = fst(dest_binop `( +. )` t2) in
+      new_distrib_order t1 t2'
+    with Failure _ -> false ;;
+
+let real_poly_conv =
+  (* same side *)
+  ONCE_REWRITE_CONV [GSYM REAL_SUB_0] THENC
+  (* expand ALL *)
+  REWRITE_CONV[real_div;REAL_RDISTRIB;REAL_SUB_RDISTRIB;
+  pow;
+  GSYM REAL_MUL_ASSOC;GSYM REAL_ADD_ASSOC;
+   REAL_ARITH `(x -. (--y) = x + y) /\ (x - y = x + (-- y)) /\
+               (--(x + y) = --x + (--y)) /\ (--(x - y) = --x + y)`;
+   REAL_ARITH
+       `(x*.(-- y) = -- (x*. y)) /\ (--. (--. x) = x) /\
+       ((--. x)*.y = --.(x*.y))`;
+         REAL_SUB_LDISTRIB;REAL_LDISTRIB] THENC
+  (* move constants rightward on monomials *)
+   REWRITE_ORD_CONV new_factor_order false [REAL_MUL_AC;] THENC
+   GEN_REWRITE_CONV ONCE_DEPTH_CONV
+           [REAL_ARITH `-- x = (x*(-- &.1))`] THENC
+   REWRITE_CONV[GSYM REAL_MUL_ASSOC] THENC
+   REAL_RAT_REDUCE_CONV THENC
+   (* collect like monomials *)
+   REWRITE_ORD_CONV new_summand_order false [REAL_ADD_AC;] THENC
+   (* move constants leftward AND collect them together *)
+   REWRITE_ORD_CONV new_factor_order2 false [REAL_MUL_AC;] THENC
+   REWRITE_ORD_CONV new_distrib_order true [
+        REAL_ARITH `(a*b +. d*b = (a+d)*b) /\
+             (a*b + b = (a+ &.1)*b ) /\ ( b + a*b = (a+ &.1)*b) /\
+             (a*b +. d*b +e = (a+d)*b + e) /\
+             (a*b + b + e= (a+. &.1)* b +e ) /\
+             ( b + a*b + e = (a + &.1)*b +e) `;] THENC
+   REAL_RAT_REDUCE_CONV THENC
+   REWRITE_CONV[REAL_ARITH `(&.0 * x = &.0) /\ (x + &.0 = x) /\
+              (&.0 + x = x)`];;
+
+let real_poly_tac = CONV_TAC real_poly_conv;;
+
+let test_real_poly_tac = prove_by_refinement(
+  `!x y . (x + (&.2)*y)*(x- (&.2)*y) = (x*x -. (&.4)*y*y)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  real_poly_tac;
+  ]);;
+  (* }}} *)
+
+
+
+
+(* ------------------------------------------------------------------ *)
+(* REAL INEQUALITIES *)
+
+
+(* Take inequality certificate A + B1 + B2 +.... + P = C as a term.
+   Prove it as an inequality.
+   Reduce to an ineq (A < C) WITH side conditions
+      0 <= Bi,  0 < P.
+
+   If (not strict), write as an ineq (A <= C) WITH side conditions
+      0 <= Bi.
+
+   Expand each Bi (or P) that is a product U*V as 0 <= U /\ 0 <= V.
+   To prevent expansion of Bi write (U*V) as (&0 + (U*V)).
+
+   CALL as
+   ineq_le_tac `A + B1 + B2 = C`;
+
+   *)
+(* ------------------------------------------------------------------ *)
+
+
+let strict_lemma = prove_by_refinement(
+  `!A B C. (A+B = C) ==> ((&.0 <. B) ==> (A <. C)  )`,
+  (* {{{ proof *)
+  [
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let weak_lemma = prove_by_refinement(
+  `!A B C. (A+B = C) ==> ((&.0 <=. B) ==> (A <=. C))`,
+  (* {{{ proof *)
+  [
+  REAL_ARITH_TAC;
+  ]);;
+  (* }}} *)
+
+let strip_lt_lemma = prove_by_refinement(
+  `!B1 B2 C. ((&.0 <. (B1+B2)) ==> C) ==>
+         ((&.0 <. B2) ==> ((&.0 <=. B1) ==> C))`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[REAL_LET_ADD];
+  ]);;
+  (* }}} *)
+
+let strip_le_lemma = prove_by_refinement(
+  `!B1 B2 C. ((&.0 <=. (B1+B2)) ==> C) ==>
+         ((&.0 <=. B2) ==> ((&.0 <=. B1) ==> C))`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[REAL_LE_ADD];
+  ]);;
+  (* }}} *)
+
+let is_x_prod_le tm =
+  try let hyp = fst(dest_binop `( ==> )` tm) in
+      let arg = snd(dest_binop `( <=. ) ` hyp) in
+      let fac = dest_binop `( *. )` arg in
+  true
+  with Failure _ -> false;;
+
+let switch_lemma_le_order t1 t2 =
+  if (is_x_prod_le t1) & (is_x_prod_le t2) then
+  term_order t1 t2 else
+  if (is_x_prod_le t2) then true else false;;
+
+let is_x_prod_lt tm =
+  try let hyp = fst(dest_binop `( ==> )` tm) in
+      let arg = snd(dest_binop `( <. ) ` hyp) in
+      let fac = dest_binop `( *. )` arg in
+  true
+  with Failure _ -> false;;
+
+let switch_lemma_lt_order t1 t2 =
+  if (is_x_prod_lt t1) & (is_x_prod_lt t2) then
+  term_order t1 t2 else
+  if (is_x_prod_lt t2) then true else false;;
+
+let switch_lemma_le = prove_by_refinement(
+  `!A B C. ((&.0 <= A) ==> (&.0 <= B) ==> C) =
+       ((&.0 <=. B) ==> (&.0 <= A) ==> C)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let switch_lemma_let = prove_by_refinement(
+  `!A B C. ((&.0 < A) ==> (&.0 <= B) ==> C) =
+       ((&.0 <=. B) ==> (&.0 < A) ==> C)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let switch_lemma_lt = prove_by_refinement(
+  `!A B C. ((&.0 < A) ==> (&.0 < B) ==> C) =
+       ((&.0 <. B) ==> (&.0 < A)  ==> C)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[];
+  ]);;
+  (* }}} *)
+
+let expand_prod_lt = prove_by_refinement(
+  `!B1 B2 C. (&.0 < B1*B2 ==> C) ==>
+              ((&.0 <. B1) ==> (&.0 <. B2) ==> C)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[REAL_LT_MUL ];
+  ]);;
+  (* }}} *)
+
+let expand_prod_le = prove_by_refinement(
+  `!B1 B2 C. (&.0 <= B1*B2 ==> C) ==>
+              ((&.0 <=. B1) ==> (&.0 <=. B2) ==> C)`,
+  (* {{{ proof *)
+  [
+  ASM_MESON_TAC[REAL_LE_MUL ];
+  ]);;
+  (* }}} *)
+
+
+let ineq_cert_gen_tac v cert =
+  let DISCH_RULE f = DISCH_THEN (fun t-> MP_TAC (f t)) in
+  TYPE_THEN cert
+     (MP_TAC o (REWRITE_CONV[REAL_POW_2] THENC real_poly_conv)) THEN
+  REWRITE_TAC[] THEN
+  DISCH_RULE (MATCH_MP v) THEN
+  DISCH_RULE (repeat (MATCH_MP strip_lt_lemma)) THEN
+  DISCH_RULE (repeat (MATCH_MP strip_le_lemma)) THEN
+  DISCH_RULE (repeat (MATCH_MP expand_prod_lt o
+        (CONV_RULE
+   (REWRITE_ORD_CONV switch_lemma_lt_order true[switch_lemma_lt])))) THEN
+  DISCH_RULE (repeat (MATCH_MP expand_prod_le o
+        (CONV_RULE (REWRITE_ORD_CONV switch_lemma_le_order true
+                    [switch_lemma_le])) o
+      (REWRITE_RULE[switch_lemma_let]))) THEN
+  DISCH_RULE (repeat (MATCH_MP
+        (TAUT `(A ==> B==>C) ==> (A /\ B ==> C)`))) THEN
+  REWRITE_TAC[REAL_MUL_LID] THEN
+  DISCH_THEN MATCH_MP_TAC THEN
+  CONV_TAC  REAL_RAT_REDUCE_CONV THEN
+  ASM_SIMP_TAC[REAL_LE_POW_2;
+     REAL_ARITH `(&.0 < x ==> &.0 <= x) /\ (&.0 + x = x) /\
+          (a <= b ==> &.0 <= b - a) /\
+          (a < b ==> &.0 <= b - a) /\
+          (~(b < a) ==> &.0 <= b - a) /\
+          (~(b <= a) ==> &.0 <= b - a) /\
+          (a < b ==> &.0 < b - a) /\
+          (~(b <= a) ==> &.0 < b - a)`];;
+
+let ineq_lt_tac = ineq_cert_gen_tac strict_lemma;;
+let ineq_le_tac = ineq_cert_gen_tac weak_lemma;;
+
+
+
+(* test *)
+let test_ineq_tac  = prove_by_refinement(
+  `!x y z. (&.0 <= x*y) /\ (&.0 <. z) ==>
+             (x*y)  <. x*x + (&.3)*x*y + &.4 `,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  ineq_lt_tac `x * y + x pow 2 + &2 * (&.0 + x * y) + &2 * &2 = x * x + &3 * x * y + &4`;
+  ]);;
+  (* }}} *)
+
+
+
+(* ------------------------------------------------------------------ *)
+(* Move quantifier left. Use class.ml and theorems.ml to bubble
+   quantifiers towards the head of an expression.  It should move
+   quantifiers past other quantifiers, past conjunctions, disjunctions,
+   implications, etc.
+
+   val quant_left_CONV : string -> term -> thm = <fun>
+   Arguments:
+   var_name:string  -- The name of the variable that is to be shifted.
+
+   It tends to return `T` when the conversion fails.
+
+   Example:
+   quant_left_CONV "a" `!b. ?a. a = b*4`;;
+   val it : thm = |- (!b. ?a. a = b *| 4) <=> (?a. !b. a b = b *| 4)
+   *)
+(* ------------------------------------------------------------------ *)
+
+let tagb = new_definition `TAGB (x:bool) = x`;;
+
+let is_quant tm = (is_forall tm) or (is_exists tm);;
+
+(*** JRH replaced Comb and Abs with abstract type constructors ***)
+
+let rec tag_quant var_name tm =
+  if (is_forall tm && (fst (dest_var (fst (dest_forall tm))) = var_name))
+  then mk_comb (`TAGB`,tm)
+  else if (is_exists tm && (fst (dest_var (fst (dest_exists tm))) = var_name))   then mk_comb (`TAGB`,tm)
+  else match tm with
+     | Comb (x,y) -> mk_comb(tag_quant var_name x,tag_quant var_name y)
+     | Abs (x,y) -> mk_abs(x,tag_quant var_name y)
+     | _ -> tm;;
+
+let quant_left_CONV  =
+  (* ~! -> ?~ *)
+  let iprove f = prove(f,REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+  let NOT_FORALL_TAG = prove(`!P. ~(TAGB(!x. P x)) <=> (?x:A. ~(P x))`,
+                             REWRITE_TAC[tagb;NOT_FORALL_THM]) in
+ let SKOLEM_TAG =
+  prove(`!P. (?y. TAGB (!(x:A). P x ((y:A->B) x))) <=>
+     ( (!(x:A). ?y. P x ((y:B))))`,REWRITE_TAC[tagb;SKOLEM_THM]) in
+ let SKOLEM_TAG2 =
+   prove(`!P. (!x:A. TAGB(?y:B. P x y)) <=> (?y. !x. P x (y x))`,
+         REWRITE_TAC[tagb;SKOLEM_THM]) in
+ (* !1 !2 -> !2 !1 *)
+ let SWAP_FORALL_TAG =
+  prove(`!P:A->B->bool. (!x. TAGB(! y. P x y)) <=> (!y x. P x y)`,
+    REWRITE_TAC[SWAP_FORALL_THM;tagb]) in
+ let SWAP_EXISTS_THM = iprove
+  `!P:A->B->bool. (?x. TAGB (?y. P x y)) <=> (?y x. P x y)` in
+ (* ! /\ ! -> ! /\ *)
+ let AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\ TAGB (!x. Q x) <=>
+   (!x. P x /\ Q x))`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let LEFT_AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\  Q) <=>
+   (!x. P x /\ Q )`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let RIGHT_AND_FORALL_TAG = prove(`!P Q. P /\ TAGB (!x. Q x) <=>
+   (!x. P  /\ Q x)`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let TRIV_OR_FORALL_TAG = prove
+ (`!P Q. TAGB (!x:A. P) \/ TAGB (!x:A. Q) <=> (!x:A. P \/ Q)`,
+  REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let RIGHT_IMP_FORALL_TAG = prove
+ (`!P Q. (P ==> TAGB (!x:A. Q x)) <=> (!x. P ==> Q x)`,
+  REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let OR_EXISTS_THM = iprove
+  `!P Q. TAGB (?x. P x) \/ TAGB (?x. Q x) <=> (?x:A. P x \/ Q x)` in
+ let LEFT_OR_EXISTS_THM = iprove
+ `!P Q. TAGB (?x. P x) \/ Q <=> (?x:A. P x \/ Q)` in
+ let RIGHT_OR_EXISTS_THM = iprove
+ `!P Q. P \/ TAGB (?x. Q x) <=> (?x:A. P \/ Q x)` in
+ let LEFT_AND_EXISTS_THM = iprove
+ `!P Q. TAGB (?x:A. P x) /\ Q <=> (?x:A. P x /\ Q)` in
+ let RIGHT_AND_EXISTS_THM = iprove
+ `!P Q. P /\ TAGB (?x:A. Q x) <=> (?x:A. P /\ Q x)` in
+ let TRIV_AND_EXISTS_THM = iprove
+ `!P Q. TAGB (?x:A. P) /\ TAGB (?x:A. Q) <=> (?x:A. P /\ Q)` in
+ let LEFT_IMP_EXISTS_THM = iprove
+ `!P Q. (TAGB (?x:A. P x) ==> Q) <=> (!x. P x ==> Q)` in
+ let TRIV_FORALL_IMP_THM = iprove
+ `!P Q. (TAGB (?x:A. P) ==> TAGB (!x:A. Q)) <=> (!x:A. P ==> Q) ` in
+ let TRIV_EXISTS_IMP_THM = iprove
+ `!P Q. (TAGB(!x:A. P) ==> TAGB (?x:A. Q)) <=> (?x:A. P ==> Q) ` in
+ let NOT_EXISTS_TAG = prove(
+ `!P. ~(TAGB(?x:A. P x)) <=> (!x. ~(P x))`,
+ REWRITE_TAC[tagb;NOT_EXISTS_THM]) in
+ let LEFT_OR_FORALL_TAG = prove
+ (`!P Q. TAGB(!x:A. P x) \/ Q <=> (!x. P x \/ Q)`,
+ REWRITE_TAC[tagb;LEFT_OR_FORALL_THM]) in
+ let RIGHT_OR_FORALL_TAG = prove
+ (`!P Q. P \/ TAGB(!x:A. Q x) <=> (!x. P \/ Q x)`,
+  REWRITE_TAC[tagb;RIGHT_OR_FORALL_THM]) in
+ let LEFT_IMP_FORALL_TAG = prove
+ (`!P Q. (TAGB(!x:A. P x) ==> Q) <=> (?x. P x ==> Q)`,
+ REWRITE_TAC[tagb;LEFT_IMP_FORALL_THM]) in
+ let RIGHT_IMP_EXISTS_TAG = prove
+ (`!P Q. (P ==> TAGB(?x:A. Q x)) <=> (?x:A. P ==> Q x)`,
+ REWRITE_TAC[tagb;RIGHT_IMP_EXISTS_THM]) in
+  fun var_name tm ->
+     REWRITE_RULE [tagb]
+       (TOP_SWEEP_CONV
+       (GEN_REWRITE_CONV I
+         [NOT_FORALL_TAG;SKOLEM_TAG;SKOLEM_TAG2;
+          SWAP_FORALL_TAG;SWAP_EXISTS_THM;
+          SWAP_EXISTS_THM;
+          AND_FORALL_TAG;LEFT_AND_FORALL_TAG;RIGHT_AND_FORALL_TAG;
+          TRIV_OR_FORALL_TAG;RIGHT_IMP_FORALL_TAG;
+          OR_EXISTS_THM;LEFT_OR_EXISTS_THM;RIGHT_OR_EXISTS_THM;
+          LEFT_AND_EXISTS_THM;
+          RIGHT_AND_EXISTS_THM;
+          TRIV_AND_EXISTS_THM;LEFT_IMP_EXISTS_THM;TRIV_FORALL_IMP_THM;
+          TRIV_EXISTS_IMP_THM;NOT_EXISTS_TAG;
+          LEFT_OR_FORALL_TAG;RIGHT_OR_FORALL_TAG;LEFT_IMP_FORALL_TAG;
+          RIGHT_IMP_EXISTS_TAG;
+         ])
+       (tag_quant var_name tm));;
+
+(* same, but never pass a quantifier past another. No Skolem, etc. *)
+let quant_left_noswap_CONV  =
+  (* ~! -> ?~ *)
+  let iprove f = prove(f,REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+  let NOT_FORALL_TAG = prove(`!P. ~(TAGB(!x. P x)) <=> (?x:A. ~(P x))`,
+                             REWRITE_TAC[tagb;NOT_FORALL_THM]) in
+ let SKOLEM_TAG =
+  prove(`!P. (?y. TAGB (!(x:A). P x ((y:A->B) x))) <=>
+     ( (!(x:A). ?y. P x ((y:B))))`,REWRITE_TAC[tagb;SKOLEM_THM]) in
+ let SKOLEM_TAG2 =
+   prove(`!P. (!x:A. TAGB(?y:B. P x y)) <=> (?y. !x. P x (y x))`,
+         REWRITE_TAC[tagb;SKOLEM_THM]) in
+ (* !1 !2 -> !2 !1 *)
+ let SWAP_FORALL_TAG =
+  prove(`!P:A->B->bool. (!x. TAGB(! y. P x y)) <=> (!y x. P x y)`,
+    REWRITE_TAC[SWAP_FORALL_THM;tagb]) in
+ let SWAP_EXISTS_THM = iprove
+  `!P:A->B->bool. (?x. TAGB (?y. P x y)) <=> (?y x. P x y)` in
+ (* ! /\ ! -> ! /\ *)
+ let AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\ TAGB (!x. Q x) <=>
+   (!x. P x /\ Q x))`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let LEFT_AND_FORALL_TAG = prove(`!P Q. (TAGB (!x. P x) /\  Q) <=>
+   (!x. P x /\ Q )`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let RIGHT_AND_FORALL_TAG = prove(`!P Q. P /\ TAGB (!x. Q x) <=>
+   (!x. P  /\ Q x)`,REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let TRIV_OR_FORALL_TAG = prove
+ (`!P Q. TAGB (!x:A. P) \/ TAGB (!x:A. Q) <=> (!x:A. P \/ Q)`,
+  REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let RIGHT_IMP_FORALL_TAG = prove
+ (`!P Q. (P ==> TAGB (!x:A. Q x)) <=> (!x. P ==> Q x)`,
+  REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let OR_EXISTS_THM = iprove
+  `!P Q. TAGB (?x. P x) \/ TAGB (?x. Q x) <=> (?x:A. P x \/ Q x)` in
+ let LEFT_OR_EXISTS_THM = iprove
+ `!P Q. TAGB (?x. P x) \/ Q <=> (?x:A. P x \/ Q)` in
+ let RIGHT_OR_EXISTS_THM = iprove
+ `!P Q. P \/ TAGB (?x. Q x) <=> (?x:A. P \/ Q x)` in
+ let LEFT_AND_EXISTS_THM = iprove
+ `!P Q. TAGB (?x:A. P x) /\ Q <=> (?x:A. P x /\ Q)` in
+ let RIGHT_AND_EXISTS_THM = iprove
+ `!P Q. P /\ TAGB (?x:A. Q x) <=> (?x:A. P /\ Q x)` in
+ let TRIV_AND_EXISTS_THM = iprove
+ `!P Q. TAGB (?x:A. P) /\ TAGB (?x:A. Q) <=> (?x:A. P /\ Q)` in
+ let LEFT_IMP_EXISTS_THM = iprove
+ `!P Q. (TAGB (?x:A. P x) ==> Q) <=> (!x. P x ==> Q)` in
+ let TRIV_FORALL_IMP_THM = iprove
+ `!P Q. (TAGB (?x:A. P) ==> TAGB (!x:A. Q)) <=> (!x:A. P ==> Q) ` in
+ let TRIV_EXISTS_IMP_THM = iprove
+ `!P Q. (TAGB(!x:A. P) ==> TAGB (?x:A. Q)) <=> (?x:A. P ==> Q) ` in
+ let NOT_EXISTS_TAG = prove(
+ `!P. ~(TAGB(?x:A. P x)) <=> (!x. ~(P x))`,
+ REWRITE_TAC[tagb;NOT_EXISTS_THM]) in
+ let LEFT_OR_FORALL_TAG = prove
+ (`!P Q. TAGB(!x:A. P x) \/ Q <=> (!x. P x \/ Q)`,
+ REWRITE_TAC[tagb;LEFT_OR_FORALL_THM]) in
+ let RIGHT_OR_FORALL_TAG = prove
+ (`!P Q. P \/ TAGB(!x:A. Q x) <=> (!x. P \/ Q x)`,
+  REWRITE_TAC[tagb;RIGHT_OR_FORALL_THM]) in
+ let LEFT_IMP_FORALL_TAG = prove
+ (`!P Q. (TAGB(!x:A. P x) ==> Q) <=> (?x. P x ==> Q)`,
+ REWRITE_TAC[tagb;LEFT_IMP_FORALL_THM]) in
+ let RIGHT_IMP_EXISTS_TAG = prove
+ (`!P Q. (P ==> TAGB(?x:A. Q x)) <=> (?x:A. P ==> Q x)`,
+ REWRITE_TAC[tagb;RIGHT_IMP_EXISTS_THM]) in
+  fun var_name tm ->
+     REWRITE_RULE [tagb]
+       (TOP_SWEEP_CONV
+       (GEN_REWRITE_CONV I
+         [NOT_FORALL_TAG; (* SKOLEM_TAG;SKOLEM_TAG2; *)
+          (* SWAP_FORALL_TAG;SWAP_EXISTS_THM;
+          SWAP_EXISTS_THM; *)
+          AND_FORALL_TAG;LEFT_AND_FORALL_TAG;RIGHT_AND_FORALL_TAG;
+          TRIV_OR_FORALL_TAG;RIGHT_IMP_FORALL_TAG;
+          OR_EXISTS_THM;LEFT_OR_EXISTS_THM;RIGHT_OR_EXISTS_THM;
+          LEFT_AND_EXISTS_THM;
+          RIGHT_AND_EXISTS_THM;
+          TRIV_AND_EXISTS_THM;LEFT_IMP_EXISTS_THM;TRIV_FORALL_IMP_THM;
+          TRIV_EXISTS_IMP_THM;NOT_EXISTS_TAG;
+          LEFT_OR_FORALL_TAG;RIGHT_OR_FORALL_TAG;LEFT_IMP_FORALL_TAG;
+          RIGHT_IMP_EXISTS_TAG;
+         ])
+       (tag_quant var_name tm));;
+
+let quant_right_CONV  =
+  (* ~! -> ?~ *)
+  let iprove f = prove(f,REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+  let NOT_FORALL_TAG = prove(`!P. TAGB(?x:A. ~(P x)) <=> ~((!x. P x))`,
+                             REWRITE_TAC[tagb;GSYM NOT_FORALL_THM]) in
+ let SKOLEM_TAG =
+  prove(`!P. ( TAGB(!(x:A). ?y. P x ((y:B)))) <=>
+   (?y.  (!(x:A). P x ((y:A->B) x)))`,
+   REWRITE_TAC[tagb;GSYM SKOLEM_THM])
+   in
+ let SKOLEM_TAG2 =
+   prove(`!P. TAGB(?y. !x. P x (y x)) <=> (!x:A. (?y:B. P x y))`,
+         REWRITE_TAC[tagb;GSYM SKOLEM_THM]) in
+ (* !1 !2 -> !2 !1.. *)
+ let SWAP_FORALL_TAG =
+  prove(`!P:A->B->bool.  TAGB(!y x. P x y) <=> (!x. (! y. P x y))`,
+    REWRITE_TAC[GSYM SWAP_FORALL_THM;tagb]) in
+ let SWAP_EXISTS_THM = iprove
+  `!P:A->B->bool.  TAGB (?y x. P x y) <=> (?x. (?y. P x y))` in
+ (* ! /\ ! -> ! /\ *)
+ let AND_FORALL_TAG = iprove`!P Q. TAGB(!x. P x /\ Q x) <=>
+   ((!x. P x) /\ (!x. Q x))` in
+ let LEFT_AND_FORALL_TAG = prove(`!P Q.
+   TAGB(!x. P x /\ Q ) <=> ((!x. P x) /\  Q)`,
+   REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let RIGHT_AND_FORALL_TAG = prove(`!P Q.
+   TAGB(!x. P  /\ Q x) <=> P /\  (!x. Q x)`,
+   REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let TRIV_OR_FORALL_TAG = prove
+ (`!P Q.   TAGB(!x:A. P \/ Q) <=>(!x:A. P) \/  (!x:A. Q)`,
+  REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let RIGHT_IMP_FORALL_TAG = prove
+ (`!P Q. TAGB (!x. P ==> Q x) <=> (P ==>  (!x:A. Q x)) `,
+  REWRITE_TAC[tagb] THEN ITAUT_TAC) in
+ let OR_EXISTS_THM = iprove
+  `!P Q.  TAGB(?x:A. P x \/ Q x) <=> (?x. P x) \/ (?x. Q x) ` in
+ let LEFT_OR_EXISTS_THM = iprove
+ `!P Q. TAGB (?x:A. P x \/ Q) <=>  (?x. P x) \/ Q ` in
+ let RIGHT_OR_EXISTS_THM = iprove
+ `!P Q.TAGB (?x:A. P \/ Q x) <=>  P \/ (?x. Q x)` in
+ let LEFT_AND_EXISTS_THM = iprove
+ `!P Q.TAGB (?x:A. P x /\ Q) <=>  (?x:A. P x) /\ Q` in
+ let RIGHT_AND_EXISTS_THM = iprove
+ `!P Q. TAGB (?x:A. P /\ Q x) <=>  P /\ (?x:A. Q x) ` in
+ let TRIV_AND_EXISTS_THM = iprove
+ `!P Q. TAGB(?x:A. P /\ Q) <=>  (?x:A. P) /\  (?x:A. Q) ` in (* *)
+ let LEFT_IMP_EXISTS_THM = iprove
+ `!P Q. TAGB(!x. P x ==> Q) <=> ( (?x:A. P x) ==> Q) ` in (* *)
+ let TRIV_FORALL_IMP_THM = iprove
+ `!P Q. TAGB(!x:A. P ==> Q)  <=> ( (?x:A. P) ==>  (!x:A. Q)) ` in
+ let TRIV_EXISTS_IMP_THM = iprove
+ `!P Q. TAGB(?x:A. P ==> Q)  <=> ((!x:A. P) ==>  (?x:A. Q)) ` in
+ let NOT_EXISTS_TAG = prove(
+ `!P. TAGB(!x. ~(P x)) <=> ~((?x:A. P x)) `,
+ REWRITE_TAC[tagb;NOT_EXISTS_THM]) in
+ let LEFT_OR_FORALL_TAG = prove
+ (`!P Q. TAGB(!x. P x \/ Q) <=> (!x:A. P x) \/ Q `,
+ REWRITE_TAC[tagb;LEFT_OR_FORALL_THM]) in
+ let RIGHT_OR_FORALL_TAG = prove
+ (`!P Q. TAGB(!x. P \/ Q x) <=> P \/ (!x:A. Q x) `,
+  REWRITE_TAC[tagb;RIGHT_OR_FORALL_THM]) in
+ let LEFT_IMP_FORALL_TAG = prove
+ (`!P Q. TAGB(?x. P x ==> Q) <=> ((!x:A. P x) ==> Q) `,
+ REWRITE_TAC[tagb;LEFT_IMP_FORALL_THM]) in
+ let RIGHT_IMP_EXISTS_TAG = prove
+ (`!P Q. TAGB(?x:A. P ==> Q x) <=> (P ==> (?x:A. Q x)) `,
+ REWRITE_TAC[tagb;RIGHT_IMP_EXISTS_THM]) in
+  fun var_name tm ->
+     REWRITE_RULE [tagb]
+       (TOP_SWEEP_CONV
+       (GEN_REWRITE_CONV I
+         [NOT_FORALL_TAG;SKOLEM_TAG;SKOLEM_TAG2;
+          SWAP_FORALL_TAG;SWAP_EXISTS_THM;
+          SWAP_EXISTS_THM;
+          AND_FORALL_TAG;LEFT_AND_FORALL_TAG;RIGHT_AND_FORALL_TAG;
+          TRIV_OR_FORALL_TAG;RIGHT_IMP_FORALL_TAG;
+          OR_EXISTS_THM;LEFT_OR_EXISTS_THM;RIGHT_OR_EXISTS_THM;
+          LEFT_AND_EXISTS_THM;
+          RIGHT_AND_EXISTS_THM;
+          TRIV_AND_EXISTS_THM;LEFT_IMP_EXISTS_THM;TRIV_FORALL_IMP_THM;
+          TRIV_EXISTS_IMP_THM;NOT_EXISTS_TAG;
+          LEFT_OR_FORALL_TAG;RIGHT_OR_FORALL_TAG;LEFT_IMP_FORALL_TAG;
+          RIGHT_IMP_EXISTS_TAG;
+         ])
+       (tag_quant var_name tm));;
+
+
+(* ------------------------------------------------------------------ *)
+(* Dropping Superfluous Quantifiers .
+    Example: ?u. (u = t) /\ ...
+    We can eliminate the u.
+ *)
+(* ------------------------------------------------------------------ *)
+
+let mark_term = new_definition `mark_term (u:A) = u`;;
+
+(*** JRH replaced Comb and Abs with explicit constructors ***)
+
+let rec markq qname tm =
+  match tm with
+   Var (a,b) -> if (a=qname) then mk_icomb (`mark_term:A->A`,tm) else tm
+  |Const(_,_) -> tm
+  |Comb(s,b) -> mk_comb(markq qname s,markq qname b)
+  |Abs (x,t) -> mk_abs(x,markq qname t);;
+
+let rec getquants tm =
+  if (is_forall tm) then
+     (fst (dest_var (fst (dest_forall tm))))::
+        (getquants (snd (dest_forall tm)))
+  else if (is_exists tm) then
+     (fst (dest_var (fst (dest_exists tm))))::
+        (getquants (snd (dest_exists tm)))
+  else match tm with
+    Comb(s,b) -> (getquants s) @ (getquants b)
+  | Abs (x,t) -> (getquants t)
+  | _ -> [];;
+
+(* can loop if there are TWO *)
+let rewrite_conjs = [
+  prove_by_refinement (`!A B C. (A /\ B) /\ C <=> A /\ B /\ C`,[REWRITE_TAC[CONJ_ACI]]);
+  prove_by_refinement (`!u. (mark_term (u:A) = mark_term u) <=> T`,[MESON_TAC[]]);
+  prove_by_refinement (`!u t. (t = mark_term (u:A)) <=> (mark_term u = t)`,[MESON_TAC[]]);
+  prove_by_refinement (`!u a b. (mark_term (u:A) = a) /\ (mark_term u = b) <=> (mark_term u = a) /\ (a = b)`,[MESON_TAC[]]);
+  prove_by_refinement (`!u a b B. (mark_term (u:A) = a) /\ (mark_term u = b) /\ B <=> (mark_term u = a) /\ (a = b) /\ B`,[MESON_TAC[]]);
+  prove_by_refinement (`!u t A C. A /\ (mark_term (u:A) = t) /\ C <=>
+        (mark_term u = t) /\ A /\ C`,[MESON_TAC[]]);
+  prove_by_refinement (`!A u t. A /\ (mark_term (u:A) = t)  <=>
+        (mark_term u = t) /\ A `,[MESON_TAC[]]);
+  prove_by_refinement (`!u t C D. (((mark_term (u:A) = t) /\ C) ==> D) <=>
+        ((mark_term (u:A) = t) ==> C ==> D)`,[MESON_TAC[]]);
+  prove_by_refinement (`!A u t B. (A ==> (mark_term (u:A) = t) ==> B) <=>
+         ((mark_term (u:A) = t) ==> A ==> B)`,[MESON_TAC[]]);
+];;
+
+let higher_conjs = [
+  prove_by_refinement (`!C u t. ((mark_term u = t) ==> C (mark_term u)) <=>
+       ((mark_term u = t) ==> C (t:A))`,[MESON_TAC[mark_term]]);
+  prove_by_refinement (`!C u t. ((mark_term u = t) /\ C (mark_term u)) <=>
+         ((mark_term u = t) /\ C (t:A))`,[MESON_TAC[mark_term]]);
+];;
+
+
+let dropq_conv  =
+  let drop_exist =
+    REWRITE_CONV [prove_by_refinement (`!t. ?(u:A). (u = t)`,[MESON_TAC[]])] in
+  fun qname tm ->
+  let quanlist =  getquants tm in
+  let quantleft_CONV = EVERY_CONV
+      (map (REPEATC o quant_left_noswap_CONV) quanlist) in
+  let qname_conv tm = prove(mk_eq(tm,markq qname tm),
+             REWRITE_TAC[mark_term]) in
+  let conj_conv = REWRITE_CONV rewrite_conjs in
+  let quantright_CONV = (REPEATC (quant_right_CONV qname)) in
+  let drop_mark_CONV = REWRITE_CONV [mark_term] in
+ (quantleft_CONV THENC qname_conv  THENC conj_conv   THENC
+      (ONCE_REWRITE_CONV higher_conjs)
+       THENC drop_mark_CONV THENC quantright_CONV THENC
+       drop_exist  ) tm ;;
+
+
+(* Examples : *)
+dropq_conv "u" `!P Q R . (?(u:B). (?(x:A). (u = P x) /\ (Q x)) /\ (R u))`;;
+dropq_conv "t" `!P Q R. (!(t:B). (?(x:A). P x /\ (t = Q x)) ==> R t)`;;
+
+dropq_conv "u" `?u v.
+     ((t * (a + &1) + (&1 - t) *a = u) /\
+      (t * (b + &0) + (&1 - t) * b = v)) /\
+     a < u /\
+     u < r /\
+     (v = b)`;;
+
+
+
+(* ------------------------------------------------------------------ *)
+(*  SOME GENERAL TACTICS FOR THE ASSUMPTION LIST *)
+(* ------------------------------------------------------------------ *)
+
+let (%) i = HYP (string_of_int i);;
+
+let WITH i rule = (H_VAL (rule) (HYP (string_of_int i))) ;;
+
+let (UND:int -> tactic) =
+ fun i (asl,w) ->
+   let name = "Z-"^(string_of_int i) in
+   try let thm= assoc name asl in
+        let tm = concl (thm) in
+       let (_,asl') = partition (fun t-> ((=) name (fst t))) asl in
+       null_meta,[asl',mk_imp(tm,w)],
+       fun i [th] -> MP th (INSTANTIATE_ALL i thm)
+   with Failure _ -> failwith "UND";;
+
+let KILL i =
+  (UND i) THEN (DISCH_THEN (fun t -> ALL_TAC));;
+
+let USE i rule = (WITH i rule) THEN (KILL i);;
+
+let CHO i = (UND i) THEN (DISCH_THEN CHOOSE_TAC);;
+
+let X_CHO i t = (UND i) THEN (DISCH_THEN (X_CHOOSE_TAC t));;
+
+let AND i = (UND i) THEN
+  (DISCH_THEN (fun t-> (ASSUME_TAC (CONJUNCT1 t)
+                          THEN (ASSUME_TAC (CONJUNCT2 t)))));;
+
+let JOIN i j =
+   (H_VAL2 CONJ ((%)i) ((%)j)) THEN (KILL i) THEN (KILL j);;
+
+let COPY i = WITH i I;;
+
+let REP n tac = EVERY (replicate tac n);;
+
+let REWR i = (UND i) THEN (ASM_REWRITE_TAC[]) THEN DISCH_TAC;;
+
+let LEFT i t = (USE i (CONV_RULE (quant_left_CONV t)));;
+
+let RIGHT i t =  (USE i (CONV_RULE (quant_right_CONV t)));;
+
+let LEFT_TAC  t = ((CONV_TAC (quant_left_CONV t)));;
+
+let RIGHT_TAC t =  ( (CONV_TAC (quant_right_CONV t)));;
+
+let INR = REWRITE_RULE[IN];;
+
+(*
+
+
+
+let rec REP n tac = if (n<=0) then ALL_TAC
+  else (tac THEN (REP (n-1) tac));;  (* doesn't seem to work? *)
+
+
+let COPY i = (UNDISCH_WITH i) THEN (DISCH_THEN (fun t->ALL_TAC));;
+
+
+MANIPULATING ASSUMPTIONS. (MAKE 0= GOAL)
+
+COPY: int -> tactic   Make a copy in adjacent slot.
+
+
+EXPAND: int -> tactic.
+    conjunction -> two separate.
+    exists/goal-forall -> choose.
+    goal-if-then -> discharge
+EXPAND_TERM: int -> term -> tactic.
+    constant -> expand definition or other rewrites associated.
+ADD: term -> tactic.
+
+SIMPLIFY: int -> tactic.  Apply simplification rules.
+
+
+*)
+
+let CONTRAPOSITIVE_TAC = MATCH_MP_TAC (TAUT `(~q ==> ~p) ==> (p ==> q)`)
+                           THEN REWRITE_TAC[];;
+
+let REWRT_TAC = (fun t-> REWRITE_TAC[t]);;
+
+let (REDUCE_CONV,REDUCE_TAC) =
+ let list = [
+   (* reals *)   REAL_NEG_GE0;
+   REAL_HALF_DOUBLE;
+   REAL_SUB_REFL ;
+   REAL_NEG_NEG;
+   REAL_LE; LE_0;
+   REAL_ADD_LINV;REAL_ADD_RINV;
+   REAL_NEG_0;
+   REAL_NEG_LE0;
+   REAL_NEG_GE0;
+   REAL_LE_NEGL;
+   REAL_LE_NEGR;
+   REAL_LE_NEG;
+   REAL_NEG_EQ_0;
+   REAL_SUB_RNEG;
+   REAL_ARITH `!(x:real). (--x = x) <=>  (x = &.0)`;
+   REAL_ARITH `!(a:real) b. (a - b + b) = a`;
+   REAL_ADD_LID;
+   REAL_ADD_RID ;
+   REAL_INV_0;
+   REAL_OF_NUM_EQ;
+   REAL_OF_NUM_LE;
+   REAL_OF_NUM_LT;
+   REAL_OF_NUM_ADD;
+   REAL_OF_NUM_MUL;
+   REAL_POS;
+   REAL_MUL_RZERO;
+   REAL_MUL_LZERO;
+   REAL_LE_01;
+   REAL_SUB_RZERO;
+   REAL_LE_SQUARE;
+   REAL_MUL_RID;
+   REAL_MUL_LID;
+   REAL_ABS_ZERO;
+   REAL_ABS_NUM;
+   REAL_ABS_1;
+   REAL_ABS_NEG;
+   REAL_ABS_POS;
+   ABS_ZERO;
+   ABS_ABS;
+   REAL_NEG_LT0;
+   REAL_NEG_GT0;
+   REAL_LT_NEG;
+   REAL_NEG_MUL2;
+   REAL_OF_NUM_POW;
+   REAL_LT_INV_EQ;
+   REAL_POW_1;
+   REAL_INV2;
+   prove (`(--. (&.n) < (&.m)) <=> (&.0 < (&.n) + (&.m))`,REAL_ARITH_TAC);
+   prove (`(--. (&.n) <= (&.m)) <=> (&.0 <= (&.n) + (&.m))`,REAL_ARITH_TAC);
+   prove (`(--. (&.n) = (&.m)) <=> ((&.n) + (&.m) = (&.0))`,REAL_ARITH_TAC);
+   prove (`((&.n) < --.(&.m)) <=> ((&.n) + (&.m) <. (&.0))`,REAL_ARITH_TAC);
+   prove (`((&.n) <= --.(&.m)) <=> ((&.n) + (&.m) <=. (&.0))`,REAL_ARITH_TAC);
+   prove (`((&.n) = --.(&.m)) <=> ((&.n) + (&.m) = (&.0))`,REAL_ARITH_TAC);
+   prove (`((&.n) < --.(&.m) + &.r) <=> ((&.n) + (&.m) < (&.r))`,REAL_ARITH_TAC);
+   prove (`(--. x = --. y) <=> (x = y)`,REAL_ARITH_TAC);
+   prove (`(--(&.n) < --.(&.m) + &.r) <=> ( (&.m) < &.n + (&.r))`,REAL_ARITH_TAC);
+   prove (`(--. x = --. y) <=> (x = y)`,REAL_ARITH_TAC);
+   prove (`((--. (&.1))*  x < --. y <=> y < x)`,REAL_ARITH_TAC );
+   prove (`((--. (&.1))*  x <= --. y <=> y <= x)`,REAL_ARITH_TAC );
+   (* num *)
+   EXP_1;
+   EXP_LT_0;
+   ADD_0;
+   ARITH_RULE `0+| m  = m`;
+   ADD_EQ_0;
+   prove (`(0 = m +|n) <=> (m = 0)/\ (n=0)`,MESON_TAC[ADD_EQ_0]);
+   EQ_ADD_LCANCEL_0;
+   EQ_ADD_RCANCEL_0;
+   LT_ADD;
+   LT_ADDR;
+   ARITH_RULE `(0 = j -| i) <=> (j <=| i)`;
+   ARITH_RULE `(j -| i = 0) <=> (j <=| i)`;
+   ARITH_RULE `0 -| i = 0`;
+   ARITH_RULE `(i<=| j) /\ (j <=| i) <=> (i = j)`;
+   ARITH_RULE `0 <| 1`;
+   (* SUC *)
+   NOT_SUC;
+   SUC_INJ;
+   PRE;
+   ADD_CLAUSES;
+   MULT;
+   MULT_CLAUSES;
+   LE; LT;
+   ARITH_RULE `SUC b -| 1 = b`;
+   ARITH_RULE `SUC b -| b = 1`;
+   prove(`&.(SUC x) - &.x = &.1`,
+      REWRITE_TAC [REAL_ARITH `(a -. b=c) <=> (a  = b+.c)`;
+      REAL_OF_NUM_ADD;REAL_OF_NUM_EQ] THEN ARITH_TAC);
+   (* (o) *)
+   o_DEF;
+   (* I *)
+   I_THM;
+   I_O_ID;
+   (* pow *)
+   REAL_POW_1;
+   REAL_POW_ONE;
+   (* INT *)
+   INT_ADD_LINV;
+   INT_ADD_RINV;
+   INT_ADD_SUB2;
+   INT_EQ_NEG2;
+   INT_LE_NEG;
+   INT_LE_NEGL;
+   INT_LE_NEGR;
+   INT_LT_NEG;
+   INT_LT_NEG2;
+   INT_NEGNEG;
+   INT_NEG_0;
+   INT_NEG_EQ_0;
+   INT_NEG_GE0;
+   INT_NEG_GT0;
+   INT_NEG_LE0;
+   INT_NEG_LT0;
+   GSYM INT_NEG_MINUS1;
+   INT_NEG_MUL2;
+   INT_NEG_NEG;
+   (* sets *)
+   ] in
+(REWRITE_CONV list,REWRITE_TAC list);;
+
+
+
+
+
+(* prove by squaring *)
+let REAL_POW_2_LE = prove_by_refinement(
+  `!x y. (&.0 <= x) /\ (&.0 <= y) /\ (x pow 2 <=. y pow 2) ==> (x <=. y)`,
+  (* {{{ proof *)
+  [
+  DISCH_ALL_TAC;
+  MP_TAC (SPECL[` (x:real) pow 2`;`(y:real)pow 2`] SQRT_MONO_LE);
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[REAL_POW_LE];
+  ASM_SIMP_TAC[POW_2_SQRT];
+  ]);;
+  (* }}} *)
+
+(* prove by squaring *)
+let REAL_POW_2_LT = prove_by_refinement(
+  `!x y. (&.0 <= x) /\ (&.0 <= y) /\ (x pow 2 <. y pow 2) ==> (x <. y)`,
+  (* {{{ proof *)
+
+  [
+  DISCH_ALL_TAC;
+  MP_TAC (SPECL[` (x:real) pow 2`;`(y:real)pow 2`] SQRT_MONO_LT);
+  ASM_REWRITE_TAC[];
+  ASM_SIMP_TAC[REAL_POW_LE];
+  ASM_SIMP_TAC[POW_2_SQRT];
+  ]);;
+
+  (* }}} *)
+
+let SQUARE_TAC =
+    FIRST[
+      MATCH_MP_TAC REAL_LE_LSQRT;
+      MATCH_MP_TAC REAL_POW_2_LT;
+      MATCH_MP_TAC REAL_POW_2_LE
+    ]
+    THEN REWRITE_TAC[];;
+
+(****)
+
+let SPEC2_TAC t = SPEC_TAC (t,t);;
+
+let IN_ELIM i = (USE i (REWRITE_RULE[IN]));;
+
+let rec range i n =
+  if (n>0) then (i::(range (i+1) (n-1))) else [];;
+
+
+(* in elimination *)
+
+let (IN_OUT_TAC: tactic) =
+   fun (asl,g) -> (REWRITE_TAC [IN] THEN
+   (EVERY (map (IN_ELIM) (range 0 (length asl))))) (asl,g);;
+
+let (IWRITE_TAC : thm list -> tactic) =
+   fun thlist -> REWRITE_TAC (map INR thlist);;
+
+let (IWRITE_RULE : thm list -> thm -> thm) =
+   fun thlist -> REWRITE_RULE (map INR thlist);;
+
+let IMATCH_MP imp ant = MATCH_MP (INR imp) (INR ant);;
+
+let IMATCH_MP_TAC imp  = MATCH_MP_TAC  (INR imp);;
+
+
+let GBETA_TAC =   (CONV_TAC (TOP_DEPTH_CONV GEN_BETA_CONV));;
+let GBETA_RULE =   (CONV_RULE (TOP_DEPTH_CONV GEN_BETA_CONV));;
+
+(* breaks antecedent into multiple cases *)
+let REP_CASES_TAC =
+  REPEAT (DISCH_THEN (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC));;
+
+let TSPEC t i  = TYPE_THEN t (USE i o SPEC);;
+
+let IMP_REAL t i = (USE i (MATCH_MP (REAL_ARITH t)));;
+
+(* goes from f = g to fz = gz *)
+let TAPP z i  = TYPE_THEN z (fun u -> (USE i(fun t -> AP_THM t u)));;
+
+(* ONE NEW TACTIC -- DOESN'T WORK!! DON'T USE....
+let CONCL_TAC t = let co = snd  (dest_imp (concl t)) in
+  SUBGOAL_TAC co THEN (TRY (IMATCH_MP_TAC  t));;
+*)
+
+(* subgoal the antecedent of a THM, in order to USE the conclusion *)
+let ANT_TAC t = let (ant,co) =   (dest_imp (concl t)) in
+  SUBGOAL_TAC ant
+  THENL [ALL_TAC;DISCH_THEN (fun u-> MP_TAC (MATCH_MP t u))];;
+
+
+let TH_INTRO_TAC tl th = TYPEL_THEN tl (fun t-> ANT_TAC (ISPECL t th));;
+
+let THM_INTRO_TAC tl th = TYPEL_THEN tl
+  (fun t->
+    let s = ISPECL t th in
+    if is_imp (concl s) then ANT_TAC s else ASSUME_TAC s);;
+
+let (DISCH_THEN_FULL_REWRITE:tactic) =
+      DISCH_THEN (fun t-> REWRITE_TAC[t] THEN
+                    (RULE_ASSUM_TAC  (REWRITE_RULE[t])));;
+
+let FULL_REWRITE_TAC t = (REWRITE_TAC t THEN (RULE_ASSUM_TAC (REWRITE_RULE t)));;
+
+(* ------------------------------------------------------------------ *)
+
+let BASIC_TAC  =
+  [ GEN_TAC;
+    IMATCH_MP_TAC  (TAUT ` (a ==> b ==> C) ==> ( a /\ b ==> C)`);
+    DISCH_THEN (CHOOSE_THEN MP_TAC);
+    FIRST_ASSUM (fun t-> UNDISCH_TAC (concl t) THEN
+              (DISCH_THEN CHOOSE_TAC));
+    FIRST_ASSUM (fun t ->
+        (if (length (CONJUNCTS t) < 2) then failwith "BASIC_TAC"
+         else UNDISCH_TAC (concl t)));
+    DISCH_TAC;
+  ];;
+
+let REP_BASIC_TAC = REPEAT (CHANGED_TAC (FIRST BASIC_TAC));;
+
+(* ------------------------------------------------------------------ *)
+
+let USE_FIRST rule =
+  FIRST_ASSUM (fun t -> (UNDISCH_TAC (concl t) THEN
+   (DISCH_THEN (ASSUME_TAC o rule))));;
+
+let WITH_FIRST rule =
+  FIRST_ASSUM (fun t -> ASSUME_TAC (rule t));;
+
+let UNDF t = (TYPE_THEN t UNDISCH_FIND_TAC );;
+
+let GRABF t ttac = (UNDF t THEN (DISCH_THEN ttac));;
+
+let USEF t rule =
+    (TYPE_THEN t (fun t' -> UNDISCH_FIND_THEN t'
+                        (fun u -> ASSUME_TAC (rule u))));;
+
+
+(* ------------------------------------------------------------------ *)
+(* UNIFY_EXISTS_TAC *)
+(* ------------------------------------------------------------------ *)
+
+let rec EXISTSL_TAC tml = match tml with
+  a::tml' -> EXISTS_TAC a THEN EXISTSL_TAC tml' |
+  [] -> ALL_TAC;;
+
+(*
+  Goal:  ?x1....xn. P1 /\ ... /\ Pm
+  Try to pick ALL of x1...xn to unify ONE or more Pi with terms
+  appearing in the assumption list, trying term_unify on
+  each Pi with each assumption.
+*)
+let (UNIFY_EXISTS_TAC:tactic) =
+  let run_one wc assum (varl,sofar)  =
+    if varl = [] then (varl,sofar) else
+      try (
+        let wc' = instantiate ([],sofar,[]) wc in
+        let (_,ins,_) = term_unify varl wc' assum in
+        let insv = map snd ins in
+          ( subtract varl insv  , union sofar ins    )
+      ) with failure -> (varl,sofar) in
+  let run_onel asl wc (varl,sofar)   =
+    itlist (run_one wc) asl (varl,sofar) in
+  let run_all varl sofar wcl asl =
+    itlist (run_onel asl) wcl (varl,sofar) in
+  let full_unify (asl,w) =
+    let (varl,ws) = strip_exists w in
+    let vargl = map genvar (map type_of varl) in
+    let wg = instantiate ([],zip vargl varl,[]) ws in
+    let wcg = conjuncts wg in
+    let (vargl',sofar) = run_all vargl [] wcg ( asl) in
+      if (vargl' = []) then
+        map (C rev_assoc sofar) (map (C rev_assoc (zip vargl varl)) varl)
+      else failwith "full_unify: unification not found " in
+  fun (asl,w) ->
+    try(
+      let asl' = map (concl o snd) asl in
+      let asl'' = flat (map (conjuncts ) asl') in
+      let varsub = full_unify (asl'',w) in
+        EXISTSL_TAC varsub (asl,w)
+    ) with failure -> failwith "UNIFY_EXIST_TAC: unification not found.";;
+
+(* partial example *)
+let unify_exists_tac_example = try(prove_by_refinement(
+  `!C a b v A R TX U SS. (A v /\ (a = v) /\  (C:num->num->bool) a b /\ R a ==>
+    ?v v'. TX v' /\ U v v' /\  C v' v /\ SS v)`,
+  (* {{{ proof *)
+
+  [
+  REP_BASIC_TAC;
+  UNIFY_EXISTS_TAC; (* v' -> a  and v -> b *)
+  (* not finished. Here is a variant approach. *)
+  REP_GEN_TAC;
+  DISCH_TAC;
+  UNIFY_EXISTS_TAC;
+  ])) with failure -> (REFL `T`);;
+
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+(* UNIFY_EXISTS conversion *)
+(* ------------------------------------------------------------------ *)
+
+(*
+   FIRST argument is the "certificate"
+   second arg is the goal.
+   Example:
+   UNIFY_EXISTS `(f:num->bool) x` `?t. (f:num->bool) t`
+*)
+
+let (UNIFY_EXISTS:thm -> term -> thm) =
+  let run_one wc assum (varl,sofar)  =
+    if varl = [] then (varl,sofar) else
+      try (
+        let wc' = instantiate ([],sofar,[]) wc in
+        let (_,ins,_) = term_unify varl wc' assum in
+        let insv = map snd ins in
+          ( subtract varl insv  , union sofar ins    )
+      ) with failure -> (varl,sofar) in
+  let run_onel asl wc (varl,sofar)   =
+    itlist (run_one wc) asl (varl,sofar) in
+  let run_all varl sofar wcl asl =
+    itlist (run_onel asl) wcl (varl,sofar) in
+  let full_unify (t,w) =
+    let (varl,ws) = strip_exists w in
+    let vargl = map genvar (map type_of varl) in
+    let wg = instantiate ([],zip vargl varl,[]) ws in
+    let wcg = conjuncts wg in
+    let (vargl',sofar) = run_all vargl [] wcg ( [concl t]) in
+      if (vargl' = []) then
+        map (C rev_assoc sofar) (map (C rev_assoc (zip vargl varl)) varl)
+      else failwith "full_unify: unification not found " in
+  fun t w ->
+    try(
+      if not(is_exists w) then failwith "UNIFY_EXISTS: not EXISTS" else
+      let varl' =  (full_unify (t,w)) in
+      let (varl,ws) = strip_exists w in
+      let varsub = zip varl' varl in
+      let varlb = map (fun s->  chop_list s (rev varl))
+            (range 1 (length varl)) in
+      let targets = map (fun s-> (instantiate ([],varsub,[])
+          (list_mk_exists( rev (fst s),  ws)) )) varlb in
+      let target_zip  = zip (rev targets) varl' in
+      itlist (fun s th  -> EXISTS s  th) target_zip t
+    ) with failure -> failwith "UNIFY_EXISTS: unification not found.";;
+
+let unify_exists_example=
+   UNIFY_EXISTS (ARITH_RULE `2 = 0+2`) `(?x y. ((x:num) = y))`;;
+
+(* now make a prover for it *)
+
+
+(* ------------------------------------------------------------------ *)
+
+(*
+drop_ant_tac replaces
+  0  A ==>B
+  1  A
+with
+  0  B
+  1  A
+in hypothesis list
+*)
+let DROP_ANT_TAC pq  =
+  UNDISCH_TAC pq THEN (UNDISCH_TAC (fst (dest_imp pq))) THEN
+  DISCH_THEN (fun pthm -> ASSUME_TAC pthm THEN
+      DISCH_THEN (fun pqthm -> ASSUME_TAC (MATCH_MP pqthm pthm )));;
+
+let (DROP_ALL_ANT_TAC:tactic) =
+  fun (asl,w) ->
+    let imps = filter (is_imp) (map (concl o snd) asl) in
+    MAP_EVERY (TRY o DROP_ANT_TAC) imps (asl,w);;
+
+let drop_ant_tac_example = prove_by_refinement(
+  `!A B C D E. (A /\ (A ==> B) /\ (C ==>D) /\ C) ==> (E \/ C \/ B)`,
+  (* {{{ proof *)
+  [
+  REP_BASIC_TAC;
+  DROP_ALL_ANT_TAC;
+  ASM_REWRITE_TAC[];
+  ]);;
+  (* }}} *)
+
+(* ------------------------------------------------------------------ *)
+
+(* ASSUME tm, then prove it later. almost the same as asm-cases-tac *)
+let (BACK_TAC : term -> tactic) =
+  fun tm (asl,w) ->
+    let ng = mk_imp (tm,w) in
+    (SUBGOAL_TAC ng THENL [ALL_TAC;DISCH_THEN  IMATCH_MP_TAC ]) (asl,w);;
+
+(* --- *)
+(* Using hash numbers for tactics *)
+(* --- *)
+
+let label_of_hash ((asl,g):goal) (h:int) =
+  let one_label h (s,tm) =
+    if  (h = hash_of_term (concl tm)) then
+      let s1 = String.sub s 2 (String.length s - 2) in
+      int_of_string s1
+      else failwith "label_of_hash" in
+  tryfind (one_label h) asl;;
+
+let HASHIFY m h w = m (label_of_hash w h) w;;
+let UNDH = HASHIFY UND;;
+let REWRH = HASHIFY REWR;;
+let KILLH = HASHIFY KILL;;
+let COPYH = HASHIFY COPY;;
+let HASHIFY1 m h tm w = m (label_of_hash w h) tm w;;
+let USEH = HASHIFY1 USE;;
+let LEFTH = HASHIFY1 LEFT;;
+let RIGHTH = HASHIFY1 RIGHT;;
+let TSPECH tm h w = TSPEC tm (label_of_hash w h) w ;;

diff --git a/Jordan/tactics_fix.ml b/Jordan/tactics_fix.ml
new file mode 100644 (file)
index 0000000..b1fa085
--- /dev/null
+++ b/Jordan/tactics_fix.ml
@@ -0,0 +1,133 @@
+(* ------------------------------------------------------------------------- *)
+(* A printer for goals etc.                                                  *)
+(* ------------------------------------------------------------------------- *)
+
+(* had (rev asl) in this method.  I don't want to reverse the list *)
+
+
+let hash_of_string =
+  let prime200 = 1223 in
+  let prime = 8831 in
+  let rec hashll v = match v with
+    | [] -> 0
+    | h::t ->
+   (int_of_char (String.get h 0) + prime200*( hashll t)) mod prime in
+  fun s ->
+    let slt = explode s in
+    hashll slt;;
+
+let saved_hashstring =
+    ref ((Hashtbl.create 300):(string,int) Hashtbl.t);;
+let save_hashstring string =
+    Hashtbl.add !saved_hashstring (string) (hash_of_string string);;
+let mem_hashstring s = Hashtbl.mem !saved_hashstring s;;
+let remove_hashstring s = Hashtbl.remove !saved_hashstring s;;
+let find_hashstring s = Hashtbl.find !saved_hashstring s;;
+
+let memhash_of_string s =
+   if not(mem_hashstring s) then (save_hashstring s) ;
+   find_hashstring s;;
+
+let hash_of_type =
+  let prime150 = 863 in
+  let prime160 = 941 in
+  let prime180 = 1069 in
+  let prime190 = 1151 in
+  let prime1200 = 9733 in
+  let rec hashl u = match u with
+    | [] -> 0
+    | h::t -> ((hasht h) + prime190*(hashl t)) mod prime1200
+    and
+    hasht v = match v with
+    | Tyvar s -> (prime150*memhash_of_string s + prime160) mod prime1200
+    | Tyapp (s,tlt) -> let h = memhash_of_string s in
+               let h2 = (h*h) mod prime1200 in
+          (prime180*h2 + hashl tlt ) mod prime1200 in
+  hasht;;
+
+(* make hash_of_term constant on alpha-equivalence classes of
+   terms *)
+
+let rename_var n =
+  fun v -> mk_var ("??_"^(string_of_int n),type_of v);;
+
+let paform =
+  let rec raform n env tm =
+    match tm with
+      | Var(_,_) -> assocd tm env tm
+      | Const(_,_) -> tm
+      | Comb (s,t) -> mk_comb(raform n env s, raform n env t)
+      | Abs  (x,t) -> let x1 = rename_var n x in
+                      mk_abs(x1, raform (n+1) ((x,x1)::env) t) in
+  raform 0 [];;
+
+let hash_of_term =
+  let prime1220 = 9887 in
+  let prime210 = 1291 in
+  let prime220 = 1373 in
+  let prime230 = 1451 in
+  let prime240 = 1511 in
+  let prime250 = 1583 in
+  let prime260 = 1657 in
+  let prime270 = 1733 in
+  let prime280 = 1811 in
+  let rec hasht u = match u with
+    | Var (s,t) ->
+      (prime210*(memhash_of_string s) + hash_of_type t) mod prime1220
+    | Const (s,t) ->
+      (prime220*(memhash_of_string s) + hash_of_type t) mod prime1220
+    | Comb (s,t) -> let h = hasht s in
+            let h2 = (h*h) mod prime1220 in
+             (prime230*h2 + prime240*hasht t + prime250) mod prime1220
+    | Abs   (s,t) -> let h = hasht s in
+           let h2 = (h*h) mod prime1220 in
+             (prime260*h2 + prime270*hasht t + prime280) mod prime1220
+  in hasht o paform;;
+
+let print_hyp n (s,th) =
+  open_hbox();
+  print_string " ";
+  print_as 4 (string_of_int (hash_of_term (concl th)));
+  print_string " [";
+  print_qterm (concl th);
+  print_string "]";
+  (if not (s = "") then (print_string (" ("^s^")")) else ());
+  close_box();
+  print_newline();;
+
+let rec print_hyps n asl =
+  if asl = [] then () else
+  (print_hyp n (hd asl);
+   print_hyps (n + 1) (tl asl));;
+
+let (print_goal_hashed:goal->unit) =
+  fun (asl,w) ->
+    print_newline();
+    if asl <> [] then (print_hyps 0 (asl); print_newline()) else ();
+    print_qterm w; print_newline();;
+
+let (print_goalstate_hashed:int->goalstate->unit) =
+  fun k gs -> let (_,gl,_) = gs in
+              let n = length gl in
+              let s = if n = 0 then "No subgoals" else
+                        (string_of_int k)^" subgoal"^(if k > 1 then "s" else "")
+                     ^" ("^(string_of_int n)^" total)" in
+              print_string s; print_newline();
+              if gl = [] then () else
+              do_list (print_goal_hashed o C el gl) (rev(0--(k-1)));;
+
+let (print_goalstack_hashed:goalstack->unit) =
+  fun l ->
+    if l = [] then print_string "Empty goalstack"
+    else if tl l = [] then
+      let (_,gl,_ as gs) = hd l in
+      print_goalstate_hashed 1 gs
+    else
+      let (_,gl,_ as gs) = hd l
+      and (_,gl0,_) = hd(tl l) in
+      let p = length gl - length gl0 in
+      let p' = if p < 1 then 1 else p + 1 in
+      print_goalstate_hashed p' gs;;
+
+#install_printer print_goal_hashed;;
+#install_printer print_goalstack_hashed;;

diff --git a/Jordan/tactics_refine.ml b/Jordan/tactics_refine.ml
new file mode 100644 (file)
index 0000000..788a20b
--- /dev/null
+++ b/Jordan/tactics_refine.ml
@@ -0,0 +1,106 @@
+
+(* ------------------------------------------------------------------ *)
+(* This bundles an interactive session into a proof. *)
+(* ------------------------------------------------------------------ *)
+
+let labels_flag = ref false;;
+
+
+let LABEL_ALL_TAC:tactic = 
+ let mk_label avoid =
+  let rec mk_one_label i avoid  = 
+    let label = "Z-"^(string_of_int i) in
+      if not(mem label avoid) then label else mk_one_label (i+1) avoid in
+    mk_one_label 0 avoid in
+ let update_label i asl = 
+  let rec f_at_i f j =
+    function [] -> []
+      | a::b -> if (j=0) then (f a)::b else a::(f_at_i f (j-1) b) in
+  let avoid = map fst asl in
+  let current = el i avoid in
+  let new_label = mk_label avoid in
+  if (String.length current > 0) then asl else 
+    f_at_i (fun (_,y) -> (new_label,y) ) i asl in
+  fun (asl,w) ->  
+    let aslp = ref asl in
+    (for i=0 to ((length asl)-1) do (aslp := update_label i !aslp) done;
+    (ALL_TAC (!aslp,w)));;
+
+(* global_var *)
+let (EVERY_STEP_TAC:tactic ref) = ref ALL_TAC;;
+
+let (e:tactic ->goalstack) =  
+   fun tac -> refine(by(VALID 
+   (if !labels_flag then (tac THEN (!EVERY_STEP_TAC)) THEN LABEL_ALL_TAC
+   else tac)));;
+
+let has_stv t = 
+  let typ = (type_vars_in_term t) in
+  can (find (fun ty -> (is_vartype ty) && ((dest_vartype ty).[0] = '?'))) typ;;
+
+let prove_by_refinement(t,(tacl:tactic list)) = 
+  if (length (frees t) > 0) 
+    then failwith "prove_by_refinement: free vars" else
+  if (has_stv t) 
+    then failwith "prove_by_refinement: has stv" else
+  let gstate = mk_goalstate ([],t) in
+  let _,sgs,just = rev_itlist 
+    (fun tac gs -> by 
+       (if !labels_flag then (tac THEN 
+         (!EVERY_STEP_TAC) THEN LABEL_ALL_TAC ) else tac) gs)
+     tacl gstate in
+  let th = if sgs = [] then just null_inst []
+  else failwith "BY_REFINEMENT_PROOF: Unsolved goals" in
+  let t' = concl th in
+  if t' = t then th else
+  try EQ_MP (ALPHA t' t) th
+  with Failure _ -> failwith "prove_by_refinement: generated wrong theorem";;
+
+
+(* ------------------------------------------------------------------ *)
+(* DUMPING AND PRELOADED THEOREMS *)
+(* ------------------------------------------------------------------ *)
+
+
+let saved_thm = ref ((Hashtbl.create 300):(term,thm) Hashtbl.t);;
+let save_thm thm = Hashtbl.add !saved_thm (concl thm) thm;;
+let mem_thm tm = Hashtbl.mem !saved_thm tm;;
+let remove_thm tm = Hashtbl.remove !saved_thm tm;;
+let find_thm tm = Hashtbl.find !saved_thm tm;;
+
+let dump_thm file_name = 
+    let ch = open_out_bin file_name in
+    (output_value ch !saved_thm;
+    close_out ch);;
+
+let load_thm file_name =
+  let ch = open_in_bin file_name in 
+  (saved_thm := input_value ch;
+   close_in ch);;
+
+(* ------------------------------------------------------------------ *)
+(* PROOFS STORED.  *)
+(* ------------------------------------------------------------------ *)
+
+let old_prove = prove;;
+let old_prove_by_refinement = prove_by_refinement;;
+let fast_load  = ref true;;
+
+let set_fast_load file_name =
+  (fast_load := true;
+  load_thm file_name);;
+
+let set_slow_load () = 
+  (fast_load := false;);;
+
+let prove (x, tac) = 
+  if (!fast_load) then (try(find_thm x) with failure -> old_prove(x,tac))
+  else (let t = old_prove(x,tac) in (save_thm t; t));;
+
+let prove_by_refinement (x, tacl) = 
+  if (!fast_load) then (try(find_thm x) 
+                       with failure -> old_prove_by_refinement(x,tacl))
+  else (let t = old_prove_by_refinement(x,tacl) in (save_thm t; t));;
+
+if (false) then (set_fast_load "thm.dump") else (fast_load:=false);; 
+

diff --git a/make.ml b/make.ml
new file mode 100644 (file)
index 0000000..fcd6ef8
--- /dev/null
+++ b/make.ml
@@ -0,0 +1,31 @@
+(* ========================================================================= *)
+(*                          The Jordan Curve Theorem                         *)
+(*                                                                           *)
+(*                             Proof by Tom Hales                            *)
+(*                                                                           *)
+(*           A few tweaks by John Harrison for the latest HOL Light          *)
+(* ========================================================================= *)
+
+(*** Standard HOL Light library ***)
+
+loads "Library/analysis.ml";;
+loads "Library/transc.ml";;
+loads "Examples/polylog.ml";;
+
+(*** New stuff ***)
+
+loadt "Jordan/tactics_refine.ml";;
+loadt "Jordan/lib_ext.ml";;
+loadt "Jordan/tactics_fix.ml";;
+loadt "Jordan/parse_ext_override_interface.ml";;
+loadt "Jordan/tactics_ext.ml";;
+loadt "Jordan/num_ext_gcd.ml";;
+loadt "Jordan/num_ext_nabs.ml";;
+loadt "Jordan/real_ext_geom_series.ml";;
+loadt "Rqe/num_calc_simp.ml";;
+loadt "Jordan/real_ext.ml";;
+loadt "Jordan/float.ml";;
+loadt "Jordan/tactics_ext2.ml";;
+loadt "Jordan/misc_defs_and_lemmas.ml";;
+loadt "Jordan/metric_spaces.ml";;
+loadt "Jordan/jordan_curve_theorem.ml";;