open Mp10common
let rubric_version = "1.0"
let rubric_title = "CS421 Fall 2014 MP10"

(**************************************************************************
 * You can add new test cases by adding new elements to the following lists
 * Format is:
 * TEST<X>ARG(<weight>, <function_name>, <arg1>, <arg2>, ..., <argX>)
 *
 * <X> is the number of argument that the function being tested takes.
 **************************************************************************)

let parse s = Picomlparse.main Picomllex.token (Lexing.from_string s)

(* These lists are for regular problems *)

let eval_exp_tests = 
[
(* Problem 2 *)
TEST1ARG(1, eval_exp, (ConstExp(IntConst 2), []));
(* Problem 4 *)
TEST1ARG(1, eval_exp, (VarExp "x", [("x", IntVal 2)]));
TEST1ARG(2, eval_exp, (VarExp "y", [("y", FloatVal 2.4)]));
TEST1ARG(2, eval_exp, (VarExp "z", [("z", StringVal "hello")]));

(* Problem 5 *)
TEST1ARG(1, eval_exp, (MonOpAppExp(IntNegOp, ConstExp (IntConst 2)), []));

(* Problem 6 *)
TEST1ARG(1, eval_exp, (BinOpAppExp (IntPlusOp, ConstExp(IntConst(3)), ConstExp(IntConst(4))),  []));
(* Problem 7 *)
TEST1ARG(1, eval_exp, (IfExp(ConstExp(BoolConst true), 
                            ConstExp(IntConst 1), ConstExp(IntConst 0)), []));
(* Problem 8 *)
TEST1ARG(1, eval_exp, (LetInExp("y", ConstExp(IntConst 5), VarExp "y"), []));
(* Problem 9 *)
TEST1ARG(1, eval_exp, (FunExp("x", VarExp "x"), []));
TEST1ARG(1, eval_exp, (FunExp("x", BinOpAppExp (IntPlusOp,
                                    VarExp "x", VarExp "x")), []));
(* Problem 10 *)
TEST1ARG(1, eval_exp, (AppExp(FunExp("x", VarExp "x"),
                              ConstExp(IntConst 7)), []));
TEST1ARG(1, eval_exp, (MonOpAppExp
                       (HdOp,BinOpAppExp (ConsOp, ConstExp (IntConst 1),
                                            ConstExp NilConst)), []));
(* Problem 11 *)
TEST1ARG(1, eval_dec, (LetRec ("even", "x",
    IfExp (BinOpAppExp (EqOp, VarExp "x", ConstExp (IntConst 0)),
    ConstExp (BoolConst true),
    IfExp (BinOpAppExp (EqOp, VarExp "x", ConstExp (IntConst 1)),
      ConstExp (BoolConst false),
      AppExp (VarExp "even",
      BinOpAppExp (IntMinusOp, VarExp "x", ConstExp (IntConst 2)))))), []));
(* Problem 12 *)
TEST1ARG(2, eval_exp, (AppExp (VarExp "even", ConstExp (IntConst 3)),
[("even",
   RecVarVal ("even", "x",
    IfExp (BinOpAppExp (EqOp, VarExp "x", ConstExp (IntConst 0)),
     ConstExp (BoolConst true),
     IfExp (BinOpAppExp (EqOp, VarExp "x", ConstExp (IntConst 1)),
      ConstExp (BoolConst false),
      AppExp (VarExp "even",
       BinOpAppExp (IntMinusOp, VarExp "x", ConstExp (IntConst 2))))),
    []))]));
TEST1ARG(2, eval_exp, (AppExp (VarExp "r", ConstExp (IntConst 3)),
[("r",
   RecVarVal ("even", "x",
    IfExp (BinOpAppExp (EqOp, VarExp "x", ConstExp (IntConst 0)),
     ConstExp (BoolConst true),
     IfExp (BinOpAppExp (EqOp, VarExp "x", ConstExp (IntConst 1)),
      ConstExp (BoolConst false),
      AppExp (VarExp "even",
       BinOpAppExp (IntMinusOp, VarExp "x", ConstExp (IntConst 2))))),
    []))]));
TEST1ARG(2, eval_exp, (AppExp (VarExp "f", ConstExp (IntConst 3)),
 [("f",
   RecVarVal ("f", "x",
    BinOpAppExp (IntPlusOp, VarExp "x", ConstExp (IntConst 1)), []))]));
TEST1ARG(2, eval_exp, (AppExp (VarExp "g", ConstExp (IntConst 3)),
 [("f", IntVal 32);
 ("g",
   RecVarVal ("f", "x",
    BinOpAppExp (IntPlusOp, VarExp "x", ConstExp (IntConst 1)), []))]));
TEST1ARG(2, eval_exp, (AppExp (VarExp "f", ConstExp (IntConst 3)),
[("f",
   RecVarVal ("f", "x",
    IfExp
     (IfExp (BinOpAppExp (GreaterOp, ConstExp (IntConst 0), VarExp "x"),
       ConstExp (BoolConst true),
       BinOpAppExp (EqOp, VarExp "x", ConstExp (IntConst 0))),
     ConstExp (IntConst 1),
     AppExp (VarExp "f",
      BinOpAppExp (IntMinusOp, VarExp "x", ConstExp (IntConst 1)))),
    []))]));
TEST1ARG(2, eval_exp, (AppExp (VarExp "f", ConstExp (IntConst 3)),
[("f",
   RecVarVal ("f", "x",
    IfExp
     (IfExp (BinOpAppExp (GreaterOp, ConstExp (IntConst 0), VarExp "x"),
       ConstExp (BoolConst true),
       BinOpAppExp (EqOp, VarExp "x", ConstExp (IntConst 0))),
     ConstExp (IntConst 1),
     AppExp (VarExp "f",
      BinOpAppExp (IntMinusOp, VarExp "x", ConstExp (IntConst 1)))),
    [("f",
      RecVarVal ("f", "x",
       BinOpAppExp (IntPlusOp, VarExp "x", ConstExp (IntConst 1)), []))]));
  ("f",
   RecVarVal ("f", "x",
    BinOpAppExp (IntPlusOp, VarExp "x", ConstExp (IntConst 1)), []))]))
]

(* Declaration test cases should go in this list.
 * The first element of the pair is the weight of the case,
 * and the second is the string to be given to the parser.
 *)

let eval_dec_test_cases = [
(* Problems 1 and 2 *)
1, "(* Q1  and Q2*) 2;;"; 
2, "true;;";
2, "false;;";
2, "2.4;;";
2, "\"hi\";;";
2, "13;;";

(* Problem 3 *)
1, "(* Q3 *) let x = 2;;";
1, " let y = 2.4;;";
1, " let z = false;;";

(* Problem 4 - tested above *)

(* Problem 5 *)
2, "(* Q5 *) hd [3;4];;";
2, "         tl [3;4];;";
1, "         fst (3, 2);;";
1, "         snd (3, 2);;";
1, "         print_string \"hi\";;";

(* Problem 6 *)
2, "(* Q6 *) (2 * 3) / (4 - 1) ;;";
3, "         ((3.0 *. 4.0) /. (4.0 - 1.0)) +. (2.0 ** 3.0);;";
2, "         ((\"hi \" ^ \"there\", 3::[]) = (\"a\", 4::2::[])) > true;;";

(* Problem 7 *)
1, "(* Q7 *)  if true then false else true;;";
1, "          if 3 < 4 then 3 else 4;;";
1, "          if true then if true then false else true else false;;";
1, "          if if true then false else true then 3 else 4;;";

(* Problem 8 *)
1, "(* Q8 *) let z = 12 in z + z;;";
1, "         let a = 94 in let z = 4 in a;;";
1, "         let a = 94 in let z = 4 in a + z;;";
1, "         let z = let z = 4 in z + 1 in z - 3;;";
1, "         let a = 19 in let a = 23 in a;;";
(* Problem 9 *)
1, "(* Q9 *) fun x -> 3;;";
1, "         fun y -> fun z -> y + z;;";
1, "         fun x -> fun x -> fun z -> x * x * z;;";

(* Problem 10 *)
1, "(* Q10 *) (fun f -> f 4) (fun y -> y - 1);;";
1, "         (fun f -> fun x -> f x) (fun x -> x) 3;;";
1, "         (fun x -> fun y -> x * y) 3 4;;";
1, "         (fun f -> fun g -> f(g 3)) (fun x -> x + 2) (fun x -> x * 2);;";

(* Problem 11 *)
1, "(* Q11 *) let rec f y = 1;;";
1, "          let rec f x = fun x -> x;;";
1, "          let rec q a = 3 + 4;;";
1, "          let rec f x = if x = 0 then 1 else x * f (x - 1);;"]


let rubric = eval_exp_tests @ 
             (List.map 
             (fun (w,s) -> TEST1ARG(w, eval_dec, (parse s, [])))
             eval_dec_test_cases)


(* This list is for extra credit / graduate student problems *)
(*
let grad_test_cases = [
(* Problem 14 *)
1, "(* Q14 *) let f = fun x -> raise 4 in f 17.0 15;;";
(*Problem 15*)
1, "(* Q15 *) raise 1;;";
1, "(* Q16 *) 4/0;;";
1, "(* Q17 *) try 4 / 0 with 0 -> 9999;;";
]
*)
let eval_dec_test_cases2 = [
(* Problem 14 *)
1, "(* Q14 *) (raise 4) 17.0;;";
2, "          if true then raise 2 else raise 3;;";
2, "          if (raise 2) then 3 else 4;;";
2, "          hd (raise 2);;";
3, "          (raise 3) (raise 4);;";

(* Problem 15 *)
1, "(* Q15 *) raise 1;;";
1, "          raise 2;;";
3, "          raise (raise 4);;";

(* Problem 16 *)
1, "(* Q16 *) 4/0;;";
1, "          4.0 /. 0.0;;";
1, "          hd [];;";
1, "          tl [];;";

(* Problem 17 *)
2, "(* Q17 *) try 4 / 0 with 0 -> 9999;;";
2, "          try (raise 2) with 2 -> 9999;;";
2, "          try 4 with 2 -> 9999 | 3 -> 9998;;";
2, "          try raise (raise 2) with 3 -> 8888 | 2 -> 9999;;";
2, "          try if (raise 2) then false else true with 2 -> 9999;;"
]

let smart_eval_dec_student (s, t) =
        try (Student.eval_dec (s, t)) with
              Failure u -> ((None, Exn 0), t)
               | Division_by_zero -> ((None, Exn 0), t)

let smart_eval_dec_solution (s, t) =
        try (Solution.eval_dec (s, t)) with
              Failure u -> ((None, Exn 0), t)
               | Division_by_zero -> ((None, Exn 0), t)

let grad_rubric = eval_exp_tests @ 
 (*            (List.map 
             (fun (w,s) -> TEST1ARG_TWOFUN(w, smart_eval_dec_solution, smart_eval_dec_student, (parse s, [])))
             eval_dec_test_cases) @*)
             (List.map 
             (fun (w,s) -> TEST1ARG(w, eval_dec, (parse s, [])))
             eval_dec_test_cases2)


(* This list is for extra credit problems *)
let extra_test_cases = [
(* Problem 13 *)
1, "(* Q13 *) let rec f x = if x = 0 then 1 else x * f (x - 1) in f 3;;";
1, "          let rec f x = x + 1 in f 3;;";
1, "          let rec f x = x in f 2;;";
1, "          let rec f y = let rec g x = 2 in g in f;;";
1, "          let rec p x = fun y -> if x = 0 then 1 else y * p (x - 1) y in p 3 2;; ";
1, "          let rec f x = if x <= 0 then 0 else f(x - 1) in f 17;;"]


let extra_rubric = List.map
             (fun (w,s) -> TEST1ARG(w, eval_dec, (parse s, [])))
             extra_test_cases