chained lambdas fixed

src/dune

@@ -1,4 +1,4 @@
 (executable
  (public_name zaml)
  (name main)
- (libraries zaml ast parsing typing repl interpreter))
+ (libraries zaml ast parsing typing repl interpreter evaluating))

src/evaluating/errors.ml

@@ -1,5 +1,7 @@
 exception RuntimeError of string
 
+let not_a_value () = RuntimeError "Not a value" |> raise
+
 let unbound_variable x =
   RuntimeError (Format.sprintf "Unbound variable `%s`" x) |> raise
 
@@ -8,9 +10,6 @@ let if_guard_error () = RuntimeError "If guard must be a boolean" |> raise
 let op_error () =
   RuntimeError "Operator requires the same type on both sides" |> raise
 
-let partial_app_error () =
-  RuntimeError "Partial application not allowed yet" |> raise
-
 let too_many_args num =
   RuntimeError
     (Format.sprintf

src/evaluating/eval.ml

@@ -12,7 +12,7 @@ let string_of_val = function
   | VChar c -> "'" ^ String.make 1 c ^ "'"
   | VString s -> "\"" ^ s ^ "\""
   | VBool b -> string_of_bool b
-  | Closure _ -> failwith "Not a value"
+  | Closure _ -> not_a_value ()
 
 let lookup ctx v =
   try (ECtx.find v ctx, ctx) with Not_found -> unbound_variable v
@@ -24,7 +24,7 @@ let rec value_of ctx e =
   | If (e1, e2, e3) -> eval_if ctx e1 e2 e3
   | Bop (op, e1, e2) -> eval_bop ctx op e1 e2
   | Let { name; binding; in_body } -> eval_let ctx name binding in_body
-  | Lambda { vars; body } -> (Closure { vars; body; context = ctx }, ctx)
+  | Lambda { vars; body } -> (follow_lambda vars body ctx, ctx)
   | App (e1, e2) -> eval_app ctx e1 e2
 
 and eval_const ctx = function
@@ -60,6 +60,13 @@ and eval_bop ctx op e1 e2 =
   | Eq, VInt a, VInt b -> (VBool (a = b), ctx)
   | _ -> op_error ()
 
+and follow_lambda vars body ctx =
+  match get_expr body with
+  | Lambda { vars = vars_inside; body = body_inside } ->
+      let newvars = List.append vars vars_inside in
+      follow_lambda newvars body_inside ctx
+  | _ -> Closure { vars; body; context = ctx }
+
 and eval_app ctx e1 e2 =
   let e, ctx' = value_of ctx e1 in
   match e with

test.zml

@@ -1,5 +1,14 @@
-let f1 = fun x -> fun y -> fun k -> k (k x y) (k y x)
 let f2 = fun x -> fun y -> let x = x y in fun x -> y x
-let f4 = fun x -> let y = let z = x (fun x -> x) in z in y
+let f2 = fun x -> let y = let z = x (fun x -> x) in z in y
+
+let g1 x y k = k (k x y) (k y x)
+
+let res_g1 = g1 5 10 (fun a b -> a + b)
+
+let h1 = fun x y k -> k (k x y) (k y x)
+
+let res_h1 = h1 5 10 (fun a b -> a + b)
+
+let f1 = fun x -> fun y -> fun k -> k (k x y) (k y x)
 
 let res_f1 = f1 5 10 (fun a b -> a + b)

test/eval_test/dune

@@ -0,0 +1,6 @@
+(library
+ (name eval_test)
+ (libraries parsing evaluating)
+ (inline_tests)
+ (preprocess
+  (pps ppx_expect ppx_inline_test)))

test/eval_test/eval_test.ml

@@ -0,0 +1,60 @@
+open Evaluating.Env
+open Evaluating.Eval
+
+let start_time = Sys.time ()
+let run () = ()
+
+let test str ctx =
+  Parsing.Parse.from_string str
+  |> Parsing.Parse.parse |> List.hd
+  |> Evaluating.Eval.value_of ctx
+  |> fst
+
+let%test "function" =
+  let ctx =
+    Parsing.Parse.from_string "let f1 x y k = k (k x y) (k y x)"
+    |> Parsing.Parse.parse
+    |> List.fold_left
+         (fun acc a ->
+           let _, newctx = Evaluating.Eval.value_of acc a in
+           ECtx.merge (fun _ _ x -> x) acc newctx)
+         ECtx.empty
+  in
+  match test "f1 5 10 (fun a b -> a + b)" ctx |> string_of_val with
+  | "30" -> true
+  | _ -> false
+
+let%test "one lambda" =
+  let ctx =
+    Parsing.Parse.from_string "let f1 = fun x y k -> k (k x y) (k y x)"
+    |> Parsing.Parse.parse
+    |> List.fold_left
+         (fun acc a ->
+           let _, newctx = Evaluating.Eval.value_of acc a in
+           ECtx.merge (fun _ _ x -> x) acc newctx)
+         ECtx.empty
+  in
+  match test "f1 5 10 (fun a b -> a + b)" ctx |> string_of_val with
+  | "30" -> true
+  | _ -> false
+
+let%test "chained lambdas" =
+  let ctx =
+    Parsing.Parse.from_string
+      "let f1 = fun x -> fun y -> fun k -> k (k x y) (k y x)"
+    |> Parsing.Parse.parse
+    |> List.fold_left
+         (fun acc a ->
+           let _, newctx = Evaluating.Eval.value_of acc a in
+           ECtx.merge (fun _ _ x -> x) acc newctx)
+         ECtx.empty
+  in
+  match test "f1 5 10 (fun a b -> a + b)" ctx |> string_of_val with
+  | "30" -> true
+  | _ -> false
+
+let () =
+  "Eval tests completed. Time elapsed: "
+  ^ string_of_float ((Sys.time () -. start_time) *. 1000.)
+  ^ "ms"
+  |> print_endline