let fix ts = MAP_EVERY X_GEN_TAC ts;;

let assume lab t =
  DISCH_THEN(fun th -> if concl th = t then LABEL_TAC lab th
                       else failwith "assume");;

let we're finished tac = tac;;

let suffices_to_prove q tac = SUBGOAL_THEN q (fun th -> MP_TAC th THEN tac);;

let note(lab,t) tac =
  SUBGOAL_THEN t MP_TAC THENL [tac; ALL_TAC] THEN
  DISCH_THEN(fun th -> LABEL_TAC lab th);;

let have t = note("",t);;

let cases (lab,t) tac =
  SUBGOAL_THEN t MP_TAC THENL [tac; ALL_TAC] THEN
  DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (LABEL_TAC lab));;

let consider (x,lab,t) tac =
  let tm = mk_exists(x,t) in
  SUBGOAL_THEN tm (X_CHOOSE_THEN x (LABEL_TAC lab)) THENL [tac; ALL_TAC];;

let trivial = MESON_TAC[];;
let algebra = CONV_TAC NUM_RING;;
let arithmetic = ARITH_TAC;;

let by labs tac = MAP_EVERY (fun l -> USE_THEN l MP_TAC) labs THEN tac;;

let using ths tac = MAP_EVERY MP_TAC ths THEN tac;;

let so constr arg tac = constr arg (FIRST_ASSUM MP_TAC THEN tac);;

let NSQRT_2 = 
prove
 (`!p q. p * p = 2 * q * q ==> q = 0`,

  suffices_to_prove
   `!p. (!m. m < p ==> (!q. m * m = 2 * q * q ==> q = 0))
        ==> (!q. p * p = 2 * q * q ==> q = 0)`
   (MATCH_ACCEPT_TAC num_WF) THEN
  fix [`p:num`] THEN
  assume("A") `!m. m < p ==> !q. m * m = 2 * q * q ==> q = 0` THEN
  fix [`q:num`] THEN
  assume("B") `p * p = 2 * q * q` THEN
  so have `EVEN(p * p) <=> EVEN(2 * q * q)` (trivial) THEN
  so have `EVEN(p)` (using [ARITH; EVEN_MULT] trivial) THEN
  so consider (`m:num`,"C",`p = 2 * m`) (using [EVEN_EXISTS] trivial) THEN
  cases ("D",`q < p \/ p <= q`) (arithmetic) THENL
   [so have `q * q = 2 * m * m ==> m = 0` (by ["A"] trivial) THEN
    so we're finished (by ["B";
 "C"] algebra);

    so have `p * p <= q * q` (using [LE_MULT2] trivial) THEN
    so have `q * q = 0` (by ["B"] arithmetic) THEN
    so we're finished (algebra)]);;