Require Import Coq.ZArith.ZArith.
Require Import Crypto.Specific.X86.Core.
Require Import Crypto.BoundedArithmetic.Interface.

Local Coercion Z.of_nat : nat >-> Z.

Section x86.
  Local Notation n := 64%nat.
  Context (ops : x86.instructions n).
  Definition barrett_reduce64'1 :=
    fun x : (x86.W * x86.W * (x86.W * x86.W) * (x86.W * x86.W * (x86.W * x86.W)))%type =>
      let y :=
  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 6346243789798364141,
  @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 1503914060200516822,
  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
  @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 1152921504606846976)) in
let y0 :=
  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 11508512988225646668,
  @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 12431087832907484326,
  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 18446744073709551615,
  @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 4611686018427387903)) in
let y1 :=
  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
  @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
  @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0)) in
let y2 :=
  let y2 :=
    let (_, y2) :=
      let (xs, x0) := let (x0, _) := x in x0 in
      let (ys, y2) :=
        let (x1, _) :=
          let y2 :=
            let (_, y2) :=
              let y2 :=
                let y2 := x in
                let (high1, high2) := let (_, y3) := y2 in y3 in
                let (_, low2) := let (x1, _) := y2 in x1 in
                (let (high3, high4) := high1 in
                 let (_, low4) := low2 in
                 (let (_, y3) :=
                    @shrdf (@x86.W (Z.of_nat 64) ops) (@x86.shrdf (Z.of_nat 64) ops) high3 low4
                      58 in
                  y3,
                 let (_, y3) :=
                   @shrdf (@x86.W (Z.of_nat 64) ops) (@x86.shrdf (Z.of_nat 64) ops) high4 high3
                     58 in
                 y3),
                let (high3, high4) := high2 in
                let (_, low4) := high1 in
                (let (_, y3) :=
                   @shrdf (@x86.W (Z.of_nat 64) ops) (@x86.shrdf (Z.of_nat 64) ops) high3 low4 58 in
                 y3,
                let (_, y3) :=
                  @shrdf (@x86.W (Z.of_nat 64) ops) (@x86.shrdf (Z.of_nat 64) ops) high4 high3 58 in
                y3)) in
              let y3 := y0 in
              let y4 :=
                (let y4 := let (x1, _) := y2 in x1 in
                 let y5 := let (x1, _) := y3 in x1 in
                 let y6 :=
                   (let (_, y6) :=
                      @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                        (let (x1, _) := y4 in x1) (let (x1, _) := y5 in x1) in
                    y6,
                   let (_, y6) :=
                     @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                       (let (_, y6) := y4 in y6) (let (_, y6) := y5 in y6) in
                   y6) in
                 let y7 :=
                   let (_, y7) :=
                     @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                       (let (_, y7) := y4 in y7) (let (x1, _) := y5 in x1) in
                   y7 in
                 let (_, out) :=
                   let (xs0, x1) := y6 in
                   let (carry, zs) :=
                     let (xs1, x2) := xs0 in
                     let (ys, y8) :=
                       let (r1, _) := y7 in
                       (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                       let (_, y8) :=
                         @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                       y8) in
                     let (carry, zs) :=
                       @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                     let (carry0, z) :=
                       @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y8 carry in
                     (carry0, (zs, z)) in
                   let (carry0, z) :=
                     let (xs1, x2) := x1 in
                     let (ys, y8) :=
                       let (_, r2) := y7 in
                       (let (_, y8) :=
                          @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                        y8, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                     let (carry0, zs0) :=
                       @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                     let (carry1, z) :=
                       @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y8 carry0 in
                     (carry1, (zs0, z)) in
                   (carry0, (zs, z)) in
                 let y8 :=
                   let (_, y8) :=
                     @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                       (let (_, y8) := y5 in y8) (let (x1, _) := y4 in x1) in
                   y8 in
                 let (_, out0) :=
                   let (xs0, x1) := out in
                   let (carry, zs) :=
                     let (xs1, x2) := xs0 in
                     let (ys, y9) :=
                       let (r1, _) := y8 in
                       (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                       let (_, y9) :=
                         @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                       y9) in
                     let (carry, zs) :=
                       @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                     let (carry0, z) :=
                       @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry in
                     (carry0, (zs, z)) in
                   let (carry0, z) :=
                     let (xs1, x2) := x1 in
                     let (ys, y9) :=
                       let (_, r2) := y8 in
                       (let (_, y9) :=
                          @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                        y9, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                     let (carry0, zs0) :=
                       @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                     let (carry1, z) :=
                       @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry0 in
                     (carry1, (zs0, z)) in
                   (carry0, (zs, z)) in
                 out0,
                let y4 := let (_, y4) := y2 in y4 in
                let y5 := let (_, y5) := y3 in y5 in
                let y6 :=
                  (let (_, y6) :=
                     @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                       (let (x1, _) := y4 in x1) (let (x1, _) := y5 in x1) in
                   y6,
                  let (_, y6) :=
                    @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                      (let (_, y6) := y4 in y6) (let (_, y6) := y5 in y6) in
                  y6) in
                let y7 :=
                  let (_, y7) :=
                    @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                      (let (_, y7) := y4 in y7) (let (x1, _) := y5 in x1) in
                  y7 in
                let (_, out) :=
                  let (xs0, x1) := y6 in
                  let (carry, zs) :=
                    let (xs1, x2) := xs0 in
                    let (ys, y8) :=
                      let (r1, _) := y7 in
                      (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                      let (_, y8) :=
                        @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                      y8) in
                    let (carry, zs) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                    let (carry0, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y8 carry in
                    (carry0, (zs, z)) in
                  let (carry0, z) :=
                    let (xs1, x2) := x1 in
                    let (ys, y8) :=
                      let (_, r2) := y7 in
                      (let (_, y8) :=
                         @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                       y8, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                    let (carry0, zs0) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                    let (carry1, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y8 carry0 in
                    (carry1, (zs0, z)) in
                  (carry0, (zs, z)) in
                let y8 :=
                  let (_, y8) :=
                    @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                      (let (_, y8) := y5 in y8) (let (x1, _) := y4 in x1) in
                  y8 in
                let (_, out0) :=
                  let (xs0, x1) := out in
                  let (carry, zs) :=
                    let (xs1, x2) := xs0 in
                    let (ys, y9) :=
                      let (r1, _) := y8 in
                      (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                      let (_, y9) :=
                        @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                      y9) in
                    let (carry, zs) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                    let (carry0, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry in
                    (carry0, (zs, z)) in
                  let (carry0, z) :=
                    let (xs1, x2) := x1 in
                    let (ys, y9) :=
                      let (_, r2) := y8 in
                      (let (_, y9) :=
                         @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                       y9, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                    let (carry0, zs0) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                    let (carry1, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry0 in
                    (carry1, (zs0, z)) in
                  (carry0, (zs, z)) in
                out0) in
              let y5 :=
                let y5 := let (_, y5) := y2 in y5 in
                let y6 := let (x1, _) := y3 in x1 in
                let y7 :=
                  (let (_, y7) :=
                     @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                       (let (x1, _) := y5 in x1) (let (x1, _) := y6 in x1) in
                   y7,
                  let (_, y7) :=
                    @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                      (let (_, y7) := y5 in y7) (let (_, y7) := y6 in y7) in
                  y7) in
                let y8 :=
                  let (_, y8) :=
                    @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                      (let (_, y8) := y5 in y8) (let (x1, _) := y6 in x1) in
                  y8 in
                let (_, out) :=
                  let (xs0, x1) := y7 in
                  let (carry, zs) :=
                    let (xs1, x2) := xs0 in
                    let (ys, y9) :=
                      let (r1, _) := y8 in
                      (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                      let (_, y9) :=
                        @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                      y9) in
                    let (carry, zs) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                    let (carry0, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry in
                    (carry0, (zs, z)) in
                  let (carry0, z) :=
                    let (xs1, x2) := x1 in
                    let (ys, y9) :=
                      let (_, r2) := y8 in
                      (let (_, y9) :=
                         @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                       y9, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                    let (carry0, zs0) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                    let (carry1, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry0 in
                    (carry1, (zs0, z)) in
                  (carry0, (zs, z)) in
                let y9 :=
                  let (_, y9) :=
                    @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                      (let (_, y9) := y6 in y9) (let (x1, _) := y5 in x1) in
                  y9 in
                let (_, out0) :=
                  let (xs0, x1) := out in
                  let (carry, zs) :=
                    let (xs1, x2) := xs0 in
                    let (ys, y10) :=
                      let (r1, _) := y9 in
                      (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                      let (_, y10) :=
                        @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                      y10) in
                    let (carry, zs) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                    let (carry0, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y10 carry in
                    (carry0, (zs, z)) in
                  let (carry0, z) :=
                    let (xs1, x2) := x1 in
                    let (ys, y10) :=
                      let (_, r2) := y9 in
                      (let (_, y10) :=
                         @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                       y10, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                    let (carry0, zs0) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                    let (carry1, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y10 carry0 in
                    (carry1, (zs0, z)) in
                  (carry0, (zs, z)) in
                out0 in
              let (_, out) :=
                let (xs0, x1) := y4 in
                let (carry, zs) :=
                  let (xs1, x2) := xs0 in
                  let (ys, y6) :=
                    let (r1, _) := y5 in
                    (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                    @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                    let (r3, r4) := r1 in (r3, r4)) in
                  let (carry, zs) :=
                    let (xs2, x3) := xs1 in
                    let (ys0, y7) := ys in
                    let (carry, zs) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 false in
                    let (carry0, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y7 carry in
                    (carry0, (zs, z)) in
                  let (carry0, z) :=
                    let (xs2, x3) := x2 in
                    let (ys0, y7) := y6 in
                    let (carry0, zs0) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry in
                    let (carry1, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y7 carry0 in
                    (carry1, (zs0, z)) in
                  (carry0, (zs, z)) in
                let (carry0, z) :=
                  let (xs1, x2) := x1 in
                  let (ys, y6) :=
                    let (_, r2) := y5 in
                    (let (r3, r4) := r2 in (r3, r4),
                    (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                    @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0)) in
                  let (carry0, zs0) :=
                    let (xs2, x3) := xs1 in
                    let (ys0, y7) := ys in
                    let (carry0, zs0) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry in
                    let (carry1, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y7 carry0 in
                    (carry1, (zs0, z)) in
                  let (carry1, z) :=
                    let (xs2, x3) := x2 in
                    let (ys0, y7) := y6 in
                    let (carry1, zs1) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry0 in
                    let (carry2, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y7 carry1 in
                    (carry2, (zs1, z)) in
                  (carry1, (zs0, z)) in
                (carry0, (zs, z)) in
              let y6 :=
                let y6 := let (_, y6) := y3 in y6 in
                let y7 := let (x1, _) := y2 in x1 in
                let y8 :=
                  (let (_, y8) :=
                     @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                       (let (x1, _) := y6 in x1) (let (x1, _) := y7 in x1) in
                   y8,
                  let (_, y8) :=
                    @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                      (let (_, y8) := y6 in y8) (let (_, y8) := y7 in y8) in
                  y8) in
                let y9 :=
                  let (_, y9) :=
                    @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                      (let (_, y9) := y6 in y9) (let (x1, _) := y7 in x1) in
                  y9 in
                let (_, out0) :=
                  let (xs0, x1) := y8 in
                  let (carry, zs) :=
                    let (xs1, x2) := xs0 in
                    let (ys, y10) :=
                      let (r1, _) := y9 in
                      (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                      let (_, y10) :=
                        @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                      y10) in
                    let (carry, zs) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                    let (carry0, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y10 carry in
                    (carry0, (zs, z)) in
                  let (carry0, z) :=
                    let (xs1, x2) := x1 in
                    let (ys, y10) :=
                      let (_, r2) := y9 in
                      (let (_, y10) :=
                         @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                       y10, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                    let (carry0, zs0) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                    let (carry1, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y10 carry0 in
                    (carry1, (zs0, z)) in
                  (carry0, (zs, z)) in
                let y10 :=
                  let (_, y10) :=
                    @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                      (let (_, y10) := y7 in y10) (let (x1, _) := y6 in x1) in
                  y10 in
                let (_, out1) :=
                  let (xs0, x1) := out0 in
                  let (carry, zs) :=
                    let (xs1, x2) := xs0 in
                    let (ys, y11) :=
                      let (r1, _) := y10 in
                      (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                      let (_, y11) :=
                        @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                      y11) in
                    let (carry, zs) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                    let (carry0, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y11 carry in
                    (carry0, (zs, z)) in
                  let (carry0, z) :=
                    let (xs1, x2) := x1 in
                    let (ys, y11) :=
                      let (_, r2) := y10 in
                      (let (_, y11) :=
                         @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                       y11, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                    let (carry0, zs0) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                    let (carry1, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y11 carry0 in
                    (carry1, (zs0, z)) in
                  (carry0, (zs, z)) in
                out1 in
              let (_, out0) :=
                let (xs0, x1) := out in
                let (carry, zs) :=
                  let (xs1, x2) := xs0 in
                  let (ys, y7) :=
                    let (r1, _) := y6 in
                    (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                    @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                    let (r3, r4) := r1 in (r3, r4)) in
                  let (carry, zs) :=
                    let (xs2, x3) := xs1 in
                    let (ys0, y8) := ys in
                    let (carry, zs) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 false in
                    let (carry0, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y8 carry in
                    (carry0, (zs, z)) in
                  let (carry0, z) :=
                    let (xs2, x3) := x2 in
                    let (ys0, y8) := y7 in
                    let (carry0, zs0) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry in
                    let (carry1, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y8 carry0 in
                    (carry1, (zs0, z)) in
                  (carry0, (zs, z)) in
                let (carry0, z) :=
                  let (xs1, x2) := x1 in
                  let (ys, y7) :=
                    let (_, r2) := y6 in
                    (let (r3, r4) := r2 in (r3, r4),
                    (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                    @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0)) in
                  let (carry0, zs0) :=
                    let (xs2, x3) := xs1 in
                    let (ys0, y8) := ys in
                    let (carry0, zs0) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry in
                    let (carry1, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y8 carry0 in
                    (carry1, (zs0, z)) in
                  let (carry1, z) :=
                    let (xs2, x3) := x2 in
                    let (ys0, y8) := y7 in
                    let (carry1, zs1) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry0 in
                    let (carry2, z) :=
                      @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y8 carry1 in
                    (carry2, (zs1, z)) in
                  (carry1, (zs0, z)) in
                (carry0, (zs, z)) in
              out0 in
            y2 in
          let y3 := y in
          let y4 :=
            (let y4 := let (x1, _) := y2 in x1 in
             let y5 := let (x1, _) := y3 in x1 in
             let y6 :=
               (let (_, y6) :=
                  @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                    (let (x1, _) := y4 in x1) (let (x1, _) := y5 in x1) in
                y6,
               let (_, y6) :=
                 @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                   (let (_, y6) := y4 in y6) (let (_, y6) := y5 in y6) in
               y6) in
             let y7 :=
               let (_, y7) :=
                 @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                   (let (_, y7) := y4 in y7) (let (x1, _) := y5 in x1) in
               y7 in
             let (_, out) :=
               let (xs0, x1) := y6 in
               let (carry, zs) :=
                 let (xs1, x2) := xs0 in
                 let (ys, y8) :=
                   let (r1, _) := y7 in
                   (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                   let (_, y8) :=
                     @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                   y8) in
                 let (carry, zs) :=
                   @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                 let (carry0, z) :=
                   @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y8 carry in
                 (carry0, (zs, z)) in
               let (carry0, z) :=
                 let (xs1, x2) := x1 in
                 let (ys, y8) :=
                   let (_, r2) := y7 in
                   (let (_, y8) :=
                      @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                    y8, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                 let (carry0, zs0) :=
                   @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                 let (carry1, z) :=
                   @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y8 carry0 in
                 (carry1, (zs0, z)) in
               (carry0, (zs, z)) in
             let y8 :=
               let (_, y8) :=
                 @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                   (let (_, y8) := y5 in y8) (let (x1, _) := y4 in x1) in
               y8 in
             let (_, out0) :=
               let (xs0, x1) := out in
               let (carry, zs) :=
                 let (xs1, x2) := xs0 in
                 let (ys, y9) :=
                   let (r1, _) := y8 in
                   (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                   let (_, y9) :=
                     @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                   y9) in
                 let (carry, zs) :=
                   @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                 let (carry0, z) :=
                   @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry in
                 (carry0, (zs, z)) in
               let (carry0, z) :=
                 let (xs1, x2) := x1 in
                 let (ys, y9) :=
                   let (_, r2) := y8 in
                   (let (_, y9) :=
                      @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                    y9, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                 let (carry0, zs0) :=
                   @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                 let (carry1, z) :=
                   @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry0 in
                 (carry1, (zs0, z)) in
               (carry0, (zs, z)) in
             out0,
            let y4 := let (_, y4) := y2 in y4 in
            let y5 := let (_, y5) := y3 in y5 in
            let y6 :=
              (let (_, y6) :=
                 @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                   (let (x1, _) := y4 in x1) (let (x1, _) := y5 in x1) in
               y6,
              let (_, y6) :=
                @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                  (let (_, y6) := y4 in y6) (let (_, y6) := y5 in y6) in
              y6) in
            let y7 :=
              let (_, y7) :=
                @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                  (let (_, y7) := y4 in y7) (let (x1, _) := y5 in x1) in
              y7 in
            let (_, out) :=
              let (xs0, x1) := y6 in
              let (carry, zs) :=
                let (xs1, x2) := xs0 in
                let (ys, y8) :=
                  let (r1, _) := y7 in
                  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                  let (_, y8) :=
                    @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                  y8) in
                let (carry, zs) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                let (carry0, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y8 carry in
                (carry0, (zs, z)) in
              let (carry0, z) :=
                let (xs1, x2) := x1 in
                let (ys, y8) :=
                  let (_, r2) := y7 in
                  (let (_, y8) :=
                     @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                   y8, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                let (carry0, zs0) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                let (carry1, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y8 carry0 in
                (carry1, (zs0, z)) in
              (carry0, (zs, z)) in
            let y8 :=
              let (_, y8) :=
                @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                  (let (_, y8) := y5 in y8) (let (x1, _) := y4 in x1) in
              y8 in
            let (_, out0) :=
              let (xs0, x1) := out in
              let (carry, zs) :=
                let (xs1, x2) := xs0 in
                let (ys, y9) :=
                  let (r1, _) := y8 in
                  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                  let (_, y9) :=
                    @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                  y9) in
                let (carry, zs) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                let (carry0, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry in
                (carry0, (zs, z)) in
              let (carry0, z) :=
                let (xs1, x2) := x1 in
                let (ys, y9) :=
                  let (_, r2) := y8 in
                  (let (_, y9) :=
                     @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                   y9, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                let (carry0, zs0) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                let (carry1, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry0 in
                (carry1, (zs0, z)) in
              (carry0, (zs, z)) in
            out0) in
          let y5 :=
            let y5 := let (_, y5) := y2 in y5 in
            let y6 := let (x1, _) := y3 in x1 in
            let y7 :=
              (let (_, y7) :=
                 @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                   (let (x1, _) := y5 in x1) (let (x1, _) := y6 in x1) in
               y7,
              let (_, y7) :=
                @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                  (let (_, y7) := y5 in y7) (let (_, y7) := y6 in y7) in
              y7) in
            let y8 :=
              let (_, y8) :=
                @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                  (let (_, y8) := y5 in y8) (let (x1, _) := y6 in x1) in
              y8 in
            let (_, out) :=
              let (xs0, x1) := y7 in
              let (carry, zs) :=
                let (xs1, x2) := xs0 in
                let (ys, y9) :=
                  let (r1, _) := y8 in
                  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                  let (_, y9) :=
                    @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                  y9) in
                let (carry, zs) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                let (carry0, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry in
                (carry0, (zs, z)) in
              let (carry0, z) :=
                let (xs1, x2) := x1 in
                let (ys, y9) :=
                  let (_, r2) := y8 in
                  (let (_, y9) :=
                     @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                   y9, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                let (carry0, zs0) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                let (carry1, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y9 carry0 in
                (carry1, (zs0, z)) in
              (carry0, (zs, z)) in
            let y9 :=
              let (_, y9) :=
                @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                  (let (_, y9) := y6 in y9) (let (x1, _) := y5 in x1) in
              y9 in
            let (_, out0) :=
              let (xs0, x1) := out in
              let (carry, zs) :=
                let (xs1, x2) := xs0 in
                let (ys, y10) :=
                  let (r1, _) := y9 in
                  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                  let (_, y10) :=
                    @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                  y10) in
                let (carry, zs) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                let (carry0, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y10 carry in
                (carry0, (zs, z)) in
              let (carry0, z) :=
                let (xs1, x2) := x1 in
                let (ys, y10) :=
                  let (_, r2) := y9 in
                  (let (_, y10) :=
                     @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                   y10, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                let (carry0, zs0) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                let (carry1, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y10 carry0 in
                (carry1, (zs0, z)) in
              (carry0, (zs, z)) in
            out0 in
          let (_, out) :=
            let (xs0, x1) := y4 in
            let (carry, zs) :=
              let (xs1, x2) := xs0 in
              let (ys, y6) :=
                let (r1, _) := y5 in
                (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                let (r3, r4) := r1 in (r3, r4)) in
              let (carry, zs) :=
                let (xs2, x3) := xs1 in
                let (ys0, y7) := ys in
                let (carry, zs) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 false in
                let (carry0, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y7 carry in
                (carry0, (zs, z)) in
              let (carry0, z) :=
                let (xs2, x3) := x2 in
                let (ys0, y7) := y6 in
                let (carry0, zs0) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry in
                let (carry1, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y7 carry0 in
                (carry1, (zs0, z)) in
              (carry0, (zs, z)) in
            let (carry0, z) :=
              let (xs1, x2) := x1 in
              let (ys, y6) :=
                let (_, r2) := y5 in
                (let (r3, r4) := r2 in (r3, r4),
                (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0)) in
              let (carry0, zs0) :=
                let (xs2, x3) := xs1 in
                let (ys0, y7) := ys in
                let (carry0, zs0) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry in
                let (carry1, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y7 carry0 in
                (carry1, (zs0, z)) in
              let (carry1, z) :=
                let (xs2, x3) := x2 in
                let (ys0, y7) := y6 in
                let (carry1, zs1) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry0 in
                let (carry2, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y7 carry1 in
                (carry2, (zs1, z)) in
              (carry1, (zs0, z)) in
            (carry0, (zs, z)) in
          let y6 :=
            let y6 := let (_, y6) := y3 in y6 in
            let y7 := let (x1, _) := y2 in x1 in
            let y8 :=
              (let (_, y8) :=
                 @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                   (let (x1, _) := y6 in x1) (let (x1, _) := y7 in x1) in
               y8,
              let (_, y8) :=
                @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                  (let (_, y8) := y6 in y8) (let (_, y8) := y7 in y8) in
              y8) in
            let y9 :=
              let (_, y9) :=
                @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                  (let (_, y9) := y6 in y9) (let (x1, _) := y7 in x1) in
              y9 in
            let (_, out0) :=
              let (xs0, x1) := y8 in
              let (carry, zs) :=
                let (xs1, x2) := xs0 in
                let (ys, y10) :=
                  let (r1, _) := y9 in
                  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                  let (_, y10) :=
                    @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                  y10) in
                let (carry, zs) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                let (carry0, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y10 carry in
                (carry0, (zs, z)) in
              let (carry0, z) :=
                let (xs1, x2) := x1 in
                let (ys, y10) :=
                  let (_, r2) := y9 in
                  (let (_, y10) :=
                     @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                   y10, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                let (carry0, zs0) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                let (carry1, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y10 carry0 in
                (carry1, (zs0, z)) in
              (carry0, (zs, z)) in
            let y10 :=
              let (_, y10) :=
                @muldwf (@x86.W (Z.of_nat 64) ops) (@x86.muldwf (Z.of_nat 64) ops)
                  (let (_, y10) := y7 in y10) (let (x1, _) := y6 in x1) in
              y10 in
            let (_, out1) :=
              let (xs0, x1) := out0 in
              let (carry, zs) :=
                let (xs1, x2) := xs0 in
                let (ys, y11) :=
                  let (r1, _) := y10 in
                  (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                  let (_, y11) :=
                    @shlf (@x86.W (Z.of_nat 64) ops) (@x86.shlf (Z.of_nat 64) ops) r1 0 in
                  y11) in
                let (carry, zs) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys false in
                let (carry0, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y11 carry in
                (carry0, (zs, z)) in
              let (carry0, z) :=
                let (xs1, x2) := x1 in
                let (ys, y11) :=
                  let (_, r2) := y10 in
                  (let (_, y11) :=
                     @shrf (@x86.W (Z.of_nat 64) ops) (@x86.shrf (Z.of_nat 64) ops) r2 0 in
                   y11, @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0) in
                let (carry0, zs0) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs1 ys carry in
                let (carry1, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x2 y11 carry0 in
                (carry1, (zs0, z)) in
              (carry0, (zs, z)) in
            out1 in
          let (_, out0) :=
            let (xs0, x1) := out in
            let (carry, zs) :=
              let (xs1, x2) := xs0 in
              let (ys, y7) :=
                let (r1, _) := y6 in
                (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                let (r3, r4) := r1 in (r3, r4)) in
              let (carry, zs) :=
                let (xs2, x3) := xs1 in
                let (ys0, y8) := ys in
                let (carry, zs) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 false in
                let (carry0, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y8 carry in
                (carry0, (zs, z)) in
              let (carry0, z) :=
                let (xs2, x3) := x2 in
                let (ys0, y8) := y7 in
                let (carry0, zs0) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry in
                let (carry1, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y8 carry0 in
                (carry1, (zs0, z)) in
              (carry0, (zs, z)) in
            let (carry0, z) :=
              let (xs1, x2) := x1 in
              let (ys, y7) :=
                let (_, r2) := y6 in
                (let (r3, r4) := r2 in (r3, r4),
                (@ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0,
                @ldi (@x86.W (Z.of_nat 64) ops) (@x86.ldi (Z.of_nat 64) ops) 0)) in
              let (carry0, zs0) :=
                let (xs2, x3) := xs1 in
                let (ys0, y8) := ys in
                let (carry0, zs0) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry in
                let (carry1, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y8 carry0 in
                (carry1, (zs0, z)) in
              let (carry1, z) :=
                let (xs2, x3) := x2 in
                let (ys0, y8) := y7 in
                let (carry1, zs1) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) xs2 ys0 carry0 in
                let (carry2, z) :=
                  @adc (@x86.W (Z.of_nat 64) ops) (@x86.adc (Z.of_nat 64) ops) x3 y8 carry1 in
                (carry2, (zs1, z)) in
              (carry1, (zs0, z)) in
            (carry0, (zs, z)) in
          out0 in
        x1 in
      let (carry, zs) :=
        let (xs0, x1) := xs in
        let (ys0, y3) := ys in
        let (carry, zs) :=
          @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) xs0 ys0 false in
        let (carry0, z) :=
          @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) x1 y3 carry in
        (carry0, (zs, z)) in
      let (carry0, z) :=
        let (xs0, x1) := x0 in
        let (ys0, y3) := y2 in
        let (carry0, zs0) :=
          @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) xs0 ys0 carry in
        let (carry1, z) :=
          @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) x1 y3 carry0 in
        (carry1, (zs0, z)) in
      (carry0, (zs, z)) in
    y2 in
  let (CF, _) :=
    let (xs, x0) := y2 in
    let (ys, y3) := y in
    let (carry, zs) :=
      let (xs0, x1) := xs in
      let (ys0, y4) := ys in
      let (carry, zs) :=
        @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) xs0 ys0 false in
      let (carry0, z) :=
        @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) x1 y4 carry in
      (carry0, (zs, z)) in
    let (carry0, z) :=
      let (xs0, x1) := x0 in
      let (ys0, y4) := y3 in
      let (carry0, zs0) :=
        @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) xs0 ys0 carry in
      let (carry1, z) :=
        @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) x1 y4 carry0 in
      (carry1, (zs0, z)) in
    (carry0, (zs, z)) in
  let (_, y3) :=
    let (xs, x0) := y2 in
    let (ys, y3) :=
      let (x1, x2) := y1 in
      let (y3, y4) := y in
      (let (x3, x4) := x1 in
       let (y5, y6) := y3 in
       (@selc (@x86.W (Z.of_nat 64) ops) (@x86.selc (Z.of_nat 64) ops) CF x3 y5,
       @selc (@x86.W (Z.of_nat 64) ops) (@x86.selc (Z.of_nat 64) ops) CF x4 y6),
      let (x3, x4) := x2 in
      let (y5, y6) := y4 in
      (@selc (@x86.W (Z.of_nat 64) ops) (@x86.selc (Z.of_nat 64) ops) CF x3 y5,
      @selc (@x86.W (Z.of_nat 64) ops) (@x86.selc (Z.of_nat 64) ops) CF x4 y6)) in
    let (carry, zs) :=
      let (xs0, x1) := xs in
      let (ys0, y4) := ys in
      let (carry, zs) :=
        @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) xs0 ys0 false in
      let (carry0, z) :=
        @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) x1 y4 carry in
      (carry0, (zs, z)) in
    let (carry0, z) :=
      let (xs0, x1) := x0 in
      let (ys0, y4) := y3 in
      let (carry0, zs0) :=
        @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) xs0 ys0 carry in
      let (carry1, z) :=
        @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) x1 y4 carry0 in
      (carry1, (zs0, z)) in
    (carry0, (zs, z)) in
  y3 in
let (CF, _) :=
  let (xs, x0) := y2 in
  let (ys, y3) := y in
  let (carry, zs) :=
    let (xs0, x1) := xs in
    let (ys0, y4) := ys in
    let (carry, zs) :=
      @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) xs0 ys0 false in
    let (carry0, z) :=
      @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) x1 y4 carry in
    (carry0, (zs, z)) in
  let (carry0, z) :=
    let (xs0, x1) := x0 in
    let (ys0, y4) := y3 in
    let (carry0, zs0) :=
      @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) xs0 ys0 carry in
    let (carry1, z) :=
      @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) x1 y4 carry0 in
    (carry1, (zs0, z)) in
  (carry0, (zs, z)) in
let (_, y3) :=
  let (xs, x0) := y2 in
  let (ys, y3) :=
    let (x1, x2) := y1 in
    let (y3, y4) := y in
    (let (x3, x4) := x1 in
     let (y5, y6) := y3 in
     (@selc (@x86.W (Z.of_nat 64) ops) (@x86.selc (Z.of_nat 64) ops) CF x3 y5,
     @selc (@x86.W (Z.of_nat 64) ops) (@x86.selc (Z.of_nat 64) ops) CF x4 y6),
    let (x3, x4) := x2 in
    let (y5, y6) := y4 in
    (@selc (@x86.W (Z.of_nat 64) ops) (@x86.selc (Z.of_nat 64) ops) CF x3 y5,
    @selc (@x86.W (Z.of_nat 64) ops) (@x86.selc (Z.of_nat 64) ops) CF x4 y6)) in
  let (carry, zs) :=
    let (xs0, x1) := xs in
    let (ys0, y4) := ys in
    let (carry, zs) :=
      @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) xs0 ys0 false in
    let (carry0, z) :=
      @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) x1 y4 carry in
    (carry0, (zs, z)) in
  let (carry0, z) :=
    let (xs0, x1) := x0 in
    let (ys0, y4) := y3 in
    let (carry0, zs0) :=
      @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) xs0 ys0 carry in
    let (carry1, z) :=
      @subc (@x86.W (Z.of_nat 64) ops) (@x86.subc (Z.of_nat 64) ops) x1 y4 carry0 in
    (carry1, (zs0, z)) in
  (carry0, (zs, z)) in
y3.
  Definition rexpression : Syntax.Expr base_type (interp_base_type _) op (Arrow TW (Arrow TW (Arrow TW (Arrow TW (Arrow TW (Arrow TW (Arrow TW (Arrow TW (Tbase TW))))))))).
  Proof.
    Typeclasses eauto := debug.
    Time try let v := (eval cbv beta delta [barrett_reduce64'1] in (fun a b c d e f g h => barrett_reduce64'1 (((a, b), (c, d)), ((e, f), (g, h))))) in
             let v := Reify v in
             exact v.
  Defined.
End x86.


From iris.proofmode Require Import proofmode.
From iris.base_logic.lib Require Import na_invariants.
From self.logrel Require Import model.
From self.prob_lang Require Import adequacy primitive_laws lang.

Class prelogrelGpreS Σ := PrelogrelGPreS {
  prelogrelGpreS_preloc :> prelocGpreS Σ;
  prelorelGpreS_na_inv  :> na_invG Σ;
}.

Definition prelogrelΣ : gFunctors := #[prelocΣ; na_invΣ].
Global Instance subG_prelogrelGPreS {Σ} : subG prelogrelΣ Σ → prelogrelGpreS Σ.
Proof. solve_inG. Qed.

Theorem refines_coupling Σ `{prelogrelGpreS Σ}
  (A : ∀ `{prelogrelGS Σ}, lrel Σ) (φ : val → val → Prop) e e' σ σ' n :
  (∀ `{prelogrelGS Σ}, ∀ v v', A v v' -∗ ⌜φ v v'⌝) →
  (∀ `{prelogrelGS Σ}, ⊢ REL e << e' : A) →
  refRcoupl (exec_val n (e, σ)) (lim_exec_val (e', σ')) φ.
Proof.
  intros HA Hlog.
  apply (wp_refRcoupl Σ).
  intros ?.
  iIntros "#Hctx He'".
  iMod na_alloc as "[%γ Htok]".
  set (Hprelogrel := PrelogrelGS Σ _ _ γ).
  iPoseProof (Hlog _) as "Hlog".
  rewrite refines_eq /refines_def.
  iSpecialize ("Hlog" $! []  with "[$Hctx $He'] Htok").
  iApply (wp_mono with "Hlog").
  iIntros (?) "H /=".
  iDestruct "H" as (?) "([? ? ] & ? & ?) /=".
  iExists _. iFrame. by iApply HA.
Qed.


Require Import CodeProofDeps.
Require Import Ident.
Require Import Constants.
Require Import RData.
Require Import EventReplay.
Require Import MoverTypes.
Require Import CommonLib.
Require Import RVIC.Layer.
Require Import RVIC2.Code.rvic_target_is_valid.

Require Import RVIC2.LowSpecs.rvic_target_is_valid.

Local Open Scope Z_scope.

Section CodeProof.

  Context `{real_params: RealParams}.
  Context {memb} `{Hmemx: Mem.MemoryModelX memb}.
  Context `{Hmwd: UseMemWithData memb}.

  Let mem := mwd (cdata RData).

  Context `{Hstencil: Stencil}.
  Context `{make_program_ops: !MakeProgramOps Clight.function type Clight.fundef type}.
  Context `{Hmake_program: !MakeProgram Clight.function type Clight.fundef type}.

  Let L : compatlayer (cdata RData) :=
    ∅.

  Local Instance: ExternalCallsOps mem := CompatExternalCalls.compatlayer_extcall_ops L.
  Local Instance: CompilerConfigOps mem := CompatExternalCalls.compatlayer_compiler_config_ops L.

  Section BodyProof.

    Context `{Hwb: WritableBlockOps}.
    Variable (sc: stencil).
    Variables (ge: genv) (STENCIL_MATCHES: stencil_matches sc ge).

    Lemma rvic_target_is_valid_body_correct:
      forall m d env le target res
             (Henv: env = PTree.empty _)
             (Hinv: high_level_invariant d)
             (HPTtarget: PTree.get _target le = Some (Vlong target))
             (Hspec: rvic_target_is_valid_spec0 (VZ64 (Int64.unsigned target)) d = Some (Int.unsigned res)),
           exists le', (exec_stmt ge env le ((m, d): mem) rvic_target_is_valid_body E0 le' (m, d) (Out_return (Some (Vint res, tuint)))).
    Proof.
      solve_code_proof Hspec rvic_target_is_valid_body; eexists; solve_proof_low.
      simpl in C1. solve_proof_low. simpl in C1. omega.
      solve_proof_low. solve_proof_low. simpl in *. solve_proof_low.
      solve_proof_low. solve_proof_low.
    Qed.

  End BodyProof.

End CodeProof.


Require Import Coqlib.
Require Import ITreelib.
Require Import ImpPrelude.
Require Import STS.
Require Import Behavior.
Require Import ModSem.
Require Import Skeleton.
Require Import PCM.
Require Import HoareDef.
Require Import IntroHeader.
Import Sep.

Set Implicit Arguments.

Section PROOF.

  Context `{Σ: GRA.t}.
  Context `{@GRA.inG IRA.t Σ}.

  Definition Gsbtb: list (string * fspecbody) := [("g", mk_specbody g_spec (fun _ => trigger (Choose _)))].

  Definition GSem: SModSem.t := {|
    SModSem.fnsems := Gsbtb;
    SModSem.mn := "G";
    SModSem.initial_mr := GRA.embed (IRA.module true: IRA.t);
    SModSem.initial_st := tt↑;
  |}
  .

  Definition G: Mod.t := (SMod.to_tgt (fun _ => GlobalStb)) {|
    SMod.get_modsem := fun _ => GSem;
    SMod.sk := [("g", Sk.Gfun)];
  |}.

End PROOF.


(*********************************************************************************************************************************)
(* HaskSkolemizer:                                                                                *)
(*                                                                                *)
(*   Skolemizes the portion of a proof which uses judgments at level >0                                                          *)
(*                                                                                *)
(*********************************************************************************************************************************)

Generalizable All Variables.
Require Import Preamble.
Require Import General.
Require Import NaturalDeduction.
Require Import NaturalDeductionContext.
Require Import Coq.Strings.String.
Require Import Coq.Lists.List.

Require Import HaskKinds.
Require Import HaskCoreTypes.
Require Import HaskCoreVars.
Require Import HaskWeakTypes.
Require Import HaskWeakVars.
Require Import HaskLiterals.
Require Import HaskTyCons.
Require Import HaskStrongTypes.
Require Import HaskProof.
Require Import NaturalDeduction.

Require Import HaskStrongTypes.
Require Import HaskStrong.
Require Import HaskProof.
Require Import HaskStrongToProof.
Require Import HaskProofToStrong.
Require Import HaskWeakToStrong.

Open Scope nd_scope.
Set Printing Width 130.

Section HaskSkolemizer.

(*
  Fixpoint debruijn2phoas {κ} (exp: RawHaskType (fun _ => nat) κ) : HaskType TV κ :=
     match exp with
    | TVar    _  x          => x
    | TAll     _ y          => TAll   _  (fun v => debruijn2phoas  (y (TVar v)))
    | TApp   _ _ x y        => TApp      (debruijn2phoas  x) (debruijn2phoas  y)
    | TCon       tc         => TCon      tc
    | TCoerc _ t1 t2 t      => TCoerc    (debruijn2phoas  t1) (debruijn2phoas  t2)   (debruijn2phoas  t)
    | TArrow                => TArrow
    | TCode      v e        => TCode     (debruijn2phoas  v) (debruijn2phoas  e)
    | TyFunApp  tfc kl k lt => TyFunApp tfc kl k (debruijn2phoasyFunApp _ lt)
    end
    with debruijn2phoasyFunApp (lk:list Kind)(exp:@RawHaskTypeList (fun _ => nat) lk) : @HaskTypeList TV lk :=
    match exp in @RawHaskTypeList _ LK return @RawHaskTypeList TV LK with
    | TyFunApp_nil               => TyFunApp_nil
    | TyFunApp_cons  κ kl t rest => TyFunApp_cons _ _ (debruijn2phoas  t) (debruijn2phoasyFunApp _ rest)
    end.
*)
  Definition isNotBrakOrEsc {h}{c} (r:Rule h c) : Prop :=
    match r with
      | RBrak _ _ _ _ _ _ => False
      | REsc  _ _ _ _ _ _ => False
      | _                 => True
    end.

  Fixpoint mkArrows {Γ}(lt:list (HaskType Γ ★))(t:HaskType Γ ★) : HaskType Γ ★ :=
    match lt with
      | nil => t
      | a::b => mkArrows b (a ---> t)
    end.

(*
  Fixpoint unleaves_ {Γ}(t:Tree ??(LeveledHaskType Γ ★))(l:list (HaskType Γ ★)) lev : Tree ??(LeveledHaskType Γ ★) :=
    match l with
      | nil  => t
      | a::b => unleaves_ (t,,[a @@ lev]) b lev
    end.
*)
  (* weak inverse of "leaves" *)
  Fixpoint unleaves_ {A:Type}(l:list A) : Tree (option A) :=
    match l with
      | nil      => []
      | (a::nil) => [a]
      | (a::b)   => [a],,(unleaves_ b)
    end.

  (* rules of skolemized proofs *)
  Definition getΓ (j:Judg) := match j with Γ > _ > _ |- _ @ _ => Γ end.

  Fixpoint take_trustme {Γ}
    (n:nat)
    (l:forall TV, InstantiatedTypeEnv TV Γ -> list (RawHaskType TV ★))
    : list (HaskType Γ ★) :=

    match n with
      | 0    => nil
      | S n' => (fun TV ite => match l TV ite with
                | nil  => Prelude_error "impossible"
                | a::b => a
                end)
                ::
                take_trustme n' (fun TV ite => match l TV ite with
                | nil  => Prelude_error "impossible"
                | a::b => b
                end)
    end.

  Axiom phoas_extensionality : forall Γ Q (f g:forall TV, InstantiatedTypeEnv TV Γ -> Q TV),
    (forall tv ite, f tv ite = g tv ite) -> f=g.

  Definition take_arg_types_as_tree {Γ}(ht:HaskType Γ ★) : Tree ??(HaskType Γ ★ ) :=
    unleaves_
    (take_trustme
      (count_arg_types (ht _ (ite_unit _)))
      (fun TV ite => take_arg_types (ht TV ite))).

  Definition drop_arg_types_as_tree {Γ} (ht:HaskType Γ ★) : HaskType Γ ★ :=
    fun TV ite => drop_arg_types (ht TV ite).

  Implicit Arguments take_arg_types_as_tree [[Γ]].
  Implicit Arguments drop_arg_types_as_tree [[Γ]].

  Definition take_arrange : forall {Γ} (tx te:HaskType Γ ★) lev,
    Arrange ([tx @@ lev],,take_arg_types_as_tree te @@@ lev)
      (take_arg_types_as_tree (tx ---> te) @@@ lev).
    intros.
    destruct (eqd_dec ([tx],,take_arg_types_as_tree te) (take_arg_types_as_tree (tx ---> te))).
      rewrite <- e.
      simpl.
      apply AId.
    unfold take_arg_types_as_tree.
      Opaque take_arg_types_as_tree.
      simpl.
      destruct (count_arg_types (te (fun _ : Kind => unit) (ite_unit Γ))).
      simpl.
      replace (tx) with (fun (TV : Kind → Type) (ite : InstantiatedTypeEnv TV Γ) => tx TV ite).
      apply ACanR.
        apply phoas_extensionality.
        reflexivity.
    apply (Prelude_error "should not be possible").
    Defined.
    Transparent take_arg_types_as_tree.

  Definition take_unarrange : forall {Γ} (tx te:HaskType Γ ★) lev,
    Arrange (take_arg_types_as_tree (tx ---> te) @@@ lev)
      ([tx @@ lev],,take_arg_types_as_tree te @@@ lev).
    intros.
    destruct (eqd_dec ([tx],,take_arg_types_as_tree te) (take_arg_types_as_tree (tx ---> te))).
      rewrite <- e.
      simpl.
      apply AId.
    unfold take_arg_types_as_tree.
      Opaque take_arg_types_as_tree.
      simpl.
      destruct (count_arg_types (te (fun _ : Kind => unit) (ite_unit Γ))).
      simpl.
      replace (tx) with (fun (TV : Kind → Type) (ite : InstantiatedTypeEnv TV Γ) => tx TV ite).
      apply AuCanR.
        apply phoas_extensionality.
        reflexivity.
    apply (Prelude_error "should not be possible").
    Defined.
    Transparent take_arg_types_as_tree.

  Lemma drop_works : forall {Γ}(t1 t2:HaskType Γ ★),
    drop_arg_types_as_tree (t1 ---> t2) = (drop_arg_types_as_tree t2).
    intros.
    unfold drop_arg_types_as_tree.
    simpl.
    reflexivity.
    Qed.

  Inductive SRule : Tree ??Judg -> Tree ??Judg -> Type :=
(*  | SFlat  : forall h c (r:Rule h c), isNotBrakOrEsc r -> SRule h c*)
  | SFlat  : forall h c, Rule h c -> SRule h c
  | SBrak  : forall Γ Δ t ec Σ l,
    SRule
    [Γ > Δ > Σ,,(take_arg_types_as_tree t @@@ (ec::l)) |- [ drop_arg_types_as_tree t        ] @ (ec::l)]
    [Γ > Δ > Σ                                  |- [<[ec |- t]>                ] @l]

  | SEsc   : forall Γ Δ t ec Σ l,
    SRule
    [Γ > Δ > Σ                                  |- [<[ec |- t]>                ] @l]
    [Γ > Δ > Σ,,(take_arg_types_as_tree t @@@ (ec::l)) |- [ drop_arg_types_as_tree t         ] @ (ec::l)]
    .

  Definition take_arg_types_as_tree' {Γ}(lt:LeveledHaskType Γ ★) :=
    match lt with t @@ l => take_arg_types_as_tree t @@@ l end.

  Definition drop_arg_types_as_tree' {Γ}(lt:LeveledHaskType Γ ★) :=
    match lt with t @@ l => drop_arg_types_as_tree t @@ l end.

  Definition skolemize_judgment (j:Judg) : Judg :=
    match j with
      | Γ > Δ > Σ₁ |- Σ₂ @ nil       => j
        | Γ > Δ > Σ₁ |- Σ₂ @ lev =>
          Γ > Δ > Σ₁,,(mapOptionTreeAndFlatten take_arg_types_as_tree Σ₂ @@@ lev) |- mapOptionTree drop_arg_types_as_tree Σ₂ @ lev
    end.

  Definition check_hof : forall {Γ}(t:HaskType Γ ★),
    sumbool
    True
    (take_arg_types_as_tree t = [] /\ drop_arg_types_as_tree t = t).
    intros.
    destruct (eqd_dec (take_arg_types_as_tree t) []);
    destruct (eqd_dec (drop_arg_types_as_tree t) t).
    right; auto.
    left; auto.
    left; auto.
    left; auto.
    Defined.

  Opaque take_arg_types_as_tree.
  Definition skolemize_proof :
    forall  {h}{c},
      ND Rule  h c ->
      ND SRule (mapOptionTree skolemize_judgment h) (mapOptionTree skolemize_judgment c).
    intros.
    eapply nd_map'; [ idtac | apply X ].
    clear h c X.
    intros.

    refine (match X as R in Rule H C with
      | RArrange Γ Δ a b x l d         => let case_RArrange := tt      in _
      | RNote    Γ Δ Σ τ l n           => let case_RNote := tt         in _
      | RLit     Γ Δ l     _           => let case_RLit := tt          in _
      | RVar     Γ Δ σ           lev   => let case_RVar := tt          in _
      | RGlobal  Γ Δ σ l wev           => let case_RGlobal := tt       in _
      | RLam     Γ Δ Σ tx te     lev   => let case_RLam := tt          in _
      | RCast    Γ Δ Σ σ τ lev γ       => let case_RCast := tt         in _
      | RAbsT    Γ Δ Σ κ σ lev n       => let case_RAbsT := tt         in _
      | RAppT    Γ Δ Σ κ σ τ     lev   => let case_RAppT := tt         in _
      | RAppCo   Γ Δ Σ κ σ₁ σ₂ γ σ lev => let case_RAppCo := tt        in _
      | RAbsCo   Γ Δ Σ κ σ  σ₁ σ₂  lev => let case_RAbsCo := tt        in _
      | RApp     Γ Δ Σ₁ Σ₂ tx te lev   => let case_RApp := tt          in _
      | RCut     Γ Δ Σ Σ₁ Σ₁₂ Σ₂ Σ₃ l  => let case_RCut := tt          in _
      | RLeft    Γ Δ Σ₁ Σ₂  Σ     l    => let case_RLeft := tt in _
      | RRight   Γ Δ Σ₁ Σ₂  Σ     l    => let case_RRight := tt in _
      | RVoid    _ _           l       => let case_RVoid := tt   in _
      | RBrak    Γ Δ t ec succ lev     => let case_RBrak := tt         in _
      | REsc     Γ Δ t ec succ lev     => let case_REsc := tt          in _
      | RCase    Γ Δ lev tc Σ avars tbranches alts => let case_RCase := tt         in _
      | RLetRec  Γ Δ lri x y t         => let case_RLetRec := tt       in _
      end); clear X h c.

      destruct case_RArrange.
        simpl.
        destruct l.
        apply nd_rule.
        apply SFlat.
        apply RArrange.
        apply d.
        apply nd_rule.
        apply SFlat.
        apply RArrange.
        apply ARight.
        apply d.

      destruct case_RBrak.
        simpl.
        destruct lev; [ idtac | apply (Prelude_error "Brak with nesting depth >1") ].
        apply nd_rule.
        apply SBrak.

      destruct case_REsc.
        simpl.
        destruct lev; [ idtac | apply (Prelude_error "Esc with nesting depth >1") ].
        apply nd_rule.
        apply SEsc.

      destruct case_RNote.
        apply nd_rule.
        apply SFlat.
        simpl.
        destruct l.
        apply RNote.
        apply n.
        apply RNote.
        apply n.

      destruct case_RLit.
        simpl.
        destruct l0.
        apply nd_rule.
        apply SFlat.
        apply RLit.
        set (check_hof (@literalType l Γ)) as hof.
        destruct hof; [ apply (Prelude_error "attempt to use a literal with higher-order type at depth>0") | idtac ].
        destruct a.
        rewrite H.
        rewrite H0.
        simpl.
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; apply AuCanL ].
        apply nd_rule.
        apply SFlat.
        apply RLit.

      destruct case_RVar.
        simpl.
        destruct lev.
        apply nd_rule; apply SFlat; apply RVar.
        set (check_hof σ) as hof.
        destruct hof; [ apply (Prelude_error "attempt to use a variable with higher-order type at depth>0") | idtac ].
        destruct a.
        rewrite H.
        rewrite H0.
        simpl.
        eapply nd_comp; [ idtac | eapply nd_rule; apply SFlat; eapply RArrange; apply AuCanR ].
        apply nd_rule.
        apply SFlat.
        apply RVar.

      destruct case_RGlobal.
        simpl.
        destruct σ.
        apply nd_rule; apply SFlat; apply RGlobal.
        set (check_hof (l wev)) as hof.
        destruct hof; [ apply (Prelude_error "attempt to use a global with higher-order type at depth>0") | idtac ].
        destruct a.
        rewrite H.
        rewrite H0.
        simpl.
        eapply nd_comp; [ idtac | eapply nd_rule; apply SFlat; eapply RArrange; apply AuCanR ].
        apply nd_rule.
        apply SFlat.
        apply RGlobal.

      destruct case_RLam.
        destruct lev.
          apply nd_rule.
          apply SFlat.
          simpl.
          apply RLam.
        simpl.
        rewrite drop_works.
        apply nd_rule.
          apply SFlat.
          apply RArrange.
          eapply AComp.
          eapply AuAssoc.
          eapply ALeft.
          apply take_arrange.

      destruct case_RCast.
        simpl.
        destruct lev.
        apply nd_rule.
        apply SFlat.
        apply RCast.
        apply γ.
        apply (Prelude_error "found RCast at level >0").

      destruct case_RApp.
        simpl.
        destruct lev.
        apply nd_rule.
        apply SFlat.
        apply RApp.
        rewrite drop_works.
        set (check_hof tx) as hof_tx.
        destruct hof_tx; [ apply (Prelude_error "attempt tp apply a higher-order function at depth>0") | idtac ].
        destruct a.
        rewrite H.
        rewrite H0.
        simpl.
        eapply nd_comp.
        eapply nd_prod; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply ACanR ].
        eapply nd_rule.
        eapply SFlat.
        eapply RArrange.
        eapply ALeft.
        eapply take_unarrange.

        eapply nd_comp; [ idtac | eapply nd_rule; apply SFlat; eapply RArrange; apply AAssoc ].
        eapply nd_comp; [ apply nd_exch | idtac ].
        eapply nd_rule; eapply SFlat; eapply RCut.

      destruct case_RCut.
        simpl; destruct l; [ apply nd_rule; apply SFlat; apply RCut | idtac ].
        set (mapOptionTreeAndFlatten take_arg_types_as_tree Σ₃) as Σ₃''.
        set (mapOptionTree drop_arg_types_as_tree Σ₃) as Σ₃'''.
        set (mapOptionTreeAndFlatten take_arg_types_as_tree Σ₁₂) as Σ₁₂''.
        set (mapOptionTree drop_arg_types_as_tree Σ₁₂) as Σ₁₂'''.
        destruct (decide_tree_empty (Σ₁₂'' @@@ (h::l)));
          [ idtac | apply (Prelude_error "used RCut on a variable with function type") ].
        destruct (eqd_dec Σ₁₂ Σ₁₂'''); [ idtac | apply (Prelude_error "used RCut on a variable with function type") ].
        rewrite <- e.
        clear e.
        destruct s.
        eapply nd_comp.
          eapply nd_prod.
          eapply nd_rule.
          eapply SFlat.
          eapply RArrange.
          eapply AComp.
          eapply ALeft.
          eapply arrangeCancelEmptyTree with (q:=x).
          apply e.
          apply ACanR.
          apply nd_id.
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply AAssoc ].
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply ALeft; eapply AAssoc ].
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RCut ].
        apply nd_prod.
        apply nd_id.
        eapply nd_rule.
          eapply SFlat.
          eapply RArrange.
          eapply AComp.
          eapply AuAssoc.
          eapply ALeft.
          eapply AComp.
          eapply AuAssoc.
          eapply ALeft.
          eapply AId.

      destruct case_RLeft.
        simpl; destruct l; [ apply nd_rule; apply SFlat; apply RLeft | idtac ].
        set (mapOptionTreeAndFlatten take_arg_types_as_tree Σ₂) as Σ₂'.
        set (mapOptionTreeAndFlatten take_arg_types_as_tree Σ) as Σ'.
        set (mapOptionTree drop_arg_types_as_tree Σ₂) as Σ₂''.
        set (mapOptionTree drop_arg_types_as_tree Σ) as Σ''.
        destruct (decide_tree_empty (Σ' @@@ (h::l)));
          [ idtac | apply (Prelude_error "used RLeft on a variable with function type") ].
        destruct (eqd_dec Σ Σ''); [ idtac | apply (Prelude_error "used RLeft on a variable with function type") ].
        rewrite <- e.
        clear Σ'' e.
        destruct s.
        set (arrangeUnCancelEmptyTree _ _ e) as q.
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply ALeft; eapply ARight; eapply q ].
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply ALeft; eapply AuCanL; eapply q ].
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply AAssoc ].
        apply nd_rule.
        eapply SFlat.
        eapply RLeft.

      destruct case_RRight.
        simpl; destruct l; [ apply nd_rule; apply SFlat; apply RRight | idtac ].
        set (mapOptionTreeAndFlatten take_arg_types_as_tree Σ₂) as Σ₂'.
        set (mapOptionTreeAndFlatten take_arg_types_as_tree Σ) as Σ'.
        set (mapOptionTree drop_arg_types_as_tree Σ₂) as Σ₂''.
        set (mapOptionTree drop_arg_types_as_tree Σ) as Σ''.
        destruct (decide_tree_empty (Σ' @@@ (h::l)));
          [ idtac | apply (Prelude_error "used RRight on a variable with function type") ].
        destruct (eqd_dec Σ Σ''); [ idtac | apply (Prelude_error "used RRight on a variable with function type") ].
        rewrite <- e.
        clear Σ'' e.
        destruct s.
        set (arrangeUnCancelEmptyTree _ _ e) as q.
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply ALeft; eapply ALeft; eapply q ].
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply ALeft; eapply AuCanR ].
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply AAssoc ].
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply ALeft; eapply AExch ].  (* yuck *)
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply AuAssoc ].
        eapply nd_rule.
        eapply SFlat.
        apply RRight.

      destruct case_RVoid.
        simpl.
        destruct l.
        apply nd_rule.
        apply SFlat.
        apply RVoid.
        eapply nd_comp; [ idtac | eapply nd_rule; eapply SFlat; eapply RArrange; eapply AuCanL ].
        apply nd_rule.
        apply SFlat.
        apply RVoid.

      destruct case_RAppT.
        simpl.
        destruct lev; [ apply nd_rule; apply SFlat; apply RAppT | idtac ].
        apply (Prelude_error "RAppT at depth>0").

      destruct case_RAbsT.
        simpl.
        destruct lev; simpl.
          apply nd_rule.
          apply SFlat.
          apply (@RAbsT Γ Δ Σ κ σ nil n).
        apply (Prelude_error "RAbsT at depth>0").

      destruct case_RAppCo.
        simpl.
        destruct lev; [ apply nd_rule; apply SFlat; apply RAppCo | idtac ].
        apply γ.
        apply (Prelude_error "RAppCo at depth>0").

      destruct case_RAbsCo.
        simpl.
        destruct lev; [ apply nd_rule; apply SFlat; apply RAbsCo | idtac ].
        apply (Prelude_error "RAbsCo at depth>0").

      destruct case_RLetRec.
        simpl.
        destruct t.
        apply nd_rule.
        apply SFlat.
        apply (@RLetRec Γ Δ lri x y nil).
        destruct (decide_tree_empty (mapOptionTreeAndFlatten take_arg_types_as_tree y @@@ (h :: t)));
          [ idtac | apply (Prelude_error "used LetRec on a set of bindings involving a function type") ].
        destruct (eqd_dec y (mapOptionTree drop_arg_types_as_tree y));
          [ idtac | apply (Prelude_error "used LetRec on a set of bindings involving a function type") ].
        rewrite <- e.
        clear e.
        eapply nd_comp.
          eapply nd_rule.
          eapply SFlat.
          eapply RArrange.
          eapply ALeft.
          eapply AComp.
          eapply ARight.
          destruct s.
          apply (arrangeCancelEmptyTree _ _ e).
          apply ACanL.
        eapply nd_comp.
          eapply nd_rule.
          eapply SFlat.
          eapply RArrange.
          eapply AuAssoc.
        eapply nd_rule.
          eapply SFlat.
          eapply RLetRec.

      destruct case_RCase.
        destruct lev; [ idtac | apply (Prelude_error "case at depth >0") ]; simpl.
        apply nd_rule.
        apply SFlat.
        rewrite <- mapOptionTree_compose.
        assert
          ((mapOptionTree (fun x => skolemize_judgment (@pcb_judg tc Γ Δ nil tbranches avars (fst x) (snd x))) alts) =
           (mapOptionTree (fun x => (@pcb_judg tc Γ Δ nil tbranches avars (fst x) (snd x))) alts)).
           admit.
           rewrite H.
        set (@RCase Γ Δ nil tc Σ avars tbranches alts) as q.
        apply q.
        Defined.

  Transparent take_arg_types_as_tree.

End HaskSkolemizer.