peter
/
Flatrate
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

improper lists, floats

This commit is contained in:
Peter McGoron 2024-06-21 22:45:46 -04:00
parent ac04cf7828
commit 413b9614d2
3 changed files with 121 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
README.rst
View File

@ -3,6 +3,7 @@ Flatrate LISP
=============
Flatrate is a minimalistic LISP. It's designed to test out my garbage
collectors.
collectors. It is C89+ and as portable as one can reasonably make a
program.
The default macro system is non-hygenic.

83
main.c
View File

@ -42,8 +42,10 @@ enum token_type {
UNQUOTE,
UNQUOTE_LIST,
T_IDENT,
T_NUMBER,
T_INT,
T_FLOAT,
T_STRING,
T_DOT,
TOKEN_NUM
};
@ -58,13 +60,16 @@ static const char *token2string[TOKEN_NUM] = {
",@",
"IDENT",
"NUMBER_TOK",
"STRING_TOK"
"STRING_TOK",
"."
};
#endif
struct token {
enum token_type typ;
struct uns_ctr dat;
double f;
long i;
};
@ -145,19 +150,27 @@ static int tonum(int c)
}
}
static void tok_num(FILE *input, struct token *tok, int mul)
static void tok_num(FILE *input, struct token *tok, int c)
{
int c = getc(input);
int is_float = 0;
tok->typ = T_NUMBER;
uns_string_alloc(&gc, &tok->dat, 32);
do {
if (c == '.' || c == 'e' || c == 'E')
is_float = 1;
uns_string_append_char(&gc, &tok->dat, c);
c = getc(input);
} while (tonum(c) >= 0);
ungetc(c, input);
tok->i = mul*strtol(uns_string_cstring(&gc, &tok->dat), NULL, 10);
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;
}
@ -215,17 +228,29 @@ static void tokenize(FILE *input, struct token *tok)
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 == '+' ? 1 : -1);
tok_num(input, tok, c);
return;
}
/* FALLTHROUGH */
default:
if (tonum(c) >= 0) {
ungetc(c, input);
tok_num(input, tok, 1);
if (c == '.') {
c2 = getc(input);
/* Flatrate does not have floating point. */
if (part_of_ident(c2)) {
tok_ident(input, tok, c);
} else if (tonum(c2) >= 0) {
tok_num(input, tok, c);
} else {
tok->typ = T_DOT;
}
} else if (tonum(c) >= 0) {
tok_num(input, tok, c);
} else {
tok_ident(input, tok, c);
}
@ -237,6 +262,7 @@ enum item_type {
CELL,
LAMBDA,
INTEGER,
FLOAT,
STRING,
SYMBOL,
EMPTY_LIST,
@ -305,6 +331,16 @@ static void alloc_integer(struct uns_ctr *ctr, long l)
gc.record_set_ptr(ctr->p, 1, p);
}
static void alloc_float(struct uns_ctr *ctr, double f)
{
void *p;
alloc_of_type(ctr, FLOAT);
p = gc.alloc(&gc, sizeof(double));
memcpy(p, &f, sizeof(double));
gc.record_set_ptr(ctr->p, 1, p);
}
static int expr_all(FILE *input, struct token *tok, struct uns_ctr *expr);
static int list_expr(FILE *input, struct uns_ctr *expr, struct token *tok)
@ -334,6 +370,19 @@ static int list_expr(FILE *input, struct uns_ctr *expr, struct token *tok)
break;
alloc_of_type(&in_cdr, CELL);
if (tok->typ == T_DOT) {
tokenize(input, tok);
expr_all(input, tok, &in_cdr);
gc.record_set_ptr(cur_head.p, 2, in_cdr.p);
tokenize(input, tok);
if (tok->typ != RPAREN) {
r = 0;
}
goto end;
}
gc.record_set_ptr(cur_head.p, 2, in_cdr.p);
cur_head.p = in_cdr.p;
}
@ -398,14 +447,17 @@ static int expr_all(FILE *input, struct token *tok, struct uns_ctr *expr)
alloc_of_type(expr, SYMBOL);
gc.record_set_ptr(expr->p, 1, tok->dat.p);
break;
case T_NUMBER:
case T_INT:
alloc_integer(expr, tok->i);
break;
case T_FLOAT:
alloc_float(expr, tok->f);
break;
case T_STRING:
alloc_of_type(expr, STRING);
gc.record_set_ptr(expr->p, 1, tok->dat.p);
break;
case RPAREN: case T_EOF: case TOKEN_NUM:
case RPAREN: case T_EOF: case TOKEN_NUM: case T_DOT:
return 0;
}
@ -474,9 +526,10 @@ static void display(struct uns_ctr *ctr)
{
struct uns_ctr tmp = {0};
long l;
double f;
if (!ctr->p) {
printf("__null");
printf("<undefined>");
return;
}
@ -500,6 +553,10 @@ static void display(struct uns_ctr *ctr)
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(float));
printf("%f ", f);
return;
case STRING:
tmp.p = gc.record_get_ptr(ctr->p, 1);
uns_root_add(&gc, &tmp);

67
prelude.scm
View File

@ -34,8 +34,10 @@
;
; Others:
; __uniapply: Apply function to single argument
; __null: A value that can only be passed to __unilambda. It cannot be
; bound to a top-level, or "set!", or added to a list.
; <undefined>: A value that can only be passed to __unilambda. It cannot
; be bound to a top-level, or "set!", or added to a list.
; It can also be the parameter of a __unilambda, although
; it still cannot be used.
;
; Macros are functions that return an sexpr.
@ -48,7 +50,7 @@
; (cdr (car (car args))) = (a)
`((__unilambda ,(car (car (car args)))
(let ,(cdr (car args)) ,@body))
,(car (cdr (car (car args))))
. ,(car (cdr (car (car args))))
)
)
)
@ -56,6 +58,20 @@
(__define-macro let* let)
; if and __unilambda only execute one statement. This uses Flatrate's
; evaluation order (arguments first) and tail-call optimization to simulate
; multiple statements.
(__define-macro begin body
(let ((first (car body))
(rest (cdr body))
)
(if (null? rest)
first
`((__unilambda <undefined> (begin ,@rest)) . ,first)
)
)
)
(__define-macro __bindlambda
(__unilambda l
(let ((larg (car l))
@ -66,7 +82,7 @@
`(__unilambda larg
(if (not (null? larg))
(raise "incorrect number of arguments")
,body
(begin ,@body)
)
)
(let* ((argval (cons args))
@ -90,10 +106,10 @@
)
(if (symbol? args)
`(__unilambda ,args ,@body)
(let ((larg (gensym)))
(if (null? args)
`(__unilambda ,larg ,@body)
`(__bindlambda ,larg . body)
`(__unilambda <undefined> (begin ,@body))
(let ((larg (gensym)))
`(__bindlambda ,larg ,@body)
)
)
)
@ -110,23 +126,12 @@
(tmpname (gensym))
)
`(__define-macro ,name
(lambda ,args ,body)
(lambda ,args ,@body)
)
)
)
)
(define-macro (define name . body)
(if (symbol? name)
`(__define ,name ,@body)
`(__define ,(car name) (lambda ,(cdr name) ,@body))
)
)
(define-macro (begin . body)
`((lambda () ,@body))
)
(define-macro (and . body)
(if (null? body)
1
@ -157,13 +162,33 @@
(val (car (cdr argval)))
(rest (cdr args))
)
`(let ((,arg __null))
(letrec ,rest (set! ,arg ,val) ,@body)
`(let ((,arg <undefined>))
(letrec ,rest (begin (set! ,arg ,val) ,@body))
)
)
)
)
(define-macro (define name . body)
(if (symbol? name)
`(__define ,name ,@body)
(let ((fname (car name))
(args (cdr name))
(tmparg (gensym))
)
`(__define ,fname
(lambda ,tmparg
(letrec ((,fname (lambda ,args ,@body)))
(,fname . ,tmparg)
)
)
)
)
)
)
;;;;;;;;;;;;;; Standard Library ;;;;;;;;;;;;;;;;;;;
;; for a list of (v1 v2 ... vn)
;; runs (f vn (... (f v2 (f v1 start))))
(define (foldl f start l)