peano.mm1

delimiter $ ( [ { ~ $
          $ } ] ) , $;
--| Well formed formulas, or propositions - true or false.
strict provable sort wff;
--| Implication: if p, then q.
term im (p q: wff): wff; infixr im: $->$ prec 25;
--| Negation: p is false.
term not (p: wff): wff; prefix not: $~$ prec 41;

--| Axiom 1 of Lukasiewicz' axioms for classical propositional logic.
axiom ax_1 (a b: wff): $ a -> b -> a $;
--| Axiom 2 of Lukasiewicz' axioms for classical propositional logic.
axiom ax_2 (a b c: wff): $ (a -> b -> c) -> (a -> b) -> a -> c $;
--| Axiom 3 of Lukasiewicz' axioms for classical propositional logic.
axiom ax_3 (a b: wff): $ (~a -> ~b) -> b -> a $;
--| Modus ponens: from `a -> b` and `a`, infer `b`.
axiom ax_mp (a b: wff): $ a -> b $ > $ a $ > $ b $;

-- global definitions
do {
  (def (id x) x)
  (def (ignore . _))
  (def dbg @ match-fn* [(x) (print x) x]
    [(x y) (display @ string-append (->string x) ": " (->string y)) y])
  (def (foldl l z s) (if (null? l) z (foldl (tl l) (s z (hd l)) s)))
  (def (foldr l z s) (if (null? l) z (s (hd l) (foldr (tl l) z s))))
  (def (range a b) (if {a = b} () (cons a (range {a + 1} b))))
  (def (for a b f) (if {a = b} #undef (begin (f a) (for {a + 1} b f))))
  (def last (match-fn [(a) a] [(_ . l) (last l)]))
  (def split-last @ match-fn
    [(and (_) l) l]
    [(a . l) @ match (split-last l) @ (r . l2) '(,r ,a . ,l2)]
    [() ()])
  (def (append . ls) @ foldr ls () @ fn (l l2) @ foldr l l2 cons)
  (def (rev l) @ foldl l () (fn (l a) (cons a l)))
  (def (len l) @ foldl l 0 (fn (n _) {n + 1}))
  (def (filter l p) @ foldl l () @ fn (l2 x) @ if (p x) (cons x l2) l2)
  (def (repeat a n) (if {n = 0} () (cons a (repeat a {n - 1}))))
  (def (iterate n f a) (if {n = 0} a (f (iterate {n - 1} f a))))
  (def (find l) @ match l
    [((k v) . l) (def f (find l)) @ fn (a) @ if {k == a} v (f a)]
    [() @ fn (a)])
  (def (verb e) (copy-span e (list ':verb e)))
  (def (exact e) (refine (verb e)))
  (def (result) (hd (get-goals)))
  (def (target) (goal-type (result)))
  (def (inspect-result f) (def g (result)) (refine (f)) (display @ pp g))
  (def (later) @ match (get-goals)
    [(g . gs) (apply set-goals @ append gs @ list g)])
  (def mvar-sort @ match-fn @ (mvar s _) s)
  (def (report a) (def g (result)) (refine a) (print g))
  (def (atom-map . xs) (get! @ apply atom-map! xs))
  (def (lookup-fn xs) (def m (apply atom-map xs)) (fn k (apply lookup m k)))
  (def (atom-app . xs) (string->atom (apply string-append (map ->string xs))))
  (def transpose @ match-fn*
    [(xs) (apply map list xs)]
    [(n xs) (if (null? xs) (repeat () n) (apply map list xs))])
  (def (join xs) (apply append xs))
  (def (rmap . args) (apply map (split-last args)))
  (def (scan . args) (apply rmap args) #undef)
  (def (undef? x) (not (def? x)))
  (def (error-at sp msg) (report-at 'error sp msg))
  (def (info-at sp msg) (report-at 'info sp msg))
  (def goal! @ match-fn*
    [(ty) (ref! (goal ty))]
    [(pos ty) (ref! (copy-span pos (goal ty)))])
  (def (swap) @ match (get-goals) [(x . y) (apply set-goals @ append y @ list x)])
  (def suffices @ match-fn*
    [(h) (have h _) (swap)]
    [xs (apply have xs) (swap)])
  (def (get-proof x) @ match (get-decl x)
    [('theorem _ _ _ _ _ pf) (hd @ tl @ pf)]
    [_ (error "not a theorem")])
  (def (pp-proof x) (display @ pp @ get-proof x))

  --| This utility will take a verbatim proof and "unelaborate" it into a refine script
  --| using ! on every step. This is useful to get `refine` to re-typecheck a term when
  --| testing tactics which produce verbatim proofs.
  (def unelab @ letrec (
    [(args bs xs)
      @ if (null? bs) (map rec xs)
      @ cons (hd xs) @ args (tl bs) (tl xs)]
    [rec @ match-fn
      [(':conv tgt _ p) '{,(rec p) : ,tgt}]
      [(f . xs)
        (cons '! f @ args (nth 2 @ get-decl f) xs)]
      [e e]])
    rec)

  --| This is a special variable used by `mm0-rs doc` to shorten axiom list printouts.
  --| It is an atom map from a name for the axiom list to a list of axioms.
  (def axiom-sets (atom-map!))
  --| Declare a new axiom set, which is used by the docgen tool to shorten axiom lists.
  (def (add-axiom-set! x doc xs) (insert! axiom-sets x (cons doc xs)))

  --| `(named pf)` wraps a proof script `pf`, runs it, then gathers all
  --| unassigned metavariables and assigns them to dummies.
  --| `(named x1 ... xn pf)` is the same but names the first `n` variables `x1,...,xn`.
  --| This is commonly used for proofs where we don't care to name the
  --| dummy variables.
  (def named
    (def (assign-mvar m x) @ match x ['_] [_ (set! m (dummy! x (mvar-sort m)))])
    @ match-fn*
      [((? atom? d) es) (refine es) (scan (get-mvars) (list d) assign-mvar)]
      [(ds es) (refine es) (scan (get-mvars) ds assign-mvar)]
      [(es) (refine es)
        (def n (ref! 1))
        (scan (get-mvars) @ fn (v)
          (assign-mvar v (atom-app "a" n)) (set! n {n + 1}))
        (if {n = 1} (display "unnecessary (named)"))])

  --| `(name-all x1 ... xn)` instantiates all metavariables in the current
  --| proof state. It is the same as `named` but it can be used in the middle of a
  --| proof instead of as a wrapper around a complete proof.
  (def (name-all . ds)
    (def (assign-mvar m x) @ match x ['_] [_ (set! m (dummy! x (mvar-sort m)))])
    (scan (get-mvars) ds assign-mvar))

  (def ((tac-thm stmt f))
    @ match (get-goals) @ (g)
    (def res (f))
    (if (def? res) (refine res))
    (match (get-goals) [()] [_ (stat) (error "not all goals are solved")])
    '(() ,g))
  (def (add-tac-thm! x bis hyps ret vis f)
    (add-thm! x bis hyps ret vis (tac-thm ret f)))

  (def eq-for @ lookup-fn '([wff iff] [nat eq] [set eqs]))
  (def eq-sort @ lookup-fn '([iff wff] [eq nat] [eqs set]))
  (def nf-for @ lookup-fn '([wff nf] [nat nfn] [set nfs]))
  (def eqid-for @ lookup-fn '([wff biid] [nat eqid] [set eqsid]))
  (def eqidd-for @ lookup-fn '([wff biidd] [nat eqidd] [set eqsidd]))
  (def eqd-map (atom-map!)) (set-merge-strategy eqd-map merge-map)
  (def (eqd-for . e) (apply lookup eqd-map e))
  (def (register-eqd df) (fn (tgt) (insert! eqd-map df tgt)))
  (def (get-tgt-args args df . s) @ match args
    [() (apply atom-app df s)]
    [((? atom? t)) (apply atom-app t s)]
    [('quote (? atom? t)) t])

  (def (maybe-atom-map hs)
    @ if (apply and @ map (fn (x) (atom? (hd x))) hs)
      (let ([m (get! @ apply atom-map! hs)])
        @ fn (x) (lookup m x))
      (find hs))
  (def (eqtac-ctx ltr hyps)
    @ foldr hyps () @ fn (h ls)
      @ match (match (infer-type h) [('im _ R) R] [R R])
        [('eq L R) '([,(if ltr L R) ,h] . ,ls)]
        [_ ls])
  (def (eqtac-core ltr ctx t)
    @ match t @ (eq L R)
    @ letrec (
      [(f A) @ match (ctx A)
        [#undef @ match A
          [((? atom? t) . es)
            @ if (null? es) #undef @ begin
            @ match (eqd-for t) [#undef] @ eqd
            @ match (get-decl eqd) @ (_ _ bis hs ('im _ (eq (t . args) _)) ...)
            (def subterms @ apply atom-map! @ map list args es)
            (def isrefl (ref! #t))
            (def subproofs @ rmap hs @ match-fn @ (h ('im _ (eq arg _)))
              @ if (atom? arg)
                (or_refl isrefl @ lookup subterms arg)
                (eqidd-for (infer-sort A)))
            @ if isrefl #undef (cons eqd subproofs)]
          [e #undef]]
        [res res]]
      [(or_refl isrefl A) @ match (f A)
        [#undef (eqidd-for (infer-sort A))]
        [e (set! isrefl #f) e]])
    (or_refl (ref!) (if ltr L R)))
  (def ((eqtac-with ltr . hyps) refine t)
    @ refine t @ match t
    [('im G (and rhs (eq L R)))
      @ letrec ([add-locals @ match-fn*
        [(('an G D) f)
          (add-locals G @ fn (a p) (f a '(anwl ,G ,D ,a ,p)))
          (add-locals D @ fn (a p) (f a '(anwr ,G ,D ,a ,p)))]
        [((and a (h . _)) f) @ if (def? (eq-sort h)) (f a '(id ,a))]
        [_]])
      (def ctx (ref! (eqtac-ctx #t hyps)))
      (add-locals G @ match-fn* @ ((eq L R) p)
        (def v (if ltr L R))
        (def v @ match v [(mvar s _) (def d (dummy! s)) (set! v d) d] [_ v])
        (set! ctx '([,v ,(verb p)] . ,(get! ctx))))
      (eqtac-core ltr (maybe-atom-map ctx) rhs)]
    [(eq L R) '(trud ,(eqtac-core ltr (maybe-atom-map @ eqtac-ctx #t hyps) t))])

  --| A refine script that will prove formulas of the form `x = a -> (p <-> ?q)`
  --| by substituting all instances of `x` with `a` in `p`. This works whether `?q`
  --| is a metavariable or the substitution.
  (def eqtac (eqtac-with #t))

  --| Like `eqtac` but works in reverse:
  --| it will prove formulas of the form `x = a -> (?p <-> q)`
  --| by substituting all instances of `a` with `x` in `q`. If `x` is a metavariable, it
  --| also assigns it to a new dummy variable.
  (def ((eqtac-gen a) refine t) @ refine t
    @ match t @ ('im (eq x _) _)
      (def y (match x [(mvar s _) (dummy! s)] [_ x]))
      '{,(eqtac-with #f) : (im (eq ,y ,a) _)})

  --| This metaprogram proves a statement of the form
  --| $ G -> a1 = a2 $ > $ G -> b1 = b2 $ > $ G -> foo a1 b1 = foo a2 b2 $
  --| for any definition foo.
  (def (add-eqd-thm df . args)
    (def tgt (get-tgt-args args df "eqd"))
    @ match (get-decl df)
      [#undef (error (string-append "declaration '" (->string df) "' not found"))]
      [(_ _ () ...)]
      [(_ _ bis (ret _) . rest)
        (def G @ if (apply or (map (match-fn [('G ...) #t] [_ #f]) bis)) '_G '_G)
        @ if (def? (get-decl tgt)) (insert! eqd-map df tgt) @ begin
        (def ctx (atom-map!))
        @ match (map join @ transpose 4 @ rmap bis @ match-fn
          [(and (x s) e) (insert! ctx x (list s)) '((,e) () (,x) (,x))]
          [(v s vs) @ let ([v1 (atom-app '_ v 1)] [v2 (atom-app '_ v 2)] [hv (atom-app '_ v 'h)])
            (insert! ctx v (list v1 v2 s hv))
            '(() ((,v ,s ,v1 ,v2 ,hv))
              (,v1) (,v2))]) @ (xs vs es1 es2)
        (def xs1 (map hd xs))
        (def bis '((,G wff ()) . ,(append xs @ join @ rmap vs
          @ match-fn [(v s v1 v2 hv) '((,v1 ,s ,xs1) (,v2 ,s ,xs1))])))
        (def hs @ rmap vs @ match-fn [(v s v1 v2 hv) '(,hv (im ,G (,(eq-for s) ,v1 ,v2)))])
        (def rete '(im ,G (,(eq-for ret) (,df . ,es1) (,df . ,es2))))
        (match rest
          [() (add-thm! tgt bis hs rete)]
          [(_ ds v) @ add-thm! tgt bis hs rete () @ fn () @ list ds
            (def ds (rmap ds @ match-fn @ (x s) (insert! ctx x (list s)) x))
            @ letrec (
              [preproof (match-fn
                [(? atom? v) (lookup ctx v)]
                [((? atom? t) . es)
                  @ match (get-decl t) @ (_ _ bis (ret _) ...)
                  @ if (null? es) (list ret) @ begin
                  (def isrefl (ref! #t))
                  @ match (transpose 5 @ rmap bis es @ match-fn*
                    [((_ _) x) '((,x) () () ,x ,x)]
                    [((_ _ _) e)
                      @ match (preproof e)
                        [(s) '(() (,e ,e) ((,(eqidd-for s) ,G ,e)) ,e ,e)]
                        [(e1 e2 s p) (set! isrefl #f)
                          '(() (,e1 ,e2) (,p) ,e1 ,e2)]]) @ (xs ts ps es1 es2)
                  @ if isrefl (list ret) @ begin
                  @ match (eqd-for t)
                    [#undef (error @ string-append "equality theorem not found for " (->string t))]
                    [eqd '((,t . ,es1) (,t . ,es2) ,ret
                      (,eqd ,G . ,(append (join xs) (join ts) (join ps))))]])]
              [(mk-proof e) (match (preproof e)
                [(s) '(,e ,e (,(eqidd-for s) ,G ,e))]
                [(e1 e2 s p) (list e1 e2 p)])])
            @ match (mk-proof v) @ (t1 t2 p)
            '(:conv ,rete (im ,G (,(eq-for ret)
              (:unfold ,df ,es1 ,ds ,t1)
              (:unfold ,df ,es2 ,ds ,t2))) ,p)])
        (insert! eqd-map df tgt)])

  (def (ded-to-thm t)
    @ match (get-decl t) @ (_ _ ((G 'wff ()) . bis) hs ('im _ ret) ...)
    @ if (apply and @ rmap bis @ match-fn [(_ _ ()) #t] [_ #f]) @ begin
    (def rete @ foldr hs ret @ match-fn* [((_ ('im _ h)) r) '(im ,h ,r)])
    @ list bis rete @ fn () @ list ()
    @ letrec (
      [(exps l r) @ match r
        [('im e1 e2) (list 'exp l e1 e2 (exps (list 'an l e1) e2))]
        [_ (cons t l @ append (map hd bis) @
          map (match-fn [(_ h) h]) @ rev @ conjuncts l)]]
      [conjuncts @ match-fn
        [('an e1 e2)
          @ match (conjuncts e1)
            [(_) '((,e2 (anr ,e1 ,e2)) (,e1 (anl ,e1 ,e2)))]
            [hs (cons '(,e2 (anr ,e1 ,e2)) @
              rmap hs @ match-fn [(e h) '(,e (anwl ,e1 ,e2 ,e ,h))])]]
        [e '((,e (id ,e)))]])
    @ match rete [('im l r) (exps l r)])

  --| Using the `*eqd` proof in `add-eqd-thm`,
  --| this metaprogram proves the corresponding `*eq` theorem of the form
  --| `a1 = a2 -> b1 = b2 -> foo a1 b1 = foo a2 b2`
  --| for any definition `foo`.
  (def (add-eq-thm t . args)
    (def tgt (get-tgt-args args t "eq"))
    @ if (undef? (get-decl tgt)) @ begin
    @ match (eqd-for t) [#undef] @ eqd
    @ match (ded-to-thm eqd) [#undef] @ (bis ret val)
    (add-thm! tgt bis () ret () val))

  (def (make-eqNd-thms df)
    @ match (get-decl df) @ (_ _ bis (ret _) . rest)
    (def G '_G) (def h0 '_h)
    @ letrec (
      [mk-bis @ match-fn
        [() '(() () () () ())]
        [((and (x _) e) . bis)
          @ match (mk-bis bis) @ (pes vs es pp data)
          '((,x . ,pes) ,vs ,es ,pp
            ,(rmap data @ match-fn [(b t1 t2 h es ps)
              '(,b (,x . ,t1) (,x . ,t2) ,h ,es ,ps)]))]
        [((v s _) . bis)
          @ match (mk-bis bis) @ (pes vs es pp data)
          @ let ([v1 (atom-app '_ v 1)] [v2 (atom-app '_ v 2)])
          '((,v . ,pes)
            ((,v ,s) . ,vs)
            (,v ,v . ,es)
            ((,(eqidd-for s) ,G ,v) . ,pp)
            ((((,v1 ,s) (,v2 ,s) . ,vs)
              (,v1 . ,pes)
              (,v2 . ,pes)
              (im ,G (,(eq-for s) ,v1 ,v2))
              (,v1 ,v2 . ,es)
              (,h0 . ,pp)) .
             ,(rmap data @ match-fn @ (b t1 t2 h es ps)
              '(((,v ,s) . ,b) (,v . ,t1) (,v . ,t2) ,h (,v ,v . ,es) ((,(eqidd-for s) ,G ,v) . ,ps)))))]])
    (def xs @ join @ rmap bis @ match-fn [(and (_ _) e) (list e)] [_ ()])
    @ rmap (match (mk-bis bis) [(_ _ _ _ data) data]) @ match-fn @ (vs t1 t2 h es ps)
      (def xs1 (map hd xs))
      (def vs+ (rmap vs @ match-fn @ (v s) '(,v ,s ,xs1)))
      @ list
        '((,G wff ()) . ,(append xs vs+))
        '((,h0 ,h))
        '(im ,G (,(eq-for ret) (,df . ,t1) (,df . ,t2)))
        (match (eqd-for df)
          [#undef (error @ string-append "equality theorem not found for " (->string df))]
          [eqd '(,eqd ,G . ,(append xs1 es ps))]))

  --| This program adds `*eqNd` and `*eqN` theorems corresponding to the definition
  --| `foo`, of the form
  --| * `fooeq1: $ a1 = a2 -> foo a1 b = foo a2 b $`
  --| * `fooeq1: $ a1 = a2 -> foo a1 b = foo a2 b $`
  --| * `fooeq2: $ b1 = b2 -> foo a b1 = foo a b2 $`
  --| * `fooeq1d: $ G -> a1 = a2 $ > $ G -> foo a1 b = foo a2 b $`
  --| * `fooeq2: $ G -> b1 = b2 $ > $ G -> foo a b1 = foo a b2 $`
  --|
  --| for any definition `foo`.
  (def (add-eqN-thms t . args)
    (def idx (ref! 0))
    (def base (get-tgt-args args t "eq"))
    @ match (make-eqNd-thms t)
      [(and (__ 2) thms)
        @ scan thms @ match-fn @ (bis hs ret val)
          (set! idx {idx + 1})
          (def tgt (atom-app base idx "d"))
          @ if (undef? (get-decl tgt)) @ begin
          (add-thm! tgt bis hs ret () '(() ,val))
          (def tgt2 (atom-app base idx))
          @ if (undef? (get-decl tgt2)) @ begin
          @ match (ded-to-thm tgt) [#undef] @ (bis2 ret2 val2)
          (add-thm! tgt2 bis2 () ret2 () val2)]
      [_])

  (def derive-eq @ match-fn*
    [(t1 t2 t3) @ fn (s)
      (add-eqd-thm s '',t1)
      (add-eq-thm s '',t2)
      (add-eqN-thms s '',t3)]
    [args @ fn (s)
      (apply add-eqd-thm s args)
      (apply add-eq-thm s args)
      (apply add-eqN-thms s args)])

  (def eval-map (atom-map!
    '[im ,(fn (a b) {(not (eval a)) or (eval b)})]
    '[not ,(fn (a) (not (eval a)))]))
  (set-merge-strategy eval-map merge-map)
  (def (eval e) @ match e @ ((? atom? t) . es)
    (apply
      (lookup eval-map t @ fn () @ error
        @ string-append "unknown function encountered during evaluation: " (->string t))
      es))

  --| This is used as an annotation.
  --| * `@(add-eval f) def foo ..` will add `f` as an evaluator for `foo`,
  --|   which is used by the `eval` function (which can evaluate many
  --|   closed terms of sort `nat` or `wff` to values).
  --| * `@(add-eval)` will attempt to evaluate the body of the definition
  --|   and use that as the result.
  (def ((add-eval . f) a)
    (if (def? @ lookup eval-map a) (error "already defined evaluation rule"))
    @ insert! eval-map a @ match f
    [(f) (if (fn? f) f (fn () f))]
    [() (def x @ eval @ nth 6 @ get-decl a) (fn () x)])

  --| `@eval-check` is an annotation that can be placed on theorems or axioms which
  --| are closed terms, and will check that the theorem/axiom evaluates to `#t`.
  --| This is not formally rigorous as the evaluator is not verified, but it can be
  --| viewed as a cross-check of the axiom or the evaluator, depending on your
  --| point of view.
  (def (eval-check a) @ match (eval @ nth 4 @ get-decl a) [#t])
};

-- configuration
do {
  (set-timeout 500)
  (def (refine-extra-args refine tgt e . ps)
    @ refine tgt (foldl ps (verb e) @ fn (acc p2) @ copy-span e '(ax_mp ,acc ,p2)))
  (def default-annotate (derive-eq))
  (def (annotate e s) @ match e ['_ (default-annotate s)] [_ (e s)])

  -- Enable this to mark unnecessary parentheses below.
  -- It is disabled because there are many "false positives"
  -- for operator pairs which are not obvious like (a -> b) <-> c
  --
  -- (warn-unnecessary-parens #t)
};

theorem a1i (h: $ b $): $ a -> b $ = '(ax_1 h);
theorem a2i (h: $ a -> b -> c $): $ (a -> b) -> (a -> c) $ = '(ax_2 h);
theorem mpd (h1: $ a -> b $) (h2: $ a -> b -> c $): $ a -> c $ = '(ax_2 h2 h1);
theorem mpi (h1: $ b $) (h2: $ a -> b -> c $): $ a -> c $ = '(mpd (a1i h1) h2);
theorem id: $ a -> a $ = '(mpd (! ax_1 _ a) ax_1);
theorem idd: $ a -> b -> b $ = '(a1i id);
theorem syl (h1: $ b -> c $) (h2: $ a -> b $): $ a -> c $ = '(mpd h2 (a1i h1));
theorem rsyl (h1: $ a -> b $) (h2: $ b -> c $): $ a -> c $ = '(syl h2 h1);
theorem a1d (h: $ a -> b $): $ a -> c -> b $ = '(syl ax_1 h);
theorem a2d (h: $ a -> b -> c -> d $): $ a -> (b -> c) -> (b -> d) $ = '(syl ax_2 h);
theorem a3d (h: $ a -> ~b -> ~c $): $ a -> c -> b $ = '(syl ax_3 h);
theorem sylc (h: $ b -> c -> d $) (h1: $ a -> b $) (h2: $ a -> c $): $ a -> d $ = '(mpd h2 @ syl h h1);
theorem syld (h1: $ a -> b -> c $) (h2: $ a -> c -> d $): $ a -> b -> d $ = '(mpd h1 @ a2d @ a1d h2);
theorem syl5 (h1: $ b -> c $) (h2: $ a -> c -> d $): $ a -> b -> d $ = '(syld (a1i h1) h2);
theorem syl6 (h1: $ c -> d $) (h2: $ a -> b -> c $): $ a -> b -> d $ = '(syld h2 (a1i h1));
theorem imim2: $ (b -> c) -> (a -> b) -> (a -> c) $ = '(a2d ax_1);
theorem imim2i (h: $ b -> c $): $ (a -> b) -> (a -> c) $ = '(imim2 h);
theorem imim2d (h: $ a -> c -> d $): $ a -> (b -> c) -> (b -> d) $ = '(syl imim2 h);
theorem absurd: $ ~a -> a -> b $ = '(a3d ax_1);
theorem com12 (h: $ a -> b -> c $): $ b -> a -> c $ = '(syl (a2i h) ax_1);
theorem mpcom: $ a -> (a -> b) -> b $ = '(com12 id);
theorem com23 (h: $ a -> b -> c -> d $): $ a -> c -> b -> d $ = '(syl (com12 @ imim2d mpcom) h);
theorem eimd (h1: $ a -> b $) (h2: $ a -> c -> d $): $ a -> (b -> c) -> d $ = '(syld (rsyl h1 mpcom) h2);
theorem absurdr: $ a -> ~a -> b $ = '(com12 absurd);
theorem imim1: $ (a -> b) -> (b -> c) -> (a -> c) $ = '(com12 imim2);
theorem imim1i (h: $ a -> b $): $ (b -> c) -> (a -> c) $ = '(imim1 h);
theorem imim1d (h: $ a -> b -> c $): $ a -> (c -> d) -> (b -> d) $ = '(syl imim1 h);
theorem imimd (h1: $ a -> b -> c $) (h2: $ a -> d -> e $):
  $ a -> (c -> d) -> (b -> e) $ = '(syld (imim1d h1) (imim2d h2));
theorem imim: $ (a -> b) -> (c -> d) -> (b -> c) -> (a -> d) $ = '(syl5 imim2 (imim2d imim1));
theorem imidm: $ (a -> a -> b) -> a -> b $ = '(a2i mpcom);
theorem eim: $ a -> (b -> c) -> (a -> b) -> c $ = '(imim1d mpcom);
theorem contra: $ (~a -> a) -> a $ = '(imidm (a3d (a2i absurd)));
theorem dne: $ ~~a -> a $ = '(syl contra absurd);
theorem inot: $ (a -> ~a) -> ~a $ = '(syl contra (imim1 dne));
theorem con2: $ (a -> ~b) -> (b -> ~a) $ = '(a3d (syl5 dne id));
theorem notnot1: $ a -> ~~a $ = '(con2 id);
theorem con3: $ (a -> b) -> (~b -> ~a) $ = '(syl con2 (imim2i notnot1));
theorem con1: $ (~a -> b) -> (~b -> a) $ = '(a3d (imim2i notnot1));
theorem cases (h1: $ a -> b $) (h2: $ ~a -> b $): $ b $ = '(contra @ syl h1 @ con1 h2);
theorem casesd (h1: $ a -> b -> c $) (h2: $ a -> ~b -> c $): $ a -> c $ =
'(cases (com12 h1) (com12 h2));
theorem con1d (h: $ a -> ~b -> c $): $ a -> ~c -> b $ = '(syl con1 h);
theorem con2d (h: $ a -> b -> ~c $): $ a -> c -> ~b $ = '(syl con2 h);
theorem con3d (h: $ a -> b -> c $): $ a -> ~c -> ~b $ = '(syl con3 h);
theorem con4d (h: $ a -> ~b -> ~c $): $ a -> c -> b $ = '(syl ax_3 h);
theorem mt (h1: $ b -> a $) (h2: $ ~a $): $ ~b $ = '(con3 h1 h2);
theorem mt2 (h1: $ b -> ~a $) (h2: $ a $): $ ~b $ = '(con2 h1 h2);
theorem mtd (h1: $ a -> ~b $) (h2: $ a -> c -> b $): $ a -> ~c $ = '(mpd h1 (con3d h2));
theorem mti (h1: $ ~b $) (h2: $ a -> c -> b $): $ a -> ~c $ = '(mtd (a1i h1) h2);
theorem mt2d (h1: $ a -> c $) (h2: $ a -> b -> ~c $): $ a -> ~b $ = '(sylc con2 h2 h1);

--| Conjunction: `a` and `b` are both true.
@(add-eval @ fn (a b) {(eval a) and (eval b)})
def an (a b: wff): wff = $ ~(a -> ~b) $;
infixl an: $/\$ prec 34;

theorem anl: $ a /\ b -> a $ = '(con1 absurd);
theorem anr: $ a /\ b -> b $ = '(con1 ax_1);
theorem anli (h: $ a /\ b $): $ a $ = '(anl h);
theorem anri (h: $ a /\ b $): $ b $ = '(anr h);
theorem ian: $ a -> b -> a /\ b $ = '(con2d mpcom);
theorem iand (h1: $ a -> b $) (h2: $ a -> c $): $ a -> b /\ c $ = '(sylc ian h1 h2);
theorem anld (h: $ a -> b /\ c $): $ a -> b $ = '(syl anl h);
theorem anrd (h: $ a -> b /\ c $): $ a -> c $ = '(syl anr h);
theorem iani (h1: $ a $) (h2: $ b $): $ a /\ b $ = '(ian h1 h2);
theorem anwl (h: $ a -> c $): $ a /\ b -> c $ = '(syl h anl);
theorem anwr (h: $ b -> c $): $ a /\ b -> c $ = '(syl h anr);
theorem anll: $ a /\ b /\ c -> a $ = '(anwl anl);
theorem anlr: $ a /\ b /\ c -> b $ = '(anwl anr);
theorem anrl: $ a /\ (b /\ c) -> b $ = '(anwr anl);
theorem anrr: $ a /\ (b /\ c) -> c $ = '(anwr anr);
theorem anwll (h: $ a -> d $): $ a /\ b /\ c -> d $ = '(anwl (anwl h));
theorem anw3l (h: $ a -> e $): $ a /\ b /\ c /\ d -> e $ = '(anwll (anwl h));
theorem anw4l (h: $ a -> f $): $ a /\ b /\ c /\ d /\ e -> f $ = '(anw3l (anwl h));
theorem anw5l (h: $ a -> g $): $ a /\ b /\ c /\ d /\ e /\ f -> g $ = '(anw4l (anwl h));
theorem anw6l (x: $ a -> h $): $ a /\ b /\ c /\ d /\ e /\ f /\ g -> h $ = '(anw5l (anwl x));
theorem anw7l (x: $ a -> i $): $ a /\ b /\ c /\ d /\ e /\ f /\ g /\ h -> i $ = '(anw6l (anwl x));
theorem anllr: $ a /\ b /\ c /\ d -> b $ = '(anwll anr);
theorem an3l: $ a /\ b /\ c /\ d -> a $ = '(anwll anl);
theorem an3lr: $ a /\ b /\ c /\ d /\ e -> b $ = '(anwl anllr);
theorem an4l: $ a /\ b /\ c /\ d /\ e -> a $ = '(anwl an3l); -- TODO: automate these
theorem an4lr: $ a /\ b /\ c /\ d /\ e /\ f -> b $ = '(anwl an3lr);
theorem an5l: $ a /\ b /\ c /\ d /\ e /\ f -> a $ = '(anwl an4l);
theorem an5lr: $ a /\ b /\ c /\ d /\ e /\ f /\ g -> b $ = '(anwl an4lr);
theorem an6l: $ a /\ b /\ c /\ d /\ e /\ f /\ g -> a $ = '(anwl an5l);
theorem an6lr: $ a /\ b /\ c /\ d /\ e /\ f /\ g /\ h -> b $ = '(anwl an5lr);
theorem imp (h: $ a -> b -> c $): $ a /\ b -> c $ = '(sylc h anl anr);
theorem exp (h: $ a /\ b -> c $): $ a -> b -> c $ = '(syl6 h ian);
theorem impcom (h: $ a -> b -> c $): $ b /\ a -> c $ = '(imp (com12 h));
theorem expcom (h: $ a /\ b -> c $): $ b -> a -> c $ = '(com12 (exp h));
theorem syla (h1: $ (b -> c) -> d $) (h2: $ a /\ b -> c $): $ a -> d $ = '(syl h1 @ exp h2);
theorem sylan (h: $ b /\ c -> d $) (h1: $ a -> b $) (h2: $ a -> c $):
  $ a -> d $ = '(syl h @ iand h1 h2);
theorem animd (h1: $ a -> b -> c $) (h2: $ a -> d -> e $): $ a -> b /\ d -> c /\ e $ =
'(exp (iand (imp (syl5 anl h1)) (imp (syl5 anr h2))));
theorem anim1d (h: $ a -> b -> c $): $ a -> b /\ d -> c /\ d $ = '(animd h idd);
theorem anim2d (h: $ a -> c -> d $): $ a -> b /\ c -> b /\ d $ = '(animd idd h);
theorem anim1: $ (a -> b) -> a /\ c -> b /\ c $ = '(anim1d id);
theorem anim2: $ (b -> c) -> a /\ b -> a /\ c $ = '(anim2d id);
theorem anim: $ (a -> b) -> (c -> d) -> a /\ c -> b /\ d $ =
'(exp @ syld (anim1d anl) (anim2d anr));
theorem anim2a: $ (a -> b -> c) -> (a /\ b -> a /\ c) $ =
'(exp @ iand anrl @ mpd anrr @ mpd anrl anl);
theorem ancom: $ a /\ b -> b /\ a $ = '(iand anr anl);
theorem anrasss (h: $ a /\ b /\ c -> d $): $ a /\ c /\ b -> d $ =
'(sylan h (iand anll anr) anlr);
theorem anim1a: $ (a -> b -> c) -> (b /\ a -> c /\ a) $ =
'(syl6 ancom @ syl5 ancom anim2a);
theorem casesda (h1: $ a /\ b -> c $) (h2: $ a /\ ~b -> c $): $ a -> c $ =
'(casesd (exp h1) (exp h2));
theorem inotda (h: $ a /\ b -> ~b $): $ a -> ~b $ = '(syla inot h);
theorem mpand (h1: $ a -> b $) (h2: $ a /\ b -> c $): $ a -> c $ = '(mpd h1 (exp h2));
theorem mtand (h1: $ a -> ~b $) (h2: $ a /\ c -> b $): $ a -> ~c $ = '(mtd h1 (exp h2));
theorem mtani (h1: $ ~b $) (h2: $ a /\ c -> b $): $ a -> ~c $ = '(mtand (a1i h1) h2);

--| If and only if: `a` implies `b`, and `b` implies `a`.
@(add-eval @ fn (a b) {(eval a) == (eval b)})
def iff (a b: wff): wff = $ (a -> b) /\ (b -> a) $;
infixl iff: $<->$ prec 20;

theorem bi1: $ (a <-> b) -> a -> b $ = 'anl;
theorem bi1i (h: $ a <-> b $): $ a -> b $ = '(bi1 h);
theorem bi1d (h: $ a -> (b <-> c) $): $ a -> b -> c $ = '(syl bi1 h);
theorem bi1a (h: $ a -> (b <-> c) $): $ a /\ b -> c $ = '(imp @ bi1d h);
theorem bi2: $ (a <-> b) -> b -> a $ = 'anr;
theorem bi2i (h: $ a <-> b $): $ b -> a $ = '(bi2 h);
theorem bi2d (h: $ a -> (b <-> c) $): $ a -> c -> b $ = '(syl bi2 h);
theorem bi2a (h: $ a -> (b <-> c) $): $ a /\ c -> b $ = '(imp @ bi2d h);
theorem ibii (h1: $ a -> b $) (h2: $ b -> a $): $ a <-> b $ = '(iani h1 h2);
theorem ibid (h1: $ a -> b -> c $) (h2: $ a -> c -> b $): $ a -> (b <-> c) $ = '(iand h1 h2);
theorem ibida (h1: $ a /\ b -> c $) (h2: $ a /\ c -> b $): $ a -> (b <-> c) $ = '(ibid (exp h1) (exp h2));
theorem biid: $ a <-> a $ = '(ibii id id);
theorem biidd: $ a -> (b <-> b) $ = '(a1i biid);
theorem mpbi (h1: $ a <-> b $) (h2: $ a $): $ b $ = '(bi1i h1 h2);
theorem mpbir (h1: $ b <-> a $) (h2: $ a $): $ b $ = '(bi2i h1 h2);
theorem mpbid (h1: $ a -> (b <-> c) $) (h2: $ a -> b $): $ a -> c $ = '(mpd h2 (bi1d h1));
theorem mpbird (h1: $ a -> (c <-> b) $) (h2: $ a -> b $): $ a -> c $ = '(mpd h2 (bi2d h1));
theorem mpbii (h1: $ b $) (h2: $ a -> (b <-> c) $): $ a -> c $ = '(mpbid h2 (a1i h1));
theorem mpbiri (h1: $ b $) (h2: $ a -> (c <-> b) $): $ a -> c $ = '(mpbird h2 (a1i h1));
theorem mtbi (h1: $ a <-> b $) (h2: $ ~a $): $ ~b $ = '(mt (bi2 h1) h2);
theorem mtbir (h1: $ b <-> a $) (h2: $ ~a $): $ ~b $ = '(mt (bi1 h1) h2);
theorem mtbid (h1: $ a -> (b <-> c) $) (h2: $ a -> ~b $): $ a -> ~c $ = '(mtd h2 (bi2d h1));
theorem mtbird (h1: $ a -> (c <-> b) $) (h2: $ a -> ~b $): $ a -> ~c $ = '(mtd h2 (bi1d h1));
theorem con1b: $ (~a <-> b) -> (~b <-> a) $ = '(ibid (con1d bi1) (con2d bi2));
theorem con2b: $ (a <-> ~b) -> (b <-> ~a) $ = '(ibid (con2d bi1) (con1d bi2));
theorem con3b: $ (a <-> b) -> (~a <-> ~b) $ = '(ibid (con3d bi2) (con3d bi1));
theorem con4b: $ (~a <-> ~b) -> (a <-> b) $ = '(ibid (con4d bi2) (con4d bi1));
theorem con1bb: $ (~a <-> b) <-> (~b <-> a) $ = '(ibii con1b con1b);
theorem con2bb: $ (a <-> ~b) <-> (b <-> ~a) $ = '(ibii con2b con2b);
theorem con3bb: $ (a <-> b) <-> (~a <-> ~b) $ = '(ibii con3b con4b);
theorem con1bi: $ (~a -> b) <-> (~b -> a) $ = '(ibii con1 con1);
theorem con2bi: $ (a -> ~b) <-> (b -> ~a) $ = '(ibii con2 con2);
theorem con3bi: $ (a -> b) <-> (~b -> ~a) $ = '(ibii con3 ax_3);
theorem notnot: $ a <-> ~~a $ = '(ibii notnot1 dne);
theorem bithd (h1: $ a -> b $) (h2: $ a -> c $): $ a -> (b <-> c) $ = '(ibid (a1d h2) (a1d h1));
theorem binthd (h1: $ a -> ~b $) (h2: $ a -> ~c $): $ a -> (b <-> c) $ = '(syl con4b @ bithd h1 h2);
theorem bith: $ a -> b -> (a <-> b) $ = '(exp @ bithd anl anr);
theorem binth: $ ~a -> ~b -> (a <-> b) $ = '(exp @ binthd anl anr);
theorem bicom: $ (a <-> b) -> (b <-> a) $ = '(ibid bi2 bi1);
theorem bicomb: $ (a <-> b) <-> (b <-> a) $ = '(ibii bicom bicom);
theorem bicomd (h: $ a -> (b <-> c) $): $ a -> (c <-> b) $ = '(syl bicom h);
theorem bitrd (h1: $ a -> (b <-> c) $) (h2: $ a -> (c <-> d) $): $ a -> (b <-> d) $ =
'(ibid (syld (bi1d h1) (bi1d h2)) (syld (bi2d h2) (bi2d h1)));
theorem bitr2d (h1: $ a -> (b <-> c) $) (h2: $ a -> (c <-> d) $): $ a -> (d <-> b) $ = '(bicomd (bitrd h1 h2));
theorem bitr3d (h1: $ a -> (c <-> b) $) (h2: $ a -> (c <-> d) $): $ a -> (b <-> d) $ = '(bitrd (bicomd h1) h2);
theorem bitr4d (h1: $ a -> (b <-> c) $) (h2: $ a -> (d <-> c) $): $ a -> (b <-> d) $ = '(bitrd h1 (bicomd h2));
theorem bitr: $ (a <-> b) -> (b <-> c) -> (a <-> c) $ = '(exp (bitrd anl anr));
theorem bitr2: $ (a <-> b) -> (b <-> c) -> (c <-> a) $ = '(exp (bitr2d anl anr));
theorem bitr3: $ (b <-> a) -> (b <-> c) -> (a <-> c) $ = '(exp (bitr3d anl anr));
theorem bitr4: $ (a <-> b) -> (c <-> b) -> (a <-> c) $ = '(exp (bitr4d anl anr));
theorem sylib (h1: $ b <-> c $) (h2: $ a -> b $): $ a -> c $ = '(syl (bi1i h1) h2);
theorem sylibr (h1: $ c <-> b $) (h2: $ a -> b $): $ a -> c $ = '(syl (bi2i h1) h2);
theorem sylbi (h1: $ a <-> b $) (h2: $ b -> c $): $ a -> c $ = '(syl h2 (bi1i h1));
theorem sylbir (h1: $ b <-> a $) (h2: $ b -> c $): $ a -> c $ = '(syl h2 (bi2i h1));
theorem syl5bb (h1: $ b <-> c $) (h2: $ a -> (c <-> d) $): $ a -> (b <-> d) $ = '(bitrd (a1i h1) h2);
theorem syl5bbr (h1: $ c <-> b $) (h2: $ a -> (c <-> d) $): $ a -> (b <-> d) $ = '(syl5bb (bicom h1) h2);
theorem syl6bb (h1: $ c <-> d $) (h2: $ a -> (b <-> c) $): $ a -> (b <-> d) $ = '(bitrd h2 (a1i h1));
theorem syl6bbr (h1: $ d <-> c $) (h2: $ a -> (b <-> c) $): $ a -> (b <-> d) $ = '(syl6bb (bicom h1) h2);
theorem syl5bi (h1: $ b <-> c $) (h2: $ a -> c -> d $): $ a -> b -> d $ = '(syl5 (bi1 h1) h2);
theorem syl5bir (h1: $ c <-> b $) (h2: $ a -> c -> d $): $ a -> b -> d $ = '(syl5bi (bicom h1) h2);
theorem syl6ib (h1: $ c <-> d $) (h2: $ a -> b -> c $): $ a -> b -> d $ = '(syl6 (bi1 h1) h2);
theorem syl6ibr (h1: $ d <-> c $) (h2: $ a -> b -> c $): $ a -> b -> d $ = '(syl6 (bi2 h1) h2);
theorem syl5ibrcom (h1: $ c -> (b <-> d) $) (h2: $ a -> d $): $ a -> c -> b $ = '(com12 @ syl5 h2 (bi2d h1));
theorem sylbid (h1: $ a -> (b <-> c) $) (h2: $ a -> c -> d $): $ a -> b -> d $ = '(syld (bi1d h1) h2);
theorem sylibd (h1: $ a -> b -> c $) (h2: $ a -> (c <-> d) $): $ a -> b -> d $ = '(syld h1 (bi1d h2));
theorem sylbird (h1: $ a -> (c <-> b) $) (h2: $ a -> c -> d $): $ a -> b -> d $ = '(syld (bi2d h1) h2);
theorem sylibrd (h1: $ a -> b -> c $) (h2: $ a -> (d <-> c) $): $ a -> b -> d $ = '(syld h1 (bi2d h2));
theorem bitr3g (h1: $ b <-> d $) (h2: $ c <-> e $) (h: $ a -> (b <-> c) $):
  $ a -> (d <-> e) $ = '(syl5bb (bicom h1) @ syl6bb h2 h);
theorem bitr4g (h1: $ d <-> b $) (h2: $ e <-> c $) (h: $ a -> (b <-> c) $):
  $ a -> (d <-> e) $ = '(syl5bb h1 @ syl6bb (bicom h2) h);
theorem bitr3gi (h1: $ a <-> c $) (h2: $ b <-> d $) (h: $ a <-> b $): $ c <-> d $ = '(bitr3 h1 @ bitr h h2);
theorem bitr4gi (h1: $ c <-> a $) (h2: $ d <-> b $) (h: $ a <-> b $): $ c <-> d $ = '(bitr h1 @ bitr4 h h2);
theorem impbi (h: $ a -> (b <-> c) $): $ a /\ b -> c $ = '(imp @ bi1d h);
theorem impbir (h: $ a -> (c <-> b) $): $ a /\ b -> c $ = '(imp @ bi2d h);
theorem ancomb: $ a /\ b <-> b /\ a $ = '(ibii ancom ancom);
theorem anass: $ a /\ b /\ c <-> a /\ (b /\ c) $ =
'(ibii (iand anll (anim1 anr)) (iand (anim2 anl) anrr));
theorem bian2a: $ (a -> b) -> (a /\ b <-> a) $ = '(ibid (a1i anl) (a2i ian));
theorem bian1a: $ (b -> a) -> (a /\ b <-> b) $ = '(syl5bb ancomb bian2a);
theorem bian1: $ a -> (a /\ b <-> b) $ = '(syl bian1a ax_1);
theorem bian2: $ b -> (a /\ b <-> a) $ = '(syl bian2a ax_1);
theorem bibi1: $ a -> ((a <-> b) <-> b) $ = '(ibid (com12 bi1) bith);
theorem bibi2: $ b -> ((a <-> b) <-> a) $ = '(syl5bb bicomb bibi1);
theorem noteq: $ (a <-> b) -> (~a <-> ~b) $ = 'con3b;
theorem noteqi (h: $ a <-> b $): $ ~a <-> ~b $ = '(noteq h);
@(register-eqd 'not) theorem noteqd (h: $ a -> (b <-> c) $): $ a -> (~b <-> ~c) $ = '(syl noteq h);
@(register-eqd 'im) theorem imeqd
  (h1: $ a -> (b <-> c) $) (h2: $ a -> (d <-> e) $): $ a -> (b -> d <-> c -> e) $ =
'(ibid (imimd (bi2d h1) (bi1d h2)) (imimd (bi1d h1) (bi2d h2)));
theorem bibin1: $ ~a -> ((a <-> b) <-> ~b) $ = '(ibid (com12 @ bi1d noteq) binth);
theorem bibin2: $ ~b -> ((a <-> b) <-> ~a) $ = '(syl5bb bicomb bibin1);
theorem imeq1d (h: $ a -> (b <-> c) $): $ a -> (b -> d <-> c -> d) $ = '(imeqd h biidd);
theorem imeq2d (h: $ a -> (c <-> d) $): $ a -> (b -> c <-> b -> d) $ = '(imeqd biidd h);
theorem imeq1i (h: $ a <-> b $): $ a -> c <-> b -> c $ = '(imeq1d id h);
theorem imeq2i (h: $ b <-> c $): $ a -> b <-> a -> c $ = '(imeq2d id h);
theorem imeqi (h1: $ a <-> b $) (h2: $ c <-> d $): $ a -> c <-> b -> d $ = '(bitr (imeq1i h1) (imeq2i h2));
@(register-eqd 'an) theorem aneqd
  (h1: $ a -> (b <-> c) $) (h2: $ a -> (d <-> e) $): $ a -> (b /\ d <-> c /\ e) $ =
'(ibid (animd (bi1d h1) (bi1d h2)) (animd (bi2d h1) (bi2d h2)));
theorem imeq2a: $ (a -> (b <-> c)) -> (a -> b <-> a -> c) $ = '(ibid (a2d @ imim2i bi1) (a2d @ imim2i bi2));
theorem imeq1a: $ (~c -> (a <-> b)) -> (a -> c <-> b -> c) $ = '(bitr4g con3bi con3bi @ syl imeq2a @ imim2i noteq);
theorem imeq2da (h: $ G /\ a -> (b <-> c) $): $ G -> (a -> b <-> a -> c) $ = '(syl imeq2a @ exp h);
theorem aneq1d (h: $ a -> (b <-> c) $): $ a -> (b /\ d <-> c /\ d) $ = '(aneqd h biidd);
theorem aneq2d (h: $ a -> (c <-> d) $): $ a -> (b /\ c <-> b /\ d) $ = '(aneqd biidd h);
theorem aneq: $ (a <-> b) -> (c <-> d) -> (a /\ c <-> b /\ d) $ = '(exp @ aneqd anl anr);
theorem aneq1i (h: $ a <-> b $): $ a /\ c <-> b /\ c $ = '(aneq1d id h);
theorem aneq2i (h: $ b <-> c $): $ a /\ b <-> a /\ c $ = '(aneq2d id h);
theorem aneq2a: $ (a -> (b <-> c)) -> (a /\ b <-> a /\ c) $ =
'(ibid (syl anim2a @ imim2i bi1) (syl anim2a @ imim2i bi2));
theorem aneq1a: $ (c -> (a <-> b)) -> (a /\ c <-> b /\ c) $ = '(syl5bb ancomb @ syl6bb ancomb aneq2a);
theorem aneq1da (h: $ G /\ c -> (a <-> b) $): $ G -> (a /\ c <-> b /\ c) $ = '(syl aneq1a @ exp h);
theorem aneq2da (h: $ G /\ a -> (b <-> c) $): $ G -> (a /\ b <-> a /\ c) $ = '(syl aneq2a @ exp h);
theorem anlass: $ a /\ (b /\ c) <-> b /\ (a /\ c) $ =
'(bitr3 anass @ bitr (aneq1i ancomb) anass);
theorem anrass: $ a /\ b /\ c <-> a /\ c /\ b $ =
'(bitr anass @ bitr4 (aneq2i ancomb) anass);
theorem an4: $ (a /\ b) /\ (c /\ d) <-> (a /\ c) /\ (b /\ d) $ =
'(bitr4 anass @ bitr4 anass @ aneq2i anlass);
theorem anroti (h: $ a -> b /\ d $): $ a /\ c -> b /\ c /\ d $ = '(sylib anrass @ anim1 h);
theorem anrotri (h: $ b /\ d -> a $): $ b /\ c /\ d -> a /\ c $ = '(sylbi anrass @ anim1 h);
theorem bian11i (h: $ a <-> b /\ c $): $ a /\ d <-> b /\ (c /\ d) $ = '(bitr (aneq1i h) anass);
theorem bian21i (h: $ a <-> b /\ c $): $ a /\ d <-> (b /\ d) /\ c $ = '(bitr (aneq1i h) anrass);
theorem bian12i (h: $ a <-> b /\ c $): $ d /\ a <-> b /\ (d /\ c) $ = '(bitr (aneq2i h) anlass);
theorem bian22i (h: $ a <-> b /\ c $): $ d /\ a <-> (d /\ b) /\ c $ = '(bitr4 (aneq2i h) anass);
theorem bian11d (h: $ G -> (a <-> b /\ c) $): $ G -> (a /\ d <-> b /\ (c /\ d)) $ = '(syl6bb anass (aneq1d h));
theorem bian21d (h: $ G -> (a <-> b /\ c) $): $ G -> (a /\ d <-> (b /\ d) /\ c) $ = '(syl6bb anrass (aneq1d h));
theorem bian12d (h: $ G -> (a <-> b /\ c) $): $ G -> (d /\ a <-> b /\ (d /\ c)) $ = '(syl6bb anlass (aneq2d h));
theorem bian22d (h: $ G -> (a <-> b /\ c) $): $ G -> (d /\ a <-> (d /\ b) /\ c) $ = '(syl6bbr anass (aneq2d h));
theorem bian11da (h: $ G /\ d -> (a <-> b /\ c) $): $ G -> (a /\ d <-> b /\ (c /\ d)) $ = '(syl6bb anass (aneq1da h));
theorem bian21da (h: $ G /\ d -> (a <-> b /\ c) $): $ G -> (a /\ d <-> (b /\ d) /\ c) $ = '(syl6bb anrass (aneq1da h));
theorem bian12da (h: $ G /\ d -> (a <-> b /\ c) $): $ G -> (d /\ a <-> b /\ (d /\ c)) $ = '(syl6bb anlass (aneq2da h));
theorem bian22da (h: $ G /\ d -> (a <-> b /\ c) $): $ G -> (d /\ a <-> (d /\ b) /\ c) $ = '(syl6bbr anass (aneq2da h));
theorem anidm: $ a /\ a <-> a $ = '(ibii anl (iand id id));
theorem anandi: $ a /\ (b /\ c) <-> (a /\ b) /\ (a /\ c) $ = '(bitr3 (aneq1i anidm) an4);
theorem anandir: $ (a /\ b) /\ c <-> (a /\ c) /\ (b /\ c) $ = '(bitr3 (aneq2i anidm) an4);
theorem imandi: $ (a -> b /\ c) <-> (a -> b) /\ (a -> c) $ =
'(ibii (iand (imim2i anl) (imim2i anr)) (com12 @ animd mpcom mpcom));
theorem imancom: $ a /\ (b -> c) -> b -> a /\ c $ = '(com12 @ anim2d mpcom);
theorem rbida (h1: $ a /\ c -> b $) (h2: $ a /\ d -> b $)
  (h: $ a /\ b -> (c <-> d) $): $ a -> (c <-> d) $ =
'(bitr3d (syla bian2a h1) @ bitrd (syla aneq1a h) (syla bian2a h2));
theorem rbid (h1: $ b -> a $) (h2: $ c -> a $) (h: $ a -> (b <-> c) $): $ b <-> c $ =
'(bitr3 (bian2a h1) @ bitr (aneq1a h) (bian2a h2));
@(register-eqd 'iff) theorem bieqd
  (h1: $ a -> (b <-> c) $) (h2: $ a -> (d <-> e) $): $ a -> ((b <-> d) <-> (c <-> e)) $ =
'(aneqd (imeqd h1 h2) (imeqd h2 h1));
theorem bieq1d (h: $ a -> (b <-> c) $): $ a -> ((b <-> d) <-> (c <-> d)) $ = '(bieqd h biidd);
theorem bieq2d (h: $ a -> (c <-> d) $): $ a -> ((b <-> c) <-> (b <-> d)) $ = '(bieqd biidd h);
theorem bieq: $ (a <-> b) -> (c <-> d) -> ((a <-> c) <-> (b <-> d)) $ = '(exp (bieqd anl anr));
theorem bieq1: $ (a <-> b) -> ((a <-> c) <-> (b <-> c)) $ = '(bieq1d id);
theorem bieq2: $ (b <-> c) -> ((a <-> b) <-> (a <-> c)) $ = '(bieq2d id);
theorem impexp: $ (a /\ b -> c) <-> (a -> b -> c) $ =
'(ibii (exp @ exp @ mpd (anim1 anr) anll) (exp @ mpd anrr @ mpd anrl anl));
theorem impd (h: $ a -> b -> c -> d $): $ a -> b /\ c -> d $ = '(sylibr impexp h);
theorem expd (h: $ a -> b /\ c -> d $): $ a -> b -> c -> d $ = '(sylib impexp h);
theorem com12b: $ (a -> b -> c) <-> (b -> a -> c) $ = '(ibii (com23 id) (com23 id));

--| Disjunction: either `a` is true or `b` is true.
@(add-eval @ fn (a b) {(eval a) or (eval b)})
@_ def or (a b: wff): wff = $ ~a -> b $;
infixl or: $\/$ prec 30;

theorem orl: $ a -> a \/ b $ = 'absurdr;
theorem orr: $ b -> a \/ b $ = 'ax_1;
theorem eori (h1: $ a -> c $) (h2: $ b -> c $): $ a \/ b -> c $ =
'(casesd (a1i h1) (imim2i h2));
theorem eord (h1: $ a -> b -> d $) (h2: $ a -> c -> d $):
  $ a -> b \/ c -> d $ = '(com12 (eori (com12 h1) (com12 h2)));
theorem eorda (h1: $ a /\ b -> d $) (h2: $ a /\ c -> d $):
  $ a -> b \/ c -> d $ = '(eord (exp h1) (exp h2));
theorem orld (h: $ a -> b $): $ a -> b \/ c $ = '(syl orl h);
theorem orrd (h: $ a -> c $): $ a -> b \/ c $ = '(syl orr h);
theorem eor: $ (a -> c) -> (b -> c) -> a \/ b -> c $ = '(exp (eord anl anr));
theorem orimd (h1: $ a -> b -> c $) (h2: $ a -> d -> e $): $ a -> b \/ d -> c \/ e $ =
'(eord (syl6 orl h1) (syl6 orr h2));
theorem orim1d (h: $ a -> b -> c $): $ a -> b \/ d -> c \/ d $ = '(orimd h idd);
theorem orim2d (h: $ a -> c -> d $): $ a -> b \/ c -> b \/ d $ = '(orimd idd h);
theorem orim1: $ (a -> b) -> a \/ c -> b \/ c $ = '(orim1d id);
theorem orim2: $ (b -> c) -> a \/ b -> a \/ c $ = '(orim2d id);
theorem oreq1i (h: $ a <-> b $): $ a \/ c <-> b \/ c $ = '(oreq1d id h);
theorem oreq2i (h: $ b <-> c $): $ a \/ b <-> a \/ c $ = '(oreq2d id h);
theorem orim: $ (a -> b) -> (c -> d) -> a \/ c -> b \/ d $ = '(exp @ syld (anwl orim1) (anwr orim2));
theorem oreqi (h1: $ a <-> b $) (h2: $ c <-> d $): $ a \/ c <-> b \/ d $ = '(bitr (oreq1i h1) (oreq2i h2));
theorem orcom: $ a \/ b -> b \/ a $ = 'con1;
theorem orcomb: $ a \/ b <-> b \/ a $ = '(ibii orcom orcom);
theorem or12: $ a \/ (b \/ c) <-> b \/ (a \/ c) $ = '(bitr3 impexp @ bitr (imeq1i ancomb) impexp);
theorem orass: $ a \/ b \/ c <-> a \/ (b \/ c) $ = '(bitr orcomb @ bitr or12 (oreq2 orcomb));
theorem or4: $ (a \/ b) \/ (c \/ d) <-> (a \/ c) \/ (b \/ d) $ = '(bitr4 orass @ bitr4 orass @ oreq2 or12);
theorem oridm: $ a \/ a <-> a $ = '(ibii (eor id id) orl);
theorem notan2: $ ~(a /\ b) <-> a -> ~b $ = '(bicom notnot);
theorem notan: $ ~(a /\ b) <-> (~a \/ ~b) $ = '(bitr notan2 (imeq1i notnot));
theorem notor: $ ~(a \/ b) <-> (~a /\ ~b) $ = '(con1b (bitr4 notan (oreqi notnot notnot)));
theorem iman: $ a -> b <-> ~(a /\ ~b) $ = '(bitr4 (imeq2i notnot) notan2);
theorem imor: $ ((a \/ b) -> c) <-> ((a -> c) /\ (b -> c)) $ =
'(ibii (iand (imim1i orl) (imim1i orr)) (imp eor));
theorem andi: $ a /\ (b \/ c) <-> a /\ b \/ a /\ c $ =
'(ibii (imp @ orimd ian ian) @ eor (anim2 orl) (anim2 orr));
theorem andir: $ (a \/ b) /\ c <-> a /\ c \/ b /\ c $ =
'(bitr ancomb @ bitr andi @ oreqi ancomb ancomb);
theorem ordi: $ a \/ (b /\ c) <-> (a \/ b) /\ (a \/ c) $ =
'(ibii (iand (orim2 anl) (orim2 anr)) @ com12 @ animd mpcom mpcom);
theorem ordir: $ (a /\ b) \/ c <-> (a \/ c) /\ (b \/ c) $ =
'(bitr orcomb @ bitr ordi @ aneq orcomb orcomb);
theorem oreq2a: $ (~a -> (b <-> c)) -> (a \/ b <-> a \/ c) $ = 'imeq2a;
theorem oreq1a: $ (~c -> (a <-> b)) -> (a \/ c <-> b \/ c) $ = '(syl5bb orcomb @ syl6bb orcomb oreq2a);
theorem biim1a: $ (~a -> b) -> (a -> b <-> b) $ = '(ibid (exp @ casesd anr anl) (a1i ax_1));
theorem biim2a: $ (b -> ~a) -> (a -> b <-> ~a) $ = '(ibid (exp @ syl inot @ imp imim2) (a1i absurd));
theorem bior1a: $ (a -> b) -> (a \/ b <-> b) $ = '(sylbi (imeq1i notnot) biim1a);
theorem bior2a: $ (b -> a) -> (a \/ b <-> a) $ = '(syl5bb orcomb bior1a);
theorem biim1: $ a -> (a -> b <-> b) $ = '(syl biim1a absurdr);
theorem biim2: $ ~b -> (a -> b <-> ~a) $ = '(syl biim2a absurd);
theorem bior1: $ ~a -> (a \/ b <-> b) $ = '(syl bior1a absurd);
theorem bior2: $ ~b -> (a \/ b <-> a) $ = '(syl bior2a absurd);
theorem em: $ p \/ ~p $ = 'id;
theorem emr: $ ~p \/ p $ = '(orcom em);

--| Selection: `ifp p a b` is equivalent to `a` if `p` is true,
--| and equivalent to `b` if `p` is false.
@(add-eval @ fn (a b c) (if (eval a) (eval b) (eval c)))
@_ abstract def ifp (p a b: wff): wff = $ p /\ a \/ ~p /\ b $;

pub theorem ifppos (p a b: wff): $ p -> (ifp p a b <-> a) $ =
'(bitrd (syl bior2 @ con2 anl) bian1);
pub theorem ifpneg (p a b: wff): $ ~p -> (ifp p a b <-> b) $ =
'(bitrd (syl bior1 @ con3 anl) bian1);

theorem ifpid: $ ifp p a a <-> a $ = '(cases ifppos ifpneg);
theorem ifpnot: $ ifp (~p) a b <-> ifp p b a $ =
'(bitr4 orcomb @ oreq1 @ aneq1i notnot);

theorem ifpan1: $ ifp p a b /\ c <-> ifp p (a /\ c) (b /\ c) $ =
'(bitr andir @ oreq anass anass);
theorem ifpan2: $ c /\ ifp p a b <-> ifp p (c /\ a) (c /\ b) $ =
'(bitr andi @ oreq anlass anlass);
theorem ifpor: $ ifp p (a \/ b) (c \/ d) <-> ifp p a c \/ ifp p b d $ =
(let ([(f x) '(bitr4d ,x @ oreqd ,x ,x)]) '(cases ,(f 'ifppos) ,(f 'ifpneg)));

theorem ifpeq2a: $ (p -> (a1 <-> a2)) -> (ifp p a1 b <-> ifp p a2 b) $ = '(oreq1d aneq2a);
theorem ifpeq3a: $ (~p -> (b1 <-> b2)) -> (ifp p a b1 <-> ifp p a b2) $ = '(oreq2d aneq2a);

theorem ifptreq (h: $ G -> (p <-> ifp a p0 p1) $)
  (h0: $ G /\ a -> (p0 <-> q0) $) (h1: $ G /\ ~a -> (p1 <-> q1) $):
  $ G -> (p <-> ifp a q0 q1) $ =
'(bitrd h @ bitrd (syl ifpeq2a @ exp h0) (syl ifpeq3a @ exp h1));

theorem ifppos2: $ b -> (ifp a b c <-> a \/ c) $ = '(syl6bb (oreq2a bian1) (oreq1d bian2));
theorem ifppos3: $ c -> (ifp a b c <-> ~a \/ b) $ = '(syl5bbr ifpnot ifppos2);
theorem ifpneg3: $ ~c -> (ifp a b c <-> a /\ b) $ = '(syl bior2 @ con3 anr);
theorem ifpneg2: $ ~b -> (ifp a b c <-> ~a /\ c) $ = '(syl5bbr ifpnot ifpneg3);

--| The constant `true`.
@(add-eval #t)
term tru: wff; prefix tru: $T.$ prec max;
--| `true` is true.
axiom itru: $ T. $;
--| The constant `false`.
@(add-eval) def fal: wff = $ ~T. $; prefix fal: $F.$ prec max;

do (add-axiom-set! 'axs_prop_calc "Propositional calculus" '(ax_1 ax_2 ax_3 ax_mp itru));

theorem trud (h: $ T. -> a $): $ a $ = '(h itru);
theorem eqtru: $ (a <-> T.) <-> a $ =
'(ibii (mpbiri itru id) @ bithd id (a1i itru));
theorem notfal: $ ~F. $ = '(notnot1 itru);
theorem efal: $ F. -> a $ = '(absurd notfal);
theorem imfal: $ (a -> F.) <-> ~a $ = '(ibii (mpi notfal con3) absurd);
theorem eqfal: $ (a <-> F.) <-> ~a $ = '(bitr (bian2 efal) imfal);
theorem neqfal: $ (~a <-> F.) <-> a $ = '(bitr4 eqfal notnot);

--| The sort of natural numbers, or nonnegative integers.
--| In Peano Arithmetic this is the domain of discourse,
--| the basic sort over which quantifiers range.
sort nat;

--| The for-all quantifier. `A. x p` means
--| "for all natural numbers `x`, `p` holds",
--| where `(p: wff x)` in the declaration indicates that `p` may contain
--| free occurrences of variable `x` that are bound by this quantifier.
term al {x: nat} (p: wff x): wff; prefix al: $A.$ prec 41;

--| The exists quantifier. `E. x p` means
--| "there is a natural number `x`, such that `p` holds",
--| where `(p: wff x)` in the declaration indicates that `p` may contain
--| free occurrences of variable `x` that are bound by this quantifier.
def ex {x: nat} (p: wff x): wff = $ ~(A. x ~p) $;
prefix ex: $E.$ prec 41;

--| Equality of natural numbers: `a = b`
--| means that `a` and `b` have the same value.
@(add-eval @ fn (a b) {(eval a) = (eval b)})
term eq (a b: nat): wff; infixl eq: $=$ prec 50;

--| The axiom of generalization. If `|- p` is derivable
--| (the lack of a precondition means this is a proof in the empty context),
--| then `p` is universally true, so `|- A. x p` is also true.
axiom ax_gen {x: nat} (p: wff x): $ p $ > $ A. x p $;

--| Axiom 4 for predicate logic: forall distributes over implication.
axiom ax_4 {x: nat} (p q: wff x): $ A. x (p -> q) -> A. x p -> A. x q $;
theorem alim {x: nat} (p q: wff x): $ A. x (p -> q) -> A. x p -> A. x q $ = 'ax_4;

--| Axiom 5 for predicate logic: If `p` does not contain an occurrence of `x`
--| (note that `(p: wff)` in contrast to `(p: wff x)` means that `p` cannot
--| depend on variable `x`), then `p` implies `A. x p`
--| because the quantifier is trivial.
axiom ax_5 {x: nat} (p: wff): $ p -> A. x p $;
theorem ial {x: nat} (p: wff): $ p -> A. x p $ = 'ax_5;

--| Axiom 6 for predicate logic: for any term `a` (which cannot depend on `x`),
--| there exists an `x` which is equal to `a`.
axiom ax_6 (a: nat) {x: nat}: $ E. x x = a $;

--| Axiom 7 for predicate logic: equality satisfies the euclidean property
--| (which implies symmetry and transitivity, and reflexivity given axiom 6).
axiom ax_7 (a b c: nat): $ a = b -> a = c -> b = c $;
theorem eqtr3: $ b = a -> b = c -> a = c $ = 'ax_7;

-- axiom 9 has been proven redundant; axiom 8 is displaced below

--| Axiom 10 for predicate logic: `x` is bound in `~(A. x p)`, so we can
--| safely introduce a `A. x` quantifier. (This axiom is used to internalize
--| the notion of "bound in" when axiom 5 does not apply.)
axiom ax_10 {x: nat} (p: wff x): $ ~(A. x p) -> A. x ~(A. x p) $;

--| Axiom 11 for predicate logic: forall quantifiers commute.
axiom ax_11 {x y: nat} (p: wff x y): $ A. x A. y p -> A. y A. x p $;
theorem alcom {x y: nat} (p: wff x y): $ A. x A. y p -> A. y A. x p $ = 'ax_11;

--| Axiom 12 for predicate logic: If `x` is some fixed `a` and `p(x)` holds,
--| then for all `x` which are equal to `a`, `p(x)` holds. This expresses the
--| substitution property of `=`, but the name shadowing on `x` allows us to
--| express this without changing `p`,
--| because we haven't defined proper substitution yet.
axiom ax_12 {x: nat} (a: nat) (p: wff x): $ x = a -> p -> A. x (x = a -> p) $;

do (add-axiom-set! 'axs_pred_calc "Predicate calculus"
  '(ax_gen ax_4 ax_5 ax_6 ax_7 ax_10 ax_11 ax_12));

theorem alimi (a b: wff x) (h: $ a -> b $): $ A. x a -> A. x b $ = '(ax_4 (ax_gen h));
theorem iald (a: wff) (b: wff x) (h: $ a -> b $): $ a -> A. x b $ = '(syl (alimi h) ax_5);
theorem eex (a: wff x) (b: wff) (h: $ a -> b $): $ E. x a -> b $ = '(con1 @ iald @ con3 h);

theorem eqid: $ a = a $ = '(!! eex x (imidm ax_7) ax_6);
theorem eqcom: $ a = b -> b = a $ = '(mpi eqid ax_7);
theorem eqtr: $ a = b -> b = c -> a = c $ = '(syl ax_7 eqcom);
theorem eqtr2: $ a = b -> b = c -> c = a $ = '(syl6 eqcom eqtr);
theorem eqtr4: $ a = b -> c = b -> a = c $ = '(syl5 eqcom eqtr);
theorem eqcomb: $ a = b <-> b = a $ = '(ibii eqcom eqcom);
theorem eqeq1: $ a = b -> (a = c <-> b = c) $ = '(ibid eqtr3 eqtr);
theorem eqeq2: $ b = c -> (a = b <-> a = c) $ = '(ibid (com12 eqtr) (com12 eqtr4));
theorem eqeq1d (h: $ G -> a = b $): $ G -> (a = c <-> b = c) $ = '(syl eqeq1 h);
theorem eqeq2d (h: $ G -> b = c $): $ G -> (a = b <-> a = c) $ = '(syl eqeq2 h);
@(register-eqd 'eq) theorem eqeqd (h1: $ G -> a = b $) (h2: $ G -> c = d $):
  $ G -> (a = c <-> b = d) $ = '(bitrd (eqeq1d h1) (eqeq2d h2));
theorem eqeq: $ a = b -> c = d -> (a = c <-> b = d) $ = '(exp (eqeqd anl anr));
theorem eqtr2d (h1: $ G -> a = b $) (h2: $ G -> b = c $): $ G -> c = a $ = '(sylc eqtr2 h1 h2);
theorem eqtr3d (h1: $ G -> b = a $) (h2: $ G -> b = c $): $ G -> a = c $ = '(sylc eqtr3 h1 h2);
theorem eqidd: $ G -> a = a $ = '(a1i eqid);
theorem eqcomi (h: $ a = b $): $ b = a $ = '(eqcom h);
theorem eqcomd (h: $ G -> a = b $): $ G -> b = a $ = '(syl eqcom h);
theorem eqtrd (h1: $ G -> a = b $) (h2: $ G -> b = c $): $ G -> a = c $ = '(sylc eqtr h1 h2);
theorem eqtr4i (h1: $ a = b $) (h2: $ c = b $): $ a = c $ = '(eqtr4 h1 h2);
theorem eqtr4d (h1: $ G -> a = b $) (h2: $ G -> c = b $): $ G -> a = c $ = '(sylc eqtr4 h1 h2);
theorem syl5eq (h1: $ a = b $) (h2: $ G -> b = c $): $ G -> a = c $ = '(eqtrd (a1i h1) h2);
theorem syl5eqr (h1: $ b = a $) (h2: $ G -> b = c $): $ G -> a = c $ = '(eqtr3d (a1i h1) h2);
theorem syl6eq (h1: $ b = c $) (h2: $ G -> a = b $): $ G -> a = c $ = '(eqtrd h2 (a1i h1));
theorem syl6eqr (h1: $ c = b $) (h2: $ G -> a = b $): $ G -> a = c $ = '(eqtr4d h2 (a1i h1));
theorem eqtr3g (h1: $ a = c $) (h2: $ b = d $) (h: $ G -> a = b $):
  $ G -> c = d $ = '(syl5eqr h1 @ syl6eq h2 h);
theorem eqtr4g (h1: $ c = a $) (h2: $ d = b $) (h: $ G -> a = b $):
  $ G -> c = d $ = '(syl5eq h1 @ syl6eqr h2 h);

theorem aleq (a b: wff x): $ A. x (a <-> b) -> (A. x a <-> A. x b) $ =
'(ibid (syl ax_4 @ alimi bi1) (syl ax_4 @ alimi bi2));
theorem aleqi (a b: wff x) (h: $ a <-> b $): $ A. x a <-> A. x b $ = '(aleq @ ax_gen h);
theorem alimd (G) (a b: wff x) (h: $ G -> a -> b $):
  $ G -> A. x a -> A. x b $ = '(syl ax_4 @ syl (alimi h) ax_5);
theorem raleqi (p a b: wff x) (h: $ a <-> b $): $ A. x (p -> a) <-> A. x (p -> b) $ = '(aleqi @ imeq2i h);
theorem al2imi (a b c: wff x) (h: $ a -> b -> c $): $ A. x a -> A. x b -> A. x c $ =
'(syl alim @ alimi h);
@(register-eqd 'al) theorem aleqd (G) {x} (a b: wff x) (h: $ G -> (a <-> b) $):
  $ G -> (A. x a <-> A. x b) $ = '(syl aleq @ iald h);
theorem ialda (G: wff) (a b: wff x) (h: $ G /\ a -> b $): $ G -> A. x (a -> b) $ = '(iald @ exp h);
theorem alcomb (a: wff x y): $ A. x A. y a <-> A. y A. x a $ = '(ibii alcom alcom);
theorem alan (a b: wff x): $ A. x (a /\ b) <-> A. x a /\ A. x b $ =
'(ibii (iand (alimi anl) (alimi anr)) (imp @ al2imi ian));
theorem ralan (a b c: wff x): $ A. x (a -> b /\ c) <-> A. x (a -> b) /\ A. x (a -> c) $ =
'(bitr (aleqi imandi) alan);
theorem exim (a b: wff x): $ A. x (a -> b) -> E. x a -> E. x b $ = '(syl con3 @ al2imi con3);
theorem eximi (a b: wff x) (h: $ a -> b $): $ E. x a -> E. x b $ = '(exim @ ax_gen h);
theorem exeq (a b: wff x): $ A. x (a <-> b) -> (E. x a <-> E. x b) $ =
'(noteqd @ syl aleq @ alimi noteq);
@(register-eqd 'ex) theorem exeqd (G) {x} (a b: wff x) (h: $ G -> (a <-> b) $):
  $ G -> (E. x a <-> E. x b) $ = '(syl exeq @ iald h);
theorem exeqi (a b: wff x) (h: $ a <-> b $): $ E. x a <-> E. x b $ = '(exeq @ ax_gen h);
theorem rexeqi (p a b: wff x) (h: $ a <-> b $): $ E. x (p /\ a) <-> E. x (p /\ b) $ = '(exeqi @ aneq2i h);
theorem rexeqa (p a b: wff x) (h: $ p -> (a <-> b) $): $ E. x (p /\ a) <-> E. x (p /\ b) $ = '(exeqi @ aneq2a h);
theorem rexeqd (p a b: wff x) (h: $ G -> (a <-> b) $): $ G -> (E. x (p /\ a) <-> E. x (p /\ b)) $ = '(exeqd @ aneq2d h);
theorem rexeqda (p a b: wff x) (h: $ G /\ p -> (a <-> b) $): $ G -> (E. x (p /\ a) <-> E. x (p /\ b)) $ = '(exeqd @ aneq2da h);
theorem iex (a: wff x): $ a -> E. x a $ =
'(!! eex y (rsyl eqcom @ syl6 (mpi ax_6 exim) ax_12) ax_6);
theorem alanex (a b: wff x): $ A. x a /\ E. x b -> E. x (a /\ b) $ = '(imp @ syl exim @ alimi ian);
theorem exanal (a b: wff x): $ E. x a /\ A. x b -> E. x (a /\ b) $ = '(impcom @ syl exim @ alimi @ com12 ian);
theorem alnex (a: wff x): $ A. x ~a <-> ~(E. x a) $ = 'notnot;
theorem ngen (a: wff x) (h: $ ~a $): $ ~E. x a $ = '(notnot1 (ax_gen h));
theorem alex (a: wff x): $ A. x a <-> ~(E. x ~a) $ =
'(bitr (aleqi notnot) alnex);
theorem exnal (a: wff x): $ E. x ~a <-> ~(A. x a) $ = '(con2b alex);
theorem eal (a: wff x): $ A. x a -> a $ = '(ax_3 @ sylib exnal iex);
theorem albi: $ A. x a <-> a $ = '(ibii eal ial);
theorem exbi: $ E. x a <-> a $ = '(con1b @ bicom albi);
theorem alan1 (b: wff x): $ A. x (a /\ b) <-> a /\ A. x b $ = '(bitr alan @ aneq1i albi);
theorem alan2 (a: wff x): $ A. x (a /\ b) <-> A. x a /\ b $ = '(bitr alan @ aneq2i albi);
theorem exor (a b: wff x): $ E. x (a \/ b) <-> E. x a \/ E. x b $ =
'(bitr (noteqi (bitr (aleqi notor) alan)) notan);
theorem eximd (G) (a b: wff x) (h: $ G -> a -> b $): $ G -> E. x a -> E. x b $ = '(syl exim @ iald h);
theorem excomb (a: wff x y): $ E. x E. y a <-> E. y E. x a $ =
'(noteq @ bitr3 (aleqi alnex) @ bitr alcomb (aleqi alnex));
theorem excom (a: wff x y): $ E. x E. y a -> E. y E. x a $ = '(bi1 excomb);
theorem nexi (a: wff x) (h: $ ~a $): $ ~E. x a $ = '(mpbi alnex @ ax_gen h);
theorem nexd (a: wff x) (h: $ G -> ~a $): $ G -> ~E. x a $ = '(sylib alnex @ iald h);
theorem exim1 (a: wff) (b: wff x): $ E. x (a -> b) -> (a -> E. x b) $ = '(com12 @ eximd mpcom);

@_ local def nf {x: nat} (a: wff x): wff = $ A. x (a -> A. x a) $;
prefix nf: $F/$ prec 10;

theorem nfv: $ F/ x a $ = '(ax_gen ax_5);
theorem nfi (a: wff x) (h: $ F/ x a $): $ a -> A. x a $ = '(eal h);
theorem nfri (a: wff x) (h: $ a -> A. x a $): $ F/ x a $ = '(ax_gen h);
theorem nfeqi (a b: wff x) (h: $ a <-> b $): $ (F/ x a) <-> (F/ x b) $ = '(trud @ nfeqd @ a1i h);
theorem nfx (a b: wff x) (h1: $ a <-> b $) (h2: $ F/ x b $): $ F/ x a $ = '(bi2i (nfeqi h1) h2);
theorem nfal (a: wff x y) (h: $ F/ x a $): $ F/ x A. y a $ =
'(nfri @ syl ax_11 @ alimi @ nfi h);
theorem nfnot (a: wff x) (h: $ F/ x a $): $ F/ x ~a $ =
'(nfri @ con1 @ syl eal @ syl (con1 @ !! ax_10 x) @ eximi @ nfi h);
theorem nfim (a b: wff x) (h1: $ F/ x a $) (h2: $ F/ x b $): $ F/ x a -> b $ =
'(nfri @ cases
   (syl6 (syl (alimi ax_1) (nfi h2)) mpcom)
   (a1d @ syl (alimi absurd) @ nfi @ nfnot h1));
theorem nfan (a b: wff x) (h1: $ F/ x a $) (h2: $ F/ x b $): $ F/ x a /\ b $ = '(nfnot @ nfim h1 @ nfnot h2);
theorem nfor (a b: wff x) (h1: $ F/ x a $) (h2: $ F/ x b $): $ F/ x a \/ b $ = '(nfim (nfnot h1) h2);
theorem nfbi (a b: wff x) (h1: $ F/ x a $) (h2: $ F/ x b $): $ F/ x a <-> b $ = '(nfan (nfim h1 h2) (nfim h2 h1));
theorem nfex1 (a: wff x): $ F/ x E. x a $ = '(ax_gen ax_10);
theorem nfex (a: wff x y) (h: $ F/ x a $): $ F/ x E. y a $ = '(nfnot @ nfal @ nfnot h);
theorem nfal1 (a: wff x): $ F/ x A. x a $ = '(nfx alex @ nfnot nfex1);

theorem ialdh (a b: wff x) (h1: $ F/ x a $) (h2: $ a -> b $): $ a -> A. x b $ =
'(syl (alimi h2) (nfi h1));
theorem eexh (a b: wff x) (h1: $ F/ x b $) (h2: $ a -> b $): $ E. x a -> b $ =
'(con1 @ ialdh (nfnot h1) @ con3 h2);
theorem eexdh (a b c: wff x) (h1: $ F/ x a $) (h2: $ F/ x c $)
  (h3: $ a -> b -> c $): $ a -> E. x b -> c $ =
'(con1d @ exp @ ialdh (nfan h1 (nfnot h2)) (imp @ con3d h3));
theorem alimdh (a b c: wff x) (h1: $ F/ x a $) (h2: $ a -> b -> c $):
  $ a -> A. x b -> A. x c $ = '(syl alim @ ialdh h1 h2);
theorem aleqdh (G a b: wff x) (h1: $ F/ x G $) (h: $ G -> (a <-> b) $):
  $ G -> (A. x a <-> A. x b) $ = '(syl aleq @ ialdh h1 h);
theorem eexd (a: wff) (b: wff x) (c: wff)
  (h: $ a -> b -> c $): $ a -> E. x b -> c $ = '(eexdh nfv nfv h);
theorem eexda (a: wff) (b: wff x) (c: wff)
  (h: $ a /\ b -> c $): $ a -> E. x b -> c $ = '(eexd (exp h));
theorem eexb (a: wff x) (b: wff): $ (E. x a -> b) <-> A. x (a -> b) $ =
'(ibii (ialdh (nfim nfex1 nfv) (imim1i iex)) (eexdh nfal1 nfv eal));
theorem erexb (a b: wff x) (c: wff): $ (E. x (a /\ b) -> c) <-> A. x (a -> b -> c) $ =
'(bitr eexb @ aleqi impexp);
theorem iexeh (a: nat) (b c: wff x) (h: $ F/ x c $)
  (e: $ x = a -> (b <-> c) $): $ c -> E. x b $ =
'(mpi ax_6 @ syl exim @ ialdh h @ com12 @ bi2d e);
theorem ealeh (a: nat) (b c: wff x) (h: $ F/ x c $)
  (e: $ x = a -> (b <-> c) $): $ A. x b -> c $ =
'(ax_3 @ sylib exnal @ iexeh (nfnot h) @ noteqd e);
theorem alim1 (a) (b: wff x): $ A. x (a -> b) <-> a -> A. x b $ =
'(ibii (com12 @ alimd mpcom) (ialdh (nfim nfv nfal1) @ imim2i eal));
theorem ralim1 (a) (p b: wff x): $ A. x (p -> a -> b) <-> a -> A. x (p -> b) $ =
'(bitr (aleqi com12b) alim1);
theorem ralalcomb (p: wff x) (a: wff x y): $ A. x (p -> A. y a) <-> A. y A. x (p -> a) $ =
'(bitr3 (aleqi alim1) alcomb);
theorem ralcomb (p: wff x) (q: wff y) (a: wff x y):
  $ A. x (p -> A. y (q -> a)) <-> A. y (q -> A. x (p -> a)) $ =
'(bitr ralalcomb @ aleqi ralim1);
theorem exal (a: wff x y): $ E. x A. y a -> A. y E. x a $ = '(eexh (nfal nfex1) @ alimi iex);
theorem exral (a: wff y) (b: wff x y):
  $ E. x A. y (a -> b) -> A. y (a -> E. x b) $ = '(rsyl exal @ alimi exim1);
theorem rexal (a: wff x) (b: wff x y):
  $ E. x (a /\ A. y b) -> A. y E. x (a /\ b) $ = '(sylbir (exeqi alan1) @ exal);
theorem rexim1 (a c: wff x): $ E. x (a /\ (b -> c)) -> b -> E. x (a /\ c) $ =
'(com12 @ eximd @ anim2d mpcom);
theorem rexral (a: wff x) (b: wff y) (c: wff x y):
  $ E. x (a /\ A. y (b -> c)) -> A. y (b -> E. x (a /\ c)) $ =
'(syl exral @ eximi @ sylbir alan1 @ alimi imancom);
theorem eqerd {x} (h: $ G -> a = x -> p $): $ G -> p $ = '(mpi ax_6 @ eexd @ syl5 eqcom h);
theorem eale (a: nat) (b: wff x) (c: wff)
  (e: $ x = a -> (b <-> c) $): $ A. x b -> c $ = '(ealeh nfv e);
theorem iexdeh (a: nat) (G b: wff x) (h: $ F/ x G $)
  (e: $ G /\ x = a -> b $): $ G -> E. x b $ = '(mpi ax_6 (syl exim @ ialdh h (exp e)));
theorem iexde (G) (a: nat) (b: wff x)
  (e: $ G /\ x = a -> b $): $ G -> E. x b $ = '(iexdeh nfv e);
theorem iexdde (G b) (a: nat) (c: wff x)
  (e: $ G /\ x = a -> b -> c $): $ G -> b -> E. x c $ =
'(exp @ iexde @ imp @ imp @ com23 @ exp e);
theorem iexie (a: nat) (b: wff x) (e: $ x = a -> b $): $ E. x b $ = '(trud @ iexde @ anwr e);
theorem iexe (a: nat) (b: wff x) (c: wff)
  (e: $ x = a -> (b <-> c) $): $ c -> E. x b $ = '(iexde @ mpbird (anwr e) anl);
theorem ealdeh (a: nat) (G b c: wff x) (h1: $ F/ x G $) (h2: $ F/ x c $)
  (e: $ G /\ x = a -> b -> c $): $ G -> A. x b -> c $ =
'(con4d @ exp @ sylib exnal @ iexdeh (nfan h1 @ nfnot h2) @ anrasss @ imp @ con3d e);
theorem ealieh (a: nat) (b: wff x) (h: $ F/ x c $)
  (e: $ x = a -> b -> c $): $ A. x b -> c $ =
'(trud @ ealdeh nfv h @ anwr e);
theorem ealde (G) (a: nat) (b: wff x)
  (e: $ G /\ x = a -> b -> c $): $ G -> A. x b -> c $ = '(ealdeh nfv nfv e);
theorem ealie (a: nat) (b: wff x) (e: $ x = a -> b -> c $): $ A. x b -> c $ = '(ealieh nfv e);
theorem exan1 (a) (b: wff x): $ E. x (a /\ b) <-> a /\ E. x b $ =
'(ibii (iand (eex anl) (eximi anr)) (imp @ eximd ian));
theorem exan2 (a: wff x) (b): $ E. x (a /\ b) <-> E. x a /\ b $ =
'(bitr (exeqi ancomb) @ bitr exan1 ancomb);
theorem bian1exi (a c: wff x) (h: $ a <-> b /\ c $): $ E. x a <-> b /\ E. x c $ = '(bitr (exeqi h) exan1);
theorem bian2exi (a b: wff x) (h: $ a <-> b /\ c $): $ E. x a <-> E. x b /\ c $ = '(bitr (exeqi h) exan2);
theorem bian1exd (a c: wff x) (h: $ G -> (a <-> b /\ c) $): $ G -> (E. x a <-> b /\ E. x c) $ = '(syl6bb exan1 (exeqd h));
theorem bian2exd (a b: wff x) (h: $ G -> (a <-> b /\ c) $): $ G -> (E. x a <-> E. x b /\ c) $ = '(syl6bb exan2 (exeqd h));
theorem biexexi (a b: wff x y) (h: $ a <-> E. y b $): $ E. x a <-> E. y E. x b $ = '(bitr4 (exeqi h) excomb);
theorem biexan1a (a b: wff x) (h: $ c -> (a <-> E. x b) $): $ a /\ c <-> E. x (b /\ c) $ = '(bitr4 (aneq1a h) exan2);
theorem biexan2a (b c: wff x) (h: $ a -> (b <-> E. x c) $): $ a /\ b <-> E. x (a /\ c) $ = '(bitr4 (aneq2a h) exan1);
theorem biexan1i (a b: wff x) (h: $ a <-> E. x b $): $ a /\ c <-> E. x (b /\ c) $ = '(biexan1a @ a1i h);
theorem biexan2i (b c: wff x) (h: $ b <-> E. x c $): $ a /\ b <-> E. x (a /\ c) $ = '(biexan2a @ a1i h);
theorem rexexcomb (p: wff x) (a: wff x y):
  $ E. x (p /\ E. y a) <-> E. y E. x (p /\ a) $ = '(bitr3 (exeqi exan1) excomb);
theorem birexexi (a b: wff x y) (q: wff y) (h: $ a <-> E. y (q /\ b) $):
  $ E. x a <-> E. y (q /\ E. x b) $ = '(bitr4 (exeqi h) rexexcomb);
theorem biexrexa (p: wff x) (a b: wff x y) (h: $ p -> (a <-> E. y b) $):
  $ E. x (p /\ a) <-> E. y E. x (p /\ b) $ = '(bitr (rexeqa h) rexexcomb);
theorem biexrexi (p: wff x) (a b: wff x y) (h: $ a <-> E. y b $):
  $ E. x (p /\ a) <-> E. y E. x (p /\ b) $ = '(biexrexa @ a1i h);
theorem rexcomb (p: wff x) (q: wff y) (a: wff x y):
  $ E. x (p /\ E. y (q /\ a)) <-> E. y (q /\ E. x (p /\ a)) $ =
'(bitr rexexcomb @ exeqi @ bitr (exeqi anlass) exan1);
theorem birexan1a (p a b: wff x) (h: $ c -> (a <-> E. x (p /\ b)) $):
  $ a /\ c <-> E. x (p /\ (b /\ c)) $ = '(bitr (biexan1a h) @ exeqi anass);
theorem birexan2a (p b c: wff x) (h: $ a -> (b <-> E. x (p /\ c)) $):
  $ a /\ b <-> E. x (p /\ (a /\ c)) $ = '(bitr (biexan2a h) @ exeqi anlass);
theorem birexrexa (q: wff y) (p: wff x) (a b: wff x y) (h: $ p -> (a <-> E. y (q /\ b)) $):
  $ E. x (p /\ a) <-> E. y (q /\ E. x (p /\ b)) $ = '(birexexi @ birexan2a h);
theorem birexan1i (p a b: wff x) (h: $ a <-> E. x (p /\ b) $):
  $ a /\ c <-> E. x (p /\ (b /\ c)) $ = '(birexan1a @ a1i h);
theorem birexan2i (p b c: wff x) (h: $ b <-> E. x (p /\ c) $):
  $ a /\ b <-> E. x (p /\ (a /\ c)) $ = '(birexan2a @ a1i h);
theorem birexrexi (q: wff y) (p: wff x) (a b: wff x y) (h: $ a <-> E. y (q /\ b) $):
  $ E. x (p /\ a) <-> E. y (q /\ E. x (p /\ b)) $ = '(birexrexa @ a1i h);
theorem rexan1 (a) (p b: wff x): $ E. x (p /\ (a /\ b)) <-> a /\ E. x (p /\ b) $ =
'(bitr (exeqi anlass) exan1);
theorem rexan2 (p a: wff x) (b): $ E. x (p /\ (a /\ b)) <-> E. x (p /\ a) /\ b $ =
'(bitr3 (exeqi anass) exan2);
theorem bian1rexa (p a c: wff x) (h: $ p -> (a <-> b /\ c) $):
  $ E. x (p /\ a) <-> b /\ E. x (p /\ c) $ = '(bitr (rexeqa h) rexan1);
theorem bian2rexa (p a b: wff x) (h: $ p -> (a <-> b /\ c) $):
  $ E. x (p /\ a) <-> E. x (p /\ b) /\ c $ = '(bitr (rexeqa h) rexan2);
theorem bian1rexi (p a c: wff x) (h: $ a <-> b /\ c $):
  $ E. x (p /\ a) <-> b /\ E. x (p /\ c) $ = '(bian1rexa @ a1i h);
theorem bian2rexi (p a b: wff x) (h: $ a <-> b /\ c $):
  $ E. x (p /\ a) <-> E. x (p /\ b) /\ c $ = '(bian2rexa @ a1i h);
theorem alexan (a b: wff x): $ A. x a -> E. x b -> E. x (a /\ b) $ =
'(syl exim @ alimi ian);
theorem exifp (a b: wff x): $ E. x ifp p a b <-> ifp p (E. x a) (E. x b) $ =
'(bitr exor @ oreq exan1 exan1);

theorem cbvalh (p q: wff x y) (h1: $ F/ y p $) (h2: $ F/ x q $)
  (e: $ x = y -> (p <-> q) $): $ A. x p <-> A. y q $ =
'(ibii (ialdh (nfal h1) (ealeh h2 e))
  (ialdh (nfal h2) (ealeh h1 @ bicomd @ syl e eqcom)));
theorem cbval (p: wff x) (q: wff y)
  (e: $ x = y -> (p <-> q) $): $ A. x p <-> A. y q $ = '(cbvalh nfv nfv e);

theorem cbvexh (p q: wff x y) (h1: $ F/ y p $) (h2: $ F/ x q $)
  (e: $ x = y -> (p <-> q) $): $ E. x p <-> E. y q $ =
'(noteq (cbvalh (nfnot h1) (nfnot h2) (noteqd e)));
theorem cbvex (p: wff x) (q: wff y)
  (e: $ x = y -> (p <-> q) $): $ E. x p <-> E. y q $ = '(cbvexh nfv nfv e);

--| Not sure what to call this, let's say "positive implication".
--| It quantifies both `p` and `q` and asserts that `p` implies `q`, but not vacuously.
local def pim {x: nat} (p q: wff x): wff = $ E. x p /\ A. x (p -> q) $;
-- uses a low prec to require parens, since the binding is not obvious
notation pim {x} (p q) = ($P.$:10) x p ($->$:25) q;

theorem pimex (p q: wff x): $ (P. x p -> q) -> E. x p $ = 'anl;
theorem pimal (p q: wff x): $ (P. x p -> q) -> A. x (p -> q) $ = 'anr;
theorem pimex2 (p q: wff x): $ (P. x p -> q) -> E. x q $ = '(impcom exim);
theorem pimex12 (p q: wff x): $ (P. x p -> q) -> E. x (p /\ q) $ =
'(impcom @ syl exim @ alimi @ a2i ian);
theorem pimeq: $ (P. x p -> q) -> A. x (p -> q) $ = 'anr;
theorem pimeq1 (p1 p2 q: wff x):
  $ A. x (p1 <-> p2) -> ((P. x p1 -> q) <-> (P. x p2 -> q)) $ =
'(aneqd exeq @ syl aleq @ alimi @ imeq1d id);
theorem pimim2 (p q1 q2: wff x):
  $ A. x (q1 -> q2) -> (P. x p -> q1) -> (P. x p -> q2) $ =
'(anim2d @ al2imi imim2);
theorem pimim2i (p q1 q2: wff x) (h: $ q1 -> q2 $):
  $ (P. x p -> q1) -> (P. x p -> q2) $ = '(pimim2 @ ax_gen h);
theorem pimim2d (p q1 q2: wff x) (h: $ G -> q1 -> q2 $):
  $ G -> (P. x p -> q1) -> (P. x p -> q2) $ = '(syl pimim2 @ iald h);
theorem pimeq2a (p q1 q2: wff x):
  $ A. x (p -> (q1 <-> q2)) -> ((P. x p -> q1) <-> (P. x p -> q2)) $ =
'(aneq2d @ syl aleq @ alimi imeq2a);
theorem pimeq2 (p q1 q2: wff x):
  $ A. x (q1 <-> q2) -> ((P. x p -> q1) <-> (P. x p -> q2)) $ =
'(syl pimeq2a @ alimi ax_1);
theorem pimeq1d (G: wff) {x: nat} (p1 p2 q: wff x)
  (h1: $ G -> (p1 <-> p2) $): $ G -> ((P. x p1 -> q) <-> (P. x p2 -> q)) $ =
'(syl pimeq1 @ iald h1);
theorem pimeq2d (G: wff) {x: nat} (p q1 q2: wff x)
  (h1: $ G -> (q1 <-> q2) $): $ G -> ((P. x p -> q1) <-> (P. x p -> q2)) $ =
'(syl pimeq2 @ iald h1);
theorem pimeq1i {x: nat} (p1 p2 q: wff x)
  (h1: $ p1 <-> p2 $): $ (P. x p1 -> q) <-> (P. x p2 -> q) $ = '(trud @ pimeq1d @ a1i h1);
theorem pimeq2i {x: nat} (p q1 q2: wff x)
  (h1: $ q1 <-> q2 $): $ (P. x p -> q1) <-> (P. x p -> q2) $ = '(trud @ pimeq2d @ a1i h1);
@(register-eqd 'pim) theorem pimeqd (G: wff) {x: nat} (p1 p2 q1 q2: wff x)
  (h1: $ G -> (p1 <-> p2) $) (h2: $ G -> (q1 <-> q2) $):
  $ G -> ((P. x p1 -> q1) <-> (P. x p2 -> q2)) $ =
'(bitrd (pimeq1d h1) (pimeq2d h2));

theorem cbvpimh (p1 p2 q1 q2: wff x y)
  (h1: $ F/ y p1 $) (h2: $ F/ y q1 $) (h3: $ F/ x p2 $) (h4: $ F/ x q2 $)
  (e1: $ x = y -> (p1 <-> p2) $) (e2: $ x = y -> (q1 <-> q2) $):
  $ (P. x p1 -> q1) <-> (P. y p2 -> q2) $ =
'(aneq (cbvexh h1 h3 e1) (cbvalh (nfim h1 h2) (nfim h3 h4) (imeqd e1 e2)));
theorem cbvpim (p1 q1: wff x) (p2 q2: wff y)
  (e1: $ x = y -> (p1 <-> p2) $) (e2: $ x = y -> (q1 <-> q2) $):
  $ (P. x p1 -> q1) <-> (P. y p2 -> q2) $ =
'(cbvpimh nfv nfv nfv nfv e1 e2);

theorem piman (a b c: wff x): $ (P. x a -> b) /\ (P. x a -> c) -> (P. x a -> b /\ c) $ =
'(iand anll @ sylibr ralan @ anim anr anr);
theorem impim (a c: wff x): $ (P. x a -> b -> c) -> b -> (P. x a -> c) $ =
'(com12 @ anim2d @ alimd @ imim2d mpcom);
theorem expim (p: wff x) (q: wff x y): $ E. y (P. x p -> q) -> (P. x p -> E. y q) $ =
'(iand (rsyl (eximi anl) @ rsyl excom @ eximi @ eex id) @ syl exral @ eximi anr);
theorem rexpim (a: wff y) (p: wff x) (q: wff x y):
  $ E. y (a /\ (P. x p -> q)) -> (P. x p -> E. y (a /\ q)) $ =
'(syl expim @ eximi @ bi2a @ pimeq2d bian1);
theorem rexpim1 (a: wff x) (b: wff y) (c: wff x y):
  $ E. x (a /\ (P. y b -> c)) -> (P. y b -> E. x (a /\ c)) $ =
'(iand (eex anrl) @ rsyl (eximi @ anim2 anr) rexral);
theorem pim2im (p1 q1: wff x) (p2 q2: wff y):
  $ A. x (p1 -> (P. y p2 -> q1 -> q2)) -> (P. x p1 -> q1) -> (P. y p2 -> q2) $ =
'(impd @ com23 @ syl6ibr eexb @ al2imi @ a2d @ imim2i impim);
theorem pimtr (p: wff x) (q a: wff x y) (b: wff y):
  $ (P. x p -> a) -> A. x (a -> (P. y q -> b)) -> (P. y E. x (p /\ q) -> b) $ =
'(exp @ iand
  (syl excom @ impcom @ syl5 pimex12 @ syl exim @ alimi @
    impd @ com12 @ imim2d @ syl5 anl @ eximd ian)
  (rsyl (anim anr @ alimi @ imim2i anr) @
    sylibr (aleqi @ bitr eexb @ aleqi impexp) @ sylib ralalcomb @
    imp @ al2imi @ com12 imim2));

--| Not equal: `a != b` means `a` and `b` are distinct natural numbers.
@(add-eval @ fn (a b) (not {(eval a) = (eval b)}))
@_ def ne (a b: nat): wff = $ ~ a = b $; infixl ne: $!=$ prec 50;

theorem necom: $ a != b -> b != a $ = '(con3 eqcom);

--| Proper substitution. `[a / x] p` is `p`, with free occurrences of `x` in
--| `p` replaced by `a`. If we write `p(x)`, this may also be denoted as `p(a)`.
--| (Note that this is only provably equivalent to `p(a)`;
--| `[0 / x] (x < x + y)` is equivalent but not syntactically identical to
--| `0 < 0 + y`, and it requires a rewriting/substitution proof to show.)
def sb (a: nat) {x .y: nat} (p: wff x): wff =
  $ A. y (y = a -> A. x (x = y -> p)) $;
notation sb (a x p) = ($[$:41) a ($/$:0) x ($]$:0) p;

theorem sbq (a: nat) (b: wff x): $ x = a -> (b <-> [a / x] b) $ =
'(! ibid _ _ (al y _) (exp @ ialda @ sylc ax_12 (eqtr4d anll anr) anlr)
  (mpi ax_6 @ eexdh nfv (nfim nfal1 nfv) @ exp @ syl5 eal @
    syld (com12 @ imim1i anr) @ syl (com12 eal) @ imp eqtr4));
theorem sbqcom (a: nat) (b: wff x): $ a = x -> ([a / x] b <-> b) $ = '(bicomd @ rsyl eqcom sbq);
theorem nfsb1 (a: nat) (b: wff x): $ F/ x [a / x] b $ =
'(!! nfal _ y (nfim nfv nfal1));
theorem nfsb (a: nat y) (b: wff x y) (h: $ F/ x b $): $ F/ x [a / y] b $ =
'(!! nfal _ z (nfim nfv (nfal (nfim nfv h))));
theorem sbeq1 (a b: nat x) (c: wff x): $ a = b -> ([a / x] c <-> [b / x] c) $ =
'(!! aleqd y @ imeq1d eqeq2);
theorem sbeq1d (G: wff x) (a b: nat x) (c: wff x) (h: $ G -> a = b $):
  $ G -> ([a / x] c <-> [b / x] c) $ = '(syl sbeq1 h);
do ((derive-eq) 'sb);
theorem sbeq2i (a: nat x) (b c: wff x) (h: $ b <-> c $):
  $ [a / x] b <-> [a / x] c $ = '(trud @ sbeq2d @ a1i h);

theorem sbeht (a: nat) (b c: wff x) (h: $ F/ x c $):
  $ A. x (x = a -> (b <-> c)) -> ([a / x] b <-> c) $ =
'(eexh (nfim nfal1 (nfbi nfsb1 h))
  (exp (bitr3d (anwl sbq) (impcom eal))) ax_6);
theorem sbeh (a: nat) (b c: wff x) (h: $ F/ x c $)
  (e: $ x = a -> (b <-> c) $): $ [a / x] b <-> c $ = '(sbeht h (ax_gen e));
theorem sbet (a: nat) (b: wff x) (c: wff):
  $ A. x (x = a -> (b <-> c)) -> ([a / x] b <-> c) $ = '(sbeht nfv);
theorem sbe (a: nat) (b: wff x) (c: wff)
  (e: $ x = a -> (b <-> c) $): $ [a / x] b <-> c $ = '(sbeh nfv e);
theorem sbed (a: nat) (b: wff x) (c: wff)
  (e: $ G /\ x = a -> (b <-> c) $): $ G -> ([a / x] b <-> c) $ =
'(syl sbet @ ialda e);
theorem dfsb2 (a: nat) (b: wff x): $ [a / x] b <-> A. x (x = a -> b) $ =
'(! ibii (al y _) _
  (mpi ax_6 @ eexdh nfal1 nfv @ syl (a2i @ alimd @ imim1d @ com12 eqtr4) eal)
  (iald @ com12 @ alimd @ imim1d @ com12 eqtr));
theorem dfsb3 (a: nat) (b: wff x): $ [a / x] b <-> E. x (x = a /\ b) $ =
'(sbeh nfex1 @ syl con2b @ syl5bb (bitr4 (aleqi notan2) dfsb2) @ bicomd sbq);
theorem sbco (a: nat x) (b: wff x):
  $ [a / y] [y / x] b <-> [a / x] b $ = '(bitr dfsb2 (aleqi (imeq2i dfsb2)));
theorem sbid (a: wff x): $ [x / x] a <-> a $ =
'(! ibii (al y _) _
  (mpi ax_6 @ eexdh nfal1 nfv @ rsyl eal @ a2i @ rsyl eqcom @ com12 eal)
  (iald @ com12 @ bi1d @ syl6bb dfsb2 @ syl sbq eqcom));
theorem sbcom (p: wff x y): $ [a / x] [b / y] p <-> [b / y] [a / x] p $ =
'(bitr dfsb2 @ bitr4 (raleqi dfsb2) @ bitr dfsb2 @ bitr4 (raleqi dfsb2) ralcomb);
theorem sbth (a: nat x) (p: wff x) (h: $ p $): $ [a / x] p $ =
'(!! ax_gen y @ a1i @ ax_gen @ a1i h);
theorem sbthd (p: wff x) (h: $ G /\ x = a -> p $): $ G -> [a / x] p $ =
'(mpbiri itru @ sbed @ syl (mpi itru bith) h);
theorem sbeth (p: wff x) (h: $ p $) (e: $ x = a -> (p <-> q) $): $ q $ =
'(mpbi (sbe e) @ sbth h);
theorem sbethh (p q: wff x) (h: $ F/ x q $)
  (hp: $ p $) (e: $ x = a -> (p <-> q) $): $ q $ =
'(mpbi (sbeh h e) @ sbth hp);
theorem cbvsbh (a: nat) (p q: wff x y) (h1: $ F/ y p $) (h2: $ F/ x q $)
  (e: $ x = y -> (p <-> q) $): $ [a / x] p <-> [a / y] q $ =
'(!! aleqi z (imeq2i (cbvalh (nfim nfv h1) (nfim nfv h2) (imeqd eqeq1 e))));
theorem cbvsb (a: nat) (p: wff x) (q: wff y)
  (e: $ x = y -> (p <-> q) $): $ [a / x] p <-> [a / y] q $ = '(cbvsbh nfv nfv e);

theorem aleqe (a: nat) (p: wff x) (q: wff)
  (e: $ x = a -> (p <-> q) $): $ A. x (x = a -> p) <-> q $ = '(bitr3 dfsb2 @ sbe e);
theorem aleqed (a: nat) (p: wff x) (q: wff)
  (e: $ G /\ x = a -> (p <-> q) $): $ G -> (A. x (x = a -> p) <-> q) $ = '(syl5bbr dfsb2 @ sbed e);
theorem exeqe (a: nat) (p: wff x) (q: wff)
  (e: $ x = a -> (p <-> q) $): $ E. x (x = a /\ p) <-> q $ = '(bitr3 dfsb3 @ sbe e);
theorem exeqed (a: nat) (p: wff x) (q: wff)
  (e: $ G /\ x = a -> (p <-> q) $): $ G -> (E. x (x = a /\ p) <-> q) $ = '(syl5bbr dfsb3 @ sbed e);
theorem pimeqed (a: nat) (p: wff x) (q: wff)
  (e: $ G /\ x = a -> (p <-> q) $): $ G -> ((P. x x = a -> p) <-> q) $ = '(syl5bb (bian1 ax_6) @ aleqed e);
theorem pimeqe (a: nat) (p: wff x) (q: wff)
  (e: $ x = a -> (p <-> q) $): $ (P. x x = a -> p) <-> q $ = '(trud @ pimeqed @ anwr e);
theorem cbvals (p: wff x): $ A. x p <-> A. y ([y / x] p) $ = '(cbvalh nfv nfsb1 sbq);
theorem cbvexs (p: wff x): $ E. x p <-> E. y ([y / x] p) $ = '(cbvexh nfv nfsb1 sbq);
theorem cbvald (G) (p: wff x) (q: wff y)
  (h: $ G /\ x = y -> (p <-> q) $): $ G -> (A. x p <-> A. y q) $ =
'(bitrd (a1i cbvals) (aleqd @ syl sbet @ ialda h));
theorem cbvexd (G) (p: wff x) (q: wff y)
  (h: $ G /\ x = y -> (p <-> q) $): $ G -> (E. x p <-> E. y q) $ =
'(bitrd (a1i cbvexs) (exeqd @ syl sbet @ ialda h));

theorem pimexeqed (a: nat) (p: wff x y) (q: wff x) (p2 q2: wff y)
  (e1: $ G /\ x = a -> (p <-> p2) $)
  (e2: $ G /\ x = a -> (q <-> q2) $):
  $ G -> ((P. x E. y (x = a /\ p) -> q) <-> (P. y p2 -> q2)) $ =
'(aneqd (syl5bb excomb @ exeqd @ exeqed e1) @ syl5bb (aleqi eexb) @
  syl5bb alcomb @ aleqd @ syl5bb (aleqi impexp) @ aleqed @ imeqd e1 e2);

-- FOL mode: a natural deduction language that compiles to MM0 peano axioms
do {
  (def folmode-context (ref!))

  --| `(folmode)` initializes the FOL goal state from the MM0 goal state.
  --| For example, if the initial state is
  --|
  --|    h1: G -> a
  --|    h2: G -> b
  --|    |- G /\ c -> a /\ b
  --|
  --| then the generated FOL state will be
  --|
  --|    h1: a
  --|    h2: b
  --|    _h0: c
  --|    |- a /\ b
  --|
  --| The context is populated with all the MM0 hypotheses, as well as all
  --| antecedents of the goal implication, except for a leftmost variable called
  --| `G` or `_G`. The antecedents can be named using arguments to `(folmode)`; for
  --| example `(folmode 'hc _)` produces
  --|
  --|    h1: a
  --|    h2: b
  --|    hc: c
  --|    |- a /\ b
  --|
  --| instead.
  --|
  --| The last argument to folmode is a refine script that is passed to `(folrefine)`.
  (def (folmode . vs)
    @ match (match (split-last vs) [() '(#undef)] [r r]) @ (r . vs)
    (set! folmode-context
      (def vs (ref! vs))
      @ rmap (get-goals) @ fn (g)
      (def t (goal-type g))
      @ match (match t [('im G R) (list G R)] [_ (list #undef t)]) @ (G rhs)
      (def hs1 (rmap (local-ctx) @ fn (h)
        (def t (infer-type h))
        @ if (undef? G) '(,h (,t ,h))
        @ match t
          [('im L R) (=> break)
            @ letrec ([upgrade @ match-fn
              [(? (fn (G) {L == G})) h]
              [('an G1 D) '(anwl ,G1 ,D ,R ,(upgrade G1))]
              [_ (break)]])
            '(,h (,R ,(upgrade G)))]
          [_ '(,h (,t (a1i ,G ,t ,h)))]))
      (def hs
        @ if (undef? G) hs1
        @ letrec ([add-locals @ match-fn*
          [(('an G D) left)
            (def hsG (add-locals G left))
            (def hsD (add-locals D #f))
            @ fn (f hs)
            @ hsG (fn (v a p) (f v a '(anwl ,G ,D ,a ,p)))
            @ hsD (fn (v a p) (f v a '(anwr ,G ,D ,a ,p))) hs]
          [((or 'G '_G) #t) @ fn (f hs) (append hs1 hs)]
          [(a _)
            (def v @ match vs
              [(v . vs2) (set! vs vs2) v]
              [_
                (def n @ if (number? vs) vs 0)
                (set! vs {n + 1})
                (atom-app "_h" n)])
            @ fn (f hs) '(,(f v a '(id ,a)) . ,hs)]])
        ((add-locals G #t) (fn (v a p) '(,v (,a ,p))) ()))
      (list G (apply atom-map! hs) (rev @ map hd hs) rhs g))
    (set-close-fn folmode-end)
    (folrefine r))

  --| `(folmode-pp-goal g)` converts the FOL goal `g` to a string.
  (def folmode-pp-goal @ match-fn @ (G hm hs t g)
    (def ss @ foldr hs "" @ fn (v acc)
      @ match (lookup hm v)
      [(e _) (string-append acc (->string v) ": " (pp e) "\n")]
      [#undef acc])
    (string-append ss "|- " (pp t) "\n"))

  --| `(folstat-str)` returns the FOL goals as a string, or `#undef` if there are no goals.
  (def (folstat-str)
    @ match (apply append @ map (fn (g) (list "\n" (folmode-pp-goal g))) folmode-context)
    [()]
    [(_ . gs) @ apply string-append gs])

  --| `(folstat)` is the analogue of `(stat)` for the FOL goal state.
  (def (folstat)
    (def s (folstat-str))
    (if (def? s) (display s)))

  --| Resets the MM0 goals using the FOL goals.
  (def (folmode-reset-goals)
    (apply set-goals @ map (fn (g) (nth 4 g)) folmode-context))

  --| Closer for the FOL mode - prints all the FOL goals that have not been closed
  --| (and suppresses MM0 goal printing).
  (def (folmode-end)
    (scan folmode-context @ fn (g)
      (error-at (nth 4 g) @ folmode-pp-goal g))
    @ if (not (null? folmode-context)) @ begin
    (error @ string-append "not all goals are solved\n" (folstat-str)))

  --| `(folrefine)` runs a refine script in FOL mode. This is similar to `(refine)` but
  --| includes operations for manipulating the context using lambda-calculus
  --| inspired proof terms.
  --|
  --| * If `h` is in the context, then `h` applies it to solve the goal.
  --| * A `_` in the term generates a new subgoal.
  --| * `(ian p1 p2 ... pn)` proves `|- a1 /\ a2 /\ ... /\ an` if `pi` proves `|- ai`.
  --| * `(iim x1 ... xn p)` proves `|- a1 -> a2 -> ... -> an -> b` if
  --|   `p` is a proof of `x1: a1, x2: a2, ..., xn: an |- b`.
  --| * `(:base p)` provides `p` as an MM0 refine script.
  --| * `(p p1 ... pn)` proves `b` if `p: a1 -> a2 -> ... -> an -> b` and `pi: ai`.
  (def (folrefine . rs)
    (def newgs (ref! ()))
    (def (push . a) @ set! newgs @ cons a @ get! newgs)
    (def (im2 G e) @ if (def? G) '(im ,G ,e) e)
    @ letrec ([((folref G hm hs p) refine tgt)
      (def (im e) (im2 G e))
      (def rhs (match tgt [('im _ e) e] [_ tgt]))
      (def (app sp p ps)
        @ match (lookup hm p)
          [(t pr)
            (def mp (if (def? G) 'mpd 'ax_mp))
            @ copy-span sp @ foldl ps
              (copy-span p '{(:verb ,pr) : (:verb ,(im t))})
              (fn (acc p2) (list mp acc (folref G hm hs p2)))]
          [#undef (error-at p "unimplemented") (copy-span p '?)])
      (def out @ match p
        [('ian p1 . ps)
          (def ian (if (def? G) 'iand 'ian))
          @ foldl ps (folref G hm hs p1) @ fn (acc p2)
          @ copy-span p (list ian acc (folref G hm hs p2))]
        [('iim . ps)
          @ letrec ([(iim G hm hs ps rhs) @ match ps
            [(p) (folref G hm hs p)]
            [(x . ps2)
              @ match (match rhs
                [('im D rhs2) (list D rhs2)]
                [_ (list (copy-span x (mvar! 'wff #f)) (mvar! 'wff #f))])
                @ (D rhs2)
              (def G2 @ if (def? G) '(an ,G ,D) D)
              (def hm2 @ apply atom-map! @ rmap (rev hs) @ if (def? G)
                (fn (h) @ match (lookup hm h) [(R pr) '(,h (,R (anwl ,G ,D ,R ,pr)))])
                (fn (h) @ match (lookup hm h) [(R pr) '(,h (,R (a1i ,D ,R ,pr)))]))
              (def hs2 @ match x ['_ hs] @ _
                (insert! hm2 x @ list D @ if (def? G) '(anr ,G ,D) '(id ,D))
                (cons x hs))
              '{(exp ,(iim G2 hm2 hs2 ps2 rhs2)) : ,(im2 G '(im ,D ,rhs2))}]
            [_ (error-at p "expected > 1 argument") (copy-span p '?)]])
          (iim G hm hs ps rhs)]
        [(or '_ ('_))
          (def g (goal! p tgt))
          (push G hm hs rhs g)
          '(:verb ,g)]
        [(? atom?) (app p p ())]
        [(':base p) p]
        [((? atom? p1) . ps) (app p p1 ps)])
      (refine tgt out)])
    (def oldgs (ref! @ get! folmode-context))
    (apply refine @ rmap rs @ match-fn
      [#undef]
      [e @ match oldgs
        [((G hm hs _ _) . gs) (set! oldgs gs) (folref G hm hs e)]
        [_ (error "no more goals")]])
    (set! folmode-context @ append (rev newgs) oldgs)
    (folmode-reset-goals))
};

--| The sort of sets of natural numbers. Because we are working in
--| Peano Arithmetic, we cannot quantify over variables of this type, and these
--| should be thought of only as sugar for formulas with one free variable.
--| This is a conservative extension of PA.
strict sort set;

--| A "class abstraction" `{x | p(x)}` is the set of natural numbers `x` such that `p(x)` holds.
term ab {x: nat} (p: wff x): set;
notation ab {x: nat} (p: wff x): set = (${$:max) x ($|$:0) p ($}$:0);

--| Given a natural number `a` and a set `A`, `a e. A` (read `e.` as epsilon)
--| means `a` is in the set `A`.
term el (a: nat) (A: set): wff; infixl el: $e.$ prec 50;

--| `a` is in `{x | p(x)}` iff `p(a)` holds.
axiom elab (a: nat) {x: nat} (p: wff x): $ a e. {x | p} <-> [a / x] p $;

--| Elementhood respects equality. This is a theorem for most definitions
--| but has to be axiomatized for primitive term constructors like `e.`
--| This is Axiom 8 of predicate logic (which has an instance for every
--| primitive predicate in the language).
axiom ax_8 (a b: nat) (A: set): $ a = b -> a e. A -> b e. A $;

do (add-axiom-set! 'axs_set "Sets and elements" '(elab ax_8));

--| `A == B` is equality for sets. Two sets are equal if they have the
--| same elements.
def eqs (A B: set) {.x: nat}: wff = $ A. x (x e. A <-> x e. B) $;
infixl eqs: $==$ prec 50;

theorem eqsid: $ A == A $ = '(!! ax_gen x biid);
theorem eqscom: $ A == B -> B == A $ = '(!! alimi x bicom);
theorem eqscomb: $ A == B <-> B == A $ = '(ibii eqscom eqscom);
theorem eqstr: $ A == B -> B == C -> A == C $ = '(!! al2imi x bitr);
theorem eqstr2: $ A == B -> B == C -> C == A $ = '(syl6 eqscom eqstr);
theorem eqstr3: $ B == A -> B == C -> A == C $ = '(syl eqstr eqscom);
theorem eqstr4: $ A == B -> C == B -> A == C $ = '(syl5 eqscom eqstr);
theorem eqstr3d (h1: $ G -> B == A $) (h2: $ G -> B == C $): $ G -> A == C $ = '(sylc eqstr3 h1 h2);
theorem eqsidd (G A): $ G -> A == A $ = '(a1i eqsid);
theorem eqscomd (h: $ G -> A == B $): $ G -> B == A $ = '(syl eqscom h);
theorem eqstrd (h1: $ G -> A == B $) (h2: $ G -> B == C $): $ G -> A == C $ = '(sylc eqstr h1 h2);
theorem eqstr4d (h1: $ G -> A == B $) (h2: $ G -> C == B $): $ G -> A == C $ = '(sylc eqstr4 h1 h2);
theorem syl5eqs (h1: $ A == B $) (h2: $ G -> B == C $): $ G -> A == C $ = '(eqstrd (a1i h1) h2);
theorem syl5eqsr (h1: $ B == A $) (h2: $ G -> B == C $): $ G -> A == C $ = '(eqstr3d (a1i h1) h2);
theorem syl6eqs (h1: $ B == C $) (h2: $ G -> A == B $): $ G -> A == C $ = '(eqstrd h2 (a1i h1));
theorem syl6eqsr (h1: $ C == B $) (h2: $ G -> A == B $): $ G -> A == C $ = '(eqstr4d h2 (a1i h1));
theorem eqstr3g (h1: $ A == C $) (h2: $ B == D $) (h: $ G -> A == B $):
  $ G -> C == D $ = '(syl5eqsr h1 @ syl6eqs h2 h);
theorem eqstr4g (h1: $ C == A $) (h2: $ D == B $) (h: $ G -> A == B $):
  $ G -> C == D $ = '(syl5eqs h1 @ syl6eqsr h2 h);

theorem eleq1: $ a = b -> (a e. A <-> b e. A) $ = '(ibid ax_8 @ syl ax_8 eqcom);
theorem eleq2: $ A == B -> (a e. A <-> a e. B) $ = '(!! eale x @ bieqd eleq1 eleq1);
theorem eleq1d (h: $ G -> a = b $): $ G -> (a e. A <-> b e. A) $ = '(syl eleq1 h);
theorem eleq2d (h: $ G -> A == B $): $ G -> (a e. A <-> a e. B) $ = '(syl eleq2 h);
@(register-eqd 'el) theorem eleqd (G a b A B) (h1: $ G -> a = b $) (h2: $ G -> A == B $):
  $ G -> (a e. A <-> b e. B) $ = '(bitrd (eleq1d h1) (eleq2d h2));
do ((derive-eq) 'eqs);

theorem abeq (p q: wff x): $ A. x (p <-> q) -> {x | p} == {x | q} $ =
'(!! iald y @ bitr4g elab elab @ ealeh (nfbi nfsb1 nfsb1) (bieqd sbq sbq));
@(register-eqd 'ab) theorem abeqd (G) {x} (p q: wff x)
  (h: $ G -> (p <-> q) $): $ G -> {x | p} == {x | q} $ = '(syl abeq @ iald h);
theorem abeqi (p q: wff x) (h: $ p <-> q $): $ {x | p} == {x | q} $ = '(trud @ abeqd @ a1i h);
theorem eqri {x} (h: $ x e. A <-> x e. B $): $ A == B $ = '(ax_gen h);
theorem eqrd (G) {x} (h: $ G -> (x e. A <-> x e. B) $): $ G -> A == B $ = '(iald h);
theorem cbvabh (p q: wff x y) (h1: $ F/ y p $) (h2: $ F/ x q $)
  (e: $ x = y -> (p <-> q) $): $ {x | p} == {y | q} $ =
'(!! eqri z @ bitr4gi elab elab @ cbvsbh h1 h2 e);
theorem cbvab (p: wff x) (q: wff y)
  (e: $ x = y -> (p <-> q) $): $ {x | p} == {y | q} $ = '(cbvabh nfv nfv e);
theorem cbvabs (p: wff x): $ {x | p} == {y | [y / x] p} $ = '(cbvabh nfv nfsb1 sbq);
theorem cbvabd (G) (p: wff x) (q: wff y)
  (h: $ G /\ x = y -> (p <-> q) $): $ G -> {x | p} == {y | q} $ =
'(eqstrd (a1i cbvabs) @ abeqd @ syl sbet @ ialda h);
theorem elab2 (a: nat x) (p: wff x): $ a e. {x | p} <-> [a / x] p $ =
'(bitr (bitr (eleq2 (cbvabh nfv nfsb1 sbq)) elab) (!! sbco x y));
theorem elabe (a: nat) (p: wff x) (q: wff)
  (e: $ x = a -> (p <-> q) $): $ a e. {x | p} <-> q $ = '(bitr elab2 (sbe e));
theorem elabed (a: nat) (p: wff x) (q: wff)
  (e: $ G /\ x = a -> (p <-> q) $): $ G -> (a e. {x | p} <-> q) $ =
'(syl5bb elab2 @ sbed e);
theorem ssabed (a: nat) (p: wff x) (q: wff)
  (h: $ G /\ x = a -> p -> q $): $ G -> a e. {x | p} -> q $ =
'(syl5bi elab2 @ mpi ax_6 @ eexdh nfv (nfim nfsb1 nfv) @ exp @ syld (bi2d @ anwr sbq) h);
theorem eelabd (a: nat x) (p: wff x) (q: wff)
  (h: $ G -> p -> q $): $ G -> a e. {x | p} -> q $ =
'(syl5 (iexe eleq1) @ !! eexd y @ ssabed @ anwl h);
theorem ssabeled (a: nat) (p: wff x) (q: wff)
  (h: $ G /\ x = a -> p -> q /\ x e. A $): $ G -> a e. {x | p} -> q /\ a e. A $ =
'(ssabed @ syld h @ bi1d @ aneq2d @ eleq1d anr);
theorem abid (p: wff x): $ x e. {x | p} <-> p $ = '(bitr elab2 sbid);
theorem abid2: $ {x | x e. A} == A $ = '(!! eqri y @ elabe eleq1);

--| `A C_ B` means `A` is a subset of `B`.
@(derive-eq 'ss) def subset (A B: set): wff = $ A. x (x e. A -> x e. B) $;
infixl subset: $C_$ prec 50;

theorem dfss: $ A C_ B <-> A. x (x e. A -> x e. B) $ = 'biid;
theorem ssel: $ A C_ B -> a e. A -> a e. B $ = '(!! eale x @ imeqd eleq1 eleq1);
theorem sseld (h1: $ G -> A C_ B $) (h2: $ G -> a e. A $): $ G -> a e. B $ = '(sylc ssel h1 h2);
theorem ssid: $ A C_ A $ = '(!! ax_gen x id);
theorem sstr: $ A C_ B -> B C_ C -> A C_ C $ =
'(exp @ !! iald x @ syld (anwl ssel) (anwr ssel));
theorem eqss: $ A == B -> A C_ B $ = '(mpbii ssid sseq2);
theorem eqssr: $ A == B -> B C_ A $ = '(mpbii ssid sseq1);
theorem ssasym: $ A C_ B -> B C_ A -> A == B $ = '(!! al2imi x ian);
theorem ssasymd (h1: $ G -> A C_ B $) (h2: $ G -> B C_ A $): $ G -> A == B $ = '(sylc ssasym h1 h2);
theorem ssasymb: $ A == B <-> A C_ B /\ B C_ A $ = '(ibii (iand eqss eqssr) (imp ssasym));

--| `A i^i B` is the intersection of sets `A` and `B`.
@(derive-eq 'in) def Inter (A B: set): set = $ {x | x e. A /\ x e. B} $;
infixl Inter: $i^i$ prec 70;

theorem elin: $ a e. A i^i B <-> a e. A /\ a e. B $ = '(!! elabe x @ aneqd eleq1 eleq1);

theorem incom: $ A i^i B == B i^i A $ = '(!! eqri x @ bitr elin @ bitr4 ancomb elin);
theorem inass: $ (A i^i B) i^i C == A i^i (B i^i C) $ =
'(!! eqri x @ bitr4 elin @ bitr4 elin @ bitr4 (aneq1i elin) @ bitr4 (aneq2i elin) anass);

theorem inss1: $ A i^i B C_ A $ = '(!! ax_gen x @ sylbi elin anl);
theorem inss2: $ A i^i B C_ B $ = '(mpbi (sseq1 incom) inss1);
theorem ssin: $ A C_ B i^i C <-> A C_ B /\ A C_ C $ =
'(ibii (iand (mpi inss1 sstr) (mpi inss2 sstr)) @
  !! iald x @ exp @ sylibr elin @ iand (sseld anll anr) (sseld anlr anr));
theorem ssin1: $ A C_ B -> A i^i C C_ B i^i C $ = '(sylibr ssin @ iand (sstr inss1) (a1i inss2));
theorem ssin2: $ B C_ C -> A i^i B C_ A i^i C $ = '(sylibr ssin @ iand (a1i inss1) (sstr inss2));

theorem eqin1: $ A C_ B <-> A i^i B == A $ =
'(ibii (ssasymd (a1i inss1) @ sylibr ssin @ iand (a1i ssid) id) (mpbii inss2 sseq1));
theorem eqin2: $ A C_ B <-> B i^i A == A $ = '(bitr eqin1 @ eqseq1 incom);

--| `A u. B` is the union of sets `A` and `B`.
@(derive-eq 'un) def Union (A B: set): set = $ {x | x e. A \/ x e. B} $;
infixl Union: $u.$ prec 64;

theorem elun: $ a e. A u. B <-> a e. A \/ a e. B $ = '(!! elabe x @ oreqd eleq1 eleq1);
theorem uncom: $ A u. B == B u. A $ = '(!! eqri x @ bitr elun @ bitr4 orcomb elun);
theorem unass: $ (A u. B) u. C == A u. (B u. C) $ =
'(!! eqri x @ bitr4 elun @ bitr4 elun @ bitr4 (oreq1i elun) @ bitr4 (oreq2i elun) orass);
theorem indi: $ A i^i (B u. C) == (A i^i B) u. (A i^i C) $ =
'(!! eqri x @ bitr4 elin @ bitr4 elun @ bitr4 (aneq2i elun) @ bitr4 (oreq elin elin) andi);
theorem indir: $ (A u. B) i^i C == (A i^i C) u. (B i^i C) $ =
'(eqstr4 incom @ eqstr4 (uneq incom incom) indi);
theorem inindi: $ A i^i (B i^i C) == (A i^i B) i^i (A i^i C) $ =
'(!! eqri x @ bitr4 elin @ bitr4 elin @ bitr4 (aneq2i elin) @ bitr4 (aneq elin elin) anandi);
theorem undi: $ A u. (B i^i C) == (A u. B) i^i (A u. C) $ =
'(!! eqri x @ bitr4 elun @ bitr4 elin @ bitr4 (oreq2i elin) @ bitr4 (aneq elun elun) ordi);
theorem undir: $ (A i^i B) u. C == (A u. C) i^i (B u. C) $ =
'(eqstr4 uncom @ eqstr4 (ineq uncom uncom) undi);

theorem ssun1: $ A C_ A u. B $ = '(!! ax_gen x @ sylibr elun orl);
theorem ssun2: $ B C_ A u. B $ = '(mpbi (sseq2 uncom) ssun1);
theorem elun1: $ a e. A -> a e. A u. B $ = '(ssel ssun1);
theorem elun2: $ a e. B -> a e. A u. B $ = '(ssel ssun2);
theorem unss: $ A u. B C_ C <-> A C_ C /\ B C_ C $ =
'(ibii (iand (sstr ssun1) (sstr ssun2)) @
  !! iald x @ syl5bi elun @ eord (anwl ssel) (anwr ssel));
theorem unss1: $ A C_ B -> A u. C C_ B u. C $ = '(sylibr unss @ iand (mpi ssun1 sstr) (a1i ssun2));
theorem unss2: $ B C_ C -> A u. B C_ A u. C $ = '(sylibr unss @ iand (a1i ssun1) (mpi ssun2 sstr));

theorem equn1: $ A C_ B <-> A u. B == B $ =
'(ibii (ssasymd (sylibr unss @ iand id (a1i ssid)) (a1i ssun2)) (mpbii ssun1 sseq2));
theorem equn2: $ A C_ B <-> B u. A == B $ = '(bitr equn1 @ eqseq1 uncom);

--| `Compl A` is the complement of `A`, the set of all elements not in `A`.
@(derive-eq 'cpl) def Compl (A: set): set = $ {x | ~x e. A} $;

theorem elcpl: $ a e. Compl A <-> ~a e. A $ = '(!! elabe x @ noteqd eleq1);

theorem sscpl: $ B C_ A <-> Compl A C_ Compl B $ =
'(!! aleqi x @ bitr4 con3bi @ imeqi elcpl elcpl);
theorem cplcpl: $ Compl (Compl A) == A $ =
'(!! eqri x @ bitr elcpl @ bitr4 (noteq elcpl) notnot);
theorem cplinj: $ A == B <-> Compl A == Compl B $ =
'(ibii cpleq @ sylib (eqseq cplcpl cplcpl) cpleq);
theorem cplin: $ Compl (A i^i B) == Compl A u. Compl B $ =
'(!! eqri x @ bitr elcpl @ bitr4 (noteq elin) @ bitr elun @ bitr4 (oreq elcpl elcpl) notan);
theorem cplun: $ Compl (A u. B) == Compl A i^i Compl B $ =
'(eqstr (cpleq @ eqstr2 cplin @ uneq cplcpl cplcpl) cplcpl);

--| `Univ`, or `_V` is the set of all natural numbers.
def Univ: set = $ {x | T.} $; prefix Univ: $_V$ prec max;

theorem elv: $ a e. _V $ = '(mpbir (!! elabe x biidd) itru);
theorem inv1: $ _V i^i A == A $ = '(!! eqri x @ bitr elin @ bian1 elv);
theorem inv2: $ A i^i _V == A $ = '(eqstr incom inv1);
theorem uncpl2: $ A u. Compl A == _V $ =
'(!! eqri x @ bith (mpbir elun @ mpbir (oreq2i elcpl) em) elv);
theorem uncpl1: $ Compl A u. A == _V $ = '(eqstr uncom uncpl2);
theorem ssv2: $ A C_ _V $ = '(!! ax_gen x @ a1i elv);
theorem ssv1: $ _V C_ A <-> A == _V $ = '(ibii (ssasym ssv2) (mpbiri ssid sseq2));

local def nfs {x: nat} (A: set x): wff = $ A. y (F/ x y e. A) $;
prefix nfs: $FS/$ prec 10;
local def nfn {x: nat} (a: nat x): wff = $ A. y (F/ x y = a) $;
prefix nfn: $FN/$ prec 10;

theorem nfsbid (G) {x} (A B: set x) (h: $ G -> A == B $):
  $ G -> ((FS/ x A) <-> (FS/ x B)) $ = '(!! aleqd y @ nfeqd @ eleq2d h);
theorem nfnbid (G) {x} (a b: nat x) (h: $ G -> a = b $):
  $ G -> ((FN/ x a) <-> (FN/ x b)) $ = '(!! aleqd y @ nfeqd @ eqeq2d h);
theorem nfsv: $ FS/ x A $ = '(!! ax_gen y nfv);
theorem nfnv: $ FN/ x a $ = '(!! ax_gen y nfv);
theorem nfsri {x y} (A: set x) (h: $ F/ x y e. A $): $ FS/ x A $ = '(ax_gen h);
theorem nfnri {x y} (a: nat x) (h: $ F/ x y = a $): $ FN/ x a $ = '(ax_gen h);
theorem nfel2 (a: nat) (A: set x) (h: $ FS/ x A $): $ F/ x a e. A $ = '(!! eale y (nfeqd eleq1) h);
theorem nfsx (A B: set x) (h1: $ A == B $) (h2: $ FS/ x B $): $ FS/ x A $ =
'(!! ax_gen y @ nfx (eleq2 h1) @ nfel2 h2);
theorem nf_eq (a b: nat x) (h1: $ FN/ x a $) (h2: $ FN/ x b $): $ F/ x a = b $ =
'(nfx (bicom @ !! exeqe y eqeq1) (nfex @ nfan (eal h1) (eal h2)));
theorem nfeq2 (b: nat x) (h: $ FN/ x b $): $ F/ x a = b $ = '(nf_eq nfnv h);
theorem nfsb1h (a: nat x) (b: wff x) (h: $ FN/ x a $): $ F/ x [a / x] b $ =
'(!! nfal _ z (nfim (nfeq2 h) nfal1));
theorem nfsbh (a: nat x y) (b: wff x y) (h1: $ FN/ x a $) (h2: $ F/ x b $): $ F/ x [a / y] b $ =
'(!! nfal _ z (nfim (nfeq2 h1) (nfal (nfim nfv h2))));
theorem nfel (a: nat x) (A: set x) (h1: $ FN/ x a $) (h2: $ FS/ x A $): $ F/ x a e. A $ =
'(nfx (bicom @ !! exeqe y eleq1) (nfex @ nfan (eal h1) (eal h2)));
theorem nfab1 (p: wff x): $ FS/ x {x | p} $ = '(!! nfsri _ y @ nfx elab nfsb1);
theorem nfab (p: wff x y) (h: $ F/ x p $): $ FS/ x {y | p} $ = '(!! nfsri _ z @ nfx elab @ nfsb h);
theorem nfeqs (A B: set x) (h1: $ FS/ x A $) (h2: $ FS/ x B $): $ F/ x A == B $ =
'(!! nfal _ y @ nfbi (nfel2 h1) (nfel2 h2));
theorem nfnx (a b: nat x) (h1: $ a = b $) (h2: $ FN/ x b $): $ FN/ x a $ =
'(!! nfnri _ y @ nfx (eqeq2 h1) @ nfeq2 h2);
theorem nfin (A B: set x) (h1: $ FS/ x A $) (h2: $ FS/ x B $): $ FS/ x A i^i B $ =
'(!! nfab _ y @ nfan (nfel2 h1) (nfel2 h2));
theorem nfss (A B: set x) (h1: $ FS/ x A $) (h2: $ FS/ x B $): $ F/ x A C_ B $ =
'(!! nfal _ y @ nfim (nfel2 h1) (nfel2 h2));

theorem abeqb (p q: wff x): $ A. x (p <-> q) <-> {x | p} == {x | q} $ =
'(ibii abeq (ialdh (nfeqs nfab1 nfab1) (sylib (bieq abid abid) eleq2)));
theorem eqab2d (p: wff x) (h: $ G -> (x e. A <-> p) $): $ G -> A == {x | p} $ =
'(sylib (!! cbvalh _ y nfv (nfbi nfv @ nfel2 nfab1) @ bieqd eleq1 @ syl5bbr abid eleq1) (iald h));
theorem eqab2i (p: wff x) (h: $ x e. A <-> p $): $ A == {x | p} $ = '(trud @ eqab2d @ a1i h);
theorem eqab1d (p: wff x) (h: $ G -> (p <-> x e. A) $): $ G -> {x | p} == A $ = '(eqscomd @ eqab2d @ bicomd h);
theorem eqab1i (p: wff x) (h: $ p <-> x e. A $): $ {x | p} == A $ = '(trud @ eqab1d @ a1i h);
theorem ssab (p q: wff x): $ A. x (p -> q) <-> {x | p} C_ {x | q} $ =
'(!! cbvalh _ y nfv (nfim (nfel2 nfab1) (nfel2 nfab1)) @
  imeqd (syl6bbr elab sbq) (syl6bbr elab sbq));
theorem ssabi (p q: wff x) (h: $ p -> q $): $ {x | p} C_ {x | q} $ = '(mpbi ssab @ ax_gen h);
theorem ssabd (p q: wff x) (h: $ G -> p -> q $): $ G -> {x | p} C_ {x | q} $ = '(sylib ssab @ iald h);
theorem ssab1 (p: wff x): $ A. x (p -> x e. A) <-> {x | p} C_ A $ =
'(!! cbvalh _ y nfv (nfim (nfel2 nfab1) nfv) @ imeqd (syl6bbr elab sbq) eleq1);
theorem ssab2 (p: wff x): $ A. x (x e. A -> p) <-> A C_ {x | p} $ =
'(!! cbvalh _ y nfv (nfim nfv (nfel2 nfab1)) @ imeqd eleq1 (syl6bbr elab sbq));
theorem elabed1 (p: wff x) (e: $ G /\ x = a -> (a e. A <-> p) -> P $): $ G -> A == {x | p} -> P $ =
'(mpi ax_6 @ eexdh nfv (nfim (nfeqs nfsv nfab1) nfv) @
  exp @ syld (syl5ibrcom (bieq1d eleq2) @ bitr3d (eleq1d anr) (a1i abid)) e);
theorem elabed2 (p: wff x) (e: $ G /\ x = a -> (p <-> q) $): $ G -> A == {x | p} -> (a e. A <-> q) $ =
'(elabed1 @ bi1d @ bieq2d e);

--| Substitution for sets. `S[a / x] A` is the set `A` when
--| free variable `x` is evaluated at `a`.
def sbs (a: nat) {x .y: nat} (A: set x): set = $ {y | [a / x] y e. A} $;
notation sbs (a: nat) {x: nat} (A: set x): set = ($S[$:99) a ($/$:0) x ($]$:0) A;

theorem elsbs (a: nat x) (b: nat) (A: set x): $ b e. S[a / x] A <-> [a / x] b e. A $ =
'(bitr (!! elab y) @ sbe @ sbeq2d eleq1);
theorem sbsq (a: nat) (A: set x): $ x = a -> A == S[a / x] A $ =
'(!! eqrd y @ syl6bbr elsbs sbq);
theorem nfsbs1h (a: nat x) (A: set x) (h: $ FN/ x a $): $ FS/ x S[a / x] A $ =
'(!! nfsri _ y (nfx elsbs @ nfsb1h h));
theorem nfsbs1 (a: nat) (A: set x): $ FS/ x S[a / x] A $ =
'(nfsbs1h nfnv);
theorem nfsbsh (a: nat x) (A: set x y) (h1: $ FN/ x a $) (h2: $ FS/ x A $): $ FS/ x S[a / y] A $ =
'(!! nfsri _ z @ nfx elsbs @ nfsbh h1 @ nfel2 h2);
theorem nfsbs (a: nat) (A: set x y) (h: $ FS/ x A $): $ FS/ x S[a / y] A $ = '(nfsbsh nfnv h);
theorem sbseq1d (G) (a b: nat) (A: set x) (h: $ G -> a = b $):
  $ G -> S[a / x] A == S[b / x] A $ = '(!! abeqd y (sbeq1d h));
theorem sbseq2d (G) (a: nat x) (A B: set x)
  (h: $ G -> A == B $): $ G -> S[a / x] A == S[a / x] B $ =
'(!! abeqd y (sbeq2d (eleq2d h)));
@(register-eqd 'sbs) theorem sbseqd (G) {x} (a b: nat) (A B: set x)
  (h1: $ G -> a = b $) (h2: $ G -> A == B $):
  $ G -> S[a / x] A == S[b / x] B $ = '(eqstrd (sbseq1d h1) (sbseq2d h2));
theorem sbseht (a: nat) (A B: set x) (h: $ FS/ x B $):
  $ A. x (x = a -> A == B) -> S[a / x] A == B $ =
'(!! eqrd y @ syl5bb elsbs @ syl (sbeht @ nfel2 h) @ alimi @ imim2 eleq2);
theorem sbsco (a: nat) (A: set x): $ S[a / y] S[y / x] A == S[a / x] A $ =
'(!! abeqi z @ bitr (sbeq2i elsbs) sbco);
theorem sbseh (a: nat) (A B: set x) (h: $ FS/ x B $)
  (e: $ x = a -> A == B $): $ S[a / x] A == B $ = '(sbseht h (ax_gen e));
theorem sbset (a: nat) (A: set x) (B: set):
  $ A. x (x = a -> A == B) -> S[a / x] A == B $ = '(sbseht nfsv);
theorem sbse (a: nat) (A: set x) (B: set)
  (e: $ x = a -> A == B $): $ S[a / x] A == B $ = '(sbseh nfsv e);
theorem sbsed (a: nat) (A: set x) (B: set)
  (e: $ G /\ x = a -> A == B $): $ G -> S[a / x] A == B $ =
'(syl sbset @ ialda e);
theorem sbsid (A: set x): $ S[x / x] A == A $ =
'(!! eqri y @ bitr elsbs sbid);
theorem nfslem {y} (A: set y) (a: nat x) (B: set x)
  (e: $ y = a -> A == B $) (h: $ FN/ x a $): $ FS/ x B $ =
'(nfsx (eqscom @ sbse e) @ nfsbsh h nfsv);

@_ local def If (p: wff) (A B: set): set = $ {n | ifp p (n e. A) (n e. B)} $;

theorem Ifpos: $ p -> If p A B == A $ = '(!! eqab1d n ifppos);
theorem Ifneg: $ ~p -> If p A B == B $ = '(!! eqab1d n ifpneg);

theorem Ifid: $ If p A A == A $ = '(cases Ifpos Ifneg);
theorem Ifeq2a: $ (p -> A == B) -> If p A C == If p B C $ =
'(casesd (imim2i Ifeq2) (a1i @ eqstr4d Ifneg Ifneg));
theorem Ifeq3a: $ (~p -> B == C) -> If p A B == If p A C $ =
'(casesd (a1i @ eqstr4d Ifpos Ifpos) (imim2i Ifeq3));

@_ local def eu {x: nat} (p: wff x): wff = $ E. y A. x (p <-> x = y) $;

--| `0` is a natural number.
@(add-eval 0) term d0: nat; prefix d0: $0$ prec max;
--| The successor operation: `suc n` is a natural number when `n` is.
@(add-eval @ fn (a) {(eval a) + 1})
term suc (n: nat): nat;

@(add-eval) def d1:  nat = $suc 0$; prefix d1:  $1$  prec max;
@(add-eval) def d2:  nat = $suc 1$; prefix d2:  $2$  prec max;
@(add-eval) def d3:  nat = $suc 2$; prefix d3:  $3$  prec max;
@(add-eval) def d4:  nat = $suc 3$; prefix d4:  $4$  prec max;
@(add-eval) def d5:  nat = $suc 4$; prefix d5:  $5$  prec max;
@(add-eval) def d6:  nat = $suc 5$; prefix d6:  $6$  prec max;
@(add-eval) def d7:  nat = $suc 6$; prefix d7:  $7$  prec max;
@(add-eval) def d8:  nat = $suc 7$; prefix d8:  $8$  prec max;
@(add-eval) def d9:  nat = $suc 8$; prefix d9:  $9$  prec max;
@(add-eval) def d10: nat = $suc 9$; prefix d10: $10$ prec max;

--| Zero is not a successor. Axiom 1 of Peano Arithmetic.
axiom peano1 (a: nat): $ suc a != 0 $;
--| The successor function is injective. Axiom 2 of Peano Arithmetic.
axiom peano2 (a b: nat): $ suc a = suc b <-> a = b $;
--| The induction axiom of Peano Arithmetic. If `p(0)` is true,
--| and `p(x)` implies `p(suc x)` for all `x`, then `p(x)` is true for all `x`.
axiom peano5 {x: nat} (p: wff x):
  $ [0 / x] p -> A. x (p -> [suc x / x] p) -> A. x p $;

theorem d1ne0: $ 1 != 0 $ = 'peano1;
theorem d2ne0: $ 2 != 0 $ = 'peano1;
theorem suceq: $ a = b -> suc a = suc b $ = '(bi2 peano2);
@(register-eqd 'suc) theorem suceqd
  (h: $ G -> a = b $): $ G -> suc a = suc b $ = '(syl suceq h);

theorem ind {x y} (a: nat y) (px: wff x) (p0 pa py ps: wff y)
  (ha: $ x = a -> (px <-> pa) $)
  (h0: $ x = 0 -> (px <-> p0) $)
  (hy: $ x = y -> (px <-> py) $)
  (hs: $ x = suc y -> (px <-> ps) $)
  (h1: $ p0 $) (h2: $ py -> ps $): $ pa $ =
'(eale ha @ peano5
  (mpbir (sbe h0) h1)
  (mpbir (cbvalh nfv (nfim nfv nfsb1) @ imeqd hy @ sbeq1d suceq)
    (ax_gen @ rsyl h2 @ bi2i @ sbe hs)));

theorem indd (G) {x y} (a: nat y) (px: wff x) (p0 pa py ps: wff y)
  (ha: $ x = a -> (px <-> pa) $)
  (h0: $ x = 0 -> (px <-> p0) $)
  (hy: $ x = y -> (px <-> py) $)
  (hs: $ x = suc y -> (px <-> ps) $)
  (h1: $ G -> p0 $) (h2: $ G /\ py -> ps $): $ G -> pa $ =
'(ind (imeq2d ha) (imeq2d h0) (imeq2d hy) (imeq2d hs) h1 (a2i (exp h2)));

--| `(induct th x . ps)` uses `eqtac` to prove the substitution subgoals of an
--| induction-like theorem.
--| * `th`: the induction lemma
--| * `x`: the variable to induct on
--| * `xs`: the inductive subproofs (the base case and induction step)
do (def (induct a c . xs)
  (copy-span a @ append a @ cons (eqtac-gen c) eqtac eqtac eqtac xs));

--| `(mk-ind th t . ps)` uses `eqtac` to prove the substitution subgoals of an
--| induction-like theorem.
--| * `th`: the induction lemma
--| * `t`: the theorem being proven by induction
--| * `xs`: the inductive subproofs (the base case and induction step)
do (def (mk-ind a e . xs)
  (copy-span a @ append a @ cons '{,eqtac : $ _ -> (,e <-> _) $} eqtac eqtac eqtac xs));

theorem sucne0: $ a = suc b -> a != 0 $ = '(mpbiri peano1 neeq1);
theorem exsuc (a: nat): $ a != 0 <-> E. x a = suc x $ =
'(ibii
  (! ind y z _ $ y != 0 -> E. x y = suc x $ _ _ _ _
    (imeqd (noteqd eqeq1) (exeqd eqeq1)) (imeqd (noteqd eqeq1) (exeqd eqeq1))
    (imeqd (noteqd eqeq1) (exeqd eqeq1)) (imeqd (noteqd eqeq1) (exeqd eqeq1))
    (absurdr eqid) (a1i (a1i (iexe (eqeq2d suceq) eqid))))
  (eex sucne0));

theorem eqsucext: $ a = b <-> A. x (a = suc x <-> b = suc x) $ =
'(ibii (iald eqeq1) @
  casesd (exp @ eqtr4d anr @ imp @ con4d @ bi2d @ bitr4g exsuc exsuc exeq) @
  syl5bi exsuc @ sylibr eexb @ alimi @ exp @ eqtr4d anr @ imp bi1);

--| The definite description operator: `the A` is the value `a` such that
--| `A = {a}`, if there is such a value, otherwise `0`.
term the (A: set): nat;
--| The positive case of definite description: `A = {a}` then `the A = a`.
axiom theid {x: nat} (A: set) (a: nat): $ A == {x | x = a} -> the A = a $;
--| The negative case of definite description: if `A` is not a singleton then `the A = 0`.
axiom the0 {x y: nat} (A: set): $ ~E. y A == {x | x = y} -> the A = 0 $;

do (add-axiom-set! 'axs_the "Definite description" '(theid the0));

@(register-eqd 'the) theorem theeqd (G A B)
  (h: $ G -> A == B $): $ G -> the A = the B $ =
'(! casesd _ $ E. y A == {x | x = y} $ _
  (eexda @ eqtr4d (anwr theid) @ syl theid @ imp @ syl eqstr3 h)
  (exp @ eqtr4d (anwr the0) @ syl the0 @ impbi @ noteqd @ exeqd @ eqseq1d h));
theorem theeq: $ A == B -> the A = the B $ = '(theeqd id);
theorem eqthed {x} (h: $ G -> (x e. A <-> x = a) $): $ G -> the A = a $ =
'(syl (!! theid z) @ eqrd @ syl6bbr (elabe eqeq1) h);
theorem eqtheabd (p: wff x) (h: $ G -> (p <-> x = a) $): $ G -> the {x | p} = a $ =
'(!! eqthed y @ syl5bb elab @
  rsyl (iald h) @ ealeh (nfbi nfsb1 nfv) @ bieqd sbq eqeq1);

theorem eqthe0d {x} (h: $ G -> x e. A -> x = 0 $): $ G -> the A = 0 $ =
(focus
  '(casesd (eexda _) (a1i (!! the0 y x)))
  '(syl theid @ eqstrd anr @ syl (abeqd eqeq2) _)
  '(mpd (mpbiri (mpbir (elabe eqeq1) eqid) (anwr eleq2)) (anwl h)));
theorem eqthe0abd (p: wff x) (h: $ G -> p -> x = 0 $): $ G -> the {x | p} = 0 $ =
'(!! eqthe0d y @ syl5bi elab @
  rsyl (iald h) @ ealeh (nfim nfsb1 nfv) @ imeqd sbq eqeq1);

theorem eqtheb: $ a = the A <-> (A == {x | x = a} \/ ~E. y A == {x | x = y} /\ a = 0) $ =
'(ibii
  (casesda
    (imp @ eexdh nfv (nfor nfv @ nfan (nfnot nfex1) nfv) @ exp @ orld @ mpbird
      (syl (eqseq2d @ abeqd eqeq2) @ eqtrd anl @ anwr theid) anr)
    (orrd @ iand anr @ eqtrd anl @ anwr the0))
  (eor (eqcomd theid) (eqtrd anr @ anwl @ eqcomd the0)));

theorem nfthe (A: set x) (h: $ FS/ x A $): $ FN/ x the A $ =
'(!! nfnri _ y (nfx (!! eqtheb u v)
  (nfor (nfeqs h nfsv) (nfan (nfnot (nfex (nfeqs h nfsv))) nfv))));

--| Variation on "the" that returns an optional value.
--| `theo A = suc a` if `A = {a}` and `theo A = 0` otherwise
@_ local def theo (A: set): nat = $ the {x | E. y (x = suc y /\ y e. A)} $;
theorem theoid1 {x: nat} (A: set) (a: nat): $ A == {x | x = a} -> theo A = suc a $ =
(named '(eqtheabd @ ibid
  (eexda @ eqtrd anrl @ suceqd @ sylib (elabe eqeq1) @ mpbid (eleq2d anl) anrr)
  (exp @ sylan (iexe @ aneqd (eqeq2d suceq) eleq1) anr @
    mpbiri (mpbir (elabe eqeq1) eqid) (eleq2d anl))));

theorem theo01 {x: nat} (A: set): $ ~E. y A == {x | x = y} -> theo A = 0 $ =
(named @ focus
  '(syl the0 @ con3 @ !! eex n @ sylbir (bitr abeqb @ eqseq2 @ cbvab eqeq1) @
    mpd (rsyl (eale @ bieqd (exeqd @ aneq1d eqeq1) eqeq1) @
        sylibr (cbvex @ aneqd (eqeq2d suceq) eleq1) (mpi eqid bi2)) @
      eximd @ exp @ eqab2d @ ibida _ (mpbird (eleq1d anr) (anwl anrr)))
  (have 'h '(anwll @ rsyl (alimi @ sylib eexb bi1) @ rsyl ax_11 @ alimi @
    syl (imim1i @ ian eqid) @ eale @ imeqd (aneq1d eqeq1) eqeq1))
  (def (h x) '(sylc (eale @ imeqd eleq1 @ eqeq1d suceq) h ,x))
  '(sylib peano2 @ eqtr4d ,(h 'anr) ,(h '(anwl anrr))));

theorem theoid {x: nat} (A: set) (a: nat): $ A == {x | x = a} <-> theo A = suc a $ =
(named '(ibii theoid1 @ mpd (rsyl sucne0 @ con1 theo01) @ eexda @
  eqstrd anr @ syl (abeqd eqeq2) @ sylib peano2 @ eqtr3d (anwr theoid1) anl));

theorem theo0 {x y: nat} (A: set): $ ~E. y A == {x | x = y} <-> theo A = 0 $ =
'(ibii theo01 @ con2 @ eex @ syl sucne0 theoid1);

@_ local def subsn (A: set) = $ A. x A. y (x e. A -> y e. A -> x = y) $;

theorem subsni (h: $ G -> subsn A $) (h1: $ G -> a e. A $) (h2: $ G -> b e. A $): $ G -> a = b $ =
'(mpd h2 @ mpd h1 @ mpd h @ !! ealde x @ !! ealde y @
  bi1d @ imeqd (eleq1d anlr) @ imeqd (eleq1d anr) @ eqeqd anlr anr);

theorem subsnss: $ A C_ B -> subsn B -> subsn A $ =
'(!! alimd x @ !! alimd y @ imimd ssel @ imim1d ssel);

theorem subsnsn2: $ subsn {x | x = a} $ =
'(!! ax_gen u @ !! ax_gen v @ exp @
  eqtr4d (sylib (elabe eqeq1) anl) (sylib (elabe eqeq1) anr));

theorem eqsubsnd {x} (h: $ G -> x e. A -> x = a $): $ G -> subsn A $ =
'(sylc subsnss (sylib ssab2 @ iald h) @ a1i subsnsn2);

theorem eqsubsnabd (p: wff x) (h: $ G -> p -> x = a $): $ G -> subsn {x | p} $ =
'(sylc subsnss (ssabd h) @ a1i subsnsn2);

theorem subsnthe: $ subsn A -> a e. A -> the A = a $ =
(named '(exp @ eqthed @ ibida (subsni anll anr anlr) @ mpbird (eleq1d anr) anlr));

theorem subsnex: $ subsn A <-> E. a A. x (x e. A -> x = a) $ =
(named '(ibii (syl (iexe ,eqtac) @ iald @ syl6 eqcom subsnthe)
  (eex @ eqsubsnd @ eale ,eqtac)));

theorem subsntheo: $ subsn A -> (theo A = suc a <-> a e. A) $ =
'(syl5bbr theoid @ ibid
  (a1i @ mpbiri (mpbir (!! elabe x eqeq1) eqid) eleq2)
  (exp @ eqab2d @ ibida (subsni anll anr anlr) (mpbird (eleq1d anr) anlr)));

--| Substitution for numbers. If `b(x)` is an expression denoting a natural number,
--| with free `x`, then `N[a / x] b` is the term `b(a)`.
def sbn (a: nat) {x: nat} (b: nat x): nat = $ the {y | [a / x] y = b} $;
notation sbn (a: nat) {x: nat} (b: nat x): nat = ($N[$:99) a ($/$:0) x ($]$:0) b;
do { (add-eqd-thm 'sbn) (add-eq-thm 'sbn) };

theorem sbnq (a: nat) (b: nat x): $ x = a -> b = N[a / x] b $ =
'(eqcomd @ !! eqtheabd y @ bicomd sbq);
theorem nfsbn1h (a b: nat x) (h: $ FN/ x a $): $ FN/ x N[a / x] b $ =
'(nfthe @ !! nfab _ y @ nfsb1h h);
theorem nfsbn1 (a: nat) (b: nat x): $ FN/ x N[a / x] b $ =
'(nfsbn1h nfnv);
theorem nfsbnh (a b: nat x y) (h1: $ FN/ x a $) (h2: $ FN/ x b $): $ FN/ x N[a / y] b $ =
'(nfthe @ !! nfab _ z @ nfsbh h1 @ nfeq2 h2);
theorem nfsbn (a: nat) (b: nat x y) (h: $ FN/ x b $): $ FN/ x N[a / y] b $ = '(nfsbnh nfnv h);
theorem sbneq2d (G) (a b c: nat x)
  (h: $ G -> b = c $): $ G -> N[a / x] b = N[a / x] c $ =
'(theeqd @ !! cbvabd y z @ sbeq2d @ eqeqd anr @ anwl h);
theorem sbneht (a: nat) (b c: nat x) (h: $ FN/ x c $):
  $ A. x (x = a -> b = c) -> N[a / x] b = c $ =
'(!! eqtheabd y @ syl (sbeht @ nfeq2 h) @ alimi @ imim2 eqeq2);
theorem sbneh (a: nat) (b c: nat x) (h: $ FN/ x c $)
  (e: $ x = a -> b = c $): $ N[a / x] b = c $ = '(sbneht h @ ax_gen e);
theorem sbnet (a: nat) (b: nat x) (c: nat):
  $ A. x (x = a -> b = c) -> N[a / x] b = c $ = '(sbneht nfnv);
theorem sbne (a: nat) (b: nat x) (c: nat)
  (e: $ x = a -> b = c $): $ N[a / x] b = c $ = '(sbneh nfnv e);
theorem sbned (a: nat) (b: nat x) (c: nat)
  (e: $ G /\ x = a -> b = c $): $ G -> N[a / x] b = c $ = '(syl sbnet @ ialda e);
theorem sbneq1 (a b c: nat x): $ a = b -> N[a / x] c = N[b / x] c $ =
'(theeqd @ !! abeqd y sbeq1);
theorem sbneq1d (G: wff x) (a b c: nat x)
  (h: $ G -> a = b $): $ G -> N[a / x] c = N[b / x] c $ = '(syl sbneq1 h);
theorem sbnid (a: nat x): $ N[x / x] a = a $ = '(trud @ !! eqtheabd y @ a1i sbid);

theorem nfnlem {y} (b: nat y) (a c: nat x)
  (e: $ y = a -> b = c $) (h: $ FN/ x a $): $ FN/ x c $ =
'(nfnx (eqcom @ sbne e) @ nfsbnh h nfnv);
theorem nfnlem2 {y z} (c: nat y z) (a b d: nat x) (e: $ y = a /\ z = b -> c = d $)
  (h1: $ FN/ x a $) (h2: $ FN/ x b $): $ FN/ x d $ =
'(nfnx (eqcom @ sbne @ sbned e) @ nfsbnh h1 @ nfsbnh h2 nfnv);

theorem nfsuc (a: nat x) (h: $ FN/ x a $): $ FN/ x suc a $ = '(!! nfnlem _ y suceq h);

--| Addition of natural numbers, a primitive term constructor in PA.
@(add-eval @ fn (a b) {(eval a) + (eval b)})
term add (a b: nat): nat; infixl add: $+$ prec 64;
--| Multiplication of natural numbers, a primitive term constructor in PA.
@(add-eval @ fn (a b) {(eval a) * (eval b)})
term mul (a b: nat): nat; infixl mul: $*$ prec 70;

--| Addition respects equalty.
axiom addeq (a b c d: nat): $ a = b -> c = d -> a + c = b + d $;
--| Multiplication respects equalty.
axiom muleq (a b c d: nat): $ a = b -> c = d -> a * c = b * d $;
--| The base case in the definition of addition.
axiom add0 (a: nat): $ a + 0 = a $;
--| The successor case in the definition of addition.
axiom addS (a b: nat): $ a + suc b = suc (a + b) $;
--| The base case in the definition of multiplication.
axiom mul0 (a: nat): $ a * 0 = 0 $;
--| The successor case in the definition of multiplication.
axiom mulS (a b: nat): $ a * suc b = a * b + a $;

do (add-axiom-set! 'axs_peano "Peano arithmetic"
  '(peano1 peano2 peano5 addeq muleq add0 addS mul0 mulS));

@(register-eqd 'add) theorem addeqd (h1: $ G -> a = b $) (h2: $ G -> c = d $):
  $ G -> a + c = b + d $ = '(sylc addeq h1 h2);
@(register-eqd 'mul) theorem muleqd (h1: $ G -> a = b $) (h2: $ G -> c = d $):
  $ G -> a * c = b * d $ = '(sylc muleq h1 h2);
do { (add-eqN-thms 'add) (add-eqN-thms 'mul) };
theorem nfadd (a b: nat x) (h1: $ FN/ x a $) (h2: $ FN/ x b $):
  $ FN/ x a + b $ = '(!! nfnlem2 _ y z (addeqd anl anr) h1 h2);
theorem nfmul (a b: nat x) (h1: $ FN/ x a $) (h2: $ FN/ x b $):
  $ FN/ x a * b $ = '(!! nfnlem2 _ y z (muleqd anl anr) h1 h2);

theorem add02: $ a + 0 = a $ = 'add0;
theorem add01: $ 0 + a = a $ =
'(! ind x y _ $ 0 + x = x $ _ _ _ _
  (eqeqd addeq2 id) (eqeqd addeq2 id)
  (eqeqd addeq2 id) (eqeqd addeq2 id)
  add0 (syl5eq addS suceq));

theorem addS2: $ a + suc b = suc (a + b) $ = 'addS;
theorem addS1: $ suc a + b = suc (a + b) $ =
'(! ind x y _ $ suc a + x = suc (a + x) $ _ _ _ _
  (eqeqd addeq2 (suceqd addeq2)) (eqeqd addeq2 (suceqd addeq2))
  (eqeqd addeq2 (suceqd addeq2)) (eqeqd addeq2 (suceqd addeq2))
  (eqtr4 add0 (suceq add0))
  (syl5eq addS (suceqd (syl6eqr addS id))));
theorem addSass: $ suc a + b = a + suc b $ = '(eqtr4 addS1 addS2);

theorem add12: $ a + 1 = suc a $ = '(eqtr addS (suceq add0));
theorem add11: $ 1 + a = suc a $ = '(eqtr addS1 (suceq add01));
theorem add22: $ a + 2 = suc (suc a) $ = '(eqtr addS (suceq add12));

theorem addcom: $ a + b = b + a $ =
'(! ind x y _ $ a + x = x + a $ _ _ _ _
  (eqeqd addeq2 addeq1) (eqeqd addeq2 addeq1)
  (eqeqd addeq2 addeq1) (eqeqd addeq2 addeq1)
  (eqtr4 add0 add01) (eqtr4g addS addS1 suceq));

theorem addass: $ (a + b) + c = a + (b + c) $ =
'(! ind x y _ $ (a + b) + x = a + (b + x) $ _ _ _ _
  (eqeqd addeq2 (addeq2d addeq2)) (eqeqd addeq2 (addeq2d addeq2))
  (eqeqd addeq2 (addeq2d addeq2)) (eqeqd addeq2 (addeq2d addeq2))
  (eqtr4 add0 (addeq2 add0))
  (eqtr4g addS (eqtr (addeq2 addS) addS) suceq));

theorem addlass: $ a + (b + c) = b + (a + c) $ =
'(eqtr3 addass @ eqtr (addeq1 addcom) addass);
theorem addrass: $ (a + b) + c = (a + c) + b $ =
'(eqtr addass @ eqtr4 (addeq2 addcom) addass);
theorem add4: $ (a + b) + (c + d) = (a + c) + (b + d) $ =
'(eqtr3 addass @ eqtr (addeq1 addrass) addass);

theorem addcan1: $ a + c = b + c <-> a = b $ =
'(! ind x y _ $ a + x = b + x <-> a = b $ _ _ _ _
  (bieq1d (eqeqd addeq2 addeq2)) (bieq1d (eqeqd addeq2 addeq2))
  (bieq1d (eqeqd addeq2 addeq2)) (bieq1d (eqeqd addeq2 addeq2))
  (eqeq add0 add0) (syl5bb (bitr (eqeq addS addS) peano2) id));
theorem addcan2: $ a + b = a + c <-> b = c $ =
'(bitr (eqeq addcom addcom) addcan1);

theorem mul02: $ a * 0 = 0 $ = 'mul0;
theorem mul01: $ 0 * a = 0 $ =
'(! ind x y _ $ 0 * x = 0 $ _ _ _ _
  (eqeq1d muleq2) (eqeq1d muleq2) (eqeq1d muleq2) (eqeq1d muleq2)
  mul0 (syl5eq (eqtr mulS add0) id));

theorem mulS2: $ a * suc b = a * b + a $ = 'mulS;
theorem mulS1: $ suc a * b = a * b + b $ =
'(! ind x y _ $ suc a * x = a * x + x $ _ _ _ _
  (eqeqd muleq2 (addeqd muleq2 id)) (eqeqd muleq2 (addeqd muleq2 id))
  (eqeqd muleq2 (addeqd muleq2 id)) (eqeqd muleq2 (addeqd muleq2 id))
  (eqtr4 mul0 (eqtr add0 mul0))
  (eqtr4g mulS (eqtr (addeq1 mulS) @
    eqtr addS @ eqtr4 (suceq addrass) addS) addeq1));

theorem mulcom: $ a * b = b * a $ =
'(! ind x y _ $ a * x = x * a $ _ _ _ _
  (eqeqd muleq2 muleq1) (eqeqd muleq2 muleq1)
  (eqeqd muleq2 muleq1) (eqeqd muleq2 muleq1)
  (eqtr4 mul0 mul01) (eqtr4g mulS mulS1 addeq1));

theorem mul12: $ a * 1 = a $ = '(eqtr mulS (eqtr (addeq1 mul0) add01));
theorem mul11: $ 1 * a = a $ = '(eqtr mulcom mul12);
theorem mul22: $ a * 2 = a + a $ = '(eqtr mulS2 @ addeq1 mul12);
theorem mul21: $ 2 * a = a + a $ = '(eqtr mulcom mul22);

theorem muladd: $ a * (b + c) = a * b + a * c $ =
'(! ind x y _ $ a * (b + x) = a * b + a * x $ _ _ _ _
  (eqeqd (muleq2d addeq2) (addeq2d muleq2))
  (eqeqd (muleq2d addeq2) (addeq2d muleq2))
  (eqeqd (muleq2d addeq2) (addeq2d muleq2))
  (eqeqd (muleq2d addeq2) (addeq2d muleq2))
  (eqtr4 (muleq2 add0) (eqtr (addeq2 mul0) add0))
  (eqtr4g (eqtr (muleq2 addS) mulS) (eqtr4 (addeq2 mulS) addass) addeq1));

theorem addmul: $ (a + b) * c = a * c + b * c $ =
'(eqtr mulcom (eqtr muladd (addeq mulcom mulcom)));

theorem mulass: $ (a * b) * c = a * (b * c) $ =
'(! ind x y _ $ (a * b) * x = a * (b * x) $ _ _ _ _
  (eqeqd muleq2 (muleq2d muleq2)) (eqeqd muleq2 (muleq2d muleq2))
  (eqeqd muleq2 (muleq2d muleq2)) (eqeqd muleq2 (muleq2d muleq2))
  (eqtr4 mul0 (eqtr (muleq2 mul0) mul0))
  (eqtr4g mulS (eqtr (muleq2 mulS) muladd) addeq1));

theorem mullass: $ a * (b * c) = b * (a * c) $ =
'(eqtr3 mulass @ eqtr (muleq1 mulcom) mulass);
theorem mulrass: $ (a * b) * c = (a * c) * b $ =
'(eqtr mulass @ eqtr4 (muleq2 mulcom) mulass);

--| (Truncated) subtraction of natural numbers.
--| Note that `a - b = 0` when `a < b`.
@(add-eval @ fn (a b) {{(eval a) - (eval b)} max 0})
@_ def sub (a b: nat): nat = $ the {x | b + x = a} $;
infixl sub: $-$ prec 64;

theorem eqsub2: $ a + b = c -> c - a = b $ =
'(!! eqthed x @ syl5bb (!! elabe y @ eqeq1d addeq2) (syl6bb addcan2 @ bicomd eqeq2));
theorem eqsub1: $ a + b = c -> c - b = a $ = '(sylbi (eqeq1 addcom) eqsub2);
theorem pncan: $ a + b - b = a $ = '(eqsub1 eqid);
theorem pncan2: $ a + b - a = b $ = '(eqsub2 eqid);
theorem sub02: $ a - 0 = a $ = '(eqsub1 add0);
theorem subid: $ a - a = 0 $ = '(eqsub1 add01);
theorem sucsub1: $ suc a - 1 = a $ = '(eqtr3 (subeq1 add12) pncan);

--| `a <= b` means `a` is less than or equal to `b`.
@(add-eval @ fn (a b) {(eval a) <= (eval b)})
@_ def le (a b .x: nat): wff = $ E. x a + x = b $;
infixl le: $<=$ prec 50;

theorem dfle: $ a <= b <-> E. x a + x = b $ = '(!! cbvex y x (eqeq1d addeq2));

theorem leid: $ a <= a $ = '(!! iexe x (eqeq1d addeq2) add0);
theorem eqle: $ a = b -> a <= b $ = '(mpbii leid leeq2);
theorem eqler: $ a = b -> b <= a $ = '(syl eqle eqcom);

theorem pncan3: $ a <= b -> a + (b - a) = b $ =
'(!! eex x @ mpbii (addeq2 pncan2) (eqeqd (addeq2d subeq1) id));
theorem npcan: $ b <= a -> a - b + b = a $ = '(syl5eq addcom pncan3);
theorem subadd: $ b <= a -> (a - b = c <-> b + c = a) $ =
'(ibid (syl5ibrcom (rsyl eqcom @ eqeq1d addeq2) pncan3) @ a1i eqsub2);
theorem addsub: $ c <= a -> a + b - c = a - c + b $ =
'(syl6eq pncan @ subeq1d @ syl6eq addrass @ addeq1d @ eqcomd npcan);

theorem leaddid1: $ a <= a + b $ = '(!! iexe x (eqeq1d addeq2) eqid);
theorem leaddid2: $ a <= b + a $ = '(mpbi (leeq eqid addcom) leaddid1);

theorem lesucid: $ a <= suc a $ = '(mpbi (leeq2 add12) leaddid1);

theorem le01: $ 0 <= a $ = '(mpbi (leeq2 add0) leaddid2);

theorem leadd1: $ a <= b <-> a + c <= b + c $ =
'(bitr dfle (!! exeqi x (bitr3 addcan1 (eqeq1 addrass))));
theorem leadd2: $ b <= c <-> a + b <= a + c $ = '(bitr leadd1 (leeq addcom addcom));
theorem lesuc: $ a <= b <-> suc a <= suc b $ = '(bitr leadd1 (leeq add12 add12));

theorem letrd (h1: $ G -> a <= b $) (h2: $ G -> b <= c $): $ G -> a <= c $ =
'(mpd h1 @ !! eexda x @ mpd (anwl h2) @ !! eexda y @ syl
  (!! iexe z @ eqeq1d addeq2) @
  syl5eqr addass @ eqtrd (addeq1d anlr) anr);

theorem letr: $ a <= b -> b <= c -> a <= c $ = '(exp (letrd anl anr));

theorem leasymd (h1: $ G -> a <= b $) (h2: $ G -> b <= a $): $ G -> a = b $ =
(focus
  '(mpd h1 (!! eexda x (! casesda _ $ x = 0 $ _ _ _)))
  (focus
    '(syl5eqr add0 (eqtr3d (anwr addeq2) anlr)))
  (focus
    '(imp (syl5bi exsuc (!! eexda y _)))
    '(mpd (anwl (anwl h2)) (!! eexda z _))
    '(sylc absurd (a1i peano1) _)
    '(syl5eqr addS1 @ eqtr3d (addeq1d anlr) (sylib addcan2 _))
    '(eqtr4g (eqcom addass) add0 (eqtrd (addeq1d (anwl anlr)) anr))));

theorem leasym: $ a <= b -> b <= a -> a = b $ = '(exp (leasymd anl anr));
theorem eqlele: $ a = b <-> a <= b /\ b <= a $ =
'(ibii (iand eqle eqler) (imp leasym));

theorem le02: $ a <= 0 <-> a = 0 $ = '(ibii (mpi le01 leasym) eqle);
theorem le11: $ 1 <= a <-> a != 0 $ = '(bitr4 (!! exeqi x (bitr eqcomb @ eqeq2 add11)) exsuc);

theorem addeq0: $ a + b = 0 <-> a = 0 /\ b = 0 $ =
'(ibii (iand (sylib le02 @ mpbii leaddid1 leeq2) (sylib le02 @ mpbii leaddid2 leeq2)) @
  syl6eq add0 @ imp addeq);

theorem sub1can: $ a != 0 -> suc (a - 1) = a $ = '(sylbir le11 @ syl5eqr add12 npcan);

theorem leaddd (h1: $ G -> a <= b $) (h2: $ G -> c <= d $): $ G -> a + c <= b + d $ =
'(letrd (sylib leadd1 h1) (sylib leadd2 h2));

theorem leadd: $ a <= b -> c <= d -> a + c <= b + d $ = '(exp @ leaddd anl anr);

theorem lemul1a: $ a <= b -> a * c <= b * c $ =
(induct '(!! indd x y) 'c
  '(a1i (eqle (eqtr4 mul0 mul0))) '(sylibr (leeq mulS mulS) (leaddd anr anl)));
theorem lemul2a: $ b <= c -> a * b <= a * c $ = '(sylib (leeq mulcom mulcom) lemul1a);
theorem lemuld (h1: $ G -> a <= b $) (h2: $ G -> c <= d $): $ G -> a * c <= b * d $ =
'(letrd (syl lemul1a h1) (syl lemul2a h2));

--| `a < b` means `a` is strictly less than `b`.
@(add-eval @ fn (a b) {(eval a) < (eval b)})
@_ def lt (a b: nat): wff = $ suc a <= b $;
infixl lt: $<$ prec 50;

theorem ltletr: $ a < b -> b <= c -> a < c $ = 'letr;
theorem ltletrd (h1: $ G -> a < b $) (h2: $ G -> b <= c $): $ G -> a < c $ = '(letrd h1 h2);

theorem ltle: $ a < b -> a <= b $ = '(letrd (a1i lesucid) id);
theorem ltlei (h: $ a < b $): $ a <= b $ = '(ltle h);
theorem ltled (h: $ G -> a < b $): $ G -> a <= b $ = '(syl ltle h);

theorem lelttr: $ a <= b -> b < c -> a < c $ = '(sylbi lesuc letr);
theorem lelttrd (h1: $ G -> a <= b $) (h2: $ G -> b < c $): $ G -> a < c $ = '(sylc lelttr h1 h2);

theorem lttr: $ a < b -> b < c -> a < c $ = '(syl lelttr ltle);
theorem lttri (h1: $ a < b $) (h2: $ b < c $): $ a < c $ = '(lttr h1 h2);
theorem lttrd (h1: $ G -> a < b $) (h2: $ G -> b < c $): $ G -> a < c $ = '(sylc lttr h1 h2);

theorem ltsucid: $ a < suc a $ = 'leid;

theorem lt01: $ 0 < a <-> a != 0 $ = 'le11;
theorem lt02: $ ~ a < 0 $ = '(con3 (bi1 le02) peano1);
theorem lt01S: $ 0 < suc a $ = '(mpbir lt01 peano1);
theorem le11S: $ 1 <= suc a $ = 'lt01S;

theorem ltadd1: $ a < b <-> a + c < b + c $ = '(bitr leadd1 (leeq1 addS1));
theorem ltadd2: $ b < c <-> a + b < a + c $ = '(bitr ltadd1 (lteq addcom addcom));
theorem ltsuc: $ a < b <-> suc a < suc b $ = '(bitr ltadd1 (lteq add12 add12));
theorem leltsuc: $ a <= b <-> a < suc b $ = 'lesuc;

theorem leltaddd (h1: $ G -> a <= b $) (h2: $ G -> c < d $): $ G -> a + c < b + d $ =
'(lelttrd (sylib leadd1 h1) (sylib ltadd2 h2));
theorem ltleaddd (h1: $ G -> a < b $) (h2: $ G -> c <= d $): $ G -> a + c < b + d $ =
'(ltletrd (sylib ltadd1 h1) (sylib leadd2 h2));

theorem ltirr: $ ~ a < a $ = '(mtbi (bitr ltadd1 @ lteq add01 add01) lt02);
theorem ltne: $ a < b -> a != b $ = '(mpi ltirr @ con3d @ com12 @ bi1d lteq1);
theorem ltner: $ a < b -> b != a $ = '(syl necom ltne);
theorem ltnei (h: $ a < b $): $ a != b $ = '(ltne h);
theorem ltneri (h: $ a < b $): $ b != a $ = '(ltner h);

theorem d0lt1: $ 0 < 1 $ = 'lt01S;
theorem d0lt2: $ 0 < 2 $ = 'lt01S;
theorem d1lt2: $ 1 < 2 $ = '(mpbi ltsuc d0lt1);
theorem lt12: $ a < 1 <-> a = 0 $ = '(bitr3 leltsuc le02);

theorem nlesubeq0: $ ~b <= a -> a - b = 0 $ =
'(!! eqthe0abd x @ syl5 (mpbii leaddid1 leeq2) absurd);

theorem subleid: $ a - b <= a $ =
'(cases (mpbii leaddid1 @ leeq2d npcan) (mpbiri le01 @ leeq1d nlesubeq0));
theorem subltid: $ 0 < a /\ 0 < b -> a - b < a $ =
'(casesda
  (sylibr ltadd1 @ mpbird (anwr @ lteq1d @ syl6eqr add0 npcan) @ sylib ltadd2 anlr)
  (mpbird (anwr @ lteq1d nlesubeq0) anll));

theorem lesub1i: $ a <= b -> a - c <= b - c $ =
'(cases
  (exp @ sylibr leadd1 @ mpbird (leeqd (anwl npcan) (syl npcan (imp letr))) anr)
  (a1d @ mpbiri le01 (leeq1d nlesubeq0)));

theorem leloe: $ a <= b <-> a < b \/ a = b $ =
'(ibii (!! eex x @ casesd
    (exp (orrd (syl5eqr add0 (eqtr3d (anwr addeq2) anl))))
    (syl5bi exsuc @ !! eexda y @ orld @ mpbii leaddid1 @
      leeq2d @ syl5eq addSass @ eqtr3d (anwr addeq2) anl))
  (eor ltle eqle));

theorem ltlene: $ a < b <-> a <= b /\ a != b $ =
'(ibii (iand ltle ltne) (imp (con1d (bi1 leloe))));
theorem ltlenle: $ a < b <-> a <= b /\ ~b <= a $ =
'(ibii (iand ltle (mtd (a1i ltirr) ltletr))
  (sylibr ltlene @ iand anl @ anwr @ con3 eqler));

theorem ltorle: $ a < b \/ b <= a $ =
'(! ind x y _ $ a < x \/ x <= a $ _ _ _ _
  (oreqd lteq2 leeq1) (oreqd lteq2 leeq1) (oreqd lteq2 leeq1) (oreqd lteq2 leeq1)
  (orr le01)
  (eor (orld (mpi ltsucid lttr))
    (syl5 (con3 (bi1 lesuc)) @ exp @ bi2 ltlenle)));
theorem leorlt: $ a <= b \/ b < a $ = '(orcom ltorle);

theorem ltnle: $ a < b <-> ~b <= a $ = '(ibii (sylbi ltlenle anr) leorlt);
theorem lenlt: $ a <= b <-> ~b < a $ = '(con2b ltnle);
theorem ltnlt: $ a < b -> ~b < a $ = '(sylbi ltnle (con3 ltle));
theorem leorle: $ a <= b \/ b <= a $ = '(syl ltle leorlt);

theorem neltlt: $ a != b <-> a < b \/ b < a $ =
'(ibii (mpi ltorle @ imim2d @ rsyl necom @ com12 @ exp @ bi2i ltlene) (eor ltne ltner));

theorem eqalle2: $ a = b <-> A. i (a <= i <-> b <= i) $ =
'(ibii (iald leeq1) @ leasymd
  (mpbiri leid @ eale @ bieqd leeq2 leeq2)
  (mpbii leid @ eale @ bieqd leeq2 leeq2));
theorem eqallt1: $ a = b <-> A. i (i < a <-> i < b) $ =
'(bitr eqalle2 @ aleqi @ bitr4 con3bb @ bieq ltnle ltnle);

theorem ltsubeq0: $ a < b -> a - b = 0 $ = '(sylbi ltnle nlesubeq0);
theorem lesubeq0: $ a <= b <-> a - b = 0 $ =
'(ibii (sylbi leloe @ eor ltsubeq0 @ syl6eq subid subeq1) @
  syla contra @ syl eqle @
  eqtr3d (syl npcan @ anwr leorle) (syl6eq add01 @ anwl addeq1));

theorem subpos: $ a < b <-> 0 < b - a $ = '(bitr ltnle @ bitr4 (noteq lesubeq0) lt01);

theorem lesubadd2: $ a - b <= c <-> a <= b + c $ =
'(ibii
  (eor (a1d @ mpi leaddid1 letr) (bi1d @ syl5bb leadd2 @ leeq1d pncan3) leorle)
  (sylib (leeq2 pncan2) lesub1i));

theorem lesubadd: $ a - b <= c <-> a <= c + b $ = '(bitr lesubadd2 (leeq2 addcom));

theorem ltaddsub: $ a + b < c <-> a < c - b $ =
'(bitr4 ltnle @ bitr ltnle @ noteqi lesubadd);

theorem ltaddsub2: $ a + b < c <-> b < c - a $ = '(bitr (lteq1 addcom) ltaddsub);

theorem ltsubadd: $ b <= a -> (a - b < c <-> a < c + b) $ = '(syl5bb ltadd1 @ lteq1d npcan);
theorem ltsubadd2: $ b <= a -> (a - b < c <-> a < b + c) $ = '(syl6bb (lteq2 addcom) ltsubadd);

theorem leaddsub: $ b <= c -> (a + b <= c <-> a <= c - b) $ =
'(bitr4g lenlt lenlt @ noteqd @ bicomd ltsubadd);
theorem leaddsub2: $ a <= c -> (a + b <= c <-> b <= c - a) $ =
'(syl5bb (leeq1 addcom) leaddsub);
theorem leaddsubi: $ a + b <= c -> a <= c - b $ =
'(mpbid (syl leaddsub @ letr leaddid2) id);
theorem leaddsub2i: $ a + b <= c -> b <= c - a $ =
'(sylbi (leeq1 addcom) leaddsubi);

theorem mulsub: $ a * (b - c) = a * b - a * c $ =
'(eor
  (eqcomd @ syl eqsub1 @ syl5eqr muladd @ muleq2d npcan)
  (eqtr4d (syl6eq mul02 @ sylbi lesubeq0 muleq2)
    (sylib lesubeq0 lemul2a)) leorle);
theorem submul: $ (a - b) * c = a * c - b * c $ =
'(eqtr mulcom @ eqtr mulsub @ subeq mulcom mulcom);

theorem ltmul1: $ 0 < c -> (a < b <-> a * c < b * c) $ =
(named '(ibid
  (com12 ,(induct '(indd) 'c
    '(a1i @ absurd lt02)
    '(a1d @ anwl @ sylibr (lteq mulS mulS) @
      ltletrd (bi1 ltadd2) @ sylib leadd1 @ syl lemul1a ltle)))
  (a1i (mpbir (imeqi ltnle ltnle) (con3 lemul1a)))));
theorem ltmul2: $ 0 < a -> (b < c <-> a * b < a * c) $ =
'(syl6bb (lteq mulcom mulcom) ltmul1);
theorem lemul1: $ 0 < c -> (a <= b <-> a * c <= b * c) $ =
'(sylibr (bieq lenlt lenlt) (noteqd ltmul1));
theorem lemul2: $ 0 < a -> (b <= c <-> a * b <= a * c) $ =
'(syl6bb (leeq mulcom mulcom) lemul1);
theorem ltmuld (h1: $ G -> a < b $) (h2: $ G -> c < d $): $ G -> a * c < b * d $ =
'(lelttrd (syl lemul1a @ syl ltle h1) @ mpbid (syl ltmul2 @ syl (lelttr le01) h1) h2);

theorem mulcan1: $ c != 0 -> (a * c = b * c <-> a = b) $ =
'(ibid (sylbir lt01 @ exp (leasymd
    (mpbird (anwl lemul1) (anwr eqle))
    (mpbird (anwl lemul1) (anwr eqler))))
  (a1i muleq1));
theorem mulcan2: $ a != 0 -> (a * b = a * c <-> b = c) $ =
'(syl5bb (eqeq mulcom mulcom) mulcan1);

theorem mulpos: $ 0 < a * b <-> 0 < a /\ 0 < b $ =
'(ibii (iand
    (sylbi lt01 @ sylibr lt01 @ con3 @ syl6eq mul01 muleq1)
    (sylbi lt01 @ sylibr lt01 @ con3 @ syl6eq mul02 muleq2))
  (sylib (lteq1 mul0) @ mpbid (anwl ltmul2) anr));

theorem mulne0: $ a * b != 0 <-> a != 0 /\ b != 0 $ =
'(bitr3 lt01 @ bitr mulpos @ aneq lt01 lt01);

theorem sub01: $ 0 - a = 0 $ =
'(cases (sylbi le02 @ syl6eq sub02 subeq2) nlesubeq0);

theorem pnpcan2: $ (a + c) - (b + c) = a - b $ =
'(cases
  (syl eqsub1 @ syl5eqr addass @ addeq1d npcan)
  (eqtr4d (sylbi (noteq leadd1) nlesubeq0) nlesubeq0));

theorem pnpcan1: $ (a + b) - (a + c) = b - c $ = '(eqtr (subeq addcom addcom) pnpcan2);
theorem subSS: $ suc a - suc b = a - b $ = '(eqtr3 (subeq add12 add12) pnpcan2);
theorem subsub: $ a - b - c = a - (b + c) $ =
'(eor (eqtr4d (sylib lesubeq0 @ bi2i lesubadd2) @ bi1i lesubeq0)
  (eqcomd @ syl eqsub1 @ syl5eq addlass @
    eqtrd (addeq2d @ syl npcan leaddsub2i) @ syl pncan3 @ letr leaddid1)
  leorle);

theorem indlt (G) {x y} (a: nat) (px: wff x) (p0 pa py ps: wff y)
  (ha: $ x = a -> (px <-> pa) $)
  (h0: $ x = 0 -> (px <-> p0) $)
  (hy: $ x = y -> (px <-> py) $)
  (hs: $ x = suc y -> (px <-> ps) $)
  (h1: $ G -> p0 $) (h2: $ G /\ y < a /\ py -> ps $): $ G -> pa $ =
'(mpi leid @ indd
   (imeqd leeq1 ha) (imeqd leeq1 h0) (imeqd leeq1 hy) (imeqd leeq1 hs)
  (a1d h1) (imp @ syl5 (imim1i ltle) @ a2d @ exp @ exp h2));

theorem indstr (G) {x y} (a: nat y) (px: wff x) (pa py: wff y)
  (ha: $ x = a -> (px <-> pa) $)
  (hy: $ x = y -> (px <-> py) $)
  (h: $ G /\ A. x (x < y -> px) -> py $): $ G -> pa $ =
'(syl (mpi ltsucid @ eale @ imeqd lteq1 ha) ,(induct
  '(!! indd z y) $suc a$
  '(a1i @ ax_gen @ absurd lt02)
  '(mpd (rsyl h @ iald @ com12 @ bi2d hy) @
    anwr @ al2imi @ syl6 (imim1i @ bi1i @ bitr3 leltsuc leloe) eor)));

--| `finite A` means `A` is a finite set
--| (here defined as one that is upper bounded by some natural number).
@(derive-eq 'fin) def finite (A: set): wff = $ E. n A. x (x e. A -> x < n) $;

theorem nffin (A: set x) (h: $ FS/ x A $): $ F/ x finite A $ =
(named '(nfex @ nfal @ nfim (nfel2 h) nfv));

theorem finss: $ A C_ B -> finite B -> finite A $ =
'(!! eximd n @ !! alimd x @ imim1d ssel);

theorem ltfin: $ finite {x | x < n} $ =
'(!! iexe m (aleqd @ imeq2d @ lteq2) @ !! ax_gen y @ bi1i @ elabe lteq1);

theorem lefin: $ finite {x | x <= n} $ =
'(!! iexe m (aleqd @ imeq2d @ lteq2) @ !! ax_gen y @ sylbi (elabe leeq1) @ bi1i leltsuc);

theorem snfin: $ finite {x | x = n} $ =
'(finss (mpbi ssab @ ax_gen eqle) lefin);

theorem infin1: $ finite A -> finite (A i^i B) $ = '(finss inss1);
theorem infin2: $ finite B -> finite (A i^i B) $ = '(finss inss2);

--| `if p a b` is the if-then-else construct:
--| if `p` is true then `a`, else `b`.
@(add-eval @ fn (a b c) (if (eval a) (eval b) (eval c)))
@_ abstract def if (p: wff) (a b: nat): nat = $ the {n | ifp p (n = a) (n = b)} $;

pub theorem ifpos (p: wff) (a b: nat): $ p -> if p a b = a $ = '(!! eqtheabd n ifppos);
pub theorem ifneg (p: wff) (a b: nat): $ ~p -> if p a b = b $ = '(!! eqtheabd n ifpneg);

theorem ifid: $ if p a a = a $ = '(cases ifpos ifneg);
theorem ifeq2a: $ (p -> a = b) -> if p a c = if p b c $ =
'(casesd (imim2i ifeq2) (a1i @ eqtr4d ifneg ifneg));
theorem ifeq3a: $ (~p -> b = c) -> if p a b = if p a c $ =
'(casesd (a1i @ eqtr4d ifpos ifpos) (imim2i ifeq3));

theorem ifbothd
  (ea: $ if p a b = a -> (q <-> qa) $)
  (eb: $ if p a b = b -> (q <-> qb) $)
  (h1: $ G /\ p -> qa $) (h2: $ G /\ ~p -> qb $): $ G -> q $ =
'(casesda (mpbird (syl ea @ anwr ifpos) h1) (mpbird (syl eb @ anwr ifneg) h2));

theorem ifT: $ a e. A /\ b e. A -> if p a b e. A $ = '(ifbothd eleq1 eleq1 anll anlr);

--| `true n` means `n` is "truthy", that is, nonzero.
@(add-eval @ fn (a) {(eval a) != 0})
@_ def true (n: nat): wff = $ n != 0 $;
--| `bool n` means `n` is "boolean", that is, 0 or 1.
@(add-eval @ fn (a) {(eval a) < 2})
@_ def bool (n: nat): wff = $ n < 2 $;
--| `nat p` turns wff `p` into a natural number: if `p` is true then `1`, else `0`.
@(add-eval @ fn (a) (if (eval a) 1 0))
@_ def nat (p: wff): nat = $ if p 1 0 $;

theorem true1: $ true 1 $ = 'd1ne0;
theorem true0: $ ~ true 0 $ = '(notnot1 eqid);

theorem letrue: $ a <= b -> true a -> true b $ =
'(sylib (imeqi lt01 lt01) @ com12 ltletr);

theorem truemul: $ true (a * b) <-> true a /\ true b $ = 'mulne0;

theorem bool0: $ bool 0 $ = 'd0lt2;
theorem bool1: $ bool 1 $ = 'd1lt2;
theorem bool01: $ bool n <-> n = 0 \/ n = 1 $ =
'(bitr3 leltsuc (bitr leloe (oreq1i lt12)));

theorem boolle1: $ bool n <-> n <= 1 $ = '(bicom leltsuc);

theorem lebool: $ a <= b -> bool b -> bool a $ = 'lelttr;

theorem letrueb: $ bool a -> (a <= b <-> (true a -> true b)) $ =
'(ibid (a1i letrue) @ sylbi bool01 @ eor
  (a1d @ mpbiri le01 leeq1)
  (mpbiri (bi2i le11) @ imeqd (syl biim1 @ mpbiri true1 trueeq) leeq1));

theorem dftrue2: $ bool n -> (true n <-> n = 1) $ =
'(ibid (bi1 bool01) (a1i @ mpbiri d1ne0 neeq1));

theorem boolnat: $ bool (nat p) $ =
'(cases (mpbiri d1lt2 @ lteq1d ifpos) (mpbiri d0lt2 @ lteq1d ifneg));

theorem truenat: $ true (nat p) <-> p $ =
'(ibii (con1 ifneg) (mpbiri d1ne0 (neeq1d ifpos)));
theorem nateq1: $ nat p = 1 <-> p $ = '(bitr3 (dftrue2 boolnat) truenat);
theorem nateq0: $ nat p = 0 <-> ~p $ = '(con2b @ bicom truenat);
theorem nat1: $ nat T. = 1 $ = '(mpbir nateq1 itru);
theorem nat0: $ nat F. = 0 $ = '(mpbir nateq0 notfal);
theorem nattrue: $ bool n -> nat (true n) = n $ =
'(sylbi bool01 @ eor
  (eqtr4d (nateqd trueeq) @ syl6eqr (ifneg true0) id)
  (eqtr4d (nateqd trueeq) @ syl6eqr (ifpos true1) id));

theorem natle: $ (p -> q) <-> nat p <= nat q $ =
'(bicom @ bitr (letrueb boolnat) (imeqi truenat truenat));
theorem natinj: $ (p <-> q) <-> nat p = nat q $ = '(bitr4 (aneq natle natle) eqlele);

theorem natle1: $ nat p <= 1 $ = '(mpbi boolle1 boolnat);

theorem nattruele: $ nat (true n) <= n $ =
'(eor id (syl eqle @ syl nattrue @ mpi boolnat lebool) leorle);

theorem boolext: $ bool a -> bool b -> ((true a <-> true b) <-> a = b) $ =
'(exp @ ibid
  (exp @ mpbid (eqeqd (syl nattrue anll) (syl nattrue anlr)) @ anwr nateq)
  (a1i trueeq));

--| `min a b` is the smaller of `a` and `b`.
@(add-eval @ fn (a b) {(eval a) min (eval b)})
@_ def min (a b: nat): nat = $ if (a < b) a b $;
--| `max a b` is the larger of `a` and `b`.
@(add-eval @ fn (a b) {(eval a) max (eval b)})
@_ def max (a b: nat): nat = $ if (a < b) b a $;

theorem nfmax {x} (a b: nat x)
  (h1: $ FN/ x a $) (h2: $ FN/ x b $): $ FN/ x max a b $ =
'(!! nfnlem2 _ u v (maxeqd anl anr) h1 h2);

theorem eqmin1: $ a <= b -> min a b = a $ =
'(sylbi leloe @ eor ifpos @ syl6eq ifid (ifeq3d eqcom));
theorem eqmax2: $ a <= b -> max a b = b $ =
'(sylbi leloe @ eor ifpos @ syl6eq ifid (ifeq3d id));

theorem mincom: $ min a b = min b a $ =
'(cases (eqtr4d ifpos @ syl ifneg ltnlt) (eqtr4d ifneg @ sylbir lenlt eqmin1));
theorem maxcom: $ max a b = max b a $ =
'(cases (eqtr4d ifpos @ syl ifneg ltnlt) (eqtr4d ifneg @ sylbir lenlt eqmax2));

theorem eqmin2: $ b <= a -> min a b = b $ = '(syl5eq mincom eqmin1);
theorem eqmax1: $ b <= a -> max a b = a $ = '(syl5eq maxcom eqmax2);

theorem minle1: $ min a b <= a $ =
'(cases (syl eqle ifpos) (mpbird (leeq1d ifneg) (bi2 lenlt)));
theorem minle2: $ min a b <= b $ = '(mpbi (leeq1 mincom) minle1);
theorem lemin: $ a <= min b c <-> a <= b /\ a <= c $ =
'(ibii (iand (mpi minle1 letr) (mpi minle2 letr)) @ casesda
  (mpbird (anwr @ leeq2d ifpos) anll)
  (mpbird (anwr @ leeq2d ifneg) anlr));
theorem ltmin: $ a < min b c <-> a < b /\ a < c $ = 'lemin;

theorem subaddmin: $ (a - b) + min a b = a $ =
'(eor (eqtrd (addeq2d eqmin2) npcan)
  (eqtrd (sylbi lesubeq0 addeq1) @ syl5eq add01 @ eqmin1) leorle);
theorem minaddsub: $ min a b + (a - b) = a $ = '(eqtr addcom subaddmin);

theorem submin: $ a - min a b = a - b $ =
'(eor (eqtr4d (subeq2d eqmin1) @ syl6eqr subid @ bi1 lesubeq0)
  (subeq2d eqmin2) leorle);

theorem lemax1: $ a <= max a b $ =
'(cases (mpbird (leeq2d ifpos) ltle) (syl eqler ifneg));
theorem lemax2: $ b <= max a b $ = '(mpbi (leeq2 maxcom) lemax1);
theorem maxle: $ max a b <= c <-> a <= c /\ b <= c $ =
'(ibii (iand (letr lemax1) (letr lemax2)) @ casesda
  (mpbird (anwr @ leeq1d ifpos) anlr)
  (mpbird (anwr @ leeq1d ifneg) anll));

theorem ltmax: $ a < max b c <-> a < b \/ a < c $ =
'(con4b @ bitr3 lenlt @ bitr maxle @ bitr4 (aneq lenlt lenlt) notor);

theorem minadd1: $ min a b + c = min (a + c) (b + c) $ =
'(cases (eqtr4d (addeq1d ifpos) (sylbi ltadd1 ifpos))
  (eqtr4d (addeq1d ifneg) (sylbi (noteq ltadd1) ifneg)));
theorem maxadd1: $ max a b + c = max (a + c) (b + c) $ =
'(cases (eqtr4d (addeq1d ifpos) (sylbi ltadd1 ifpos))
  (eqtr4d (addeq1d ifneg) (sylbi (noteq ltadd1) ifneg)));

theorem minS: $ suc (min a b) = min (suc a) (suc b) $ =
'(eqtr3 add12 @ eqtr minadd1 @ trud @ mineqd (a1i add12) (a1i add12));
theorem maxS: $ suc (max a b) = max (suc a) (suc b) $ =
'(eqtr3 add12 @ eqtr maxadd1 @ trud @ maxeqd (a1i add12) (a1i add12));

theorem maxlt: $ max a b < c <-> a < c /\ b < c $ = '(bitr (leeq1 maxS) maxle);
theorem lemax: $ a <= max b c <-> a <= b \/ a <= c $ =
'(con4b @ bitr3 ltnle @ bitr maxlt @ bitr4 (aneq ltnle ltnle) notor);

theorem unfin: $ finite A -> finite B -> finite (A u. B) $ =
'(!! eex m @ !! eexd n @
  syl6 (!! iexe z @ aleqd @ imeq2d lteq2) @ !! al2imi x @
  rsyl (imim2i @ mpi lemax1 ltletr) @
  syl5 (imim2i @ mpi lemax2 ltletr) @
  syl6ibr (imeq1i elun) eor);

--| `a // b` is the quotient on dividing `a` by `b`.
--| (The double slash is used as in python to remind the reader that
--| this is a rounding-down division, not exact division.)
--| Division by 0 is defined and equal to 0.
@(add-eval @ fn (a b) {(eval a) // (eval b)})
@_ abstract def div (a b: nat): nat = $ the {q | E. r (r < b /\ b * q + r = a)} $;
infixl div: $//$ prec 70;

--| `a % b` is the remainder on dividing `a` by `b`.
--| Modulus by 0 is defined and `a % 0 = a`.
@(add-eval @ fn (a b) {(eval a) % (eval b)})
@_ abstract def mod (a b: nat): nat = $ a - b * (a // b) $;
infixl mod: $%$ prec 70;

pub theorem div0 (a: nat): $ a // 0 = 0 $ =
'(trud @ !! eqthe0abd q @ a1i @ !! eex r @ anwl @ absurd lt02);
theorem mod0: $ a % 0 = a $ = '(eqtr (subeq2 mul01) sub02);

theorem divlem1
  (h1: $ G -> r1 < b $) (h2: $ G -> r2 < b $)
  (h3: $ G -> b * q1 + r1 <= b * q2 + r2 $):
  $ G -> q1 <= q2 $ =
(focus
  (have 'b0 $ G -> 0 < b $ '(lelttrd (a1i le01) h1))
  '(sylibr leltsuc @ mpbird (syl ltmul2 b0) @ lelttrd (a1i leaddid1) _)
  '(lelttrd h3 @ sylibr (lteq2 mulS) @ sylib ltadd2 h2));

theorem divlem2 (h1: $ G -> R < b $) (h2: $ G -> b * Q + R = a $):
  $ G -> (E. r (r < b /\ b * q + r = a) <-> q = Q) $ =
(focus
  (have 'b0 $ G -> b != 0 $ '(syl ltner @ lelttrd (a1i le01) h1))
  '(ibid (eexda @ leasymd
      (divlem1 anrl (anwl h1) @ syl eqle @ eqtr4d anrr (anwl h2))
      (divlem1 (anwl h1) anrl @ syl eqle @ eqtr4d (anwl h2) anrr))
    (exp @ syl
      (iexe @ aneqd lteq1 @ eqeq1d addeq2)
      (iand (anwl h1) @ eqtrd (anwr @ addeq1d muleq2) (anwl h2)))));

theorem divlem3: $ b != 0 -> E. q E. r (r < b /\ b * q + r = a) $ =
(named @ induct '(indd) 'a
  '(iexde @ iexde @ iand
    (mpbird (anwr lteq1) @ sylibr lt01 anll)
    (syl6eq add0 @ addeqd (syl6eq mul02 @ anwl @ anwr muleq2) anr))
  '(imp @ syl5bi (!! cbvex _ u @ !! cbvexd _ v
    (aneqd (anwr lteq1) @ eqeq1d @ addeqd (anwl muleq2) anr))
    (eexd @ eexda @ mpd (sylib leloe anrl) @ eorda
      (iexde @ iexde @ iand
        (mpbird (anwr lteq1) (anwll anr))
        (eqtrd (anwr addeq2) @ syl5eq addS @ suceqd @
          eqtrd (addeq1d @ muleq2d anlr) (anw3l anrr)))
      (iexde @ iexde @ iand
        (mpbird (anwr lteq1) (sylibr lt01 (anw3l anl)))
        (eqtrd (addeqd (muleq2d anlr) anr) @
          syl5eq add0 @ syl5eq mulS @ eqtr3d (addeq2d @ anwll anr) @
            syl5eq addS @ suceqd @ anw3l anrr)))));

theorem eqdivmod (h1: $ G -> R < b $) (h2: $ G -> b * Q + R = a $):
  $ G -> a // b = Q /\ a % b = R $ =
(focus
  (have 'eq $ G -> a // b = Q $
    '(!! eqtheabd q @ !! divlem2 r h1 h2))
  '(iand eq (syl eqsub2 @ eqtrd (addeq1d @ muleq2d eq) h2)));

pub theorem divmod (a b: nat): $ b * (a // b) + a % b = a $ =
(focus
  '(pncan3 @ cases _ _)
  (focus
    '(mpbiri le01 @ leeq1d @ syl6eq mul0 @ muleq2d @ syl6eq div0 diveq2))
  (focus
    '(mpd (!! divlem3 q r) @ eexd @ eexda @ mpbii leaddid1 _)
    '(leeq2d @ eqtrd (addeq1d @ muleq2d _) anrr)
    '(!! eqtheabd x @ !! divlem2 y anrl anrr)));

pub theorem modlt (a b: nat): $ b != 0 -> a % b < b $ =
'(mpd (!! divlem3 q r) @ eexd @ eexda @
  mpbird (lteq1d @ anrd @ eqdivmod anrl anrr) anrl);

theorem modle1: $ a % b <= a $ = '(mpbi (leeq2 divmod) leaddid2);

theorem div01: $ 0 // a = 0 $ =
'(cases (syl6eq div0 diveq2) @ anld @
  eqdivmod (bi2 lt01) (a1i @ eqtr add0 mul0));
theorem mod01: $ 0 % a = 0 $ =
'(cases (syl6eq mod0 modeq2) @ anrd @
  eqdivmod (bi2 lt01) (a1i @ eqtr add0 mul0));

theorem mod12: $ a % 1 = 0 $ = '(mpbi lt12 @ modlt d1ne0);
theorem div12: $ a // 1 = a $ =
'(eqtr3 (eqtr (addeq mul11 mod12) add02) divmod);

theorem muladddiv2: $ b != 0 -> (b * a + c) // b = a + c // b $ =
'(anld @ eqdivmod modlt @ a1i @ eqtr (addeq1 muladd) @ eqtr addass (addeq2 divmod));
theorem muladddiv1: $ b != 0 -> (a * b + c) // b = a + c // b $ =
'(syl5eq (diveq1 @ addeq1 mulcom) muladddiv2);
theorem muladdmod2: $ b != 0 -> (b * a + c) % b = c % b $ =
'(anrd @ eqdivmod modlt @ a1i @ eqtr (addeq1 muladd) @ eqtr addass (addeq2 divmod));
theorem muladdmod1: $ b != 0 -> (a * b + c) % b = c % b $ =
'(syl5eq (modeq1 @ addeq1 mulcom) muladdmod2);

theorem muladddiv2lt: $ b != 0 /\ c < b -> (b * a + c) // b = a $ =
'(anld @ eqdivmod anr eqidd);
theorem muladddiv1lt: $ b != 0 /\ c < b -> (a * b + c) // b = a $ =
'(syl5eq (diveq1 @ addeq1 mulcom) muladddiv2lt);
theorem muladdmod2lt: $ b != 0 /\ c < b -> (b * a + c) % b = c $ =
'(anrd @ eqdivmod anr eqidd);
theorem muladdmod1lt: $ b != 0 /\ c < b -> (a * b + c) % b = c $ =
'(syl5eq (modeq1 @ addeq1 mulcom) muladdmod2lt);

theorem muldiv2: $ b != 0 -> b * a // b = a $ =
'(anld @ eqdivmod (bi2 lt01) (a1i add0));
theorem muldiv1: $ b != 0 -> a * b // b = a $ =
'(eqtrd (diveqd (a1i mulcom) eqidd) muldiv2);
theorem mulmod1: $ b * a % b = 0 $ =
'(cases
  (eqtrd modeq2 @ syl5eq mod0 @ syl6eq mul01 muleq1)
  (anrd @ eqdivmod (bi2 lt01) (a1i add0)));
theorem mulmod2: $ a * b % b = 0 $ =
'(eqtr (modeqd id eqidd mulcom) mulmod1);
theorem divid: $ a != 0 -> a // a = 1 $ = '(syl5eqr (diveq1 mul12) muldiv2);
theorem modid: $ a % a = 0 $ = '(eqtr3 (modeq1 mul12) mulmod1);

theorem divlteq0: $ a < b -> a // b = 0 $ =
'(anld @ eqdivmod id @ a1i @ eqtr (addeq1 mul02) add01);
theorem modltid: $ a < b -> a % b = a $ =
'(anrd @ eqdivmod id @ a1i @ eqtr (addeq1 mul02) add01);

theorem lediv1: $ a <= b -> a // c <= b // c $ =
'(casesda (mpbiri le01 @ leeq1d @ syl6eq div0 (anwr diveq2))
  (divlem1 (anwr modlt) (anwr modlt) @ sylibr (leeq divmod divmod) anl));

theorem muldivle: $ b * (a // b) <= a $ = '(mpbi (leeq2 divmod) leaddid1);
theorem divleid: $ a // b <= a $ =
'(cases (mpbiri le01 @ leeq1d @ syl6eq div0 diveq2)
  (letrd (sylib (leeq1 mul11) @ sylbir le11 lemul1a) (a1i muldivle)));

theorem ledivmul1: $ c != 0 -> (a <= b // c <-> c * a <= b) $ =
'(ibida (letrd (anwr lemul2a) (a1i muldivle))
  (sylibr leltsuc @
    mpbird (syl ltmul2 @ sylibr lt01 anl) @ lelttrd anr @ anwl @
    sylibr (lteq2 mulS) @ sylib (lteq1 divmod) @ sylib ltadd2 @ modlt));
theorem ledivmul2: $ c != 0 -> (a <= b // c <-> a * c <= b) $ =
'(syl6bb (leeq1 mulcom) ledivmul1);
theorem divltmul1: $ b != 0 -> (a // b < c <-> a < b * c) $ =
'(syl5bb ltnle @ syl6bbr ltnle @ noteqd @ ledivmul1);
theorem divltmul2: $ b != 0 -> (a // b < c <-> a < c * b) $ =
'(syl6bb (lteq2 mulcom) divltmul1);

theorem divlemul1r: $ b != 0 -> a <= b * c -> a // b <= c $ =
'(exp @ mpbid (leeq2d @ anwl muldiv2) @ anwr lediv1);
theorem divlemul2r: $ b != 0 -> a <= c * b -> a // b <= c $ =
'(syl5bi (leeq2 mulcom) divlemul1r);

theorem diveq0: $ b != 0 -> (a // b = 0 <-> a < b) $ =
'(syl5bbr lt12 @ syl6bb (lteq2 mul12) divltmul1);

theorem divdiv: $ a // b // c = a // (b * c) $ =
'(cases (eqtr4d (syl6eq div01 @ diveq1d @ syl6eq div0 diveq2)
    (syl6eq div0 @ diveq2d @ syl6eq mul01 muleq1)) @
  casesda (anwr @ eqtr4d (syl6eq div0 diveq2)
    (syl6eq div0 @ diveq2d @ syl6eq mul02 muleq2)) @
  leasymd
    (mpbird (sylbir mulne0 ledivmul1) @ a1i @
      mpbir (leeq1 mulass) @ letr (lemul2a muldivle) muldivle)
    (mpbird (anwr ledivmul1) @ mpbird (anwl ledivmul1) @ a1i @
      mpbi (leeq1 mulass) muldivle));

theorem divmod1: $ a // b % c = a % (b * c) // b $ =
'(cases (eqtr4d (syl6eq mod01 @ modeq1d @ syl6eq div0 diveq2) @ syl6eq div0 diveq2) @
  casesda (anwr @ eqtr4d (syl6eq mod0 modeq2) @
    diveq1d @ syl6eq mod0 @ modeq2d @ syl6eq mul02 muleq2) @
  anrd @ eqdivmod (mpbird (anwl divltmul1) @ sylbir mulne0 modlt) @
  eqcomd @ anld @ eqdivmod (anwl modlt) @ a1i @
  eqtr (addeq1 muladd) @ eqtr addass @ eqtr (addeq2 divmod) @
  eqtr3 (addeq1 mulass) divmod);

theorem divmod2: $ a // b % c = a % (c * b) // b $ =
'(eqtr divmod1 @ diveq1 @ modeq2 mulcom);

theorem divmoddilem: $ a != 0 ->
  (a * b) // (a * c) = b // c /\ (a * b) % (a * c) = a * (b % c) $ =
'(casesda
  (anwr @ iand
    (eqtr4d (syl6eq div0 @ diveq2d @ syl6eq mul0 muleq2) @ syl6eq div0 diveq2)
    (eqtr4d (syl6eq mod0 @ modeq2d @ syl6eq mul0 muleq2) @ muleq2d @ syl6eq mod0 modeq2))
  (eqdivmod (mpbid (syl ltmul2 @ sylibr lt01 anl) @ anwr modlt) @
    a1i @ eqtr (addeq1 mulass) @ eqtr3 muladd @ muleq2 divmod));

theorem mdmcan1: $ a != 0 -> (a * b) // (a * c) = b // c $ = '(anld divmoddilem);
theorem mdmcan2: $ c != 0 -> (a * c) // (b * c) = a // b $ =
'(syl5eq (diveq mulcom mulcom) mdmcan1);

theorem mulmoddi: $ a * (b % c) = (a * b) % (a * c) $ =
'(cases
  (eqtr4d muleq1 @ syl6eqr mul01 @ syl6eq mod0 @
    modeqd (syl6eq mul01 muleq1) (syl6eq mul01 muleq1))
  (eqcomd @ anrd divmoddilem));
theorem mulmoddir: $ (a % b) * c = (a * c) % (b * c) $ =
'(eqtr mulcom @ eqtr mulmoddi @ modeq mulcom mulcom);

--| `a || b` means that `a` divides `b`, or equivalently,
--| `b` is a multiple of `a`.
@(add-eval @ fn (a b) {{(eval b) % (eval a)} = 0})
@_ def dvd (a b: nat): wff = $ E. c c * a = b $;
infixl dvd: $||$ prec 50;

theorem idvd: $ c * a = b -> a || b $ = '(!! iexe x @ eqeq1d muleq1);
theorem idvd2: $ a * c = b -> a || b $ = '(sylbi (eqeq1 mulcom) idvd);

theorem divmul: $ b || a -> a // b * b = a $ =
(focus
  '(!! eex x @ eqtr3d (muleq1d diveq1) @ syl5eq _ id)
  '(cases (eqtr4d (syl6eq mul0 muleq2) (syl6eq mul0 muleq2)) (muleq1d muldiv1)));
theorem muldiv3: $ b || a -> b * (a // b) = a $ = '(syl5eq mulcom divmul);

theorem dvdadd1: $ n || a -> (n || b <-> n || a + b) $ =
(focus
  '(!! eex x @ ibid _ _)
  (focus
    '(!! eexda y @ syl idvd @ syl5eq addmul @ imp addeq))
  (focus
    '(!! eexda z @ syl idvd @ sylib addcan2 _)
    '(eqtr3d (anwl addeq1) @ syl5eqr addmul @ eqtrd _ anr)
    '(casesda (anwr @ eqtr4d (syl6eq mul0 muleq2) (syl6eq mul0 muleq2)) _)
    '(muleq1d @ syl pncan3 _)
    '(mpbiri leaddid1 @ bitrd (anwr @ sylbir lt01 @ lemul1) @ leeqd anll anlr)));

theorem dvdadd2: $ n || a -> (n || b <-> n || b + a) $ =
'(syl6bb (dvdeqd eqidd id addcom) dvdadd1);

theorem dvdmul1: $ a || b * a $ = '(idvd eqid);
theorem dvdmul2: $ a || a * b $ = '(mpbi (dvdeq2 mulcom) dvdmul1);

theorem dvdtr: $ a || b -> b || c -> a || c $ =
'(!! eex x @ !! eexda y @ syl idvd @ eqtrd (anwl @ syl5eq mulass muleq2) anr);

theorem dvdmul12: $ a || b -> a || c * b $ = '(mpi dvdmul1 dvdtr);
theorem dvdmul11: $ a || b -> a || b * c $ = '(mpi dvdmul2 dvdtr);

theorem modeq0: $ a % n = 0 <-> n || a $ =
'(! ibii _ (ex x _)
  (iexde @ eqtrd (anwr muleq1) @ syl5eq mulcom @
    syl5eqr add0 @ eqtr3d (anwl addeq2) @ a1i divmod)
  (eex @ syl6eq mulmod2 @ modeqd eqcom eqidd));

theorem dvd02: $ a || 0 $ = '(idvd mul01);
theorem dvd01: $ 0 || a <-> a = 0 $ =
'(ibii (!! eex x @ eqcomd @ bi1 @ eqeq1 mul02) (mpbiri dvd02 dvdeq2));

theorem dvdid: $ a || a $ = '(idvd mul11);

theorem dvdle (h1: $ G -> b != 0 $) (h2: $ G -> a || b $): $ G -> a <= b $ =
'(mpd h2 @ !! eexda x @ mpbid (leeqd (a1i mul11) anr) @
  syl lemul1a @ sylibr lt01 @ mtand (anwl h1) @
  eqtr3d anlr @ syl6eq mul01 (anwr muleq1));

theorem dvdasymd (h1: $ G -> a || b $) (h2: $ G -> b || a $): $ G -> a = b $ =
'(casesda (eqtr4d anr (sylib dvd01 @ mpbid (anwr dvdeq1) (anwl h1))) @
  casesda (eqtr4d (sylib dvd01 @ mpbid (anwr dvdeq1) (anwll h2)) anr) @
  leasymd (dvdle anr @ anwll h1) (dvdle anlr @ anwll h2));

theorem dvd11: $ 1 || a $ = '(idvd mul12);
theorem dvd12: $ a || 1 <-> a = 1 $ =
'(ibii (leasymd (dvdle (a1i d1ne0) id) @
    sylibr le11 @ mtani d1ne0 @ sylib dvd01 @ mpbid (anwr dvdeq1) anl)
  (mpbiri dvdid dvdeq1));

theorem d2dvd1: $ ~2 || 1 $ = '(mt (dvdle (a1i d1ne0) id) @ mpbi ltnle d1lt2);

theorem d2dvdS: $ 2 || suc n <-> ~2 || n $ =
(named '(ibii
  (mtd (a1i d2dvd1) @ exp @ mpbird (syl6bb (dvdeq2 add12) (anwr dvdadd1)) anl)
  ,(induct '(ind) 'n
    '(orl dvd02)
    '(eor (orrd @ sylib (dvdeq2 @ eqtr addS @ suceq add12) @ mpbii dvdid dvdadd1) orl))));

theorem modlteq: $ a < n -> a % n = a $ =
'(anrd @ eqdivmod id @ a1i @ eqtr (addeq1 mul0) add01);

theorem modmodid: $ a % n % n = a % n $ =
'(cases (modeqd (syl6eq mod0 modeq2) eqidd) (syl modlteq modlt));

theorem dvdsubmod: $ n || a - a % n $ = '(idvd2 @ eqcom @ eqsub1 @ divmod);

theorem div2lt: $ 0 < n -> n // 2 < n $ =
'(sylibr (divltmul1 d2ne0) @ sylib (lteq1 mul11) @ mpbii d1lt2 ltmul1);

theorem boolmod2: $ bool (n % 2) $ = '(modlt d2ne0);

@(add-eval @ fn (n a b) (def e (eval n)) {{(eval a) % e} = {(eval b) % e}})
@_ local def eqm (n a b) = $ a % n = b % n $;
notation eqm (n a b) = ($mod($:50) n ($):$:50) a ($=$:50) b;

theorem eqmid: $ mod(n): a = a $ = 'eqid;
theorem eqmtr: $ mod(n): a = b -> mod(n): b = c -> mod(n): a = c $ = 'eqtr;
theorem eqmcom: $ mod(n): a = b -> mod(n): b = a $ = 'eqcom;
theorem eqmcomb: $ mod(n): a = b <-> mod(n): b = a $ = '(ibii eqmcom eqmcom);

theorem eqeqm: $ a = b -> mod(n): a = b $ = '(mpbii eqmid eqmeq3);
theorem eqeqmd (h: $ G -> a = b $): $ G -> mod(n): a = b $ = '(syl eqeqm h);

theorem eqmeq23d (h1: $ G -> a = b $) (h2: $ G -> c = d $):
  $ G -> (mod(n): a = c <-> mod(n): b = d) $ = '(eqmeqd eqidd h1 h2);

theorem eqmeqm23d (h1: $ G -> mod(n): a = b $) (h2: $ G -> mod(n): c = d $):
  $ G -> (mod(n): a = c <-> mod(n): b = d) $ =
'(ibida
  (sylc eqmtr (syl eqmcom @ anwl h1) @ sylc eqmtr anr @ anwl h2)
  (sylc eqmtr (anwl h1) @ sylc eqmtr anr @ syl eqmcom @ anwl h2));

theorem eqmmod: $ mod(n): a % n = a $ = 'modmodid;

theorem eqm03: $ mod(n): a = 0 <-> n || a $ = '(bitr (eqeq2 mod01) modeq0);
theorem eqmid0: $ mod(n): n = 0 $ = '(mpbir eqm03 dvdid);

theorem eqmdvdsub: $ a <= b -> (mod(n): a = b <-> n || b - a) $ =
(focus
  (have 'h $ a <= b -> b - a % n = b - a + (a - a % n) $
    '(syl eqsub1 @ syl5eq addass @ syl5eq (addeq2 @ npcan modle1) npcan))
  '(ibida
    (sylibr (dvdadd2 dvdsubmod) @
      mpbiri dvdsubmod @ dvdeqd eqidd @ eqtr3d (anwl h) (anwr subeq2))
    (casesda _ _))
  (focus
    '(modeq1d @ eqtr3d
      (syl6eq add01 @ addeq1d @ sylib dvd01 @ mpbid (anwr dvdeq1) anlr)
      (anwll npcan)))
  (focus
    '(eqcomd @ anrd @ eqdivmod (anwr modlt) @ eqtrd
      (addeq1d @ syl5eq muladd @ eqtr4d _ @ anwll h)
      (syl npcan @ letrd (a1i modle1) anll))
    '(addeqd (syl muldiv3 anlr) @ a1i @ eqcom @ eqsub1 divmod)));

theorem eqmaddlem: $ a <= b -> (mod(n): a + c = b + c <-> mod(n): a = b) $ =
'(bitr4d (sylbi leadd1 eqmdvdsub) @ syl6bbr (dvdeq2 pnpcan2) eqmdvdsub);

theorem eqmadd1: $ mod(n): a + c = b + c <-> mod(n): a = b $ =
'(eor eqmaddlem (syl5bb eqmcomb @ syl6bb eqmcomb eqmaddlem) leorle);
theorem eqmadd2: $ mod(n): a + b = a + c <-> mod(n): b = c $ =
'(bitr (eqmeq eqid addcom addcom) eqmadd1);
theorem eqmsuc: $ mod(n): suc a = suc b <-> mod(n): a = b $ =
'(bitr3 (eqmeq eqid add12 add12) eqmadd1);

theorem eqmadd1d (h: $ G -> mod(n): a = b $): $ G -> mod(n): a + c = b + c $ =
'(sylibr eqmadd1 h);
theorem eqmadd2d (h: $ G -> mod(n): b = c $): $ G -> mod(n): a + b = a + c $ =
'(sylibr eqmadd2 h);

theorem eqmaddd (h1: $ G -> mod(n): a = b $) (h2: $ G -> mod(n): c = d $):
  $ G -> mod(n): a + c = b + d $ =
'(sylc eqmtr (eqmadd1d h1) (eqmadd2d h2));

theorem eqmdvd: $ mod(n): a = b -> (n || a <-> n || b) $ = '(bitr3g eqm03 eqm03 eqeq1);

theorem eqmaddn: $ mod(n): a + n = a $ =
'(mpbi (eqmeq3 add0) @ mpbir eqmadd2 eqmid0);

theorem dvdeqm (h1: $ G -> m || n $)
  (h2: $ G -> mod(n): a = b $): $ G -> mod(m): a = b $ =
'(mpi leorle @ eorda
  (mpbird (anwr eqmdvdsub) @ sylc dvdtr (anwl h1) @ mpbid (anwr eqmdvdsub) (anwl h2))
  (syl eqmcom @
    mpbird (anwr eqmdvdsub) @ sylc dvdtr (anwl h1) @
    mpbid (anwr eqmdvdsub) (anwl @ syl eqmcom h2)));

theorem modmod: $ m || n -> a % n % m = a % m $ = '(dvdeqm id @ a1i eqmmod);

theorem eqm11: $ mod(1): a = b $ = '(eqtr4 mod12 mod12);
theorem eqm01: $ mod(0): a = b <-> a = b $ = '(eqeq mod0 mod0);

--| `b0 n` is `n * 2`.
--| It is named for "bit 0" as in binary representation of numbers.
--|
--| `b0` is also used as left injection when creating disjoint unions.
@(add-eval @ fn (a) {(eval a) shl 1})
@_ def b0 (n: nat): nat = $ n + n $;

--| `b1 n` is `n * 2 + 1`.
--| It is named for "bit 1" as in binary representation of numbers.
--|
--| `b1` is also used as right injection when creating disjoint unions.
@(add-eval @ fn (a) {{(eval a) shl 1} + 1})
@_ def b1 (n: nat): nat = $ suc (b0 n) $;

--| `odd n` means `n` is odd, not divisible by 2.
@(add-eval @ fn (a) {{(eval a) band 1} = 1})
@_ def odd (n: nat): wff = $ n % 2 = 1 $;

theorem b00: $ b0 0 = 0 $ = 'add0;
theorem b10: $ b1 0 = 1 $ = '(suceq b00);

theorem b0mul21: $ 2 * n = b0 n $ = 'mul21;
theorem b0mul22: $ n * 2 = b0 n $ = 'mul22;

theorem b0ne0: $ b0 n != 0 <-> n != 0 $ =
'(bitr3 (neeq1 b0mul21) @ bitr mulne0 @ bian1 d2ne0);

theorem b1ne0: $ b1 n != 0 $ = 'peano1;

theorem b1mul21: $ 2 * n + 1 = b1 n $ = '(eqtr (addeq1 b0mul21) add12);

theorem b0dvd2: $ 2 || b0 n $ = '(idvd b0mul22);
theorem b1dvd2: $ ~2 || b1 n $ = '(mpbi (con2b d2dvdS) b0dvd2);

theorem dfodd2: $ odd n <-> true (n % 2) $ = '(bicom @ dftrue2 boolmod2);
theorem odddvd: $ odd n <-> ~ 2 || n $ = '(bitr dfodd2 @ noteq modeq0);
theorem boolodd: $ bool n -> (odd n <-> true n) $ = '(syl5bb dfodd2 @ trueeqd modlteq);

theorem b0odd: $ ~odd (b0 n) $ = '(mpbi (con2b odddvd) b0dvd2);
theorem b1odd: $ odd (b1 n) $ = '(mpbir odddvd b1dvd2);
theorem oddnat: $ odd (nat p) <-> p $ = '(bitr (boolodd boolnat) truenat);

theorem b0mod2: $ b0 n % 2 = 0 $ = '(mpbir modeq0 b0dvd2);
theorem b1mod2: $ b1 n % 2 = 1 $ = 'b1odd;

theorem b0div2: $ b0 n // 2 = n $ = '(eqtr3 (diveq1 b0mul21) (muldiv2 d2ne0));
theorem b1div2: $ b1 n // 2 = n $ =
'(trud @ anld @ eqdivmod (a1i d1lt2) (a1i b1mul21));
theorem b0can: $ b0 a = b0 b <-> a = b $ =
'(ibii (sylib (eqeq b0div2 b0div2) diveq1) b0eq);
theorem b1can: $ b1 a = b1 b <-> a = b $ =
'(ibii (sylib (eqeq b1div2 b1div2) diveq1) b1eq);
theorem b1neb0: $ b1 a != b0 b $ = '(mt (mpbii b1odd oddeq) b0odd);
theorem b0neb1: $ b0 a != b1 b $ = '(necom b1neb0);

theorem sucb0: $ suc (b0 a) = b1 a $ = 'eqid;
theorem sucb1: $ suc (b1 a) = b0 (suc a) $ = '(eqtr2 addS1 @ suceq addS);
theorem addb00: $ b0 a + b0 b = b0 (a + b) $ = 'add4;
theorem addb01: $ b0 a + b1 b = b1 (a + b) $ = '(eqtr addS @ suceq addb00);
theorem addb10: $ b1 a + b0 b = b1 (a + b) $ = '(eqtr addcom @ eqtr addb01 @ b1eq addcom);
theorem addb11: $ b1 a + b1 b = b0 (suc (a + b)) $ = '(eqtr addS @ eqtr (suceq addb10) sucb1);

theorem b0le: $ a <= b <-> b0 a <= b0 b $ =
'(bitr (lemul2 d0lt2) (leeq b0mul21 b0mul21));
theorem b1le: $ a <= b <-> b1 a <= b1 b $ = '(bitr b0le lesuc);

theorem b0lt: $ a < b <-> b0 a < b0 b $ =
'(bitr (ltmul2 d0lt2) (lteq b0mul21 b0mul21));
theorem b1lt: $ a < b <-> b1 a < b1 b $ = '(bitr b0lt ltsuc);
theorem b0ltb1: $ b0 a < b1 b <-> a <= b $ = '(bicom b1le);
theorem b1ltb0: $ b1 a < b0 b <-> a < b $ =
'(bitr ltsuc @ bitr (lteq sucb1 sucb0) b0ltb1);
theorem b0leb1: $ b0 a <= b1 b <-> a <= b $ =
'(bitr4 lenlt @ bitr4 lenlt @ noteq b1ltb0);
theorem b1leb0: $ b1 a <= b0 b <-> a < b $ =
'(bitr4 lenlt @ bitr4 ltnle @ noteq b0ltb1);

theorem b0orb1: $ n = b0 (n // 2) \/ n = b1 (n // 2) $ =
'(rsyl (con3 @ eqcomd @ syl5eqr b0mul21 muldiv3) @
  sylbir odddvd @ syl5eqr divmod @ syl6eq b1mul21 addeq2);

theorem b0leid: $ n <= b0 n $ = 'leaddid1;
theorem b1ltid: $ n < b1 n $ = '(mpbi leltsuc b0leid);
theorem b1leid: $ n <= b1 n $ = '(ltle b1ltid);
theorem b0ltid: $ n != 0 <-> n < b0 n $ = '(bitr3 lt01 @ bitr ltadd2 @ lteq1 add0);

theorem ltb0tr (h: $ a < b $): $ a < b0 b $ = '(ltletr h b0leid);
theorem ltb1tr (h: $ a <= b $): $ a < b1 b $ = '(lelttr h b1ltid);
theorem leb0tr (h: $ a <= b $): $ a <= b0 b $ = '(letr h b0leid);
theorem leb1tr (h: $ a <= b $): $ a <= b1 b $ = '(ltle @ ltb1tr h);

theorem eqb0: $ ~ odd n <-> n = b0 (n // 2) $ =
'(ibii (con1 @ rsyl b0orb1 @ mpbiri b1odd oddeq) (mpbiri b0odd (noteqd oddeq)));
theorem eqb1: $ odd n <-> n = b1 (n // 2) $ =
'(ibii (syl b0orb1 @ con2 @ mpbiri b0odd @ noteqd oddeq) (mpbiri b1odd oddeq));

theorem splitb (h0: $ G -> a = b0 (a // 2) -> p $) (h1: $ G -> a = b1 (a // 2) -> p $): $ G -> p $ =
'(mpi b0orb1 @ eord h0 h1);

theorem splitb0 (h: $ G -> a = b0 c -> p $): $ G -> b = c -> a = b0 b -> p $ =
'(exp @ exp @ sylc h anll @ eqtrd anr @ b0eqd anlr);

theorem splitb1 (h: $ G -> a = b1 c -> p $): $ G -> b = c -> a = b1 b -> p $ =
'(exp @ exp @ sylc h anll @ eqtrd anr @ b1eqd anlr);

theorem odd0: $ ~ odd 0 $ = '(mtbir (eqeq1 mod01) (mt eqcom d1ne0));
theorem oddS: $ odd (suc n) <-> ~odd n $ =
'(bitr odddvd @ noteq @ bitr4 d2dvdS odddvd);
theorem odd1: $ odd 1 $ = '(mpbir oddS odd0);

--| `a, b` is the pairing operator on natural numbers
--| (or anything that is being encoded as a natural number).
--| It is defined using the Cantor pairing function.
--| It is right associative, i.e. `a, b, c` means `(a, (b, c))`.
@(add-eval @ fn (a b) (cons (eval a) (eval b)))
@_ def pr (a b: nat): nat = $ (a + b) * suc (a + b) // 2 + b $;
infixr pr: $,$ prec 55;

theorem nfpr (a b: nat x) (h1: $ FN/ x a $) (h2: $ FN/ x b $): $ FN/ x a, b $ =
'(!! nfnlem2 _ y z (preqd anl anr) h1 h2);

theorem preqadd: $ a, b = (a + b, 0) + b $ =
'(eqcom @ addeq1 @ eqtr add0 @ diveq1 @ muleq add0 @ suceq add0);

theorem prlem1: $ 2 || n * suc n $ = '(cases dvdmul11 @ sylbir d2dvdS dvdmul12);

theorem prlem2: $ a, c <= b, d -> a + c <= b + d $ =
(focus
  '(sylibr lenlt @ mtd (sylib ltnle _) (exp @ sylibr (lemul2 d0lt2) _))
  '(lelttrd (letr leaddid1) @ a1i @ mpbi ltadd2 @ mpbi leltsuc leaddid2)
  '(mpbird
    (leeqd
      (syl6eqr addmul @ syl5eq muladd @ addeq1d @ a1i @ muldiv3 prlem1)
      (a1i @ eqtr (muldiv3 prlem1) mulcom))
    (lemuld (sylibr (leeq1 addS) @ sylib lesuc @ sylibr (leeq1 add12) anr) anr)));

theorem prth: $ a, c = b, d <-> a = b /\ c = d $ =
(focus
  '(ibii _ (preqd anl anr))
  (have 'h $ a, c = b, d -> a + c = b + d $
    '(leasymd (syl prlem2 eqle) (syl prlem2 eqler)))
  (have 'h2 $ a, c = b, d -> c = d $
    '(sylib addcan2 @ mpbid (rsyl h @ eqeq1d @
      addeq1d @ diveq1d @ muleqd id suceq) id))
  '(iand (sylib addcan1 @ eqtr4d h @ sylibr addcan2 h2) h2));

theorem prltsuc: $ a, b < suc (a + b), 0 $ =
'(mpbir ltnle @ mt prlem2 @ mpbi ltnle @ mpbir (lteq2 add0) ltsucid);

theorem addlepr: $ a + b <= a, b $ =
'(letr
  (cases (mpbiri le01 leeq1) @ sylibr (ledivmul2 d2ne0) @
    sylbi (bitr3 le11 lesuc) lemul2a)
  leaddid1);

theorem leprid1: $ a <= a, b $ = '(letr leaddid1 addlepr);
theorem leprid2: $ b <= a, b $ = '(letr leaddid2 addlepr);

theorem lepr1tr (h: $ a <= b $): $ a <= b, c $ = '(letr h leprid1);
theorem lepr2tr (h: $ a <= c $): $ a <= b, c $ = '(letr h leprid2);
theorem ltpr1tr (h: $ a < b $): $ a < b, c $ = '(ltletr h leprid1);
theorem ltpr2tr (h: $ a < c $): $ a < b, c $ = '(ltletr h leprid2);

theorem lepr1: $ a <= b <-> a, c <= b, c $ =
'(ibii
  (syla contra @ syl eqle @ preq1d @
    leasymd anl @ sylibr leadd1 @ syl prlem2 @ anwr leorle)
  (sylibr leadd1 prlem2));
theorem lepr2: $ b <= c <-> a, b <= a, c $ =
'(ibii
  (syla contra @ syl eqle @ preq2d @
    leasymd anl @ sylibr leadd2 @ syl prlem2 @ anwr leorle)
  (sylibr leadd2 prlem2));

theorem ltpr1: $ a < b <-> a, c < b, c $ =
'(bitr4gi ltnle ltnle @ noteq lepr1);
theorem ltpr2: $ b < c <-> a, b < a, c $ =
'(bitr4gi ltnle ltnle @ noteq lepr2);

do {
  (def (eval-fst a) @ match a [(x . _) x] [0 0])
  (def (eval-snd a) @ match a [(_ . x) x] [0 0])
  (def (eval-pr a) @ match a [(and x (_ . _)) x] [0 (cons 0 0)])
};

--| The first component of a pair.
@(add-eval @ fn (a) (eval-fst (eval a)))
@_ abstract def fst (a: nat): nat = $ the {x | E. y a = x, y} $;
--| The second component of a pair.
@(add-eval @ fn (a) (eval-snd (eval a)))
@_ abstract def snd (a: nat): nat = $ the {y | E. x a = x, y} $;

pub theorem pr0: $ 0, 0 = 0 $ =
'(eqtr (addeq1 @ eqtr (diveq1 @ eqtr (muleq1 add0) mul01) div01) add0);

theorem expr: $ E. x E. y a = x, y $ =
(named @ focus
  (induct '(ind) 'a
    '(iexie @ iexde @ syl5eqr pr0 @ eqcomd @ imp preq)
    '(sylib (cbvex @ cbvexd @ eqeq2d @ preqd anl anr) @
      eex @ eex @ casesd _ _))
  (focus
    '(exp @ iexde @ iexde _)
    (have 'h3 $ _ /\ m = suc y /\ n = 0 -> m + n = suc y $
      '(syl6eq add0 (addeqd anlr anr)))
    (have 'h4 $ _ /\ x = 0 /\ m = suc y /\ n = 0 -> x + y = y $
      '(syl6eq add01 @ addeq1d @ anwll anr))
    '(eqtrd (suceqd an3l) @ syl5eqr addS @ eqtr4d (sylib (mulcan2 d2ne0) _)
      (syl6eq add0 @ addeqd (diveq1d @ muleqd h3 @ suceqd h3) anr))
    '(syl5eq muladd @ syl6eqr (eqtr (muldiv3 prlem1) mulcom) _)
    '(eqtrd
      (addeq1d @ syl5eq (muldiv3 prlem1) @ muleqd h4 @ suceqd h4)
      (syl5eqr addmul @ a1i @ muleq1 @ eqtr addS @ suceq add12)))
  (focus
    (have 'h $ _ /\ x = suc z /\ m = z /\ n = suc y -> x + y = m + n $
      '(eqtr4d
        (syl6eq addSass @ anwll @ anwr addeq1)
        (addeqd anlr anr)))
    '(syl5bi exsuc @ eexda @ iexde @ iexde @
      eqtrd (anw3l suceq) @ syl5eqr addS @ addeqd
      (diveq1d @ muleqd h @ suceqd h) (eqcomd anr))));

theorem splitpr {x y} (h: $ G -> a = x, y -> p $): $ G -> p $ =
'(mpi expr @ eexd @ eexd h);

theorem splitpr1 (h: $ G -> a = x, y -> p $): $ G -> b = x -> a = b, y -> p $ =
'(exp @ exp @ sylc h anll @ eqtrd anr @ preq1d anlr);

theorem splitpr2 (h: $ G -> a = x, y -> p $): $ G -> b = y -> a = x, b -> p $ =
'(exp @ exp @ sylc h anll @ eqtrd anr @ preq2d anlr);

theorem splitopt (h0: $ G -> a = 0 -> p $) (h1: $ G -> a = suc (a - 1) -> p $): $ G -> p $ =
'(casesd h0 @ syl5 (eqcomd sub1can) h1);

theorem splitoptS (h: $ G -> a = suc c -> p $): $ G -> b = c -> a = suc b -> p $ =
'(exp @ exp @ sylc h anll @ eqtrd anr @ suceqd anlr);

do {
  --| `(splitpr n h)` proves `G -> p` if `h: |- G -> a = a1, ..., an -> p`
  --| (where `n >= 1`)
  (def (splitpr n h)
    @ if {n = 1} (list 'eqerd h) @
    iterate {n - 2} (fn (x) '(! splitpr _ _ _ _ ,(dummy! 'nat) ,x)) @ list 'splitpr @
    iterate {n - 2} (fn (x) '(splitpr2 ,x)) h)

  --| Performs a case analysis on sums of products.
  --| Proves `G -> p` given proofs of facts like `G /\ a = b0 (b1 (b0 (a1, ..., an))) -> p`.
  --| The input takes a form such as `(split-sop '{(1 => pr1) + {(3 => pr2) + (2 => pr3)}})`,
  --| which expects:
  --|   * `pr1: G /\ ?a = b0 ?x1 -> p`
  --|   * `pr2: G /\ ?a = b1 (b0 (?y1, ?y2, ?y3)) -> p`
  --|   * `pr3: G /\ ?a = b1 (b1 (?z1, ?z2)) -> p`
  --| The alternative form `n as e => p` provides an expression `e` for each branch
  --| in place of e.g. `b1 (b0 (a, b, c))`.
  --|
  --| Using `o` in place of `+` allows for splitting along optionals or casing on natural numbers, e.g.
  --| `(split-sop '{($0$ => pr1) o ($1$ => pr2) o ($suc (a : b)$ => pr3)})` which expects
  --|   * `pr1: G /\ ?a = 0 -> p`
  --|   * `pr2: G /\ ?a = 1 -> p`
  --|   * `pr3: G /\ ?a = suc (a : b) -> p`
  (def (split-sop . hs)
    @ match (match hs [(hs) '(_ ,hs)] [e e]) @ (lhs . hs)
    @ match (match hs [(hs) '(,(fn (x) '(exp ,x)) ,hs)] [e e]) @ (f hs)
    (def (base e h) '{,(apply f h) : $ _ -> ,lhs = ,e -> _ $})
    @ letrec
      -- Here (f g): $ G -> p $ assuming g is such that
      -- (g h): $ G -> x2 = F x3 -> x1 = G x2 -> a = H x1 -> p $ given
      -- h: $ G -> a = H (G (F x3)) -> p $
      ([(f hs g) @ match hs
        [{hs0 '+ hs1} @ list 'splitb
          (f hs0 @ fn (x) '(splitb0 ,(g x)))
          (f hs1 @ fn (x) '(splitb1 ,(g x)))]
        [('o (e '=> . h) hs1 . hsS) @ list 'splitopt
          (g (base e h))
          (f (cons 'o hs1 hsS) @ fn (x) '(splitoptS ,(g x)))]
        [('o hs) (f hs g)]
        [((? number? n) '=> . h) (splitpr n (g (base _ h)))]
        [((? number? n) 'as e '=> . h) (splitpr n (g (base e h)))]
        [((and e (...)) '=> . h) (splitpr {(len e) - 1} (g (base e h)))]])
    (f hs id))
};

pub theorem fstpr (a b: nat): $ fst (a, b) = a $ =
'(trud @ !! eqtheabd x @ a1i @ ibii
  (!! eex y @ sylbi prth @ eqcomd anl)
  (rsyl (eqcomd preq1) @ iexe @ eqeq2d preq2));
pub theorem sndpr (a b: nat): $ snd (a, b) = b $ =
'(trud @ !! eqtheabd y @ a1i @ ibii
  (!! eex x @ sylbi prth @ eqcomd anr)
  (rsyl (eqcomd preq2) @ iexe @ eqeq2d preq1));
pub theorem fstsnd (a: nat): $ fst a, snd a = a $ =
'(!! eex x (!! eex y @ eqtr4d (preqd (syl6eq fstpr fsteq) (syl6eq sndpr sndeq)) id) expr);

theorem fstleid: $ fst a <= a $ = '(mpbi (leeq2 fstsnd) leprid1);
theorem sndleid: $ snd a <= a $ = '(mpbi (leeq2 fstsnd) leprid2);

theorem axext2: $ A == B <-> A. x A. y (x, y e. A <-> x, y e. B) $ =
'(bitr (aleqi @ bitr3 (biim1 expr) @ bitr eexb @ aleqi eexb) @
  bitr alcomb @ aleqi @ bitr alcomb @ aleqi @ !! aleqe p @ bieqd eleq1 eleq1);
theorem eqrd2 (G) {x y} (h: $ G -> (x, y e. A <-> x, y e. B) $): $ G -> A == B $ =
'(sylibr axext2 @ iald @ iald h);
theorem eqri2 {x y} (h: $ x, y e. A <-> x, y e. B $): $ A == B $ = '(trud @ eqrd2 @ a1i h);
theorem ssal2: $ A C_ B <-> A. x A. y (x, y e. A -> x, y e. B) $ =
'(bitr (aleqi @ bitr3 (biim1 expr) @ bitr eexb @ aleqi eexb) @
  bitr alcomb @ aleqi @ bitr alcomb @ aleqi @ !! aleqe p @ imeqd eleq1 eleq1);
theorem ssrd2 (G) {x y} (h: $ G -> x, y e. A -> x, y e. B $): $ G -> A C_ B $ =
'(sylibr ssal2 @ iald @ iald h);
theorem ssri2 {x y} (h: $ x, y e. A -> x, y e. B $): $ A C_ B $ = '(trud @ ssrd2 @ a1i h);

theorem fst0: $ fst 0 = 0 $ = '(eqtr3 (fsteq pr0) fstpr);
theorem snd0: $ snd 0 = 0 $ = '(eqtr3 (sndeq pr0) sndpr);

--| `pi11 ((a, b), c) = a`
@(add-eval @ fn (a) (eval-fst @ eval-fst @ eval a))
@_ def pi11 (n: nat): nat = $ fst (fst n) $;
--| `pi12 ((a, b), c) = b`
@(add-eval @ fn (a) (eval-snd @ eval-fst @ eval a))
@_ def pi12 (n: nat): nat = $ snd (fst n) $;
--| `pi21 (a, (b, c)) = b`
@(add-eval @ fn (a) (eval-fst @ eval-snd @ eval a))
@_ def pi21 (n: nat): nat = $ fst (snd n) $;
--| `pi22 (a, (b, c)) = c`
@(add-eval @ fn (a) (eval-snd @ eval-snd @ eval a))
@_ def pi22 (n: nat): nat = $ snd (snd n) $;
--| `pi221 (a, (b, (c, d))) = c`
@(add-eval @ fn (a) (eval-fst @ eval-snd @ eval-snd @ eval a))
@_ def pi221 (n: nat): nat = $ fst (pi22 n) $;
--| `pi222 (a, (b, (c, d))) = d`
@(add-eval @ fn (a) (eval-snd @ eval-snd @ eval-snd @ eval a))
@_ def pi222 (n: nat): nat = $ snd (pi22 n) $;

theorem pi11pr: $ pi11 ((a, b), c) = a $ = '(eqtr (fsteq fstpr) fstpr);
theorem pi12pr: $ pi12 ((a, b), c) = b $ = '(eqtr (sndeq fstpr) sndpr);
theorem pi21pr: $ pi21 (a, b, c) = b $ = '(eqtr (fsteq sndpr) fstpr);
theorem pi22pr: $ pi22 (a, b, c) = c $ = '(eqtr (sndeq sndpr) sndpr);
theorem pi221pr: $ pi221 (a, b, c, d) = c $ = '(eqtr (fsteq pi22pr) fstpr);
theorem pi222pr: $ pi222 (a, b, c, d) = d $ = '(eqtr (sndeq pi22pr) sndpr);

--| `isfun A` means `A` is a function,
--| i.e. if `(x,y)` and `(x,z)` are in `A` then `y = z`.
@(derive-eq 'isf) def isfun (A: set): wff =
$ A. a A. b A. b2 (a, b e. A -> a, b2 e. A -> b = b2) $;

theorem nfisf (F: set x) (hF: $ FS/ x F $): $ F/ x isfun F $ =
(named '(nfal @ nfal @ nfal @ nfim (nfel2 hF) @ nfim (nfel2 hF) nfv));

theorem isfd (h1: $ G -> isfun F $)
  (h2: $ G -> a, b e. F $) (h3: $ G -> a, b2 e. F $):
  $ G -> b = b2 $ =
'(mpd h3 @ mpd h2 @ mpd h1 @ !! ealde x @ !! ealde y @ !! ealde z @ bi1d @
  imeqd (eleq1d @ preqd anllr anlr) @
  imeqd (eleq1d @ preqd anllr anr) @ eqeqd anlr anr);

theorem isfbd (h1: $ G -> isfun F $) (h2: $ G -> a, b e. F $):
  $ G -> (a, b2 e. F <-> b = b2) $ =
'(ibida (isfd (anwl h1) (anwl h2) anr) @ mpbid (eleq1d @ anwr preq2) (anwl h2));

theorem isfss: $ A C_ B -> isfun B -> isfun A $ =
'(exp @ !! iald a @ !! iald b @ !! iald c @ exp @ exp @
  isfd anllr (sseld an3l anlr) (sseld an3l anr));

--| `S\ x, A` is "lambda for relations": `a, b e. S\ x, A(x)` if `b e. A(a)`.
--| It can be iterated to produce n-ary relations.
--| `S\ x, S\ y, {z | p(x,y,z)}` is the set `S` such that
--| `x, y, z e. S` iff `p(x,y,z)`.
@_ def sab {x: nat} (A: set x): set = $ {z | snd z e. S[fst z / x] A} $;
notation sab {x: nat} (A: set x): set = ($S\$:100) x ($,$:55) A;

theorem nfsab (A: set x y) (h: $ FS/ y A $): $ FS/ y S\ x, A $ =
(named '(nfab @ nfel2 @ nfsbs h));
theorem nfsab1 (A: set x): $ FS/ x S\ x, A $ =
(named '(nfab @ nfel2 nfsbs1));
theorem sabeq (A B: set x): $ A. x A == B -> S\ x, A == S\ x, B $ =
(named '(abeqd @ eleq2d @ ealeh (nfeqs nfsbs1 nfsbs1) @ eqseqd sbsq sbsq));
theorem sabeqi (A B: set x) (h: $ A == B $): $ S\ x, A == S\ x, B $ = '(sabeq @ ax_gen h);

theorem cbvsabs (A: set x): $ S\ x, A == S\ y, (S[y / x] A) $ =
'(!! abeqi z @ eleq2 @ eqscom sbsco);

theorem elsabs (A: set x): $ a, b e. S\ x, A <-> b e. S[a / x] A $ =
'(!! elabe p @ eleqd (syl6eq sndpr sndeq) (sbseq1d @ syl6eq fstpr fsteq));

theorem elsab (A: set x) (h: $ x = a -> A == B $):
  $ a, b e. S\ x, A <-> b e. B $ =
'(bitr elsabs @ eleq2 @ sbse h);

theorem elsabed (A: set x) (h: $ G /\ x = a -> (b e. A <-> p) $):
  $ G -> (a, b e. S\ x, A <-> p) $ =
'(syl5bb elsabs @ mpi ax_6 @ eexdh nfv (nfbi (nfel2 nfsbs1) nfv) @
  exp @ bitr3d (eleq2d @ anwr sbsq) h);

theorem elsabe (A: set x) (h: $ x = a -> (b e. A <-> p) $):
  $ a, b e. S\ x, A <-> p $ = '(trud @ elsabed @ anwr h);

theorem eexsabd {z} (y: nat x z) (A: set x) (h: $ G -> z e. A -> p $):
  $ G -> y e. S\ x, A -> p $ =
'(syl5 (iexe eleq1) @ !! eexd w @
  syl5bir (eleq1 fstsnd) @ syl5bi elsabs @
  syl5 (iexe eleq1) @ eexd @
  sbethh (nfim nfv @ nfim (nfel2 nfsbs1) nfv) h (imeq2d @ imeq1d @ eleq2d sbsq));

theorem sabss (A B: set x): $ S\ x, A C_ S\ x, B <-> A. x A C_ B $ =
(named @ focus
  '(bitr3 ssab @ ibii _ _)
  (def h '(eleqd (syl6eq sndpr sndeq) @ eqscomd @ syl sbsq @ eqcomd @ syl6eq fstpr fsteq))
  '(ialdh (nfal @ nfim (nfel2 nfsbs1) (nfel2 nfsbs1)) @ iald @ eale @ imeqd ,h ,h)
  '(iald @ syl ssel @ ealeh (nfss nfsbs1 nfsbs1) @ sseqd sbsq sbsq));
theorem sabssi (A B: set x) (h: $ A C_ B $): $ S\ x, A C_ S\ x, B $ = '(mpbir sabss @ ax_gen h);
theorem sabssd (A B: set x) (h: $ G -> A C_ B $): $ G -> S\ x, A C_ S\ x, B $ = '(sylibr sabss @ iald h);

--| Indexed disjoint union, a restricted version of `S\`.
--| `a, b e. X\ x e. A, B(x)` iff `a e. A` and `b e. B(a)`.
@_ def xab {x: nat} (A: set) (B: set x): set =
$ {z | fst z e. A /\ snd z e. S[fst z / x] B} $;
notation xab {x: nat} (A: set) (B: set x): set = ($X\$:100) x ($e.$:50) A ($,$:55) B;

theorem nfxab (A B: set x y) (h1: $ FS/ y A $) (h2: $ FS/ y B $): $ FS/ y X\ x e. A, B $ =
(named '(nfab @ nfan (nfel2 h1) @ nfel2 @ nfsbs h2));
theorem nfxab1 (A B: set x) (h1: $ FS/ x A $): $ FS/ x X\ x e. A, B $ =
(named '(nfab @ nfan (nfel2 h1) @ nfel2 nfsbs1));

theorem xabeq2da (B C: set x) (h: $ G /\ x e. A -> B == C $):
  $ G -> X\ x e. A, B == X\ x e. A, C $ =
'(!! abeqd z @ syl aneq2a @ syl6 eleq2 @
  syl (ealeh (nfim nfv @ nfeqs nfsbs1 nfsbs1) @
    imeqd eleq1 @ eqseqd sbsq sbsq) @ ialda h);

theorem cbvxabs (B: set x): $ X\ x e. A, B == X\ y e. A, (S[y / x] B) $ =
'(!! abeqi z @ aneq2i @ eleq2 @ eqscom sbsco);

theorem elxabs (B: set x):
  $ a, b e. X\ x e. A, B <-> a e. A /\ b e. S[a / x] B $ =
'(!! elabe p @ aneqd (eleq1d @ syl6eq fstpr fsteq) @
  eleqd (syl6eq sndpr sndeq) (sbseq1d @ syl6eq fstpr fsteq));

theorem elxab (B: set x) (h: $ x = a -> B == C $):
  $ a, b e. X\ x e. A, B <-> a e. A /\ b e. C $ =
'(bitr elxabs @ aneq2i @ eleq2 @ sbse h);

theorem elxabed (B: set x) (h: $ G /\ x = a -> (b e. B <-> p) $):
  $ G -> (a, b e. X\ x e. A, B <-> a e. A /\ p) $ =
'(syl5bb elxabs @ mpi ax_6 @ eexdh nfv (nfbi (nfan nfv @ nfel2 nfsbs1) nfv) @
  exp @ aneq2d @ bitr3d (eleq2d @ anwr sbsq) h);

theorem elxabe (B: set x) (h: $ x = a -> (b e. B <-> p) $):
  $ a, b e. X\ x e. A, B <-> a e. A /\ p $ =
'(trud @ elxabed @ anwr h);

theorem elxabe2 (B: set x) (h: $ x = fst a -> (snd a e. B <-> p) $):
  $ a e. X\ x e. A, B <-> fst a e. A /\ p $ =
'(bitr3 (eleq1 fstsnd) @ elxabe h);

theorem xabssd (B C: set x) (h: $ G /\ x e. A -> B C_ C $):
  $ G -> X\ x e. A, B C_ X\ x e. A, C $ =
(named '(ssabd @ syl anim2a @ exp @ syl ssel @
  sbethh (nfim nfv @ nfss nfsbs1 nfsbs1) h @
  imeqd (aneq2d eleq1) (sseqd sbsq sbsq)));

theorem sabxab {y} (B: set x) (h: $ G -> y e. B -> x e. A $):
  $ G -> S\ x, B == X\ x e. A, B $ =
'(!! eqrd2 z y @ bitr4g elsabs elxabs @ bicomd @ syl bian1a @
  sbethh (nfim nfv @ nfim (nfel2 nfsbs1) nfv) h (imeq2d @ imeqd (eleq2d sbsq) eleq1));

--| `Xp A B` is the cartesian product of sets:
--| `(a,b) e. Xp A B` iff `a e. A` and `b e. B`.
@(derive-eq 'xp) def Xp (A B: set): set = $ X\ x e. A, B $;

theorem nfxp (A B: set x) (h1: $ FS/ x A $) (h2: $ FS/ x B $): $ FS/ x Xp A B $ =
'(!! nfxab y _ h1 h2);
theorem prelxp: $ a, b e. Xp A B <-> a e. A /\ b e. B $ = '(!! elxab x eqsidd);
theorem elxp: $ a e. Xp A B <-> fst a e. A /\ snd a e. B $ =
'(bitr3 (eleq1 fstsnd) prelxp);
theorem xpvv: $ Xp _V _V == _V $ =
'(!! eqri p @ bith (mpbir elxp @ ian elv elv) elv);
theorem cplxpv1: $ Compl (Xp _V A) == Xp _V (Compl A) $ =
'(!! eqri p @ bitr elcpl @ bitr4 (noteq @ bitr elxp @ bian1 elv) @
  bitr elxp @ bitr (bian1 elv) elcpl);
theorem cplxpv2: $ Compl (Xp A _V) == Xp (Compl A) _V $ =
'(!! eqri p @ bitr elcpl @ bitr4 (noteq @ bitr elxp @ bian2 elv) @
  bitr elxp @ bitr (bian2 elv) elcpl);
theorem xpss1: $ A C_ B -> Xp A C C_ Xp B C $ =
'(!! iald p @ sylibr (imeqi elxp elxp) @ anim1d ssel);
theorem xpss2: $ B C_ C -> Xp A B C_ Xp A C $ =
'(!! iald p @ sylibr (imeqi elxp elxp) @ anim2d ssel);
theorem xpundi: $ Xp (A u. B) C == Xp A C u. Xp B C $ =
'(!! eqri p @ bitr elxp @ bitr4 (aneq1i elun) @
  bitr elun @ bitr4 (oreq elxp elxp) andir);
theorem xpundir: $ Xp A (B u. C) == Xp A B u. Xp A C $ =
'(!! eqri p @ bitr elxp @ bitr4 (aneq2i elun) @
  bitr elun @ bitr4 (oreq elxp elxp) andi);
theorem xpindi: $ Xp (A i^i B) C == Xp A C i^i Xp B C $ =
'(!! eqri p @ bitr elxp @ bitr4 (aneq1i elin) @
  bitr elin @ bitr4 (aneq elxp elxp) anandir);
theorem xpindir: $ Xp A (B i^i C) == Xp A B i^i Xp A C $ =
'(!! eqri p @ bitr elxp @ bitr4 (aneq2i elin) @
  bitr elin @ bitr4 (aneq elxp elxp) anandi);
theorem xpfst: $ a e. Xp A B -> fst a e. A $ = '(sylbi elxp anl);
theorem xpsnd: $ a e. Xp A B -> snd a e. B $ = '(sylbi elxp anr);
theorem prelxp1: $ a, b e. Xp A B -> a e. A $ = '(sylbi prelxp anl);
theorem prelxp2: $ a, b e. Xp A B -> b e. B $ = '(sylbi prelxp anr);
theorem xpTd (h1: $ G -> a e. A $) (h2: $ G -> b e. B $): $ G -> a, b e. Xp A B $ =
'(sylibr prelxp @ iand h1 h2);

theorem xppi11: $ a e. Xp (Xp A B) C -> pi11 a e. A $ = '(rsyl xpfst xpfst);
theorem xppi12: $ a e. Xp (Xp A B) C -> pi12 a e. B $ = '(rsyl xpfst xpsnd);
theorem xppi21: $ a e. Xp A (Xp B C) -> pi21 a e. B $ = '(rsyl xpsnd xpfst);
theorem xppi22: $ a e. Xp A (Xp B C) -> pi22 a e. C $ = '(rsyl xpsnd xpsnd);
theorem xppi221: $ a e. Xp A (Xp B (Xp C D)) -> pi221 a e. C $ = '(rsyl xppi22 xpfst);
theorem xppi222: $ a e. Xp A (Xp B (Xp C D)) -> pi222 a e. D $ = '(rsyl xppi22 xpsnd);

theorem xpfin: $ finite A -> finite B -> finite (Xp A B) $ =
'(!! eex m @ !! eexda n @ syl (!! iexe z @ aleqd @ imeq2d lteq2) @
  !! iald p @ syl5bi elxp @ syl6
    (sylib (lteq1 fstsnd) @ imp @ sylibr (imeqi ltnle ltnle) @ con3d @
      syl5 prlem2 @ syl5bi (leeq1 add0) @
      syl6ibr leadd2 @ syl letr @ sylib leadd1 ltle)
    (animd
      (anwl @ !! eale x @ imeqd eleq1 lteq1)
      (anwr @ !! eale y @ imeqd eleq1 lteq1)));

theorem xabconst: $ X\ x e. A, B == Xp A B $ =
(named '(eqri2 @ bitr4 (elxab eqsidd) prelxp));

theorem sabssxped (B: set x)
  (h: $ G /\ x = fst a -> snd a e. B -> p /\ x e. A /\ snd a e. C $):
  $ G -> a e. S\ x, B -> p /\ a e. Xp A C $ =
'(syl5bir (bitr3 elsabs @ eleq1 fstsnd) @ syl6ibr (aneq2i elxp) @
  mpi ax_6 @ eexdh nfv (nfim (nfel2 nfsbs1) nfv) @ exp @
  mpbid (anwr @ imeqd (eleq2d sbsq) @ syl6bb anass @ aneq1d @ aneq2d eleq1) h);
theorem sabssxpe (B: set x) (h: $ x = fst a -> snd a e. B -> x e. A /\ snd a e. C $):
  $ a e. S\ x, B -> a e. Xp A C $ =
'(trud @ syl6 anr @ sabssxped @ anwr @ syl6 (anim1 @ trud ian) h);

--| The domain of a binary relation:
--| `x e. Dom A` if there exists `y` such that `(x,y) e. A`.
@(derive-eq 'dm) def Dom (A: set): set = $ {x | E. y x, y e. A} $;
--| The range of a binary relation:
--| `y e. Ran A` if there exists `x` such that `(x,y) e. A`.
@(derive-eq 'rn) def Ran (A: set): set = $ {y | E. x x, y e. A} $;

--| The image of a relation under a set: `y e. F '' A`
--| if there exists `x e. A` such that `(x,y) e. F`.
@(derive-eq 'ima) def Im (F A: set): set = $ {y | E. x (x e. A /\ x, y e. F)} $;
infixl Im: $''$ prec 80;

theorem nfdm (A: set x) (h: $ FS/ x A $): $ FS/ x Dom A $ = (named '(nfab @ nfex @ nfel2 h));
theorem nfrn (A: set x) (h: $ FS/ x A $): $ FS/ x Ran A $ = (named '(nfab @ nfex @ nfel2 h));
theorem eldm: $ a e. Dom A <-> E. y a, y e. A $ = '(!! elabe x @ exeqd @ eleq1d preq1);
theorem elrn: $ a e. Ran A <-> E. x x, a e. A $ = '(!! elabe y @ exeqd @ eleq1d preq2);
theorem preldm: $ a, b e. A -> a e. Dom A $ = '(sylibr eldm @ !! iexe y @ eleq1d preq2);
theorem prelrn: $ a, b e. A -> b e. Ran A $ = '(sylibr elrn @ !! iexe x @ eleq1d preq1);
theorem fsteldm: $ p e. A -> fst p e. Dom A $ = '(sylbir (eleq1 fstsnd) preldm);
theorem sndelrn: $ p e. A -> snd p e. Ran A $ = '(sylbir (eleq1 fstsnd) prelrn);

theorem dmun: $ Dom (A u. B) == Dom A u. Dom B $ =
(named '(ax_gen @ bitr4 eldm @ bitr4 elun @ bitr4 (exeqi elun) @ bitr4 (oreq eldm eldm) exor));
theorem rnun: $ Ran (A u. B) == Ran A u. Ran B $ =
(named '(ax_gen @ bitr4 elrn @ bitr4 elun @ bitr4 (exeqi elun) @ bitr4 (oreq elrn elrn) exor));
theorem dmss: $ A C_ B -> Dom A C_ Dom B $ = '(sylibr equn1 @ sylbi equn1 @ syl5eqsr dmun dmeq);
theorem rnss: $ A C_ B -> Ran A C_ Ran B $ = '(sylibr equn1 @ sylbi equn1 @ syl5eqsr rnun rneq);

theorem ssdm: $ Dom R C_ A <-> R C_ Xp A _V $ =
(named '(bitr4 (aleqi @ bitr (imeq1i eldm) @
  bitr4 eexb @ aleqi @ imeq2i @ bitr prelxp @ bian2 elv) ssal2));
theorem ssrn: $ Ran R C_ A <-> R C_ Xp _V A $ =
(named '(bitr4 (aleqi @ bitr (imeq1i elrn) @
  bitr4 eexb @ aleqi @ imeq2i @ bitr prelxp @ bian1 elv) @ bitr ssal2 alcomb));

theorem dmfin: $ finite A -> finite (Dom A) $ =
(named '(eximi @ iald @ syl5bi eldm @ eexd @
  syl6 (lelttr leprid1) (eale @ imeqd eleq1 lteq1)));
theorem rnfin: $ finite A -> finite (Ran A) $ =
(named '(eximi @ iald @ syl5bi elrn @ eexd @
  syl6 (lelttr leprid2) (eale @ imeqd eleq1 lteq1)));

theorem elima: $ b e. F '' A <-> E. x (x e. A /\ x, b e. F) $ =
'(!! elabe y @ exeqd @ aneq2d @ eleq1d preq2);
theorem elimai: $ a, b e. F -> a e. A -> b e. F '' A $ =
'(expcom @ sylibr elima @ !! iexe x @ aneqd eleq1 @ eleq1d preq1);
theorem imv: $ F '' _V == Ran F $ =
'(!! eqri x @ bitr4 elima @ bitr4 elrn @ !! exeqi y @ bian1 elv);

--| The converse of a relation: `(x,y) e. cnv A` if `(y,x) e. A`.
@_ def cnv (A: set): set = $ S\ x, {y | y, x e. A} $;

theorem prcnv: $ x, y e. cnv A <-> y, x e. A $ = '(elsabe @ elabed ,eqtac);

theorem cnvopab (p: wff x y): $ cnv (S\ x, {y | p}) == S\ y, {x | p} $ =
(named '(eqri2 @ bitr prcnv @
  bitr elsabs @ bitr elsbs @ bitr4 (sbeq2i elab) @
  bitr elsabs @ bitr elsbs @ bitr4 (sbeq2i elab) sbcom));

--| The relational composition: `(x,z) e. F o> G` if there exists `y` such that
--| `(x,y) e. F` and `(y,z) e. G`. *Warning*: This is also applicable for functions,
--| but it does not match the more conventional right-to-left composition order.
--| `(F o> G) @ x = G @ (F @ x)`. We use an arrow like notation
--| `o>` to remind the reader of this: we apply `F` *then* `G`.
@(derive-eq 'co) def comp (F G: set): set =
$ S\ x, {z | E. y (x, y e. F /\ y, z e. G)} $;
infixr comp: $o>$ prec 91;

theorem prco: $ x, z e. A o> B <-> E. y (x, y e. A /\ y, z e. B) $ =
'(elsabe @ elabed ,eqtac);

--| The restriction of a relation to a set: `A |` B` is
--| the set of `(x,y) e. A` such that `x e. B`.
@_ def res (A B: set): set = $ A i^i Xp B _V $;
infixl res: $|`$ prec 54;

theorem nfres (A B: set x) (h1: $ FS/ x A $) (h2: $ FS/ x B $): $ FS/ x A |` B $ =
'(nfin h1 @ nfxp h2 nfsv);
theorem elres: $ a e. A |` B <-> a e. A /\ fst a e. B $ =
'(bitr elin @ aneq2i @ bitr elxp @ bian2 elv);
theorem prelres: $ a, b e. A |` B <-> a, b e. A /\ a e. B $ =
'(bitr elres @ aneq2i @ eleq1 fstpr);
theorem resss: $ A |` B C_ A $ = 'inss1;
theorem resv: $ F |` _V == F $ = '(eqstr (ineq2 xpvv) inv2);
theorem resfin: $ finite F -> finite (F |` A) $ = '(finss resss);
theorem resisf: $ isfun F -> isfun (F |` A) $ = '(isfss resss);
theorem dmres: $ Dom (F |` A) == Dom F i^i A $ =
'(!! eqri x @ bitr (!! eldm y) @ bitr4 (exeqi prelres) @
  bitr elin @ bitr4 (aneq1i eldm) exan2);
theorem rnres: $ Ran (F |` A) == F '' A $ =
(named '(abeqi @ exeqi @ bitr prelres ancomb));
theorem unres: $ (F u. G) |` A == (F |` A) u. (G |` A) $ = 'indir;
theorem resun: $ F |` (A u. B) == (F |` A) u. (F |` B) $ = '(eqstr (ineq2 xpundi) indi);
theorem eqres: $ Dom F C_ A <-> F |` A == F $ = '(bitr ssdm eqin1);
theorem resdm: $ F |` Dom F == F $ = '(mpbi eqres ssid);
theorem resres: $ F |` A |` B == F |` A i^i B $ = '(eqstr4 inass @ ineq2 xpindi);

--| The lambda operator: `\ x, v(x)` is the set of pairs `(x, v(x))` over
--| all natural numbers `x`.
@_ def lam {x: nat} (a: nat x): set = $ {p | E. x p = x, a} $;
notation lam {x: nat} (a: nat x): set = ($\$:53) x ($,$:55) a;

theorem ellam (a: nat x): $ p e. \ x, a <-> E. x p = x, a $ =
'(!! elabe q @ exeqd eqeq1);
theorem prellams (v: nat x): $ a, b e. \ x, v <-> b = N[a / x] v $ =
'(bitr ellam @ bitr (exeqi @ bitr prth @ aneq1i eqcomb) @
  bitr3 dfsb3 @ sbeh (nf_eq nfnv nfsbn1) @ eqeq2d sbnq);
theorem prellame (a: nat x) (h: $ x = y -> a = b $): $ y, z e. \ x, a <-> z = b $ =
'(bitr prellams @ eqeq2 @ sbne h);
theorem lameq (a b: nat x): $ A. x a = b -> \ x, a == \ x, b $ =
'(sylib (!! abeqb p) @ iald @ syl exeq @ alimi @ eqeq2d preq2);
theorem lameqi (a b: nat x) (h: $ a = b $): $ \ x, a == \ x, b $ = '(lameq @ ax_gen h);
theorem nflam1 (a: nat x): $ FS/ x \ x, a $ = '(!! nfab _ p nfex1);
theorem nflam (a: nat x y) (h: $ FN/ x a $): $ FS/ x \ y, a $ =
'(!! nfab _ p @ nfex @ nf_eq nfnv @ nfpr nfnv h);
theorem cbvlamh (a b: nat x y) (h1: $ FN/ y a $) (h2: $ FN/ x b $)
  (e: $ x = y -> a = b $): $ \ x, a == \ y, b $ =
'(!! cbvab p1 p2 @ syl5bb
  (cbvexh (nfeq2 @ nfpr nfnv h1) (nfeq2 @ nfpr nfnv h2) @ eqeq2d @ preqd id e) @
  exeqd eqeq1);
theorem cbvlam (a: nat x) (b: nat y)
  (e: $ x = y -> a = b $): $ \ x, a == \ y, b $ = '(cbvlamh nfnv nfnv e);
theorem cbvlams (a: nat x): $ \ x, a == \ y, N[y / x] a $ = '(cbvlamh nfnv nfsbn1 sbnq);
theorem cbvlamd (G) (a: nat x) (b: nat y)
  (h: $ G /\ x = y -> a = b $): $ G -> \ x, a == \ y, b $ =
'(eqstrd (a1i cbvlams) @ lameqd @ syl sbnet @ ialda h);

theorem lamisf (a: nat x): $ isfun (\ x, a) $ =
'(!! ax_gen u @ !! ax_gen v @ !! ax_gen w @
  sylbi ellam @ eexh (nfim (nfel2 nflam1) nfv) @ sylbi prth @
  syl5bi (bitr ellam @
    cbvexh nfv (nfeq2 @ nfpr nfnv nfsbn1) @ eqeq2d @ preqd id sbnq) @
  !! eexd y @ syl5bi prth @ exp @ eqtr4d anlr @ eqtr4d anrr @ syl sbnq @
  eqtr3d anll anrl);

theorem finlam (v: nat x): $ finite A -> finite ((\ x, v) |` A) $ =
(named @ focus
  (have 'h $ E. n A. x (x < m -> x, v < n) $ (induct '(ind) 'm
    '(iexie @ iald @ a1i @ absurd lt02)
    '(sylibr (cbvex @ aleqd @ imeq2d @ lteq2) @
      eex @ syl (iexe @
        aleqdh (nfeq2 @ nfmax nfnv @ nfsuc @ nfpr nfnv nfsbn1) @
        imeq2d @ lteq2) @
      alimi @ syl5bir leltsuc @ syl5bi leloe @ eord
        (imim2i @ mpi lemax1 ltletr)
        (a1i @ mpbii lemax2 @ lteq2d @
          maxeqd eqidd @ suceqd @ preqd id sbnq))))
  '(!! eex m @ mpi h @ eximd @ syl6 _ @ al2imi @ exp @ syld anl anr)
  '(!! iald p @ syl5bi elres @ sylibr impexp @
    syl5bi (!! elabe q @ exeqd eqeq1) @ sylibr eexb @ alimi @
    syl5ibrcom (imeqd (eleq1d @ syl6eq fstpr fsteq) lteq1) id));

theorem finlamh (A: set x) (v: nat x): $ finite A -> finite ((\ x, v) |` A) $ =
(named '(sylibr (fineq @ reseq1 cbvlams) finlam));

theorem ellamima (v: nat x): $ a e. (\ x, v) '' A <-> E. x (x e. A /\ a = v) $ =
'(bitr elima @ bitr4 (rexeqi @ bitr ellam @ exeqi prth) @
  birexexi @ bitr3 (exeqe @ aneq1d eleq1) (!! exeqi y anlass));

theorem ellamimaab (v: nat x) (p: wff x): $ a e. (\ x, v) '' {x | p} <-> E. x (p /\ a = v) $ =
'(bitr (eleq2 @ imaeq1 cbvlams) @ bitr4 (!! ellamima y) @
  cbvexh nfv (nfan (nfel2 nfab1) (nfeq2 nfsbn1)) @ aneqd (syl6bbr elab sbq) (eqeq2d sbnq));

theorem finlamima (v: nat x): $ finite A -> finite ((\ x, v) '' A) $ =
'(sylib (fineq rnres) @ syl rnfin finlam);

theorem lameqb (a b: nat x): $ A. x a = b <-> \ x, a == \ x, b $ =
'(ibii lameq @ sylbir (!! abeqb p) @
  sylibr (!! cbvalh x y nfv (nf_eq nfsbn1 nfsbn1) (eqeqd sbnq sbnq)) @
  iald @ syl (eex @ sylbi prth @ imp @ bi2d @ eqeq2d sbneq1) @
  mpbii (iexe (eqeq2d @ preqd id sbneq1) eqid) @ eale @ bieqd
    (syl5bb (!! cbvexh x z nfv
      (nfeq2 @ nfpr nfnv nfsbn1) @ eqeq2d @ preqd id sbnq) (exeqd eqeq1))
    (syl5bb (!! cbvexh x z nfv
      (nfeq2 @ nfpr nfnv nfsbn1) @ eqeq2d @ preqd id sbnq) (exeqd eqeq1)));

theorem reslameq (a b: nat x):
  $ A. x (x e. A -> a = b) -> (\ x, a) |` A == (\ x, b) |` A $ =
'(!! eqrd p @ bitr4g elres elres @ syla aneq1a @
  bitr4g ellam ellam @ syl exeq @ impcom @ alimd @ exp @
  rbida (syl6eq fstpr (fsteqd anr)) (syl6eq fstpr (fsteqd anr)) @
  eqeq2d @ preq2d @ mpd (mpbid (eleq1d anr) anll) anlr);

theorem dmlam (a: nat x): $ Dom (\ x, a) == _V $ =
'(!! eqri y @ bith (preldm @ mpbir (eleq2 cbvlams) @
  mpbir ellam @ !! iexe z (eqeq2d @ preqd id sbneq1) eqid) elv);

theorem dmreslam (A: set x) (a: nat x): $ Dom ((\ x, a) |` A) == A $ =
'(eqstr dmres @ eqstr (ineq1 dmlam) inv1);

@_ local def rapp (F: set) (x: nat): set = $ {y | x, y e. F} $;
infixl rapp: $@'$ prec 200;

theorem nfrapp (F: set x) (a: nat x) (h1: $ FS/ x F $) (h2: $ FN/ x a $):
  $ FS/ x F @' a $ = (named '(nfab @ nfel (nfpr h2 nfnv) h1));

theorem elrapp: $ b e. F @' a <-> a, b e. F $ = '(elabe ,eqtac);

theorem rappsabs (A: set x): $ (S\ x, A) @' a == S[a / x] A $ =
(named '(ax_gen @ bitr elrapp elsabs));

theorem rappsab (A: set x): $ (S\ x, A) @' x == A $ =
(named '(sbeth rappsabs @ eqseqd rappeq2 @ rsyl eqcom @ eqscomd sbsq));

theorem rappsabed (A: set x) (h: $ G /\ x = a -> A == B $):
  $ G -> (S\ x, A) @' a == B $ =
'(syl5eqs rappsabs @ mpi ax_6 @ eexdh nfv (nfeqs nfsbs1 nfsv) @
  exp @ eqstr3d (anwr sbsq) h);

theorem rappsabe (A: set x) (h: $ x = a -> A == B $):
  $ (S\ x, A) @' a == B $ = '(trud @ rappsabed @ anwr h);

theorem rappsabed1 (A: set x) (e: $ G /\ x = a -> F @' a == A -> P $):
  $ G -> F == S\ x, A -> P $ =
'(mpi ax_6 @ eexdh nfv (nfim (nfeqs nfsv nfsab1) nfv) @
  exp @ syld (syl5ibrcom (eqseq1d rappeq1) @ syl6eqs rappsab @ eqscomd @ rappeq2d anr) e);
theorem rappsabed2 (A: set x)
  (e: $ G /\ x = a -> A == B $): $ G -> F == S\ x, A -> F @' a == B $ =
'(rappsabed1 @ bi1d @ eqseq2d e);

theorem rappss: $ A C_ B -> A @' a C_ B @' a $ = (named '(ssabd ssel));
theorem rappssb: $ A C_ B <-> A. x A @' x C_ B @' x $ =
(named '(bitr ssal2 @ aleqi ssab));
theorem eqrappb: $ A == B <-> A. x A @' x == B @' x $ =
'(bitr4 ssasymb @ bitr (aleqi ssasymb) @ bitr4 alan @ aneq rappssb rappssb);

--| The application operator. If `F` is a function and `x` is a natural number then
--| `F @ x` is `F` evaluated at `x`. That is, it is the value `y`
--| for which `(x,y) e. F`, if there is a unique such number.
@_ def app (F: set) (x: nat): nat = $ the {y | x, y e. F} $;
infixl app: $@$ prec 200;

theorem nfapp (F: set x) (a: nat x) (h1: $ FS/ x F $) (h2: $ FN/ x a $):
  $ FN/ x F @ a $ = (named '(nfthe @ nfrapp h1 h2));

theorem isfappd (h1: $ G -> isfun F $) (h2: $ G -> a, b e. F $):
  $ G -> F @ a = b $ =
(named '(!! eqthed x @ syl5bb elrapp @ syl6bb eqcomb @ isfbd h1 h2));

theorem isfappb: $ isfun F -> (a, b e. F <-> a e. Dom F /\ F @ a = b) $ =
(named '(ibida (iand (anwr preldm) @ isfappd anl anr) @
  mpd (sylib eldm anrl) @ eexda @
  mpbid (eleq1d @ preq2d @ eqtr3d (isfappd anll anr) (anwl anrr)) anr));

theorem eqapp: $ A. y (a, y e. F <-> a, y e. G) -> F @ a = G @ a $ = '(theeqd abeq);

theorem ndmapp: $ ~a e. Dom F -> F @ a = 0 $ = '(!! eqthe0abd y @ syl5 preldm absurd);

theorem appelrn: $ isfun F -> a e. Dom F -> F @ a e. Ran F $ =
(named '(syl5bi eldm @ eexda @ mpbird (eleq1d @ isfappd anl anr) @ anwr prelrn));

theorem isfrn: $ isfun F -> (y e. Ran F <-> E. x (x e. Dom F /\ F @ x = y)) $ =
'(syl5bb elrn @ exeqd isfappb);

theorem isfrnss: $ isfun F -> (Ran F C_ A <-> A. x (x e. Dom F -> F @ x e. A)) $ =
(named '(syl6bb (aleqi @ imeq2i @ bitr (aleqi @ imeq1i eqcomb) @ aleqe eleq1) @
  syl6bbr ralalcomb @ aleqd @ syl6bb erexb @ imeq1d isfrn));

theorem eqisf: $ isfun F /\ isfun G ->
  (F == G <-> Dom F == Dom G /\ A. x (x e. Dom F -> F @ x = G @ x)) $ =
'(syl5bbr (bian1a dmeq) @ syl aneq2a @ exp @ syl5bb axext2 @ aleqd @
  ibid (a1i @ a1d eqapp) @ exp @ !! iald y @
  bitr4d (syl isfappb an3l) @ bitr4d (syl isfappb anllr) @
  bitrd (syl aneq2a @ syl6 eqeq1 anr) @ aneq1d @ eleq2d anlr);

theorem resapp: $ a e. A -> (F |` A) @ a = F @ a $ =
'(syl eqapp @ !! iald y @ syl5bb prelres bian2);

theorem appelima
  (h1: $ G -> isfun F $) (h2: $ G -> a e. Dom F $) (h3: $ G -> a e. A $):
  $ G -> F @ a e. F '' A $ =
'(sylib (eleq2 rnres) @ mpbid (eleq1d @ syl resapp h3) @
  sylc appelrn (syl resisf h1) @ sylibr (eleq2 dmres) @ sylibr elin @ iand h2 h3);

theorem applams (a b: nat x): $ (\ x, a) @ b = N[b / x] a $ =
'(trud @ isfappd (a1i lamisf) @ a1i @ mpbir
  (!! elabe p @ syl5bb
    (cbvexh nfv (nfeq2 @ nfpr nfnv nfsbn1) @ eqeq2d @ preqd id sbnq)
    (!! exeqd z eqeq1))
  (iexe (eqeq2d @ preqd id sbneq1) eqid));
theorem applam (a: nat x): $ (\ x, a) @ x = a $ = '(eqtr applams sbnid);
theorem applame (a: nat x) (e: $ x = b -> a = c $):
  $ (\ x, a) @ b = c $ = '(eqtr applams @ sbne e);
theorem applamed (a: nat x) (e: $ G /\ x = b -> a = c $):
  $ G -> (\ x, a) @ b = c $ = '(syl5eq applams @ sbned e);
theorem applamed1 (a: nat x) (e: $ G /\ x = b -> F @ b = a -> P $):
  $ G -> F == \ x, a -> P $ =
'(mpi ax_6 @ eexdh nfv (nfim (nfeqs nfsv nflam1) nfv) @
  exp @ syld (syl5ibrcom (eqeq1d appeq1) @ syl6eq applam @ eqcomd @ appeq2d anr) e);
theorem applamed2 (a: nat x)
  (e: $ G /\ x = b -> a = c $): $ G -> F == \ x, a -> F @ b = c $ =
'(applamed1 @ bi1d @ eqeq2d e);

theorem lamapp2: $ (\ x, F @ x) |` A == F <-> isfun F /\ Dom F == A $ =
'(ibii (iand (mpbii (resisf lamisf) isfeq) @ eqstr3d dmeq @ a1i dmreslam) @
  !! eqrd2 y z @ syl5bb prelres @ bitr3d (aneq2d @ eleq2d anr) @ ibid
  (sylibr impexp @ syl5bi (!! elabe p @ exeqd eqeq1) @ eexd @
    syl5ibrcom (imeqd (eleq1d @ sylbi prth anl) eleq1) @
    syl5bi eldm @ !! eexda y @ mpbird (eleq1d @ preq2d @ isfappd anll anr) anr)
  (exp @ iand (sylibr (!! elabe p @ exeqd eqeq1) @ iexde @ eqcomd @
    preqd anr @ eqtrd (appeq2d anr) @ isfappd an3l anlr) (anwr preldm)));
theorem lamapp: $ (\ x, F @ x) |` Dom F == F <-> isfun F $ = '(bitr lamapp2 @ bian2 eqsid);

--| Define a function by cases on a disjoint union.
--| `case A B` is the function such that
--| * `case A B @ b0 n = A @ n`
--| * `case A B @ b1 n = B @ n`
@_ def case (A B: set): set =
$ \ n, if (odd n) (B @ (n // 2)) (A @ (n // 2)) $;

pub theorem casel (A B: set) (n: nat): $ case A B @ b0 n = A @ n $ =
'(!! applame i @ eqtrd
  (syl ifneg @ mtbird oddeq (a1i b0odd))
  (appeq2d @ syl6eq b0div2 diveq1));
pub theorem caser (A B: set) (n: nat): $ case A B @ b1 n = B @ n $ =
'(!! applame i @ eqtrd
  (syl ifpos @ mpbird oddeq (a1i b1odd))
  (appeq2d @ syl6eq b1div2 diveq1));

--| Disjoint union of sets; also `case` for wff-valued functions.
--| * `b0 n e. Sum A B <-> n e. A`
--| * `b1 n e. Sum A B <-> n e. B`
@_ abstract def Sum (A B: set): set =
$ {n | ifp (odd n) (n // 2 e. B) (n // 2 e. A)} $;
pub theorem Suml (A B: set) (n: nat): $ b0 n e. Sum A B <-> n e. A $ =
'(!! elabe i @ bitrd
  (syl ifpneg @ mtbird oddeq @ a1i b0odd)
  (eleq1d @ syl6eq b0div2 diveq1));
pub theorem Sumr (A B: set) (n: nat): $ b1 n e. Sum A B <-> n e. B $ =
'(!! elabe i @ bitrd
  (syl ifppos @ mpbird oddeq @ a1i b1odd)
  (eleq1d @ syl6eq b1div2 diveq1));
theorem Sumld (h: $ G -> a e. A $): $ G -> b0 a e. Sum A B $ = '(sylibr Suml h);
theorem Sumrd (h: $ G -> b e. B $): $ G -> b1 b e. Sum A B $ = '(sylibr Sumr h);

--| With `Sum` as a pairing operator for classes, this is the first projection.
@_ local def Fst (A: set): set = $ {n | b0 n e. A} $;
--| With `Sum` as a pairing operator for classes, this is the second projection.
@_ local def Snd (A: set): set = $ {n | b1 n e. A} $;

theorem elFst: $ a e. Fst A <-> b0 a e. A $ = '(elabe ,eqtac);
theorem elSnd: $ a e. Snd A <-> b1 a e. A $ = '(elabe ,eqtac);

theorem FstSum: $ Fst (Sum A B) == A $ = (named '(ax_gen @ bitr elFst Suml));
theorem SndSum: $ Snd (Sum A B) == B $ = (named '(ax_gen @ bitr elSnd Sumr));
theorem FstSnd: $ Sum (Fst A) (Snd A) == A $ =
(named (def (f x y) '(mpbiri (bitr ,x ,y) @ bieqd eleq1 eleq1))
  '(ax_gen @ eor ,(f 'Suml 'elFst) ,(f 'Sumr 'elSnd) b0orb1));

@_ local def slam {x: nat} (A: set x): set = $ S\ p, {y | snd p, y e. S[fst p / x] A} $;
notation slam {x: nat} (A: set x): set = ($\\$:30) x ($,$:55) A;

theorem prelslams (A: set x): $ (a, b), y e. (\\ x, A) <-> b, y e. S[a / x] A $ =
'(!! elsabe p @ !! elabed z @ eleqd
  (preqd (anwl @ syl6eq sndpr sndeq) anr)
  (anwl @ sbseq1d @ syl6eq fstpr fsteq));

theorem appslams (A: set x): $ (\\ x, A) @ (a, b) = (S[a / x] A) @ b $ =
(named '(theeq @ abeqi prelslams));

theorem appslam (A: set x) (h: $ x = a -> A == B $):
  $ (\\ x, A) @ (a, b) = B @ b $ =
'(eqtr appslams @ appeq1 @ sbse h);

theorem appslamed (A: set x) (h: $ G /\ x = a -> A @ b = c $):
  $ G -> (\\ x, A) @ (a, b) = c $ =
'(syl5eq appslams @ mpi ax_6 @ eexdh nfv (nf_eq (nfapp nfsbs1 nfnv) nfnv) @
  exp @ eqtr3d (appeq1d @ anwr sbsq) h);

theorem appslame (A: set x) (h: $ x = a -> A @ b = c $):
  $ (\\ x, A) @ (a, b) = c $ = '(trud @ appslamed @ anwr h);

@_ local def least (A: set): nat = $ the {x | x e. A /\ A. y (y e. A -> x <= y)} $;

theorem leastlem: $ a e. A -> least A e. A /\ A. z (z e. A -> least A <= z) $ =
(focus
  (have 'h1 $ A. z (z e. A -> a < z) \/ E. u (u e. A /\ A. z (z e. A -> u <= z)) $
    (induct '(!! ind x y) 'a
      '(cases
        (orrd @ sylan (iexe @ aneqd eleq1 @ aleqd @ imeq2d leeq1)
          id (a1i @ ax_gen @ a1i le01))
        (orld @ ialda @ sylibr lt01 @
          mtd anl @ com12 @ syl5 anr (bi1d eleq1)))
      '(eor
        (casesda
          (orrd @ sylan (iexe @ aneqd eleq1 @ aleqd @ imeq2d leeq1) anr anl)
          (orld @ ialdh (nfan nfal1 nfv) @ exp @ sylibr ltlene
            (iand (imp @ anwl eal) (mtand anlr @ mpbird (anwr eleq1) anlr))))
        orr)))
  (have 'h2 $ a e. A -> E. u (u e. A /\ A. z (z e. A -> u <= z)) $
    '(syl h1 @ mtd (a1i ltirr) @ com12 @ eale @ imeqd eleq1 lteq2))
  (have 'h3 $ u e. A /\ A. z (z e. A -> u <= z) -> least A = u $
    '(!! eqtheabd v @ ibid
      (exp @ leasymd
        (mpd anll @ anwr @ anwr @ eale @ imeqd eleq1 leeq2)
        (mpd anrl @ anwl @ anwr @ eale @ imeqd eleq1 leeq2))
      (com12 @ bi2d @ aneqd eleq1 @ aleqd @ imeq2d leeq1)))
  '(rsyl h2 @ eex @ mpbird (rsyl h3 @ aneqd eleq1 @ aleqd @ imeq2d @ leeq1) id));

theorem leastel: $ a e. A -> least A e. A $ = '(anld @ !! leastlem x);

theorem leastle: $ a e. A -> least A <= a $ =
'(mpd (!! leastlem x) @ com12 @ anwr @ eale @ imeqd eleq1 leeq2);

theorem least0: $ ~E. x x e. A -> least A = 0 $ =
'(! eqthe0abd _ y $ _ /\ A. z _ $ @ com12 @ syl absurdr @ anwl @ iexe eleq1);

theorem subsnfin: $ subsn A -> finite A $ =
(named '(syl (mpi snfin finss) @ sylib ssab2 @
  ialda @ subsni anl anr @ anwr leastel));

@_ local def sapp (F: set) (x: nat): set = $ S\ y, F @' (x, y) $;
infixl sapp: $@@$ prec 200;

theorem nfsapp (F: set x) (a: nat x) (h1: $ FS/ x F $) (h2: $ FN/ x a $):
  $ FS/ x F @@ a $ = (named '(nfsab @ nfrapp h1 (nfpr h2 nfnv)));

theorem sapprapp: $ F @@ a @' b == F @' (a, b) $ = '(!! eqab1i y @ elsabe ,eqtac);
theorem sappapp: $ F @@ a @ b = F @ (a, b) $ = (named '(theeq sapprapp));
theorem prelsapp: $ b, y e. F @@ a <-> (a, b), y e. F $ =
'(bitr3 elrapp @ bitr (eleq2 sapprapp) elrapp);

theorem sappslams (A: set x): $ (\\ x, A) @@ a == S[a / x] A $ =
(named '(mpbir axext2 @ ax_gen @ ax_gen @ bitr prelsapp prelslams));
theorem sappslam (A: set x) (h: $ x = a -> A == B $):
  $ (\\ x, A) @@ a == B $ = '(eqstr sappslams @ sbse h);
theorem sappslamed (A: set x) (h: $ G /\ x = a -> A == B $):
  $ G -> (\\ x, A) @@ a == B $ =
'(syl5eqs sappslams @ mpi ax_6 @ eexdh nfv (nfeqs nfsbs1 nfsv) @
  exp @ eqstr3d (anwr sbsq) h);
theorem sappslame (A: set x) (h: $ x = a -> A == B $):
  $ (\\ x, A) @@ a == B $ = '(trud @ sappslamed @ anwr h);

do {
  (def evalZ-map (atom-map!
    '[d0 ,(fn () 0)]
    '[b0 ,(fn (n) (eval n))]
    '[b1 ,(fn (n) (- {(eval n) + 1}))]))
  (set-merge-strategy evalZ-map merge-map)
  (def (evalZ e) @ match e @ ((? atom? t) . es)
    (apply
      (lookup evalZ-map t @ fn () @ error
        @ string-append "unknown function encountered during evaluation: " (->string t))
      es))

  --| This is used as an annotation.
  --| `@(add-evalZ f) def foo ..` will add `f` as an evaluator for `foo`
  --| in the integer domain,
  --| which is used by the `evalZ` function (which can evaluate many
  --| closed terms of sort `nat`, interpreted as signed integers).
  (def ((add-evalZ f) a) (insert! evalZ-map a f))
};

@(add-evalZ @ fn (m n) {(eval m) - (eval n)})
@_ local def znsub (m n) = $ if (m < n) (b1 (n - suc m)) (b0 (m - n)) $;
infixl znsub: $-ZN$ prec 64;

theorem znsubneg: $ m < n -> m -ZN n = b1 (n - suc m) $ = 'ifpos;
theorem znsubpos: $ n <= m -> m -ZN n = b0 (m - n) $ = '(sylbi lenlt ifneg);
theorem znsubid: $ m -ZN m = 0 $ = '(eqtr (znsubpos leid) @ eqtr (b0eq subid) b00);
theorem znsub02: $ a -ZN 0 = b0 a $ = '(eqtr (znsubpos le01) @ b0eq sub02);
theorem znsubodd: $ odd (a -ZN b) <-> a < b $ =
'(ibii (ax_3 @ mpbiri b0odd @ noteqd @ oddeqd ifneg) (mpbiri b1odd @ oddeqd ifpos));

@(add-eval @ fn (n) {(evalZ n) max 0})
@_ local def zfst (n) = $ case (\ mpos, mpos) (\ mneg, 0) @ n $;
@(add-eval @ fn (n) {(- (evalZ n)) max 0})
@_ local def zsnd (n) = $ case (\ mpos, 0) (\ mneg, suc mneg) @ n $;

theorem zfstb0: $ zfst (b0 n) = n $ = (named '(eqtr casel @ applame id));
theorem zfstb1: $ zfst (b1 n) = 0 $ = (named '(eqtr caser @ applame eqidd));
theorem zsndb0: $ zsnd (b0 n) = 0 $ = (named '(eqtr casel @ applame eqidd));
theorem zsndb1: $ zsnd (b1 n) = suc n $ = (named '(eqtr caser @ applame suceq));

theorem zfst0: $ zfst 0 = 0 $ = '(eqtr3 (zfsteq b00) zfstb0);
theorem zsnd0: $ zsnd 0 = 0 $ = '(eqtr3 (zsndeq b00) zsndb0);

theorem zfstsnd: $ zfst n -ZN zsnd n = n $ =
'(eor
  (eqtrd (syl znsubpos @ mpbiri le01 @
      leeqd (syl6eq zsndb0 zsndeq) (syl6eq zfstb0 zfsteq)) @
    eqtr4d (b0eqd @ syl6eq sub02 @
      subeqd (syl6eq zfstb0 zfsteq) (syl6eq zsndb0 zsndeq)) id)
  (eqtrd (syl znsubneg @ mpbiri lt01S @
      lteqd (syl6eq zfstb1 zfsteq) (syl6eq zsndb1 zsndeq)) @
    eqtr4d (b1eqd @ syl6eq (eqtr subSS sub02) @
      subeqd (syl6eq zsndb1 zsndeq) (suceqd @ syl6eq zfstb1 zfsteq)) id)
  b0orb1);

theorem zfstsndeq0: $ zfst n = 0 /\ zsnd n = 0 <-> n = 0 $ =
'(ibii (syl5eqr zfstsnd @ syl6eq znsubid @ znsubeqd anl anr) @
  iand (syl6eq zfst0 zfsteq) (syl6eq zsnd0 zsndeq));

theorem zfstznsub: $ zfst (m -ZN n) = m - n $ =
'(cases
  (eqtr4d (syl6eq zfstb1 @ zfsteqd znsubneg) ltsubeq0)
  (syl6eq zfstb0 @ zfsteqd ifneg));

theorem zfstsnd0: $ zfst n = 0 \/ zsnd n = 0 $ =
'(eor (orrd @ syl6eq zsndb0 zsndeq) (orld @ syl6eq zfstb1 zfsteq) b0orb1);

theorem zfstsubsnd: $ zfst n - zsnd n = zfst n $ =
'(eor (eqtr4d subeq1 @ syl6eqr sub01 id) (syl6eq sub02 subeq2) zfstsnd0);

theorem zneqb (a b c d): $ a -ZN c = b -ZN d <-> a + d = b + c $ =
(focus
  '(cases (casesda _ _) (casesda _ _))
  '(bitrd (eqeqd (anwl ifpos) (anwr ifpos)) @
    syl5bb (bitr4 b1can @ bitr addcan2 eqcomb) @ eqeqd
      (syl5eq (eqtr3 (addeq1 addS2) addass) @ addeq2d @ anwr pncan3)
      (syl5eq (eqtr3 (addeq1 @ eqtr addcom addS1) addass) @ addeq2d @ anwl pncan3))
  '(bitrd (eqeqd (anwl ifpos) (anwr ifneg)) @ binthd (a1i b1neb0) @
    syl ltne @ ltletrd (sylib ltadd1 anl) @
    sylib (leeq2 addcom) @ sylib leadd2 @ sylibr lenlt anr)
  '(bitrd (eqeqd (anwl ifneg) (anwr ifpos)) @ binthd (a1i b0neb1) @
    syl ltner @ lelttrd (sylib leadd2 @ sylibr lenlt anl) @
    sylib (bitr ltadd2 @ lteq1 addcom) anr)
  '(bitrd (eqeqd (anwl ifneg) (anwr ifneg)) @
    syl5bb b0can @ syl5bbr addcan1 @ eqeqd
      (syl5eqr addass @ addeq1d @ syl npcan @ sylibr lenlt anl)
      (syl5eqr addass @ syl5eq addrass @ addeq1d @ syl npcan @ sylibr lenlt anr)));

theorem znpnpcan1: $ (a + c) -ZN (b + c) = a -ZN b $ = '(mpbir zneqb @ eqtr addrass addass);
theorem znpnpcan2: $ (a + b) -ZN (a + c) = b -ZN c $ = '(mpbir zneqb @ eqtr addass addlass);

@(add-evalZ @ fn (n) (- (evalZ n)))
@_ local def zneg (n) = $ zsnd n -ZN zfst n $;
prefix zneg: $-uZ$ prec 100;

theorem znegzn: $ -uZ (a -ZN b) = b -ZN a $ =
'(mpbir zneqb @ eqtr addcom @ eqtr3 (mpbi zneqb zfstsnd) addcom);

theorem znegneg: $ -uZ -uZ n = n $ = '(eqtr znegzn zfstsnd);

theorem zfstneg: $ zfst (-uZ n) = zsnd n $ =
'(eqtr (zfsteq @ eqtr3 znegzn @ znegeq zfstsnd) @
  eqtr zfstznsub @
  eor (syl6eq sub02 subeq2) (eqtr4d subeq1 @ syl6eqr sub01 id) zfstsnd0);

theorem zsndneg: $ zsnd (-uZ n) = zfst n $ = '(eqtr3 zfstneg @ zfsteq znegneg);

theorem zneg0: $ -uZ 0 = 0 $ =
'(eqtr3 (znegeq @ ! znsubid d0) @ eqtr znegzn znsubid);

theorem zsndznsub: $ zsnd (m -ZN n) = n - m $ =
'(eqtr3 zfstneg @ eqtr (zfsteq znegzn) zfstznsub);

theorem znegb1: $ -uZ b1 n = b0 (suc n) $ =
'(eqtr (znsubpos @ mpbir (leeq1 zfstb1) le01) @ b0eq @ eqtr (subeq zsndb1 zfstb1) sub02);

@(add-evalZ @ fn (m n) {(evalZ m) + (evalZ n)})
@_ local def zadd (m n) = $ (zfst m + zfst n) -ZN (zsnd m + zsnd n) $;
infixl zadd: $+Z$ prec 64;

theorem zaddzn: $ (a -ZN c) +Z (b -ZN d) = (a + b) -ZN (c + d) $ =
'(mpbir zneqb @ eqtr add4 @
  eqtr (addeq (mpbi zneqb zfstsnd) (mpbi zneqb zfstsnd)) add4);

theorem zaddb0: $ b0 m +Z b0 n = b0 (m + n) $ =
'(eqtr (znsubeq (addeq zfstb0 zfstb0) (eqtr (addeq zsndb0 zsndb0) add0)) znsub02);

theorem zaddcom: $ a +Z b = b +Z a $ = '(znsubeq addcom addcom);
theorem zaddass: $ (a +Z b) +Z c = a +Z (b +Z c) $ =
'(eqtr3 (zaddeq2 zfstsnd) @ eqtr4 zaddzn @
  eqtr3 (zaddeq1 zfstsnd) @ eqtr4 zaddzn @ znsubeq addass addass);
theorem zaddlass: $ a +Z (b +Z c) = b +Z (a +Z c) $ =
'(eqtr3 zaddass @ eqtr (zaddeq1 zaddcom) zaddass);
theorem zaddrass: $ (a +Z b) +Z c = (a +Z c) +Z b $ =
'(eqtr4 zaddass @ eqtr4 zaddass @ zaddeq2 zaddcom);

theorem zadd02: $ a +Z 0 = a $ =
'(eqtr (znsubeq (eqtr (addeq2 zfst0) add0) (eqtr (addeq2 zsnd0) add0)) zfstsnd);
theorem zadd01: $ 0 +Z a = a $ = '(eqtr zaddcom zadd02);

theorem znegid: $ a +Z -uZ a = 0 $ =
'(eqtr3 (zaddeq1 zfstsnd) @ eqtr zaddzn @ eqtr (znsubeq1 addcom) znsubid);
theorem znegid1: $ -uZ a +Z a = 0 $ = '(eqtr zaddcom znegid);

@(add-evalZ @ fn (m n) {(evalZ m) - (evalZ n)})
@_ local def zsub (m n) = $ m +Z -uZ n $;
infixl zsub: $-Z$ prec 64;

theorem zsubb0: $ b0 m -Z b0 n = m -ZN n $ =
'(eqtr3 (zsubeq1 zfstsnd) @ eqtr zaddzn @
  znsubeq (eqtr (addeq zfstb0 zsndb0) add0) (eqtr (addeq zsndb0 zfstb0) add01));
theorem zsubpos: $ n <= m -> b0 m -Z b0 n = b0 (m - n) $ = '(syl5eq zsubb0 znsubpos);

theorem zsubid: $ a -Z a = 0 $ = 'znegid;
theorem zsub01: $ 0 -Z a = -uZ a $ = 'zadd01;
theorem zsub02: $ a -Z 0 = a $ = '(eqtr (zaddeq2 zneg0) zadd02);
theorem zpncan: $ a +Z b -Z b = a $ = '(eqtr zaddass @ eqtr (zaddeq2 znegid) zadd02);
theorem zpncan2: $ a +Z b -Z a = b $ = '(eqtr (zsubeq1 zaddcom) zpncan);
theorem znpcan: $ a -Z b +Z b = a $ = '(eqtr zaddass @ eqtr (zaddeq2 znegid1) zadd02);
theorem zpncan3: $ a +Z (b -Z a) = b $ = '(eqtr zaddcom znpcan);
theorem zaddsubass: $ a +Z b -Z c = a +Z (b -Z c) $ = 'zaddass;
theorem zaddsub: $ a +Z b -Z c = a -Z c +Z b $ = 'zaddrass;

theorem zaddcan1: $ a +Z c = b +Z c <-> a = b $ =
'(ibii (syl5eqr zpncan @ syl6eq zpncan zsubeq1) zaddeq1);
theorem zaddcan2: $ a +Z b = a +Z c <-> b = c $ =
'(bitr (eqeq zaddcom zaddcom) zaddcan1);

theorem eqzsub: $ a -Z c = b <-> b +Z c = a $ =
'(bitr (ibii (syl5eqr znpcan zaddeq1) (syl6eq zpncan zsubeq1)) eqcomb);
theorem eqzsub2: $ a -Z b = c <-> b +Z c = a $ = '(bitr eqzsub @ eqeq1 zaddcom);
theorem eqzneg: $ -uZ a = b <-> a +Z b = 0 $ = '(bitr3 (eqeq1 zsub01) eqzsub2);
theorem znegeqcom: $ -uZ a = b <-> -uZ b = a $ = '(bitr4 eqzneg @ bitr4 eqzneg @ eqeq1 zaddcom);
theorem eqznegcom: $ a = -uZ b <-> b = -uZ a $ = '(bitr eqcomb @ bitr znegeqcom eqcomb);
theorem zsubeq0: $ a -Z b = 0 <-> a = b $ = '(bitr eqzsub @ bitr (eqeq1 zadd01) eqcomb);
theorem znegadd2: $ -uZ (a +Z b) = -uZ a -Z b $ =
'(eqcom @ mpbir eqzsub @ eqtr zaddcom @ mpbir eqzsub @ eqtr zaddcom zpncan2);
theorem znegadd: $ -uZ (a +Z b) = -uZ a +Z -uZ b $ = 'znegadd2;
theorem zsubsub: $ a -Z b -Z c = a -Z (b +Z c) $ = '(eqtr4 zaddsubass @ zaddeq2 znegadd2);
theorem znpncan: $ (a -Z b) +Z (b -Z c) = a -Z c $ = '(eqtr3 zaddsubass @ zsubeq1 znpcan);
theorem znpncan2: $ (b -Z c) +Z (a -Z b) = a -Z c $ = '(eqtr zaddcom znpncan);
theorem zpnpcan2: $ (a +Z b) -Z (a +Z c) = b -Z c $ = '(eqtr3 zsubsub @ zsubeq1 zpncan2);
theorem zpnpcan1: $ (a +Z c) -Z (b +Z c) = a -Z b $ = '(eqtr (zsubeq zaddcom zaddcom) zpnpcan2);
theorem znegsub: $ -uZ (a -Z b) = b -Z a $ = '(eqtr znegadd2 @ eqtr zaddcom @ zaddeq1 znegneg);
theorem zsubsub2: $ a -Z (b -Z c) = a +Z (c -Z b) $ = '(zaddeq2 znegsub);
theorem zsubadd: $ a -Z b +Z c = a -Z (b -Z c) $ = '(eqtr3 zaddsub @ eqtr4 zaddsubass zsubsub2);
theorem zsubneg2: $ a -Z -uZ b = a +Z b $ = '(zaddeq2 znegneg);
theorem znegsub2: $ -uZ a -Z -uZ b = b -Z a $ = '(eqtr zsubneg2 zaddcom);
theorem znegb0S: $ -uZ b0 (suc n) = b1 n $ = '(mpbi znegeqcom znegb1);

@(add-evalZ @ fn (m n) {(evalZ m) < (evalZ n)})
@_ local def zlt (m n) = $ odd (m -Z n) $;
infixr zlt: $<Z$ prec 50;
@(add-evalZ @ fn (m n) {(evalZ m) <= (evalZ n)})
@_ local def zle (m n) = $ ~n <Z m $;
infixr zle: $<=Z$ prec 50;

theorem zlenlt: $ a <=Z b <-> ~b <Z a $ = 'biid;
theorem zltnle: $ a <Z b <-> ~b <=Z a $ = '(con2b zlenlt);
theorem zlt01: $ a <Z 0 <-> odd a $ = '(oddeq zsub02);
theorem zle02: $ 0 <=Z a <-> ~odd a $ = '(noteq zlt01);
theorem zle0b0: $ 0 <=Z b0 a $ = '(mpbir zle02 b0odd);
theorem zltb10: $ b1 a <Z 0 $ = '(mpbir zlt01 b1odd);
theorem zle0b1: $ ~0 <=Z b1 a $ = '(mpbi zltnle zltb10);
theorem zltb00: $ ~b0 a <Z 0 $ = 'zle0b0;
theorem zlt01eq: $ a <Z 0 <-> a = b1 (a // 2) $ = '(bitr zlt01 eqb1);
theorem zle02eq: $ 0 <=Z a <-> a = b0 (a // 2) $ = '(bitr zle02 eqb0);
theorem zltb0: $ b0 a <Z b0 b <-> a < b $ = '(bitr (oddeq zsubb0) znsubodd);
theorem zleb0: $ b0 a <=Z b0 b <-> a <= b $ = '(bitr4 (noteq zltb0) lenlt);
theorem zltadd1: $ a <Z b <-> a +Z c <Z b +Z c $ = '(oddeq @ eqcom zpnpcan1);
theorem zltadd2: $ b <Z c <-> a +Z b <Z a +Z c $ = '(oddeq @ eqcom zpnpcan2);
theorem zleadd1: $ a <=Z b <-> a +Z c <=Z b +Z c $ = '(noteq zltadd1);
theorem zleadd2: $ b <=Z c <-> a +Z b <=Z a +Z c $ = '(noteq zltadd2);
theorem zltaddsub: $ a +Z b <Z c <-> a <Z c -Z b $ = '(bitr2 zltadd1 @ zlteq2 znpcan);
theorem zltsubadd: $ a -Z b <Z c <-> a <Z c +Z b $ = '(bitr2 zltadd1 @ zlteq2 zpncan);
theorem zlt0neg: $ 0 <Z -uZ a <-> a <Z 0 $ = '(oddeq @ eqtr4 zsub01 @ eqtr4 zsub02 znegneg);
theorem zltneg0: $ -uZ a <Z 0 <-> 0 <Z a $ = '(bitr3 zlt0neg @ zlteq2 znegneg);
theorem zle0neg: $ 0 <=Z -uZ a <-> a <=Z 0 $ = '(noteq zltneg0);
theorem zleneg0: $ -uZ a <=Z 0 <-> 0 <=Z a $ = '(noteq zlt0neg);
theorem zlt0sub: $ 0 <Z a -Z b <-> b <Z a $ = '(bitr3 zltaddsub @ zlteq1 zadd01);
theorem zltsub0: $ a -Z b <Z 0 <-> a <Z b $ = '(bitr3 zlt0neg @ bitr (zlteq2 znegsub) zlt0sub);
theorem zle0sub: $ 0 <=Z a -Z b <-> b <=Z a $ = '(noteq zltsub0);
theorem zlesub0: $ a -Z b <=Z 0 <-> a <=Z b $ = '(noteq zlt0sub);
theorem zlt0znsub: $ 0 <Z a -ZN b <-> b < a $ = '(bitr3 (zlteq2 zsubb0) @ bitr zlt0sub zltb0);
theorem zltznsub0: $ a -ZN b <Z 0 <-> a < b $ = '(bitr3 (zlteq1 zsubb0) @ bitr zltsub0 zltb0);
theorem zle0znsub: $ 0 <=Z a -ZN b <-> b <= a $ = '(bitr4 (noteq zltznsub0) lenlt);
theorem zleznsub0: $ a -ZN b <=Z 0 <-> a <= b $ = '(bitr4 (noteq zlt0znsub) lenlt);
theorem zsndeq0: $ zsnd a = 0 <-> 0 <=Z a $ =
'(ibii
  (mpbiri zle0b0 @ zleeq2d @ syl6eq znsub02 @ syl5eqr zfstsnd znsubeq2)
  (syl6eq zsndb0 @ sylbi zle02eq zsndeq));
theorem zfsteq0: $ zfst a = 0 <-> a <=Z 0 $ = '(bitr3 (eqeq1 zsndneg) @ bitr zsndeq0 zle0neg);
theorem zleorle: $ a <=Z b \/ b <=Z a $ =
'(mpbi (oreq (bitr zfsteq0 zlesub0) (bitr zsndeq0 zle0sub)) zfstsnd0);
theorem zltle: $ a <Z b -> a <=Z b $ = '(sylbi zltnle zleorle);
theorem zleasymb: $ a = b <-> a <=Z b /\ b <=Z a $ =
'(bitr3 zsubeq0 @ bitr3 zfstsndeq0 @ bitr (aneq zfsteq0 zsndeq0) (aneq zlesub0 zle0sub));
theorem zleasym: $ a <=Z b -> b <=Z a -> a = b $ = '(exp @ bi2i zleasymb);
theorem zaddpos: $ 0 <=Z a -> 0 <=Z b -> 0 <=Z a +Z b $ =
'(sylbi zle02eq @ syl5bi zle02eq @ exp @
  mpbiri zle0b0 @ zleeq2d @ syl6eq zaddb0 ,eqtac);
theorem zletr: $ a <=Z b -> b <=Z c -> a <=Z c $ =
'(sylbir zle0sub @ syl5bir zle0sub @ syl6ib (bitr (zleeq2 znpncan2) zle0sub) zaddpos);
theorem zlelttr: $ a <=Z b -> b <Z c -> a <Z c $ = '(con4d @ com12 zletr);
theorem zltletr: $ a <Z b -> b <=Z c -> a <Z c $ = '(com12 @ con4d zletr);
theorem zlttr: $ a <Z b -> b <Z c -> a <Z c $ = '(syl zlelttr zltle);
theorem zb0orb0div: $ a = b0 (a // 2) \/ a = -uZ (b0 (-uZ a // 2)) $ =
'(mpbi (oreq zle02eq @ bitr3 zle0neg @ bitr zle02eq @ bitr znegeqcom eqcomb) zleorle);

@(add-evalZ @ fn (m n) {(evalZ m) * (evalZ n)})
@_ local def zmul (m n) =
$ (zfst m * zfst n + zsnd m * zsnd n) -ZN
  (zfst m * zsnd n + zsnd m * zfst n) $;
infixl zmul: $*Z$ prec 70;

theorem zmulznlem (a1 b1 c1 d1 a2 b2 c2 d2)
  (h1: $ a1 + c2 = a2 + c1 $) (h2: $ b1 + d2 = b2 + d1 $):
  $ (a1 * b1 + c1 * d1) + (a2 * d2 + b2 * c2) =
    (a2 * b2 + c2 * d2) + (a1 * d1 + c1 * b1) $ =
(focus
  (have 'h3 $ b1 * c2 + (a1 * b1 + a2 * d2) = a2 * b2 + c1 * b1 + a2 * d1 $
    '(eqtr addcom @ eqtr addrass @
      eqtr (addeq1 @ eqtr (addeq2 mulcom) @ eqtr3 addmul @ eqtr (muleq1 h1) addmul) @
      eqtr addrass @
      eqtr (addeq1 @ eqtr3 muladd @ eqtr (muleq2 h2) muladd)
      addrass))
  (have 'h4 $ b1 * c2 + (c2 * d2 + a1 * d1) = a2 * d1 + (c1 * d1 + b2 * c2) $
    '(eqtr3 addass @
      eqtr (addeq1 @ eqtr (addeq2 mulcom) @ eqtr3 addmul @ eqtr (muleq1 h2) @ addmul) @
      eqtr addass @
      eqtr4 (addeq2 @
        eqtr (addeq1 mulcom) @ eqtr addcom @
        eqtr3 addmul @ eqtr (muleq1 h1) addmul) @
      eqtr3 addass addcom))
  '(eqtr add4 @ eqtr (mpbi addcan2 _) @ eqtr add4 (addeq2 addcom))
  '(eqtr3 addass @ eqtr (addeq1 h3) @
    eqtr addass @ eqtr3 (addeq2 h4) @
    eqtr3 addass @ eqtr (addeq1 addcom) addass));

theorem zmulzn: $ (a -ZN c) *Z (b -ZN d) = (a * b + c * d) -ZN (a * d + b * c) $ =
'(mpbir zneqb @ zmulznlem (mpbi zneqb zfstsnd) (mpbi zneqb zfstsnd));

theorem zmulcom: $ a *Z b = b *Z a $ =
'(znsubeq (addeq mulcom mulcom) (eqtr addcom @ addeq mulcom mulcom));
theorem zmulass: $ (a *Z b) *Z c = a *Z (b *Z c) $ =
'(eqtr3 (zmuleq2 zfstsnd) @ eqcom @ eqtr3 (zmuleq1 zfstsnd) @
  eqtr4 zmulzn @ eqtr4 zmulzn @ znsubeq
  (eqtr4 (addeq muladd muladd) @ eqtr4 (addeq addmul addmul) @
    eqtr4 addass @ eqtr4 addass @ eqcom @ addeq mulass @
    eqtr addlass @ addeq mulass @ eqtr addcom @ addeq mulass mulass)
  (eqtr4 (addeq muladd addmul) @ eqtr4 (addeq addmul muladd) @
    eqtr4 addass @ eqtr4 addass @ eqcom @ addeq mulass @
    eqtr addlass @ addeq (eqtr mulcom mulass) @
    eqtr addcom @ addeq (eqtr3 mulass @ eqtr mulrass @ muleq1 mulcom) @
    eqtr (muleq1 mulcom) mulrass));

theorem zmuladd: $ a *Z (b +Z c) = a *Z b +Z a *Z c $ =
'(eqtr3 (zmuleq1 zfstsnd) @ eqcom @ eqtr4 zaddzn @ eqtr4 zmulzn @ znsubeq
  (eqtr4 add4 @ addeq muladd muladd)
  (eqtr4 add4 @ addeq muladd @ eqtr mulcom muladd));
theorem zaddmul: $ (a +Z b) *Z c = a *Z c +Z b *Z c $ =
'(eqtr zmulcom @ eqtr zmuladd @ zaddeq zmulcom zmulcom);

theorem zmulsub: $ a *Z (b -Z c) = a *Z b -Z a *Z c $ =
'(eqcom @ mpbir eqzsub @ eqtr3 zmuladd @ zmuleq2 znpcan);
theorem zsubmul: $ (a -Z b) *Z c = a *Z c -Z b *Z c $ =
'(eqtr zmulcom @ eqtr zmulsub @ zsubeq zmulcom zmulcom);

theorem zmul01: $ 0 *Z a = 0 $ = '(eqtr3 (zmuleq1 @ ! zsubid d0) @ eqtr zsubmul zsubid);
theorem zmul02: $ a *Z 0 = 0 $ = '(eqtr zmulcom zmul01);
theorem zmul11: $ b0 1 *Z a = a $ =
'(eqtr3 (zmuleq znsub02 zfstsnd) @ eqtr zmulzn @
  eqtr (znsubeq (eqtr (addeq mul11 mul01) add0) (eqtr (addeq mul11 mul02) add0)) zfstsnd);
theorem zmul12: $ a *Z b0 1 = a $ = '(eqtr zmulcom zmul11);

theorem zmulneg1: $ -uZ a *Z b = -uZ (a *Z b) $ =
'(eqtr3 (zmuleq1 zsub01) @ eqtr zsubmul @ eqtr (zsubeq1 zmul01) zsub01);
theorem zmulneg2: $ a *Z -uZ b = -uZ (a *Z b) $ =
'(eqtr zmulcom @ eqtr zmulneg1 @ znegeq zmulcom);
theorem zmul2neg: $ -uZ a *Z -uZ b = a *Z b $ =
'(eqtr zmulneg1 @ mpbi znegeqcom @ eqcom zmulneg2);

theorem zmulb0: $ b0 a *Z b0 b = b0 (a * b) $ =
'(eqtr3 (zmuleq znsub02 znsub02) @ eqtr4 zmulzn @ eqtr3 znsub02 @
  znsubeq (eqtr2 (addeq2 mul0) add0) (eqtr2 (addeq mul0 mul0) add0));

@(add-eval @ fn (n) (def x (evalZ n)) (if {x >= 0} x (- x)))
@_ local def zabs (n) = $ zfst n + zsnd n $;

theorem zabsb0: $ zabs (b0 n) = n $ = '(eqtr (addeq zfstb0 zsndb0) add0);
theorem zabsneg: $ zabs (-uZ n) = zabs n $ = '(eqtr addcom @ addeq zsndneg zfstneg);
theorem zabszn: $ zabs (m -ZN n) = (m - n) + (n - m) $ = '(addeq zfstznsub zsndznsub);
theorem lezabszn: $ n <= m -> zabs (m -ZN n) = m - n $ =
'(syl5eq zabszn @ syl6eq add0 @ sylbi lesubeq0 addeq2);
theorem zabscom: $ zabs (m -ZN n) = zabs (n -ZN m) $ =
'(eqtr zabszn @ eqtr4 addcom zabszn);
theorem zabseq0: $ zabs n = 0 <-> n = 0 $ = '(bitr addeq0 zfstsndeq0);
theorem b0zabs: $ b0 (zabs a) = a <-> 0 <=Z a $ =
'(bitr eqcomb @ ibii (mpbiri zle0b0 zleeq2)
  (sylbi zle02eq @ eqtr4d id @ b0eqd @ syl6eq zabsb0 zabseq));
theorem zb0orb0: $ a = b0 (zabs a) \/ a = -uZ (b0 (zabs a)) $ =
'(mpbi (oreq (bitr2 eqcomb b0zabs) @ bitr3 zle0neg @ bitr3 b0zabs @
    bitr (eqeq1 @ b0eq zabsneg) eqznegcom) zleorle);
theorem zabsmul: $ zabs (m *Z n) = zabs m * zabs n $ =
(focus
  (def h '(eqtr (zabseq zmulb0) @ eqtr4 zabsb0 @ muleq2 zabsb0))
  (def (f) @ focus
    '(eqtr4 (eor _ _ (! zb0orb0 n)) (muleq1 zabsb0))
    '(mpbiri ,h ,eqtac)
    '(mpbiri (eqtr (zabseq zmulneg2) @ eqtr4 zabsneg @ eqtr4 (muleq2 zabsneg) ,h) ,eqtac))
  '(eor _ _ (! zb0orb0 m))
  '(mpbiri _ ,eqtac) (f)
  '(mpbiri (eqtr (zabseq zmulneg1) @ eqtr4 zabsneg @ eqtr4 (muleq1 zabsneg) _) ,eqtac) (f));

theorem eqmdvdsub2: $ mod(n): a = b <-> n || zabs (b -ZN a) $ =
'(eor (bitr4d eqmdvdsub @ dvdeq2d lezabszn)
  (syl5bb eqmcomb @ bitr4d eqmdvdsub @
    dvdeq2d @ syl5eq zabscom lezabszn)
  leorle);

theorem eqmdvdsub3: $ mod(n): zfst a = zsnd a <-> n || zabs a $ =
'(bitr eqmcomb @ bitr eqmdvdsub2 @ dvdeq2 @ zabseq zfstsnd);

@(add-eval @ fn (m n) {{(evalZ n) % (evalZ m)} = 0})
@_ local def zdvd (m n) = $ zabs m || zabs n $;
infixl zdvd: $|Z$ prec 50;

theorem zdvdid: $ a |Z a $ = 'dvdid;
theorem zdvdtr: $ a |Z b -> b |Z c -> a |Z c $ = 'dvdtr;
theorem zdvdb0: $ b0 a |Z b0 b <-> a || b $ = '(dvdeq zabsb0 zabsb0);
theorem zdvdb01: $ b0 a |Z b <-> a || zabs b $ = '(dvdeq1 zabsb0);
theorem zdvdb02: $ a |Z b0 b <-> zabs a || b $ = '(dvdeq2 zabsb0);
theorem zdvdneg1: $ -uZ a |Z b <-> a |Z b $ = '(dvdeq1 zabsneg);
theorem zdvdneg2: $ a |Z -uZ b <-> a |Z b $ = '(dvdeq2 zabsneg);
theorem eqmzdvdsub: $ mod(n): a = b <-> b0 n |Z b -ZN a $ =
'(bitr4 eqmdvdsub2 @ dvdeq1 zabsb0);
theorem zdvd01: $ 0 |Z a <-> a = 0 $ = '(bitr3 (zdvdeq1 b00) @ bitr zdvdb01 @ bitr dvd01 zabseq0);
theorem zdvd02: $ a |Z 0 $ = '(mpbi (zdvdeq2 b00) @ mpbir zdvdb02 dvd02);
theorem zdvd11: $ b0 1 |Z a $ = '(mpbir zdvdb01 dvd11);
theorem zdvd12: $ a |Z b0 1 <-> zabs a = 1 $ = '(bitr zdvdb02 dvd12);

theorem zdvdmul1: $ a |Z b *Z a $ = '(mpbir (dvdeq2 zabsmul) dvdmul1);
theorem zdvdmul2: $ a |Z a *Z b $ = '(mpbi (zdvdeq2 zmulcom) zdvdmul1);

theorem izdvd: $ c *Z a = b -> a |Z b $ = '(mpbii zdvdmul1 zdvdeq2);
theorem izdvd2: $ a *Z c = b -> a |Z b $ = '(mpbii zdvdmul2 zdvdeq2);

theorem zdvddef: $ a |Z b <-> E. c c *Z a = b $ =
(focus
  (def (g x) '(mpbiri ,x @ imeqd (zdvdeqd anl anr) @ exeqd @ eqeqd (zmuleq2d anl) anr))
  (def (f x y) '(mpi (! zb0orb0 b) (eorda ,(g x) ,(g '(sylbi zdvdneg2 ,y)))))
  (def (h x) '(sylbi zdvdb0 @ syl (iexe @ eqeq1d zmuleq1) ,x))
  (def (h2 x) '(sylbi zdvdneg1 ,(h x)))
  (def b '(syl5eq zmulb0 @ b0eqd divmul))
  '(ibii (eor
    ,(f (h b) (h '(syl5eq zmulneg1 @ znegeqd ,b)))
    ,(f (h2 '(syl5eq zmul2neg ,b)) (h2 '(syl5eq zmulneg2 @ znegeqd ,b)))
    (! zb0orb0 a)) (eex izdvd)));

theorem zdvdadd1: $ n |Z a -> (n |Z b <-> n |Z a +Z b) $ =
(focus
  '(sylbi zdvddef @ !! eex x @ ibid _ _)
  (focus
    '(syl5bi zdvddef @ !! eexda y @ syl izdvd @ syl5eq zaddmul @ imp zaddeq))
  (focus
    '(syl5bi zdvddef @ !! eexda z @ syl izdvd @ sylib zaddcan2 _)
    '(eqtr3d (anwl zaddeq1) @ syl5eqr zaddmul @ eqtrd _ anr)
    '(casesda (anwr @ eqtr4d (syl6eq zmul02 zmuleq2) (syl6eq zmul02 zmuleq2)) _)
    '(zmuleq1d @ a1i zpncan3)));

theorem zdvdadd2: $ n |Z a -> (n |Z b <-> n |Z b +Z a) $ =
'(syl6bb (zdvdeqd eqidd id zaddcom) zdvdadd1);

theorem zdvdmul12: $ a |Z b -> a |Z c *Z b $ = '(mpi zdvdmul1 zdvdtr);
theorem zdvdmul11: $ a |Z b -> a |Z b *Z c $ = '(mpi zdvdmul2 zdvdtr);

@(add-eval @ fn (a n) @ let ([a (evalZ a)] [n (eval n)])
  @ if {a >= 0} {a % n} {{{a + 1} % n} + {n - 1}})
@_ local def zmod (a n: nat): nat = $ zabs (zfst a + n -ZN zsnd a % n) % n $;
infixl zmod: $%Z$ prec 70;

theorem zmod02: $ a %Z 0 = zabs a $ =
'(eqtr (modeq1 @ zabseq @ eqtr (znsubeq add02 mod0) zfstsnd) mod0);
theorem zmodb00: $ b0 a %Z 0 = a $ = '(eqtr zmod02 zabsb0);

theorem zmodn02: $ n != 0 -> a %Z n = (zfst a + n - zsnd a % n) % n $ =
'(modeq1d @ syl6eq zabsb0 @ zabseqd @ syl znsubpos @
  letrd (syl ltle modlt) (a1i leaddid2));

theorem zmodb0: $ b0 a %Z n = a % n $ =
'(cases
  (eqtr4d zmodeq2 @ syl6eqr zmod02 @ syl6eqr zabsb0 @ syl6eq mod0 modeq2)
  (syl6eq eqmaddn @ syl6eq (modeq1 @ eqtr (subeq (addeq1 zfstb0) @
    eqtr (modeq1 zsndb0) mod01) sub02) zmodn02));

theorem zmodb1: $ a < n -> b1 a %Z n = n - suc a $ =
'(eqtrd (syl zmodn02 @ sylib lt01 @ lelttr le01) @
  syl5eq (modeq1 @ subeq (eqtr (addeq1 zfstb1) add01) @ modeq1 zsndb1) @
  sylbi leloe @ eor
  (eqtrd (modeq1d @ subeq2d modlteq) @
    syl modlteq @ sylan subltid (lttr lt01S) @ a1i lt01S)
  (eqtr4d (modeq1d @ syl6eq sub02 @ subeq2d @ syl6eq modid modeq1) @
    syl6eqr modid @ syl6eq subid subeq2));

theorem zmod01: $ 0 %Z a = 0 $ = '(eqtr3 (zmodeq1 b00) @ eqtr zmodb0 mod01);

theorem zmodmodid: $ a %Z n % n = a %Z n $ = 'modmodid;

theorem zmodeq0: $ a %Z n = 0 <-> b0 n |Z a $ =
'(bitr4 modeq0 @ bitr4 zdvdb01 @ trud @ syl6bb eqmdvdsub3 @
  syl5bbr eqmdvdsub2 @ syl6bb eqmcomb @ eqmeqm23d (a1i eqmmod) (a1i eqmaddn));

@(add-eval @ fn (n a b) {{{(evalZ a) - (evalZ b)} % (eval n)} = 0})
@_ local def zeqm (n a b) = $ b0 n |Z a -Z b $;
notation zeqm (n a b) = ($modZ($:50) n ($):$:50) a ($=$:50) b;

theorem zeqmid: $ modZ(n): a = a $ = '(mpbir (zdvdeq2 zsubid) zdvd02);
theorem zeqmidd: $ G -> modZ(n): a = a $ = '(a1i zeqmid);
theorem zeqmtr: $ modZ(n): a = b -> modZ(n): b = c -> modZ(n): a = c $ =
'(syl6ib (zdvdeq2 znpncan2) @ bi1d zdvdadd2);
theorem zeqmtrd (h1: $ G -> modZ(n): a = b $) (h2: $ G -> modZ(n): b = c $):
  $ G -> modZ(n): a = c $ = '(sylc zeqmtr h1 h2);
theorem zeqmcomb: $ modZ(n): a = b <-> modZ(n): b = a $ =
'(bitr3 zdvdneg2 @ zdvdeq2 znegsub);
theorem zeqmcom: $ modZ(n): a = b -> modZ(n): b = a $ = '(bi1i zeqmcomb);
theorem zeqmcomd (h: $ G -> modZ(n): a = b $): $ G -> modZ(n): b = a $ = '(syl zeqmcom h);
theorem zeqmtr4d (h1: $ G -> modZ(n): a = b $) (h2: $ G -> modZ(n): c = b $):
  $ G -> modZ(n): a = c $ = '(zeqmtrd h1 @ zeqmcomd h2);
theorem zeqmtr3d (h1: $ G -> modZ(n): b = a $) (h2: $ G -> modZ(n): b = c $):
  $ G -> modZ(n): a = c $ = '(zeqmtrd (zeqmcomd h1) h2);
theorem eqzeqm: $ a = b -> modZ(n): a = b $ = '(mpbii zeqmid zeqmeq3);
theorem eqzeqmd (h: $ G -> a = b $): $ G -> modZ(n): a = b $ = '(syl eqzeqm h);
theorem zeqmeqm: $ modZ(n): b0 a = b0 b <-> mod(n): a = b $ =
'(bitr4 (zdvdeq2 zsubb0) @ bitr eqmcomb eqmzdvdsub);
theorem zeqm03: $ modZ(n): a = 0 <-> b0 n |Z a $ = '(zdvdeq2 zsub02);
theorem zeqmznsub: $ modZ(n): a -ZN b = 0 <-> mod(n): a = b $ =
'(bitr4 zeqm03 @ bitr eqmcomb eqmzdvdsub);
theorem zeqmsub: $ modZ(n): a -Z b = 0 <-> modZ(n): a = b $ = '(zdvdeq2 zsub02);
theorem zeqmid0: $ modZ(n): b0 n = 0 $ = '(mpbir zeqm03 zdvdid);
theorem zeqm01: $ modZ(0): a = b <-> a = b $ =
'(bitr (zdvdeq1 b00) @ bitr zdvd01 zsubeq0);

theorem zeqmeqm23d (h1: $ G -> modZ(n): a = b $) (h2: $ G -> modZ(n): c = d $):
  $ G -> (modZ(n): a = c <-> modZ(n): b = d) $ =
'(ibida
  (sylc zeqmtr (syl zeqmcom @ anwl h1) @ sylc zeqmtr anr @ anwl h2)
  (sylc zeqmtr (anwl h1) @ sylc zeqmtr anr @ syl zeqmcom @ anwl h2));
theorem zeqmeqm2: $ modZ(n): a = b -> (modZ(n): a = c <-> modZ(n): b = c) $ =
'(zeqmeqm23d id @ a1i zeqmid);
theorem zeqmeqm3: $ modZ(n): b = c -> (modZ(n): a = b <-> modZ(n): a = c) $ =
'(zeqmeqm23d (a1i zeqmid) id);

theorem zeqmadd1: $ modZ(n): a +Z c = b +Z c <-> modZ(n): a = b $ = '(zdvdeq2 zpnpcan1);
theorem zeqmadd2: $ modZ(n): a +Z b = a +Z c <-> modZ(n): b = c $ = '(zdvdeq2 zpnpcan2);

theorem zeqmadd1d (h: $ G -> modZ(n): a = b $): $ G -> modZ(n): a +Z c = b +Z c $ =
'(sylibr zeqmadd1 h);
theorem zeqmadd2d (h: $ G -> modZ(n): b = c $): $ G -> modZ(n): a +Z b = a +Z c $ =
'(sylibr zeqmadd2 h);

theorem zeqmaddd (h1: $ G -> modZ(n): a = b $) (h2: $ G -> modZ(n): c = d $):
  $ G -> modZ(n): a +Z c = b +Z d $ =
'(sylc zeqmtr (zeqmadd1d h1) (zeqmadd2d h2));

theorem zeqmneg: $ modZ(n): -uZ a = -uZ b <-> modZ(n): a = b $ =
'(bitr zeqmcomb @ zdvdeq2 znegsub2);

theorem zeqmsub1: $ modZ(n): a -Z c = b -Z c <-> modZ(n): a = b $ = 'zeqmadd1;
theorem zeqmsub2: $ modZ(n): a -Z b = a -Z c <-> modZ(n): b = c $ = '(bitr zeqmadd2 zeqmneg);
theorem zeqmsubd (h1: $ G -> modZ(n): a = b $) (h2: $ G -> modZ(n): c = d $):
  $ G -> modZ(n): a -Z c = b -Z d $ =
'(sylc zeqmtr (sylibr zeqmsub1 h1) (sylibr zeqmsub2 h2));

theorem zeqmznsub1: $ modZ(n): a -ZN c = b -ZN c <-> mod(n): a = b $ =
'(bitr3 (zeqmeq eqid zsubb0 zsubb0) @ bitr zeqmsub1 zeqmeqm);
theorem zeqmznsub2: $ modZ(n): a -ZN b = a -ZN c <-> mod(n): b = c $ =
'(bitr3 (zeqmeq eqid zsubb0 zsubb0) @ bitr zeqmsub2 zeqmeqm);

theorem zeqmznsubd (h1: $ G -> mod(n): a = b $) (h2: $ G -> mod(n): c = d $):
  $ G -> modZ(n): a -ZN c = b -ZN d $ =
'(sylc zeqmtr (sylibr zeqmznsub1 h1) (sylibr zeqmznsub2 h2));

theorem zeqmaddn: $ modZ(n): a +Z b0 n = a $ =
'(mpbi (zeqmeq3 zadd02) @ mpbir zeqmadd2 zeqmid0);

theorem zeqmmod: $ n != 0 -> modZ(n): b0 (a %Z n) = a $ =
'(syl (zeqmtr @ mpbir zeqmeqm eqmmod) @
  mpbird (zeqmeq2d @
    sylibr b0zabs @ sylibr zle0znsub @ letrd (syl ltle modlt) (a1i leaddid2)) @
  sylib (zeqmeq3 zfstsnd) @ zeqmznsubd (a1i eqmaddn) (a1i eqmmod));

theorem zmodeqmod: $ n != 0 -> (a %Z n = b %Z n <-> modZ(n): a = b) $ =
'(syl5bb (ibii (syl eqzeqm b0eq) (eqtr3g zmodmodid zmodmodid @ bi1i zeqmeqm)) @
  zeqmeqm23d zeqmmod zeqmmod);

theorem dvdzeqm (h1: $ G -> m || n $)
  (h2: $ G -> modZ(n): a = b $): $ G -> modZ(m): a = b $ =
'(sylc dvdtr (sylibr (dvdeq zabsb0 zabsb0) h1) h2);

theorem zeqm11: $ modZ(1): a = b $ = 'zdvd11;

do (def (gcd a b) @ if {a = 0} b (gcd {b % a} a));

@(add-eval @ fn (a b) (gcd (eval a) (eval b)))
@_ local def gcd (a b: nat): nat = $ the {d | A. x (x || d <-> x || a /\ x || b)} $;

theorem gcdcom: $ gcd a b = gcd b a $ =
'(theeqd id @ !! cbvab d1 d2 @ !! cbvald x y @ bieqd (dvdeqd anr anl) @
  syl5bb ancomb @ anwr @ aneqd dvdeq1 dvdeq1);

theorem eqgcd {x} (h: $ G -> (x || d <-> x || a /\ x || b) $):
  $ G -> gcd a b = d $ =
(focus
  (def h1 '(rsyl (anwl @ iald h) @ eale @ bieqd dvdeq1 @ aneqd dvdeq1 dvdeq1))
  (def h2 '(anwr @ eale @ bieqd dvdeq1 @ aneqd dvdeq1 dvdeq1))
  '(!! eqtheabd d2 @ ibida
    (dvdasymd (mpbird ,h1 @ mpbii dvdid ,h2) (mpbird ,h2 @ mpbii dvdid ,h1))
    (mpbird
      (!! cbvald y x @ bieqd (dvdeqd anr anlr) (anwr @ aneqd dvdeq1 dvdeq1))
      (anwl @ iald h))));

theorem gcd00: $ gcd 0 0 = 0 $ =
'(trud @ !! eqgcd x @ a1i @ bith dvd02 @ ian dvd02 dvd02);

@(add-eval @ fn (a b) (def a (eval a)) @ if {a = 0} 0 (gcd a (eval b)))
@_ local def bgcd (a b: nat): nat = $ least {d | 0 < d /\ E. x E. y x * a = y * b + d} $;

theorem dfbgcd: $ bgcd a b = least {d | 0 < d /\ E. x E. y x * a = y * b + d} $ =
'(leasteq @ !! cbvab d2 d @ aneqd lteq2 @ !! cbvexd z x @ !! cbvexd w y @
    eqeqd (muleq1d anlr) @ addeqd (anwr muleq1) anll);

theorem bgcd01: $ bgcd 0 b = 0 $ =
'(least0 @ !! ngen d @ mt (sylbi
  (!! elabe d2 @ aneqd lteq2 @ exeqd @ exeqd @
    eqeqd (a1i mul02) addeq2) @
  imp @ !! eexd x @ !! eexd y @
  syl absurd @ syl ltne @ mpi leaddid2 ltletr) notfal);

theorem bgcdlem: $ a != 0 -> 0 < bgcd a b /\ E. x E. y x * a = y * b + bgcd a b $ =
'(sylib
  (!! elabe d @ aneqd lteq2 @ !! cbvexd z x @ !! cbvexd w y @
    eqeqd (muleq1d anlr) @ addeqd (anwr muleq1) anll) @
  syl leastel @ sylibr (elabe @ aneqd lteq2 @ exeqd @ exeqd @ eqeq2d addeq2) @
  iand (bi2 lt01) @ iexde @ iexde @
  eqtr4d (syl6eq mul11 @ muleq1d anlr) @
  syl6eq add01 @ addeq1d @ syl6eq mul01 @ anwr muleq1);

theorem bgcdpos: $ a != 0 -> 0 < bgcd a b $ = '(anld @ ! bgcdlem a b x y);

theorem bgcdbezout: $ E. x E. y x * a = y * b + bgcd a b $ =
'(cases
  (iexde @ iexde @ eqtr4d (muleqd anlr anll) @ syl6eqr mul01 @
    syl6eq add0 @ addeqd (syl6eq mul01 @ anwr muleq1) (syl6eq bgcd01 @ bgcdeq1d anll))
  (anrd bgcdlem));

theorem bgcdled (h: $ G -> 0 < d $) (h2: $ G -> x * a = y * b + d $):
  $ G -> bgcd a b <= d $ =
'(syl leastle @ sylibr (!! elabe d2 @ aneqd lteq2 @ exeqd @ exeqd @ eqeq2d addeq2) @
  iand h @ !! iexde z @ !! iexde w @
  mpbird (eqeqd (muleq1d anlr) (addeq1d @ anwr muleq1)) (anwll h2));

theorem bgcd02: $ bgcd a 0 = a $ =
'(cases (eqtr4d (syl6eq bgcd01 bgcdeq1) id) @ leasymd
  (bgcdled (bi2i lt01) @ a1i @ eqtr mul11 @ eqcom @ eqtr (addeq1 mul01) add01)
  (mpi (!! bgcdbezout x y) @ eexd @ eexda @
    mpbid (leeqd (a1i mul11) @ syl6eq add01 @ syl6eq (addeq1 mul0) anr) @
    syl lemul1a @ sylibr lt01 @ mtand (anwl @ syl ltner bgcdpos) @ eqtr3d
      (anwl @ syl6eq add01 @ syl6eq (addeq1 mul0) anr)
      (syl6eq mul01 @ anwr muleq1)));

theorem dvdbgcd: $ d || a /\ d || b -> d || bgcd a b $ =
'(mpi (!! bgcdbezout x y) @ eexd @ eexda @
  mpbird (syl dvdadd1 @ syl dvdmul12 anlr) @
  mpbid (anwr dvdeq2) (anwll dvdmul12));

theorem bgcddvd1lem (h1: $ G -> a != 0 $) (h2: $ G -> x * a = y * b + d $)
  (h3: $ G -> b != 0 $) (h4: $ G -> d * q + r = a $)
  (h5: $ G -> x <= u $) (h6: $ G -> y <= u $):
  $ G -> suc ((u * b - x) * q) * a = (u * a - y) * q * b + r $ =
'(sylib addcan1 @ syl5eqr addass @
  eqtr4d (addeq1d @ syl5eqr addmul @ muleq1d @
    syl5eq addS1 @ suceqd @ syl5eqr addmul @ muleq1d @
    syl npcan @ letrd h5 @ sylib (leeq1 mul12) @ syl lemul2a @ sylibr lt01 h3) @
  syl5eq (addeq2 addcom) @ syl5eqr addass @
  eqtr4d (addeq1d @ syl5eq addrass @ addeq1d @
    syl5eqr addmul @ muleq1d @ syl5eqr addmul @ muleq1d @
    syl npcan @ letrd h6 @ sylib (leeq1 mul12) @ syl lemul2a @ sylibr lt01 h1) @
  syl6eqr addrass @ syl6eqr addass @
  syl5eq (addeq1 @ eqtr mulS1 @ addeq1 @
    eqtr mulass @ eqtr mulass @
    eqtr4 (muleq2 @ eqtr mulcom @ muleq1 mulcom) @
    eqtr (muleq1 mulass) mulass) @
  syl5eq addass @ addeq2d @ syl5eq addcom @
  eqtr3d (addeq2d h4) @ syl5eqr addass @ addeq1d @
  syl5eq (addeq1 mulrass) @ syl5eqr addmul @ syl6eq mulrass @
  muleq1d @ eqcomd h2);

theorem bgcddvd2lem (h1: $ G -> a != 0 $) (h2: $ G -> x * a = y * b + d $)
  (h3: $ G -> b != 0 $) (h4: $ G -> d * q + r = b $)
  (h5: $ G -> x * q <= u $) (h6: $ G -> y * q < u $):
  $ G -> (u * b - x * q) * a = (u * a - suc (y * q)) * b + r $ =
'(sylib addcan1 @ syl5eqr addass @
  eqtr4d (addeq1d @ syl5eqr addmul @ muleq1d @
    syl npcan @ letrd h5 @ sylib (leeq1 mul12) @ syl lemul2a @ sylibr lt01 h3) @
  syl5eq (addeq2 addcom) @ syl5eqr addass @
  eqtr4d (addeq1d @ syl5eq addrass @ addeq1d @ syl5eqr addmul @ muleq1d @
    syl npcan @ letrd h6 @ sylib (leeq1 mul12) @ syl lemul2a @ sylibr lt01 h1) @
  syl6eqr addrass @ syl6eqr addass @
  syl5eq (addeq1 mulrass) @ addeq2d @
  syl5eq mulS1 @ eqtr3d (addeq2d h4) @
  syl5eqr addass @ addeq1d @ syl5eq (addeq1 mulrass) @
  syl5eqr addmul @ syl6eq mulrass @ muleq1d @ eqcomd h2);

theorem bgcddvd1: $ bgcd a b || a $ =
'(cases (mpbiri dvd02 dvdeq2) @ mpi (! bgcdbezout a b x y) @ eexd @ eexda @
  casesda (anwr @ mpbii dvdid @ dvdeq2d @ syl6eq bgcd02 bgcdeq2) @
  sylib modeq0 @ mpd (anwll @ syl modlt @ sylib lt01 bgcdpos) @
  syl5bi ltnle @ con1d @ exp @ bgcdled (sylibr lt01 anr) @
  bgcddvd1lem an3l anllr anlr (a1i divmod) (a1i lemax1) (a1i lemax2));

theorem bgcddvd2: $ a != 0 -> bgcd a b || b $ =
'(casesda (anwr @ mpbiri dvd02 dvdeq2) @ mpi (! bgcdbezout a b x y) @ eexd @ eexda @
  sylib modeq0 @ mpd (anwll @ syl modlt @ sylib lt01 bgcdpos) @
  syl5bi ltnle @ con1d @ exp @ bgcdled (sylibr lt01 anr) @
  bgcddvd2lem an3l anlr anllr (a1i divmod) (a1i lemax1) (a1i lemax2));

theorem dvdbgcdb: $ a != 0 -> (d || bgcd a b <-> d || a /\ d || b) $ =
'(ibid
  (exp @ iand (sylc dvdtr anr (a1i bgcddvd1)) (sylc dvdtr anr (anwl bgcddvd2)))
  (a1i dvdbgcd));

theorem gcdbgcd: $ a != 0 -> gcd a b = bgcd a b $ = '(!! eqgcd d dvdbgcdb);

theorem gcd01: $ gcd 0 b = b $ = '(trud @ !! eqgcd d @ a1i @ bicom @ bian1 dvd02);

theorem dvdgcdlem {x} (h: $ G -> (x || d <-> x || a /\ x || b) $):
  $ G -> (c || gcd a b <-> c || a /\ c || b) $ =
'(bitrd (dvdeq2d @ eqgcd h) @
  syl (eale @ bieqd dvdeq1 @ aneqd dvdeq1 dvdeq1) (iald h));

theorem dvdgcd: $ d || gcd a b <-> d || a /\ d || b $ =
'(cases (!! dvdgcdlem x @ bicomd @ syl bian1 @ mpbiri dvd02 dvdeq2) (!! dvdgcdlem x dvdbgcdb));
theorem gcddvd1: $ gcd a b || a $ = '(anl @ mpbi dvdgcd dvdid);
theorem gcddvd2: $ gcd a b || b $ = '(anr @ mpbi dvdgcd dvdid);

theorem gcd02: $ gcd a 0 = a $ = '(eqtr gcdcom gcd01);

theorem bezout: $ a != 0 -> E. x E. y x * a = y * b + gcd a b $ =
'(mpbiri bgcdbezout @ exeqd @ exeqd @ eqeq2d @ addeq2d gcdbgcd);

@(add-eval @ fn (a b) {(gcd (eval a) (eval b)) = 1})
@_ local def coprime (a b: nat): wff = $ gcd a b = 1 $;

theorem copcom: $ coprime a b <-> coprime b a $ = '(eqeq1 gcdcom);

theorem dvdcop (h1: $ G -> coprime a b $)
  (h2: $ G -> d || a $) (h3: $ G -> d || b $): $ G -> d = 1 $ =
'(sylib dvd12 @ mpbid (dvdeq2d h1) @ sylibr dvdgcd @ iand h2 h3);

theorem dfcop2: $ coprime a b <-> A. x (x || a -> x || b -> x = 1) $ =
'(ibii
  (ialda @ exp @ dvdcop anll anlr anr)
  (!! eqgcd y @ ibid
    (a1i @ iand (mpi dvd11 dvdtr) (mpi dvd11 dvdtr))
    (exp @ sylibr dvd12 @ mpd anrr @ mpd anrl @ anwl @
      eale @ imeqd dvdeq1 @ imeqd dvdeq1 eqeq1)));

theorem copbezout (h1: $ G -> coprime a b $) (h2: $ G -> a != 0 $):
  $ G -> E. x E. y x * a = y * b + 1 $ =
'(mpbid (exeqd @ exeqd @ eqeq2d @ addeq2d h1) (syl bezout h2));

theorem copdvdmul2 (h1: $ G -> coprime a b $) (h2: $ G -> a || b * c $): $ G -> a || c $ =
'(casesda
  (mpbid (dvdeq2d @ syl6eq mul11 @
    muleq1d @ eqtr3d (anwr @ syl6eq gcd01 gcdeq1) (anwl h1)) (anwl h2))
  (mpd (copbezout (anwl h1) anr) @ !! eexd x @ !! eexda y @
    mpbird (syl dvdadd1 @ syl dvdmul11 @ anwll h2) @ mpbii dvdmul1 @
    dvdeq2d @ syl5eq mulrass @ syl6eq (addeq mulrass mul11) @
    syl6eq addmul @ muleq1d @ syl6eq (addeq1 mulcom) anr));

theorem copdvdmul1 (h1: $ G -> coprime a c $) (h2: $ G -> a || b * c $): $ G -> a || b $ =
'(copdvdmul2 h1 @ sylib (dvdeq2 mulcom) h2);

@_ local def invm (a n: nat): nat = $ least {b | mod(n): a * b = 1} $;

theorem mulinvmlem (h: $ G -> mod(n): a * b = 1 $): $ G -> mod(n): a * invm a n = 1 $ =
'(sylib (!! elabe x @ eqmeq2d muleq2) @ syl leastel @ sylibr (elabe @ eqmeq2d muleq2) h);

theorem mulinvm (h: $ G -> coprime a n $):
  $ G -> mod(n): a * invm a n = 1 $ =
'(casesda (mpbiri eqm11 @ eqmeq1d @ eqtr3d (syl6eq gcd01 @ anwr gcdeq1) (anwl h)) @
  casesda (mulinvmlem @ syl eqeqm @ syl5eq mul12 @ eqtr3d (syl6eq gcd02 @ anwr gcdeq2) (anwll h)) @
  mpd (copbezout (anwll h) anlr) @ !! eexd x @ !! eexda y @ mulinvmlem @
  mpbid (eqmeq23d (eqtr3d anr @ a1i mulcom) (a1i add01)) @
  eqmadd1d @ a1i @ mpbir eqm03 dvdmul1);

@_ local def pset (a: nat): set = $ {n | 0 < fst a /\ 0 < snd a /\
  A. x (0 < x /\ x <= n -> x || fst a) /\ suc (fst a * suc n) || snd a} $;

theorem elpset: $ n e. pset (m, v) <-> 0 < m /\ 0 < v /\
  A. x (0 < x /\ x <= n -> x || m) /\ suc (m * suc n) || v $ =
'(!! elabe y @ aneqd (aneqd (aneqd (lteq2d @ a1i @ fstpr) (lteq2d @ a1i @ sndpr)) @
    !! cbvald x1 _ @ imeqd (aneqd (anwr lteq2) (leeqd anr anl)) (dvdeqd anr (a1i fstpr))) @
  dvdeqd (suceqd @ muleqd (a1i fstpr) suceq) @ a1i sndpr);

theorem elpset1: $ ~n e. pset (m, 1) $ =
'(inot @ sylbi (!! elpset x) @
  sylc absurd (sylib lenlt @ syl (sylibr mulpos @ iand id @ a1i lt01S) an3l) @
  dvdle (a1i d1ne0) anr);

theorem psetSlem1 (h1: $ G -> A. x (0 < x /\ x < n -> x || m) $)
  (h2: $ G -> i < j $) (h3: $ G -> j < n $):
  $ G -> coprime (suc (m * suc i)) (suc (m * suc j)) $ =
(focus
  '(sylibr dfcop2 @ !! iald u @ exp @ exp @
    sylib dvd12 @ mpbird _ (sylibr (dvdeq2 add12) anlr))
  '(syl dvdadd1 @ syl dvdmul11 @
    sylc dvdtr (mpbird
      (syl dvdadd1 @ anwr dvdmul11)
      (mpbird (dvdeq2d _) (syl dvdmul11 anlr))) @
    sylc (eale @ imeqd (aneqd lteq2 lteq1) dvdeq1) (anwll h1) @
    iand (sylib subpos @ anwll h2) @ lelttrd (a1i subleid) (anwll h3))
  '(syl5eq (addeq1 mulS1) @ syl5eq addass @
    syl6eqr mulS1 @ syl6eq (addeq1 mulrass) @ addeq2d @
    syl5eq addS1 @ suceqd @ syl pncan3 @ syl ltle @ anwll h2));

theorem psetSlem2 (h1: $ G -> A. x (0 < x /\ x < n -> x || m) $) (h2: $ G -> a != b $)
  (h3: $ G -> a < n $) (h4: $ G -> b < n $):
  $ G -> coprime (suc (m * suc a)) (suc (m * suc b)) $ =
'(mpd (sylib neltlt h2) @ eorda
  (psetSlem1 (anwl h1) anr (anwl h4))
  (sylib copcom @ psetSlem1 (anwl h1) anr (anwl h3)));

theorem psetS (h1: $ G -> 0 < m $) (h2: $ G -> 0 < v $)
  (h3: $ G -> A. x (0 < x /\ x <= n -> x || m) $): $ G ->
  (a e. pset (m, v * suc (m * suc n)) <-> a e. pset (m, v) \/ a = n) $ =
(focus
  '(syl5bb elpset @ syl6bbr (oreq1i elpset) @ ibid
    (exp @ syla orcom @ iand (iand (iand
      (anwll h1)
      (anld @ sylib mulpos @ syl anllr anlr))
      (syl anlr anlr))
      (copdvdmul1 (psetSlem2
        (sylib (!! cbval _ y (imeqd (aneqd lteq2 lteq1) dvdeq1)) @
          sylc _ (syl anlr anlr) (anwll h3))
        anr (a1i lemax1) (a1i lemax2)) (anwl anrr)))
    (eord (animd (a1i @ anim1 @ anim2 @ sylibr mulpos @ iand id @ a1i lt01S)
      (a1i dvdmul11)) @
      syl5ibrcom (aneqd (aneq2d @ aleqd @ imeq1d @ aneq2d leeq2) @
        dvdeq1d @ suceqd @ muleq2d suceq) @
      iand (iand (iand h1 (sylibr mulpos @ iand h2 @ a1i lt01S)) h3) @ a1i dvdmul1))
  '(al2imi @ syl6 (imim1i @ sylib andi @ anim2 @
    sylbi ltmax @ bi2 @ oreqi leltsuc leltsuc) eor));

theorem lcmex: $ E. m (0 < m /\ A. x (0 < x /\ x <= n -> x || m)) $ =
(named @ induct '(ind) 'n
  '(iexe (aneqd leeq2 @ aleqd @ imeq2d dvdeq2) @
    ian d0lt1 @ ax_gen @ imp @ sylbi ltnle absurd)
  '(sylbi (!! cbvex _ a @ aneqd leeq2 @ aleqd @ imeq2d dvdeq2) @ eex @ sylan
    (iexe @ aneqd leeq2 @ aleqd @ imeq2d dvdeq2)
    (sylibr mulpos @ iand anl @ a1i lt01S)
    (anwr @ alimi @ sylbi impexp @ sylibr impexp @ imim2 @ syl5bi leloe @ eord
      (syl5bir leltsuc @ imim2i dvdmul11)
      (a1i @ mpbii dvdmul1 @ dvdeq2d muleq2))));

theorem psetsep (p: wff x): $ E. b pset b == {x | x < n /\ p} $ =
(focus
  (have 'h1 $ y < suc v /\ [y / x] p <-> y < v /\ [y / x] p \/ y = v /\ [v / x] p $
    '(bitr (aneq1i @ bitr3 leltsuc leloe) @ bitr andir @ oreq2i @ aneq2a sbeq1))
  (have 'h2 $ 0 < m /\ A. x (0 < x /\ x <= n -> x || m) ->
              E. a (0 < a /\ pset (m, a) == {x | x < n /\ p}) $
    @ induct '(indlt) 'n
    '(a1i @ iexe (aneqd lteq2 @ eqseq1d @ pseteqd preq2) @
      ian d0lt1 @ eqab2i @ binth elpset1 @ mt anl lt02)
    '(imp @ casesda
      (syl6ibr (!! cbvex _ b @ aneqd lteq2 @ eqseq1d @ pseteqd preq2) @
        eexda @ syl (iexe @ aneqd lteq2 @ eqseq1d @ pseteqd preq2) @
        iand (sylibr mulpos @ iand anrl @ a1i lt01S) @ !! eqrd y @
        syl6bbr (bitr elab @ sbeh (nfan nfv nfsb1) @ aneqd lteq1 sbq) @
        bitrd (psetS (anld an3l) anrl @
          sylib (!! cbval _ z @ imeqd (aneqd lteq2 leeq1) dvdeq1) @ mpd (anrd an3l) @
          rsyl (syl (letr lesucid) anllr) @ alimd @ imim1d @ anim2d @ com12 letr) @
        bitr4d (oreq1d @ syl6bb
          (bitr elab @ sbeh (nfan nfv nfsb1) @ aneqd lteq1 sbq) @ eleq2d anrr) @
        syl5bb h1 @ oreq2d @ syl bian2 anlr)
      (bi2d @ exeqd @ aneq2d @ eqseq2d @ !! eqrd y @
        syl5bb (bitr elab @ sbeh (nfan nfv nfsb1) @ aneqd lteq1 sbq) @
        syl6bbr (bitr elab @ sbeh (nfan nfv nfsb1) @ aneqd lteq1 sbq) @
        syl5bb h1 @ syl bior2 @ anwr @ con3 anr)))
  '(eex (mpd h2 @ eexda @ !! iexde b @ eqstrd (anwr pseteq) (anwl anrr)) lcmex));

theorem expset: $ finite A <-> E. a pset a == A $ =
(focus
  (have 'h '(sylib (!! elpset y) @ mpbird (eleq2d @ eqstrd (a1i @ pseteq fstsnd) anll) anr))
  '(! ibii $ E. n A. x _ $ _
    (eex @ mpbii psetsep @ exeqd @ eqseq2d @ !! eqab1d y @ syl bian1a @
      eale @ imeqd eleq1 lteq1)
    (eex @ iexde @ ialda @
      letrd (syl (mpi lesucid letr) @
        sylib (leeq1 mul11) @ syl lemul1a @ syl an3l h) @
      letrd (dvdle (syl ltner @ syl anllr h) (anrd h)) @
      syl eqler anlr)));

theorem psetfn (p: wff x) (v: nat x):
  $ finite {x | p} -> E. a A. x (p -> pset a @ x = v) $ =
'(rsyl (sylib expset finlam) @ eximi @
  ialdh (nfeqs nfsv @ nfres (!! nflam x y @ nfsbn1) nfab1) @ exp @
  eqtrd (anwl appeq1) @ syl6eq (eqtr3 (appeq1 cbvlams) applam) @
  anwr @ sylbir abid resapp);

--| Simple recursion operator:
--| * `rec 0 = z`
--| * `rec (n+1) = S (rec n)`
@_ abstract def rec (z: nat) (S: set) (n: nat): nat =
$ the {v | E. a (pset a @ 0 = z /\ pset a @ n = v /\
    A. i (i < n -> pset a @ suc i = S @ (pset a @ i)))} $;

theorem reclem {i}
  (h1: $ G -> pset a @ 0 = z $) (h2: $ G -> pset a @ n = v $)
  (h3: $ G -> A. i (i < n -> pset a @ suc i = S @ (pset a @ i)) $):
  $ G -> rec z S n = v $ =
(named @ focus
  '(!! eqtheabd u @ ibid
    (eexda @ eqtr3d (anwr anlr) @ eqtrd _ (anwl h2))
    (exp @ !! iexde b @ iand (iand
        (eqtrd (appeq1d @ anwr pseteq) (anwll h1))
        (eqtrd (appeq1d @ anwr pseteq) @ eqtr4d (anwll h2) anlr)) @
      mpbird (aleqd @ imeq2d @ eqeqd (appeq1d @ anwr pseteq) @
        appeq2d @ appeq1d @ anwr pseteq) (anwll h3)))
  @ induct '(indlt) 'n
  '(eqtr4d (anwr anll) (anwl h1))
  '(eqtrd (mpd anlr @ rsyl anllr @ anwr @ eale @ imeqd lteq1 @
      eqeqd (appeq2d suceq) (appeq2d appeq2)) @
    eqtr4d (anwr appeq2) @
    mpd anlr @ anw3l @ rsyl h3 @ eale @ imeqd lteq1 @
      eqeqd (appeq2d suceq) (appeq2d appeq2)));

pub theorem rec0 (z: nat) (S: set): $ rec z S 0 = z $ =
(focus
  (have 'h $ A. x (x = 0 -> pset a @ x = z) -> pset a @ 0 = z $
    '(mpi eqid (eale @ imeqd eqeq1 @ eqeq1d appeq2)))
  '(eex (reclem h h @ a1i @ !! ax_gen i @ absurd lt02) (psetfn snfin)));

pub theorem recS (z: nat) (S: set) (n: nat):
  $ rec z S (suc n) = S @ rec z S n $ =
(focus
  '(trud @ ! indstr _ m k _ $ rec z S (suc m) = S @ rec z S m $ _ _
    (eqeqd (receq3d suceq) (appeq2d receq3))
    (eqeqd (receq3d suceq) (appeq2d receq3)) @ anwr @
    mpi (psetfn lefin) @ ! eexda _ _ $ A. x (x <= suc k ->
      pset a @ x = if (x = suc k) (S @ rec z S k) (rec z S x)) $ _ @
    reclem
      (anwr @ syl6eq rec0 @ mpi le01 @ eale @ imeqd leeq1 @ eqeqd appeq2 @
        eqtrd (syl ifneg @ con2 sucne0) receq3)
      (anwr @ mpi leid @ eale @ imeqd leeq1 @ eqeqd appeq2 ifpos)
      (!! iald y @ syl5bir leltsuc @ exp @
        eqtrd (mpd (sylib lesuc anr) @ rsyl anlr @ eale @ imeqd leeq1 @
          eqeqd appeq2 @ ifeqd (syl6bb peano2 eqeq1) eqidd receq3) _))
  (have 'h
    $ A. m (m < k -> rec z S (suc m) = S @ rec z S m) /\
      A. x (x <= suc k -> pset a @ x = if (x = suc k) (S @ rec z S k) (rec z S x)) /\
      y <= k -> rec z S y = pset a @ y $
    '(mpd anlr @ anwr @ ealde @ syl6 eqcom @ bi1d @
      bitrd (syl biim1 @ mpbird (anwr leeq1) @ letrd anl @ a1i lesucid) @
      eqeqd (anwr appeq2) @
      eqtrd (syl ifneg @ syl ltne @ sylib leltsuc @ imp @ syl5ibrcom leeq1 id) @
      anwr receq3))
  '(casesda
    (eqtr4d (anwr ifpos) @ appeq2d @ eqtr3d (anwl h) (anwr receq3))
    (eqtrd (anwr ifneg) @
      eqtrd (mpd (imp @ syl orcom @ sylib leloe anr) @
        rsyl an3l @ eale @ imeqd lteq1 @
        eqeqd (receq3d suceq) (appeq2d receq3)) @
      appeq2d @ anwl h)));

@_ local def recnaux (z: nat) (S: set) (n: nat): nat =
$ rec (0, z) (\ p, suc (fst p), S @ p) n $;

theorem recnaux0: $ recnaux z S 0 = 0, z $ = (named 'rec0);

theorem recnauxS2: $ recnaux z S (suc n) =
  suc (fst (recnaux z S n)), S @ recnaux z S n $ =
'(eqtr recS @ ! applame $ recnaux z S n $ _ p _ @
  preqd (suceqd fsteq) appeq2);

theorem recnauxfst: $ fst (recnaux z S n) = n $ =
(named @ induct '(ind) 'n
  '(eqtr (fsteq recnaux0) fstpr)
  '(syl5eq (eqtr (fsteq recnauxS2) fstpr) suceq));

--| Recursion operator with iteration variable:
--| * `recn 0 = z`
--| * `recn (n+1) = S (n, recn n)`
@_ local def recn (z: nat) (S: set) (n: nat): nat = $ snd (recnaux z S n) $;

theorem recn0: $ recn z S 0 = z $ = (named '(eqtr (sndeq rec0) sndpr));
theorem recnS: $ recn z S (suc n) = S @ (n, recn z S n) $ =
'(eqtr (sndeq recnauxS2) @ eqtr sndpr @ appeq2 @
  eqtr3 fstsnd @ preq1 recnauxfst);

@_ local def ocase (z: nat) (S: set): set = $ \ n, recn z (\ i, S @ fst i) n $;
theorem ocaseval: $ ocase z S @ n = recn z (\ i, S @ fst i) n $ =
(named '(applame recneq3));
theorem ocase0: $ ocase z S @ 0 = z $ = (named '(eqtr ocaseval recn0));
theorem ocaseS: $ ocase z S @ suc n = S @ n $ =
'(eqtr ocaseval @ eqtr recnS @ eqtr3 (appeq2 @ preq2 ocaseval) @
  !! applame i @ appeq2d @ syl6eq fstpr fsteq);

@_ local def ocasep (z: wff) (S: set): set = $ {n | ifp (n = 0) z (n - 1 e. S)} $;
theorem ocasep0: $ 0 e. ocasep z S <-> z $ = (named '(elabe ifppos));
theorem ocasepS: $ suc n e. ocasep z S <-> n e. S $ =
(named '(elabe @ syl6bb (eleq1 sucsub1) @
  syl6bb (ifpneg peano1) @ ifpeqd eqeq1 biidd (eleq1d subeq1)));

@_ local def Tail (S: set): set = $ {n | suc n e. S} $;
theorem elTail: $ n e. Tail S <-> suc n e. S $ = '(elabe ,eqtac);
theorem Tail_ocasep: $ Tail (ocasep z S) == S $ = (named '(ax_gen @ bitr elTail ocasepS));
theorem ocasep_Tail: $ ocasep (0 e. S) (Tail S) == S $ =
(named '(ax_gen @ cases (mpbiri ocasep0 @ bieqd eleq1 eleq1) @
  sylbi exsuc @ eex @ mpbiri (bitr ocasepS elTail) @ bieqd eleq1 eleq1));

--| The "bind" operator for the option monad,
--| `obind : Option A -> (A -> Option B) -> Option B`.
--| * `obind none F = none`
--| * `obind (some a) F = F a`
@_ abstract def obind (a: nat) (F: set): nat = $ ocase 0 F @ a $;
pub theorem obind0 (F: set): $ obind 0 F = 0 $ = 'ocase0;
pub theorem obindS (n: nat) (F: set): $ obind (suc n) F = F @ n $ = 'ocaseS;

theorem obindS2: $ obind n (\ x, suc x) = n $ =
(named '(cases (mpbiri obind0 @ eqeqd obindeq1 id) @ sylbi exsuc @ eex @
  mpbiri (eqtr obindS @ applame suceq) (eqeqd obindeq1 id)));

theorem obindeqS: $ obind n F = suc a <-> E. m (n = suc m /\ F @ m = suc a) $ =
'(ibii
  (cases
    (syl5 sucne0 @ syl absurdr @ syl6eq obind0 obindeq1)
    (sylbi exsuc @ com12 @ eximd @ exp @
      iand anr @ eqtr3d (syl6eq obindS @ obindeq1d anr) anl))
  (eex @ eqtrd (anwl @ syl6eq obindS obindeq1) anr));

--| The power function on natural numbers.
--| * `a ^ 0 = 1`
--| * `a ^ suc b = a * a ^ b`
@(add-eval @ fn (a b) {(eval a) ^ (eval b)})
@_ abstract def pow (a b: nat): nat = $ rec 1 (\ n, a * n) b $;
infixr pow: $^$ prec 81;

pub theorem pow0: $ a ^ 0 = 1 $ = (named 'rec0);
pub theorem powS: $ a ^ suc b = a * a ^ b $ =
'(eqtr recS @ ! applame $ a ^ b $ _ n _ muleq2);
theorem powS2: $ a ^ suc b = a ^ b * a $ = '(eqtr powS mulcom);
theorem pow12: $ a ^ 1 = a $ = '(eqtr powS @ eqtr (muleq2 pow0) mul12);
theorem pow22: $ a ^ 2 = a * a $ = '(eqtr powS @ muleq2 pow12);

theorem pow11: $ 1 ^ b = 1 $ =
(named @ induct '(ind) 'b
  'pow0 '(syl5eq powS @ syl5eq mul11 id));

theorem powpos: $ 0 < a -> 0 < a ^ b $ =
(named @ induct '(indd) 'b
  '(a1i @ mpbir (lteq2 pow0) d0lt1)
  '(sylibr (lteq2 powS) @ bi2i mulpos));
theorem powne0: $ a != 0 -> a ^ b != 0 $ = '(sylbir lt01 @ sylib lt01 powpos);
theorem pow2ne0: $ 2 ^ b != 0 $ = '(powne0 d2ne0);

theorem powltid2: $ 1 < a -> b < a ^ b $ =
(named @ induct '(indd) 'b
  '(a1i @ mpbir (lteq2 pow0) d0lt1)
  '(lelttrd anr @ sylib (lteq mul11 @ eqcom powS) @
    mpbid (syl ltmul1 @ syl powpos @ anwl @ lttr d0lt1) anl));

theorem powadd: $ a ^ (b + c) = a ^ b * a ^ c $ =
(named @ induct '(ind) 'c
  '(eqtr4 (poweq2 add0) @ eqtr (muleq2 pow0) mul12)
  '(eqtr4g (poweq2 addS) (muleq2 powS2) @ syl5eq powS2 @ syl6eq mulass muleq1));

theorem powmul: $ a ^ (b * c) = (a ^ b) ^ c $ =
(named @ induct '(ind) 'c
  '(eqtr (poweq2 mul0) @ eqtr4 pow0 pow0)
  '(syl5eq (poweq2 mulS) @ syl5eq powadd @ syl6eqr powS2 muleq1));

theorem powdvd: $ b <= c -> a ^ b || a ^ c $ =
'(mpbii dvdmul1 @ dvdeq2d @ syl5eqr powadd @ poweq2d npcan);
theorem powdvd1: $ 0 < b -> a || a ^ b $ = '(sylib (dvdeq1 pow12) powdvd);
theorem lepow2a: $ a != 0 -> b <= c -> a ^ b <= a ^ c $ =
'(exp @ dvdle (anwl powne0) (anwr powdvd));
theorem ltpow2: $ 1 < a -> (b < c <-> a ^ b < a ^ c) $ =
'(ibida
  (mpbid (lteqd (a1i mul11) @ syl5eqr powadd @ poweq2d @ syl npcan @ anwr ltle) @
    mpbid (syl ltmul1 @ syl powpos @ anwl @ lttr d0lt1) @
    lelttrd (sylib subpos anr) @ anwl powltid2)
  (imp @ sylibr (imeqi ltnle ltnle) @ con3d @ syl lepow2a @ sylib lt01 @ lttr d0lt1));
theorem lepow2: $ 1 < a -> (b <= c <-> a ^ b <= a ^ c) $ =
'(syl5bb lenlt @ syl6bbr lenlt @ noteqd ltpow2);

--| Left shift for natural numbers: `shl a n = a * 2 ^ n`.
@(add-eval @ fn (a b) {(eval a) shl (eval b)})
@_ def shl (a n: nat): nat = $ a * 2 ^ n $;
--| Right shift for natural numbers: `shr a n = a // 2 ^ n`.
@(add-eval @ fn (a b) {(eval a) shr (eval b)})
@_ def shr (a n: nat): nat = $ a // 2 ^ n $;

theorem shl01: $ shl 0 b = 0 $ = 'mul01;
theorem shl02: $ shl a 0 = a $ = '(eqtr (muleq2 pow0) mul12);
theorem shl11: $ shl 1 b = 2 ^ b $ = 'mul11;
theorem shl12: $ shl a 1 = b0 a $ = '(eqtr (muleq2 pow12) b0mul22);
theorem shlshl: $ shl (shl a b) c = shl a (b + c) $ = '(eqtr4 mulass (muleq2 powadd));
theorem shladd: $ shl (a + b) c = shl a c + shl b c $ = 'addmul;
theorem shlpow2dvd: $ 2 ^ b || shl a b $ = 'dvdmul1;
theorem shl2dvd: $ 0 < b -> 2 || shl a b $ =
'(rsyl powdvd1 @ mpi shlpow2dvd dvdtr);

theorem shr01: $ shr 0 b = 0 $ = 'div01;
theorem shr02: $ shr a 0 = a $ = '(eqtr (diveq2 pow0) div12);
theorem shr12: $ shr a 1 = a // 2 $ = '(diveq2 pow12);
theorem shrshr: $ shr (shr a b) c = shr a (b + c) $ = '(eqtr4 divdiv (diveq2 powadd));
theorem shrmodadd1: $ shr (a % 2 ^ (b + c)) b = shr a b % 2 ^ c $ =
'(eqtr4 (shreq1 @ modeq2 powadd) divmod1);
theorem shrmodadd2: $ shr (a % 2 ^ (b + c)) c = shr a c % 2 ^ b $ =
'(eqtr (shreq1 @ modeq2 @ poweq2 addcom) shrmodadd1);
theorem shrmodsub: $ c <= b -> shr (a % 2 ^ b) c = shr a c % 2 ^ (b - c) $ =
'(syl6eq shrmodadd2 @ shreq1d @ modeq2d @ poweq2d @ eqcomd npcan);
theorem shrshladd: $ shr (shl a b + c) b = a + shr c b $ = '(muladddiv1 pow2ne0);
theorem shrshladdid: $ c < 2 ^ b -> shr (shl a b + c) b = a $ = '(exp muladddiv1lt pow2ne0);
theorem shrshlid: $ shr (shl a b) b = a $ = '(muldiv1 pow2ne0);
theorem shrshl1: $ c <= b -> shr (shl a b) c = shl a (b - c) $ =
'(syl6eq shrshlid @ shreq1d @ syl6eqr shlshl @ shleq2d @ eqcomd npcan);
theorem shrshl2: $ b <= c -> shr (shl a b) c = shr a (c - b) $ =
'(syl6eq (shreq1 shrshlid) @ syl6eqr shrshr @ shreq2d @ eqcomd pncan3);

theorem shreq0: $ shr a b = 0 <-> a < 2 ^ b $ = '(diveq0 pow2ne0);

--| Lift a natural number to a set, via `a ~> {x | odd (shr a x)}`.
--| That is, `x e. a` if the `x`'th bit of `a` is 1.
--| This mapping is injective, and surjective onto finite sets,
--| so we can view the sort `nat` as a subtype of `set`
--| consisting of the finite sets.
@_ def ns (a .x: nat): set = $ {x | odd (shr a x)} $; coercion ns: nat > set;

theorem elnel: $ a e. b <-> odd (shr b a) $ = '(elabe ,eqtac);
theorem elneqd (h1: $ G -> a = b $) (h2: $ G -> c = d $):
  $ G -> (a e. c <-> b e. d) $ = '(eleqd h1 @ nseqd h2);
theorem elneq2d (h: $ G -> b = c $): $ G -> (a e. b <-> a e. c) $ = '(elneqd eqidd h);
theorem elneq2: $ b = c -> (a e. b <-> a e. c) $ = '(elneq2d id);
theorem elneq: $ a = b -> c = d -> (a e. c <-> b e. d) $ = '(exp @ elneqd anl anr);
theorem appneq1d (h: $ G -> f = g $): $ G -> f @ x = g @ x $ = '(appeq1d @ nseqd h);
theorem appneq1: $ f = g -> f @ x = g @ x $ = '(appneq1d id);
theorem nfns (a: nat x) (h: $ FN/ x a $): $ FS/ x a $ = (named '(nfslem nseq h));

theorem el01: $ 0 e. a <-> odd a $ = '(bitr elnel @ oddeq shr02);

theorem elshr: $ a e. shr b c <-> a + c e. b $ =
'(bitr elnel @ bitr4 (oddeq @ eqtr shrshr @ shreq2 addcom) elnel);

theorem elshl: $ a e. shl b c <-> c <= a /\ a - c e. b $ =
'(bitr elnel @
  rbid (sylbi odddvd @ con1 @ sylbir ltnle @
    mpbird (dvdeq2d @ rsyl ltle shrshl1) (sylbi subpos shl2dvd)) anl @
  bitr4d (syl6bbr elnel @ oddeqd shrshl2) bian1);

theorem elmodpow2: $ x e. a % 2 ^ n <-> x < n /\ x e. a $ =
'(bitr elnel @ bitr3
  (bian1a @ ax_3 @ sylbir lenlt @ mpbiri odd0 @ noteqd @ oddeqd @
    sylibr shreq0 @ syl (ltletr @ modlt pow2ne0) @ lepow2a d2ne0)
  (aneq2a @ syl6bbr elnel @ bitr4g odddvd odddvd @ noteqd @
    syl eqmdvd @ mpbird (eqmeq2d @ syl shrmodsub ltle) @
    dvdeqm (sylbi subpos powdvd1) @ a1i eqmmod));

theorem shrss: $ a C_ b -> shr a n C_ shr b n $ =
'(!! iald x @ syl5bi elshr @ syl6ibr elshr ssel);
theorem shlss: $ a C_ b <-> shl a n C_ shl b n $ =
'(ibii (!! iald x @ syl5bi elshl @ syl6ibr elshl @ anim2d ssel) @
  sylib (sseq (nseq shrshlid) (nseq shrshlid)) shrss);

theorem eldiv2: $ a e. b // 2 <-> suc a e. b $ =
'(bitr3 (elneq2 shr12) @ bitr elshr @ eleq1 add12);
theorem elb0: $ a e. b0 b <-> 0 < a /\ a - 1 e. b $ = '(bitr3 (elneq2 shl12) elshl);
theorem elb1: $ a e. b1 b <-> a = 0 \/ a - 1 e. b $ =
'(cases (bithd (mpbiri (mpbir el01 b1odd) eleq1) orl) @
  bicomd @ bitrd bior1 @ syl5bb (bitr3 (elneq2 b1div2) eldiv2) @ eleq1d sub1can);

theorem elb00: $ ~0 e. b0 b $ = '(mt (sylbi elb0 anl) ltirr);
theorem elb10: $ 0 e. b1 b $ = '(mpbir elb1 @ orl eqid);
theorem elb0S: $ suc a e. b0 b <-> a e. b $ = '(bitr elb0 @ bitr (bian1 lt01S) (eleq1 sucsub1));
theorem elb1S: $ suc a e. b1 b <-> a e. b $ = '(bitr elb1 @ bitr (bior1 peano1) (eleq1 sucsub1));

theorem bndextle:
  $ A. x (x < n -> x e. a -> x e. b) -> a % 2 ^ n <= b % 2 ^ n $ =
(named @ induct '(ind) 'n
  '(a1i @ mpbir (leeq1 @ eqtr (modeq2 pow0) mod12) le01)
  '(rsyl (imim1i @ alimi @ imim1i @ mpi ltsucid lttr) @
    a2i @ rsyl (mpi ltsucid @ eale @ imeqd lteq1 (imeqd eleq1 eleq1)) @ exp @
    sylib (leeq divmod divmod) @
    sylibr (leeq
      (addeq (muleq2 @ eqtr4 (diveq1 @ modeq2 powS2) divmod1) (modmod @ powdvd lesucid))
      (addeq (muleq2 @ eqtr4 (diveq1 @ modeq2 powS2) divmod1) (modmod @ powdvd lesucid))) @
    leaddd (syl lemul2a @ sylibr (letrueb boolmod2) @
      syl5bir dfodd2 @ syl6ib dfodd2 @
      syl5bir elnel @ syl6ib elnel anl) anr));

theorem bndext: $ A. x (x < n -> (x e. a <-> x e. b)) -> mod(2 ^ n): a = b $ =
'(leasymd (syl bndextle @ alimi @ imim2i bi1) (syl bndextle @ alimi @ imim2i bi2));

theorem ssle: $ a C_ b -> a <= b $ =
'(sylib (leeq
    (modlteq @ lelttr lemax1 @ powltid2 d1lt2)
    (modlteq @ lelttr lemax2 @ powltid2 d1lt2)) @
  syl bndextle @ !! alimi x ax_1);

pub theorem axext: $ a == b -> a = b $ =
'(leasymd (syl ssle eqss) (syl ssle eqssr));
theorem nsinj: $ a == b <-> a = b $ = '(ibii axext nseq);

pub theorem ellt: $ a e. b -> a < b $ =
'(sylbi elnel @ sylbi dfodd2 @ con1 @ sylbir lenlt @
  syl6eq mod01 @ modeq1d @ sylibr (diveq0 pow2ne0) @
  mpi (powltid2 d1lt2) lelttr);

theorem el02: $ ~a e. 0 $ = '(mt ellt lt02);
pub theorem nel0: $ ~a e. 0 $ = 'el02;

theorem ss01: $ 0 C_ A $ = '(!! ax_gen x @ absurd el02);
theorem ss02: $ A C_ 0 <-> A == 0 $ = '(ibii (mpi ss01 ssasym) (mpbiri ss01 sseq1));
theorem eq0al: $ A == 0 <-> A. x ~ x e. A $ =
'(aleqi @ bitr (bieq2 @ mpbir eqfal el02) eqfal);
theorem sseq0: $ A C_ B -> B == 0 -> A == 0 $ = '(syl6ib ss02 @ com12 @ bi1d sseq2);
theorem in01: $ 0 i^i A == 0 $ = '(mpbi eqin1 ss01);
theorem in02: $ A i^i 0 == 0 $ = '(mpbi eqin2 ss01);
theorem inidm: $ A i^i A == A $ = '(mpbi eqin2 ssid);
theorem un01: $ 0 u. A == A $ = '(mpbi equn1 ss01);
theorem un02: $ A u. 0 == A $ = '(mpbi equn2 ss01);
theorem unidm: $ A u. A == A $ = '(mpbi equn2 ssid);
theorem uneq0: $ A u. B == 0 <-> A == 0 /\ B == 0 $ =
'(bitr3 ss02 @ bitr unss @ aneq ss02 ss02);
theorem cplv: $ Compl _V == 0 $ = '(!! eqri x @ binth (con2 (bi1 elcpl) elv) el02);
theorem cpl0: $ Compl 0 == _V $ = '(eqstr3 (cpleq cplv) cplcpl);
theorem incpl2: $ A i^i Compl A == 0 $ = '(mpbir cplinj @ eqstr cplin @ eqstr4 uncpl2 cpl0);
theorem incpl1: $ Compl A i^i A == 0 $ = '(eqstr incom incpl2);
theorem incpleq0: $ A i^i Compl B == 0 <-> A C_ B $ =
'(!! aleqi x @ bitr (bibin2 el02) @ bitr4 (noteq @ bitr elin @ aneq2i elcpl) iman);
theorem ineq0: $ A i^i B == 0 <-> A C_ Compl B $ = '(bitr3 (eqseq1 @ ineq2 cplcpl) incpleq0);
theorem ineq0r: $ A i^i B == 0 <-> B C_ Compl A $ = '(bitr (eqseq1 incom) ineq0);
theorem sscpl2: $ A C_ Compl B <-> B C_ Compl A $ = '(bitr3 ineq0 ineq0r);
theorem inincpl: $ A i^i (B i^i Compl A) == 0 $ = '(sseq0 (ssin2 inss2) incpl2);
theorem unincpl: $ A u. (B i^i Compl A) == A u. B $ =
'(eqstr undi @ mpbi eqin1 @ mpbir (sseq2 uncpl2) ssv2);
theorem xp01: $ Xp 0 A == 0 $ = '(mpbir eq0al @ !! ax_gen x @ mt xpfst el02);
theorem xp02: $ Xp A 0 == 0 $ = '(mpbir eq0al @ !! ax_gen x @ mt xpsnd el02);
theorem dmeq0: $ Dom A == 0 <-> A == 0 $ = '(bitr3 ss02 @ bitr ssdm @ bitr (sseq2 xp01) ss02);
theorem rneq0: $ Ran A == 0 <-> A == 0 $ = '(bitr3 ss02 @ bitr ssrn @ bitr (sseq2 xp02) ss02);
theorem dm0: $ Dom 0 == 0 $ = '(mpbir dmeq0 eqsid);
theorem rn0: $ Ran 0 == 0 $ = '(mpbir rneq0 eqsid);
theorem isf0: $ isfun 0 $ = '(!! ax_gen x @ !! ax_gen y @ !! ax_gen z @ absurd el02);
theorem app01: $ 0 @ a = 0 $ = '(ndmapp @ mtbir (eleq2 dm0) el02);

theorem disjne (h1: $ G -> A i^i B == 0 $)
  (h2: $ G -> x e. A $) (h3: $ G -> y e. B $):
  $ G -> x != y $ =
'(mpi el02 @ con3d @ exp @ mpbid (eleq2d @ anwl h1) @
  sylibr elin @ iand (mpbid (eleq1d anr) (anwl h2)) @ anwl h3);

theorem unisf: $ Dom A i^i Dom B == 0 -> (isfun (A u. B) <-> isfun A /\ isfun B) $ =
(named @ focus
  (have 'h '(syl5bir elin @ syl6 (absurd el02) @ bi1d eleq2))
  (def (A x)  '(isfd (anwll ,x) anlr anr))
  (def (B x y) '(mpd (iand (syl preldm ,x) (syl preldm ,y)) (anw3l h)))
  (def (f x y) '(syl5bi elun @ eorda ,x ,y))
  '(ibid (a1i @ iand (isfss ssun1) (isfss ssun2)) @ exp @ iald @ iald @ iald @
    syl5bi elun @ eorda ,(f (A 'anrl) (B 'anlr 'anr)) ,(f (B 'anr 'anlr) (A 'anrr))));

theorem reseq0: $ Dom F i^i A == 0 <-> F |` A == 0 $ =
'(bitr4 ineq0 @ bitr4 ineq0 @ bitr4 ssdm @ sseq2 cplxpv2);

theorem dmdisj1: $ Dom A i^i Dom B == 0 -> A i^i B == 0 $ =
'(sylbir ss02 @ sylib ss02 @ !! ssrd2 x y @ syl5bi elin @
  syl5 (anim preldm preldm) @ syl5bir elin @ syl6 (absurd el02) ssel);

theorem dmdisj: $ isfun (A u. B) -> (Dom A i^i Dom B == 0 <-> A i^i B == 0) $ =
(named '(ibid (a1i dmdisj1) @ exp @
  sylib ss02 @ iald @ syl5bi elin @ syl5bi (aneq eldm eldm) @
  impd @ eexda @ eexda @ syl (absurd el02) @ mpbid (eleq2d anllr) @
  sylibr elin @ iand anlr @
  mpbird (eleq1d @ preq2d @ isfd an3l (rsyl anlr elun1) (rsyl anr elun2)) anr));

theorem appleid1: $ f @ x <= f $ =
(named @ focus
  '(cases (eex @ mpbird (leeq1d theid) _) @ mpbiri le01 @ leeq1d the0)
  '(rsyl (mpbiri (mpbir (elabe eqeq1) eqid) eleq2) @
    sylbi (elabe @ eleq1d preq2) @ rsyl ellt @ rsyl ltle @ letr leprid2));

theorem elobind: $ x e. obind n F <-> E. y (n = suc y /\ x e. F @ y) $ =
(named '(cases
  (mpbiri (binth nel0 @ nexi @ mt (anwl eqcom) peano1) @
    bieqd (elneq2d @ syl6eq obind0 obindeq1) @ exeqd @ aneq1d eqeq1)
  (sylbi exsuc @ eex @ mpbiri (bicom @ exeqe @ elneq2d appeq2) @
    bieqd (elneq2d @ syl6eq obindS obindeq1) @
    exeqd @ aneq1d @ syl6bb eqcomb @ syl6bb peano2 eqeq1)));

theorem el12: $ a e. 1 <-> a = 0 $ =
'(ibii (sylib lt12 ellt) (mpbiri (mpbir el01 odd1) eleq1));

theorem elpow2: $ a e. 2 ^ n <-> a = n $ =
'(bitr3 (elneq2 shl11) @ bitr elshl @
  bitr4 (aneq2i @ bitr4 el12 lesubeq0) @ bitr eqcomb eqlele);

theorem finns (a: nat): $ finite a $ =
'(finss (mpbi ssab2 @ !! ax_gen x ellt) ltfin);

--| Convert a finite set to a natural number with the same elements.
--| We use this when we wish to construct a natural number
--| from a set expression. It returns a garbage value 0 if the set is not finite.
--| This is the inverse to the `ns` coercion.
@_ def lower (A: set): nat = $ the {n | n == A} $;
theorem nflower (A: set x) (h: $ FS/ x A $): $ FN/ x lower A $ =
(named '(nfthe @ nfab @ nfeqs nfsv h));

pub theorem eqlower: $ finite A <-> A == lower A $ =
(focus
  (have 'h1 $ E. n A. x (x e. n <-> x + z e. A) -> E. n A == n $
    @ induct '(!! ind y z) 'z
    '(eximi @ alimi @ bicomd @ syl6bb (eleq1 add0) id)
    '(imim1i @ sylib (!! cbvex m _ @ !! cbvald y _ @
        bieqd (elneqd anr anl) (eleq1d @ anwr addeq1)) @
      eex @ iexde @ iald @ impcom @ casesda
        (a1d @ mpbiri (bitr el01 @ ibii
            (ax_3 @ mtbird (oddeqd ifneg) (a1i b0odd))
            (mpbiri b1odd @ oddeqd ifpos)) @
          bieqd (elneqd anr anl) (eleq1d @ syl6eq add01 @ anwr addeq1))
        (ealde @ bi1d @ bieqd
          (mpbiri
            (bitr3 (elneq2 @ cases
              (syl6eq b1div2 @ diveq1d ifpos)
              (syl6eq b0div2 @ diveq1d ifneg)) eldiv2)
            (bieqd (eleq1d anr) @ elneqd (eqcomd @ syl sub1can anlr) anll))
          (eleq1d @ syl5eqr addSass @ addeq1d @
            eqtrd (suceqd anr) (syl sub1can anlr)))))
  (have 'h2 $ finite A -> E. n A == n $
    '(!! eex z @ syl h1 @ iexde @ iald @
      bitrd (elneq2d anr) @ binthd (a1i el02) @
      mtd (a1i @ mpbi lenlt leaddid2) (anwl @ !! eale y @ imeqd eleq1 lteq1)))
  '(ibii (rsyl h2 @ eex @ eqstrd id @ nseqd @ eqcomd @
      !! eqtheabd x @ syl6bb nsinj eqseq2) (mpbiri finns fineq)));

theorem ellower: $ finite A -> (a e. lower A <-> a e. A) $ = '(bicomd @ eleq2d @ bi1 eqlower);

theorem lowerns: $ lower a = a $ = '(eqcom @ axext @ mpbi eqlower finns);

theorem eqlower1: $ finite A -> (A == a <-> lower A = a) $ =
'(ibida (anwr @ syl6eq lowerns lowereq) @ eqstrd (sylib eqlower anl) @ nseqd anr);
theorem eqlower2: $ finite A -> (a == A <-> a = lower A) $ =
'(bitr4g eqscomb eqcomb eqlower1);
theorem lowerinj: $ finite A -> finite B -> (A == B <-> lower A = lower B) $ =
'(exp @ bitrd (eqseq1d @ sylib eqlower anl) (anwr eqlower2));

--| A singleton set `{a}`, as a `nat` because it is always finite.
@_ abstract def sn (a: nat): nat = $ 2 ^ a $;
pub theorem elsn (a b: nat): $ a e. sn b <-> a = b $ = 'elpow2;
theorem snid: $ a e. sn a $ = '(mpbir elsn eqid);

theorem snss: $ sn a C_ A <-> a e. A $ =
'(bitr (!! aleqi x @ imeq1i elsn) @ aleqe eleq1);

theorem sndisj: $ sn a i^i A == 0 <-> ~a e. A $ = '(bitr ineq0 @ bitr snss elcpl);

theorem subsnsn: $ subsn (sn a) $ =
(named '(mpbir (subsneq @ eqab2i elsn) subsnsn2));

theorem thesn: $ the (sn a) = a $ = (named '(trud @ eqthed @ a1i elsn));

theorem sninj: $ sn a = sn b <-> a = b $ =
'(ibii (eqtr3g thesn thesn @ theeqd nseq) sneq);

theorem subsnsssn: $ subsn A <-> E. a A C_ sn a $ =
(named '(bitr4 subsnex @ exeqi @ aleqi @ imeq2i elsn));

theorem isfsn: $ isfun (sn x) $ =
(named '(ax_gen @ ax_gen @ ax_gen @
  sylbi elsn @ syl5bi elsn @ syl6 (sylbi prth anr) eqtr4));

theorem dmsn: $ Dom (sn (x, y)) == sn x $ =
(named '(ax_gen @ bitr eldm @
  bitr4 (exeqi @ bitr elsn @ bitr prth ancomb) @ bitr4 elsn @ exeqe biidd));
theorem rnsn: $ Ran (sn (x, y)) == sn y $ =
(named '(ax_gen @ bitr elrn @
  bitr4 (exeqi @ bitr elsn prth) @ bitr4 elsn @ exeqe biidd));

--| `ins a b` or `a ; b` is the set `{a} u. b`, the set containing `a`
--| and the elements of `b`. It is finite because `b` is.
@_ abstract def ins (a b: nat): nat = $ lower {x | x = a \/ x e. b} $;
infixr ins: $;$ prec 85;
pub theorem elins (a b c: nat): $ a e. b ; c <-> a = b \/ a e. c $ =
'(bitr (ellower @ finss (mpbi ssab @
    ax_gen @ eor (mpbiri lemax1 leeq1) @
    rsyl ellt @ letrd ltle @ a1i lemax2) lefin) @
  !! elabe x @ oreqd eqeq1 eleq1);

theorem inscom: $ a ; b ; c = b ; a ; c $ =
'(axext @ !! ax_gen x @ bitr4gi elins elins @
  bitr4gi (oreq2 elins) (oreq2 elins) or12);

theorem b0ins: $ b0 (a ; b) = suc a ; b0 b $ =
'(axext @ !! ax_gen x @ bitr4gi elb0 (bitr elins @ oreq2 elb0) @
  rbid anl (eor (mpbiri lt01S lteq2) anl) @
  bitrd bian1 @ syl5bb elins @ oreqd
    (syl5bbr peano2 @ eqeq1d (sylbi lt01 sub1can)) (bicomd bian1));

theorem b1ins: $ b1 n = 0 ; b0 n $ =
'(axext @ !! ax_gen x @ bitr4gi elb1 (bitr elins @ oreq2 elb0) @
  cases (bithd orl orl) @ oreq2d @ bicomd @ sylbir lt01 bian1);

theorem insdiv2: $ (suc a ; b) // 2 = a ; (b // 2) $ =
'(eor (syl6eq b0div2 @ diveq1d @ syl6eqr b0ins inseq2)
  (syl6eq b1div2 @ diveq1d @ syl6eqr b1ins @
    syl6eqr (inseq2 b0ins) @ syl6eq inscom @ inseq2d @ syl6eq b1ins id)
  b0orb1);

theorem insunsn: $ a ; b == sn a u. b $ =
'(!! eqri x @ bitr4gi elins elun @ oreq1 @ bicom @ elsn);

theorem ins02: $ a ; 0 = sn a $ = '(axext @ eqstr insunsn un02);

theorem insss: $ a ; b C_ A <-> a e. A /\ b C_ A $ =
'(bitr (sseq1 insunsn) @ bitr unss @ aneq1i snss);

theorem ssins: $ A C_ a ; b -> a e. A \/ A C_ b $ =
'(com12 @ bi1d @ !! aleqd x @ syl imeq2a @ exp @ syl5bb elins @
  syl bior1 @ impcom @ con3d @ com12 @ bi1d eleq1);

--| `upto n = {x | x < n}` is the set of numbers less than `n`.
@(add-eval @ fn (n) {{1 shl (eval n)} - 1})
@_ def upto (n: nat): nat = $ 2 ^ n - 1 $;

theorem upto0: $ upto 0 = 0 $ = '(eqtr (subeq1 pow0) subid);
theorem uptoadd1: $ upto n + 1 = 2 ^ n $ = '(npcan @ powpos d0lt2);
theorem sucupto: $ suc (upto n) = 2 ^ n $ = '(eqtr3 add12 uptoadd1);
theorem uptoS: $ upto (suc n) = b1 (upto n) $ =
'(mpbi addcan1 @ eqtr uptoadd1 @ eqtr powS @ eqtr3 (muleq2 sucupto) @
  eqtr mulS @ eqtr4 (addeq1 b0mul21) addSass);

theorem uptolem: $ shr (upto n) a = upto (n - a) /\ upto n % 2 ^ a = upto (min n a) $ =
'(trud @ eqdivmod
  (ltletrd
    (a1i @ subltid @ ian (powpos d0lt2) d0lt1)
    (a1i @ lepow2a d2ne0 minle2))
  (a1i @ mpbi addcan1 @ eqtr addass @ eqtr4 (addeq2 uptoadd1) @ eqtr4 uptoadd1 @
    eqtr3 (addeq (cases
      (muleq1d @ poweq2d eqmin2)
      (syl (eqtr4d (syl6eq mul0 muleq2) (syl6eq mul0 muleq2)) @
        syl6eq upto0 @ uptoeqd nlesubeq0)) mul12) @
    eqtr3 muladd @ eqtr (muleq2 uptoadd1) @ eqtr3 powadd @ poweq2 minaddsub));

theorem shrupto: $ shr (upto n) a = upto (n - a) $ = '(anl uptolem);

theorem shlupto: $ shl (upto n) a + upto a = upto (n + a) $ =
'(mpbi peano2 @ eqtr3 addS2 @ eqtr4 (addeq2 sucupto) @ eqtr4 sucupto @
  eqtr3 mulS1 @ eqtr4 (muleq1 sucupto) powadd);

pub theorem elupto (k n: nat): $ k e. upto n <-> k < n $ =
'(bitr elnel @ bitr (oddeq shrupto) @
  bitr4 (ibii
    (mtd (a1i odd0) @ com12 @ bi1d @ oddeqd @ syl6eq upto0 uptoeq)
    (mpbii b1odd @ oddeqd @ syl5eqr uptoS @ uptoeqd sub1can)) @
  bitr subpos lt01);

theorem uptoss: $ upto a C_ upto b <-> a <= b $ =
'(ibii
  (mpi ltirr @ con1d (syl5bir ltnle @ sylib (imeqi elupto elupto) ssel))
  (!! iald x @ sylibr (imeqi elupto elupto) @ com12 ltletr));

theorem uptoS_ins: $ upto (suc a) = a ; upto a $ =
'(axext @ !! ax_gen x @ bitr4 elupto @ bitr4 elins @ bitr3 leltsuc @
  bitr4 leloe @ bitr orcomb @ oreq1 elupto);

theorem upto1_sn: $ upto 1 = sn 0 $ = '(eqtr uptoS_ins @ eqtr (inseq2 upto0) ins02);

theorem leupto: $ a <= b <-> upto a <= upto b $ =
'(bitr4 (lepow2 d1lt2) @ bitr leadd1 @ leeq uptoadd1 uptoadd1);

theorem dffin2: $ finite A <-> E. n A C_ upto n $ =
'(exeqi @ !! aleqi x @ imeq2i @ bicom elupto);

@_ local def size (A: set): nat = $ least {k | A C_ upto k} $;

theorem sssize: $ finite A <-> A C_ upto (size A) $ =
'(bitr dffin2 @ ! ibii _ $ A C_ upto (size A) $
  (!! eex n @ sylbir (elabe @ sseq2d @ nseqd uptoeq) @
    sylib (!! elabe k @ sseq2d @ nseqd uptoeq) leastel)
  (iexe @ sseq2d @ nseqd uptoeq));
theorem sizess1: $ A C_ upto k -> size A <= k $ =
'(sylbir (!! elabe x @ sseq2d @ nseqd uptoeq) leastle);
theorem sizess: $ finite A -> (A C_ upto k <-> size A <= k) $ =
'(ibid (a1i sizess1) @ syl5bir uptoss (sylbi sssize sstr));
theorem sizeupto: $ size (upto n) = n $ =
'(leasym (mpbi (sizess finns) ssid) (mpbi uptoss @ mpbi sssize finns));

--| `Bool = {x | bool x}` is the set of boolean values (0 and 1).
def Bool: nat = $ 0 ; sn 1 $;

theorem elBool: $ n e. Bool <-> bool n $ =
'(bitr elins @ bitr4 (oreq2i elsn) bool01);
theorem Bool0: $ 0 e. Bool $ = '(mpbir elBool bool0);
theorem Bool1: $ 1 e. Bool $ = '(mpbir elBool bool1);
theorem Bool0d: $ G -> 0 e. Bool $ = '(a1i Bool0);
theorem Bool1d: $ G -> 1 e. Bool $ = '(a1i Bool1);
theorem boolfin: $ finite Bool $ = '(mpbir (fineq @ !! eqab2i n elBool) ltfin);

--| `Option A` is the set `A` disjointly extended with an additional element.
--| We use `0` and `suc` in place of the `none` and `some` constructors.
@_ def Option (A: set): set = $ {n | n = 0 \/ n - 1 e. A} $;

theorem elopt: $ a e. Option A <-> a = 0 \/ a - 1 e. A $ =
'(!! elabe n @ oreqd eqeq1 (eleq1d subeq1));

theorem opt0: $ 0 e. Option A $ = '(mpbir elopt (orl eqid));
theorem optS: $ suc a e. Option A <-> a e. A $ =
'(bitr elopt @ bitr (bior1 peano1) @ eleq1 sucsub1);
theorem opt0d: $ G -> 0 e. Option A $ = '(a1i opt0);
theorem optSd (h: $ G -> a e. A $): $ G -> suc a e. Option A $ = '(sylibr optS h);

theorem optss: $ Option A C_ Option B <-> A C_ B $ =
(named '(ibii (iald @ sylib (imeqi optS optS) ssel)
    (iald @ sylibr (imeqi elopt elopt) @ orim2d ssel)));

theorem optfin: $ finite A -> finite (Option A) $ =
'(!! eex n @ !! iexde m @ !! iald x @ casesda
  (a1d @ imp @ syl5ibrcom lteq1 @ anwr @ mpbiri lt01S lteq2)
  (mpbird (imeqd (eleq1d (eqcomd @ anwr sub1can)) (lteqd (eqcomd @ anwr sub1can) anlr)) @
    sylib (imeqi (bicom optS) ltsuc) @ anwll @ !! eale y @ imeqd eleq1 lteq1));

theorem optns: $ Option n == b1 n $ = '(!! ax_gen x @ bitr4 elopt elb1);
theorem optupto: $ Option (upto n) == upto (suc n) $ = '(eqstr4 optns @ nseq uptoS);

--| `Power A` is the set of all (finite) subsets of `A`.
@_ def Power (A: set): set = $ {x | x C_ A} $;

theorem elPower: $ a e. Power A <-> a C_ A $ = '(!! elabe x @ sseq1d nseq);

theorem powerfin: $ finite A -> finite (Power A) $ =
'(sylbi dffin2 @ !! eex n @ syl (!! iexe x @ aleqd @ imeq2d lteq2) @
  !! iald a @ syl5bi elPower @ com12 @ syl6 (sylib leltsuc ssle) sstr);

--| `power a` is the finite set of all subsets of the finite set `a`.
@_ def power (a: nat): nat = $ lower (Power a) $;

theorem elpower (a b: nat): $ a e. power b <-> a C_ b $ =
'(bitr (ellower @ powerfin finns) elPower);

theorem powerupto (a: nat): $ power (upto a) = upto (2 ^ a) $ =
'(axext @ !! ax_gen x @ bitr4 elpower @ bitr4 elupto @ ibii
  (sylib (lteq2 sucupto) @ sylib leltsuc ssle)
  (sylbir shreq0 @ !! iald y @ exp @ sylibr elupto @ mpi el02 @ con1d @ exp @
    mpbid (elneq2d anll) @ sylibr elshr @ mpbird(eleq1d @ syl npcan @ sylibr lenlt anr) anlr));

--| `sUnion A` is the set union: the union of all the elements of `A`.
@(derive-eq 'uni) def sUnion (A: set): set = $ {x | E. y (x e. y /\ y e. A)} $;

theorem eluni: $ a e. sUnion A <-> E. x (a e. x /\ x e. A) $ =
'(!! elabe y @ exeqd @ aneq1d eleq1);
theorem elunii: $ a e. A -> b e. a -> b e. sUnion A $ =
(named '(expcom @ sylibr eluni @ iexe @ aneqd elneq2 eleq1));
theorem elssuni: $ a e. A -> a C_ sUnion A $ = (named '(iald elunii));

theorem finuni: $ finite A -> finite (sUnion A) $ =
(named '(eximi @ iald @ syl5bi eluni @ sylibr eexb @ alimi @
  syl5 ancom @ sylibr impexp @ imim2i @ com12 @ syl lttr ellt));

theorem xabfin (B: set x) (h: $ G -> finite A $) (h2: $ G /\ x e. A -> finite B $):
  $ G -> finite (X\ x e. A, B) $ =
(named '(sylc finss
  (mpbird (sseqd
      (syl5eqs cbvxabs @ xabeq2da @ sylib eqlower @
        sbethh (nfim nfv @ nffin nfsbs1) h2 (imeqd (aneq2d eleq1) (fineqd sbsq)))
      (a1i @ eqscom xabconst)) @
    xabssd @ syl elssuni @ anwr @ elimai @ mpbir ellam @
    iexe (eqeq2d @ preqd id @ lowereqd @ sbseq1d id) eqid)
  (sylc xpfin h @ syl finuni @ syl finlamima h)));

theorem sabfin {x y} (B: set x) (h: $ G -> y e. B -> x e. A $)
  (hA: $ G -> finite A $) (hB: $ G /\ x e. A -> finite B $): $ G -> finite (S\ x, B) $ =
'(mpbird (fineqd @ sabxab h) (xabfin hA hB));

--| `cons a b`, or `a : b`, is the list cons operator:
--| `cons : A -> List A -> List A`
@_ def cons (a b: nat): nat = $ suc (a, b) $; infixr cons: $:$ prec 91;

theorem consne0: $ a : b != 0 $ = 'peano1;
theorem ltconsid1: $ a < a : b $ = '(mpbi leltsuc leprid1);
theorem ltconsid2: $ b < a : b $ = '(mpbi leltsuc leprid2);
theorem consfstsnd: $ a != 0 -> fst (a - 1) : snd (a - 1) = a $ =
'(syl5eq (suceq fstsnd) sub1can);
theorem excons: $ a != 0 <-> E. x E. y a = x : y $ =
'(ibii
  (rsyl consfstsnd @ iexde @ iexde @ eqtr3d anll @ eqcomd @ conseqd anlr anr)
  (eex @ eex @ mpbiri consne0 neeq1));

theorem consinj: $ a : c = b : d <-> a = b /\ c = d $ = '(bitr peano2 prth);
theorem conscan1: $ a : c = b : c <-> a = b $ = '(bitr consinj @ bian2 eqid);
theorem conscan2: $ a : b = a : c <-> b = c $ = '(bitr consinj @ bian1 eqid);
theorem consfst: $ fst ((a : b) - 1) = a $ = '(eqtr (fsteq sucsub1) fstpr);
theorem conssnd: $ snd ((a : b) - 1) = b $ = '(eqtr (sndeq sucsub1) sndpr);

theorem lecons1: $ a <= b <-> a : c <= b : c $ = '(bitr lepr1 lesuc);
theorem lecons2: $ b <= c <-> a : b <= a : c $ = '(bitr lepr2 lesuc);
theorem ltcons1: $ a < b <-> a : c < b : c $ = '(bitr ltpr1 ltsuc);
theorem ltcons2: $ b < c <-> a : b < a : c $ = '(bitr ltpr2 ltsuc);

--| `sep n {x | p(x)}` is `{x e. n | p(x)}`,
--| the set of elements of `n` such that `p(x)`. Because it is a subset of an
--| existing finite set `n`, it is also finite.
--| This is analogous to the separation axiom of ZFC.
@_ abstract def sep (n: nat) (A: set): nat = $ lower (n i^i A) $;
pub theorem elsep (n: nat) (A: set) (a: nat):
  $ a e. sep n A <-> a e. n /\ a e. A $ =
'(bitr (ellower @ finss inss1 finns) elin);

@_ local def func (F A B: set): wff = $ isfun F /\ Dom F == A /\ Ran F C_ B $;

theorem nffunc (F A B: set x)
  (hF: $ FS/ x F $) (hA: $ FS/ x A $) (hB: $ FS/ x B $): $ F/ x func F A B $ =
'(nfan (nfan (nfisf hF) @ nfeqs (nfdm hF) hA) @ nfss (nfrn hF) hB);
theorem funcisf: $ func F A B -> isfun F $ = 'anll;
theorem funcdm: $ func F A B -> Dom F == A $ = 'anlr;
theorem funcrn: $ func F A B -> Ran F C_ B $ = 'anr;
theorem funcss3: $ B C_ C -> func F A B -> func F A C $ = '(anim2d @ com12 sstr);

theorem funcal: $ func F A B <-> isfun F /\ Dom F == A /\ A. x (x e. A -> F @ x e. B) $ =
'(aneq2a @ bitrd (anwl isfrnss) @ aleqd @ imeq1d @ eleq2d anr);

theorem funcres: $ func F A B /\ C C_ A -> func (F |` C) C B $ =
'(iand (iand (syl resisf @ anwl funcisf) @
    syl5eqs dmres @ sylib eqin2 @ imp @ bi2d @ sseq2d funcdm) @
  syl (sstr @ rnss resss) @ anwl funcrn);

theorem funcssxp: $ func F A B -> F C_ Xp A B $ =
(named '(ialda @ sylibr elxp @
  iand (mpbid (eleq2d anllr) @ anwr fsteldm) (sseld anlr @ anwr sndelrn)));

theorem funcfin: $ func F A B -> finite A -> finite B -> finite F $ =
'(syl5 xpfin @ imim2d @ rsyl funcssxp finss);

theorem funcT: $ func F A B /\ x e. A -> F @ x e. B $ =
'(sseld (anwl funcrn) @ sylc appelrn (anwl funcisf) @ imp @ bi2d @ eleq2d funcdm);

theorem eqfunc: $ func F A B /\ func G A C ->
  (F == G <-> A. x (x e. A -> F @ x = G @ x)) $ =
'(bitrd (rsyl (anim funcisf funcisf) eqisf) @
  bitrd (syl bian1 @ eqstr4d (anwl funcdm) (anwr funcdm)) @
  aleqd @ imeq1d @ eleq2d @ anwl funcdm);

theorem funceq0: $ func F A B -> (F == 0 <-> A == 0) $ =
'(syl5bbr dmeq0 @ eqseq1d funcdm);

theorem func02: $ func F 0 B <-> F == 0 $ =
'(bitr (aneq1i @ bitr (aneq2i dmeq0) @ bian1a @ mpbiri isf0 isfeq) @
  bian2a @ mpbiri ss01 @ sylbir rneq0 sseq1);
theorem func03: $ func F A 0 <-> F == 0 /\ A == 0 $ =
'(bitr3 (bian1a @ sylib rneq0 @ sylib ss02 funcrn) @
  aneq2a @ syl6bb (bitr (bian2 @ eqss rn0) @
    bitr (bian1 isf0) @ bitr (eqseq1 dm0) eqscomb) funceq1);

theorem unfunc (h0: $ G -> A1 i^i A2 == 0 $)
  (h1: $ G -> func F1 A1 B $) (h2: $ G -> func F2 A2 B $):
  $ G -> func (F1 u. F2) (A1 u. A2) B $ =
(focus (def (f t x) '(,t (syl ,x h1) (syl ,x h2)))
  '(iand (iand (mpbird _ ,(f 'iand 'funcisf)) _) _)
  '(syl unisf @ eqstrd ,(f 'ineqd 'funcdm) h0)
  '(syl5eqs dmun ,(f 'uneqd 'funcdm))
  '(sylibr (sseq1 rnun) @ sylibr unss ,(f 'iand 'funcrn)));

theorem funcappb: $ func F A B -> (a, b e. F <-> a e. A /\ F @ a = b) $ =
'(bitrd (syl isfappb funcisf) @ aneq1d @ eleq2d funcdm);

--| `Arrow A B` (which has no notation but is denoted `A -> B` in comments)
--| is the set of all (finite) functions from `A` to `B`.
@_ def Arrow (A B: set) (.f: nat): set =
$ {f | isfun f /\ Dom f == A /\ Ran f C_ B} $;

theorem elArrow: $ f e. Arrow A B <-> func f A B $ = '(elabe ,eqtac);
theorem Arrowisf: $ f e. Arrow A B -> isfun f $ = '(sylbi elArrow funcisf);
theorem Arrowdm: $ f e. Arrow A B -> Dom f == A $ = '(sylbi elArrow funcdm);
theorem Arrowrn: $ f e. Arrow A B -> Ran f C_ B $ = '(sylbi elArrow funcrn);

theorem Arrowssxp: $ Arrow A B C_ Power (Xp A B) $ =
(named '(ax_gen @ sylibr elPower @ sylbi elArrow funcssxp));
theorem Arrowfin: $ finite A -> finite B -> finite (Arrow A B) $ =
'(exp @ syl (finss Arrowssxp) @ syl powerfin @ imp xpfin);

theorem appT: $ f e. Arrow A B /\ x e. A -> f @ x e. B $ =
'(sylbi (aneq1i elArrow) funcT);

theorem Arrow01: $ Arrow 0 B == sn 0 $ =
(named '(ax_gen @ bitr4 elArrow @ bitr4 elsn @ bitr func02 nsinj));
theorem Arrow02: $ ~A == 0 -> Arrow A 0 == 0 $ =
(named '(sylibr eq0al @ iald @ con3 @ sylbi elArrow @ sylbi func03 anr));

--| `\. x e. a, v(x)` is the finite (restricted) lambda: the regular lambda `\ x, v(x)`
--| restricted to the finite set `a`. Since it is finite, we make it manifestly finite here.
@_ def rlam {x: nat} (a: nat) (v: nat x): nat = $ lower ((\ x, v) |` a) $;
notation rlam {x: nat} (a: nat) (v: nat x): nat = ($\.$:53) x ($e.$:50) a ($,$:55) v;

theorem rlameq1 (a b c: nat x): $ a = b -> \. x e. a, c = \. x e. b, c $ =
'(lowereqd @ reseq2d nseq);
theorem rlameqs (a b: nat x): $ \. x e. a, b == (\ x, b) |` a $ =
'(eqscom @ mpbi eqlower @ finlamh finns);
theorem elrlam (a: nat) (b: nat x): $ p e. \. x e. a, b <-> E. x (x e. a /\ p = x, b) $ =
'(bitr (ellower @ finlam finns) @ bitr elres @
  bitr (aneq1i ellam) @ bitr3 exan2 @ exeqi @
  bitr ancomb @ aneq1a @ eleq1d @ syl6eq fstpr fsteq);
theorem rlameq2a (v w: nat x): $ A. x (x e. a -> v = w) -> \. x e. a, v = \. x e. a, w $ =
'(syl axext @ !! iald y @ bitr4g elrlam elrlam @ syl exeq @ alimi @
  syl aneq2a @ imim2i @ eqeq2d preq2);
theorem rlameq2da (v w: nat x) (h: $ G /\ x e. a -> v = w $): $ G -> \. x e. a, v = \. x e. a, w $ =
'(syl rlameq2a @ ialda h);
theorem nfrlam1 (a b: nat x) (h1: $ FN/ x a $): $ FN/ x \. x e. a, b $ =
'(nflower @ nfres nflam1 (nfns h1));
theorem nfrlam (a b: nat x y) (h1: $ FN/ x a $) (h2: $ FN/ x b $): $ FN/ x \. y e. a, b $ =
'(nflower @ nfres (nflam h2) (nfns h1));
theorem cbvrlamh (a b c: nat x y) (h1: $ FN/ y b $) (h2: $ FN/ x c $)
  (e: $ x = y -> b = c $): $ \. x e. a, b = \. y e. a, c $ =
'(lowereq @ reseq1 @ cbvlamh h1 h2 e);
theorem cbvrlam (a: nat x y) (b: nat x) (c: nat y)
  (e: $ x = y -> b = c $): $ \. x e. a, b = \. y e. a, c $ = '(cbvrlamh nfnv nfnv e);
theorem cbvrlams (a: nat x y) (b: nat x): $ \. x e. a, b = \. y e. a, N[y / x] b $ =
'(cbvrlamh nfnv nfsbn1 sbnq);
theorem cbvrlamd (G) (a: nat x y) (b: nat x) (c: nat y)
  (h: $ G /\ x = y -> b = c $): $ G -> \. x e. a, b = \. y e. a, c $ =
'(eqtrd (a1i cbvrlams) @ rlameq2d @ syl sbnet @ ialda h);

theorem rlamss (a b: nat x): $ \. x e. a, b C_ \ x, b $ = '(mpbir (sseq1 rlameqs) resss);
theorem rlamisf (a b: nat x): $ isfun (\. x e. a, b) $ = '(isfss rlamss lamisf);
theorem dmrlam (a b: nat x): $ Dom (\. x e. a, b) == a $ = '(eqstr (dmeq rlameqs) dmreslam);
theorem rnrlam (b: nat x): $ Ran (\. x e. a, b) == (\ x, b) '' a $ = '(eqstr (rneq rlameqs) rnres);
theorem rlamrnss (b: nat x): $ Ran (\. x e. a, b) C_ B <-> A. x (x e. a -> b e. B) $ =
'(bitr (sseq1 rnrlam) @ bitr (aleqi @ bitr (imeq1i ellamima) eexb) @
  bitr alcomb @ aleqi @ bitr (aleqi @ bitr (imeq1i ancomb) impexp) @
  !! aleqe y @ imeq2d eleq1);
theorem rlamfunc (b: nat x): $ func (\. x e. a, b) a B <-> A. x (x e. a -> b e. B) $ =
'(bitr (bian1 @ ian rlamisf dmrlam) rlamrnss);
theorem rlamfunc2 (b: nat x): $ A == a ->
  (func (\. x e. a, b) A B <-> A. x (x e. A -> b e. B)) $ =
'(mpbiri rlamfunc ,eqtac);
theorem rlamArrow (b: nat x):
  $ \. x e. a, b e. Arrow a B <-> A. x (x e. a -> b e. B) $ = '(bitr elArrow rlamfunc);
theorem unrlam (v: nat x):
  $ (\. x e. a, v) u. (\. x e. b, v) == \. x e. c, v <-> a u. b == c $ =
(named '(ibii
  (eqstr3g (eqstr dmun @ uneq dmrlam dmrlam) dmrlam dmeq)
  (eqrd @ bitr4g (bitr elun @ oreq elrlam elrlam) elrlam @ syl5bbr exor @
    exeqd @ syl5bbr andir @ aneq1d @ syl5bbr elun eleq2)));

theorem apprlams (b c: nat x): $ c e. a -> (\. x e. a, b) @ c = N[c / x] b $ =
'(syl5eq (appeq1 rlameqs) @ syl6eq applams resapp);
theorem apprlam (b: nat x): $ x e. a -> (\. x e. a, b) @ x = b $ = '(syl6eq sbnid apprlams);
theorem apprlame (b: nat x) (e: $ x = c -> b = d $):
  $ c e. a -> (\. x e. a, b) @ c = d $ = '(syl6eq (sbne e) apprlams);
theorem apprlamed (b: nat x) (e: $ G /\ x = c -> b = d $) (h: $ G -> c e. a $):
  $ G -> (\. x e. a, b) @ c = d $ = '(eqtrd (syl apprlams h) (sbned e));
theorem apprlamed1 (b: nat x) (h: $ G -> c e. a $) (e: $ G /\ x = c -> f @ c = b -> P $):
  $ G -> f = \. x e. a, b -> P $ =
'(mpi ax_6 @ eexdh nfv (nfim (nfeq2 @ nfrlam1 nfnv) nfv) @
  exp @ syld (syl5ibrcom (eqeq1d appneq1) @
    eqtr3d (appeq2d anr) (syl apprlam @ mpbird (eleq1d anr) @ anwl h)) e);
theorem apprlamed2 (f b: nat x) (h: $ G -> c e. a $)
  (e: $ G /\ x = c -> b = d $): $ G -> f = \. x e. a, b -> f @ c = d $ =
'(syl5ibrcom (eqeq1d appneq1) @ apprlamed e h);
theorem rlameq2b (v w: nat x): $ \. x e. a, v = \. x e. a, w <-> A. x (x e. a -> v = w) $ =
'(ibii (ialdh (nf_eq (nfrlam1 nfnv) (nfrlam1 nfnv)) @
    rsyl appneq1 @ com12 @ bi1d @ eqeqd apprlam apprlam) rlameq2a);
theorem apprlam0 (b c: nat x): $ ~c e. a -> (\. x e. a, b) @ c = 0 $ =
'(sylbir (noteq @ eleq2 dmrlam) ndmapp);
theorem rlamrcl (b c: nat x): $ d e. (\. x e. a, b) @ c -> c e. a $ =
'(ax_3 @ mpbiri nel0 @ noteqd @ elneq2d apprlam0);
theorem rlamapp: $ \. x e. a, F @ x == F <-> isfun F /\ Dom F == a $ =
'(bitr (eqseq1 rlameqs) lamapp2);
theorem eqsrlam (b: nat x): $ F == \. x e. a, b <->
  isfun F /\ Dom F == a /\ A. x (x e. a -> F @ x = b) $ =
'(bitr2
  (aneq2a @ sylbir rlamapp @ syl5bbr rlameq2b @ syl5bbr nsinj eqseq1)
  (bian1a @ iand (mpbiri rlamisf isfeq) (syl6eqs dmrlam dmeq)));
theorem eqrlam (b: nat x): $ f = \. x e. a, b <->
  isfun f /\ Dom f == a /\ A. x (x e. a -> f @ x = b) $ = '(bitr3 nsinj eqsrlam);

theorem funcsn2: $ func F a (sn b) <-> F == \. x e. a, b $ =
'(bitr4 funcal @ bitr4 eqsrlam @ aneq2i @ aleqi @ imeq2i elsn);
theorem Arrowsn2: $ Arrow a (sn b) == sn (\. x e. a, b) $ =
(named '(ax_gen @ bitr4 elArrow @ bitr4 elsn @ bitr funcsn2 nsinj));

--| `write F a b`, sometimes denoted `F[a -> b]` is
--| the function which is `b` at `a` and returns `F @ x` for `x != a`.
@_ def write (F: set) (a b: nat): set =
$ S\ x, {y | ifp (x = a) (y = b) (x, y e. F)} $;

theorem elwrite:
  $ x, y e. write F a b <-> ifp (x = a) (y = b) (x, y e. F) $ =
(named '(elsabe @ elabed @ ifpeqd (eqeq1d anl) (eqeq1d anr) (eleq1d @ imp preq)));

pub theorem writeEq (F a b): $ write F a b @ a = b $ =
'(trud @ !! eqtheabd y @ a1i @ bitr elwrite @ ifppos eqid);
pub theorem writeNe (F a b x): $ x != a -> write F a b @ x = F @ x $ =
'(syl eqapp @ !! iald y @ syl5bb elwrite ifpneg);

theorem writeisf: $ isfun F -> isfun (write F a b) $ =
'(!! iald x @ !! iald y @ !! iald z @ syl5bi elwrite @ eorda
  (syl5bi elwrite @ mpbird (imeq1d (syl ifppos anrl)) (syl eqtr4 anrr))
  (syl5bi elwrite @ mpbird (imeq1d (syl ifpneg anrl)) @ exp @ isfd anll (anwl anrr) anr));

theorem writeres: $ write F a b == (F |` {x | x != a}) u. sn (a, b) $ =
'(!! eqri p @ bitr3 (eleq1 fstsnd) @ bitr elwrite @
  bitr orcomb @ bitr4 (oreq1 @ bitr4 ancomb @ aneq2i @ elabe neeq1) @
  bitr3 (eleq1 fstsnd) @ bitr elun @ oreq prelres @ bitr elsn prth);

theorem writefin: $ finite F -> finite (write F a b) $ =
'(sylibr (fineq @ !! writeres x) @ sylc unfin resfin @ a1i finns);

theorem dmwrite: $ Dom (write F a b) == Dom F u. sn a $ =
(focus
  '(!! eqri x @ bitr4 (ibii _ _) @ bitr elun @ bitr orcomb @ oreq1 elsn)
  '(sylbi eldm @ !! eex y @ sylbi elwrite @ com12 @ syl6 preldm @ bi1d ifpneg)
  '(casesd (a1i @ syl preldm @ sylibr elwrite @ mpbiri eqid ifppos) @
    a2i @ syl5bi eldm @ !! eexd y @
    mpbii preldm @ imeq1d @ syl5bb elwrite ifpneg));

theorem rnwrite: $ Ran (write F a b) C_ Ran F u. sn b $ =
'(!! ax_gen x @ sylbi elrn @ !! eex y @ sylbi elwrite @ eor
  (syl elun2 @ sylibr elsn anr)
  (syl elun1 @ anwr prelrn));

theorem writeArrow
  (hf: $ G -> f e. Arrow A B $) (ha: $ G -> a e. A $) (hb: $ G -> b e. B $)
  (h: $ G -> write f a b == g $): $ G -> g e. Arrow A B $ =
'(sylibr elArrow @ iand (iand
  (mpbid (isfeqd h) @ syl writeisf @ syl Arrowisf hf)
  (eqstr3d (dmeqd h) @ syl5eqs dmwrite @ eqstrd (uneq1d @ syl Arrowdm hf) @
    sylib equn2 @ sylibr snss ha))
  (mpbid (sseq1d @ rneqd h) @ syl (sstr rnwrite) @ sylibr unss @
    iand (syl Arrowrn hf) @ sylibr snss hb));

@_ local def srecaux (S: set) (n: nat) {.a .b: nat}: nat =
$ recn 0 (\\ a, \ b, lower (write b a (S @ b))) n $;

theorem srecaux0: $ srecaux S 0 = 0 $ = (named 'recn0);
theorem srecauxS: $ srecaux S (suc n) ==
  write (srecaux S n) n (S @ srecaux S n) $ =
'(mpbir (eqlower2 @ writefin finns) @
  eqtr recnS @ ! appslame _ $ srecaux S n $ _ a _ @ !! applamed b @
  lowereqd @ writeeqd (nseqd anr) anl (appeq2d anr));

theorem dmsrecaux: $ Dom (srecaux S n) == upto n $ =
(induct '(!! ind x y) 'n
  '(eqstr (dmeq @ nseq srecaux0) @ eqstr4 dm0 @ nseq upto0)
  '(eqstr4g (eqstr (dmeq srecauxS) dmwrite)
    (!! eqri z @ bitr elupto @ bitr3 leltsuc @ bitr4 leloe @ bitr elun @ oreq elupto elsn)
    uneq1));

theorem srecauxisf: $ isfun (srecaux S n) $ =
(induct '(!! ind x y) 'n
  '(mpbir (isfeq @ nseq srecaux0) isf0)
  '(sylibr (isfeq srecauxS) writeisf));

--| Strong recursion operator:
--| * `srec n = S (srec 0, ..., srec (n-1))`
@_ abstract def srec (S: set) (n: nat): nat = $ srecaux S (suc n) @ n $;

theorem srecauxapp: $ a < n -> srecaux S n @ a = srec S a $ =
(induct '(!! ind x y) 'n
  '(absurd lt02)
  '(syl5bir leltsuc @ syl5bi leloe @ eord
    (a2i @ bi2d @ eqeq1d @ syl5eq (appeq1 @ srecauxS) (syl writeNe ltne))
    (a1i @ appneq1d @ srecauxeq2d @ suceqd eqcom)));

theorem srecval2: $ srec S n = S @ srecaux S n $ =
'(eqtr3 (srecauxapp ltsucid) @ eqtr (appeq1 srecauxS) writeEq);

theorem srecres: $ (\ i, srec S i) |` upto n == srecaux S n $ =
'(eqstr3 (reslameq @ ax_gen @ sylbi elupto srecauxapp) @
  eqstr3 (reseq2 dmsrecaux) (mpbir lamapp srecauxisf));

theorem srecrlam: $ \. i e. upto n, srec S i = srecaux S n $ =
'(axext @ eqstr rlameqs srecres);

theorem sreclem (a: nat x):
  $ f = \. x e. upto n, a -> size (Dom f) = n $ =
'(syl6eq sizeupto @ sizeeqd @ syl6eqs dmrlam @ dmeqd nseq);

theorem sreclem2 (a b: nat x):
  $ f = \. x e. upto n, a -> b < n -> f @ b = N[b / x] a $ =
'(exp @ syl6eq applams @ eqtrd
  (appeq1d @ sylibr (eqlower2 @ finlam finns) anl)
  (syl resapp @ sylibr elupto anr));

pub theorem srecval {i} (S n): $ srec S n = S @ (\. i e. upto n, srec S i) $ =
'(eqtr4 srecval2 @ appeq2 @ eqtr (lowereq srecres) lowerns);

@_ local def srecpaux (A n) (.f: nat): nat =
$ srec (\ f, nat (size (Dom f), lower {x | true (f @ x)} e. A)) n $;

--| Strong recursion operator (for wffs):
--| * `srecp n <-> (srecp 0, ..., srecp (n-1)) e. A`
@_ abstract def srecp (A: set) (n: nat): wff = $ true (srecpaux A n) $;

theorem srecpauxval:
  $ srecpaux A n = nat (n, sep (upto n) {i | srecp A i} e. A) $ =
'(eqtr {srecval : $ _ = _ @ lower ((\ i, srecpaux A i) |` _) $} @
  eqtr4 (!! applame f @ nateqd @ eleq1d @ preqd sreclem
    (lowereqd @ !! abeqd x @ trueeqd @ appeq1d @
      bi2 @ eqlower2 @ finlam finns)) @
  nateq @ eleq1 @ preq2 @ eqtr3 lowerns @ lowereq @
  eqab2i @ bitr elsep @
  rbid anl (sylib (eleq2 dmreslam) @ con1 ndmapp) @
  bitr4d bian1 @ syl6bbr (elabe srecpeq2) @ trueeqd @
  syl6eq (applame srecpauxeq2) resapp);

pub theorem srecpval (A: set) (n: nat):
  $ srecp A n <-> n, sep (upto n) {i | srecp A i} e. A $ =
'(bitr (trueeq srecpauxval) truenat);

--| The cardinality (number of elements) of a finite set.
@_ abstract def card (s .f: nat): nat =
$ srec (\ f, f @ (size (Dom f) // 2) + size (Dom f) % 2) s $;

theorem cardvallem: $ card n = ((\ i, card i) |` upto n) @ (n // 2) + n % 2 $ =
'(eqtr srecval @ ! applame $ \. i e. upto n, card i $ _ f _ @
  addeqd (appeqd (bi2 @ eqlower2 @ finlam finns) (diveq1d sreclem))
    (modeq1d sreclem));

pub theorem card0: $ card 0 = 0 $ =
'(eqtr (!! cardvallem i) @ eqtr (addeq
  (ndmapp @ mtbir (eleq2 @ eqstr dmreslam @ nseq upto0) el02) mod01) add0);

theorem cardval: $ n != 0 -> card n = card (n // 2) + n % 2 $ =
'(syl5eq cardvallem @ addeq1d @ syl6eq (!! applame i cardeq) @
  syl resapp @ sylibr elupto @ sylbir lt01 div2lt);

theorem cardb0: $ card (b0 n) = card n $ =
'(cases (cardeqd @ mpbiri b00 @ eqeqd b0eq id) @
  syl6eq add0 @ syl6eq (addeq (cardeq b0div2) b0mod2) @ sylbir b0ne0 cardval);

theorem cardb1: $ card (b1 n) = suc (card n) $ =
'(eqtr (cardval b1ne0) @ eqtr (addeq (cardeq b1div2) b1mod2) add12);

pub theorem cardS (a s: nat): $ ~a e. s -> card (a ; s) = suc (card s) $ =
'(!! eale z (imeqd (noteqd elneq2) @ eqeqd (cardeqd inseq2) (suceqd cardeq)) @
  trud @ !! indstr x y
    (aleqd @ imeqd (noteqd eleq1) (eqeq1d @ cardeqd inseq1))
    (aleqd @ imeqd (noteqd eleq1) (eqeq1d @ cardeqd inseq1)) @ anwr @
    sylibr (!! cbval z w @
      imeqd (noteqd elneq2) @ eqeqd (cardeqd inseq2) (suceqd cardeq)) @ iald @
    cases
      (a1d @ mpbiri (sylbi (noteq el01) @ sylbi eqb0 @
          eqtr4d (cardeqd @ syl6eqr b1ins inseq2) @
          syl6eqr cardb1 @ suceqd @ syl6eq cardb0 cardeq) @
        imeqd (noteqd eleq1) (eqeq1d @ cardeqd inseq1))
      (ealde @
        mpbird (imeq1d @ syl biim1 @
          mpbird (lteq1d anr) @ sylan subltid (sylibr lt01 anl) (a1i d0lt1)) @
        ealde @ imimd
          (bi2d @ noteqd @ bitrd (elneqd anlr anr) @
            syl5bb eldiv2 @ eleq1d @ syl sub1can anll) @
          sylbi anass @ imp @
          syl5ibrcom (imeq1d @ eqeqd (cardeqd @ syl6eqr insdiv2 @ imp inseq) (suceqd @ cardeqd anr)) @
          bi1d @ casesda
            (syl5bbr peano2 @ eqeqd
              (syl5eqr cardb1 @ cardeqd @
                eqtr4d (b1eqd @ diveq1d @ inseq1d @ anwl sub1can) @
                sylib eqb1 @ sylib el01 @ sylibr elins @ orrd @ sylibr el01 anr)
              (suceqd @ syl5eqr cardb1 @ cardeqd @ eqcomd @ sylib eqb1 anr))
            (eqeqd
              (syl5eqr cardb0 @ cardeqd @
                eqtr4d (b0eqd @ diveq1d @ inseq1d @ anwl sub1can) @
                sylib eqb0 @ sylbir notor @ con3 @
                sylbir el01 @ sylbi elins @ bi1 @ oreq eqcomb el01)
              (suceqd @ syl5eqr cardb0 @ cardeqd @ eqcomd @ sylib eqb0 anr))));

--| List recursion operator:
--| * `lrec 0 = z`
--| * `lrec (a : l) = S (a, l, lrec l)`
@_ abstract def lrec (z: nat) (S: set) (n: nat): nat =
$ srec (\ f, N[size (Dom f) / i]
  if (i = 0) z (S @ (fst (i - 1), snd (i - 1), f @ snd (i - 1)))) n $;

theorem lrecval: $ lrec z S n =
  if (n = 0) z (S @ (fst (n - 1), snd (n - 1), lrec z S (snd (n - 1)))) $ =
(focus
  (have 'h '(eqtrd anr @ anwl sreclem))
  '(eqtr {srecval : $ _ = _ @ (\. x e. _, lrec z S x) $} @
    !! applame f @ !! sbned i @ eqtrd (ifeq1d @ eqeq1d h) @
    syla ifeq3a @ appeq2d @
    preqd (anwl @ fsteqd @ subeq1d h) @ preqd (anwl @ sndeqd @ subeq1d h) @
    eqtrd (appeq2d @ anwl @ sndeqd @ subeq1d h) @ syl6eq (sbne lreceq3) @
    sylc sreclem2 anll @ mpbii ltconsid2 @ lteq2d @ anwr consfstsnd));

pub theorem lrec0 (z: nat) (S: set): $ lrec z S 0 = z $ = '(eqtr lrecval @ ifpos eqid);
pub theorem lrecS (z: nat) (S: set) (a b: nat):
  $ lrec z S (a : b) = S @ (a, b, lrec z S b) $ =
'(eqtr lrecval @ eqtr (ifneg consne0) @ appeq2 @
  preq consfst @ preq conssnd @ lreceq3 @ conssnd);

theorem listindd {x a l} (n) (px: wff x) (p0 pn: wff) (pl: wff l) (ps: wff a l)
  (hn: $ x = n -> (px <-> pn) $)
  (h0: $ x = 0 -> (px <-> p0) $)
  (hl: $ x = l -> (px <-> pl) $)
  (hs: $ x = a : l -> (px <-> ps) $)
  (h1: $ G -> p0 $) (h2: $ G /\ pl -> ps $): $ G -> pn $ =
'(!! indstr z w (syl6bb (sbe hn) sbeq1) sbeq1 @ casesda
  (mpbird (sbeq1d anr) @ anwll @ sylibr (sbe h0) h1)
  (mpd (sylib excons anr) @ eexd @ eexd @ anwl @ exp @
    mpbird (syl6bb (sbe hs) @ sbeq1d anr) @
    mpd (mpd (mpbiri ltconsid2 @ lteq2d anr) @
      rsyl anlr @ eale @ imeqd lteq1 @ syl6bb (sbe hl) sbeq1) @
    anwll @ exp h2));

theorem listind {x a l} (n) (px: wff x) (p0 pn: wff) (pl: wff l) (ps: wff a l)
  (hn: $ x = n -> (px <-> pn) $)
  (h0: $ x = 0 -> (px <-> p0) $)
  (hl: $ x = l -> (px <-> pl) $)
  (hs: $ x = a : l -> (px <-> ps) $)
  (h1: $ p0 $) (h2: $ pl -> ps $): $ pn $ =
'(trud @ listindd hn h0 hl hs (a1i h1) (anwr h2));

--| The set of members of list `l`: `lmems [a, b, c] = {a, b, c}`.
--|
--| `lmems : List A -> Power A`
@_ abstract def lmems (l: nat): nat = $ lrec 0 (\\ x, \\ z, \ y, x ; y) l $;
pub theorem lmems0: $ lmems 0 = 0 $ = (named 'lrec0);
pub theorem lmemsS (a l: nat): $ lmems (a : l) = a ; lmems l $ =
'(eqtr lrecS @ ! appslame _ $ _, lmems l $ _ x _ @
  !! appslamed z @ !! applamed y @ inseqd anll anr);

--| `a IN l` means `a e. lmems l`, that is, `a` is a member of the list `l`.
--|
--| `lmem : A -> List A -> Bool`
@_ def lmem (a l: nat): wff = $ a e. lmems l $; infixl lmem: $IN$ prec 50;

theorem lmem0: $ ~ a IN 0 $ = '(mtbir (elneq2 lmems0) el02);
theorem lmemS: $ a IN b : l <-> a = b \/ a IN l $ = '(bitr (elneq2 lmemsS) elins);
theorem lmem1: $ a IN b : 0 <-> a = b $ = '(bitr lmemS @ bior2 lmem0);

theorem lmemconsid: $ a IN a : l $ = '(mpbir lmemS (orl eqid));

theorem lmemlt: $ a IN l -> a < l $ =
(named @ induct '(listind) 'l '(absurd lmem0)
  '(syl5bi lmemS @ eord (a1i @ mpbiri ltconsid1 lteq1) (imim2i @ mpi ltconsid2 lttr)));

--| `all {x | p(x)} l` means every element of the list `l` satisfies `p(x)`.
@_ def all (A: set) (l: nat): wff = $ lmems l C_ A $;

theorem all0 (A: set): $ all A 0 $ = '(!! ax_gen x @ absurd lmem0);
theorem allS (A: set) (a b: nat): $ all A (a : b) <-> a e. A /\ all A b $ =
'(bitr (sseq1 @ nseq @ lmemsS) insss);

theorem all1 (A: set) (a: nat): $ all A (a : 0) <-> a e. A $ = '(bitr allS @ bian2 all0);

theorem allal2: $ all A l <-> A. x (x IN l -> x e. A) $ = 'biid;
theorem allal (p: wff x): $ all {x | p} l <-> A. x (x IN l -> p) $ = '(bicom ssab2);

theorem elall: $ all A l -> x IN l -> x e. A $ = (named '(eale @ imeqd eleq1 eleq1));

theorem ssall: $ A C_ B -> all A l -> all B l $ = (named '(alimd @ imim2d ssel));

--| `List A` is the type of lists with elements of type `A`.
--| It is inductively generated by the clauses:
--| * `0 e. List A`
--| * `a e. A -> l e. List A -> a : l e. List A`
@_ def List (A: set) (.n: nat): set = $ {n | all A n} $;

theorem elList: $ l e. List A <-> all A l $ = '(!! elabe n alleq2);

theorem elList0: $ 0 e. List A $ = '(mpbir elList all0);
theorem elListS: $ a : b e. List A <-> a e. A /\ b e. List A $ =
'(bitr elList @ bitr4 allS @ aneq2i elList);
theorem elListHd (h: $ G -> a : b e. List A $): $ G -> a e. A $ = '(anld @ sylib elListS h);
theorem elListTl (h: $ G -> a : b e. List A $): $ G -> b e. List A $ = '(anrd @ sylib elListS h);
theorem elList1: $ a : 0 e. List A <-> a e. A $ = '(bitr elListS @ bian2 elList0);

--| `len l` is the length of the list `l`.
--|
--| `len : List A -> nat`
@_ abstract def len (l: nat): nat = $ lrec 0 (\\ x, \\ z, \ y, suc y) l $;
pub theorem len0: $ len 0 = 0 $ = (named 'lrec0);
pub theorem lenS (a b: nat): $ len (a : b) = suc (len b) $ =
'(eqtr lrecS @ ! appslame _ $ _, len b $ _ x _ @
  !! appslamed z @ !! applamed y @ suceqd anr);

theorem len1: $ len (a : 0) = 1 $ = '(eqtr lenS @ suceq len0);

theorem leneq0: $ len n = 0 <-> n = 0 $ =
'(ibii (ax_3 @ syl sucne0 @ syl6eq lenS @ leneqd @ eqcomd consfstsnd)
  (syl6eq len0 leneq));

theorem lenleid: $ len l <= l $ =
(named @ induct '(listind) 'l '(eqle len0)
  '(sylibr (leeq1 lenS) @ sylib lesuc @ mpi leprid2 letr));

--| `Array A n` is the subtype of lists which have length `n`.
--| * `0 e. Array A 0`
--| * `a e. A -> l e. Array A n -> a : l e. Array A (n+1)`
@_ def Array (A: set) (n .l: nat): set = $ {l | l e. List A /\ len l = n} $;

theorem elArray: $ l e. Array A n <-> l e. List A /\ len l = n $ =
'(!! elabe x @ aneqd eleq1 (eqeq1d leneq));

theorem elArrayList: $ l e. Array A n -> l e. List A $ = '(sylbi elArray anl);
theorem elArraylen: $ l e. Array A n -> len l = n $ = '(sylbi elArray anr);

theorem elArray02: $ l e. Array A 0 <-> l = 0 $ =
'(bitr elArray @ bitr (aneq2i leneq0) @ bian1a @ mpbiri elList0 eleq1);
theorem elArray0: $ 0 e. Array A 0 $ = '(mpbir elArray02 eqid);
theorem elArrayS: $ a : b e. Array A (suc n) <-> a e. A /\ b e. Array A n $ =
'(bitr elArray @ bitr (aneq elListS @ bitr (eqeq1 lenS) peano2) @
  bitr4 anass (aneq2i elArray));
theorem elArray1: $ a : 0 e. Array A 1 <-> a e. A $ =
'(bitr elArrayS @ bian2 elArray0);
theorem elArraySne0: $ l e. Array A (suc n) -> l != 0 $ =
'(sylbi elArray @ anwr @ sylib (noteq leneq0) sucne0);
theorem elArrayS2: $ l e. Array A (suc n) <-> E. a E. b (a e. A /\ b e. Array A n /\ l = a : b) $ =
'(bitr2 (bian1exi @ bian1exi @ aneq1a @ bicomd @ syl6bb elArrayS eleq1) @
  bian2a @ sylib excons elArraySne0);

theorem Arrayfin: $ finite A -> finite (Array A n) $ =
(named @ induct '(indd) 'n
  '(a1i @ mpbir (fineq (eqri @ bitr4 elArray02 elsn)) finns)
  '(rsyl (imp xpfin) @ syl (mpi lefin finss) @ sylib ssab2 @ iald @
    syl5bi elArrayS2 @ eexd @ eexda @ mpbird (leeq1d anrr) @
    syl ellt @ mpbird (anwl ellower) @ sylibr prelxp anrl));

--| `append l1 l2`, or `l1 ++ l2`, is the result of concatenating
--| lists `l1` and `l2`.
--| * `0 ++ l = l`
--| * `(a : l) ++ r = a : (l ++ r)`
--|
--| `append : List A -> List A -> List A`
@_ abstract def append (l1 l2: nat): nat = $ lrec l2 (\\ x, \\ z, \ y, x : y) l1 $;
infixr append: $++$ prec 85;
pub theorem append0 (l: nat): $ 0 ++ l = l $ = (named 'lrec0);
pub theorem appendS (a l r: nat): $ (a : l) ++ r = a : (l ++ r) $ =
'(eqtr lrecS @ ! appslame _ $ _, append l $ _ x _ @
  !! appslamed z @ !! applamed y @ conseqd anll anr);

theorem appendSi (h: $ a ++ b = c $): $ x : a ++ b = x : c $ = '(eqtr appendS @ conseq2 h);
theorem append1: $ a : 0 ++ l = a : l $ = '(appendSi append0);

theorem append02: $ a ++ 0 = a $ =
(named @ induct '(listind) 'a 'append0 '(syl5eq appendS conseq2));

theorem appendass: $ (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3) $ =
(named @ induct '(listind) 'l1
  '(eqtr4 (appendeq1 append0) append0)
  '(syl5eq (appendeq1 appendS) @ syl5eq appendS @ syl6eqr appendS conseq2));

theorem appendlen: $ len (l1 ++ l2) = len l1 + len l2 $ =
(named @ induct '(listind) 'l1
  '(eqtr4 (leneq append0) @ eqtr (addeq1 len0) add01)
  '(syl5eq (eqtr (leneq appendS) lenS) @ syl6eqr (eqtr (addeq1 lenS) addS1) suceq));

theorem leappend2: $ b <= c <-> a ++ b <= a ++ c $ =
(named @ induct '(listind) 'a
  '(bicom @ leeq append0 append0)
  '(syl6bb (bitr4 lecons2 (leeq appendS appendS)) id));

theorem ltappend2: $ b < c <-> a ++ b < a ++ c $ =
'(bitr4 ltnle @ bitr4 ltnle @ noteq leappend2);

theorem appendcan1: $ a ++ b = a ++ c <-> b = c $ =
'(bitr4 eqlele @ bitr eqlele @ aneq leappend2 leappend2);

theorem leappendid1: $ a <= a ++ b $ =
'(mpbi (leeq1 append02) @ mpbi leappend2 le01);

theorem leappendid2: $ a <= b ++ a $ =
(named @ induct '(listind) 'b '(eqler append0)
  '(mpi (mpbir (leeq2 appendS) @ ltle ltconsid2) letr));

theorem ltappendid1: $ b != 0 <-> a < a ++ b $ =
'(bitr3 lt01 @ bitr ltappend2 (lteq1 append02));

theorem ltappendid2: $ b != 0 <-> a < b ++ a $ =
(named '(ibii
  (sylbi excons @ eex @ eex @ mpbiri (lelttr leappendid2 ltconsid2) @
    lteq2d @ syl6eq appendS appendeq1)
  (rsyl ltne @ con3 @ eqcomd @ syl6eq append0 appendeq1)));

theorem appendeq0: $ a ++ b = 0 <-> a = 0 /\ b = 0 $ =
'(bitr3 leneq0 @ bitr (eqeq1 appendlen) @ bitr addeq0 @ aneq leneq0 leneq0);

theorem lmemappend: $ x IN a ++ b <-> x IN a \/ x IN b $ =
(named @ induct '(listind) 'a '(bitr4 (lmemeq2 append0) @ bior1 lmem0)
  '(bitr4g (lmemeq2 appendS) (oreq1i lmemS) @ bitr4g lmemS orass (oreq2d id)));

theorem allappend: $ all A (a ++ b) <-> all A a /\ all A b $ =
'(bitr4 allal2 @ bitr4 (aneq allal2 allal2) @
  bitr (aleqi @ bitr (imeq1i lmemappend) imor) @ !! alan x);

theorem appendT: $ a ++ b e. List A <-> a e. List A /\ b e. List A $ =
'(bitr4 elList @ bitr4 (aneq elList elList) allappend);

theorem appendArray: $ a e. Array A m -> b e. Array A n -> a ++ b e. Array A (m + n) $ =
'(exp @ sylbi (aneq elArray elArray) @ sylbi an4 @ sylibr elArray @
  anim (bi2 appendT) @ syl5eq appendlen @ imp addeq);

--| `snoc l a` (`cons` written backwards) or `l |> a` is the
--| result of putting `a` at the end of the list `l`:
--| * `l |> a = l ++ (a : 0)`.
--|
--| `snoc : List A -> A -> List A`
@_ abstract def snoc (l a: nat): nat = $ l ++ (a : 0) $;
infixl snoc: $|>$ prec 84;
pub theorem snoc0 (a: nat): $ 0 |> a = a : 0 $ = 'append0;
pub theorem snocS (a b c: nat): $ (a : b) |> c = a : (b |> c) $ = 'appendS;
pub theorem snoclt (a b: nat): $ a < a |> b $ =
(named @ induct '(listind) 'a
  '(mpbir (lteq2 snoc0) @ mpbir lt01 consne0)
  '(bi1i @ bitr4 ltcons2 @ lteq2 snocS));

theorem lesnoc2: $ b <= c <-> a |> b <= a |> c $ = '(bitr lecons1 leappend2);
theorem appendsnoc: $ l1 ++ (l2 |> b) = l1 ++ l2 |> b $ = '(eqcom appendass);
theorem conssnoc: $ a : (l |> b) = a : l |> b $ = '(eqcom appendS);
theorem snoclen: $ len (a |> b) = suc (len a) $ = '(eqtr appendlen @ eqtr (addeq2 len1) add12);
theorem lmemsnoc: $ x IN a |> b <-> x IN a \/ x = b $ = '(bitr lmemappend @ oreq2i lmem1);
theorem lmemsnocid: $ a IN l |> a $ = '(mpbir lmemsnoc (orr eqid));
theorem allsnoc: $ all A (a |> b) <-> all A a /\ b e. A $ = '(bitr allappend @ aneq2i all1);
theorem snocne0: $ a |> b != 0 $ = '(mt (syl6eq len0 leneq) @ sucne0 snoclen);

theorem snocT: $ a |> b e. List A <-> a e. List A /\ b e. A $ =
'(bitr appendT @ aneq2i elList1);

@_ local def listfn (l .f: nat): nat = $ lrec 0 (\\ a, \\ z, \ f,
  \. i e. upto (suc (size (Dom f))), if (i = 0) a (f @ (i - 1))) l $;

theorem listfn0: $ listfn 0 = 0 $ = (named 'lrec0);
theorem listfnS2: $ listfn (a : l) =
  \. i e. upto (suc (size (Dom (listfn l)))), if (i = 0) a (listfn l @ (i - 1)) $ =
'(eqtr lrecS @ ! appslame _ $ _, listfn l $ _ x _ @ !! appslamed z @ !! applamed y @
  lowereqd @ reseqd (lameqd @ ifeqd biidd anll @ appneq1d anr)
   (nseqd @ uptoeqd @ suceqd @ sizeeqd @ dmeqd @ nseqd anr));

theorem dmlistfn: $ Dom (listfn l) == upto (len l) $ =
(named @ induct '(listind) 'l
  '(eqstr (dmeq @ nseq listfn0) @ eqstr4 dm0 @ nseq @ eqtr (uptoeq len0) upto0)
  '(syl5eqs (dmeq @ nseq @ !! listfnS2 i) @ syl5eqs dmrlam @
    nseqd @ syl6eqr (uptoeq lenS) @ uptoeqd @ suceqd @ syl6eq sizeupto sizeeq));

theorem listfnisf: $ isfun (listfn l) $ =
'(cases
  (mpbiri isf0 @ isfeqd @ nseqd @ syl6eq listfn0 listfneq)
  (mpbii rlamisf @ isfeqd @ nseqd @ syl5eqr (!! listfnS2 i) @ listfneqd consfstsnd));

theorem listfnS: $ listfn (a : l) =
  \. i e. upto (suc (len l)), if (i = 0) a (listfn l @ (i - 1)) $ =
'(eqtr listfnS2 @ rlameq1 @ uptoeq @ suceq @ eqtr (sizeeq dmlistfn) sizeupto);

theorem listfnSval: $ n < suc (len l) ->
  listfn (a : l) @ n = if (n = 0) a (listfn l @ (n - 1)) $ =
'(syl5eq (appneq1 @ !! listfnS i) @
  sylbir elupto @ apprlame @ ifeqd eqeq1 eqidd @ appeq2d subeq1);

theorem listfnS0: $ listfn (a : l) @ 0 = a $ = '(eqtr (listfnSval lt01S) (ifpos eqid));

theorem listfnSS: $ listfn (a : l) @ suc n = listfn l @ n $ =
'(cases
  (syl6eq (appeq2 sucsub1) @ syl6eq (ifneg peano1) @ sylbi ltsuc listfnSval)
  (eqtr4d
    (sylbir (noteq @ bitr (eleq2 dmlistfn) @
      bitr elupto @ bitr4 (lteq2 lenS) ltsuc) ndmapp)
    (sylbir (noteq @ bitr (eleq2 dmlistfn) elupto) ndmapp)));

--| `nth n l` is the element of list `l` at position `n`,
--| returning `0` (i.e. `none`) if the index is out of range.
--| * `nth n 0 = none`
--| * `nth 0 (a : l) = some a`
--| * `nth (n+1) (a : l) = nth n l`
--|
--| `nth : nat -> List A -> Option A`
@_ abstract def nth (n l: nat): nat = $ if (n < len l) (suc (listfn l @ n)) 0 $;

pub theorem nth0 (n: nat): $ nth n 0 = 0 $ = '(ifneg @ mtbir (lteq2 len0) lt02);
pub theorem nthZ (a l: nat): $ nth 0 (a : l) = suc a $ =
'(eqtr (ifpos @ mpbir (lteq2 lenS) lt01S) @ suceq listfnS0);
pub theorem nthS (n a l: nat): $ nth (suc n) (a : l) = nth n l $ =
'(cases
  (eqtr4d (sylbi (bitr4 ltsuc @ lteq2 lenS) ifpos) @ syl6eqr (suceq listfnSS) ifpos)
  (eqtr4d (sylbi (noteq @ bitr4 ltsuc @ lteq2 lenS) ifneg) ifneg));

theorem nthne0: $ nth n l != 0 <-> n < len l $ =
'(ibii (con1 ifneg) @ syl sucne0 ifpos);

theorem ntheq0: $ nth n l = 0 <-> len l <= n $ =
'(bicom @ bitr lenlt @ con1b nthne0);

theorem lmemnth: $ a IN l <-> E. n nth n l = suc a $ =
(named @ induct '(listind) 'l
  '(binth lmem0 @ nexi @ necom @ mpbir (neeq2 nth0) peano1)
  '(syl5bb lmemS @ syl6bb (bitr3 exor @ exeqi @ bitr3 andir (bian1 em)) @ oreqd
    (a1i @ bicom @ exeqe @ syl6bb eqcomb @ syl6bb peano2 @ eqeq1d @ syl6eq nthZ ntheq1)
    (bi1 @ bieq2 @ bitr4 (cbvex @ eqeq1d ntheq1) @
      bitr (biexexi @ biexan1a (a1i exsuc)) @
      exeqi @ exeqe @ eqeq1d @ syl6eq nthS ntheq1)));

theorem allnth: $ all A l <-> A. n A. x (nth n l = suc x -> x e. A) $ =
'(bitr4 (aleqi @ imeq1i lmemnth) @ bitr4 alcomb @ aleqi eexb);

theorem nthlmem: $ nth n l = suc a -> a IN l $ =
(named '(sylibr lmemnth @ iexe @ eqeq1d ntheq1));

theorem appendnth1: $ i < len l1 -> nth i (l1 ++ l2) = nth i l1 $ =
(named @ focus
  (def h '(imeqd lteq1 @ eqeqd ntheq1 ntheq1))
  '(eale ,h _)
  (induct '(listind) 'l1
    '(ax_gen @ sylbi (lteq2 len0) @ absurd lt02)
    '(sylbi (cbval ,h) @ iald @ casesd _ _))
  '(a1i @ a1d @ syl5eq (ntheq2 appendS) @ eqtr4d ntheq1 @ syl6eq (eqtr4 nthZ nthZ) ntheq1)
  '(syl5bi exsuc @ sylibr eexb @ alimi @ com12 @ bi2d @
    imeqd (syl5bb (lteq2 lenS) @ syl6bbr ltsuc lteq1) @
    eqeqd (syl5eq (ntheq2 appendS) @ syl6eq nthS ntheq1) (syl6eq nthS ntheq1)));

theorem appendnth2_: $ nth (len l1 + i) (l1 ++ l2) = nth i l2 $ =
(named @ induct '(listind) 'l1
  '(ntheq (eqtr (addeq1 len0) add01) append0)
  '(syl5eq (eqtr (ntheq (eqtr (addeq1 lenS) addS1) appendS) nthS) id));

theorem appendnth2: $ len l1 <= i -> nth i (l1 ++ l2) = nth (i - len l1) l2 $ =
'(syl6eq appendnth2_ @ ntheq1d @ eqcomd pncan3);

--| `repeat a n` is the list of `n` repetitions of `a`.
--|
--| `repeat : A -> nat -> List A`
@_ abstract def repeat (a n: nat): nat = $ rec 0 (\ x, a : x) n $;
pub theorem repeat0 (a: nat): $ repeat a 0 = 0 $ =  (named 'rec0);
pub theorem repeatS (a n: nat): $ repeat a (suc n) = a : repeat a n $ =
'(eqtr recS @ ! applame (repeat a n) _ x _ conseq2);
theorem repeat1: $ repeat a 1 = a : 0 $ =
'(eqtr repeatS @ conseq2 repeat0);

theorem repeatlen: $ len (repeat a n) = n $ =
(named @ induct '(ind) 'n '(eqtr (leneq repeat0) len0)
  '(syl5eq (leneq repeatS) @ syl5eq lenS suceq));

theorem repeatadd: $ repeat a (m + n) = repeat a m ++ repeat a n $ =
(named @ induct '(ind) 'm
  '(eqtr4 (repeateq2 add01) @ eqtr (appendeq1 repeat0) append0)
  '(eqtr4g (repeateq2 addS1) (appendeq1 repeatS) @
    eqtr4g repeatS appendS conseq2));

theorem repeatT: $ a e. A -> repeat a n e. List A $ =
(named @ induct '(indd) 'n
  '(a1i @ mpbir (eleq1 repeat0) elList0)
  '(bi2 @ bitr (eleq1 repeatS) elListS));

theorem repeatArray: $ a e. A -> repeat a n e. Array A n $ =
'(sylibr elArray @ iand repeatT @ a1i repeatlen);

@_ local def grecaux1 (K: set) (x z n: nat): nat =
$ recn z (\\ u, \ i, K @ (x - suc u, i)) n $;

theorem grecaux10: $ grecaux1 K x k 0 = k $ = (named 'recn0);
theorem grecaux1S: $ grecaux1 K x k (suc n) =
  K @ (x - suc n, grecaux1 K x k n) $ =
(named '(eqtr recnS @ ! appslame _ $ grecaux1 K x k n $ _ _ _ @
  applamed @ appeq2d @ preqd (subeq2d @ suceqd anl) anr));

theorem grecaux1Sx: $ grecaux1 K (suc x) k (suc n) = grecaux1 K x (K @ (x, k)) n $ =
(induct '(!! ind a b) 'n
  '(eqtr grecaux1S @ eqtr4 (appeq2 @ preq (eqtr subSS sub02) grecaux10) grecaux10)
  '(eqtr4g grecaux1S grecaux1S @ appeq2d @ preqd (a1i subSS) id));

@_ local def grecaux2 (z: nat) (K F: set) (x n k: nat): nat =
$ recn z (\\ u, \ i, F @ (u, grecaux1 K x k (x - suc u), i)) n $;

theorem grecaux20: $ grecaux2 z K F x 0 k = z $ = (named 'recn0);
theorem grecaux2S: $ grecaux2 z K F x (suc n) k =
  F @ (n, grecaux1 K x k (x - suc n), grecaux2 z K F x n k) $ =
(named '(eqtr recnS @ ! appslame _ $ grecaux2 z K F x n k $ _ _ _ @
  applamed @ appeq2d @ preqd anl @
  preqd (grecaux1eq4d @ subeq2d @ suceqd anl) anr));

theorem grecaux2Sx: $ n <= x -> grecaux2 z K F (suc x) n k = grecaux2 z K F x n (K @ (x, k)) $ =
(induct '(!! indlt a b) 'n
  '(a1i @ eqtr4 grecaux20 grecaux20)
  '(eqtr4g grecaux2S grecaux2S @ appeq2d @ preq2d @
    preqd (anwl @ syl6eq grecaux1Sx @ grecaux1eq4d @ syl5eq subSS @
      syl eqsub1 @ syl5eq addSass @ syl npcan @ impcom letr) @
    anr));

--| General recursion operator:
--| * `grec 0 k = z`
--| * `grec (n+1) k = F n k (grec n (K n k))`
@_ local def grec (z: nat) (K F: set) (n k: nat): nat = $ grecaux2 z K F n n k $;

theorem grec0: $ grec z K F 0 k = z $ = 'grecaux20;

theorem grecS: $ grec z K F (suc n) k = F @ (n, k, grec z K F n (K @ (n, k))) $ =
'(eqtr grecaux2S @ appeq2 @ preq2 @ preq (eqtr (grecaux1eq4 subid) grecaux10) (grecaux2Sx leid));

@_ local def rev (l: nat): nat = $ lrec 0 (\\ a, \\ z, \ ih, ih |> a) l $;

theorem rev0: $ rev 0 = 0 $ = (named 'lrec0);
theorem revS: $ rev (a : l) = rev l |> a $ =
(named '(! eqtr _ $ _ @ (_, _, rev l) $ _ lrecS @
  appslame @ appslamed @ applamed @ snoceqd anr anll));

theorem revsn: $ rev (a : 0) = a : 0 $ =
'(eqtr revS @ eqtr (snoceq1 rev0) snoc0);

theorem revappend: $ rev (l1 ++ l2) = rev l2 ++ rev l1 $ =
(named @ induct '(listind) 'l1
  '(eqtr4 (reveq append0) @ eqtr (appendeq2 rev0) append02)
  '(syl5eq (eqtr (reveq appendS) revS) @
    syl6eqr (appendeq2 revS) @ syl6eqr appendsnoc snoceq1));

theorem revsnoc: $ rev (l |> a) = a : rev l $ =
'(eqtr revappend @ eqtr (appendeq1 revsn) @ eqtr appendS @ conseq2 append0);

theorem revrev: $ rev (rev l) = l $ =
(named @ induct '(listind) 'l
  '(eqtr (reveq rev0) rev0)
  '(syl5eq (reveq revS) @ syl5eq revsnoc conseq2));

theorem revinj: $ rev l = rev l2 <-> l = l2 $ =
'(ibii (sylib (eqeq revrev revrev) reveq) reveq);

theorem reveq0: $ rev l = 0 <-> l = 0 $ = '(bitr3 (eqeq2 rev0) revinj);

theorem exsnoc: $ l != 0 <-> E. l2 E. a l = l2 |> a $ =
(named '(bitr3 (noteq reveq0) @ bitr excons @ biexexi @
  bitr (exeqi @ bitr (eqeq2 @ eqtr3 revrev (reveq revS)) revinj) @
  ibii (eex @ iexe @ eqeq2d snoceq1)
    (eex @ iexe @ eqeq2d @ snoceq1d @ syl6eq revrev reveq)));

theorem snocinj: $ l1 |> a = l2 |> b <-> l1 = l2 /\ a = b $ =
'(bitr3 (eqeq (eqtr revS @ snoceq1 revrev) (eqtr revS @ snoceq1 revrev)) @
  bitr revinj @ bitr consinj @ bitr ancomb @ aneq1i revinj);

theorem appendcan2: $ a ++ c = b ++ c <-> a = b $ =
'(bitr3 revinj @ bitr (eqeq revappend revappend) @ bitr appendcan1 revinj);

--| `map F l` is the list obtained by applying the function `F`
--| to every element of the list `l` to get another of the same length.
--| * `map F 0 = 0`
--| * `map F (a : l) = F a : map F l`
--|
--| `map : (A -> B) -> list A -> list B`
@_ abstract def map (F: set) (l: nat): nat =
$ lrec 0 (\\ a, \\ z, \ ih, F @ a : ih) l $;
pub theorem map0 (F: set): $ map F 0 = 0 $ = (named 'lrec0);
pub theorem mapS (F: set) (a l: nat):
  $ map F (a : l) = F @ a : map F l $ =
(named '(! eqtr _ $ _ @ (_, _, map F l) $ _ lrecS @
  appslame @ appslamed @ applamed @ conseqd (appeq2d anll) anr));

theorem maplen: $ len (map F l) = len l $ =
(named @ induct '(listind) 'l
  '(leneq map0)
  '(eqtr4g (eqtr (leneq mapS) lenS) lenS suceq));

theorem mapnth: $ nth n l = suc a -> nth n (map F l) = suc (F @ a) $ =
(named
  (def h '(imeqd (eqeq1d ntheq1) (eqeq1d ntheq1)))
  '(eale ,h ,(induct '(listind) 'l
    '(ax_gen @ absurd @ mt2 sucne0 nth0)
    '(sylbi (cbval ,h) @ iald @ casesd
      (a1i @ mpbiri (syl5eq nthZ @ sylbi peano2 @ suceqd appeq2) @
        imeqd (eqeq1d @ syl6eq nthZ ntheq1) (eqeq1d @ syl6eq (ntheq2 mapS) ntheq1))
      (syl5bi exsuc @ syl6 (eex @ rsyl ancom @ bi2a @ imeqd
          (eqeq1d @ syl6eq nthS ntheq1)
          (eqeq1d @ syl5eq (ntheq2 mapS) @ syl6eq nthS ntheq1))
        alexan)))));

theorem mapnthb: $ nth n (map F l) = suc b <-> E. a (nth n l = suc a /\ b = F @ a) $ =
'(ibii
  (mpd (sylib exsuc @ sylibr nthne0 @ sylib (lteq2 maplen) @ sylib nthne0 sucne0) @
    eximd @ exp @ iand anr @ sylib peano2 @ eqtr3d anl @ anwr mapnth)
  (eex @ eqtr4d (anwl mapnth) (suceqd anr)));

theorem lmemmapi: $ a IN l -> F @ a IN map F l $ =
(named '(sylbi lmemnth @ eex @ syl nthlmem mapnth));

theorem lmemmap: $ b IN map F l <-> E. a (a IN l /\ b = F @ a) $ =
(named '(bitr lmemnth @ bitr4 (exeqi mapnthb) @ biexexi @ biexan1i lmemnth));

--| `ljoin L` is the "join" operation of the list monad:
--| it appends all the elements of the list of lists `L`.
--| * `ljoin 0 = 0`
--| * `ljoin (l : L) = l ++ ljoin L`
--|
--| `ljoin : list (list A) -> list A`
@_ abstract def ljoin (L: nat): nat = $ lrec 0 (\\ a, \\ z, \ ih, a ++ ih) L $;
pub theorem ljoin0: $ ljoin 0 = 0 $ = (named 'lrec0);
pub theorem ljoinS (l L: nat): $ ljoin (l : L) = l ++ ljoin L $ =
(named '(! eqtr _ $ _ @ (_, _, ljoin L) $ _ lrecS @
  appslame @ appslamed @ applamed @ appendeqd anll anr));

@_ local def nztails (L: nat): nat = $ lrec 0 (\\ a, \\ z, \ ih, (a, z) : ih) L $;
theorem nztails0: $ nztails 0 = 0 $ = (named 'lrec0);
theorem nztailsS (l L: nat): $ nztails (l : L) = (l, L) : nztails L $ =
(named '(! eqtr _ $ _ @ (_, _, nztails L) $ _ lrecS @
  appslame @ appslamed @ applamed @ conseqd (preqd anll anlr) anr));

@_ local def lfnaux (F: set) (k n: nat): nat =
$ grec 0 (\\ _1, \ x, suc x) (\\ _2, \\ i, \ ih, F @ i : ih) n k $;
theorem lfnaux0: $ lfnaux F k 0 = 0 $ = (named 'grec0);
theorem lfnauxS: $ lfnaux F k (suc n) = F @ k : lfnaux F (suc k) n $ =
(named '(eqtr grecS @
  eqtr (appeq2 @ preq2 @ preq2
    {(greceq5 @ appslame @ applamed @ suceqd anr) : $ _ = lfnaux _ _ _ $}) @
  appslame @ appslamed @ applamed @ conseqd (appeq2d anlr) anr));

theorem lfnauxshift:
  $ A. i F1 @ (k1 + i) = F2 @ (k2 + i) ->
    lfnaux F1 k1 n = lfnaux F2 k2 n $ =
(named @ focus
  (def h '(imeqd
    (aleqd @ eqeqd (appeq2d @ addeq1d anl) (appeq2d @ addeq1d anr))
    (eqeqd (lfnauxeq2d anl) (lfnauxeq2d anr))))
  (def h2 '(eqeqd (appeq2d addeq2) (appeq2d addeq2)))
  '(ealie (ealde @ bi1d ,h) _)
  @ induct '(ind) 'n
  '(ax_gen @ ax_gen @ a1i @ eqtr4 lfnaux0 lfnaux0)
  '(sylbi (cbval @ cbvald ,h) @ iald @ iald @
    rsyl (ealie @ ealde @ bi1d ,h) @
    rsyl (imim1i @ sylbi (cbval ,h2) @ iald @
      sylibr (eqeq (appeq2 addSass) (appeq2 addSass)) @ eale ,h2) @
    a2i @ exp @ eqtr4g lfnauxS lfnauxS @
    conseqd (anwl @ eale @
      eqeqd (appeq2d @ syl6eq add0 addeq2) (appeq2d @ syl6eq add0 addeq2)) anr));

theorem lfnauxlen: $ len (lfnaux F k n) = n $ =
(named
  (def h '(aleqd @ eqeqd (leneqd lfnauxeq3) id))
  '(eale (eqeq1d @ leneqd lfnauxeq2) ,(induct '(ind) 'n
    '(ax_gen @ eqtr (leneq lfnaux0) len0)
    '(sylbi (cbval @ eqeq1d @ leneqd lfnauxeq2) @
      iald @ syl5eq (leneq lfnauxS) @ syl5eq lenS @ suceqd @
      eale @ eqeq1d @ leneqd lfnauxeq2))));

theorem lfnauxnth: $ i < n -> nth i (lfnaux F k n) = suc (F @ (k + i)) $ =
(named
  (def h '(imeqd (lteq1d anl) @
    eqeqd (ntheqd anl (lfnauxeq2d anr)) (suceqd @ appeq2d @ addeqd anr anl)))
  '(ealie (ealde @ bi1d ,h) ,(induct '(ind) 'n
    '(ax_gen @ ax_gen @ absurd lt02)
    '(sylbi (cbval @ cbvald ,h) @ iald @ ialda @
      syl5eq (ntheq2 lfnauxS) @ casesd
        (exp @ eqtr4d (syl6eq nthZ @ ntheq1d anr) @ suceqd @ appeq2d @ syl6eq add02 @ addeq2d anr)
        (syl5bi exsuc @ eexdh (nfan nfal1 nfv) nfv @ exp @
          eqtrd (ntheq1d anr) @ syl5eq nthS @
          eqtr4d (mpd (sylibr ltsuc @ mpbid (lteq1d anr) anlr) @ rsyl (anwll eal) @
            eale (imeq2d (eqeqd (ntheq2d lfnauxeq2) (suceqd @ appeq2d addeq1)))) @
          suceqd @ appeq2d @ syl6eqr addSass @ addeq2d anr)))));

@_ local def lfn (F: set) (n: nat): nat = $ lfnaux F 0 n $;

theorem lfn0: $ lfn F 0 = 0 $ = 'lfnaux0;
theorem lfnS: $ lfn F (suc n) = F @ 0 : lfn (\ i, F @ suc i) n $ =
(named '(eqtr4 lfnauxS @ conseq2 @ lfnauxshift @
  ax_gen @ applame @ appeq2d @ syl6eqr addS1 suceq));

theorem lenlfn: $ len (lfn F n) = n $ = 'lfnauxlen;
theorem nthlfn: $ i < n -> nth i (lfn F n) = suc (F @ i) $ =
'(syl6eq (suceq @ appeq2 add01) lfnauxnth);

theorem lfnnth: $ lfn (\ i, nth i l - 1) (len l) = l $ =
(named @ induct '(listind) 'l
  '(eqtr (lfneq2 len0) lfnaux0)
  '(syl5eq (lfneq2 lenS) @ syl5eq lfnS @ syl5eq
    (conseq
      (applame @ syl6eq sucsub1 @ subeq1d @ syl6eq nthZ ntheq1)
      (lfneq1 @ eqstr
        (lameqi @ applame @ subeq1d @ syl6eq nthS ntheq1)
        (cbvlam @ subeq1d ntheq1)))
    conseq2));

theorem nthext2d {i}
  (h1: $ G -> len l1 = n $)
  (h2: $ G -> len l2 = n $)
  (h3: $ G /\ i < n -> nth i l1 = nth i l2 $): $ G -> l1 = l2 $ =
(focus
  (have 'h $ G -> nth i l1 = nth i l2 $
    '(casesda h3 @ eqtr4d
      (imp @ con1d @ syl5bi nthne0 @ bi1d @ lteq2d h1)
      (imp @ con1d @ syl5bi nthne0 @ bi1d @ lteq2d h2)))
  '(eqtr3g lfnnth lfnnth @ lfneqd (lameqd @ subeq1d h) (eqtr4d h1 h2)));

theorem nthext2 {i} (h1: $ len l1 = n $) (h2: $ len l2 = n $)
  (h3: $ i < n -> nth i l1 = nth i l2 $): $ l1 = l2 $ =
'(trud @ nthext2d (a1i h1) (a1i h2) (anwr h3));

theorem nthext: $ l1 = l2 <-> A. n nth n l1 = nth n l2 $ =
(named @ focus
  '(ibii (iald ntheq2) @ nthext2d _ eqidd @ anwl @ eale @ eqeqd ntheq1 ntheq1)
  '(sylibr eqallt1 @ alimi @ bitr3g nthne0 nthne0 neeq1));

@_ local def zip (l1 l2: nat): nat =
$ lfn (\ i, nth i l1 - 1, nth i l2 - 1) (min (len l1) (len l2)) $;

theorem ziplen: $ len (zip l1 l2) = min (len l1) (len l2) $ =
(named 'lenlfn);

theorem zipnth (h1: $ G -> nth i l1 = suc a $) (h2: $ G -> nth i l2 = suc b $):
  $ G -> nth i (zip l1 l2) = suc (a, b) $ =
'(eqtrd (syl nthlfn @ sylibr ltmin @ iand
    (sylib nthne0 @ syl sucne0 h1)
    (sylib nthne0 @ syl sucne0 h2)) @
  suceqd @ !! applamed x ,(let
    ([(f h) '(syl6eq sucsub1 @ subeq1d @ eqtrd (ntheq1d anr) (anwl ,h))])
    '(preqd ,(f 'h1) ,(f 'h2))));

theorem zip01: $ zip 0 l = 0 $ = '(mpbi leneq0 @ eqtr ziplen @ eqtr (mineq1 len0) @ eqmin1 le01);
theorem zip02: $ zip l 0 = 0 $ = '(mpbi leneq0 @ eqtr ziplen @ eqtr (mineq2 len0) @ eqmin2 le01);
theorem zipS: $ zip (a : l1) (b : l2) = (a, b) : zip l1 l2 $ =
(focus
  '(!! nthext2 n
    (eqtr ziplen @ eqtr4 (mineq lenS lenS) minS)
    (eqtr lenS @ suceq ziplen)
    ,(induct '(!! ind m n) 'n
      '(a1i @ eqtr4 (trud @ zipnth (a1i nthZ) (a1i nthZ)) nthZ)
      '(a1i @ sylbir ltsuc @ syl6eqr nthS @ sylbi ltmin _)))
  (have 'h1 '(eqcomd @ syl sub1can @ sylibr nthne0 anl))
  (have 'h2 '(eqcomd @ syl sub1can @ sylibr nthne0 anr))
  '(eqtr4d (zipnth (syl5eq nthS h1) (syl5eq nthS h2)) (zipnth h1 h2)));

@_ local def take (l n: nat): nat =
$ lfn (\ i, nth i l - 1) (min (len l) n) $;

@_ local def drop (l n: nat): nat =
$ lfn (\ i, nth (i + n) l - 1) (len l - n) $;

theorem takelen: $ len (take l n) = min (len l) n $ = (named 'lenlfn);
theorem droplen: $ len (drop l n) = len l - n $ = (named 'lenlfn);

theorem takenth: $ i < n -> nth i (take l n) = nth i l $ =
'(mpi leorlt @ eorda
  (eqtr4d
    (sylibr ntheq0 @ anwr @ letr @ mpbir (leeq1 takelen) minle1)
    (sylibr ntheq0 anr))
  (eqtrd (rsyl ancom @ sylbir ltmin nthlfn) @
    eqtrd (suceqd @ !! applamed x @ subeq1d @ ntheq1d anr) @
    syl sub1can @ sylibr nthne0 anr));

theorem takenth0: $ n <= i -> nth i (take l n) = 0 $ =
'(sylibr ntheq0 @ letr @ mpbir (leeq1 takelen) minle2);

theorem dropnth: $ nth i (drop l n) = nth (i + n) l $ =
'(eor
  (eqtr4d (sylibr ntheq0 @ sylibr (leeq1 droplen) @ bi2i lesubadd) (bi2i ntheq0))
  (eqtrd (sylbi ltaddsub nthlfn) @
    eqtrd (suceqd @ !! applamed x @ subeq1d @ ntheq1d @ addeq1d anr) @
    sylbir nthne0 sub1can)
  leorlt);

theorem takedrop: $ take l n ++ drop l n = l $ =
'(!! nthext2 i (eqtr appendlen @ eqtr (addeq takelen droplen) minaddsub) eqid @
  mpi ltorle @ eorda
    (eqtrd (sylbir (bitr (lteq2 takelen) ltmin) appendnth1) @ anwr takenth)
    (eqtrd (syl appendnth2 @ anwr @ letr @ mpbir (leeq1 takelen) minle2) @
      syl5eq dropnth @ ntheq1d @
      eqtrd (addeq1d @ subeq2d @ syl5eq takelen @ syl eqmin2 @ letrd anr @ anwl ltle) @
      anwr npcan));

theorem takeArray: $ m <= n /\ l e. Array A n -> take l m e. Array A m $ =
'(sylibr elArray @ iand
  (anld @ sylib appendT @ sylibr (eleq1 takedrop) @ anwr elArrayList)
  (syl5eq takelen @ syl eqmin2 @ mpbird (leeq2d @ anwr elArraylen) anl));

theorem dropArray: $ l e. Array A (m + n) -> drop l m e. Array A n $ =
'(sylibr elArray @ iand
  (anrd @ sylib appendT @ sylibr (eleq1 takedrop) elArrayList)
  (syl5eq droplen @ syl6eq pncan2 @ subeq1d elArraylen));

theorem take0: $ take l 0 = 0 $ =
'(mpbi leneq0 @ eqtr takelen @ mpbi le02 minle2);

theorem drop0: $ drop l 0 = l $ =
'(eqtr3 append0 @ eqtr3 (appendeq1 take0) takedrop);

theorem dropall: $ len l <= n -> drop l n = 0 $ =
'(sylib leneq0 @ syl5eq droplen @ bi1i lesubeq0);

theorem takeall: $ len l <= n -> take l n = l $ =
'(syl5eqr append02 @ syl6eq takedrop @ appendeq2d @ eqcomd dropall);

theorem takemin: $ take l (min (len l) n) = take l n $ =
'(eor (takeeq2d eqmin2)
  (eqtr4d (takeeq2d eqmin1) @ syl6eqr (takeall leid) takeall) leorle);

theorem takeappend1: $ n <= len l1 -> take (l1 ++ l2) n = take l1 n $ =
(named '(nthext2d
  (syl5eq takelen @ syl eqmin2 @ mpi (mpbir (leeq2 appendlen) leaddid1) letr)
  (syl5eq takelen @ eqmin2)
  (eqtr4d (anwr takenth) @ eqtr4d (anwr takenth) @ syl appendnth1 @ impcom ltletr)));

theorem appendinj1: $ len l1 = len r1 -> (l1 ++ l2 = r1 ++ r2 <-> l1 = r1 /\ l2 = r2) $ =
(focus
  (suffices 'h)
  '(ibida (iand h @ sylib appendcan1 @ eqtr4d anr @ appendeq1d h) @ appendeqd anrl anrr)
  (def h2 '(eqtr (takeappend1 leid) (takeall leid)))
  '(sylib (eqeq ,h2 ,h2) @ takeeqd anr anl));

theorem appendinj2: $ len l2 = len r2 -> (l1 ++ l2 = r1 ++ r2 <-> l1 = r1 /\ l2 = r2) $ =
'(ibida (mpbid (syl appendinj1 @ sylib addcan1 @
    eqtrd (eqtr3g appendlen appendlen @ leneqd anr) @
    addeq2d @ eqcomd anl) anr) @
  appendeqd anrl anrr);

theorem eqappendlem: $ len r1 <= len l1 /\ l1 ++ l2 = r1 ++ r2 ->
  E. a (l1 = r1 ++ a /\ r2 = a ++ l2) $ =
(focus
  (have 'h1 'takedrop)
  (have 'h2 $ _ -> l1 = r1 ++ take r2 (len l1 - len r1) /\
                   l2 = drop r2 (len l1 - len r1) $
    '(mpbid (syl appendinj1 @ syl6eqr appendlen @ eqcomd @
      eqtrd (addeq2d @ syl5eq takelen @ syl eqmin2 @
        sylibr lesubadd2 @ mpbii leaddid1 @ leeq2d @
        eqtr3g appendlen appendlen @ leneqd anr) @ anwl pncan3) @
      syl6eqr appendass @ syl6eqr (appendeq2 h1) anr))
  '(syl (iexe ,eqtac) @ iand (anld h2) (eqcomd @ syl6eq h1 @ appendeq2d @ anrd h2)));

theorem eqappend: $ l1 ++ l2 = r1 ++ r2 <->
  E. a (r1 = l1 ++ a /\ l2 = a ++ r2 \/ l1 = r1 ++ a /\ r2 = a ++ l2) $ =
(focus
  (def (f x) '(mpbiri ,x ,eqtac))
  '(ibii _ @ eex @ eor ,(f '(eqcom appendass)) ,(f 'appendass))
  (def (f x) '(exp @ rsyl eqappendlem @ eximi ,x))
  '(eor (syl5 eqcom ,(f 'orl)) ,(f 'orr) leorle));

--| `sublistAt n L1 L2` means that `L2 = L1[n..n+a]`
--| where `a` is the length of `L2`.
--|
--| `sublistAt : nat -> List A -> List A -> Bool`
@_ def sublistAt (n L1 L2: nat): wff =
$ E. l E. r (L1 = l ++ L2 ++ r /\ len l = n) $;

theorem sublistAtT: $ sublistAt n L1 L2 -> L1 e. List A -> L2 e. List A $ =
(named '(eex @ eex @ exp @ anld @ sylib appendT @ anrd @ sylib appendT @
  mpbid (eleq1d anll) anr));

theorem sublistAt_append:
  $ sublistAt n l (l1 ++ l2) <-> sublistAt n l l1 /\ sublistAt (n + len l1) l l2 $ =
(focus
  '(!! bian2exi a @ bitr4 _ @ !! biexan2i b excomb)
  '(bitr2 (bian2exi @ bian21i exan2) @ biexan1a @ exeqd @
    syl6bb (exeqe @ eqeq2d @ appendeq2d @ syl6eqr appendass appendeq2) @
    syl5bbr exan2 @ !! exeqd b2 @ syl6bb ancomb @ aneq2da @
    bitrd _ @ anwl bian2)
  '(syl6bb (exeqe @ aneq2d @ syl6bb addcan1 @ eqeq1d @ syl6eq appendlen leneq) @
    !! exeqd a1 @ syl6bb (aneq1i eqcomb) @ bian11da @
    bitrd (eqeq1d @ syl6eqr appendass anlr) @
    syl appendinj1 @ syl5eq appendlen @ eqtr4d (addeq1d anll) anr));

theorem sublistAt_len_le: $ sublistAt n L1 L2 -> n + len L2 <= len L1 $ =
(named '(eex @ eex @ mpbii (mpbir (leeq2 appendlen) leaddid1) @
  syl5bb leadd2 @ leeqd (addeq1d anr) @ syl5eqr appendlen @ leneqd @ eqcomd anl));

theorem sublistAt_left: $ sublistAt n L1 L2 -> sublistAt n (L1 ++ l) L2 $ =
(named '(eximi @ eex @ !! iexde x @
  iand (mpbiri (eqtr appendass @ appendeq2 appendass) ,eqtac) anlr));

theorem sublistAt_right: $ sublistAt n L1 L2 -> sublistAt (len l + n) (l ++ L1) L2 $ =
'(!! eex x @ !! iexde r @ impcom @ !! eximd y @
  mpbiri (anim (syl6eqr appendass appendeq2) (syl5eq appendlen addeq2)) ,eqtac);

theorem sublistAt_id: $ sublistAt 0 L L $ =
'(!! iexie x @ !! iexde y @
  mpbiri (ian (eqtr2 append0 append02) len0) ,eqtac);

--| `L1, L2 e. all2 R` means that `L1` and `L2` are
--| lists of the same length that are pairwise related by `R`.
--|
--| `all2 : (A -> B -> Bool) -> (list A -> list B -> Bool)`
@_ def all2 (R: set) {.l1 .l2 .x .y .n: nat}: set =
$ S\ l1, {l2 | len l1 = len l2 /\ A. n A. x A. y
  (nth n l1 = suc x -> nth n l2 = suc y -> x, y e. R)} $;

theorem elall2:
  $ l1, l2 e. all2 R <-> len l1 = len l2 /\ A. n A. x A. y
    (nth n l1 = suc x -> nth n l2 = suc y -> x, y e. R) $ =
'(elsabe @ elabed ,eqtac);

theorem elall22:
  $ l1, l2 e. all2 R <-> len l1 = len l2 /\ A. n A. x
    (nth n l1 = suc x -> A. y (nth n l2 = suc y -> x, y e. R)) $ =
'(bitr elall2 @ aneq2i @ aleqi @ aleqi alim1);

theorem all2ssg:
  $ A. x A. y (x IN l1 /\ y IN l2 -> x, y e. R -> x, y e. S) ->
    l1, l2 e. all2 R -> l1, l2 e. all2 S $ =
'(sylibr (imeqi elall2 elall2) @ anim2d @ !! alimd n @
  al2imi @ al2imi @ sylbi impexp @ a2d @ imim nthlmem @ a2d @ imim1 nthlmem);

theorem all2ss: $ R C_ S -> all2 R C_ all2 S $ =
(named '(ssrd2 @ syl all2ssg @ iald @ iald @ a1d ssel));

theorem all2eqg:
  $ A. x A. y (x IN l1 /\ y IN l2 -> (x, y e. R <-> x, y e. S)) ->
    (l1, l2 e. all2 R <-> l1, l2 e. all2 S) $ =
(begin (def (f x) '(syl all2ssg @ alimi @ alimi @ imim2i ,x))
  '(ibid ,(f 'bi1) ,(f 'bi2)));

theorem all2len: $ l1, l2 e. all2 R -> len l1 = len l2 $ =
(named '(sylbi elall2 anl));

theorem all2i
  (h1: $ G -> nth n l1 = suc a $)
  (h2: $ G -> nth n l2 = suc b $)
  (h: $ G -> l1, l2 e. all2 R $):
  $ G -> a, b e. R $ =
'(mpd h2 @ mpd h1 @
  mpd (anrd @ sylib elall2 h) @ ealde @ ealde @ ealde @ bi1d ,eqtac);

theorem all2com: $ l1, l2 e. all2 (cnv R) <-> l2, l1 e. all2 R $ =
(named '(bitr4 elall22 @ bitr4 elall22 @ aneq eqcomb @ aleqi @
  bitr ralcomb @ raleqi @ raleqi prcnv));

theorem all2cnv: $ all2 (cnv R) == cnv (all2 R) $ =
(named '(eqri2 @ bitr4 all2com prcnv));

theorem all20: $ 0, 0 e. all2 R $ =
(named '(mpbir elall2 @ ian eqid @ ax_gen @ ax_gen @ ax_gen @
  rsyl eqcom @ absurd @ mpbir (neeq2 nth0) peano1));

theorem all201: $ 0, l e. all2 R <-> l = 0 $ =
'(ibii (sylib leneq0 @ syl6eq len0 @ eqcomd all2len) @ mpbiri all20 @ eleq1d preq2);

theorem all202: $ l, 0 e. all2 R <-> l = 0 $ = '(bitr3 all2com all201);

theorem all2S: $ a : l1, b : l2 e. all2 R <->
  a, b e. R /\ l1, l2 e. all2 R $ =
(named @ focus
  (def h '(syl6bb eqcomb @ syl6bb peano2 @ eqeq1d @ syl6eq nthZ ntheq1))
  '(bitr4 elall22 @ bitr (aneq2i elall22) @ bitr4 anlass @
    aneq (bitr (eqeq lenS lenS) peano2) @
    bitr (aleqi @ bitr3 (biim1 em) imor) @ bitr alan @ aneq _ _)
  (focus
    '(aleqe @ syl6bb _ @ aleqd @ imeqd ,h @ syl6bb _ @ aleqd @ imeq1d ,h)
    (swap) '(aleqe ,eqtac) '(aleqe ,eqtac))
  (focus
    '(bitr (aleqi @ bitr (imeq1i exsuc) eexb) @ bitr alcomb @ aleqi @ aleqe @
      aleqd @ imeqd (eqeq1d @ syl6eq nthS ntheq1) @
      aleqd @ imeq1d (eqeq1d @ syl6eq nthS ntheq1))));

theorem all2S1: $ a : l1, l2 e. all2 R <->
  E. b E. l2_ (l2 = b : l2_ /\ (a, b e. R /\ l1, l2_ e. all2 R)) $ =
'(bitr3 (bian1a @ sylib excons @ sylib (noteq leneq0) @
    mpbii peano1 @ neeq1d @ syl5eqr lenS all2len) @
  bitr3 exan2 @ exeqi @ bitr3 exan2 @ exeqi @
  aneq2a @ syl6bb all2S @ eleq1d preq2);

theorem all2all2: $ l1, l2 e. all2 (S\ x, A) -> all A l2 $ =
(named '(sylibr allnth @ sylbi elall22 @ imp @ !! alimd n @
  syl5bi (raleqi @ raleqi @ elsabe biidd) @ syl5bi ralcomb @ alimd @ a2d @ exp @
  syl5bir eexb @ syl mpcom @ sylib exsuc @ sylibr nthne0 @
  mpbird (lteq2d anl) @ anwr @ sylib nthne0 sucne0));

theorem all2all1: $ l1, l2 e. all2 (S\ x, {y | x e. A}) -> all A l1 $ =
'(sylbir all2com @ sylbi (eleq2 @ all2eq @ eqstr cnvopab @ sabeqi abid2) all2all2);

--| `L1, L2 e. ex2 R` means that `L1` and `L2` are
--| lists of the same length for which some pair is related by `R`.
--|
--| `ex2 : (A -> B -> Bool) -> (list A -> list B -> Bool)`
@_ def ex2 (R: set) {.l1 .l2 .x .y .n: nat}: set =
$ S\ l1, {l2 | len l1 = len l2 /\ E. n E. x E. y
  (nth n l1 = suc x /\ nth n l2 = suc y /\ x, y e. R)} $;

theorem elex2:
  $ l1, l2 e. ex2 R <-> len l1 = len l2 /\ E. n E. x E. y
    (nth n l1 = suc x /\ nth n l2 = suc y /\ x, y e. R) $ =
'(elsabe @ elabed ,eqtac);

theorem elex22:
  $ l1, l2 e. ex2 R <-> len l1 = len l2 /\ E. n E. x
    (nth n l1 = suc x /\  E. y (nth n l2 = suc y /\ x, y e. R)) $ =
'(bitr elex2 @ aneq2i @ exeqi @ exeqi @ bitr (exeqi anass) exan1);

theorem ex2ssg:
  $ A. x A. y (x IN l1 /\ y IN l2 -> x, y e. R -> x, y e. S) ->
    l1, l2 e. ex2 R -> l1, l2 e. ex2 S $ =
'(sylibr (imeqi elex2 elex2) @ anim2d @ !! eximd n @
  syl exim @ alimi @ syl exim @ alimi @ syl anim2a @ imim1 @ anim nthlmem nthlmem);

theorem ex2eqg:
  $ A. x A. y (x IN l1 /\ y IN l2 -> (x, y e. R <-> x, y e. S)) ->
    (l1, l2 e. ex2 R <-> l1, l2 e. ex2 S) $ =
(begin (def (f x) '(syl ex2ssg @ alimi @ alimi @ imim2i ,x))
  '(ibid ,(f 'bi1) ,(f 'bi2)));

theorem ex2ss: $ R C_ S -> ex2 R C_ ex2 S $ =
(named '(ssrd2 @ syl ex2ssg @ iald @ iald @ a1d ssel));

theorem ex2len: $ l1, l2 e. ex2 R -> len l1 = len l2 $ =
(named '(sylbi elex2 anl));

theorem ex2com: $ l1, l2 e. ex2 (cnv R) <-> l2, l1 e. ex2 R $ =
(named '(bitr4 elex22 @ bitr4 elex22 @ aneq eqcomb @ exeqi @
  bitr rexcomb @ rexeqi @ rexeqi prcnv));

theorem ex2cnv: $ ex2 (cnv R) == cnv (ex2 R) $ =
(named '(eqri2 @ bitr4 ex2com prcnv));

theorem ex201: $ ~ 0, l e. ex2 R $ =
(named '(mt (sylbi elex22 anr) @ nexi @ nexi @ mt2 (anwl sucne0) nth0));

theorem ex202: $ ~ l, 0 e. ex2 R $ = '(mtbi ex2com ex201);

theorem all2nex:
  $ l1, l2 e. all2 (Compl R) <-> len l1 = len l2 /\ ~l1, l2 e. ex2 R $ =
(named @ focus
  '(bitr elall2 @ aneq2a @ syl5bbr _ @ noteqd @ bicomd @ syl5bb elex2 bian1)
  (def h '(bitr3 alnex (aleqi _))) h h h
  '(bitr notan2 @ bitr3 (imeq2i elcpl) impexp));

theorem dfex2_2:
  $ l1, l2 e. ex2 R <-> len l1 = len l2 /\ ~l1, l2 e. all2 (Compl R) $ =
'(bitr3 (bian1a ex2len) @ aneq2a @ syl con2b @ syl5bb all2nex bian1);

theorem ex2nal:
  $ l1, l2 e. ex2 (Compl R) <-> len l1 = len l2 /\ ~l1, l2 e. all2 R $ =
'(bitr dfex2_2 @ aneq2i @ noteqi @ eleq2 @ all2eq cplcpl);

theorem mapeqg: $ all {x | F @ x = G @ x} l -> map F l = map G l $ =
(named @ let ([h '(imeqd alleq2 @ eqeqd mapeq2 mapeq2)])
  '(listind ,h ,h ,h ,h
    (a1i @ eqtr4 map0 map0)
    (rsyl (imim1i @ sylbi allS anr) @ a2i @ rsyl (sylbi allS anl) @ exp @
      eqtr4g mapS mapS @ conseqd (sylib (elabe @ eqeqd appeq2 appeq2) anl) anr)));

@_ local def rlrec (z: nat) (S: set) (n: nat): nat =
$ lrec z (\\ a, \\ l, \ ih, S @ (rev l, a, ih)) (rev n) $;
theorem rlrec0: $ rlrec z S 0 = z $ = (named '(eqtr (lreceq3 rev0) lrec0));
theorem rlrecS: $ rlrec z S (l |> a) = S @ (l, a, rlrec z S l) $ =
(named '(eqtr (lreceq3 revsnoc) @ ! eqtr _ $ _ @ (a, _, rlrec z S l) $ _ lrecS @
  appslame @ appslamed @ applamed @
  appeq2d @ preqd (syl6eq revrev @ reveqd anlr) @ preqd anll anr));

theorem rlistindd {x l a} (n) (px: wff x) (p0 pn: wff) (pl: wff l) (ps: wff a l)
  (hn: $ x = n -> (px <-> pn) $)
  (h0: $ x = 0 -> (px <-> p0) $)
  (hl: $ x = l -> (px <-> pl) $)
  (hs: $ x = l |> a -> (px <-> ps) $)
  (h1: $ G -> p0 $) (h2: $ G /\ pl -> ps $): $ G -> pn $ =
'(!! indstr z w (syl6bb (sbe hn) sbeq1) sbeq1 @ casesda
  (mpbird (sbeq1d anr) @ anwll @ sylibr (sbe h0) h1)
  (mpd (sylib exsnoc anr) @ eexd @ eexd @ anwl @ exp @
    mpbird (syl6bb (sbe hs) @ sbeq1d anr) @
    mpd (mpd (mpbiri snoclt @ lteq2d anr) @
      rsyl anlr @ eale @ imeqd lteq1 @ syl6bb (sbe hl) sbeq1) @
    anwll @ exp h2));

theorem rlistind {x l a} (n) (px: wff x) (p0 pn: wff) (pl: wff l) (ps: wff a l)
  (hn: $ x = n -> (px <-> pn) $)
  (h0: $ x = 0 -> (px <-> p0) $)
  (hl: $ x = l -> (px <-> pl) $)
  (hs: $ x = l |> a -> (px <-> ps) $)
  (h1: $ p0 $) (h2: $ pl -> ps $): $ pn $ =
'(trud @ rlistindd hn h0 hl hs (a1i h1) (anwr h2));