From 138d12e899d41380e0f03193cceaf6f2983666b7 Mon Sep 17 00:00:00 2001
From: Hyeonung Baek <wiserlix@gmail.com>
Date: Fri, 11 Feb 2022 02:54:21 +0900
Subject: [PATCH] Refactor function evaluation; now can partially apply

---
 ast.ml    | 16 ++++++++++++----
 eval.ml   | 30 ++++++++++++++++--------------
 parser.ml |  3 ++-
 3 files changed, 30 insertions(+), 19 deletions(-)

diff --git a/ast.ml b/ast.ml
index 4ba9063..16e389d 100644
--- a/ast.ml
+++ b/ast.ml
@@ -5,7 +5,7 @@ type t =
   | Nbool of bool
   | Nstring of string
   | Nsymbol of string
-  | Nfunction of string list * t
+  | Nfunction of string * t
   | Nexternal of string
   | Var of string
   | Let of string * t
@@ -50,6 +50,13 @@ let binop left op right =
 
 (* print ast LISP style. *)
 let print ast =
+  let rec cascade = function
+    | Nfunction (arg, e) ->
+      let args, e = cascade e in
+      arg :: args, e
+    | e -> [], e
+  in
+
   let pr = Printf.printf in
   let rec aux = function
     | Nint n -> pr "%d" n
@@ -57,9 +64,10 @@ let print ast =
     | Nbool b -> pr "%b" b
     | Nstring s -> pr "\"%s\"" s
     | Nsymbol s -> pr "#%s" s
-    | Nfunction (args, e) ->
-      pr "(lambda (%s" @@ List.hd args;
-      List.iter (pr " %s") @@ List.tl args;
+    | Nfunction (arg, e) ->
+      let args, e = cascade e in
+      pr "(lambda (%s" arg;
+      List.iter (pr " %s") args;
       pr ") "; aux e; pr ")"
     | Nexternal e -> pr "(extern %s)" e
 
diff --git a/eval.ml b/eval.ml
index 422dead..aedc480 100644
--- a/eval.ml
+++ b/eval.ml
@@ -7,7 +7,7 @@ type value =
   | Bool of bool
   | String of string
   | Symbol of string
-  | Function of string list * expr * env
+  | Function of string * expr * env
   | External of string
   | Nop (* return of system operations (will be deprecated) *)
 
@@ -58,8 +58,7 @@ module Value = struct
     | Bool b -> string_of_bool b
     | String s -> "\"" ^ s ^ "\""
     | Symbol s -> "symbol " ^ s
-    | Function (vars, _, _) ->
-      Printf.sprintf "function with %d arguments" @@ List.length vars
+    | Function _ -> "<fun>"
     | External f -> "external " ^ f
     | Nop -> "nop"
 
@@ -268,9 +267,7 @@ let rec eval env ast =
     | Nbool b -> Bool b
     | Nstring s -> String s
     | Nsymbol s -> Symbol s
-    | Nfunction (args, e) ->
-      let nenv = Env.make env in
-      Function (args, e, nenv)
+    | Nfunction (arg, e) -> Function (arg, e, env)
     | Nexternal f -> External f
 
     | Var v -> begin match Env.get_opt env v with
@@ -295,19 +292,24 @@ let rec eval env ast =
         | Bool false -> aux el
         | v -> raise @@ Type.Invalid (Value.typeof v)
       end
+
     | Apply (v, args) ->
       begin match aux v with
-        | Function (vars, e, env) ->
-          assert_same_length vars args;
-          let args = List.map aux args in
-          let nenv = Env.make env in
-          List.combine vars args
-          |> List.iter (fun (v, a) -> Env.set nenv v a);
-          eval nenv e
+        | Function (var, e, env) as f ->
+          begin match args with
+            | [] -> f
+            | a::args ->
+              let nenv = Env.make env in
+              Env.set nenv var (aux a);
+              eval nenv @@ Apply (e, args)
+          end
         | External f ->
           let args = List.map aux args in
           External.apply f args
-        | v -> raise @@ Type.Invalid (Value.typeof v)
+        | v ->
+          if args = []
+          then v
+          else raise @@ Type.Invalid (Value.typeof v)
       end
 
     | Set_binop_pre (op, l) ->
diff --git a/parser.ml b/parser.ml
index 96dd209..5f50188 100644
--- a/parser.ml
+++ b/parser.ml
@@ -232,7 +232,8 @@ and lambda seq =
   let vars, seq = more any_ident seq in
   let _, seq = token Right_arrow seq in
   let e, seq = expr min_int seq in
-  Nfunction (v0::vars, e), seq
+  List.fold_right (fun v f -> Nfunction (v, f)) (v0::vars) e,
+  seq
 
 (* ifexpr := "if" expr "then" expr "else" expr *)
 and ifexpr seq =