lambda
This commit is contained in:
parent
6b6f7abbea
commit
97a7a1f3e6
|
@ -41,6 +41,9 @@ struct Object *eval(
|
||||||
if (strcmp(func_expr->s, "define") == 0) {
|
if (strcmp(func_expr->s, "define") == 0) {
|
||||||
return syntax_define(args, environment);
|
return syntax_define(args, environment);
|
||||||
}
|
}
|
||||||
|
if (strcmp(func_expr->s, "lambda") == 0) {
|
||||||
|
return syntax_lambda(args, environment);
|
||||||
|
}
|
||||||
if (strcmp(func_expr->s, "let") == 0) {
|
if (strcmp(func_expr->s, "let") == 0) {
|
||||||
return syntax_let(args, environment);
|
return syntax_let(args, environment);
|
||||||
}
|
}
|
||||||
|
|
93
src/object.c
93
src/object.c
|
@ -1,5 +1,7 @@
|
||||||
#include "object.h"
|
#include "object.h"
|
||||||
|
|
||||||
|
#include "eval.h"
|
||||||
|
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
#include <stdarg.h>
|
#include <stdarg.h>
|
||||||
#include <stddef.h>
|
#include <stddef.h>
|
||||||
|
@ -21,6 +23,10 @@ const char *Type_to_str(const enum Type type)
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/************
|
||||||
|
* Creation *
|
||||||
|
************/
|
||||||
|
|
||||||
static struct Object *new(const enum Type type)
|
static struct Object *new(const enum Type type)
|
||||||
{
|
{
|
||||||
struct Object *const object = malloc(sizeof(struct Object));
|
struct Object *const object = malloc(sizeof(struct Object));
|
||||||
|
@ -30,21 +36,6 @@ static struct Object *new(const enum Type type)
|
||||||
return object;
|
return object;
|
||||||
}
|
}
|
||||||
|
|
||||||
struct Object *Object_new_procedure(
|
|
||||||
const char *const name,
|
|
||||||
const Procedure_Func func
|
|
||||||
) {
|
|
||||||
struct Object *const object = new(TYPE_PROCEDURE);
|
|
||||||
object->procedure.name = NULL;
|
|
||||||
if (name && name[0]) {
|
|
||||||
object->procedure.name = malloc(strlen(name) + 1);
|
|
||||||
assert(object->procedure.name);
|
|
||||||
strcpy(object->procedure.name, name);
|
|
||||||
}
|
|
||||||
object->procedure.func = func;
|
|
||||||
return object;
|
|
||||||
}
|
|
||||||
|
|
||||||
struct Object *Object_new_pair(
|
struct Object *Object_new_pair(
|
||||||
struct Object *const car,
|
struct Object *const car,
|
||||||
struct Object *const cdr
|
struct Object *const cdr
|
||||||
|
@ -94,6 +85,34 @@ struct Object *Object_new_number(const int64_t i64)
|
||||||
return object;
|
return object;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
struct Object *Object_new_lambda(
|
||||||
|
const char *const name,
|
||||||
|
struct Object *const arg_names,
|
||||||
|
struct Object *const body
|
||||||
|
) {
|
||||||
|
assert(OBJECT_IS_LIST_HEAD(arg_names));
|
||||||
|
for (
|
||||||
|
struct Object *arg_name = arg_names;
|
||||||
|
!OBJECT_IS_NULL(arg_name);
|
||||||
|
arg_name = arg_name->pair.cdr
|
||||||
|
) {
|
||||||
|
assert(Object_is_pair(arg_name));
|
||||||
|
assert(Object_is_symbol(arg_name->pair.car));
|
||||||
|
}
|
||||||
|
|
||||||
|
struct Object *const object = new(TYPE_PROCEDURE);
|
||||||
|
object->procedure.name = NULL;
|
||||||
|
if (name && name[0]) {
|
||||||
|
object->procedure.name = malloc(strlen(name) + 1);
|
||||||
|
assert(object->procedure.name);
|
||||||
|
strcpy(object->procedure.name, name);
|
||||||
|
}
|
||||||
|
object->procedure.func = NULL;
|
||||||
|
object->procedure.arg_names = arg_names;
|
||||||
|
object->procedure.body = body;
|
||||||
|
return object;
|
||||||
|
}
|
||||||
|
|
||||||
struct Object *Object_build_list(int count, ...)
|
struct Object *Object_build_list(int count, ...)
|
||||||
{
|
{
|
||||||
assert(count > 0);
|
assert(count > 0);
|
||||||
|
@ -121,6 +140,10 @@ struct Object *Object_build_list(int count, ...)
|
||||||
return list;
|
return list;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/*******************
|
||||||
|
* Type predicates *
|
||||||
|
*******************/
|
||||||
|
|
||||||
bool Object_is_procedure(struct Object *object)
|
bool Object_is_procedure(struct Object *object)
|
||||||
{
|
{
|
||||||
return object && object->type == TYPE_PROCEDURE;
|
return object && object->type == TYPE_PROCEDURE;
|
||||||
|
@ -156,6 +179,10 @@ bool Object_is_number(struct Object *object)
|
||||||
return object && object->type == TYPE_NUMBER;
|
return object && object->type == TYPE_NUMBER;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/********************
|
||||||
|
* Other predicates *
|
||||||
|
********************/
|
||||||
|
|
||||||
bool Object_is_false(struct Object *object)
|
bool Object_is_false(struct Object *object)
|
||||||
{
|
{
|
||||||
return Object_is_boolean(object) && object->boolean == false;
|
return Object_is_boolean(object) && object->boolean == false;
|
||||||
|
@ -166,6 +193,10 @@ bool Object_is_true(struct Object *object)
|
||||||
return Object_is_boolean(object) && object->boolean == true;
|
return Object_is_boolean(object) && object->boolean == true;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/**************************************
|
||||||
|
* Helper functions for specific type *
|
||||||
|
**************************************/
|
||||||
|
|
||||||
size_t Object_list_length(struct Object *list_obj)
|
size_t Object_list_length(struct Object *list_obj)
|
||||||
{
|
{
|
||||||
assert(OBJECT_IS_LIST_HEAD(list_obj));
|
assert(OBJECT_IS_LIST_HEAD(list_obj));
|
||||||
|
@ -183,10 +214,11 @@ struct Object *Object_procedure_call(
|
||||||
struct Object *const procedure,
|
struct Object *const procedure,
|
||||||
struct Object *const args
|
struct Object *const args
|
||||||
) {
|
) {
|
||||||
assert(procedure);
|
|
||||||
assert(Object_is_procedure(procedure));
|
assert(Object_is_procedure(procedure));
|
||||||
assert(OBJECT_IS_LIST_HEAD(args));
|
assert(OBJECT_IS_LIST_HEAD(args));
|
||||||
|
|
||||||
|
// Builtin procedure
|
||||||
|
if (procedure->procedure.func) {
|
||||||
const size_t args_count = Object_list_length(args);
|
const size_t args_count = Object_list_length(args);
|
||||||
|
|
||||||
if (args_count == 0) {
|
if (args_count == 0) {
|
||||||
|
@ -213,4 +245,33 @@ struct Object *Object_procedure_call(
|
||||||
|
|
||||||
free(args_array);
|
free(args_array);
|
||||||
return result;
|
return result;
|
||||||
|
}
|
||||||
|
// Lambda
|
||||||
|
else {
|
||||||
|
struct Object *const environment = Object_new_pair(NULL, NULL);
|
||||||
|
|
||||||
|
for (
|
||||||
|
struct Object
|
||||||
|
*arg_name_pair = procedure->procedure.arg_names,
|
||||||
|
*arg_pair = args
|
||||||
|
;
|
||||||
|
!(OBJECT_IS_NULL(arg_name_pair)) || !(OBJECT_IS_NULL(arg_pair))
|
||||||
|
;
|
||||||
|
arg_name_pair = arg_name_pair->pair.cdr,
|
||||||
|
arg_pair = arg_pair->pair.cdr
|
||||||
|
) {
|
||||||
|
assert(!OBJECT_IS_NULL(arg_name_pair));
|
||||||
|
assert(!OBJECT_IS_NULL(arg_pair));
|
||||||
|
struct Object *const arg_name = arg_name_pair->pair.car;
|
||||||
|
struct Object *const arg = arg_pair->pair.car;
|
||||||
|
assert(Object_is_symbol(arg_name));
|
||||||
|
|
||||||
|
environment->pair.car = Object_new_pair(
|
||||||
|
Object_new_pair(arg_name, arg),
|
||||||
|
environment->pair.car
|
||||||
|
);
|
||||||
|
}
|
||||||
|
|
||||||
|
return eval(procedure->procedure.body, environment);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
26
src/object.h
26
src/object.h
|
@ -26,7 +26,11 @@ typedef struct Object *(*Procedure_Func)(
|
||||||
|
|
||||||
struct Procedure {
|
struct Procedure {
|
||||||
char *name;
|
char *name;
|
||||||
|
// For builtins
|
||||||
Procedure_Func func;
|
Procedure_Func func;
|
||||||
|
// For lambdas
|
||||||
|
struct Object *arg_names;
|
||||||
|
struct Object *body;
|
||||||
};
|
};
|
||||||
|
|
||||||
/********
|
/********
|
||||||
|
@ -69,10 +73,10 @@ struct Object {
|
||||||
|
|
||||||
const char *Type_to_str(enum Type type);
|
const char *Type_to_str(enum Type type);
|
||||||
|
|
||||||
struct Object *Object_new_procedure(
|
/************
|
||||||
const char *name,
|
* Creation *
|
||||||
Procedure_Func func
|
************/
|
||||||
);
|
|
||||||
struct Object *Object_new_pair(struct Object *car, struct Object *cdr);
|
struct Object *Object_new_pair(struct Object *car, struct Object *cdr);
|
||||||
struct Object *Object_new_boolean(bool boolean);
|
struct Object *Object_new_boolean(bool boolean);
|
||||||
struct Object *Object_new_char(char chr);
|
struct Object *Object_new_char(char chr);
|
||||||
|
@ -80,8 +84,18 @@ struct Object *Object_new_symbol(const char *s);
|
||||||
struct Object *Object_new_string(const char *s);
|
struct Object *Object_new_string(const char *s);
|
||||||
struct Object *Object_new_number(int64_t i64);
|
struct Object *Object_new_number(int64_t i64);
|
||||||
|
|
||||||
|
struct Object *Object_new_lambda(
|
||||||
|
const char *name,
|
||||||
|
struct Object *arg_names,
|
||||||
|
struct Object *body
|
||||||
|
);
|
||||||
|
|
||||||
struct Object *Object_build_list(int count, ...);
|
struct Object *Object_build_list(int count, ...);
|
||||||
|
|
||||||
|
/*******************
|
||||||
|
* Type predicates *
|
||||||
|
*******************/
|
||||||
|
|
||||||
#define OBJECT_IS_NULL(object) ((object) == NULL)
|
#define OBJECT_IS_NULL(object) ((object) == NULL)
|
||||||
bool Object_is_procedure(struct Object *object);
|
bool Object_is_procedure(struct Object *object);
|
||||||
bool Object_is_pair(struct Object *object);
|
bool Object_is_pair(struct Object *object);
|
||||||
|
@ -91,6 +105,10 @@ bool Object_is_symbol(struct Object *object);
|
||||||
bool Object_is_string(struct Object *object);
|
bool Object_is_string(struct Object *object);
|
||||||
bool Object_is_number(struct Object *object);
|
bool Object_is_number(struct Object *object);
|
||||||
|
|
||||||
|
/********************
|
||||||
|
* Other predicates *
|
||||||
|
********************/
|
||||||
|
|
||||||
#define OBJECT_IS_LIST_HEAD(object) \
|
#define OBJECT_IS_LIST_HEAD(object) \
|
||||||
(OBJECT_IS_NULL(object) || Object_is_pair(object))
|
(OBJECT_IS_NULL(object) || Object_is_pair(object))
|
||||||
bool Object_is_false(struct Object *object);
|
bool Object_is_false(struct Object *object);
|
||||||
|
|
16
src/syntax.c
16
src/syntax.c
|
@ -86,6 +86,22 @@ struct Object *syntax_if(
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
struct Object *syntax_lambda(
|
||||||
|
struct Object *const args,
|
||||||
|
struct Object *environment
|
||||||
|
) {
|
||||||
|
(void)environment;
|
||||||
|
|
||||||
|
assert(Object_is_pair(args));
|
||||||
|
struct Object *const arg_names = args->pair.car;
|
||||||
|
assert(OBJECT_IS_LIST_HEAD(arg_names));
|
||||||
|
assert(Object_is_pair(args->pair.cdr));
|
||||||
|
struct Object *const body = args->pair.cdr->pair.car;
|
||||||
|
assert(OBJECT_IS_NULL(args->pair.cdr->pair.cdr));
|
||||||
|
|
||||||
|
return Object_new_lambda(NULL, arg_names, body);
|
||||||
|
}
|
||||||
|
|
||||||
struct Object *syntax_let(
|
struct Object *syntax_let(
|
||||||
struct Object *const args,
|
struct Object *const args,
|
||||||
struct Object *environment
|
struct Object *environment
|
||||||
|
|
|
@ -17,6 +17,7 @@ struct Object *syntax_script(struct Object *args, struct Object *environment);
|
||||||
struct Object *syntax_begin(struct Object *args, struct Object *environment);
|
struct Object *syntax_begin(struct Object *args, struct Object *environment);
|
||||||
struct Object *syntax_define(struct Object *args, struct Object *environment);
|
struct Object *syntax_define(struct Object *args, struct Object *environment);
|
||||||
struct Object *syntax_if(struct Object *args, struct Object *environment);
|
struct Object *syntax_if(struct Object *args, struct Object *environment);
|
||||||
|
struct Object *syntax_lambda(struct Object *args, struct Object *environment);
|
||||||
struct Object *syntax_let(struct Object *args, struct Object *environment);
|
struct Object *syntax_let(struct Object *args, struct Object *environment);
|
||||||
struct Object *syntax_quote(struct Object *args, struct Object *environment);
|
struct Object *syntax_quote(struct Object *args, struct Object *environment);
|
||||||
|
|
||||||
|
|
|
@ -24,6 +24,16 @@
|
||||||
(assert-equal 123 (if "foo" 123 456))
|
(assert-equal 123 (if "foo" 123 456))
|
||||||
(assert-equal 456 (if #false 123 456))
|
(assert-equal 456 (if #false 123 456))
|
||||||
|
|
||||||
|
;;; lambda ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
(assert-true (procedure? (lambda () 123)))
|
||||||
|
(assert-true (procedure? (lambda (x) (+ x x))))
|
||||||
|
(assert-true (procedure? (lambda (x y) (+ x y))))
|
||||||
|
(assert-true (procedure? (lambda (x y z) (+ x y z))))
|
||||||
|
(assert-equal 123 ((lambda () 123)))
|
||||||
|
(assert-equal 3 ((lambda (x) (+ 1 x)) 2))
|
||||||
|
(assert-equal 6 ((lambda (x y) (+ 1 x y)) 2 3))
|
||||||
|
(assert-equal 10 ((lambda (x y z) (+ 1 x y z)) 2 3 4))
|
||||||
|
|
||||||
;;; let ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;; let ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
(assert-equal 'foo (let () 'foo))
|
(assert-equal 'foo (let () 'foo))
|
||||||
(assert-equal '(1) (let { [a 1] } (list a)))
|
(assert-equal '(1) (let { [a 1] } (list a)))
|
||||||
|
|
Loading…
Reference in New Issue