let p = 7
(* should be prime *)

type lis = N | C of int * lis
(* type padic = int lis * int lis *) (* only the first one can be infinite *)

let rec minus_one = C(p - 1, minus_one)

(**** Equality ****)
let rec equalf p = match p with (* of floating parts: not corecursive *)
  N, N -> true
| (C(h1, t1)), C(h2, t2) -> ((h1 = h2) && (equalf (t1, t2)))
| (C(0, t1)), N -> (equalf (t1, N))
| N, C(0, t2) -> (equalf (t2, N))
| x -> false

let corec[appears(false)] equali_aux p = match p with (* of integer parts *)
  N, N -> true
| (C(h1, t1)), C(h2, t2) -> ((h1 = h2) && (equalf (t1, t2)))
| (C(0, t1)), N -> (equali_aux (t1, N))
| N, C(0, t2) -> (equali_aux (t2, N))
| x -> false
let equali p = not(equali_aux p)
let equal p1 p2 = match p1, p2 with
  (i1, j1), (i2, j2) -> ((equali (i1, i2)) && (equalf (j1, j2)))

let r1 = equali (C(1, C(2, N)), C(3, N))
let r2 = equali (C(1, C(2, N)), C(1, C(2, N)))
let rec b = C(2, b)
let r2a = let rec a = C(2, C(2, a)) in a = b

let rec zeros = C(0, zeros)
let r3 = equali(zeros, N)
let rec ones = C(1, ones)
let r4 = equali(ones, N)

let rec of_int i = match i with 0 -> N
 | i -> C((i mod p), of_int (i / p))

(**** Normalization ****)

let corec[constructor] normalizei i = 
  if equali(i, N) then N else
  match i with C(i, t) -> C(i, normalizei t)

let r5 = normalizei(N)
let r6 = normalizei(C(0, C(0, C(1, N))))
let r7 = normalizei(zeros)
let r8 = normalizei(ones)
let normalize n = match n with i, f ->
  (normalizei i, normalizei f)

(**** Euclid ****)
let rec euclid p a b =
(* assumes b and p prime together
   finds d in [| 0 ; p-1 |] such that a = (b * d) mod p
   i.e. there exists e st b * d + p * e = a *)
(* Look up Euclid's algo, but for now brute force: *)
   let a = if (a >= 0) then (a mod p) else (a mod p + p) in
   let rec tryn d =
     if d < p then 
        (if (((b * d) mod p) = a) then d else (tryn (d+1)))
     else -42 (* error *)
   in tryn 0

(**** Shifting ****)
let rec shift n i = (* multiplies i by p^n *)
  if (n = 0) then i
  else if (n > 0) then 
  (match i with
     (l, N ) -> shift (n-1) ((C(0, l)), N)
   | (l, C(hr, tr)) -> shift (n-1) ((C(hr, l)), tr))
  else (* n < 0 *) 
  (match i with
     (N, r) -> shift (n+1) (N, C(0, r))
   | ((C(hl, tl)), r) -> shift (n+1) (tl, C(hl, r)))

(**** From rational ****)
let corec[constructor] from_rationali q = match q with (a, b) ->
  (* supposes that b is not dividable by p, and outputs an integer part *)
  if a = 0 then N
  else let d = euclid p a b in
       C (d, from_rationali ((a - b * d) / p, b))

let rec from_rational a b = (* creates a/b in base p *)
  let rec divide_by_p b =
    if b mod p = 0 then 
    (match divide_by_p (b/p) with resb, resn -> (resb, resn + 1))
    else b, 0 
  in
    match divide_by_p b with b2, n ->
    let res = from_rationali (a, b2) in
    shift (-n) (res, N)

let i0 = from_rational 8 3
let i1 = from_rational 8 21

(**** To string ****)
type sep = I1 | I2 of int * sep | I3 of lis * lis
let corec[separate] separate i = match i with
  N -> I1
| C(i, t) -> I2(i, separate t)

let rev l =
 let rec rev_aux l1 l2 = match l1 with
    N -> l2
  | C(h1, t1) -> (rev_aux t1 (C(h1, l2))) 
in rev_aux(l)(N)

let rec string_of_lis l = match l with
  N -> ""
| C(i, t) -> ((string_of_int i) ^ (string_of_lis t))

let to_string n = match n with
 (i, f) -> (match separate i with
                I3(l1, N) -> (string_of_lis (rev l1))
              | I3(l1, l2) -> ("(" ^ (string_of_lis (rev l2)) ^ ")" ^ (string_of_lis (rev l1))) ^ "."
                                   ^ (string_of_lis (rev f)))

let printp n = print (to_string n); print "\n"

let r9 = printp i0
let r10 = printp i1

(**** To float ****)
let corec[gaussian] to_floati i = match i with
    N -> 0.
  | C(h, t) -> 
      ((float_of_int h) +. (float_of_int p) *. (to_floati t))
let rec to_floatf f = match f with
    N -> 0.
  | C(h, t) -> 
      ((float_of_int h) +. (to_floatf t)) /. (float_of_int p)
let to_float n = match n with (i, f) -> (to_floati i +. to_floatf f)


let r11 = to_float(i0)
let r12 = 8. /. 3. 
let r13 = to_float(i1)
let r14 = 8. /. 21. 

(**** Addition ****)
let corec[constructor] addi arg = match arg with
    N, N, c -> (if c = 0 then N
                 else C((c mod p), (addi (N, N, c/p))))
  | (C(h, t)), N, c -> (addi (C(h, t), C(0, N), c))
  | N, (C(h, t)), c -> (addi (C(0, N), C(h, t), c))
  | (C(hi, ti)), (C(hj, tj)), c -> (let res = hi + hj + c in
      C((res mod p), (addi (ti, tj, res / p))))
let rec addf j1 j2 = match j1, j2 with
    N, N -> (N, 0)
  | (C(h, t)), N -> (C(h, t), 0)
  | N, (C(h, t)) -> (C(h, t), 0)
  | (C(h1, t1)), C(h2, t2) ->
       (match addf t1 t2 with t, c ->
        let d = h1 + h2 + c in
        C((d mod p), t), d/p)
let add n1 n2 = match n1, n2 with (i1, f1), (i2, f2) ->
    match addf f1 f2 with f, c ->
    let i = addi (i1, i2, c) in
    (i, f)

let r15 = to_float (add i0 i1)
let r16 = to_float i0 +. to_float i1
let a = match i0 with (a, b) -> a
let b = match i1 with (a, b) -> a

(**** Multiplication ****)
let corec[constructor] mult1 arg = match arg with
(* calculates i * j + c, where i is a p-adic integer, j is a digit and c a carry *)
    N, d, c -> if c = 0 then N 
             else C (c mod p, mult1 (N, d, c/p))
  | (C(hi, ti)), d, c -> (let res = hi * d + c in
             C(res mod p, mult1 (ti, d, res / p)))

let corec[constructor] multi arg = match arg with
    n1, N, c -> c
  | n1, (C(h2, t2)), c ->
    (match (addi ((mult1 (n1, h2, 0)), c, 0)) with
      N -> (C(0, multi (n1, t2, 0)))
    | (C(hr, tr)) -> (C(hr, multi (n1, t2, tr))) )

let rec len l = match l with
(* for finite lists *)
  N -> 0
| C(i, t) -> (1 + len t)

let mult n1 n2 = match n1, n2 with ((i1, f1),(i2, f2)) ->
    let l1 = len f1 in let l2 = len f2 in
    (* remove the commas then add them back *)
    (match (shift l1 (i1, f1)), (shift l2 (i2, f2)) with
       ((i3, N), (i4, N)) ->
        (shift (- (l1 + l2)) ((multi (i3, i4, N)), N)) )

let r17 = to_float (mult i0 i1)
let r18 = to_float i0 *. to_float i1

(**** Substraction ****)
let sub n1 n2 =
  add n1 (mult n2 (from_rational (-1) 1))

let r19 = to_float (sub i0 i1)
let r20 = to_float i0 -. to_float i1

(**** Division ****)
let corec[constructor] divi arg = match arg with
     x, N -> (print "Error: cannot divide by zero"; N)
  | N, x -> N
  | (C(hi, ti)), C(hj, tj) -> let i = C(hi, ti) in let j = C(hj, tj) in
    let d = euclid p hi hj in
    (match sub (i, N) ((mult1 (j, d, 0)), N) with
       N, N -> C(d, divi (N, j))
     | (C(0, t)), N -> C(d, divi (t, j))
     (*| _ -> assert false*))

let div n1 n2 = match n1, n2 with ((i1, f1),(i2, f2)) ->
    if (normalize n2) = (N, N) 
    then (print "Error: cannot divide by zero; detected ahead"; (N, N))
    else
    let l1 = len f1 in let l2 = len f2 in
    (* remove the commas then add them back *)
    (match (shift l1 (i1, f1)), (shift l2 (i2, f2)) with
       ((i3, N), (i4, N)) ->
        (shift (- (l1 - l2)) ((divi (i3, i4)), N)) )

let r21 = to_float (div i0 i1)
let r22 = to_float i0 /. to_float i1
let r23 = div i0 (N,N)
let r24 = div i0 (zeros, C(0, C(0, N)))
let r25 = normalize(zeros, N)
let r26 = normalize(zeros, C(0, C(0, N)))

let r27 = printp (div i0 i1)
let r28 = printp (div i1 i0)
let r29 = printp (normalize (div i0 i1))
let r30 = printp (normalize (div i1 i0))

