toyforth/toyforth.c

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <assert.h>

#define TFOBJ_TYPE_INT 0
#define TFOBJ_TYPE_STR 1
#define TFOBJ_TYPE_BOOL 2
#define TFOBJ_TYPE_LIST 3
#define TFOBJ_TYPE_SYMBOL 4

/* ############################# Data Structures ########################################## */

typedef struct tfobj {
    int refcount;
    int type;  // TFOBJ_TYPE_*
    union {
        int i;
        struct {
            char *ptr;
            size_t len;
            int quoted;
        } str;
        struct {
            struct tfobj **ele;
            size_t len;
        } list;
    };
} tfobj;

typedef struct tfparser {
    char *prg; // The program to compile into a list.
    char *p;   // Next token to parse.
} tfparser;

/* Function table entry: each of this entry represents a symbol name
 * associated with a function implementation.
 */
struct FunctionTableEntry {
    tfobj *name;
    void (*callback) (tfctx *ctx, tfobj *name);
    tfobj *user_list;
};

struct FunctionTable {
    struct FunctionTableEntry **func_table;
    size_t func_count;
};

/* Our execution context. */
typedef struct tfctx {
    tfobj *stack;
    struct FunctionTable functable;
} tfctx;

/* ############################# Allocations wrappers ################################### */

void *xmalloc(size_t size)
{
    void *ptr = malloc(size);
    if (ptr == NULL) {
        fprintf(stderr, "Out of memory allocating %zu bytes", size);
        exit(1);
    }
    return ptr;
}

void *xrealloc(void *oldptr, size_t size)
{
    void *ptr = realloc(oldptr, size);
    if (ptr == NULL) {
        fprintf(stderr, "Out of memory allocating %zu bytes", size);
        exit(1);
    }
    return ptr;
}

/* ######################### Object related functions ###################################
 * The following functions allocate Toy Forth objects of different types.
 */

/*Allocate and initialize a new Toy Forth object. */
tfobj *createObject(int type)
{
    tfobj *o = xmalloc(sizeof(tfobj));
    o->type = type;
    o->refcount = 1;
    return o;
}

tfobj *createStringObject(char *s, size_t len)
{
    tfobj *obj = createObject(TFOBJ_TYPE_STR);
    obj->str.ptr = xmalloc(len+1);
    obj->str.len = len;
    memcpy(obj->str.ptr, s, len);
    obj->str.ptr[len] = 0;
    return obj;
}

tfobj *createIntObject(int i)
{
    tfobj *obj = createObject(TFOBJ_TYPE_INT);
    obj->i = i;
    return obj;
}

tfobj *createBoolObject(int b)
{
    tfobj *obj = createObject(TFOBJ_TYPE_BOOL);
    obj->i = b;
    return obj;
}

tfobj *createSymbolObject(char *s, size_t len)
{
    tfobj *obj = createStringObject(s, len);
    obj->type = TFOBJ_TYPE_SYMBOL;
    return obj;
}

/* Free an object and all the other nested objects. */
void freeObject(tfobj *obj) {
    switch (obj->type) {
    case TFOBJ_TYPE_LIST:
        for (size_t j = 0; j < obj->list.len; j++) {
            tfobj *ele = obj->list.ele[j];
            release(ele);
        }
        break;
    case TFOBJ_TYPE_SYMBOL:
    case TFOBJ_TYPE_STR:
        free(obj->str.ptr);
        break;
    }
    free(obj);
}

void retain(tfobj *obj)
{
    obj->refcount++;
}

void release(tfobj *obj)
{
    assert(obj->refcount > 0);
    obj->refcount--;
    if (obj->refcount == 0)
        freeObject(obj);
}


void printObject(tfobj *obj) {
    switch (obj->type) {
    case TFOBJ_TYPE_INT:
        printf("%d", obj->i);
        break;
    case TFOBJ_TYPE_LIST:
        printf("[");
        for (size_t j = 0; j < obj->list.len; j++) {
            tfobj *o = obj->list.ele[j];
            printObject(o);
            if (j != o->list.len-1)
                printf(" ");
        }
        printf("]");
        break;
    case TFOBJ_TYPE_STR:
        printf("\"%s\"", obj->str.ptr);
        break;
    case TFOBJ_TYPE_SYMBOL:
        printf("%s", obj->str.ptr);
        break;
    default:
        printf("?");
        break;
    }
}

/* ############################ List Object ############################################  */

tfobj *createListObject(void)
{
    tfobj *obj = createObject(TFOBJ_TYPE_LIST);
    obj->list.ele = NULL;
    obj->list.len = 0;
    return obj;
}

/* Add the new element at the end of the 'list'.
 * It is up to the caller to increment the reference count of the
 * element added to the list, if needed. */
void listPush(tfobj *l, tfobj *ele)
{
    l->list.ele = xrealloc(l->list.ele, sizeof(tfobj*) * (l->list.len+1));
    l->list.ele[l->list.len] = ele;
    l->list.len++;
}

/* ####################### Turn program into toy forth list  ############################ */

void parseSpaces(tfparser *parser)
{
    while (isspace(parser->p[0])) parser->p++;
}

#define MAX_NUM_LEN 128

tfobj *parseNumber(tfparser *parser)
{
    char buf[MAX_NUM_LEN];
    char *start = parser->p;
    char *end;

    if (parser->p[0] == '-') parser->p++;
    while (parser->p[0] && isdigit(parser->p[0])) parser->p++;
    end = parser->p;
    int numLen = end - start;
    if (numLen >= MAX_NUM_LEN) return NULL;

    memcpy(buf, start, numLen);
    buf[numLen] = 0;

    tfobj *obj = createIntObject(atoi(buf));
    return obj;
}

/* Return true if the character 'c' is one of the characters
 * acceptable for our symbols.
 */
int isSymbolChar(int c)
{
    char symchars[] = "+-*/%";
    return isalpha(c) || strchr(symchars, c) != NULL;
}

tfobj *parseSymbol(tfparser *parser)
{
    char *start = parser->p;
    while (parser->p[0] && isSymbolChar(parser->p[0])) parser->p++;
    int len = parser->p - start;
    return createSymbolObject(start, len);
}

tfobj *compile(char *prg)
{
    tfparser parser;
    parser.prg = prg;
    parser.p = prg;

    tfobj *parsed = createListObject();

    while (parser.p) {
        tfobj *obj;
        char *token_start = parser.p;

        parseSpaces(&parser);
        if (parser.p[0] == 0) break; // End of program reached.

        if (isdigit(parser.p[0]) ||
            (parser.p[0] == '-' && isdigit(parser.p[1]))) {
            obj = parseNumber(&parser);
        } else if (isSymbolChar(parser.p[0])) {
            obj = parseSymbol(&parser);
        } else {
            obj = NULL;
        }

        // Check if the current token produced a parsing error.
        if (obj == NULL) {
            release(parsed);
            printf("Syntax error near: %32s ...\n", token_start);
            return NULL;
        } else {
            listPush(parsed, obj);
        }
    }

    return parsed;
}

/* ############################# Execution and context ################################## */

tfctx *createContext(void)
{
    tfctx *ctx = xmalloc(sizeof(*ctx));
    ctx->stack = createListObject();
    ctx->functable.func_table = NULL;
    ctx->functable.func_count = 0;
    registerFunction(ctx, "+", basicMathFunctions);
    return ctx;
}

/* Try to resolve and call the function associated with the symbol
 * name 'word'. Return 0 if the symbol was actually bound to some
 * function, return 1 otherwise.
 */
int callSymbol(tfctx *ctx, tfobj *word)
{

    return 0;
}

/* Execute the Toy Forth program stored into the list 'prg'. */
void exec(tfctx *ctx, tfobj *prg) {
    assert(prg->type == TFOBJ_TYPE_LIST);
    for (size_t j = 0; j < prg->list.len; j++) {
        tfobj *word = prg->list.ele[j];
        switch (word->type) {
        case TFOBJ_TYPE_SYMBOL:
            callSymbol(ctx, word);
            break;
        default:
            listPush(ctx->stack, word);
            retain(word);
            break;
        }
    }
}

/* ############################### Main ################################################# */

int main(int argc, char **argv)
{
    if (argc != 2) {
        fprintf(stderr, "Usage: %s <filename>\n", argv[0]);
        return 1;
    }

    // Read the program in memory, for later parsing.
    FILE *fp = fopen(argv[1], "r");
    if (fp == NULL) {
        perror("Opening Toy Forth program");
        return 1;
    }

    fseek(fp, 0, SEEK_END);
    long file_size = ftell(fp);
    char *prgtext = xmalloc(file_size+1);
    fseek(fp, 0, SEEK_SET);
    fread(prgtext, file_size, 1, fp);
    prgtext[file_size] = 0;
    fclose(fp);

    //printf("Program text: \"%s\"\n", prgtext);

    tfobj *prg = compile(prgtext);
    printObject(prg);
    printf("\n");

    tfctx *ctx = createContext();
    exec(ctx, prg);

    printf("Stack content at end: ");
    printObject(ctx->stack);
    printf("\n");

    return 0;
}