open StateCPSMonad
open Prelude

module type Instantiate = sig
  module Lang : Coderep.Lang

  val instantiate : ('a Lang.abstract -> 
                      ('b list -> ('c -> 'd -> 'd) -> 'e Lang.abstract)) -> 
                    'a -> 'e
  val printcode : ('a Lang.abstract ->
                      ('b list -> ('c -> 'd -> 'd) -> 'e Lang.abstract)) ->
                    unit
  val string_of_code : ('a Lang.abstract ->
                         ('b list -> ('c -> 'd -> 'd) -> 'e Lang.abstract)) ->
                       string
end

module Tests = functor (I : Instantiate) -> struct
open OUnit2
open I.Lang
module B = Bubblesort.SortMake(I.Lang)
open B
open I

(* generictestcase (inputs, expectedresult) = *)

(* http://stackoverflow.com/questions/9134929/print-a-list-in-ocaml *)
let rec print_list = function
      [] -> ()
      | e::l -> print_int e ; print_string " " ; print_list l

let string_of_list l = "[" ^ (String.concat ", " (List.map string_of_int l)) ^ "]"
let string_of_list_of_lists l = "[[" ^ (String.concat "], [" (List.map  (String.concat ", ") (List.map (List.map string_of_int) l))) ^ "]]"
let string_of_array (a,n) = (string_of_list (Array.to_list a)) ^ " maxIndex: " ^ (string_of_int !n)
let string_of_arraydesc ((a,n),(l,u)) = (string_of_list (Array.to_list a)) ^ " maxIndex: " ^ (string_of_int !n) ^ " lower: " ^ (string_of_int l) ^ " upper: " ^ (string_of_int u)
let string_of_rec2array r = "fst: " ^ (string_of_list (Array.to_list r.vec)) ^ "; snd: " ^ (string_of_int !(r.siz))

module IntV = struct
  type value = int
  let default = Idx.zero
  let compare x y = ret (Idx.less x y)
end

module BT = I.Lang.BoolTag
module OT = I.Lang.OptTag

(* module ILSG = ListStorageG (IntV) *)
module IAG = ArrayStorageG (IntV) (ValOpt) (BoolTag)(BT)
module ILSG2 = ListStorageG2 (IntV) (ValOpt)(OptTag)(OT)
module ILLSG2 = ListStorageG2 (ILSG2) (ValOpt)(OptTag)(OT)

module IALG = ArrayLineG(IntV)
module ILASG = ArrayStorageG (ILSG2) (ValOpt) (BoolTag) (BT)
(* module IALASG = ArrayStorageG (IALG) (ValOpt) (BoolTag) (BT) *)

(*module ILBSG = BubbleSortG (IntV) (ILSG)
module IABSG = BubbleSortG (IntV) (IAG)*)
module IL2BSG3 = BubbleSortG3 (IntV) (OptTag) (ILSG2)
module IABSG3 = BubbleSortG3 (IntV) (BoolTag) (IAG)
module ILLBSG3 = BubbleSortG3 (ILSG2) (OptTag) (ILLSG2)

(* Int-ListStorageG tests *)

(* initializer for an array with 2 elements; takes 'cont' as
  the rest-of-the-computation, so that things get executed in context *)
(*let a2 cont elts =
  let (e1,e2) = Pair.unpair elts in
  let! _  = ILSG.init () in
  let  s1 = ILSG.add e1 () in
  let  s2 = ILSG.add e2 () in
    seqM s1 (cont s2)

let testilga2 _ =
  let result = instantiate (a2 (fun shiftc ->
    seqM c (ILSG.fin ()))) (5,3) in
  assert_equal ~printer:string_of_list
    [3;5]
    result*)

(*let testilgmi2 _ =
  let result = instantiate (a2 (fun c -> 
      seqM c (
        let! l = ILSG.fin () in
        ILSG.maxIndex l))) (5,3) in
    assert_equal
    ~printer:string_of_int
    2
    result


let testilgni0 _ =
  let c _ = ret ILSG.startIndex in
  let result = instantiate c () in
    assert_equal
    ~printer:string_of_int
    1
    result

let testilgni2 _ =
  let c _ = ret (ILSG.nextIndex (ILSG.nextIndex ILSG.startIndex)) in
  let result = instantiate c () in
    assert_equal
    ~printer:string_of_int
    3
    result

let testilgib2 _ = (*indices start at 1*)
  let result = instantiate (a2 (fun l -> 
   let! ll = l in
   seqMS l (ILSG.inBounds (lift 2) ll))) (5,3) in
    assert_equal
    ~printer:string_of_bool
    true
    result*)

(*let testilgc2 _ =
  let i = ILSG.startIndex in
  let result = instantiate (a2 (fun c -> 
    seqM c (ILSG.compare i (ILSG.nextIndex i) ()))) (5,3) in
    assert_equal
      ~printer:string_of_bool
      false
      result

let testilgs2 _ =
  let i = ILSG.startIndex in
  let result = instantiate (a2 (fun s0 ->
        let s1 = ILSG.swap i (ILSG.nextIndex i) in
        seqM s0 (seqM s1 (ILSG.fin ())))) (5,3) in
    assert_equal
      ~printer:string_of_list
      [5;3]
      result

let testilgr0 _ =
  let result = instantiate (fun _ ->
    let! a = ILSG.init () in
    let s1 = ILSG.rotate (ILSG.nextIndex ILSG.startIndex) a in
    seqM s1 (ILSG.fin ())) () in
    assert_equal
      ~printer:string_of_list
      []
      result

let testilgr1 _ =
  let result = instantiate (fun e ->
    let! l0 = ILSG.init () in
    let s1  = ILSG.add e l0 in
    let s2  = ILSG.rotate (ILSG.nextIndex ILSG.startIndex) () in
    seqM s1 (seqM s2 (ILSG.fin ()))) 5 in
    assert_equal
      ~printer:string_of_list
      [5]
      result

let testilgr2 _ =
  let result = instantiate (a2 (fun a -> 
        let s2 = ILSG.rotate (ILSG.nextIndex ILSG.startIndex) () in
        seqM a (seqM s2 (ILSG.fin ())))) (5,3) in
    assert_equal
      ~printer:string_of_list
      [5;3]
      result

let testilgr4 _ =
  let result = instantiate (a2 (fun l ->
    let  s1 = ILSG.add (lift 7) () in
    let  s2 = ILSG.add (lift 9) () in
    let  s3 = ILSG.rotate (ILSG.nextIndex ILSG.startIndex) () in
    seqMS l (seqMS s1 (seqMS s2 (seqMS s3 (ILSG.fin ())))))) (5,3) in
    assert_equal
      ~printer:string_of_list
      [5;9;7;3]
      result

let testilgte _ =
  let result = instantiate (a2 (fun l0 ->
    let! tmp = ILSG.fin l0 in
      let body = fun _ n -> Tuple.tup2 n (Idx.succ n) in
    (seqM l0 (ILSG.traverseexercise tmp body Idx.zero)))) (5,3) in
    assert_equal
      ~printer:string_of_list
      [0;1]
      result*)

(* Int-ArrayStorageG tests *)
let createTestContextA cont elts =
  let (e1,e2) = Pair.unpair elts in
    let! _  = IAG.init 20 in
    let  s1 = IAG.add e1 () in
    let  s2 = IAG.add e2 () in
    seqM s1 (cont s2)

let entrypointa n args =
  let v = Pair.snd args in
  let! l0 = IAG.init n in
  let res = IAG.add v l0 in
  seqM res (IAG.fin ())

let testiaga2 _ =
  let result = instantiate (entrypointa 20) ((),5) in
    assert_equal
    ~msg:(string_of_code (entrypointa 20))
    ~printer:string_of_array
    ((Array.init 20 (function | 0 -> 5 | _ -> 0)), ref 1)
    result

(*let testiagmi2 _ =
  let result = instantiate (IAG.entrypointmi 20) (5,3) in
    assert_equal
    ~printer:string_of_int
    1
    result

let testiagni0 _ =
  let c _ = ret IAG.startIndex in
  let result = instantiate c () in
    assert_equal
    ~printer:string_of_int
    0
    result

let testiagni2 _ =
  let c _ = ret (IAG.nextIndex (IAG.nextIndex IAG.startIndex)) in
  let result = instantiate c () in
    assert_equal
    ~printer:string_of_int
    2
    result

let testiagib2 _ = (*indices start at 1*)
  let result = instantiate (createTestContextA (fun c -> 
    seqM c (IAG.inBounds (lift 2) ()))) (5,3) in
    assert_equal
    ~printer:string_of_bool
    false (*zero-based*)
    result

let testiagc2 _ =
  let i = IAG.startIndex in
  let result = instantiate (createTestContextA (fun c -> 
    seqM c (IAG.compare i (IAG.nextIndex i) ()))) (5,3) in
    assert_equal
      ~printer:string_of_bool
      false
      result

let testiags2 _ =
  let i = IAG.startIndex in
  let result = instantiate (createTestContextA (fun c -> 
    let s1 = IAG.swap i (IAG.nextIndex i) in
    seqM c (seqM s1 (IAG.fin ())))) (5,3) in
    assert_equal
      ~printer:string_of_array
      ((Array.init 20 (function | 0 -> 3 | 1 -> 5 | _ -> 0)), ref 2)
      result
*)
let testiagte _ =
  let cont = fun c ->
    let body = fun _ n -> Tuple.tup2 n (Idx.succ n) in
    seqM c (
      let! tmp = IAG.desc () in
      IAG.traverseexercise tmp body Idx.zero) in
  let result = instantiate (createTestContextA cont) (5,3) in
  assert_equal
    ~msg:(string_of_code (createTestContextA cont))
    ~printer:string_of_array
    ((Array.init 20 (function | 0 -> 0 | 1 -> 1 | _ -> 0)), ref 2)
    result

let testiagtr2i _ =
  let tbody i n = 
    let m = matchOpt n n (fun i -> Maybe.just (Idx.succ i)) in
    ret (Tuple.tup2 i m) in
  let cont res =
    seqM res (
      let! tmp = IAG.desc () in
      IAG.traverse tmp tbody (Maybe.just Idx.zero)) in
  let result = instantiate (createTestContextA cont) (5,3) in
  assert_equal
    ~msg:(string_of_code (createTestContextA cont))
    ~printer:string_of_arraydesc
    (((Array.init 20 (function | 0 -> 0 | 1 -> 1 | _ -> 0)), ref 2),(0,1))
    result

let testiagtt2i _ =
  let tbody2 _ _ n =
    let! n2 = ret (Idx.succ n) in
    ret (Tuple.tup2 (Tuple.tup2 n n2) n2) in
  let cont res =
    seqM res (
      let! tmp = IAG.desc () in
      let! tagged_res = IAG.traverseTwo tmp None tbody2 Idx.zero in
      let! arr = retN tagged_res in
      let! res = IAG.process arr None ret (fun () -> ret tmp) in
      ret (Pair.fst res)) in
  let result = instantiate (createTestContextA cont) (5,3) in
  assert_equal
    ~msg:(string_of_code (createTestContextA cont))
    ~printer:string_of_array
    ((Array.init 20 (function | 0 -> 0 | 1 -> 1 | _ -> 0)), ref 2)
    result

let testiagtt2bt _ =
  let tbody2 _ _ n =
    let! n2 = ret (Idx.succ n) in
    ret (Tuple.tup2 (Tuple.tup2 n n2) n2) in
  let cont res =
    seqM res (
      let! tmp = IAG.desc () in
      let! maybe = IAG.traverseTwo tmp None tbody2 Idx.zero in
      ret (IAG.get_tag maybe)) in
  let result = instantiate (createTestContextA cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextA cont))
    ~printer:string_of_bool
    true
    result
let testiagtt2bf _ =
  let tbody2 h h2 n =
    let! v = (IAG.access h) in
    let! v2 = (IAG.access h2) in
    ret (Tuple.tup2 (Tuple.tup2 v v2) n) in
  let cont res =
    seqM res (
      let! tmp = IAG.desc () in
      let! maybe = IAG.traverseTwo tmp None tbody2 Idx.zero in
      ret (IAG.get_tag maybe)) in
  let result = instantiate (createTestContextA cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextA cont))
    ~printer:string_of_bool
    false
    result
let testiagtt2id _ =
  let tbody2 h h2 n =
      let! v = (IAG.access h) in
      let! v2 = (IAG.access h2) in
      ret (Tuple.tup2 (Tuple.tup2 v v2) n) in
  let tbody h _ = IAG.access h in
  let cont res =
    seqM res (
      let! tmp = IAG.desc () in
      let! t_res = IAG.traverseTwo tmp (Some tbody) tbody2 Maybe.none in
      let! arr = retN t_res in
      let! res = IAG.process arr None ret (fun () -> ret tmp) in
      ret (Pair.fst res)) in
  let result = instantiate (createTestContextA cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextA cont))
    ~printer:string_of_array
    ((Array.init 20 (function | 0 -> 5 | 1 -> 3 | _ -> 0)), ref 2)
    result
let testiagtt2r _ =
  let tbody2 x1 x2 data = (*essentially rotate for two*)
    let! v2 = IAG.access x2 in
    matchM data
      (fun _ -> ret (Tuple.tup2 (Tuple.tup2 v2 v2) data))
      (let! v1 = IAG.access x1 in
        ret (Tuple.tup2 (Tuple.tup2 v2 v2) (Maybe.just v1))) in
  let tbody x data =
    matchM data
      idM
      (IAG.access x) in
  let cont res =
    seqM res (
      let! tmp = IAG.desc () in
      let! maybe = IAG.traverseTwo tmp (Some tbody) tbody2 Maybe.none in
      let! _ = IAG.process maybe None ret (fun () -> ret tmp) in
      IAG.fin ()) in
  let result = instantiate (createTestContextA cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextA cont))
    ~printer:string_of_array
    ((Array.init 20 (function | 0 -> 3 | 1 -> 5 | _ -> 0)), ref 2)
    result

(* Int-ListStorageG2 tests*)

let createTestContextL2 cont elts =
  let (e1,e2) = Pair.unpair elts in
  let! l0 = ILSG2.init () in
  let! l1 = ILSG2.add e1 l0 in
  let res = ILSG2.add e2 l1 in
  cont res

(* original intent for the context function; needs genrecloop to preserve state like seqMS *)
(*let createTestContextL2orig elts =
(*   let (e1,e2) = Pair.unpair elts in *)
  let! _ = ILSG2.init () in
  let gen self eltlst =
    CList.matchListM eltlst
    (ILSG2.fin ())
    (fun x xs -> seqMS (ILSG2.add x) (applyM self xs)) in
  genrecloop gen elts*)

(*   seqMS (ILSG2.add e1) (ILSG2.add e2) *)

let testilg2a2 _ =
  let result = instantiate (createTestContextL2 id) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 id))
    ~printer:string_of_list
    [3;5]
    result

(*let testilg2mi2 _ =
  let result = instantiate (createTestContextL2 (fun c ->
      let! l = c in
      ILSG2.maxIndex l)) (5,3) in
    assert_equal
    ~printer:string_of_int
    2
    result

let testilg2ni0 _ =
  let c _ = ret ILSG2.startIndex in
  let result = instantiate c () in
    assert_equal
    ~printer:string_of_int
    1
    result

let testilg2ni2 _ =
  let c _ = ret (ILSG2.nextIndex (ILSG2.nextIndex ILSG2.startIndex)) in
  let result = instantiate c cunit in
    assert_equal
    ~printer:string_of_int
    3
    result

let testilg2ib2 _ = (*indices start at 1*)
  let result = instantiate (createTestContextL2 (fun c -> 
       let! l = c in
       ILSG2.inBounds (lift 2) l)) (5,3) in
    assert_equal
    ~printer:string_of_bool
    true (*one-based*)
    result*)

(*let testilg2c2 _ =
    let i = ILSG2.startIndex in
  let result = instantiate (createTestContextL2 (fun c -> 
      let! l = ILSG2.fin c in
      ILSG2.compare i (ILSG2.nextIndex i) l)) (5,3) in
    assert_equal
    ~printer:string_of_bool
    false
    result

let testilg2s2 _ =
    let i = ILSG2.startIndex in
  let result = instantiate (createTestContextL2 (fun _ -> 
      let! l = ILSG2.swap i (ILSG2.nextIndex i) in
      ILSG2.fin l)) (5,3) in
    assert_equal
    ~printer:string_of_list
    [5;3]
    result*)

let testilg2tr2i _ =
  let tbody _ n = ret (Tuple.tup2 n (Idx.succ n)) in
  let cont res =
    let! lst = res in
    ILSG2.traverse lst tbody Idx.zero in
  let result = instantiate (createTestContextL2 cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 cont))
    ~printer:string_of_list
    [0;1]
    result
let testilg2tt2i _ =
  let tbody2 _ x2 n = ret (Tuple.tup2 (Tuple.tup2 n x2) (Idx.succ n)) in
  let tbody _ n = ret n in
  let cont res =
    let! lst = res in
    let! maybe = ILSG2.traverseTwo lst (Some tbody) tbody2 Idx.zero in
    ILSG2.process maybe None ret (fun () -> ret lst) in
  let result = instantiate (createTestContextL2 cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 cont))
    ~printer:string_of_list
    [0;1]
    result
let testilg2tt2bt _ =
  let tbody2 _ x2 n = ret (Tuple.tup2 (Tuple.tup2 n x2) (Idx.succ n)) in
  let tbody _ n = ret n in
  let cont res =
    let! lst = res in
    let! maybe = ILSG2.traverseTwo lst (Some tbody) tbody2 Idx.zero in
    ret (matchOpt maybe Logic.falseL (fun _ -> Logic.trueL)) in
  let result = instantiate (createTestContextL2 cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 cont))
    ~printer:string_of_bool
    true
    result
let testilg2tt2bf _ =
  let tbody2 h h2 n =
    let! v = (ILSG2.access h) in
    let! v2 = (ILSG2.access h2) in
    ret (Tuple.tup2 (Tuple.tup2 v v2) n) in
  let tbody h _ = ILSG2.access h in
  let cont res =
    let! lst = res in
    let! maybe = ILSG2.traverseTwo lst (Some tbody) tbody2 cunit in
    ret (matchOpt maybe Logic.falseL (fun _ -> Logic.trueL)) in
  let result = instantiate (createTestContextL2 cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 cont))
    ~printer:string_of_bool
    false
    result
let testilg2tt2r _ =
  let tbody2 x1 x2 data = (*essentially rotate for two*)
    let! v2 = ILSG2.access x2 in
    matchM data
      (fun _ -> ret (Tuple.tup2 (Tuple.tup2 v2 v2) data))
      (let! v1 = ILSG2.access x1 in
        ret (Tuple.tup2 (Tuple.tup2 v2 v2) (Maybe.just v1))) in
  let tbody x data =
    matchM data
      idM
      (ILSG2.access x) in
  let cont res =
    let! lst = res in
    let! maybe = ILSG2.traverseTwo lst (Some tbody) tbody2 Maybe.none in
    ILSG2.process maybe None ret (fun () -> ret lst) in
  let result = instantiate (createTestContextL2 cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 cont))
    ~printer:string_of_list
    [5;3]
    result
let testilg2r2 _ =
  let cont res =
    let! lst = res in
    ILSG2.rotate lst in
  let result = instantiate (createTestContextL2 cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 cont))
    ~printer:string_of_list
    [5;3]
    result
let testilg2r4 _ =
  let cont res =
    let! lst = res in
    let! s1 = ILSG2.add (lift 7) lst in
    let! s2 = ILSG2.add (lift 4) s1 in
    ILSG2.rotate s2 in
  let result = instantiate (createTestContextL2 cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 cont))
    ~printer:string_of_list
    [7;3;5;4]
    result

let testillg2 _ =
  let cont res =
    let! lst = res in
    let! s1 = ILSG2.add (lift 7) lst in
    let! s2 = ILLSG2.init () in
    let! s3 = ILLSG2.add s1 s2 in
    let! s4 = ILSG2.init () in
    let! s5 = ILSG2.add (lift 2) s4 in
    let! s6 = ILLSG2.add s5 s3 in
    ILLSG2.fin s6 in
  let result = instantiate (createTestContextL2 cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 cont))
    ~printer:string_of_list_of_lists
    [[2];[7;3;5]]
    result



let createTestContextAL cont elts =
  let (e1,e2) = Pair.unpair elts in
  let! l0 = IALG.init 20 in
  let! l0n = retN l0 in
  let! l1 = IALG.add l0n e1 in
  let! l1n = retN l1 in
  let res = IALG.add l1n e2 in
  cont res
let testialg _ =
  let cont res =
    let! arr = res in
    IALG.rotate arr in
  let result = instantiate (createTestContextAL cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextAL cont))
    ~printer:string_of_rec2array
    {vec = Array.init 20 (function | 0 -> 3 | 1 -> 5 | _ -> 0); siz = ref 2}
    result


(* BubbleSortG tests *)

(*let testg0 _ =
  let c _ =
    let! l = ILSG.init () in
    ILSG.fin (ILBSG.bubblesort l) in
  let result = instantiate c () in
    assert_equal
    ~printer:string_of_list
    []
    result

let testg1 _ =
  let c elt =
    let! _ = ILSG.init () in
    let s1 = ILSG.add elt () in
    let! l = ILSG.fin () in
    let res = ILBSG.bubblesort (liftRef l) in
    let s2 = ILSG.fin res in
    seqM s1 (seqM res s2) in
  let result = instantiate c 3 in
    assert_equal
    ~printer:string_of_list
    [3]
    result

let testg2e _ =
  let c elts =
    let (e1,e2) = Pair.unpair elts in
    let! _  = ILSG.init () in
    let  s1 = ILSG.add e1 () in
    let  s2 = ILSG.add e2 () in
    let! l3 = ILSG.fin () in
    let s3 = ILBSG.bubblesort (liftRef l3) in
    let s4 = ILSG.fin () in
    seqM s1 (seqM s2 (seqM s3 s4)) in
  let result = instantiate c (2,2) in
    assert_equal
    ~printer:string_of_list
    [2;2]
    result

let testg3 _ =
  let c elts =
    let (e1,e2,e3) = liftPPair elts in
    let! _  = ILSG.init () in
    let  s1 = ILSG.add e1 () in
    let  s2 = ILSG.add e2 () in
    let  s3 = ILSG.add e3 () in
    let! l3 = ILSG.fin () in
    let  s4 = ILBSG.bubblesort (liftRef l3) in
    let  s5 = ILSG.fin () in
    seqM s1 (seqM s2 (seqM s3 (seqM s4 s5))) in
  let result = instantiate c ((3,6),5) in
    assert_equal
    ~printer:string_of_list
    [3;5;6]
    result

let testag0 _ =
  let c _ =
    let! a = IAG.init 20 in
    IAG.fin (IABSG.bubblesort a) in
  let result = instantiate c () in
    assert_equal
    ~printer:string_of_array
    ((Array.make 20 0), ref 0)
    result

let testag1 _ =
  let c elt =
    let! _  = IAG.init 20 in
    let  s0 = IAG.add elt () in
    let! l = IAG.fin () in
    let s1 = IABSG.bubblesort l in
    let s2 = IAG.fin () in
    seqM s0 (seqM s1 s2) in
  let result = instantiate c 3 in
    assert_equal
    ~printer:string_of_array
    ((Array.init 20 (function | 0 -> 3 | _ -> 0)), ref 1)
    result

let testag2e _ =
  let c elts =
    let (e1,e2) = Pair.unpair elts in
    let! _  = IAG.init 20 in
    let  s1 = IAG.add e1 () in
    let  s2 = IAG.add e2 () in
    let! l3 = IAG.fin () in
    let  s3 = IABSG.bubblesort l3 in
    let  s4 = IAG.fin () in
    seqM s1 (seqM s2 (seqM s3 s4)) in
  let result = instantiate c (2,2) in
    assert_equal
    ~printer:string_of_array
    ((Array.init 20 (function | 0 -> 2 | 1 -> 2 | _ -> 0)), ref 2)
    result

let testag3 _ =
  let c elts =
    let (e1,e2,e3) = liftPPair elts in
    let! _  = IAG.init 20 in
    let  s1 = IAG.add e1 () in
    let  s2 = IAG.add e2 () in
    let  s3 = IAG.add e3 () in
    let! l3 = IAG.fin () in
    let  s4 = IABSG.bubblesort l3 in
    let  s5 = IAG.fin () in
    seqM s1 (seqM s2 (seqM s3 (seqM s4 s5))) in
  let result = instantiate c ((3,6),5) in
    assert_equal
    ~printer:string_of_array
    ((Array.init 20 (function | 0 -> 6 | 1 -> 5 | 2 -> 3 | _ -> 0)), ref 3)
    result
*)

(* Functional Tests *)
let testil2g20 _ =
  let c _ = IL2BSG3.bubblesort CList.nil in
  let result = instantiate c () in
    assert_equal
    ~printer:string_of_list
    []
    result

let testil2g21 _ =
  let c elt =
    IL2BSG3.bubblesort (CList.cons elt CList.nil) in
  let result = instantiate c 3 in
    assert_equal
    ~printer:string_of_list
    [3]
    result

let testil2g22e _ =
  let c elts =
    let (e1,e2) = Pair.unpair elts in
    IL2BSG3.bubblesort (CList.cons e1 (CList.cons e2 CList.nil)) in
  let result = instantiate c (2,2) in
    assert_equal
    ~printer:string_of_list
    [2;2]
    result
let testil2g23 _ =
  let c elts =
    let cons = CList.cons in
    let (e1,e2,e3) = liftPPair elts in
    IL2BSG3.bubblesort (cons e1 (cons e2 (cons e3 CList.nil))) in
  let result = instantiate c ((3,6),5) in
    assert_equal
      ~msg:"sorted list of values"
      ~printer:string_of_list
      [6;5;3]
      result

(*let testilg33 _ =
  let c elts =
    let (e1,e2,e3) = liftPPair elts in
    let! core = ILSG.init () in
      seqM (seqM ( seqM ( seqM
      (ILSG.add e1)
      (ILSG.add e2) )
      (ILSG.add e3) )
      (ILBSG3.bubblesort ()) )
      (ILSG.fin ()) in
  let result = instantiate c ((3,6),5) in
    assert_equal
    ~printer:string_of_list
    [3;5;6]
    result*)

let testiagbs32 _ =
  let cont res =
    seqM res (
    let s1 = IAG.add (lift 7) () in
    let s2 = IAG.add (lift 4) () in
    seqM (seqM s1 s2) (
    let! arrdesc = IAG.desc () in
    IABSG3.bubblesort arrdesc)) in
  let result = instantiate (createTestContextA cont) (3,5) in
    assert_equal
    ~msg:(string_of_code (createTestContextA cont))
    ~printer:string_of_arraydesc
    (((Array.init 20 (function | 0 -> 7 | 1 -> 5 | 2 -> 4 | 3 -> 3 | _ -> 0)), ref 4), (0, 3))
    result

let testil2bs32 _ =
  let cont res =
    let! lst = res in
    IL2BSG3.bubblesort lst in
  let result = instantiate (createTestContextL2 cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 cont))
    ~printer:string_of_list
    [5;3]
    result

let testil2bs34 _ =
  let cont res =
    let! lst = res in
    let! s1 = ILSG2.add (lift 7) lst in
    let! s2 = ILSG2.add (lift 4) s1 in
    IL2BSG3.bubblesort s2 in
  let result = instantiate (createTestContextL2 cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 cont))
    ~printer:string_of_list
    [7;5;4;3]
    result

let testillbs32 _ =
  let cont res =
    let! lst = res in
    let! s1 = ILSG2.add (lift 7) lst in
    let! s2 = ILLSG2.init () in
    let! s3 = ILLSG2.add s1 s2 in
    let! s4 = ILSG2.init () in
    let! s5 = ILSG2.add (lift 5) s4 in
    let! s6 = ILSG2.add (lift 3) s5 in
    let! s7 = ILSG2.add (lift 7) s6 in
    let! s8 = ILLSG2.add s7 s3 in
    ILLBSG3.bubblesort s8 in
  let result = instantiate (createTestContextL2 cont) (5,3) in
    assert_equal
    ~msg:(string_of_code (createTestContextL2 cont))
    ~printer:string_of_list_of_lists
    [[7;3;5];[7;3;5]]
    result

(* assembling tests into suites *)
let ksgsuite =
  "KWICStorageG test suite">:::
   [(*"Adding twice to list-based storage">:: testilga2;*)
    "Adding twice to array-based storage">:: testiaga2;
    "Adding twice to list-based storage without ref">:: testilg2a2;
(*    "Max index of two-element list-based storage">:: testilgmi2;
    "Max index of two-element array-based storage">:: testiagmi2;
    "Max index of two-element list-based storage">:: testilg2mi2;*)
(*    "Start index for list-based storage">:: testilgni0;
    "Next index of two for list-based storage">:: testilgni2;
    "Start index for array-based storage">:: testiagni0;
    "Next index of two for array-based storage">:: testiagni2;*)
(*    "Start index for list-based storage without ref">:: testilg2ni0;
    "Next index of two for list-based storage without ref">:: testilg2ni2;*)
(*    "2 In bounds of two-element list-based storage indices">:: testilgib2;
    "2 In bounds of two-element array-based storage indices">:: testiagib2;
    "2 In bounds of two-element list-based storage indices without ref">:: testilg2ib2;*)
(*     "Compare whether first < second in list-based storage">:: testilgc2; *)
(*     "Compare whether first < second in array-based storage">:: testiagc2; *)
    (* "Compare whether first < second in list-based storage without ref">:: testilg2c2; *)
(*     "Swap two elements in list-based storage">:: testilgs2; *)
(*     "Swap two elements in array-based storage">:: testiags2; *)
    (* "Swap two elements in list-based storage without ref">:: testilg2s2 *)
(*     "Rotate an empty list-based storage">:: testilgr0; *)
(*    "Rotate a single-element list-based storage">:: testilgr1;
    "Rotate a two-element list-based storage">:: testilgr2;
    "Rotate a four-element list-based storage">:: testilgr4;
    "Test basic traverse for list">:: testilgte;*)
    "Test basic traverse for array">:: testiagte;
    "Test traverse for list without ref">:: testilg2tr2i;
    "Test traverse for array">:: testiagtr2i;
    "Test traverseTwo for list without ref">:: testilg2tt2i;
    "Test traverseTwo for array">:: testiagtt2i;
    "Test traverseTwo with identity function for array">:: testiagtt2id;
    "Test taggedvl denoting change using traverseTwo for list without ref">:: testilg2tt2bt;
    "Test taggedvl denoting no change using traverseTwo for list without ref">:: testilg2tt2bf;
    "Test taggedvl denoting change using traverseTwo for array">:: testiagtt2bt;
    "Test taggedvl denoting no change using traverseTwo for array">:: testiagtt2bf;
    "Test rotate using traverseTwo for list without ref">:: testilg2tt2r;
    "Test rotate using traverseTwo for array">:: testiagtt2r;
    "Test rotate for list">:: testilg2r2;
    "Test rotate for 4-elt list">:: testilg2r4;
    "Test rotate for arrayline">:: testialg;
    "Test list in a list">:: testillg2];;
let bsgsuite =
  "BubbleSortG test suite">:::
   [(*"Sort empty list-based storage">:: testg0;
    "Sort empty array-based storage">:: testag0;*)
    "Sort empty list-based storage without ref">:: testil2g20;
(*    "Sort single-element list-based storage">:: testg1;
    "Sort single-element array-based storage">:: testag1;*)
    "Sort single-element list-based storage without ref">:: testil2g21;
(*    "Sort duplicate-element list-based storage">:: testg2e;
    "Sort duplicate-element array-based storage">:: testag2e;*)
    "Sort duplicate-element list-based storage without ref">:: testil2g22e;
(*    "Sort triple-element list-based storage">:: testg3;
    "Sort triple-element array-based storage">:: testag3;*)
    "Sort triple-element list-based storage without ref">:: testil2g23;
(*     "Sort triple-element list-based storage with ref">:: testilg33; *)
    "Sort two-element array using traversal bubblesort on imperative array storage">:: testiagbs32;
    "Sort two-element list using traversal bubblesort on functional list storage">:: testil2bs32;
    "Sort four-element list using traversal bubblesort on functional list storage">:: testil2bs34;
    "Sort two-element list of lists using traversal on functional list storage containing functional lists">:: testillbs32];;

(* running test suites *)
let () =
    run_test_tt_main ksgsuite;
    run_test_tt_main bsgsuite;

  printcode (fun x -> seqMS (IAG.init 20) (IABSG3.bubblesort x));

  printcode IL2BSG3.bubblesort;
;;
end