M makefile => makefile +1 -1
@@ 1,7 1,7 @@
RELEASE_flags=-Os -DNDEBUG -g0 -s -Wall -Wno-unknown-pragmas
DEBUG_flags=-DDEBUG -Wall -Wno-unknown-pragmas -Wpedantic -Wshadow -Wextra -Werror=implicit-int -Werror=incompatible-pointer-types -Werror=int-conversion -Wvla -g -Og -fsanitize=address -fsanitize=undefined
TARG=-std=c99
-SRC=src/gc.c src/lispkit.c src/secd.c src/parser.c src/main.c
+SRC=src/lispkit.c src/main.c
.PHONY: all clean run test format archive
D src/gc.c => src/gc.c +0 -128
@@ 1,128 0,0 @@
-#include <assert.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-#include "lispkit.h"
-#include "gc.h"
-
-/*
-Copyright (c) 2011 A. Carl Douglas
-Copyright (c) 2023 Devine Lu Linvega
-
-Permission to use, copy, modify, and distribute this software for any
-purpose with or without fee is hereby granted, provided that the above
-copyright notice and this permission notice appear in all copies.
-
-THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-WITH REGARD TO THIS SOFTWARE.
-*/
-
-#define NUM_CELLS 65535
-
-unsigned alloc_counter;
-unsigned collect_counter;
-unsigned num_cells;
-
-void *mem;
-Object **cells;
-Object *ff;
-
-void
-gc_mark(Object *object)
-{
- if(gc_header(object)->marked == 0) {
- gc_header(object)->marked = 1;
- if(isatom(object) == 0) {
- gc_mark(car(object));
- gc_mark(cdr(object));
- }
- }
-}
-
-void
-gc_init()
-{
- const unsigned cell_size = sizeof(struct GCHeader) + sizeof(Object);
- unsigned char *ptr;
- unsigned i;
-
- num_cells = getenv("LISPKIT_MEMORY") ? atoi(getenv("LISPKIT_MEMORY")) : NUM_CELLS;
-
- mem = calloc(num_cells, cell_size);
- cells = calloc(num_cells, sizeof(Object *));
-
- alloc_counter = 0;
- collect_counter = 0;
-
- ff = NULL;
-
- for(i = 0, ptr = mem; i < num_cells; i++, ptr += cell_size) {
- cells[i] = (Object *)((struct GCHeader *)ptr + 1);
- cells[i]->Cons.cdr = ff;
- ff = cells[i];
- }
-}
-
-void
-gc_exit()
-{
- free(mem);
- free(cells);
-}
-
-Object *
-gc_alloc()
-{
- Object *object;
-
- if(ff == NULL)
- gc_collect_garbage();
-
- object = ff;
- ff = ff->Cons.cdr;
- gc_header(object)->type = 0;
-
- alloc_counter++;
-
- return object;
-}
-
-void
-gc_collect()
-{
- int i;
- for(i = 0; i < NUM_CELLS; i++) {
- if(gc_header(cells[i])->marked == 0) {
- cells[i]->Cons.cdr = ff;
- ff = cells[i];
- collect_counter++;
- }
- }
-}
-
-void
-gc_collect_garbage()
-{
- int i;
- for(i = 0; i < NUM_CELLS; i++)
- gc_header(cells[i])->marked = 0;
- gc_mark(_rS);
- gc_mark(_rE);
- gc_mark(_rC);
- gc_mark(_rD);
- gc_mark(_t);
- gc_mark(_f);
- gc_mark(_nil);
- gc_collect();
- if(ff == NULL)
- crash("Error: Out of memory", "GC", "");
-}
-
-void
-gc_stats()
-{
- fprintf(stderr, "Cells: %u\n", num_cells);
- fprintf(stderr, "Allocates: %u\n", alloc_counter);
- fprintf(stderr, "Collects: %u\n", collect_counter);
-}
D src/gc.h => src/gc.h +0 -27
@@ 1,27 0,0 @@
-#include "lispkit.h"
-
-/*
-Copyright (c) 2011 A. Carl Douglas
-Copyright (c) 2023 Devine Lu Linvega
-
-Permission to use, copy, modify, and distribute this software for any
-purpose with or without fee is hereby granted, provided that the above
-copyright notice and this permission notice appear in all copies.
-
-THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-WITH REGARD TO THIS SOFTWARE.
-*/
-
-struct GCHeader {
- int size, type, marked, id;
-};
-
-void gc_init();
-Object *gc_alloc();
-void gc_collect_garbage();
-void gc_collect();
-void gc_mark();
-void gc_exit();
-void gc_stats();
-
-#define gc_header(o) ((struct GCHeader *)o - 1)
M src/lispkit.c => src/lispkit.c +117 -5
@@ 3,7 3,6 @@
#include <string.h>
#include "lispkit.h"
-#include "gc.h"
/*
Copyright (c) 2011 A. Carl Douglas
@@ 17,9 16,122 @@ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
WITH REGARD TO THIS SOFTWARE.
*/
-#define BUFLENGTH 0x8000
+/* - GC -------------------------------------- */
-static char dict_buf[BUFLENGTH], *dict_end;
+#define NUM_CELLS 65535
+
+unsigned alloc_counter;
+unsigned collect_counter;
+unsigned num_cells;
+
+void *mem;
+Object **cells;
+Object *ff;
+
+void
+gc_mark(Object *object)
+{
+ if(gc_header(object)->marked == 0) {
+ gc_header(object)->marked = 1;
+ if(isatom(object) == 0) {
+ gc_mark(car(object));
+ gc_mark(cdr(object));
+ }
+ }
+}
+
+void
+gc_init()
+{
+ const unsigned cell_size = sizeof(struct GCHeader) + sizeof(Object);
+ unsigned char *ptr;
+ unsigned i;
+
+ num_cells = getenv("LISPKIT_MEMORY") ? atoi(getenv("LISPKIT_MEMORY")) : NUM_CELLS;
+
+ mem = calloc(num_cells, cell_size);
+ cells = calloc(num_cells, sizeof(Object *));
+
+ alloc_counter = 0;
+ collect_counter = 0;
+
+ ff = NULL;
+
+ for(i = 0, ptr = mem; i < num_cells; i++, ptr += cell_size) {
+ cells[i] = (Object *)((struct GCHeader *)ptr + 1);
+ cells[i]->Cons.cdr = ff;
+ ff = cells[i];
+ }
+}
+
+void
+gc_exit()
+{
+ free(mem);
+ free(cells);
+}
+
+Object *
+gc_alloc()
+{
+ Object *object;
+
+ if(ff == NULL)
+ gc_collect_garbage();
+
+ object = ff;
+ ff = ff->Cons.cdr;
+ gc_header(object)->type = 0;
+
+ alloc_counter++;
+
+ return object;
+}
+
+void
+gc_collect()
+{
+ int i;
+ for(i = 0; i < NUM_CELLS; i++) {
+ if(gc_header(cells[i])->marked == 0) {
+ cells[i]->Cons.cdr = ff;
+ ff = cells[i];
+ collect_counter++;
+ }
+ }
+}
+
+void
+gc_collect_garbage()
+{
+ int i;
+ for(i = 0; i < NUM_CELLS; i++)
+ gc_header(cells[i])->marked = 0;
+ gc_mark(_rS);
+ gc_mark(_rE);
+ gc_mark(_rC);
+ gc_mark(_rD);
+ gc_mark(_t);
+ gc_mark(_f);
+ gc_mark(_nil);
+ gc_collect();
+ if(ff == NULL)
+ crash("Error: Out of memory", "GC", "");
+}
+
+void
+gc_stats()
+{
+ fprintf(stderr, "Cells: %u\n", num_cells);
+ fprintf(stderr, "Allocates: %u\n", alloc_counter);
+ fprintf(stderr, "Collects: %u\n", collect_counter);
+}
+
+/* - LISPKIT --------------------------------- */
+
+#define DICTLEN 0x8000
+
+static char dict_buf[DICTLEN], *dict_end;
void
crash(char *err, const char *value, const char *id)
@@ 110,7 222,7 @@ dict_init(void)
{
int i;
/* clear buffer */
- for(i = 0; dict_buf[i] && i < BUFLENGTH; i++)
+ for(i = 0; dict_buf[i] && i < DICTLEN; i++)
dict_buf[i] = 0;
dict_end = &dict_buf[0];
}
@@ 125,7 237,7 @@ dict_alloc(const char *src)
if(!strcmp(ptr, src))
return ptr;
/* create */
- if(len + dict_end - dict_buf >= BUFLENGTH)
+ if(len + dict_end - dict_buf >= DICTLEN)
crash("Error: Out of memory", "DICT", "");
dict_end += len + 1;
return strcpy(ptr, src);
M src/lispkit.h => src/lispkit.h +15 -0
@@ 31,6 31,21 @@ union Object {
struct Cons Cons;
};
+struct GCHeader {
+ int size, type, marked, id;
+};
+
+/* gc */
+void gc_init();
+Object *gc_alloc();
+void gc_collect_garbage();
+void gc_collect();
+void gc_mark();
+void gc_exit();
+void gc_stats();
+
+#define gc_header(o) ((struct GCHeader *)o - 1)
+
/* secd */
extern Object *_rS, *_rE, *_rC, *_rD;
extern Object *_t, *_f, *_nil;
M src/main.c => src/main.c +346 -2
@@ 6,9 6,7 @@
#include <strings.h>
#include <unistd.h>
-#include "gc.h"
#include "lispkit.h"
-#include "parser.h"
/*
Copyright (c) 2011 A. Carl Douglas
@@ 22,6 20,352 @@ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
WITH REGARD TO THIS SOFTWARE.
*/
+/* - SECD ------------------------------------ */
+
+#define A car(_rS)
+#define B car(cdr(_rS))
+
+Object *_rS, *_rE, *_rC, *_rD;
+Object *_t, *_f, *_nil;
+
+void
+secd_init(void)
+{
+ _t = newsym("T");
+ _f = newsym("F");
+ _nil = newsym("NIL");
+ _rS = _rC = _rE = _rD = _nil;
+}
+
+Object *
+secd_eval(Object *fn, Object *args)
+{
+ Object *_work, *_a, *_b;
+ int live = 1, i;
+ _rS = cons(args, _nil);
+ _rC = fn;
+ while(live) {
+ switch(car(_rC)->num) {
+ case 0: /* NIL */
+ break;
+ case 1: /* LD */
+ i = 0;
+ _work = _rE;
+ for(i = 1; i <= car(car(cdr(_rC)))->num; ++i)
+ _work = cdr(_work);
+ _work = car(_work);
+ for(i = 1; i <= cdr(car(cdr(_rC)))->num; ++i)
+ _work = cdr(_work);
+ _work = car(_work);
+ _rS = cons(_work, _rS);
+ _rC = cdr(cdr(_rC));
+ break;
+ case 2: /* LDC */
+ _rS = cons(car(cdr(_rC)), _rS);
+ _rC = cdr(cdr(_rC));
+ break;
+ case 3: /* LDF */
+ _rS = cons(cons(car(cdr(_rC)), _rE), _rS);
+ _rC = cdr(cdr(_rC));
+ break;
+ case 4: /* AP */
+ _rD = cons(cdr(_rC), _rD);
+ _rD = cons(_rE, _rD);
+ _rD = cons(cdr(cdr(_rS)), _rD);
+ _rE = cons(B, cdr(car(_rS)));
+ _rC = car(car(_rS));
+ _rS = _nil;
+ break;
+ case 5: /* RTN */
+ _rS = cons(car(_rS), car(_rD));
+ _rE = car(cdr(_rD));
+ _rC = car(cdr(cdr(_rD)));
+ _rD = cdr(cdr(cdr(_rD)));
+ break;
+ case 6: /* DUM */
+ _rE = cons(_nil, _rE);
+ _rC = cdr(_rC);
+ break;
+ case 7: /* RAP */
+ _rD = cons(cdr(_rC), _rD);
+ _rD = cons(cdr(_rE), _rD);
+ _rD = cons(cdr(cdr(_rS)), _rD);
+ _rE = cdr(car(_rS));
+ _rE->Cons.car = B;
+ _rC = car(car(_rS));
+ _rS = _nil;
+ break;
+ case 8: /* SEL */
+ _rD = cons(cdr(cdr(cdr(_rC))), _rD);
+ _rC = car(cdr(istrue(car(_rS)) ? _rC : cdr(_rC)));
+ _rS = cdr(_rS);
+ break;
+ case 9: /* JOIN */
+ _rC = car(_rD);
+ _rD = cdr(_rD);
+ break;
+ case 10: /* CAR */
+ _rS = cons(car(car(_rS)), cdr(_rS));
+ _rC = cdr(_rC);
+ break;
+ case 11: /* CDR */
+ _rS = cons(cdr(car(_rS)), cdr(_rS));
+ _rC = cdr(_rC);
+ break;
+ case 12: /* ATOM */
+ _rS = cons(isatom(A) ? _t : _f, cdr(_rS));
+ _rC = cdr(_rC);
+ break;
+ case 13: /* CONS */
+ _rS = cons(cons(A, B), cdr(cdr(_rS)));
+ _rC = cdr(_rC);
+ break;
+ case 14: /* EQ */
+ _rS = cons(isequ(A, B) ? _t : _f, cdr(cdr(_rS)));
+ _rC = cdr(_rC);
+ break;
+ case 15: /* ADD */
+ _a = A, _b = B;
+ _rS = cons(isnum(_a) && isnum(_b) ? newnum(_b->num + _a->num) : _nil, cdr(cdr(_rS)));
+ _rC = cdr(_rC);
+ break;
+ case 16: /* SUB */
+ _a = A, _b = B;
+ _rS = cons(isnum(_a) && isnum(_b) ? newnum(_b->num - _a->num) : _nil, cdr(cdr(_rS)));
+ _rC = cdr(_rC);
+ break;
+ case 17: /* MUL */
+ _a = A, _b = B;
+ _rS = cons(isnum(_a) && isnum(_b) ? newnum(_b->num * _a->num) : _nil, cdr(cdr(_rS)));
+ _rC = cdr(_rC);
+ break;
+ case 18: /* DIV */
+ _a = A, _b = B;
+ _rS = cons(isnum(_a) && isnum(_b) ? newnum(_b->num / _a->num) : _nil, cdr(cdr(_rS)));
+ _rC = cdr(_rC);
+ break;
+ case 19: /* REM */
+ _a = A, _b = B;
+ _rS = cons(isnum(_a) && isnum(_b) ? newnum(_b->num % _a->num) : _nil, cdr(cdr(_rS)));
+ _rC = cdr(_rC);
+ break;
+ case 20: /* LEQ */
+ _a = A, _b = B;
+ _rS = cons(isnum(_a) && isnum(_b) ? (_b->num <= _a->num ? _t : _f) : _nil, cdr(cdr(_rS)));
+ _rC = cdr(_rC);
+ break;
+ case 21: /* BRK */
+ live = 0;
+ break;
+ case 26: /* WRITE */
+ device_write(_rS);
+ _rC = cdr(_rC);
+ break;
+ case 27: /* IMP */
+ _rS = cons(implode(A), cdr(_rS));
+ _rC = cdr(_rC);
+ break;
+ case 28: /* EXP */
+ _rS = cons(explode(A), cdr(_rS));
+ _rC = cdr(_rC);
+ break;
+ default: /* ERR */
+ crashnum("Error: Unknown opcode <%d>\n", car(_rC)->num);
+ return _rS;
+ }
+ }
+ return _rS;
+}
+
+/* - PARSER ---------------------------------- */
+
+struct Token {
+ FILE *fp;
+ char *file, *str;
+ unsigned line, pos, word;
+};
+
+enum {
+ T_SYMBOL = 1,
+ T_NUMBER = 2,
+ T_DOT = 3,
+ T_LEFTPAREN = 4,
+ T_RIGHTPAREN = 5,
+ T_END
+};
+
+Object *get_exp(FILE *fp);
+Object *get_exp_list(FILE *fp);
+
+#define ciws(c) (c == ' ' || c == '\n' || c == '\t' || c == '\r')
+
+#define BUFLEN 80
+
+static char buffer[BUFLEN];
+static struct Token token;
+static Object *s_exp(void);
+static Object *s_exp_list(void);
+
+static void
+walk_whitespaces(void)
+{
+ int ch;
+ for(; !feof(token.fp); token.pos++) {
+ ch = fgetc(token.fp);
+ if(!ciws(ch)) {
+ ungetc(ch, token.fp);
+ break;
+ }
+ if(ch == '\n')
+ token.line++, token.pos = 0;
+ }
+}
+
+static void
+walk_comment(void)
+{
+ int ch;
+ ch = fgetc(token.fp);
+ if(ch == ';') {
+ for(; !feof(token.fp); token.pos++) {
+ ch = fgetc(token.fp);
+ if(ch == '\n') {
+ token.line++, token.pos = 0;
+ break;
+ }
+ }
+ } else
+ ungetc(ch, token.fp);
+ walk_whitespaces();
+}
+
+static void
+tokenize(void)
+{
+ int i, ch, next_ch;
+ char *ptr = buffer;
+ token.str = NULL;
+ /* clear buffer */
+ for(i = 0; buffer[i] && i < BUFLEN; i++)
+ buffer[i] = 0;
+ walk_whitespaces();
+ walk_comment();
+ /* parse token */
+ for(; !feof(token.fp); token.pos++) {
+ ch = fgetc(token.fp);
+ *ptr++ = (char)ch, *ptr = '\0';
+ if(ch == '(' || ch == ')' || ch == '.')
+ break;
+ next_ch = fgetc(token.fp);
+ ungetc(next_ch, token.fp);
+ if(ciws(next_ch) || next_ch == '(' || next_ch == ')' || next_ch == '.')
+ break;
+ }
+ if(strlen(buffer) > 0)
+ token.str = buffer;
+}
+
+static void
+scan(FILE *fp)
+{
+ token.fp = fp;
+ token.line = token.pos = token.word = 0;
+ tokenize();
+}
+
+static const char *
+token_name(int type)
+{
+ switch(type) {
+ case T_SYMBOL: return "Symbol";
+ case T_NUMBER: return "Number";
+ case T_DOT: return "Dot";
+ case T_LEFTPAREN: return "Left parenthesis";
+ case T_RIGHTPAREN: return "Right parenthesis";
+ case T_END: return "End of file";
+ }
+ return "Unknown token type";
+}
+
+static int
+token_type(void)
+{
+ if(token.str == NULL) return T_END;
+ switch(token.str[0]) {
+ case '.': return T_DOT;
+ case '(': return T_LEFTPAREN;
+ case ')': return T_RIGHTPAREN;
+ case '0':
+ case '1':
+ case '2':
+ case '3':
+ case '4':
+ case '5':
+ case '6':
+ case '7':
+ case '8':
+ case '9': return T_NUMBER;
+ default: return T_SYMBOL;
+ }
+}
+
+static void
+match(int type)
+{
+ if(type == token_type()) {
+ tokenize();
+ return;
+ }
+ fprintf(stderr, "Parsing Error: Unexpected token '%s', expected %s, at %d:%d.\n", token.str, token_name(type), token.line, token.pos);
+ exit(-1);
+}
+
+static Object *
+s_exp(void)
+{
+ Object *cell = _nil;
+ switch(token_type()) {
+ case T_NUMBER: cell = newnum(atoi(token.str)), match(T_NUMBER); break;
+ case T_SYMBOL: cell = newsym(token.str), match(T_SYMBOL); break;
+ case T_LEFTPAREN: match(T_LEFTPAREN), cell = s_exp_list(), match(T_RIGHTPAREN); break;
+ case T_END: break;
+ default:
+ fprintf(stderr, "Parsing Error: Unexpected token '%s', at %d:%d.\n", token.str, token.line, token.pos);
+ exit(-1);
+ }
+ return cell;
+}
+
+static Object *
+s_exp_list(void)
+{
+ Object *cell = _nil;
+ cell = cons(s_exp(), _nil);
+ switch(token_type()) {
+ case T_RIGHTPAREN: break;
+ case T_DOT: match(T_DOT), cell->Cons.cdr = s_exp(); break;
+ case T_END: break;
+ default: cell->Cons.cdr = s_exp_list(); break;
+ }
+ return cell;
+}
+
+Object *
+get_exp(FILE *fp)
+{
+ scan(fp);
+ return s_exp();
+}
+
+Object *
+get_exp_list(FILE *fp)
+{
+ scan(fp);
+ return s_exp_list();
+}
+
+/* - MAIN ------------------------------------ */
+
int
main(int argc, char *argv[])
{
D src/parser.c => src/parser.c +0 -185
@@ 1,185 0,0 @@
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-
-#include "lispkit.h"
-#include "parser.h"
-
-/*
-Copyright (c) 2011 A. Carl Douglas
-Copyright (c) 2023 Devine Lu Linvega
-
-Permission to use, copy, modify, and distribute this software for any
-purpose with or without fee is hereby granted, provided that the above
-copyright notice and this permission notice appear in all copies.
-
-THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-WITH REGARD TO THIS SOFTWARE.
-*/
-
-#define ciws(c) (c == ' ' || c == '\n' || c == '\t' || c == '\r')
-
-#define BUFLENGTH 80
-
-static char buffer[BUFLENGTH];
-static struct Token token;
-static Object *s_exp(void);
-static Object *s_exp_list(void);
-
-static void
-walk_whitespaces(void)
-{
- int ch;
- for(; !feof(token.fp); token.pos++) {
- ch = fgetc(token.fp);
- if(!ciws(ch)) {
- ungetc(ch, token.fp);
- break;
- }
- if(ch == '\n')
- token.line++, token.pos = 0;
- }
-}
-
-static void
-walk_comment(void)
-{
- int ch;
- ch = fgetc(token.fp);
- if(ch == ';') {
- for(; !feof(token.fp); token.pos++) {
- ch = fgetc(token.fp);
- if(ch == '\n') {
- token.line++, token.pos = 0;
- break;
- }
- }
- } else
- ungetc(ch, token.fp);
- walk_whitespaces();
-}
-
-static void
-tokenize(void)
-{
- int i, ch, next_ch;
- char *ptr = buffer;
- token.str = NULL;
- /* clear buffer */
- for(i = 0; buffer[i] && i < BUFLENGTH; i++)
- buffer[i] = 0;
- walk_whitespaces();
- walk_comment();
- /* parse token */
- for(; !feof(token.fp); token.pos++) {
- ch = fgetc(token.fp);
- *ptr++ = (char)ch, *ptr = '\0';
- if(ch == '(' || ch == ')' || ch == '.')
- break;
- next_ch = fgetc(token.fp);
- ungetc(next_ch, token.fp);
- if(ciws(next_ch) || next_ch == '(' || next_ch == ')' || next_ch == '.')
- break;
- }
- if(strlen(buffer) > 0)
- token.str = buffer;
-}
-
-static void
-scan(FILE *fp)
-{
- token.fp = fp;
- token.line = token.pos = token.word = 0;
- tokenize();
-}
-
-static const char *
-token_name(int type)
-{
- switch(type) {
- case T_SYMBOL: return "Symbol";
- case T_NUMBER: return "Number";
- case T_DOT: return "Dot";
- case T_LEFTPAREN: return "Left parenthesis";
- case T_RIGHTPAREN: return "Right parenthesis";
- case T_END: return "End of file";
- }
- return "Unknown token type";
-}
-
-static int
-token_type(void)
-{
- if(token.str == NULL) return T_END;
- switch(token.str[0]) {
- case '.': return T_DOT;
- case '(': return T_LEFTPAREN;
- case ')': return T_RIGHTPAREN;
- case '0':
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- case '8':
- case '9': return T_NUMBER;
- default: return T_SYMBOL;
- }
-}
-
-static void
-match(int type)
-{
- if(type == token_type()) {
- tokenize();
- return;
- }
- fprintf(stderr, "Parsing Error: Unexpected token '%s', expected %s, at %d:%d.\n", token.str, token_name(type), token.line, token.pos);
- exit(-1);
-}
-
-static Object *
-s_exp(void)
-{
- Object *cell = _nil;
- switch(token_type()) {
- case T_NUMBER: cell = newnum(atoi(token.str)), match(T_NUMBER); break;
- case T_SYMBOL: cell = newsym(token.str), match(T_SYMBOL); break;
- case T_LEFTPAREN: match(T_LEFTPAREN), cell = s_exp_list(), match(T_RIGHTPAREN); break;
- case T_END: break;
- default:
- fprintf(stderr, "Parsing Error: Unexpected token '%s', at %d:%d.\n", token.str, token.line, token.pos);
- exit(-1);
- }
- return cell;
-}
-
-static Object *
-s_exp_list(void)
-{
- Object *cell = _nil;
- cell = cons(s_exp(), _nil);
- switch(token_type()) {
- case T_RIGHTPAREN: break;
- case T_DOT: match(T_DOT), cell->Cons.cdr = s_exp(); break;
- case T_END: break;
- default: cell->Cons.cdr = s_exp_list(); break;
- }
- return cell;
-}
-
-Object *
-get_exp(FILE *fp)
-{
- scan(fp);
- return s_exp();
-}
-
-Object *
-get_exp_list(FILE *fp)
-{
- scan(fp);
- return s_exp_list();
-}
D src/parser.h => src/parser.h +0 -29
@@ 1,29 0,0 @@
-/*
-Copyright (c) 2011 A. Carl Douglas
-Copyright (c) 2023 Devine Lu Linvega
-
-Permission to use, copy, modify, and distribute this software for any
-purpose with or without fee is hereby granted, provided that the above
-copyright notice and this permission notice appear in all copies.
-
-THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
-WITH REGARD TO THIS SOFTWARE.
-*/
-
-struct Token {
- FILE *fp;
- char *file, *str;
- unsigned line, pos, word;
-};
-
-enum {
- T_SYMBOL = 1,
- T_NUMBER = 2,
- T_DOT = 3,
- T_LEFTPAREN = 4,
- T_RIGHTPAREN = 5,
- T_END
-};
-
-Object *get_exp(FILE *fp);
-Object *get_exp_list(FILE *fp);
M src/secd.c => src/secd.c +0 -1
@@ 1,5 1,4 @@
#include "lispkit.h"
-#include "gc.h"
/*
Copyright (c) 2011 A. Carl Douglas