multiple arguments for function

ast.ml

@@ -6,7 +6,7 @@ type t =
   | Nbool of bool
   | Nstring of string
   | Nsymbol of string
-  | Nfunction of string * t
+  | Nfunction of string list * t
   | Nexternal of string
   | Var of string
   | Let of string * t
@@ -46,13 +46,6 @@ 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
     | Nothing -> pr ""
@@ -61,8 +54,7 @@ let print ast =
     | Nbool b -> pr "%b" b
     | Nstring s -> pr "\"%s\"" s
     | Nsymbol s -> pr "#%s" s
-    | Nfunction (arg, e) ->
+    | Nfunction (arg::args, e) ->
-      let args, e = cascade e in
       pr "(lambda (%s" arg;
       List.iter (pr " %s") args;
       pr ") "; aux e; pr ")"
@@ -84,5 +76,6 @@ let print ast =
       pr "(if"; f co; f th; f el; pr ")"
     | Apply (f, args) ->
       pr "("; aux f; List.iter (fun a -> pr " "; aux a) args; pr ")"
+    | _ -> invalid_arg "Ast.print"
   in
   aux ast; pr "\n"

eval.ml

@@ -7,8 +7,8 @@ type value =
   | Bool of bool
   | String of string
   | Symbol of string
-  (* (name), arg, expression, name *)
+  (* (name), bound variables, expression, environment *)
-  | Function of string option * string * expr * env
+  | Function of string option * string list * expr * env
   | External of string
   | Nop (* return of system operations (will be deprecated) *)
 
@@ -309,30 +309,41 @@ let rec eval global env ast =
         | Bool false -> aux el
         | v -> raise @@ Type.Invalid (Value.typeof v)
       end
-    | Apply (v, args) -> apply global env v args
+    | Apply (v, args) ->
+      let args = List.map (eval global env) args in
+      apply global env v args
 
     | _ -> failwith "Eval.eval"
 
 (* apply args to result of expr *)
 and apply global env expr args =
   match eval global env expr with
-  | Function (itself, var, body, local_env) as f ->
+  | Function (itself, vars, body, local_env) as f ->
     begin match args with
       | [] -> f
-      | a::args ->
+      | args ->
-        let value = eval global env a in
+        let rec aux e = function
-        let env = (* binding itself into env for recursion *)
+          | [], [] -> [], [], e
-          itself
+          | vars, [] -> vars, [], e
-          |> Option.fold
+          | [], args -> [], args, e
-            ~none: local_env
+          | v::vars, a::args ->
-            ~some: (fun n -> Env.bind (n, f) local_env)
+            let e = Env.bind (v, a) e in
-          |> Env.bind (var, value)
+            aux e (vars, args)
         in
-        apply global env body args
+        let vars, args, env = aux local_env (vars, args) in
+        let env = (* binding itself into env for recursion *)
+          itself |> Option.fold
+            ~none: env
+            ~some: (fun n -> Env.bind (n, f) env)
+        in
+        if vars <> [] then (* partially-applied function *)
+          Function (None, vars, body, env)
+        else if args <> [] then (* reapply *)
+          apply global env body args
+        else (* eval (vars = [], args = []) *)
+          eval global env body
     end
-  | External f ->
+  | External f -> External.apply f args
-    let args = List.map (eval global env) args in
-    External.apply f args
   | v ->
     if args = [] then v
     else raise @@ Type.Invalid (Value.typeof v)

parser.ml

@@ -215,8 +215,7 @@ 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
-      List.fold_right (fun v f -> Nfunction (v, f)) (v0::vars) e,
+      Nfunction (v0::vars, e), seq)
-      seq)
 
 (* ifexpr := "if" expr "then" expr "else" expr *)
 and ifexpr seq =