Refactor function evaluation; now can partially apply

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) ->
+    | Nfunction (arg, e) ->
-      pr "(lambda (%s" @@ List.hd args;
+      let args, e = cascade e in
-      List.iter (pr " %s") @@ List.tl args;
+      pr "(lambda (%s" arg;
+      List.iter (pr " %s") args;
       pr ") "; aux e; pr ")"
     | Nexternal e -> pr "(extern %s)" e
 

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, _, _) ->
+    | Function _ -> "<fun>"
-      Printf.sprintf "function with %d arguments" @@ List.length vars
     | 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) ->
+    | Nfunction (arg, e) -> Function (arg, e, env)
-      let nenv = Env.make env in
-      Function (args, e, nenv)
     | 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) ->
+        | Function (var, e, env) as f ->
-          assert_same_length vars args;
+          begin match args with
-          let args = List.map aux args in
+            | [] -> f
-          let nenv = Env.make env in
+            | a::args ->
-          List.combine vars args
+              let nenv = Env.make env in
-          |> List.iter (fun (v, a) -> Env.set nenv v a);
+              Env.set nenv var (aux a);
-          eval nenv e
+              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) ->

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 =