Writing a Lisp reader in C, part 1

README.md

Blog 2019/12/20   (retroactively posted on 12/28)

<- previous | index | next ->

Writing a Lisp reader in C, part 1

I started writing a Lisp reader in C. Here's the progress so far!

$ make
gcc -std=c99 -Wall -Werror -DTRACE  -c main.c
gcc -std=c99 -Wall -Werror -DTRACE  -c form.c
gcc -std=c99 -Wall -Werror -DTRACE  -c read.c
gcc -std=c99 -Wall -Werror -DTRACE  -c eval.c
gcc -std=c99 -Wall -Werror -DTRACE  -c print.c
gcc -std=c99 -Wall -Werror -DTRACE  -c repl.c
gcc -o lisp *.o

$ ./lisp 
> (nil true 42 3.14 foo :bar (1 (2 3)))                    
TRACE: token: '('
TRACE: token: 'nil'
TRACE: token: 'true'
TRACE: token: '42'
TRACE: token: '3.14'
TRACE: token: 'foo'
TRACE: token: ':bar'
TRACE: token: '('
TRACE: token: '1'
TRACE: token: '('
TRACE: token: '2'
TRACE: token: '3'
(nil true 42 3.140000 foo :bar (1 (2 3)))
> 

errcode.h

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

#ifndef _ERRCODE_H_
#define _ERRCODE_H_

enum ErrCode_ {
    E_success = 0, // not an error.
    E_unknown = 10001,
    E_file_get_token_buff_overflow = 10010,
    E_file_get_token_str_invalid_string_literal = 10030,
    E_read_list_missing_ws_delimiter = 10040,
    E_read_list_eof = 10041,
    E_read_eof = 10050,
    E_read_nested_eof = 10051,
    E_read_parse_error = 10052,
    E_read_unexpected_closer = 10053,
    E_read_incomplete_dispatch = 10054,
};
typedef enum ErrCode_ ErrCode;

#endif

eval.c

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

#include "eval.h"
#include "print.h"
#include <assert.h>


/* Evaluate formp into resultp.
Returns 0.
FIXME this is incomplete -- it just a printer, not an evaluator. */
int eval(Form* formp, Form** resultp) {
    if (is_nil(formp) || is_cbool(formp) || is_clong(formp) || is_cdouble(formp)
        || is_cstring(formp) || is_keyword(formp))
    {
        *resultp = formp;
        return 0;
    } else if (is_symbol(formp)) {
        *resultp = formp;
        return 0;
    } else if (is_list(formp)) {
        *resultp = formp;
        return 0;
    } else {
        assert(false);
    }
}

eval.h

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

#ifndef _EVAL_H_
#define _EVAL_H_

#include "form.h"

int eval(Form* formp, Form** resultp);

#endif

form.c

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

/* All of the Lisp forms. */

#include "form.h"
#include <stdlib.h>
#include <sys/errno.h>
#include <assert.h>
#include <string.h>


/* Form */

void free_form(Form* formp) {
    if (is_nil(formp) || is_cbool(formp)) {
        /* Nil and CBool are singletons.  Do nothing. */
        return;
    } else if (is_cchar(formp) || is_clong(formp) || is_cdouble(formp)) {
        free(formp);
        return;
    } else if (is_cstring(formp)) {
        CString* csp = (CString*)formp;
        free(csp->valuep);
        free(csp);
        return;
    } else if (is_symbol(formp) || is_keyword(formp)) {
        /* Symbols and Keywords are interned.  Do nothing for now. */
        return;
    } else if (is_list(formp)) {
        List* headp = (List*)formp;
        while (!is_emptylist(headp)) {
            List* lp = headp;
            headp = lp->nextp;
            free_form(lp->datap);
            free(lp);
        }
        return;
    } else {
        assert(false);
    }
}



/* Nil */

Nil* g_nil = NULL;


/* Is formp a Nil? */
bool is_nil(Form* formp) {
    return formp->type == TypeNil;
}


/* Call this function once from main(). */
void nil_main() {
    g_nil = malloc(sizeof(Nil));
    assert(g_nil != NULL);
    g_nil->type = TypeNil;
}



/* CBool */

CBool* g_true = NULL;
CBool* g_false = NULL;


/* Is formp a CBool? */
bool is_cbool(Form* formp) {
    return formp->type == TypeCBool;
}


/* Call this function once from main(). */
void cbool_main() {
    g_true = malloc(sizeof(CBool));
    assert(g_true != NULL);
    g_true->type = TypeCBool;
    g_true->value = true;

    g_false = malloc(sizeof(CBool));
    assert(g_false != NULL);
    g_false->type = TypeCBool;
    g_false->value = false;
}



/* CChar */

/* Malloc's a CChar into cchpp, initializing it with ch.
Returns 0 or errno. */
int new_cchar(CChar** cchpp, char ch) {
    CChar* cchp = malloc(sizeof(CChar));
    if (cchp == NULL) {
        return errno;
    }
    cchp->type = TypeCChar;
    cchp->value = ch;
    *cchpp = cchp;
    return 0;
}


/* Is formp a CChar? */
bool is_cchar(Form* formp) {
    return formp->type == TypeCChar;
}



/* CLong */

/* Malloc's a CLong into clpp, initializing it with l.
Returns 0 or errno. */
int new_clong(CLong** clpp, long l) {
    CLong* clp = malloc(sizeof(CLong));
    if (clp == NULL) {
        return errno;
    }
    clp->type = TypeCLong;
    clp->value = l;
    *clpp = clp;
    return 0;
}


/* Is formp a CLong? */
bool is_clong(Form* formp) {
    return formp->type == TypeCLong;
}



/* CDouble */

/* Malloc's a CDouble into cdpp, initializing it with d.
Returns 0 or errno. */
int new_cdouble(CDouble** cdpp, double d) {
    CDouble* cdp = malloc(sizeof(CDouble));
    if (cdp == NULL) {
        return errno;
    }
    cdp->type = TypeCDouble;
    cdp->value = d;
    *cdpp = cdp;
    return 0;
}


/* Is formp a CDouble? */
bool is_cdouble(Form* formp) {
    return formp->type == TypeCDouble;
}



/* CString */

/* Malloc's a CString into cspp and copies sp into it.
Returns 0 or errno. */
int new_cstring(CString** cspp, const char* sp) {
    CString* csp = malloc(sizeof(CString));
    if (csp == NULL) {
        return errno;
    }
    csp->type = TypeCString;

    size_t len = strlen(sp);
    csp->valuep = malloc(len + 1);
    if (csp->valuep == NULL) {
        free(csp);
        return errno;
    }
    strcpy(csp->valuep, sp);

    *cspp = csp;
    return 0;
}


/* Is formp a CString? */
bool is_cstring(Form* formp) {
    return formp->type == TypeCString;
}



/* Symbol */

List* g_symbols = NULL;


/* Malloc's a Symbol into sympp and copies sp into it. */
int new_symbol(Symbol** sympp, const char* sp) {
    Symbol* symp = malloc(sizeof(Symbol));
    if (symp == NULL) {
        return errno;
    }
    symp->type = TypeSymbol;

    size_t len = strlen(sp);
    symp->valuep = malloc(len + 1);
    if (symp->valuep == NULL) {
        free(symp);
        return errno;
    }
    strcpy(symp->valuep, sp);

    *sympp = symp;
    return 0;
}


/* Is formp a Symbol? */
bool is_symbol(Form* formp) {
    return formp->type == TypeSymbol;
}


/* Places a singleton Symbol into sympp, creating it if necessary.
Returns 0 or errno. */
int intern_symbol(Symbol** sympp, const char* sp) {
    List* lp = g_symbols;
    while (!is_emptylist(lp)) {
        Symbol* symp = (Symbol*)(lp->datap);

        /* found it. */
        if (strcmp(symp->valuep, sp) == 0) {
            *sympp = symp;
            return 0;
        
        /* try the next one. */
        } else {
            lp = lp->nextp;
        }
    }

    /* didn't find it already interned, so create a new one. */
    Symbol *symp;
    int err = new_symbol(&symp, sp);
    if (err) {
        return err;
    }
    err = list_push(&g_symbols, (Form*)symp);
    if (err) {
        free(symp);
        return err;
    }
    *sympp = symp;
    return 0;
}


/* Call this function once from main(). */
void symbol_main() {
    new_list_empty(&g_symbols);
}



/* Keyword */

List* g_keywords = NULL;


/* Malloc's a Keyword into kwpp and copies sp into it. */
int new_keyword(Keyword** kwpp, const char* sp) {
    Keyword* kwp = malloc(sizeof(Keyword));
    if (kwp == NULL) {
        return errno;
    }
    kwp->type = TypeKeyword;

    size_t len = strlen(sp);
    kwp->valuep = malloc(len + 1);
    if (kwp->valuep == NULL) {
        free(kwp);
        return errno;
    }
    strcpy(kwp->valuep, sp);

    *kwpp = kwp;
    return 0;
}


/* Is formp a Keyword? */
bool is_keyword(Form* formp) {
    return formp->type == TypeKeyword;
}


/* Places a singleton Keyword into sympp, creating it if necessary.
Returns 0 or errno. */
int intern_keyword(Keyword** kwpp, const char* sp) {
    List* lp = g_keywords;
    while (!is_emptylist(lp)) {
        Keyword* kwp = (Keyword*)(lp->datap);

        /* found it. */
        if (strcmp(kwp->valuep, sp) == 0) {
            *kwpp = kwp;
            return 0;
        
        /* try the next one. */
        } else {
            lp = lp->nextp;
        }
    }

    /* didn't find it already interned, so create a new one. */
    Keyword *kwp;
    int err = new_keyword(&kwp, sp);
    if (err) {
        return err;
    }
    err = list_push(&g_keywords, (Form*)kwp);
    if (err) {
        free(kwp);
        return err;
    }
    *kwpp = kwp;
    return 0;
}


/* Call this function once from main(). */
void keyword_main() {
    new_list_empty(&g_keywords);
}



/* List */

List* g_emptylist = NULL;


/* Malloc's a List intp lpp, initializing it with datap.
Returns 0 or errno. */
int new_list(List** lpp, Form* datap) {
    assert(datap != NULL);
    List* lp = malloc(sizeof(List));
    if (lp == NULL) {
        return errno;
    }
    lp->type = TypeList;
    lp->datap = datap;
    lp->nextp = g_emptylist;
    *lpp = lp;
    return 0;
}


/* Initializes lpp to be the empty list. */
void new_list_empty(List** lpp) {
    *lpp = g_emptylist;
}


/* Is formp a List? */
bool is_list(Form* formp) {
    return formp->type == TypeList;
}


/* Is listp the empty list? */
bool is_emptylist(List* listp) {
    return listp == g_emptylist;
}


/* Push formp as the new head of listpp.
Returns 0 or errno. */
int list_push(List** listpp, Form* formp) {
    List* list2p;
    int err = new_list(&list2p, formp);
    if (err) {
        return err;
    }
    list2p->nextp = *listpp;
    *listpp = list2p;
    return 0;
}


/* Call this function once from main(). */
void list_main() {
    g_emptylist = malloc(sizeof(List));
    assert(g_emptylist != NULL);
    g_emptylist->type = TypeList;
    g_emptylist->nextp = g_emptylist;
    g_emptylist->datap = (Form*)g_emptylist;
}

form.h

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

/* All of the Lisp forms. */

#ifndef _FORM_H_
#define _FORM_H_

#include <stdbool.h>


/* The list of Lisp form types. */
enum FormType_ {
    Type_UNINITIALIZED = 0,

    /* Atoms */

    TypeNil = 1,
    TypeCBool = 10,
    TypeCChar = 20,
    TypeCLong = 30,
    // TypeCInt64 = 40,
    // TypeCInt32 = 41,
    // TypeCInt16 = 42,
    // TypeCInt8 = 43,

    // TypeCULong = 50,
    // TypeCUInt64 = 60,
    // TypeCUInt32 = 61,
    // TypeCUInt16 = 62,
    // TypeCUInt8 = 63,

    TypeCFloat = 70,
    TypeCDouble = 71,

    TypeCString = 100,
    TypeSymbol = 110,
    TypeKeyword = 120,

    /* Collections */

    TypeList = 200,
    TypeVector = 210,
    TypeMap = 220,
    TypeSet = 230,

    _enum_force_16bit = 256,
};
typedef enum FormType_ FormType;


/* A type-erased Lisp form. */
struct Form_ {
    FormType type;
};
typedef struct Form_ Form;

void free_form(Form* formp);


/* Nil */

struct Nil_ {
    FormType type;
};
typedef struct Nil_ Nil;

extern Nil* g_nil;

bool is_nil(Form* formp);
void nil_main();



/* CBool */

struct CBool_ {
    FormType type;
    bool value;
};
typedef struct CBool_ CBool;

extern CBool* g_true;
extern CBool* g_false;

bool is_cbool(Form* formp);
void cbool_main();



/* CChar */

struct CChar_ {
    FormType type;
    char value;
};
typedef struct CChar_ CChar;

int new_cchar(CChar** cchpp, char ch);
bool is_cchar(Form* formp);



/* CLong */

struct CLong_ {
    FormType type;
    long value;
};
typedef struct CLong_ CLong;

int new_clong(CLong** clpp, long l);
bool is_clong(Form* formp);



/* CDouble */

struct CDouble_ {
    FormType type;
    double value;
};
typedef struct CDouble_ CDouble;

int new_cdouble(CDouble** cdpp, double d);
bool is_cdouble(Form* formp);



/* CString */

struct CString_ {
    FormType type;
    char* valuep;
};
typedef struct CString_ CString;

int new_cstring(CString** cspp, const char* sp);
bool is_cstring(Form* formp);



/* Symbol */

struct Symbol_ {
    FormType type;
    char* valuep;
};
typedef struct Symbol_ Symbol;

int new_symbol(Symbol** sympp, const char* sp);
int intern_symbol(Symbol** sympp, const char* sp);
bool is_symbol(Form* formp);
void symbol_main();



/* Keyword */

struct Keyword_ {
    FormType type;
    char* valuep;
};
typedef struct Keyword_ Keyword;

int new_keyword(Keyword** kwpp, const char* sp);
int intern_keyword(Keyword** kwpp, const char* sp);
bool is_keyword(Form* formp);
void keyword_main();



/* List */

struct List_ {
    FormType type;
    Form* datap;
    struct List_* nextp;
};
typedef struct List_ List;

extern List* g_emptylist;

int new_list(List** formpp, Form* datap);
void new_list_empty(List** formpp);
bool is_list(Form* formp);
int list_push(List** listpp, Form* formp);
bool is_emptylist(List* listp);
void list_main();

#endif

main.c

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

#include "repl.h"
#include "form.h"
#include <stdlib.h>
#include <stdio.h>


int main() {
    nil_main();
    cbool_main();
    list_main();
    symbol_main();
    keyword_main();

    int err = repl();
    if (err) {
        fprintf(stderr, "Error %d.\n", err);
        return err;
    } else {
        return EXIT_SUCCESS;
    }
}

Makefile

CC=gcc -std=c99 -Wall -Werror -DTRACE $(EXTRAFLAGS)

lisp: main.o form.o read.o eval.o print.o repl.o
	gcc -o lisp *.o

main.o: main.c
	$(CC) -c main.c

form.o: form.c
	$(CC) -c form.c

read.o: read.c
	$(CC) -c read.c

eval.o: eval.c
	$(CC) -c eval.c

print.o: print.c
	$(CC) -c print.c

repl.o: repl.c
	$(CC) -c repl.c

clean:
	rm -f *.o lisp

.PHONY: clean

print.c

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

#include "print.h"
#include <assert.h>


/* Prints a nil form into fp.
Returns 0 or errno. */
static int print_nil(FILE* fp) {
    int err = fputs("nil", fp);
    return err == EOF ? err : 0;
}


/* Prints the CBool in bp into fp.
Returns 0 or errno. */
static int print_cbool(CBool* bp, FILE* fp) {
    char* output;
    if (bp->value == false) {
        output = "false";
    } else {
        output = "true";
    }
    int err = fputs(output, fp);
    return err == EOF ? err : 0;
}


/* Prints the CLong in lp into fp.
Returns 0 or errno. */
static int print_clong(CLong* lp, FILE* fp) {
    int err = fprintf(fp, "%li", lp->value);
    return err < 0 ? err : 0;
}


/* Prints the CDouble in dp into fp.
Returns 0 or errno. */
static int print_cdouble(CDouble* dp, FILE* fp) {
    int err = fprintf(fp, "%f", dp->value);
    return err < 0 ? err : 0;
}


/* Prints the Symbol in symp into fp.
Returns 0 or errno. */
static int print_symbol(Symbol* symp, FILE* fp) {
    int err = fprintf(fp, "%s", symp->valuep);
    return err < 0 ? err : 0;
}


/* Prints the Keyword in kwp into fp.
Returns 0 or errno. */
static int print_keyword(Keyword* kwp, FILE* fp) {
    int err = fprintf(fp, "%s", kwp->valuep);
    return err < 0 ? err : 0;
}


/* Prints the List in lp into fp.
Returns 0 or errno. */
static int print_list(List* lp, FILE* fp) {
    int err = fputs("(", fp);
    if (err == EOF) {
        return err;
    }
    List* i = lp;
    while (!is_emptylist(i)) {
        if (i != lp) {
            err = fputs(" ", fp);
            if (err == EOF) {
                return err;
            }
        }
        err = print(i->datap, fp);
        if (err) {
            return err;
        }
        i = i->nextp;
    }
    err = fputs(")", fp);
    return err == EOF ? err : 0;
}


/* Prints the Form in formp into fp.
Returns 0 or errno. */
int print(Form* formp, FILE* fp) {
    if (is_nil(formp)) {
        return print_nil(fp);
    } else if (is_clong(formp)) {
        CLong* lp = (CLong*)formp;
        return print_clong(lp, fp);
    } else if (is_cdouble(formp)) {
        CDouble* dp = (CDouble*)formp;
        return print_cdouble(dp, fp);
    } else if (is_cbool(formp)) {
        CBool* bp = (CBool*)formp;
        return print_cbool(bp, fp);
    } else if (is_symbol(formp)) {
        Symbol* symp = (Symbol*)formp;
        return print_symbol(symp, fp);
    } else if (is_keyword(formp)) {
        Keyword* kwp = (Keyword*)formp;
        return print_keyword(kwp, fp);
    } else if (is_list(formp)) {
        List* lp = (List*)formp;
        return print_list(lp, fp);
    } else {
        assert(false);
    }
}

print.h

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

#ifndef _PRINT_H_
#define _PRINT_H_

#include "form.h"
#include <stdio.h>

int print(Form* formp, FILE* fp);

#endif

read.c

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

#include "read.h"
#include "errcode.h"
#include <stdlib.h>
#include <sys/errno.h>
#include <assert.h>
#include <stdbool.h>
#include <ctype.h>
#include <string.h>


/* Is ch considered whitespace?
Note: commas are considered whitespace. */
static bool is_ch_ws(char ch) {
    return isspace(ch) || ch == ',';
}


/* Is ch the start of a collection literal? */
static bool is_ch_opener(char ch) {
    return ch == '(' || ch == '[' || ch == '{';
}


/* Is ch the end of a collection literal? */
static bool is_ch_closer(char ch) {
    return ch == ')' || ch == ']' || ch == '}';
}


/* Does ch indicate the end of a token? */
static bool is_ch_delim(char ch) {
    return is_ch_ws(ch) || is_ch_opener(ch) || is_ch_closer(ch);
}


/* Does ch constitute a token on its own? */
static bool is_ch_single_character_token(char ch) {
    char* p = strchr("()[]{}'`@", (int)ch);
    return (p != NULL);
}


/* Places a char from fp into chp.
Returns 0, EOF, or errno. */
static int file_get_ch(FILE* fp, char* chp) {
    int i = fgetc(fp);
    if (ferror(fp)) {
        return errno;
    } else if (i == EOF) {
        return EOF;
    } else {
        *chp = (char)i;
        return 0;
    }
}


/* Pushes ch back into fp.
Returns 0 or EOF. */
static int file_unget_ch(FILE* fp, char ch) {
    int err = ungetc((int)ch, fp);
    if (err == EOF) {
        return err;
    } else {
        return 0;
    }
}


/* Peeks a char from fp into chp without advancing the stream.
Returns 0, EOF, or errno. */
static int file_peek_ch(FILE* fp, char* chp) {
    int err = file_get_ch(fp, chp);
    if (err) {
        return err;
    }

    err = file_unget_ch(fp, *chp);
    if (err) {
        return err;
    }

    return 0;
}


/* Advance fp by one char (which is discarded).
Returns 0, EOF, or errno. */
static int file_consume_ch(FILE* fp) {
    int i = fgetc(fp);
    if (ferror(fp)) {
        return errno;
    } else if (i == EOF) {
        return EOF;
    } else {
        return 0;
    }
}


/* Advance fp past any leading whitespace.
Note: commas are considered whitespace.
Returns 0, EOF, or errno. */
static int file_discard_ws(FILE* fp, int* countp) {
    int err;
    char ch;
    int count = 0;

    while (true) {
        err = file_get_ch(fp, &ch);
        if (err) {
            return err;
        } else if (is_ch_ws(ch)) {
            count++;
            continue;
        } else {
            err = file_unget_ch(fp, ch);
            if (err) {
                return err;
            }
            if (countp != NULL) {
                *countp = count;
            }
            break;
        }
    }

    return 0;
}


/* Advance fp far enough to read one token (which is a string literal).
Points buffpp to a malloc'ed buffer containing the string.
Returns 0, EOF, errno, or an error code. */
static int file_get_token_str(FILE* fp, char** buffpp) {
    int err;
    char ch;

    /* allocate the initial buffer. */
    size_t buffsize = 100;
    size_t bufflen = buffsize - 1;
    char* buffp = malloc(buffsize);
    if (buffp == NULL) {
        return errno;
    }
    char* cursor = buffp;

    /* the first char must be the opening quote. */
    err = file_get_ch(fp, &ch);
    if (err) {
        free(buffp);
        return err;
    } else if (ch != '"') {
        free(buffp);
        return E_file_get_token_str_invalid_string_literal;
    } else {
        *cursor = ch;
        cursor++;
    }

    while (true) {
        size_t len = cursor - buffp;

        /* time to grow the buffer. */
        if (len == bufflen) {
            buffsize *= 2;
            bufflen = buffsize - 1;
            char* newbuffp = realloc(buffp, buffsize);
            if (newbuffp == NULL) {
                err = errno;
                free(buffp);
                return err;
            } else {
                buffp = newbuffp;
            }
        }

        err = file_get_ch(fp, &ch);
        if (err) {
            free(buffp);
            return err;

        /* this is the end of the string. */
        } else if (ch == '"') {
            *cursor = ch;
            cursor++;
            *cursor = '\0';
            // shrink buffp to fit the size of the string.
            size_t finalbuffsize = buffp - cursor + 1;
            if (finalbuffsize < buffsize) {
                char* finalbuffp = realloc(buffp, finalbuffsize);
                if (finalbuffp == NULL) {
                    err = errno;
                    free(buffp);
                    return err;
                } else {
                    buffp = finalbuffp;
                }
            }
            break;

        /* this is an escape sequence. */
        } else if (ch == '\\') {
            assert(false); // TODO

        /* this is a regular char. */
        } else {
            *cursor = ch;
            cursor++;
        }
    }

    *buffpp = buffp;
    return 0;
}


/* Advances fp past the current comment.
Returns 0, EOF, or errno. */
static int file_discard_comment(FILE* fp) {
    int err;
    char ch;

    /* the first char must be ';'. */
    err = file_get_ch(fp, &ch);
    if (err) {
        return err;
    } else {
        assert(ch == ';');
    }

    /* discard the rest of the current line. */
    while (true) {
        err = file_get_ch(fp, &ch);
        if (err) {
            return err;
        } else if (ch == '\n') {
            break;
        } else {
            continue;
        }
    }
    return 0;
}


/* Advance fp far enough to read one token of input.
Writes the token contents to *buffpp.
In the case of a string literal, buffpp is pointed at a new malloc'ed buffer.
Returns 0, EOF, errno, or an error code. */
static int file_get_token(FILE* fp, char** buffpp, size_t buffsize) {
    int err;
    char ch;
    size_t bufflen = buffsize - 1;
    char* cursor = *buffpp;

    /* discard any leading whitespace. */
    err = file_discard_ws(fp, NULL);
    if (err) {
        return err;
    }

    /* first char. */
    err = file_get_ch(fp, &ch);
    if (err) {
        return err;

    /* this is a comment. */
    } else if (ch == ';') {
        err = file_discard_comment(fp);
        if (err) {
            return err;
        }
        return file_get_token(fp, buffpp, buffsize);

    /* this is a string literal. */
    } else if (ch == '"') {
        err = file_unget_ch(fp, ch);
        if (err) {
            return err;
        }
        return file_get_token_str(fp, buffpp);
    
    } else {
        *cursor = ch;
        cursor++;
    }

    /* this is a single-character token. */
    if (is_ch_single_character_token(ch)) {
        *cursor = '\0';

    /* this is a multi-character token. */
    } else {
        /* the rest of the chars. */
        while (true) {
            size_t len = cursor - *buffpp;

            /* we have run out of room. */
            if (len == bufflen) {
                return E_file_get_token_buff_overflow;
            }

            err = file_get_ch(fp, &ch);
            if (err) {
                return err;

            /* we've reached the end of this token. */
            } else if (is_ch_delim(ch)) {
                err = file_unget_ch(fp, ch);
                if (err) {
                    return err;
                } else {
                    *cursor = '\0';
                    break;
                }

            } else {
                *cursor = ch;
                cursor++;
            }
        }
    }

#ifdef TRACE
    printf("TRACE: token: '%s'\n", *buffpp);
#endif

    return 0;
}


/* Tries to parse a long from buffp into lp.
Returns true or false. */
static bool try_parse_long(const char* buffp, long* lp) {
    char* endptr;
    long l = strtol(buffp, &endptr, 10);
    if (errno != 0 || endptr == buffp || *endptr != '\0') {
        return false;
    } else {
        *lp = l;
        return true;
    }
}


/* Trie to parse a double from buffp intp dp.
Returns true or false. */
static bool try_parse_double(const char* buffp, double* dp) {
    char* endptr;
    double d = strtod(buffp, &endptr);
    if (errno != 0 || endptr == buffp || *endptr != '\0') {
        return false;
    } else {
        *dp = d;
        return true;
    }
}


static int read_list(FILE* fp, Form** formpp) {
    /* note: the leading '(' has already been consumed. */

    int err;
    int i = 0;
    int ws_count;
    char ch1;
    List* headp = g_emptylist;
    List* tailp = g_emptylist;

    while (true) {
        err = file_discard_ws(fp, &ws_count);
        if (err) {
            free_form((Form*)headp);
            return err;
        }

        err = file_peek_ch(fp, &ch1);
        if (err) {
            free_form((Form*)headp);
            /* reaching EOF before ')' is an error. */
            if (err == EOF) {
                return E_read_list_eof;
            } else {
                return err;
            }

        /* we've reached the end of the list. */
        } else if (ch1 == ')') {
            err = file_consume_ch(fp);
            if (err) {
                free_form((Form*)headp);
                return err;
            }
            *formpp = (Form*)headp;
            return 0;

        } else {

            /* no space between atoms is an error. */
            if (i > 0 && ws_count == 0 && is_ch_delim(ch1) == false) {
                free_form((Form*)headp);
                return E_read_list_missing_ws_delimiter;
            }

            /* read the next form in the list. */
            Form* formp;
            err = read(fp, &formp);
            if (err) {
                free_form((Form*)headp);
                return err;

            /* append the form onto the list. */
            } else {
                List* newp;
                int err = new_list(&newp, formp);
                if (err) {
                    free_form((Form*)headp);
                    return err;
                }

                if (headp == g_emptylist) {
                    headp = newp;
                    tailp = newp;
                } else {
                    tailp->nextp = newp;
                    tailp = newp;
                }
            }
        }

        i++;
    }
}


static int read_vector(FILE* fp, Form** formpp) {
    assert(false); // TODO
}


static int read_map(FILE* fp, Form** formpp) {
    assert(false); // TODO
}


/* Read one Lisp form from fp intp formpp.
Returns 0 or EOF or errno or error code.
FIXME this can leak on error. */
int read(FILE* fp, Form** formpp) {
    int err;
    int buffsize = 100;
    char buff[buffsize];
    char* buffp = buff;
    char ch1;

    /* read a token. */
    err = file_get_token(fp, &buffp, buffsize);
    if (err) {
        return err;
    }
    ch1 = *buffp;

    /* we've reached the end of input. */
    if (ch1 == '\0') {
        return EOF;

    /* this is a collection. */
    } else if (ch1 == '(') {
        return read_list(fp, formpp);
    } else if (ch1 == '[') {
        return read_vector(fp, formpp);
    } else if (ch1 == '{') {
        return read_map(fp, formpp);

    /* nil literal. */
    } else if (ch1 == 'n' && strcmp(buffp, "nil") == 0) {
        *formpp = (Form*)g_nil;
        return 0;

    /* boolean literals. */
    } else if (ch1 == 't' && strcmp(buffp, "true") == 0) {
        *formpp = (Form*)g_true;
        return 0;
    } else if (ch1 == 'f' && strcmp(buffp, "false") == 0) {
        *formpp = (Form*)g_false;
        return 0;

    /* character literal. */
    } else if (ch1 == '\\') {
        // FIXME implement char parsing.
        assert(false);

    /* string literal. */
    } else if (ch1 == '"') {
        CString* csp;
        err = new_cstring(&csp, buffp);
        if (err) {
            return err;
        } else {
            *formpp = (Form*)csp;
            return 0;
        }

    /* a keyword. */
    } else if (ch1 == ':') {
        Keyword* kwp;
        // TODO implement interning.
        err = new_keyword(&kwp, buffp);
        if (err) {
            return err;
        } else {
            *formpp = (Form*)kwp;
            return 0;
        }

    /* a collection closer at this point is a syntax error. */
    } else if (ch1 == ')' || ch1 == ']' || ch1 == '}') {
        return E_read_unexpected_closer;

    /* an anonymous function argument. */
    } else if (ch1 == '%') {
        // TODO
        assert(false);

    /* a deref. */
    } else if (ch1 == '@') {
        // TODO
        assert(false);

    /* metadata. */
    } else if (ch1 == '^') {
        // TODO
        assert(false);

    /* quote. */
    } else if (ch1 == '\'') {
        // TODO
        assert(false);

    /* syntax quote. */
    } else if (ch1 == '`') {
        // TODO
        assert(false);

    /* syntax quote. */
    } else if (ch1 == '~') {
        // TODO
        assert(false);

    /* the dispatch character. */
    } else if (ch1 == '#') {
        char ch2 = *(buffp+1);

        /* an EOF at this point is an error. */
        if (ch2 == '\0') {
            return E_read_incomplete_dispatch;

        /* the "discard" form. */
        } else if (ch2 == '_') {
            // TODO
            assert(false);

        /* a set. */
        } else if (ch2 == '{') {
            // TODO
            assert(false);

        /* a regex. */
        } else if (ch2 == '"') {
            // TODO
            assert(false);

        /* an anonymous function. */
        } else if (ch2 == '(') {
            // TODO
            assert(false);

        /* a var quote. */
        } else if (ch2 == '\'') {
            // TODO
            assert(false);

        /* a symbolic value. */
        } else if (ch2 == '#') {
            // TODO
            assert(false);

        /* tagged literals. */
        } else if (ch2 == 'i' && strcmp(buffp, "#inst") == 0) {
            // TODO
            assert(false);
        } else if (ch2 == 'u' && strcmp(buffp, "#uuid") == 0) {
            // TODO
            assert(false);
        } else if (ch2 == 'j' && strcmp(buffp, "#js") == 0) {
            // TODO
            assert(false);

        } else {
            // TODO
            assert(false);
        }

    /* forms which can't be determined from ch1 alone. */
    } else {
        bool success;

        /* an integer literal. */
        long l;
        success = try_parse_long(buffp, &l);
        if (success) {
            CLong* clp;
            err = new_clong(&clp, l);
            if (err) {
                return err;
            } else {
                *formpp = (Form*)clp;
                return 0;
            }
        }

        /* a floating-point literal. */
        double d;
        success = try_parse_double(buffp, &d);
        if (success) {
            CDouble* cdp;
            err = new_cdouble(&cdp, d);
            if (err) {
                return err;
            } else {
                *formpp = (Form*)cdp;
                return 0;
            }
        }

        /* assume anything else to be a symbol. */
        Symbol* symp;
        err = new_symbol(&symp, buffp);
        if (err) {
            return err;
        } else {
            *formpp = (Form*)symp;
            return 0;
        }
    }
}

read.h

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

#ifndef _READ_H_
#define _READ_H_

#include "form.h"
#include <stdio.h>

int read(FILE* fp, Form** formpp);

#endif

repl.c

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

#include "repl.h"
#include "read.h"
#include "eval.h"
#include "print.h"
#include <stdbool.h>
#include <sys/errno.h>


int repl() {
    while (true) {
        /* display the prompt. */
        int err = fputs("> ", stdout);
        if (err == EOF) {
            if (ferror(stdout)) {
                return errno;
            } else {
                return 0;
            }
        }

        /* have we run out of input? */
        if (feof(stdin)) {
            return 0;
        }

        /* read the next Lisp form. */
        Form* formp;
        err = read(stdin, &formp);
        if (err) {
            if (err == EOF) {
                return 0;
            } else {
                return err;
            }
        }

        /* evaluate the form. */
        Form* resultp;
        err = eval(formp, &resultp);
        if (err) {
            int err2 = fprintf(stderr, "Error %d.\n", err);
            if (err2 < 0) {
                return err2;
            }
            continue;
        }

        /* print the result. */
        err = print(resultp, stdout);
        if (err) {
            return err;
        }
        err = fputs("\n", stdout);
        if (err == EOF) {
            if (ferror(stdout)) {
                return errno;
            } else {
                return 0;
            }
        }

        /* loop. */
        continue;
    }
}

repl.h

/* This file is Copyright (C) 2019 Jason Pepas. */
/* This file is released under the terms of the MIT License. */
/* See https://opensource.org/licenses/MIT */

#ifndef _REPL_H_
#define _REPL_H_

int repl();

#endif