Skip to content

Instantly share code, notes, and snippets.

@cellularmitosis cellularmitosis/Makefile
Last active Dec 29, 2019

Embed
What would you like to do?

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)))
> 
/* 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
/* 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);
}
}
/* 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
/* 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;
}
/* 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
/* 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;
}
}
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
/* 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);
}
}
/* 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
/* 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;
}
}
}
/* 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
/* 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;
}
}
/* 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.