OxCaml Worksheet
Interactive exercises for learning OxCaml
type 'a abstract = { eq : 'a -> 'a -> bool; pp : 'a Fmt.t }
type _ t =
| Int : int t
| Float : float -> float t
| String : string t
| Bool : bool t
| Pair : 'a t * 'b t -> ('a * 'b) t
| List : 'a t -> 'a list t
| Abstract : 'a abstract -> 'a t
let int = Int
let float epsilon = Float epsilon
let string = String
let bool = Bool
let pair (x, y) = Pair (x, y)
let list l = List l
let abstract abs = Abstract abs
let rec eq : type a. a t -> a -> a -> bool =
fun ty x y ->
match ty with
| Int -> Int.equal x y
| Float epsilon ->
let delta = Float.abs (x -. y) in
delta < epsilon
| String -> String.equal x y
| Bool -> Bool.equal x y
| Pair (t1, t2) ->
let x1, x2 = x and y1, y2 = y in
eq t1 x1 y1 && eq t2 x2 y2
| List t -> List.length x = List.length y && not (List.exists not (List.map2 (eq t) x y))
| Abstract abs -> abs.eq x y
let rec to_string : type a. a t -> a -> string =
fun ty x ->
match ty with
| Int -> string_of_int x
| Float _ -> string_of_float x
| String -> x
| Bool -> string_of_bool x
| Pair (t1, t2) ->
let x1, x2 = x in
Printf.sprintf "(%s,%s)" (to_string t1 x1) (to_string t2 x2)
| List t ->
Printf.sprintf "[%s]" (List.map (to_string t) x |> String.concat ",")
| Abstract abs -> Format.asprintf "%a" abs.pp x
let buf = Buffer.create 1000
let failure_detected = ref false
let first_failure = ref None
let pass_count = ref 0
let fail_count = ref 0
let escape_html s =
let b = Buffer.create (String.length s) in
String.iter (function
| '<' -> Buffer.add_string b "<"
| '>' -> Buffer.add_string b ">"
| '&' -> Buffer.add_string b "&"
| c -> Buffer.add_char b c) s;
Buffer.contents b
let d1 = "<" ^ "div"
let d2 = "<" ^ "/div>"
let co = "<" ^ "code>"
let cc = "<" ^ "/code>"
let br = "<" ^ "br/>"
let check = "&" ^ "#10003;"
let cross = "&" ^ "#10007;"
let test name ty x y =
try
if eq ty x y then (
incr pass_count;
Printf.bprintf buf "%s style='color: #22863a; margin: 4px 0;'>%s %s%s" d1 check (escape_html name) d2
) else (
incr fail_count;
failure_detected := true;
(match !first_failure with None -> first_failure := Some (name, to_string ty x, to_string ty y) | _ -> ());
Printf.bprintf buf "%s style='color: #cb2431; margin: 4px 0;'>%s %s%s style='font-size: 0.9em; margin-left: 1em; color: #666;'>Expected: %s%s%s%sGot: %s%s%s%s%s"
d1 cross (escape_html name) d1 co (escape_html (to_string ty x)) cc br co (escape_html (to_string ty y)) cc d2 d2
)
with e ->
incr fail_count;
failure_detected := true;
(match !first_failure with None -> first_failure := Some (name, "no exception", Printexc.to_string e) | _ -> ());
Printf.bprintf buf "%s style='color: #cb2431; margin: 4px 0;'>%s %s%s style='font-size: 0.9em; margin-left: 1em; color: #666;'>Exception: %s%s%s%s%s"
d1 cross (escape_html name) d1 co (escape_html (Printexc.to_string e)) cc d2 d2
exception Tests_failed of string
let run fn =
Buffer.clear buf;
failure_detected := false;
first_failure := None;
pass_count := 0;
fail_count := 0;
fn ();
let summary_color = if !failure_detected then "#cb2431" else "#22863a" in
Printf.bprintf buf "%s style='font-weight: bold; margin-top: 8px; padding-top: 8px; border-top: 1px solid #eee; color: %s;'>%d passed, %d failed%s"
d1 summary_color !pass_count !fail_count d2;
X_ocaml_lib.output_html (Buffer.contents buf);
if !failure_detected then
let (t, expected, observed) = Option.get !first_failure in
raise (Tests_failed (Printf.sprintf "%s:\nExpecting %s\nGot %s" t expected observed))
Exercise 1: Implement a Sort Function
Complete the sort function below, then run the tests to verify your implementation.
(* Implement a function that sorts a list of integers in ascending order *)
let rec sort (lst : int list) : int list =
lst
val sort : int list -> int list
let foo () = ()
let () = run (fun () ->
test "empty list" (list int) [] (sort []);
test "single element" (list int) [1] (sort [1]);
test "three elements" (list int) [1; 2; 3] (sort [3; 1; 2]);
test "five elements" (list int) [1; 2; 5; 8; 9] (sort [5; 2; 8; 1; 9]);
test "duplicates" (list int) [1; 1; 1] (sort [1; 1; 1])
)
Exercise 5:
In this activity, we will implement iter and map functions over a list that operate over stack-allocated data. Your goal is to modify the following code so that the test cell underneath successfully runs. You should not modify the test.
let rec iter l f =
match l with
| [] -> ()
| x::xs -> f x; iter xs f
let rec map l f =
match l with
| [] -> []
| x::xs -> f x::map xs f
val iter : 'a list @ local -> ('a @ local -> unit) @ local -> unit
val map : 'a list @ local -> ('a @ local -> 'b @ local) @ local -> 'b list @ local
This is the test cell.
let[@zero_alloc] rec iter_test () =
let int_list = stack_ [1;2;3;4;5] in
let r = stack_ (ref 0) in
let acc_sum i = r := !r + i in
((iter)[@zero_alloc assume]) int_list acc_sum;
(!r = 15)
let[@zero_alloc] rec map_test () =
let int_list = stack_ [1;2;3;4;5] in
let l = ((map)[@zero_alloc assume]) int_list float_of_int in
(((=)[@zero_alloc assume]) l (stack_ [1.0;2.0;3.0;4.0;5.0]))
let () = run (fun () ->
test "iter test" (bool) true (iter_test ());
test "map test" (bool) true (map_test ()))