From 383dc65308879903fe614f62b8a095a27a94531a Mon Sep 17 00:00:00 2001
From: Bernd Jendrissek <bernd.jendrissek@gmail.com>
Date: Wed, 6 Feb 2008 21:49:00 +0000
Subject: [PATCH] Implement (define (NAME ARGS ...) BODY).

---
 lisp/lisp.c        | 22 ++++++++++++++++++++++
 lisp/test-expected |  2 ++
 lisp/test-input    |  1 +
 3 files changed, 25 insertions(+)

diff --git a/lisp/lisp.c b/lisp/lisp.c
index fc0a3ea..bb238a5 100644
--- a/lisp/lisp.c
+++ b/lisp/lisp.c
@@ -36,6 +36,9 @@ struct pair {
 	union value_pointer cdr;
 };
 
+union value_pointer builtin_lambda(struct environment *env,
+				   union value_pointer rest);
+
 char const opaque_builtin_function[] = "builtin-function";
 char const opaque_builtin_macro[] = "builtin-macro";
 char const opaque_user_function[] = "user-function";
@@ -540,6 +543,24 @@ union value_pointer builtin_list_p(struct environment *env,
 	return builtin_list_p_helper(lisp_car(rest));
 }
 
+union value_pointer builtin_define(struct environment *env,
+				   union value_pointer rest)
+{
+	union value_pointer name_and_args, definition;
+	union value_pointer lambda_args, function;
+
+	name_and_args = lisp_car(rest);
+	definition = lisp_car(lisp_cdr(rest));
+
+	lambda_args = lisp_cons(lisp_cdr(name_and_args), lisp_cons(definition, constant_nil));
+
+	function = builtin_lambda(env, lambda_args);
+
+	binding_new(env, get_charseq_chars(lisp_car(name_and_args)), function);
+
+	return constant_nil;
+}
+
 union value_pointer builtin_if(struct environment *env,
 			       union value_pointer rest)
 {
@@ -643,6 +664,7 @@ int main()
 	binding_builtin(top_env, "list?", opaque_builtin_function, builtin_list_p);
 	binding_builtin(top_env, "primitive-eval", opaque_builtin_function, builtin_eval);
 
+	binding_builtin(top_env, "define", opaque_builtin_macro, builtin_define);
 	binding_builtin(top_env, "if", opaque_builtin_macro, builtin_if);
 	binding_builtin(top_env, "lambda", opaque_builtin_macro, builtin_lambda);
 	binding_builtin(top_env, "quote", opaque_builtin_macro, builtin_quote);
diff --git a/lisp/test-expected b/lisp/test-expected
index aa7c0b2..f3149fb 100644
--- a/lisp/test-expected
+++ b/lisp/test-expected
@@ -21,3 +21,5 @@ lambda -> builtin-macro
 (list? (cons 17 42)) -> #f
 (list? (cons 17 (quote ()))) -> #t
 (primitive-eval (quote (+ 17 42))) -> 59
+(define (foo a b) (+ a b)) -> ()
+(foo 17 42) -> 59
diff --git a/lisp/test-input b/lisp/test-input
index ce62fce..971388f 100644
--- a/lisp/test-input
+++ b/lisp/test-input
@@ -21,3 +21,4 @@ lambda
 (list? (cons 17 42))
 (list? (cons 17 (quote ())))
 (primitive-eval (quote (+ 17 42)))
+(define (foo a b) (+ a b)) (foo 17 42)
-- 
2.11.4.GIT