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

Start refacting bootstrap interpreter

Seperate code analysis and evaluation process within interpreter.
parent deb92e73
# Cherry bootstrap interpreter
add_executable(bootstrap-cherry bootstrap.c)
target_link_libraries(bootstrap-cherry gc)
/*
* 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 "bootstrap.h"
#include <gc.h>
#include <stdarg.h>
// ----------------------------------------------------------------------------
// Default symbols
// ----------------------------------------------------------------------------
struct value* True = NULL;
struct value* False = NULL;
struct value* Emptylist = NULL;
struct value* Dot = NULL;
struct value* Quote = NULL;
struct value* Define = NULL;
struct value* Let = NULL;
struct value* Lambda = NULL;
struct value* If = NULL;
static void
failure(const byte_t* format, ...)
{
va_list args;
va_start(args, format);
vfprintf(stderr, format, args);
fprintf(stderr, "\n");
va_end(args);
exit(EXIT_FAILURE);
}
struct value*
alloc_value(void)
{
struct value* value = GC_MALLOC(sizeof(struct value));
if(value == NULL) {
failure("Boehm GC: out of memory in value allocation");
}
return value;
}
struct value*
symbol(const byte_t* symbol_value)
{
struct value* v = alloc_value();
v->tag = SYMBOL;
v->symbol_value = symbol_value;
return v;
}
struct value*
fixnum(fixnum_t fixnum_value)
{
struct value* v = alloc_value();
v->tag = FIXNUM;
v->fixnum_value = fixnum_value;
return v;
}
struct value*
floatpoint(float_t float_value)
{
struct value* v = alloc_value();
v->tag = FLOAT;
v->float_value = float_value;
return v;
}
struct value*
string(const byte_t* string_value)
{
struct value* v = alloc_value();
v->tag = STRING;
v->string_value = string_value;
return v;
}
struct value*
primitive(const primitive_t fun_value)
{
struct value* v = alloc_value();
v->tag = PRIMITIVE;
v->fun_value = fun_value;
return v;
}
struct value*
lambda(struct value* param, struct value* body)
{
struct value* v = alloc_value();
v->tag = LAMBDA;
v->lambda.param = param;
v->lambda.body = body;
return v;
}
struct value*
tuple(size_t size, ...)
{
struct value* v = alloc_value();
v->tag = TUPLE;
v->tuple.size = size;
v->tuple.data = GC_MALLOC(sizeof(struct value*) * size);
if(v->tuple.data == NULL)
failure("Boehm GC: Out of memory in tuple allocation");
va_list args;
va_start(args, size);
struct value* arg = va_arg(args, struct value*);
int i;
for(i = 0; i < size && arg; ++i) {
v->tuple.data[i] = arg;
arg = va_arg(args, struct value*);
}
va_end(args);
return v;
}
struct value*
dup(struct value* value)
{
struct value* cpy = alloc_value();
memcpy(cpy, value, sizeof(struct value));
return cpy;
}
struct value*
cons(struct value* head, struct value* tail)
{
struct value* v = alloc_value();
v->tag = PAIR;
HEAD(v) = head;
TAIL(v) = tail;
return v;
}
int main(int argc, char** argv)
{
return 0;
}
void
initialize(void)
{
GC_INIT();
True = alloc_value();
True->tag = BOOLEAN;
True->fixnum_value = TRUE;
False = alloc_value();
False->tag = BOOLEAN;
False->fixnum_value = FALSE;
Dot = alloc_value();
Dot->tag = DOT;
Emptylist = alloc_value();
Emptylist->tag = EMPTYLIST;
Quote = symbol("quote");
Define = symbol("define");
Let = symbol("let");
Lambda = symbol("lambda");
If = symbol("If");
}
// ----------------------------------------------------------------------------
// compile
// ----------------------------------------------------------------------------
struct value*
read(FILE* filename)
{
return NULL;
}
// ----------------------------------------------------------------------------
// compile
// ----------------------------------------------------------------------------
struct closure*
compile(struct value* ast, struct value* env)
{
return NULL;
}
struct value*
eval(struct closure* code)
{
return EXECUTE(code);
}
// ----------------------------------------------------------------------------
// printing
// ----------------------------------------------------------------------------
static void
write_tuple(FILE* out, struct value* value)
{
struct value** p = TUPLE_DATA(value);
struct value** e = TUPLE_DATA(value) + TUPLE_SIZE(value);
write(out, *p);
p++;
while(p < e) {
fprintf(out, " ");
write(out, *p);
p++;
}
}
static void
write_pair(FILE* out, struct value* value)
{
struct value* head = HEAD(value);
struct value* tail = TAIL(value);
write(out, head);
if(IS_PAIR(tail)) {
fprintf(out, " ");
write_pair(out, tail);
} else if(IS_NULL(tail)) {
return;
} else if(IS_DOT(tail)) {
write_pair(out, tail);
} else
failure("Unexpected value found in write");
}
void
write(FILE* out, struct value* value)
{
const byte_t* p;
switch(value->tag) {
case EMPTYLIST:
fprintf(out, "()");
break;
case BOOLEAN:
fprintf(out, (value->fixnum_value) ? "true" : "false");
break;
case DOT:
fprintf(out, " . ");
break;
case SYMBOL:
fprintf(out, "%s", value->symbol_value);
break;
case FIXNUM:
fprintf(out, "%ld", value->fixnum_value);
break;
case FLOAT:
fprintf(out, "%lf", value->float_value);
break;
case CHAR:
fprintf(out, "\\");
switch(value->char_value) {
case '\0':
fprintf(out, "null");
break;
case '\a':
fprintf(out, "bell");
break;
case '\b':
fprintf(out, "backspace");
break;
case '\f':
fprintf(out, "formfeed");
break;
case '\n':
fprintf(out, "newline");
break;
case ' ':
fprintf(out, "space");
break;
case '\r':
fprintf(out, "return");
break;
case '\t':
fprintf(out, "tab");
break;
case '\v':
fprintf(out, "vtab");
break;
default:
fprintf(out, "%c", (char) value->char_value);
}
break;
case STRING:
p = value->string_value;
fprintf(out, "\"");
while(*p != '\0') {
switch(*p) {
case '\a':
fprintf(out, "\\a");
break;
case '\b':
fprintf(out, "\\b");
break;
case '\f':
fprintf(out, "\\f");
break;
case '\n':
fprintf(out, "\\n");
break;
case '\r':
fprintf(out, "\\r");
break;
case '\t':
fprintf(out, "\\t");
break;
case '\v':
fprintf(out, "\v");
case '"':
fprintf(out, "\\\"");
break;
case '\\':
fprintf(out, "\\");
break;
default:
fprintf(out, "%c", *p);
}
p++;
}
fprintf(out, "\"");
break;
case PRIMITIVE:
fprintf(out, "#primitive-procedure");
break;
case LAMBDA:
fprintf(out, "#lambda-procedure");
break;
case PAIR:
fprintf(out, "(");
write_pair(out, value);
fprintf(out, ")");
break;
case TUPLE:
fprintf(out, "[");
write_tuple(out, value);
fprintf(out, "]");
break;
default:
failure("cannot write an unknown value type");
}
}
/*
* 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/>.
*/
#pragma once
#include <stdio.h>
#include <stdint.h>
#include <stdlib.h>
#include <setjmp.h>
#include <string.h>
struct value;
#define TRUE 1
#define FALSE 0
typedef void* pointer_t;
typedef const void* const_pointer_t;
typedef uint8_t byte_t;
typedef int64_t fixnum_t;
typedef double float_t;
typedef char boolean_t;
typedef uint32_t unicode_t;
typedef struct value* (*primitive_t)(struct value* env, struct value* args);
enum tag {
EMPTYLIST, BOOLEAN, DOT, FIXNUM, FLOAT, STRING, CHAR, PAIR, TUPLE, SYMBOL, PRIMITIVE, LAMBDA
};
struct value {
enum tag tag;
union {
fixnum_t fixnum_value;
float_t float_value;
unicode_t char_value;
primitive_t fun_value;
const byte_t* string_value;
const byte_t* symbol_value;
struct {
struct value* head;
struct value* tail;
} pair;
struct {
struct value** data;
size_t size;
} tuple;
struct {
struct value* param;
struct value* body;
} lambda;
};
};
#define TYPE(value) (value->tag)
#define IS_NULL(value) (value->tag == EMPTYLIST)
#define IS_BOOLEAN(value) (value->tag == BOOLEAN)
#define IS_DOT(value) (value->tag == DOT)
#define IS_FIXNUM(value) (value->tag == FIXNUM)
#define IS_STRING(value) (value->tag == STRING)
#define IS_SYMBOL(value) (value->tag == SYMBOL)
#define IS_FLOAT(value) (value->tag == FLOAT)
#define IS_CHAR(value) (value->tag == CHAR)
#define IS_PAIR(value) (value->tag == PAIR)
#define IS_PRIMITIVE(value) (value->tag == PRIMITIVE)
#define IS_LAMBDA(value) (value->tag == LAMBDA)
#define HEAD(obj) (obj->pair.head)
#define TAIL(obj) (obj->pair.tail)
#define TUPLE_DATA(obj) (obj->tuple.data)
#define TUPLE_SIZE(obj) (obj->tuple.size)
#define LAMBDA_PARAM(obj) (obj->lambda.param)
#define LAMBDA_BODY(obj) (obj->lambda.body)
extern struct value* True;
extern struct value* False;
extern struct value* Emptylist;
extern struct value* Dot;
extern struct value* Let;
extern struct value* Lambda;
extern struct value* If;
struct value* alloc_value(void);
struct value* symbol(const byte_t* symbol_value);
struct value* fixnum(fixnum_t fixnum_value);
struct value* floatpoint(float_t float_value);
struct value* string(const byte_t* string_value);
struct value* primitive(const primitive_t fun_value);
struct value* lambda(struct value* param, struct value* body);
struct value* tuple(size_t size, ...);
struct value* dup(struct value* value);
struct value* cons(struct value* head, struct value* tail);
#define list2(A, B) cons(A cons(B, emptylist))
#define list3(A, B, C) cons(A, cons(B, cons(C, emptylist)))
#define list4(A, B, C, D) cons(A, cons(B, cons(C, cons(D, emptylist))))
struct closure {
struct value* (*execute)(struct closure* self);
struct value* env;
};
#define EXECUTE(obj) (((struct closure*) obj)->execute((struct closure*)obj))
void initialize(void);
struct value* read(FILE* filename);
struct closure* compile(struct value* ast, struct value* env);
struct value* eval(struct closure* code);
void write(FILE* out, struct value* v);
Markdown is supported
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