open Mp7common
let rubric_version = "1.0"
let rubric_title = "CS421 Fall 2015 MP7"
(**************************************************************************
* 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)
let parse_exp s =
match parse s with Anon e -> e
| _ -> raise (Failure ("<<"^s^">> isn't an expression.\n"))
let cps_dec dec cont ke=
match dec
with Anon e -> cps_exp e (FnContCPS ("", cont)) ke (*EmptyExnContCPS*)
| Let (x,e) -> cps_exp e (FnContCPS (x, cont)) ke (*EmptyExnContCPS*)
| LetRec (f,x,e) ->
let (i,j) = (next_index(),next_index()) in
let ecps = cps_exp e (ContVarCPS i) (ExnContVarCPS j) in
FixCPS(FnContCPS(f, cont),f,x,i,j,ecps)
let rec eval_exp_cps_aux one_step_exp_cps_eval steps env ecps =
match one_step_exp_cps_eval env ecps with
Intermediate(env1, ecps1) ->
(eval_exp_cps_aux one_step_exp_cps_eval
(Intermediate(env1, ecps1)::steps)) env1 ecps1
| result -> result::steps (* We finished or died *)
let rec eval_exp_cps_sol =
eval_exp_cps_aux Solution.one_step_exp_cps_eval []
let rec eval_exp_cps_stu =
eval_exp_cps_aux Student.one_step_exp_cps_eval []
let rec eval_dec_aux eval_exp_cps env dec =
match dec
with Anon e -> env
| Let (x,e) ->
(match eval_exp_cps env (cps_exp e External EmptyExnContCPS)
with (Final v)::rest -> ValueBinding (x,v)::env
| _ -> raise (Failure "Bug in testing program"))
| LetRec (f,x,e) ->
let (i,j) = (next_index(),next_index()) in
let ecps2 = cps_exp e (ContVarCPS i) (ExnContVarCPS j) in
let v = CPSRecClosureVal(f, x, i, j, ecps2, env) in
ValueBinding (f,v)::env
let eval_dec_slist_aux eval_exp_cps env declist =
List.fold_left
(fun e -> fun s -> eval_dec_aux eval_exp_cps e (parse s))
env
declist
let eval_dec_slist_sol = eval_dec_slist_aux eval_exp_cps_sol [];;
let eval_dec_slist_stu = eval_dec_slist_aux eval_exp_cps_stu [];;
let rubric = [
(* Problem 1, 12 pts *)
TEST3ARG(1, app_cont_to_value, [], External, (IntVal 6));
TEST3ARG(1, app_cont_to_value,
[ContBinding(1,(FnContCPS("c",ConstCPS(External, IntConst 3)),[]))],
External, (FloatVal 6.0));
TEST3ARG(1, app_cont_to_value, [ValueBinding ("a",StringVal "hi")],
(FnContCPS("b",BinOpAppCPS(External, ConcatOp, "a", "b", ExnContVarCPS 0))),
(StringVal " there"));
TEST3ARG(1, app_cont_to_value,
[ValueBinding ("a",IntVal 3);
ContBinding (4,(FnContCPS("b",ConstCPS(External, IntConst 3)),[]))],
(ContVarCPS 4), UnitVal);
TEST3ARG(1, app_cont_to_value,
[ValueBinding ("a",IntVal 3);
ContBinding (4,(FnContCPS("b",ConstCPS(External, IntConst 3)),[]))],
(ContVarCPS 3), (BoolVal true));
TEST3ARG(1, app_cont_to_value,
[ValueBinding ("a",IntVal 3)],
(ExnMatch EmptyExnContCPS), (IntVal 3));
TEST3ARG(1, app_cont_to_value,
[ValueBinding ("a",IntVal 3)],
(ExnMatch
(UpdateExnContCPS
([(Some 2, VarCPS(External, "a"));
(Some 3, ConstCPS(FnContCPS("b",VarCPS(External,"b")),StringConst "bye"))],
EmptyExnContCPS))),
(IntVal 3));
TEST3ARG(1, app_cont_to_value,
[ValueBinding ("a",IntVal 3)],
(ExnMatch
(UpdateExnContCPS
([(Some 1, ConstCPS(FnContCPS("b", VarCPS(External, "b")),StringConst "hi"));
(None, VarCPS(External, "a"));
(Some 3, ConstCPS(FnContCPS("c", VarCPS(External, "c")),UnitConst))],
EmptyExnContCPS))),
(IntVal 3));
TEST3ARG(1, app_cont_to_value,
[ValueBinding ("a",IntVal 3)],
(ExnMatch
(UpdateExnContCPS
([(Some 3, ConstCPS(FnContCPS("b", VarCPS(External, "b")),StringConst "hi"));
(None, VarCPS(External, "a"));
(Some 2, ConstCPS(FnContCPS("c", VarCPS(External, "c")),NilConst))],
EmptyExnContCPS))),
(IntVal 3));
TEST3ARG(1, app_cont_to_value,
[ValueBinding ("a",IntVal 3)],
(ExnMatch
(UpdateExnContCPS
([(Some 3, ConstCPS(FnContCPS("b", VarCPS(External, "b")),StringConst "hi"));
(Some 2, ConstCPS(FnContCPS("c", VarCPS(External, "c")),NilConst))],
EmptyExnContCPS))),
(IntVal 7));
TEST3ARG(1, app_cont_to_value,
[ValueBinding ("a",IntVal 3)],
(ExnMatch
(UpdateExnContCPS
([(Some 3, ConstCPS(FnContCPS("b", VarCPS(External, "b")),StringConst "hi"))],
UpdateExnContCPS
([(Some 2, ConstCPS(FnContCPS("c", VarCPS(External, "c")),NilConst))],
EmptyExnContCPS)))),
(IntVal 2));
TEST3ARG(1, app_cont_to_value,
[ValueBinding ("a",IntVal 6);
ExnContBinding(4, (UpdateExnContCPS
([(Some 2, VarCPS(External, "a"))],
ExnContVarCPS 7),
[ExnContBinding(7,(UpdateExnContCPS
([(Some 3,
ConstCPS(FnContCPS("b",VarCPS(External,"b")),
StringConst "bye"))],
EmptyExnContCPS),[]))]))],
(ExnMatch (ExnContVarCPS 4)),
(IntVal 3));
(* Problem 2, 2 pts *)
TEST2ARG(1, one_step_exp_cps_eval, [], (ConstCPS(External, IntConst 2)));
TEST2ARG(1, one_step_exp_cps_eval, [], (ConstCPS(FnContCPS("z",VarCPS(External,"z")),
IntConst 2)));
(* Problem 3, 3 pts *)
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("x", IntVal 2)],
(VarCPS(External, "x")));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("x", IntVal 2)],
(VarCPS(FnContCPS("z",VarCPS(External,"z")), "x")));
TEST2ARG(1, one_step_exp_cps_eval, [], (VarCPS(External, "x")));
(* Problem 4, 7 pts *)
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("x", IntVal 2)],
(MonOpAppCPS(External, IntNegOp, "x", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval, [],
(MonOpAppCPS(External, IntNegOp, "x", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("x", IntVal 2)],
(MonOpAppCPS(FnContCPS("z",VarCPS(External,"z")), IntNegOp, "x", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("x", ListVal [])],
(MonOpAppCPS(External, HdOp, "x",
UpdateExnContCPS([(Some 0, ConstCPS(External,IntConst 20))],
EmptyExnContCPS))));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("x", ListVal [])],
(MonOpAppCPS(FnContCPS("z",VarCPS(External,"z")), TlOp, "x",
UpdateExnContCPS([(Some 0, ConstCPS(External,IntConst 20))],
EmptyExnContCPS))));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("x", ListVal [])],
(MonOpAppCPS(External, HdOp, "x", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("x", ListVal [])],
(MonOpAppCPS(External, TlOp, "x",
UpdateExnContCPS([(Some 0, ConstCPS(FnContCPS("z",VarCPS(External,"z")),
NilConst))],
EmptyExnContCPS))));
(* Problem 5, 8 pts *)
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("b", IntVal 3);ValueBinding("a", IntVal 2)],
(BinOpAppCPS(External, IntPlusOp, "a", "b", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("b", IntVal 3)],
(BinOpAppCPS(External, IntPlusOp, "a", "b", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("a", IntVal 2)],
(BinOpAppCPS(External, IntPlusOp, "a", "b", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("b", IntVal 3);ValueBinding("a", IntVal 2)],
(BinOpAppCPS(FnContCPS("z",VarCPS(External,"z")),
IntPlusOp, "a", "b", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("d", IntVal 0);ValueBinding("c", IntVal 2)],
(BinOpAppCPS(External, IntDivOp, "c", "d",
UpdateExnContCPS([(Some 0, ConstCPS(External,IntConst 20))],
EmptyExnContCPS))));
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("d", IntVal 0);ValueBinding("c", IntVal 2)],
(BinOpAppCPS(FnContCPS("z",VarCPS(External,"z")), IntDivOp, "c", "d",
UpdateExnContCPS([(Some 0, ConstCPS(External,IntConst 20))],
EmptyExnContCPS))));
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("d", FloatVal 0.0);ValueBinding("c", FloatVal 2.3)],
(BinOpAppCPS(FnContCPS("z",VarCPS(External,"z")), FloatDivOp, "c", "d",
EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("d", FloatVal 0.0);ValueBinding("c", FloatVal 2.3)],
(BinOpAppCPS(External, FloatDivOp, "c", "d",
UpdateExnContCPS([(Some 0, ConstCPS(FnContCPS("z",VarCPS(External,"z")),
FloatConst 4.5))],
EmptyExnContCPS))));
(* Problem 6, 5 pts *)
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("a", BoolVal true)],
(IfCPS("a", ConstCPS(External,IntConst 1), ConstCPS(External,IntConst 0))));
TEST2ARG(1, one_step_exp_cps_eval, [],
(IfCPS("a", ConstCPS(External,IntConst 1), ConstCPS(External,IntConst 0))));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("a", BoolVal true)],
(IfCPS("a", ConstCPS(FnContCPS("z",VarCPS(External,"z")),StringConst "splat"),
ConstCPS(FnContCPS("z",ConstCPS(External, StringConst "plop")),
StringConst "flop"))));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("a", BoolVal false)],
(IfCPS("a", ConstCPS(External,IntConst 1), ConstCPS(External,IntConst 0))));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("a", BoolVal false)],
(IfCPS("a", ConstCPS(FnContCPS("z",VarCPS(External,"z")),StringConst "splat"),
ConstCPS(FnContCPS("z",ConstCPS(External, StringConst "plop")),
StringConst "flop"))));
(* Problem 7, 3 pts *)
TEST2ARG(1, one_step_exp_cps_eval, [], (FunCPS (External, "x", 1, 0,
VarCPS
(FnContCPS ("a",
ConstCPS
(FnContCPS ("b",
BinOpAppCPS (ContVarCPS 1, IntPlusOp, "a", "b", ExnContVarCPS 0)),
IntConst 5)),
"x"))));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("y", BoolVal false)],
(FunCPS (FnContCPS("z",VarCPS(External,"z")), "x", 1, 0,
VarCPS
(FnContCPS ("a",
ConstCPS
(FnContCPS ("b",
BinOpAppCPS (ContVarCPS 1, IntPlusOp, "a", "b", ExnContVarCPS 0)),
IntConst 5)),
"x"))));
TEST2ARG(1, one_step_exp_cps_eval, [ ValueBinding("x", BoolVal false)],
(FunCPS (External, "x", 1, 0,
VarCPS
(FnContCPS ("a",
ConstCPS
(FnContCPS ("b",
BinOpAppCPS (ContVarCPS 1, IntPlusOp, "a", "b", ExnContVarCPS 0)),
IntConst 5)),
"x"))));
(* Problem 8, 3 pts *)
TEST2ARG(1, one_step_exp_cps_eval, [],
(cps_dec (parse "let rec f n = if n = 0 then 1 else f (n - 1);;")
(VarCPS(External, "f"))
EmptyExnContCPS));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("y", IntVal 3)],
(cps_dec
(parse
"let rec even n = if n = 0 then true else if n = 1 then false else (even (n - 2));;")
(VarCPS(External, "even"))
EmptyExnContCPS));
TEST2ARG(1, one_step_exp_cps_eval, [ValueBinding("y", IntVal 3)],
(cps_dec
(parse
"let rec even n = if n = 0 then true else if n = 1 then false else (even (n - 2));;")
(VarCPS(FnContCPS("z",VarCPS(External,"z")), "even"))
EmptyExnContCPS));
(* Problem 9, 10 pts *)
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("plus5", (CPSClosureVal ("x", 1, 0,
VarCPS
(FnContCPS ("a",
ConstCPS
(FnContCPS ("b",
BinOpAppCPS (ContVarCPS 1, IntPlusOp, "a", "b", ExnContVarCPS 0)),
IntConst 5)),
"x"),
[])));
ValueBinding("c",IntVal 2)],
(AppCPS(External, "plus5", "c", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("c",IntVal 2)],
(AppCPS(External, "plus5", "c", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("plus5", (CPSClosureVal ("x", 1, 0,
VarCPS
(FnContCPS ("a",
ConstCPS
(FnContCPS ("b",
BinOpAppCPS (ContVarCPS 1, IntPlusOp, "a", "b", ExnContVarCPS 0)),
IntConst 5)),
"x"),
[])))],
(AppCPS(External, "plus5", "c", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("even",
(CPSRecClosureVal ("even", "n", 1, 0,
VarCPS
(FnContCPS ("8",
ConstCPS
(FnContCPS ("9",
BinOpAppCPS
(FnContCPS ("0",
IfCPS ("0", ConstCPS (ContVarCPS 1, BoolConst true),
VarCPS
(FnContCPS ("6",
ConstCPS
(FnContCPS ("7",
BinOpAppCPS
(FnContCPS ("1",
IfCPS ("1", ConstCPS (ContVarCPS 1, BoolConst false),
VarCPS
(FnContCPS ("2",
VarCPS
(FnContCPS ("4",
ConstCPS
(FnContCPS ("5",
BinOpAppCPS
(FnContCPS ("3",
AppCPS (ContVarCPS 1, "2", "3",
ExnContVarCPS 0)),
IntMinusOp, "4", "5", ExnContVarCPS 0)),
IntConst 2)),
"n")),
"even"))),
EqOp, "6", "7", ExnContVarCPS 0)),
IntConst 1)),
"n"))),
EqOp, "8", "9", ExnContVarCPS 0)),
IntConst 0)),
"n"),
[])));
ValueBinding ("a", IntVal 3)],
(AppCPS(External, "even", "a", EmptyExnContCPS)));
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("even",
(CPSRecClosureVal ("even", "n", 1, 0,
VarCPS
(FnContCPS ("8",
ConstCPS
(FnContCPS ("9",
BinOpAppCPS
(FnContCPS ("0",
IfCPS ("0", ConstCPS (ContVarCPS 1, BoolConst true),
VarCPS
(FnContCPS ("6",
ConstCPS
(FnContCPS ("7",
BinOpAppCPS
(FnContCPS ("1",
IfCPS ("1", ConstCPS (ContVarCPS 1, BoolConst false),
VarCPS
(FnContCPS ("2",
VarCPS
(FnContCPS ("4",
ConstCPS
(FnContCPS ("5",
BinOpAppCPS
(FnContCPS ("3",
AppCPS (ContVarCPS 1, "2", "3",
ExnContVarCPS 0)),
IntMinusOp, "4", "5", ExnContVarCPS 0)),
IntConst 2)),
"n")),
"even"))),
EqOp, "6", "7", ExnContVarCPS 0)),
IntConst 1)),
"n"))),
EqOp, "8", "9", ExnContVarCPS 0)),
IntConst 0)),
"n"),
[])))],
(AppCPS(External, "even", "a", EmptyExnContCPS))) ;
TEST2ARG(1, one_step_exp_cps_eval,
[ValueBinding("f",
(CPSRecClosureVal ("even", "n", 1, 0,
VarCPS
(FnContCPS ("8",
ConstCPS
(FnContCPS ("9",
BinOpAppCPS
(FnContCPS ("0",
IfCPS ("0", ConstCPS (ContVarCPS 1, BoolConst true),
VarCPS
(FnContCPS ("6",
ConstCPS
(FnContCPS ("7",
BinOpAppCPS
(FnContCPS ("1",
IfCPS ("1", ConstCPS (ContVarCPS 1, BoolConst false),
VarCPS
(FnContCPS ("2",
VarCPS
(FnContCPS ("4",
ConstCPS
(FnContCPS ("5",
BinOpAppCPS
(FnContCPS ("3",
AppCPS (ContVarCPS 1, "2", "3",
ExnContVarCPS 0)),
IntMinusOp, "4", "5", ExnContVarCPS 0)),
IntConst 2)),
"n")),
"even"))),
EqOp, "6", "7", ExnContVarCPS 0)),
IntConst 1)),
"n"))),
EqOp, "8", "9", ExnContVarCPS 0)),
IntConst 0)),
"n"),
[])));
ValueBinding ("a", IntVal 3)],
(AppCPS(External, "f", "a", EmptyExnContCPS)));
TEST2ARG_TWOFUN(4, eval_exp_cps_sol, eval_exp_cps_stu,
(eval_dec_slist_sol
[ "let rec div_aux n = (fun l -> if l = [] then n else if hd l = 0 then raise 5 else (div_aux n (tl l)) / (hd l));;";
"let div_by_list = fun m -> fun lst -> (try div_aux m lst with 5 -> 0);;"]),
(cps_exp (parse_exp "(div_by_list 6 [3; 2], div_by_list 6 [3; 0; 2]);;")
External EmptyExnContCPS))
]
(* This list is for extra credit problems *)
let extra_rubric = []