eval.c 4 KB
Newer Older
Chris Müller's avatar
Chris Müller committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
/*
 * Cherry programming language
 * Copyright (C) 2013 Christoph Mueller
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

#include "cherry/runtime.h"
#include <stdlib.h>

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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);
	}
}


105
106
107
108
109
110
111
112
113
114
115
116
117
118
static struct org_cherry_value*
org_cherry_eval_if(struct org_cherry_symbollist* env, struct org_cherry_value* value)
{
	if(IS_NULL(value))
		return org_cherry_false;

	if(IS_TRUE(org_cherry_eval(env, HEAD(value))))
		return !IS_NULL(TAIL(value)) ? org_cherry_eval(env, HEAD(TAIL(value))) : org_cherry_false;
	else if(!IS_NULL(TAIL(TAIL(value))))
		return org_cherry_eval(env, HEAD(TAIL(TAIL(value))));
	else
		return org_cherry_false;
}

Chris Müller's avatar
Chris Müller committed
119
120
121
122
123
struct org_cherry_value*
org_cherry_eval(struct org_cherry_symbollist* env, struct org_cherry_value* value)
{
	if(IS_SELF_EVALUATING(value))
		return value;
124
125
126
127
128
129
	else if(IS_VARIABLE(value)) {
		if(org_cherry_env_lookup(env, value))
			return org_cherry_true;
		else
			return org_cherry_false;
	} else if(IS_QUOTE(value)) 
130
131
132
133
134
		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)));
135
136
	else if(IS_IF(value))
		return org_cherry_eval_if(env, TAIL(value));
137
138
	else if(IS_APPLICATION(value))
		return org_cherry_apply(org_cherry_eval(env, HEAD(value)), org_cherry_eval_values(env, TAIL(value)));
Chris Müller's avatar
Chris Müller committed
139
140
141
142
143
144
		
	fprintf(stderr, "can not eval unknown expression\n");
	exit(1);
	return 0;
}