type lis = N | C of int * lis
let one = C(1, N)
let two = C(1, C(2, N))
let rec zeros = C(0, zeros)
let rec ones = C(1, ones)
let rec alt = C(1, C(2, alt))
let rec alt3 = C(1, C(2, C(3, alt3)))

let corec[appears(true)] is_finite l = match l with
  N -> true
| C(h, t) -> (is_finite t)

let r1 = is_finite(one)
let r2 = is_finite(two)
let r3 = is_finite(zeros)


let corec[constructor] map arg = match arg with
  f, N -> N
| f, C(h, t) -> C(f(h), map(f,t))

let r4 = map ((fun i -> (i+1)), one)
let r5 = map ((fun i -> (i+1)), two)
let r6 = map ((fun i -> (i+1)), zeros)

let corec[appears(false)] for_all_aux arg = match arg with
  f, N -> true
| f, C(h, t) -> (f(h) && for_all_aux (f, t))
let for_all arg = not(for_all_aux arg)

let r7 = for_all ((fun i -> i = 1), one)
let r8 = for_all ((fun i -> i = 1), two)
let r9 = for_all ((fun i -> i = 1), alt)

let corec[appears(true)] exists arg = match arg with
  f, N -> false
| f, C(h, t) -> (f(h) || (exists (f, t)))

let r10 = exists ((fun i -> i = 1), one)
let r11 = exists ((fun i -> i = 0), two)
let r12 = exists ((fun i -> i = 1), alt)
let r13 = exists ((fun i -> i = 1), zeros)
let r14 = exists ((fun i -> i = 2), alt)

let corec[appears(true)] mem arg = match arg with
  e, N -> false
| e, C(h, t) -> ((e = h) || (mem (e, t)))

let r15 = mem (1, one)
let r16 = mem (0, two)
let r17 = mem (1, alt)
let r18 = mem (1, zeros)
let r19 = mem (2, alt)

let mem e l = exists ((fun i -> e = i), l)

let r20 = mem 1 one
let r21 = mem 0 two
let r22 = mem 1 alt
let r23 = mem 1 zeros
let r24 = mem 2 alt

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 r25 = separate one
let r26 = separate two
let r27 = separate ones
let r28 = separate zeros
let r29 = separate alt
let r30 = separate alt3
let r31 = separate (C(1, C(2, alt3)))

let corec[constructor] filter_naive arg = match arg with
  f, N -> N
| f, C(h, t) -> if f(h) then C(h, filter_naive(f, t)) else filter_naive(f, t)

let r32 = filter_naive ((fun i -> i = 1), ones)
(* but the following creates a "list" that just loops on itself, capsule is ("x", [x->"x"]) *)
let r33 = filter_naive ((fun i -> i < 1), ones)

let corec[constructor] filter_naive2 arg = match arg with
(* still not it ??? *)
  f, N -> N
| f, C(h, t) -> if f(h) then C(h, filter_naive2(f, t)) 
                     else if t = C(h, t) then N else filter_naive2(f, t)
let r34 = filter_naive2 ((fun i -> i = 1), alt)
(* still same problem *)
let r35 = filter_naive2 ((fun i -> i < 1), alt)

let corec[constructor] filter arg = match arg with
(* Nice little story *)
  f, N -> N
| f, C(h, t) -> if f(h) then C(h, filter(f, t)) 
                     else if exists(f, t) then filter(f, t) else N
let r36 = filter ((fun i -> i = 1), alt)
(* still same problem *)
let r37 = filter ((fun i -> i < 1), alt)

(* simplified version for the paper *)
let corec[constructor] remove_naive arg = match arg with
  e, N -> N
| e, C(h, t) -> if e = h then remove_naive(e, t) else C(h, remove_naive(e, t))
let r38 = remove_naive(1, alt)
let r39 = remove_naive(1, ones)

let corec[constructor] remove arg = match arg with
  e, N -> N
| e, C(h, t) -> if e = h then 
                (if exists((fun e1 -> e <> e1), t) then remove(e, t) else N)
                else C(h, remove(e, t))
let r40 = remove(1, alt)
let r41 = remove(1, ones)

(**** appending ****)
let corec[constructor] append arg = match arg with
  N, l2 -> l2
| (C(h, t)), l2 -> C(h, append(t, l2))

let r42 = append (one, two)
let r43 = append (two, ones)
let r44 = append (zeros, ones)
(* TODO
let corec[constructor] concat arg = match arg with
  N -> N
| C(h, t) -> append(h, (concat(t)))
*)

let corec[constructor] map2 arg = match arg with
  (f, N, N) -> N
| (f, (C(h1, t1)), (C(h2, t2))) -> C(f h1 h2, map2 (f, t1, t2))

let combine l1 l2 = map2 ((fun i j -> (i, j)), l1, l2)

let r45 = combine zeros ones
let r46 = combine zeros alt
let r47 = combine alt alt3
(* only works on lists of int, of course, but easy to fix
separate (combine alt alt3)
*)

(* TODO: need to update constructor or make a different solver + not right types
type lisp = Np | Cp of (int * int) * lisp
let corec[constructor] split l = match l with
  Np -> (N, N)
| Cp((h1, h2), t) -> match (split t) with (t1, t2) -> ((C(h1, t1)), C(h2, t2))
split Np
split(Cp((1, 2), Np))
*)

let corec[constructor] zip arg = match arg with
  N, N -> N
| (C(h1, t1)), C(h2, t2) -> C(h1, C(h2, zip (t1, t2)))

let r48 = zip (zeros, ones)
let r49 = zip (ones, zeros)
let r50 = zip (alt, alt3)

(**** List of elements of a list, possible infinite ****)
let rec insert i l = match l with
  N -> C(i, N)
| C(h, t) -> if(i < h) then C(i, C(h, t))
                  else if (i > h) then C(h, insert i t)
                  else C(h, t)

let corec[iterator(N)] set l = match l with
  N -> N
| C(h, t) -> (insert h (set t))

let r51 = insert(1)(N)
let r52 = insert(1)(C(2, N))
let r53 = insert(1)(C(1, N))
let r54 = insert(1)(C(0, N))

let r55 = set(one)
let r56 = set(two)
let r57 = set(zeros)
let r58 = set(ones)
let r59 = set(alt)
let r60 = set(alt3)

(* Equality revisited *)
type expr = Var of string | Int of int | Inj of string * expr | Pair of expr * expr
type env = Np | Cp of (string * expr) * env

let rec assoc arg = match arg with
  s, Np -> (print "Error\n"; Int(0))
| s1, Cp((s2, e), t) -> (if s1 = s2 then e else assoc(s1, t))

let corec[appears(false)] equal_aux arg = match arg with
  ((Var x1), env1), ((Var x2), env2) -> 
     equal_aux ((assoc (x1, env1), env1), (assoc (x2, env2), env2))
| ((Var x1), env1), s2 -> equal_aux ((assoc (x1, env1), env1), s2)
| s1, ((Var x2), env2) -> equal_aux (s1, (assoc (x2, env2), env2))
| (((Int i1), env1), ((Int i2), env2)) -> if i1 = i2 then true else false
| ((Inj(inj1, e3)), env1), ((Inj(inj2, e4)), env2) -> ((inj1 = inj2) && equal_aux((e3, env1), (e4, env2)))
| ((Pair(e1, e2)), env1), ((Pair(e3, e4)), env2) ->
    (equal_aux((e1, env1), (e3, env1)) && equal_aux((e1, env1), (e3, env1)))
| x -> (print "typing error"; false)

let equal arg = not(equal_aux(arg))

