Commit a691dabb authored by Chris Müller's avatar Chris Müller
Browse files

cherry can construct functions now

parent 89d948a3
......@@ -30,7 +30,9 @@ enum org_cherry_value_type {
CY_STRING,
CY_CHAR,
CY_PAIR,
CY_SYMBOL
CY_SYMBOL,
CY_PRIMITIVE,
CY_PROCEDURE
};
......@@ -53,9 +55,12 @@ struct org_cherry_value {
cy_unicode_t char_value;
const cy_byte_t* symbol_value;
struct org_cherry_value* (*fun_value)(struct org_cherry_value*);
};
};
#define TO_VALUE(value) ((struct org_cherry_value*) value)
#define IS_NULL(value) (value->meta.type == CY_EMPTYLIST)
#define IS_BOOLEAN(value) (value->meta.type == CY_BOOLEAN)
#define IS_FIXNUM(value) (value->meta.type == CY_FIXNUM)
......@@ -64,6 +69,8 @@ struct org_cherry_value {
#define IS_FLOAT(value) (value->meta.type == CY_FLOAT)
#define IS_CHAR(value) (value->meta.type == CY_CHAR)
#define IS_PAIR(value) (value->meta.type == CY_PAIR)
#define IS_PRIMITIVE(value) (value->meta.type == CY_PRIMITIVE)
#define IS_PROCEDURE(value) (value->meta.type == CY_PROCEDURE)
#define org_cherry_string_size(STR) (strlen(STR) + 1)
......@@ -89,12 +96,25 @@ struct org_cherry_pair {
struct org_cherry_value* tail;
};
#define HEAD(pair) pair->head
#define TAIL(pair) pair->tail
#define TO_PAIR(obj) ((struct org_cherry_pair*) obj)
#define HEAD(pair) ((struct org_cherry_pair*) pair)->head
#define TAIL(pair) ((struct org_cherry_pair*) pair)->tail
struct org_cherry_value* org_cherry_list_cons(struct org_cherry_value* head, struct org_cherry_value* tail);
struct org_cherry_pair* org_cherry_list_cons(struct org_cherry_value* head, struct org_cherry_value* tail);
struct org_cherry_value* org_cherry_list_head(struct org_cherry_pair* pair);
struct org_cherry_value* org_cherry_list_tail(struct org_cherry_pair* pair);
struct org_cherry_procedure {
struct org_cherry_meta meta;
struct org_cherry_value* param;
struct org_cherry_value* body;
struct org_cherry_symbollist* env;
};
#define TO_PROC(obj) ((struct org_cherry_procedure*) obj)
struct org_cherry_value* org_cherry_procedure(struct org_cherry_symbollist* env,
struct org_cherry_value* param,
struct org_cherry_value* body);
// ----------------------------------------------------------------------------
// Symboltables
......@@ -158,6 +178,9 @@ extern struct org_cherry_value* org_cherry_symbol_else;
#define IS_APPLICATION(value) \
IS_PAIR(value)
#define TEXT_OF_QUOTATION(value) \
HEAD(TAIL(value))
struct org_cherry_value* org_cherry_eval(struct org_cherry_symbollist* env, struct org_cherry_value* exp);
......
......@@ -19,6 +19,89 @@
#include "cherry/runtime.h"
#include <stdlib.h>
static struct org_cherry_value*
org_cherry_eval_define(struct org_cherry_symbollist* env, struct org_cherry_value* exp)
{
struct org_cherry_value* symbol;
struct org_cherry_value* value;
if(IS_SYMBOL(HEAD(TAIL(exp)))) {
symbol = HEAD(TAIL(exp));
value = HEAD(TAIL(TAIL(exp)));
} else {
symbol = HEAD(HEAD(TAIL(exp)));
value = TO_VALUE(org_cherry_list_cons(org_cherry_symbol_lambda,
TO_VALUE(org_cherry_list_cons(TAIL(HEAD(TAIL(exp))), TAIL(TAIL(exp))))));
}
if(org_cherry_env_add(env, symbol, org_cherry_eval(env, value)))
return org_cherry_true;
else
return org_cherry_false;
}
static struct org_cherry_value*
org_cherry_eval_values(struct org_cherry_symbollist* env, struct org_cherry_value* values)
{
struct org_cherry_value* list = org_cherry_emptylist;
struct org_cherry_value* val;
while(!IS_NULL(values)) {
val = org_cherry_eval(env, HEAD(values));
values = TAIL(values);
list = org_cherry_list_cons(val, list);
}
return list;
}
static struct org_cherry_value*
org_cherry_eval_sequence(struct org_cherry_symbollist* env, struct org_cherry_value* body)
{
struct org_cherry_value* val = org_cherry_false;
while(!IS_NULL(body)) {
val = org_cherry_eval(env, HEAD(body));
body = TAIL(body);
}
return val;
}
static struct org_cherry_value*
org_cherry_apply(struct org_cherry_value* operator, struct org_cherry_value* operands)
{
if(IS_PRIMITIVE(operator))
return operator->fun_value(operands);
else if(IS_PROCEDURE(operator)) {
struct org_cherry_symbollist* env = TO_PROC(operator)->env;
org_cherry_env_push(env);
struct org_cherry_value* params = TO_PROC(operator)->param;
struct org_cherry_value* sym, val;
if(IS_VARIABLE(params))
org_cherry_env_add(env, params, operands);
else {
while(!IS_NULL(operands)) {
// check if all params are given (IS_NULL(params))
org_cherry_env_add(env, HEAD(params), HEAD(operands));
params = TAIL(params);
operands = TAIL(operands);
}
}
return org_cherry_eval_sequence(env, TO_PROC(operator)->body);
}
}
struct org_cherry_value*
org_cherry_eval(struct org_cherry_symbollist* env, struct org_cherry_value* value)
{
......@@ -26,6 +109,14 @@ org_cherry_eval(struct org_cherry_symbollist* env, struct org_cherry_value* valu
return value;
else if(IS_VARIABLE(value))
return org_cherry_env_lookup(env, value);
else if(IS_QUOTE(value))
return TEXT_OF_QUOTATION(value);
else if(IS_DEFINE(value))
return org_cherry_eval_define(env, value);
else if(IS_LAMBDA(value))
return org_cherry_procedure(env, HEAD(TAIL(value)), TAIL(TAIL(value)));
else if(IS_APPLICATION(value))
return org_cherry_apply(org_cherry_eval(env, HEAD(value)), org_cherry_eval_values(env, TAIL(value)));
fprintf(stderr, "can not eval unknown expression\n");
exit(1);
......
......@@ -729,6 +729,9 @@ org_cherry_read(struct org_cherry_context* context)
return org_cherry_symbol_from_string(org_cherry_token_string(context));
case TOK_ROUNDLEFTBRACE:
return org_cherry_read_pair(context);
case TOK_QUOTE:
return TO_VALUE(org_cherry_list_cons(org_cherry_symbol_quote,
TO_VALUE(org_cherry_list_cons(org_cherry_read(context), org_cherry_emptylist))));
default:
org_cherry_error(context, "bad input with token %s",
......
......@@ -256,18 +256,30 @@ org_cherry_symbol(const cy_byte_t* value)
return org_cherry_symbollist_get(org_cherry_global_symbollist, value);
}
struct org_cherry_value*
org_cherry_procedure(struct org_cherry_symbollist* env, struct org_cherry_value* param, struct org_cherry_value* body)
{
struct org_cherry_procedure* proc = GC_MALLOC(sizeof(struct org_cherry_procedure));
proc->meta.type = CY_PROCEDURE;
proc->body = body;
proc->param = param;
proc->env = env;
return TO_VALUE(proc);
}
// ----------------------------------------------------------------------------
// cherry list operations
// ----------------------------------------------------------------------------
struct org_cherry_pair*
struct org_cherry_value*
org_cherry_list_cons(struct org_cherry_value* head, struct org_cherry_value* tail)
{
struct org_cherry_pair* pair = GC_MALLOC(sizeof(struct org_cherry_pair));
pair->meta.type = CY_PAIR;
pair->head = head;
pair->tail = tail;
return pair;
return TO_VALUE(pair);
}
struct org_cherry_value*
......@@ -425,6 +437,9 @@ org_cherry_print(FILE* out, struct org_cherry_value* value)
}
fprintf(out, "\"");
break;
case CY_PROCEDURE:
fprintf(out, "#lambda-procedure");
break;
case CY_PAIR:
fprintf(out, "(");
print_pair(out, (struct org_cherry_pair*) value);
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment