peter
/
Flatrate
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
This repository has been archived on 2024-07-29. You can view files and clone it, but cannot push or open issues or pull requests.
Flatrate/main.c

908 lines
21 KiB
C
Raw Blame History

/* Copyright (c) 2024, Peter McGoron
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
*
* 1) Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2) Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
* TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
* PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
* LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
* NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include "uns.h"
#include "uns_string.h"
#include "cheney_c89.h"
static struct uns_gc gc;
static struct uns_ctr empty_list;
enum token_type {
T_EOF,
LPAREN,
RPAREN,
QUOTE,
QUASIQUOTE,
UNQUOTE,
UNQUOTE_LIST,
T_IDENT,
T_INT,
T_FLOAT,
T_STRING,
T_DOT,
TOKEN_NUM
};
static const char *token2string_repr[TOKEN_NUM] = {
"'EOF",
"(",
")",
"quote",
"quasiquote",
"unquote",
"unquote-list",
"'ident",
"'number",
"'float",
"'string-tok",
"'dot"
};
struct token {
enum token_type typ;
struct uns_ctr dat;
double f;
long i;
};
static int is_ws(int c)
{
return c == '\n' || c == '\t' || c == '\r' || c == '\v' || c == ' ';
}
static int get_skipws(FILE *input)
{
int c;
for (;;) {
c = getc(input);
if (c == ';') {
do { c = getc(input); } while (c != '\n');
ungetc(c, input);
continue;
}
if (is_ws(c))
continue;
return c;
}
}
static void tok_string(FILE *input, struct token *tok)
{
int c;
tok->typ = T_STRING;
uns_string_alloc(&gc, &tok->dat, 32);
for (;;) {
c = getc(input);
switch (c) {
case '\\':
c = getc(input);
switch (c) {
case ' ': case '\t': case '\r': case '\n': case '\v':
do {
c = getc(input);
} while (is_ws(c));
ungetc(c, input);
continue;
case 'r':
uns_string_append_char(&gc, &tok->dat, '\r');
continue;
case 'n':
uns_string_append_char(&gc, &tok->dat, '\n');
continue;
case 'v':
uns_string_append_char(&gc, &tok->dat, '\v');
continue;
case 't':
uns_string_append_char(&gc, &tok->dat, '\t');
continue;
case '"':
uns_string_append_char(&gc, &tok->dat, '"');
continue;
default:
uns_string_append_char(&gc, &tok->dat, '\\');
uns_string_append_char(&gc, &tok->dat, c);
}
case '"': /* " */
return;
}
}
}
static int tonum(int c)
{
switch (c) {
case '0': case '1': case '2': case '3': case '4': case '5':
case '6': case '7': case '8': case '9':
return c - '0';
default:
return -1;
}
}
static void tok_num(FILE *input, struct token *tok, int c)
{
int is_float = 0;
uns_string_alloc(&gc, &tok->dat, 32);
do {
if (c == '.' || c == 'e' || c == 'E' || c == '-' || c == '+')
is_float = 1;
uns_string_append_char(&gc, &tok->dat, c);
c = getc(input);
} while (tonum(c) >= 0 || c == '.' || c == 'e' || c == 'E' || c == '-' || c == '+');
ungetc(c, input);
if (is_float) {
tok->typ = T_FLOAT;
tok->f = strtod(uns_string_cstring(&gc, &tok->dat), NULL);
} else {
tok->typ = T_INT;
tok->i = strtol(uns_string_cstring(&gc, &tok->dat), NULL, 10);
}
tok->dat.p = NULL;
}
static int part_of_ident(int c)
{
return !is_ws(c) && c != '(' && c != ')' && c != '`'
&& c != '\'' && c != '\\' && c != '\"' && c != ','
&& c != ';';
}
static void tok_ident(FILE *input, struct token *tok, int c)
{
tok->typ = T_IDENT;
uns_string_alloc(&gc, &tok->dat, 32);
do {
uns_string_append_char(&gc, &tok->dat, c);
c = getc(input);
} while (part_of_ident(c));
ungetc(c, input);
}
static void tokenize(FILE *input, struct token *tok)
{
int c = get_skipws(input);
int c2;
tok->dat.p = NULL;
switch (c) {
case EOF:
tok->typ = T_EOF;
return;
case '(':
tok->typ = LPAREN;
return;
case ')':
tok->typ = RPAREN;
return;
case '\'':
tok->typ = QUOTE;
return;
case '`':
tok->typ = QUASIQUOTE;
return;
case ',':
c = getc(input);
if (c == '@') {
tok->typ = UNQUOTE_LIST;
} else {
ungetc(c, input);
tok->typ = UNQUOTE;
}
return;
case '"':
tok_string(input, tok);
return;
tok->typ = T_STRING;
return;
case '+': case '-':
c2 = getc(input);
ungetc(c2, input);
if (tonum(c2) >= 0) {
tok_num(input, tok, c);
return;
}
/* FALLTHROUGH */
default:
if (c == '.') {
c2 = getc(input);
if (tonum(c2) >= 0) {
ungetc(c2, input);
tok_num(input, tok, c);
} else if (part_of_ident(c2)) {
ungetc(c2, input);
tok_ident(input, tok, c);
} else {
tok->typ = T_DOT;
}
} else if (tonum(c) >= 0) {
tok_num(input, tok, c);
} else {
tok_ident(input, tok, c);
}
return;
}
}
enum item_type {
CELL,
LAMBDA,
INTEGER,
FLOAT,
STRING,
SYMBOL,
EMPTY_LIST,
LISP_NULL
};
static void alloc_of_type(struct uns_ctr *ctr, int typ)
{
void *p;
int fields;
int i;
switch (typ) {
case CELL: fields = 2; break;
case LAMBDA: fields = 2; break;
case INTEGER: fields = 1; break;
case STRING: fields = 1; break;
case SYMBOL: fields = 1; break;
case FLOAT: fields = 1; break;
case EMPTY_LIST: fields = 0; break;
case LISP_NULL: fields = 0; break;
default: abort();
}
ctr->p = gc.alloc_record(&gc, fields + 1);
p = gc.alloc(&gc, sizeof(int));
memcpy(p, &typ, sizeof(int));
gc.record_set_ptr(ctr->p, 0, p);
for (i = 0; i < fields; i++)
gc.record_set_ptr(ctr->p, i + 1, NULL);
}
static int get_type(Uns_ptr p)
{
int typ;
void *innerp;
if (!p)
return LISP_NULL;
innerp = gc.record_get_ptr(p, 0);
memcpy(&typ, innerp, sizeof(int));
return typ;
}
static void alloc_symbol_from_cstring(struct uns_ctr *ctr, const char *s, size_t slen)
{
struct uns_ctr str = {0};
uns_root_add(&gc, &str);
uns_string_alloc(&gc, &str, slen);
uns_string_append_bytes(&gc, &str, s, slen);
alloc_of_type(ctr, SYMBOL);
gc.record_set_ptr(ctr->p, 1, str.p);
uns_root_remove(&gc, &str);
}
enum expr_stack_state {
EXPR_STACK_INITIAL,
EXPR_STACK_QUOTELIKE,
EXPR_STACK_SURROUND_OTHER,
EXPR_STACK_START_LIST,
EXPR_STACK_IN_LIST,
EXPR_STACK_IMPROPER_LIST,
EXPR_STACK_IMPROPER_LIST_END,
EXPR_STACK_INVALID
};
enum expr_stack_fields {
EXPR_FIELD_NEXT,
EXPR_FIELD_PTR,
EXPR_FIELD_STATE,
EXPR_FIELD_NUM
};
static void expr_stack_push(struct uns_ctr *stack, struct uns_ctr *loc, enum expr_stack_state state)
{
struct uns_ctr tmp = {0};
uns_root_add(&gc, &tmp);
tmp.p = stack->p;
stack->p = gc.alloc_record(&gc, EXPR_FIELD_NUM);
gc.record_set_ptr(stack->p, EXPR_FIELD_NEXT, tmp.p);
uns_root_remove(&gc, &tmp);
gc.record_set_ptr(stack->p, EXPR_FIELD_PTR, loc->p);
tmp.p = gc.alloc(&gc, sizeof(state));
memcpy(tmp.p, &state, sizeof(state));
gc.record_set_ptr(stack->p, EXPR_FIELD_STATE, tmp.p);
}
static enum expr_stack_state expr_stack_state(struct uns_ctr *stack)
{
enum expr_stack_state r;
if (!stack->p)
return EXPR_STACK_INVALID;
memcpy(&r, gc.record_get_ptr(stack->p, EXPR_FIELD_STATE),
sizeof(r));
return r;
}
static void expr_stack_change_state(struct uns_ctr *stack, enum expr_stack_state newst)
{
memcpy(gc.record_get_ptr(stack->p, EXPR_FIELD_STATE),
&newst,
sizeof(newst));
}
static void expr_stack_ctr(struct uns_ctr *stack, struct uns_ctr *loc)
{
loc->p = gc.record_get_ptr(stack->p, EXPR_FIELD_PTR);
}
static int expr_stack_pop(struct uns_ctr *stack)
{
if (!stack->p)
return 0;
stack->p = gc.record_get_ptr(stack->p, EXPR_FIELD_NEXT);
return 1;
}
enum parser_return {
EXPR_PARSE_OK,
EXPR_PARSE_EOF,
EXPR_PARSE_INCOMPLETE,
EXPR_PARSE_EXCESS_RPAREN,
EXPR_PARSE_INVALID_EMPTY_LIST,
EXPR_PARSE_IMPROPER_LIST_OVERFLOW,
EXPR_PARSE_BAD_IMPROPER_LIST,
EXPR_PARSE_BAD_STACK_START,
EXPR_PARSE_BAD_QUOTE,
EXPR_PARSE_INTERNAL_ERROR
};
static int tok_to_type(enum token_type tokt)
{
switch (tokt) {
case T_IDENT: return SYMBOL;
case T_STRING: return STRING;
default: return -1;
}
}
/* Parse expressions using an explicit stack.
* This is feasible to to hand-written and has the advantage that error
* recovery is much easier than recursion (implicit stack).
*
* The stack consists of a LIFO:
* [previous value][container][parser state]
*
* The implementation stores containers on the stack and when a container
* is complete or an atom is read, it is stored in "expr" and the stack
* is modified.
*/
static enum parser_return expr_parse(FILE *input, struct uns_ctr *expr)
{
struct uns_ctr stack = {0};
struct uns_ctr loc = {0};
struct uns_ctr new_cell = {0};
struct token tok = {0};
int store = 0;
enum parser_return r = EXPR_PARSE_OK;
uns_root_add(&gc, &stack);
uns_root_add(&gc, &loc);
uns_root_add(&gc, &tok.dat);
uns_root_add(&gc, &new_cell);
/* Allocate expr->p to be a single pointer. */
expr->p = gc.alloc_record(&gc, 1);
/* Initialize the stack with the final result. */
expr_stack_push(&stack, expr, EXPR_STACK_INITIAL);
while (stack.p) {
tokenize(input, &tok);
switch (tok.typ) {
case LPAREN:
/* Push a new cell onto the stack and parse it later. */
alloc_of_type(expr, CELL);
expr_stack_push(&stack, expr, EXPR_STACK_START_LIST);
break;
case QUOTE: case QUASIQUOTE: case UNQUOTE: case UNQUOTE_LIST:
/* push (token-name <undefined>) onto the stack, and have
* it point to the first cell.
*/
alloc_of_type(&loc, CELL);
alloc_symbol_from_cstring(expr, token2string_repr[tok.typ],
strlen(token2string_repr[tok.typ]));
gc.record_set_ptr(loc.p, 1, expr->p);
alloc_of_type(expr, CELL);
gc.record_set_ptr(loc.p, 2, expr->p);
gc.record_set_ptr(expr->p, 2, empty_list.p);
if (tok.typ == QUOTE || tok.typ == QUASIQUOTE)
expr_stack_push(&stack, &loc, EXPR_STACK_QUOTELIKE);
else
expr_stack_push(&stack, &loc, EXPR_STACK_SURROUND_OTHER);
break;
/* All atoms are allocated into "expr" and will be stored in the
* container after the switch.
*/
case T_IDENT: case T_STRING:
alloc_of_type(expr, tok_to_type(tok.typ));
gc.record_set_ptr(expr->p, 1, tok.dat.p);
store = 1;
break;
case T_INT:
alloc_of_type(expr, INTEGER);
loc.p = gc.alloc(&gc, sizeof(tok.i));
memcpy(loc.p, &tok.i, sizeof(tok.i));
gc.record_set_ptr(expr->p, 1, loc.p);
store = 1;
break;
case T_FLOAT:
alloc_of_type(expr, FLOAT);
loc.p = gc.alloc(&gc, sizeof(tok.f));
memcpy(loc.p, &tok.f, sizeof(tok.f));
gc.record_set_ptr(expr->p, 1, loc.p);
store = 1;
break;
case RPAREN:
switch (expr_stack_state(&stack)) {
case EXPR_STACK_START_LIST:
/* Empty list found. Pop the cell and discard it.
* If we are not in a "surround" state, report error.
* Replace the surround state with an empty list.
*/
expr_stack_pop(&stack);
if (!stack.p) {
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
}
if (expr_stack_state(&stack) != EXPR_STACK_QUOTELIKE) {
r = EXPR_PARSE_INVALID_EMPTY_LIST;
goto end;
}
/* Discard quote/quasiquote and store the empty list instead. */
if (!expr_stack_pop(&stack)) {
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
}
expr->p = empty_list.p;
store = 1;
break;
case EXPR_STACK_IN_LIST:
/* In a list, there are two things on the stack:
* first cell and last cell.
* Place the empty list in the cdr of the last cell,
* and then discard the last cell. Put the first cell into expr
* and store it in the container in the stack before it.
*/
expr_stack_ctr(&stack, &loc);
if (get_type(loc.p) != CELL) {
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
}
gc.record_set_ptr(loc.p, 2, empty_list.p);
/* FALLTHROUGH */
case EXPR_STACK_IMPROPER_LIST_END:
/* CDR of the list has been filled. Pop the last cell. */
expr_stack_pop(&stack);
if (!stack.p) {
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
}
/* Put the first cell in expr, and read it into the next item
* of the stack.
*/
expr_stack_ctr(&stack, expr);
expr_stack_pop(&stack);
store = 1;
break;
case EXPR_STACK_INITIAL:
/* Expression is not balanced. */
r = EXPR_PARSE_EXCESS_RPAREN;
goto end;
case EXPR_STACK_IMPROPER_LIST:
/* (values .) is an invalid expression. */
r = EXPR_PARSE_BAD_IMPROPER_LIST;
goto end;
case EXPR_STACK_QUOTELIKE: case EXPR_STACK_SURROUND_OTHER:
/* ,) ') etc are invalid */
r = EXPR_PARSE_BAD_QUOTE;
goto end;
case EXPR_STACK_INVALID:
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
}
break;
case T_DOT:
if (expr_stack_state(&stack) != EXPR_STACK_IN_LIST) {
r = EXPR_PARSE_BAD_IMPROPER_LIST;
goto end;
}
expr_stack_change_state(&stack, EXPR_STACK_IMPROPER_LIST);
break;
case T_EOF:
/* If EOF is encountered in the middle of an expression, repor
* that. Otherwise, the parser reads nothing.
*/
if (expr_stack_state(&stack) != EXPR_STACK_INITIAL) {
r = EXPR_PARSE_INCOMPLETE;
goto end;
}
r = EXPR_PARSE_EOF;
goto end;
case TOKEN_NUM:
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
}
/* If store is true, that means "expr" contains a value to
* be placed into the container at the top of the stack.
*
* This is a loop because some cases need to cascade values up the
* stack without acting on a token. When the loop stops, further
* action requires a new token to be read.
*/
while (store) switch (expr_stack_state(&stack)) {
case EXPR_STACK_INVALID:
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
case EXPR_STACK_START_LIST:
/* The current thing on the stack is the first part of the
* list. Add the expression to car of the cell, and add
* push a pointer to the cell. This is the last cell in
* the list.
*/
expr_stack_ctr(&stack, &loc);
if (get_type(loc.p) != CELL) {
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
}
gc.record_set_ptr(loc.p, 1, expr->p);
expr_stack_push(&stack, &loc, EXPR_STACK_IN_LIST);
store = 0;
break;
case EXPR_STACK_IN_LIST:
/* The pointer on the top of the stack is the end of the
* list. Add a new list to it's cdr, and put expr into
* the car of the new end of the list.
*/
expr_stack_ctr(&stack, &loc);
if (get_type(loc.p) != CELL) {
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
}
alloc_of_type(&new_cell, CELL);
gc.record_set_ptr(loc.p, 2, new_cell.p);
gc.record_set_ptr(new_cell.p, 1, expr->p);
expr_stack_pop(&stack);
expr_stack_push(&stack, &new_cell, EXPR_STACK_IN_LIST);
store = 0;
break;
case EXPR_STACK_IMPROPER_LIST:
/* Add the expression to the cdr of the last element.
* Set the state to expect the end of an improper list.
*/
expr_stack_ctr(&stack, &loc);
gc.record_set_ptr(loc.p, 2, expr->p);
if (get_type(loc.p) != CELL) {
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
}
expr_stack_change_state(&stack, EXPR_STACK_IMPROPER_LIST_END);
store = 0;
break;
case EXPR_STACK_IMPROPER_LIST_END:
r = EXPR_PARSE_IMPROPER_LIST_OVERFLOW;
goto end;
case EXPR_STACK_QUOTELIKE: case EXPR_STACK_SURROUND_OTHER:
/* Expression at the top of the stack is
* (surrouding-thing <undefined>)
* Replace (car (cdr (top-of-stack)) with expr.
*/
expr_stack_ctr(&stack, &loc);
if (get_type(loc.p) != CELL) {
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
}
loc.p = gc.record_get_ptr(loc.p, 2);
if (get_type(loc.p) != CELL) {
r = EXPR_PARSE_INTERNAL_ERROR;
goto end;
}
gc.record_set_ptr(loc.p, 1, expr->p);
/* Get the head of the quoted value again. */
expr_stack_ctr(&stack, expr);
expr_stack_pop(&stack);
/* This value needs to be stored somewhere. Continue looping. */
store = 1;
break;
case EXPR_STACK_INITIAL:
/* Finished parsing an expression at toplevel. */
expr_stack_ctr(&stack, &loc);
gc.record_set_ptr(loc.p, 0, expr->p);
/* Prepare for return. */
expr->p = loc.p;
expr_stack_pop(&stack);
if (stack.p) {
r = EXPR_PARSE_BAD_STACK_START;
goto end;
}
store = 0;
break;
}
}
end:
uns_root_remove(&gc, &stack);
uns_root_remove(&gc, &loc);
uns_root_remove(&gc, &tok.dat);
uns_root_remove(&gc, &new_cell);
return r;
}
static void oom(struct uns_gc *gc_)
{
(void)gc_;
printf("oom\n");
abort();
}
static void after_gc(struct uns_gc *gc_)
{
(void)gc_;
fprintf(stderr,
"The garbage collector has run %ld times\n"
"\tbefore collection: %lu\n"
"\tafter collection: %lu\n",
gc.collection_number,
gc.before_collection,
gc.after_collection
);
if (gc.after_collection >= gc.before_collection * 7/10) {
fprintf(stderr, "\tincreasing\n");
gc.next_alloc *= 2;
}
}
static void init_gc(void)
{
gc.next_alloc = 512;
gc.oom = oom;
gc.after_gc = after_gc;
gc.ctx = malloc(uns_cheney_c89_ctx_size);
if(!gc.ctx || !uns_cheney_c89_init(&gc))
exit(1);
gc.next_alloc *= 2;
uns_root_add(&gc, &empty_list);
alloc_of_type(&empty_list, EMPTY_LIST);
}
static void display(struct uns_ctr *ctr, long indent)
{
struct uns_ctr tmp = {0};
long l;
double f;
if (!ctr->p) {
printf("<undefined>");
return;
}
switch (get_type(ctr->p)) {
case CELL:
uns_root_add(&gc, &tmp);
printf("(");
tmp.p = gc.record_get_ptr(ctr->p, 1);
display(&tmp, indent);
ctr->p = gc.record_get_ptr(ctr->p, 2);
while (get_type(ctr->p) == CELL) {
tmp.p = gc.record_get_ptr(ctr->p, 1);
if (get_type(tmp.p) == CELL) {
printf("\n");
for (l = 0; l < indent; l++)
printf(" ");
display(&tmp, indent + 1);
} else {
printf(" ");
display(&tmp, indent);
}
ctr->p = gc.record_get_ptr(ctr->p, 2);
}
switch (get_type(ctr->p)) {
case EMPTY_LIST:
printf(")");
break;
default:
printf(" . ");
display(ctr, indent);
printf(")");
break;
}
uns_root_remove(&gc, &tmp);
return;
case INTEGER:
memcpy(&l, gc.record_get_ptr(ctr->p, 1), sizeof(long));
printf("%ld", l);
return;
case FLOAT:
memcpy(&f, gc.record_get_ptr(ctr->p, 1), sizeof(double));
printf("%f", f);
return;
case STRING:
tmp.p = gc.record_get_ptr(ctr->p, 1);
uns_root_add(&gc, &tmp);
printf("\"%s\"", uns_string_cstring(&gc, &tmp));
uns_root_remove(&gc, &tmp);
return;
case SYMBOL:
tmp.p = gc.record_get_ptr(ctr->p, 1);
uns_root_add(&gc, &tmp);
printf("%s", uns_string_cstring(&gc, &tmp));
uns_root_remove(&gc, &tmp);
return;
case EMPTY_LIST:
printf("'()");
return;
default:
abort();
}
}
/* Evaluation:
*
* Symbols are looked up for their value in the environment.
* Numbers, strings, etc. are returned as-is.
* Quote returns the list verbatim. Quasiquote runs another evaluation
* procedure.
*
* All function calls evalute the arguments, left to right. If the arguments
* are not a list, then it evaluated.
*
* A tail-call of the form ((__unilambda l body) . args) binds the evaluated
* args to l and jumps to body, without pushing a stack.
*
* Any other tail-call of the form (function . args) will push a new stack
* with the new values passed to the function, the previous stack removed and
* the new stack linked to the previous-previous stack.
*
* A non-tail call will push a new stack with a link to the previous stack.
*
* A lambda that is not evaluated immediately is stored with a link to the
* top stack frame, the binding symbol and the code verbatim.
*
* A tail-call is either in the body of __unilambda or the latter value in
* "if". The repl is not a tail-call position.
*
* If "(current-continuation)" is the argument of a call, then the
* continuation is passed to the argument. The continuation proceeds in the
* body.
*
* If "(current-continuation)" is the body of a lambda, then the stack is
* unwound until the result will be the argument to another lambda.
*
* A continuation is a pointer to the stack frame and the expression to
* evaluate.
*/
int main(void)
{
struct uns_ctr expr = {0};
init_gc();
uns_root_add(&gc, &expr);
while (!feof(stdin)) {
expr.p = NULL;
switch (expr_parse(stdin, &expr)) {
case EXPR_PARSE_OK:
expr.p = gc.record_get_ptr(expr.p, 0);
display(&expr, 1);
printf("\n");
break;
case EXPR_PARSE_INCOMPLETE:
fprintf(stderr, "EOF before expression was finished\n");
break;
case EXPR_PARSE_EXCESS_RPAREN:
fprintf(stderr, "Unbalanced parentheses\n");
break;
case EXPR_PARSE_INVALID_EMPTY_LIST:
fprintf(stderr, "Invalid syntax for empty list (either '() or `'())\n");
break;
case EXPR_PARSE_BAD_QUOTE:
fprintf(stderr, "Invalid syntax for quotes/unquotes\n");
break;
case EXPR_PARSE_IMPROPER_LIST_OVERFLOW:
fprintf(stderr, "too many values at end of improper list (must be exactly one)\n");
case EXPR_PARSE_BAD_IMPROPER_LIST:
fprintf(stderr, "Bad syntax for improper list (must be (value . value))\n");
break;
case EXPR_PARSE_INTERNAL_ERROR:
fprintf(stderr, "Bug in implementation\n");
break;
case EXPR_PARSE_BAD_STACK_START:
fprintf(stderr, "Bug: bottom of stack not correct\n");
break;
case EXPR_PARSE_EOF:
fprintf(stderr, "EOF\n");
break;
}
}
uns_root_remove(&gc, &expr);
uns_cheney_c89_deinit(&gc);
return 0;
}
Reference in New Issue View Git Blame Copy Permalink