trackler 2.1.0.24 → 2.1.0.25

data/tracks/ocaml/exercises/forth/.merlin

@@ -0,0 +1,5 @@
+PKG findlib
+PKG core
+PKG ounit
+S *
+B *

data/tracks/ocaml/exercises/forth/Makefile

@@ -0,0 +1,11 @@
+test: test.native
+	@./test.native
+
+test.native: *.ml *.mli
+	@corebuild -r -quiet -pkg oUnit test.native
+
+clean:
+	rm -rf _build
+	rm -f test.native
+
+.PHONY: clean

data/tracks/ocaml/exercises/forth/example.ml

@@ -0,0 +1,89 @@
+open Core
+
+let (>|>) f g x = g (f x)
+
+let string_to_int (s: string): int option =
+  Option.try_with (fun () -> Int.of_string s)
+
+type sentence = 
+| Def of string
+| Normal of string list
+
+type stack = int list
+
+type handler = stack -> stack option
+type vocabulary = handler String.Map.t
+
+let handle_binary_op f = function
+| x :: y :: xs -> Some ((f y x) :: xs)
+| _ -> None
+
+let std_vocabulary: vocabulary =
+  String.Map.empty 
+  |> Map.add ~key:"+" ~data:(handle_binary_op (+))
+  |> Map.add ~key:"-" ~data:(handle_binary_op (-))
+  |> Map.add ~key:"*" ~data:(handle_binary_op ( * ))
+  |> Map.add ~key:"/" ~data:(function | x :: y :: xs -> if x = 0 then None else Some ((y/x) :: xs) | _ -> None)
+  |> Map.add ~key:"DUP" ~data:(function | x :: xs -> Some (x :: x :: xs) | _ -> None)
+  |> Map.add ~key:"DROP" ~data:(function | _ :: xs -> Some xs | _ -> None)
+  |> Map.add ~key:"SWAP" ~data:(function | x :: y :: xs -> Some (y :: x :: xs) | _ -> None)
+  |> Map.add ~key:"OVER" ~data:(function | x :: y :: xs -> Some (y :: x :: y :: xs) | _ -> None)
+
+let (<|>) o1 o2 = match o1 with
+| None -> o2
+| Some _ -> o1
+
+let apply x f = f x
+
+let string_last = function
+| "" -> None
+| s -> Some s.[String.length s - 1]
+
+let evaluate_number (word: string) (stack: stack): stack option =
+  Option.map (string_to_int word) ~f:(fun n -> n :: stack)
+
+let evaluate_word (word: string) (vocabulary: vocabulary) (stack: stack): stack option = 
+  evaluate_number word stack <|> 
+  Option.bind (Map.find vocabulary word) ~f:(apply stack) <|>
+  None 
+
+let rec eval_all (stack: 'a) (fs: ('a -> 'a option) list): 'a option = match fs with
+| [] -> Some stack
+| f :: fs -> (match f stack with
+  | None -> None
+  | Some stack -> eval_all stack fs
+)
+
+let to_sentence (words: string): sentence =
+  if words.[0] = ':' && string_last words = Some ';'
+  then Def words
+  else Normal (String.split ~on:' ' words)
+
+let rec handle_def vocabulary stack words: (vocabulary * stack) option =
+  let words = String.split ~on:' ' words in
+  let words = List.drop words 1 in
+  let words = List.take words (List.length words - 1) in
+  if List.length words < 2
+  then None
+  else 
+    let new_vocab = List.hd_exn words in
+    if Option.is_some (string_to_int new_vocab)
+    then None
+    else
+      let def = List.drop words 1 in
+      let vocabulary = Map.add vocabulary ~key:new_vocab ~data:(fun stack -> Option.map ~f:(snd >|> List.rev) @@ evaluate_stack stack vocabulary def) in
+      Some (vocabulary, stack)
+
+and evaluate_sentence_or_fail (vocabulary: vocabulary) (stack: stack) (sentence: sentence): (vocabulary * stack) option = match sentence with
+| Normal words -> eval_all (vocabulary, stack) (List.map words ~f:(fun w -> fun (v,s) -> Option.map (evaluate_word w v s) ~f:(fun s -> (v,s))))
+| Def def -> handle_def vocabulary stack def
+
+and evaluate_stack (stack: stack) (vocabulary: vocabulary) (words: string list): (vocabulary * stack) option = 
+  List.fold words ~init:(Some (vocabulary, stack)) 
+        ~f:(fun mvs w -> (match mvs with
+          | None -> None
+          | Some (v, s) -> evaluate_sentence_or_fail v s (to_sentence w)
+          ))
+  |> Option.map ~f:(fun (v,s) -> (v, List.rev s))
+
+let evaluate words = Option.map ~f:snd @@ evaluate_stack [] std_vocabulary (List.map ~f:String.uppercase words)

data/tracks/ocaml/exercises/forth/forth.mli

@@ -0,0 +1 @@
+val evaluate : string list -> int list option

data/tracks/ocaml/exercises/forth/test.ml

@@ -0,0 +1,147 @@
+(* Test/exercise version: "1.0.0" *)
+
+open Core
+open OUnit2
+open Forth
+
+let print_int_list_option (xs: int list option) = match xs with
+| None -> "None"
+| Some xs -> "Some [" ^ String.concat ~sep:";" (List.map ~f:Int.to_string xs) ^ "]"
+let ae exp got _test_ctxt = assert_equal ~printer:print_int_list_option exp got
+
+let parsing_and_numbers_tests = [
+   "empty input results in empty stack" >::
+     ae (Some []) (evaluate []);
+   "numbers just get pushed onto the stack" >::
+     ae (Some [1; 2; 3; 4; 5]) (evaluate ["1 2 3 4 5"]);
+]
+
+
+let addition_tests = [
+   "can add two numbers" >::
+     ae (Some [3]) (evaluate ["1 2 +"]);
+   "errors if there is nothing on the stack" >::
+     ae None (evaluate ["+"]);
+   "errors if there is only one value on the stack" >::
+     ae None (evaluate ["1 +"]);
+]
+
+
+let subtraction_tests = [
+   "can subtract two numbers" >::
+     ae (Some [-1]) (evaluate ["3 4 -"]);
+   "errors if there is nothing on the stack" >::
+     ae None (evaluate ["-"]);
+   "errors if there is only one value on the stack" >::
+     ae None (evaluate ["1 -"]);
+]
+
+
+let multiplication_tests = [
+   "can multiply two numbers" >::
+     ae (Some [8]) (evaluate ["2 4 *"]);
+   "errors if there is nothing on the stack" >::
+     ae None (evaluate ["*"]);
+   "errors if there is only one value on the stack" >::
+     ae None (evaluate ["1 *"]);
+]
+
+
+let division_tests = [
+   "can divide two numbers" >::
+     ae (Some [4]) (evaluate ["12 3 /"]);
+   "performs integer division" >::
+     ae (Some [2]) (evaluate ["8 3 /"]);
+   "errors if dividing by zero" >::
+     ae None (evaluate ["4 0 /"]);
+   "errors if there is nothing on the stack" >::
+     ae None (evaluate ["/"]);
+   "errors if there is only one value on the stack" >::
+     ae None (evaluate ["1 /"]);
+]
+
+
+let combined_arithmetic_tests = [
+   "addition and subtraction" >::
+     ae (Some [-1]) (evaluate ["1 2 + 4 -"]);
+   "multiplication and division" >::
+     ae (Some [2]) (evaluate ["2 4 * 3 /"]);
+]
+
+
+let dup_tests = [
+   "copies the top value on the stack" >::
+     ae (Some [1; 1]) (evaluate ["1 DUP"]);
+   "is case-insensitive" >::
+     ae (Some [1; 2; 2]) (evaluate ["1 2 Dup"]);
+   "errors if there is nothing on the stack" >::
+     ae None (evaluate ["dup"]);
+]
+
+
+let drop_tests = [
+   "removes the top value on the stack if it is the only one" >::
+     ae (Some []) (evaluate ["1 drop"]);
+   "removes the top value on the stack if it is not the only one" >::
+     ae (Some [1]) (evaluate ["1 2 drop"]);
+   "errors if there is nothing on the stack" >::
+     ae None (evaluate ["drop"]);
+]
+
+
+let swap_tests = [
+   "swaps the top two values on the stack if they are the only ones" >::
+     ae (Some [2; 1]) (evaluate ["1 2 swap"]);
+   "swaps the top two values on the stack if they are not the only ones" >::
+     ae (Some [1; 3; 2]) (evaluate ["1 2 3 swap"]);
+   "errors if there is nothing on the stack" >::
+     ae None (evaluate ["swap"]);
+   "errors if there is only one value on the stack" >::
+     ae None (evaluate ["1 swap"]);
+]
+
+
+let over_tests = [
+   "copies the second element if there are only two" >::
+     ae (Some [1; 2; 1]) (evaluate ["1 2 over"]);
+   "copies the second element if there are more than two" >::
+     ae (Some [1; 2; 3; 2]) (evaluate ["1 2 3 over"]);
+   "errors if there is nothing on the stack" >::
+     ae None (evaluate ["over"]);
+   "errors if there is only one value on the stack" >::
+     ae None (evaluate ["1 over"]);
+]
+
+
+let user_defined_words_tests = [
+   "can consist of built-in words" >::
+     ae (Some [1; 1; 1]) (evaluate [": dup-twice dup dup ;"; "1 dup-twice"]);
+   "execute in the right order" >::
+     ae (Some [1; 2; 3]) (evaluate [": countup 1 2 3 ;"; "countup"]);
+   "can override other user-defined words" >::
+     ae (Some [1; 1; 1]) (evaluate [": foo dup ;"; ": foo dup dup ;"; "1 foo"]);
+   "can override built-in words" >::
+     ae (Some [1; 1]) (evaluate [": swap dup ;"; "1 swap"]);
+   "cannot redefine numbers" >::
+     ae None (evaluate [": 1 2 ;"]);
+   "errors if executing a non-existent word" >::
+     ae None (evaluate ["foo"]);
+]
+
+let () =
+  run_test_tt_main (
+    "forth tests" >:::
+      List.concat [
+        parsing_and_numbers_tests; 
+        addition_tests; 
+        subtraction_tests; 
+        multiplication_tests; 
+        division_tests;
+        combined_arithmetic_tests; 
+        dup_tests; 
+        drop_tests;
+        swap_tests; 
+        over_tests; 
+        user_defined_words_tests
+        ]
+  )

data/tracks/ocaml/exercises/react/.merlin

@@ -0,0 +1,5 @@
+PKG findlib
+PKG core
+PKG ounit
+S *
+B *

data/tracks/ocaml/exercises/react/HINT.md

@@ -0,0 +1,3 @@
+Feel free to change the interface if you think it can be improved.
+
+For instance, set_value can only be called on input cells, but the interface allows it to be called on compute cells (forcing a runtime check).

data/tracks/ocaml/exercises/react/Makefile

@@ -0,0 +1,11 @@
+test: test.native
+	@./test.native
+
+test.native: *.ml *.mli
+	@corebuild -r -quiet -pkg oUnit test.native
+
+clean:
+	rm -rf _build
+	rm -f test.native
+
+.PHONY: clean

data/tracks/ocaml/exercises/react/example.ml

@@ -0,0 +1,106 @@
+open Core
+
+type callback_id = int
+
+let latest_callback_id: callback_id ref = ref 0
+let latest_cell_id = ref 0
+
+type 'a cell_type = 
+  InputCell
+| ComputeCell of {one: 'a cell; f: 'a -> 'a;}
+| ComputeCell2 of {one: 'a cell; two: 'a cell; f: 'a -> 'a -> 'a;}
+and 'a cell = {
+  cell_id: int;
+  eq: 'a -> 'a -> bool;
+  value: 'a ref;
+  callbacks: (callback_id, ('a -> unit)) Hashtbl.t; 
+  cell_type: 'a cell_type;
+  observers: 'a cell list ref;
+  }
+
+let next_cell_id () =
+  let cell_id = !latest_cell_id in
+  latest_cell_id := succ !latest_cell_id;
+  cell_id
+
+let apply x f = f x
+
+let callbacks_tbl = Int.Table.create
+
+let value_of {value; _}: 'a = !value
+
+let create_input_cell ~(value: 'a) ~eq = 
+  let cell_id = next_cell_id () in
+  latest_cell_id := succ !latest_cell_id;
+  {
+    cell_id;
+    eq = eq;
+    value = ref value;
+    callbacks = callbacks_tbl (); 
+    cell_type = InputCell;
+    observers = ref [];
+  }
+
+let add_callback cell ~k = 
+  let id = !latest_callback_id in
+  Hashtbl.set cell.callbacks ~key:id ~data:k;
+  latest_callback_id := succ id;
+  id
+  
+let remove_callback cell id = 
+  Hashtbl.remove cell.callbacks id;;
+
+let call_callbacks cell =
+  Hashtbl.iter cell.callbacks ~f:(apply !(cell.value));;
+
+let dedup_cells (cells: 'a cell list): 'a cell list = 
+  List.dedup cells ~compare:(fun c1 c2 -> Int.compare c1.cell_id c2.cell_id)
+
+let update_compute_cell_value (cell: 'a cell) = 
+  let computed = match cell.cell_type with
+  | ComputeCell {one; f} -> f !(one.value)
+  | ComputeCell2 {one; two; f} -> f !(one.value) !(two.value)
+  | InputCell -> failwith "cannot call update_compute_cell on an input cell";
+  in
+  if cell.eq !(cell.value) computed
+  then false
+  else begin
+    cell.value := computed;
+    true
+  end
+
+let breadth_first_update_compute_cells (cell: 'a cell): 'a cell list =
+  let update c = List.filter !(c.observers) ~f:update_compute_cell_value in
+  let rec go cells acc =
+    let updates = dedup_cells (List.concat_map ~f:update cells) in
+    if List.is_empty updates
+    then acc
+    else go updates (updates @ acc)
+  in
+  go [cell] [cell]
+
+let set_value (cell: 'a cell) (x: 'a) = match cell.cell_type with
+| InputCell -> 
+    if not (cell.eq !(cell.value) x)
+    then begin
+      cell.value := x;
+      let cells = breadth_first_update_compute_cells cell |> dedup_cells in
+      List.iter cells ~f:call_callbacks;
+      ()
+    end
+| _ -> failwith "cannot set the value of a compute cell";;
+
+let create_compute_cell_1 one ~f ~eq = 
+  let callbacks = callbacks_tbl () in
+  let value = ref (f !(one.value)) in
+  let c = {cell_id = next_cell_id(); value; callbacks; observers = ref []; eq; cell_type = ComputeCell {one; f}} in
+  one.observers := c :: !(one.observers);
+  c
+
+let create_compute_cell_2 one two ~f ~eq = 
+  let callbacks = callbacks_tbl () in
+  let value = ref (f !(one.value) !(two.value)) in
+  let c = {cell_id = next_cell_id(); value; callbacks; observers = ref []; eq; cell_type = ComputeCell2 {one; two; f}} in
+  one.observers := c :: !(one.observers);
+  two.observers := c :: !(two.observers);
+  c

data/tracks/ocaml/exercises/react/react.mli

@@ -0,0 +1,26 @@
+type 'a cell
+type callback_id
+
+(* Creates a cell that has a value which does not depend on the value of any other cell. *)
+val create_input_cell : value: 'a -> eq: ('a -> 'a -> bool) -> 'a cell
+
+val value_of : 'a cell -> 'a
+
+(* Sets the value of an input cell. Setting the value of a compute cell is not allowed. *)
+val set_value : 'a cell -> 'a -> unit
+
+(* Creates a computed cell with one other cell as input, the value of this cell is the value of the input
+   with the function f applied to it.
+ *)
+val create_compute_cell_1 : 'a cell -> f: ('a -> 'a) -> eq: ('a -> 'a -> bool) -> 'a cell
+
+(* Creates a computed cell with two other cells as input, the value of this cell is the value of the inputs
+   with the function f applied to them.
+ *)
+val create_compute_cell_2 : 'a cell -> 'a cell -> f: ('a -> 'a -> 'a) -> eq: ('a -> 'a -> bool) -> 'a cell
+
+(* After this is called, the callback will be called whenever the cell's value is changed. *)
+val add_callback : 'a cell -> k: ('a -> unit) -> callback_id
+
+(* After this is called, the callback will be not called on changes to this cell any more. *)
+val remove_callback : 'a cell -> callback_id -> unit

data/tracks/ocaml/exercises/react/test.ml

@@ -0,0 +1,157 @@
+(* Test/exercise version: "1.0.0" *)
+
+open Core
+open OUnit2
+open React
+
+let ae exp got =
+  assert_equal ~printer:(Int.to_string) exp got;;
+
+let assert_list_eq exp got =
+  assert_equal ~printer:(List.to_string ~f:Int.to_string) exp got;;
+
+let create_int_input_cell = create_input_cell ~eq:Int.equal
+let create_compute_cell_1 = create_compute_cell_1 ~eq:Int.equal
+let create_compute_cell_2 = create_compute_cell_2 ~eq:Int.equal
+
+let tests = [
+  "creating an input cell with value then asking for its value returns the same value" >:: (fun _ctx ->
+    let cell = create_int_input_cell ~value:10 in
+    ae 10 (value_of cell)
+  );
+  "setting an input cell with a new value then asking for its value returns the new value" >:: (fun _ctx ->
+    let cell = create_int_input_cell ~value:10 in
+    set_value cell 20;
+    ae 20 (value_of cell)
+  );
+  "compute cells calculate from an initial value" >:: (fun _ctx ->
+    let cell = create_int_input_cell ~value:1 in
+    let computed = create_compute_cell_1 cell ~f:succ in
+    ae 2 (value_of computed)
+  );
+  "compute cells take inputs in the right order" >:: (fun _ctx ->
+    let one = create_int_input_cell ~value:1 in
+    let two = create_int_input_cell ~value:2 in
+    let computed = create_compute_cell_2 one two ~f:(fun x y -> x + 10 * y) in
+    ae 21 (value_of computed)
+  );
+  "compute cells update value when dependencies are changed" >:: (fun _ctx ->
+    let input = create_int_input_cell ~value:1 in
+    let computed = create_compute_cell_1 input ~f:succ in
+    set_value input 3;
+    ae 4 (value_of computed)
+  );
+  "compute cells can depend on other compute cells" >:: (fun _ctx ->
+    let input = create_int_input_cell ~value:1  in
+    let times_two = create_compute_cell_1 input ~f:(fun x -> x * 2) in
+    let times_thirty = create_compute_cell_1 input ~f:(fun x -> x * 30) in
+    let computed = create_compute_cell_2 times_two times_thirty ~f:(+) in
+    
+    ae 32 (value_of computed);
+    set_value input 3;
+    ae 96 (value_of computed)
+  );
+  "compute cells fire callbacks" >:: (fun _ctx ->
+    let input = create_int_input_cell ~value:1 in
+    let output = create_compute_cell_1 input ~f:succ in
+    let record = ref [] in
+    ignore @@ add_callback output ~k:(fun x -> record := x :: !record);
+    
+    set_value input 3;
+    assert_list_eq [4] !record
+  );
+  "input cells do not fire if no change" >:: (fun _ctx ->
+    let input = create_int_input_cell ~value:2 in
+    let record = ref [] in
+    ignore @@ add_callback input ~k:(fun x -> record := x :: !record);
+    
+    set_value input 2;
+
+    assert_list_eq [] !record;
+  );
+  "compute cells do not fire if no change" >:: (fun _ctx ->
+    let input = create_int_input_cell ~value:2 in
+    let output = create_compute_cell_1 input ~f:(fun x -> if x < 3 then 111 else 222) in
+    let record = ref [] in
+    ignore @@ add_callback output ~k:(fun x -> record := x :: !record);
+    
+    set_value input 1;
+    assert_list_eq [] !record;
+
+    set_value input 1;
+    assert_list_eq [] !record;
+  );
+  "callback cells do not fire if no change on two calls to set_value" >:: (fun _ctx ->
+    let input = create_int_input_cell ~value:2 in
+    let output = create_compute_cell_1 input ~f:(fun x -> if x < 3 then 111 else 222) in
+    let record = ref [] in
+    ignore @@ add_callback output ~k:(fun x -> record := x :: !record);
+    
+    set_value input 2;
+    set_value input 2;
+    assert_list_eq [] !record;
+  );
+  "uses the provided eq function to determine if a cell value has changed" >:: (fun _ctx ->
+    let called_eq = ref false in
+    let input = create_input_cell ~value:2 ~eq:(fun _ _ -> called_eq := true; false) in
+    
+    set_value input 2;
+    assert_bool "should call eq" !called_eq;
+  );
+  "callbacks can be added and removed" >:: (fun _ctx ->
+    let input = create_int_input_cell ~value:2 in
+    let output = create_compute_cell_1 input ~f:Fn.id  in
+    let called_callback = ref false in
+    let cb = add_callback output ~k:(fun _ -> called_callback := true) in
+    
+    remove_callback output cb;
+    set_value input 3;
+    
+    assert_bool "should not call callback" (not !called_callback);
+  );
+  "removing a callback multiple times doesn't interfere with other callbacks" >:: (fun _ctx ->
+    let input = create_int_input_cell ~value:1 in
+    let output = create_compute_cell_1 input ~f:succ in
+    let callback1_calls = ref [] in
+    let callback2_calls = ref [] in
+    let cb1 = add_callback output ~k:(fun x -> callback1_calls := x :: !callback1_calls) in
+    ignore @@ add_callback output ~k:(fun x -> callback2_calls := x :: !callback1_calls);
+    remove_callback output cb1;
+    remove_callback output cb1;
+    
+    set_value input 2;
+    
+    assert_list_eq [] !callback1_calls;
+    assert_list_eq [3] !callback2_calls;
+  );
+  "callbacks should only be called once even if multiple dependencies change" >:: (fun _ctx ->
+    let input = create_int_input_cell ~value:1 in
+    let plus_one = create_compute_cell_1 input ~f:succ in
+    let minus_one1 = create_compute_cell_1 input ~f:pred in
+    let minus_one2 = create_compute_cell_1 minus_one1 ~f:pred in
+    let output = create_compute_cell_2 plus_one minus_one2 ~f:((fun x y -> x * y)) in
+    
+    let callback1_calls = ref [] in
+    ignore @@ add_callback output ~k:(fun x -> callback1_calls := x :: !callback1_calls);
+    set_value input 4;
+    
+    assert_list_eq [10] !callback1_calls;
+  );
+  "callbacks should not be called if dependencies change but output value doesn't change" >:: (fun _ctx ->
+    let input = create_int_input_cell ~value:1 in
+    let plus_one = create_compute_cell_1 input ~f:succ in
+    let minus_one1 = create_compute_cell_1 input ~f:pred in
+    let always_two = create_compute_cell_2 plus_one minus_one1 ~f:(fun x y -> x - y) in
+    
+    let callback1_calls = ref [] in
+    ignore @@ add_callback always_two ~k:(fun x -> callback1_calls := x :: !callback1_calls);
+    set_value input 2;
+    set_value input 3;
+    set_value input 5;
+    
+    assert_list_eq [] !callback1_calls;
+  );
+]
+
+let () =
+  run_test_tt_main ("react tests" >::: tests)