fixing bug in datum comment #;
improving some library functions
This commit is contained in:
parent
bfa30fb095
commit
0643a4f3a2
|
@ -2,8 +2,7 @@ enum {
|
||||||
TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM,
|
TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM,
|
||||||
TOK_BQ, TOK_COMMA, TOK_COMMAAT, TOK_COMMADOT,
|
TOK_BQ, TOK_COMMA, TOK_COMMAAT, TOK_COMMADOT,
|
||||||
TOK_SHARPDOT, TOK_LABEL, TOK_BACKREF, TOK_SHARPQUOTE, TOK_SHARPOPEN,
|
TOK_SHARPDOT, TOK_LABEL, TOK_BACKREF, TOK_SHARPQUOTE, TOK_SHARPOPEN,
|
||||||
TOK_OPENB, TOK_CLOSEB, TOK_SHARPSYM, TOK_GENSYM, TOK_DOUBLEQUOTE,
|
TOK_OPENB, TOK_CLOSEB, TOK_SHARPSYM, TOK_GENSYM, TOK_DOUBLEQUOTE
|
||||||
TOK_SHARPSEMI
|
|
||||||
};
|
};
|
||||||
|
|
||||||
#define F value2c(ios_t*,readstate->source)
|
#define F value2c(ios_t*,readstate->source)
|
||||||
|
@ -160,6 +159,8 @@ static int read_token(char c, int digits)
|
||||||
return issym;
|
return issym;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static value_t do_read_sexpr(value_t label);
|
||||||
|
|
||||||
static u_int32_t peek()
|
static u_int32_t peek()
|
||||||
{
|
{
|
||||||
char c, *end;
|
char c, *end;
|
||||||
|
@ -267,7 +268,9 @@ static u_int32_t peek()
|
||||||
return peek();
|
return peek();
|
||||||
}
|
}
|
||||||
else if (c == ';') {
|
else if (c == ';') {
|
||||||
toktype = TOK_SHARPSEMI;
|
// datum comment
|
||||||
|
(void)do_read_sexpr(UNBOUND); // skip
|
||||||
|
return peek();
|
||||||
}
|
}
|
||||||
else if (c == ':') {
|
else if (c == ':') {
|
||||||
// gensym
|
// gensym
|
||||||
|
@ -331,8 +334,6 @@ static u_int32_t peek()
|
||||||
return toktype;
|
return toktype;
|
||||||
}
|
}
|
||||||
|
|
||||||
static value_t do_read_sexpr(value_t label);
|
|
||||||
|
|
||||||
static value_t read_vector(value_t label, u_int32_t closer)
|
static value_t read_vector(value_t label, u_int32_t closer)
|
||||||
{
|
{
|
||||||
value_t v=alloc_vector(4, 1), elt;
|
value_t v=alloc_vector(4, 1), elt;
|
||||||
|
@ -521,10 +522,6 @@ static value_t do_read_sexpr(value_t label)
|
||||||
case TOK_SHARPQUOTE:
|
case TOK_SHARPQUOTE:
|
||||||
// femtoLisp doesn't need symbol-function, so #' does nothing
|
// femtoLisp doesn't need symbol-function, so #' does nothing
|
||||||
return do_read_sexpr(label);
|
return do_read_sexpr(label);
|
||||||
case TOK_SHARPSEMI:
|
|
||||||
// datum comment
|
|
||||||
(void)do_read_sexpr(UNBOUND); // skip one
|
|
||||||
return do_read_sexpr(label);
|
|
||||||
case TOK_OPEN:
|
case TOK_OPEN:
|
||||||
PUSH(NIL);
|
PUSH(NIL);
|
||||||
read_list(&Stack[SP-1], label);
|
read_list(&Stack[SP-1], label);
|
||||||
|
|
|
@ -15,15 +15,16 @@
|
||||||
(if (<= n 0) ()
|
(if (<= n 0) ()
|
||||||
(cons zero (nestlist f (f zero) (- n 1)))))
|
(cons zero (nestlist f (f zero) (- n 1)))))
|
||||||
|
|
||||||
(define (make-string k ch)
|
(define (string.rep s k)
|
||||||
(cond ((<= k 0) "")
|
(cond ((< k 4)
|
||||||
((= k 1) (string ch))
|
(cond ((<= k 0) "")
|
||||||
((= k 2) (string ch ch))
|
((= k 1) (string s))
|
||||||
((odd? k) (string ch (make-string (- k 1) ch)))
|
((= k 2) (string s s))
|
||||||
(else (let ((half (make-string (/ k 2) ch)))
|
(else (string s s s))))
|
||||||
(string half half)))))
|
((odd? k) (string s (string.rep s (- k 1))))
|
||||||
|
(else (string.rep (string s s) (/ k 2)))))
|
||||||
|
|
||||||
(define (pad0 s n) (string (make-string (- n (length s)) "0") s))
|
(define (pad0 s n) (string (string.rep "0" (- n (length s))) s))
|
||||||
|
|
||||||
(define (bin-draw s)
|
(define (bin-draw s)
|
||||||
(string.map (lambda (c) (case c
|
(string.map (lambda (c) (case c
|
||||||
|
|
|
@ -281,12 +281,12 @@
|
||||||
|
|
||||||
(define (mapcar f . lsts)
|
(define (mapcar f . lsts)
|
||||||
((label mapcar-
|
((label mapcar-
|
||||||
(lambda (lsts)
|
(lambda (f lsts)
|
||||||
(cond ((null? lsts) (f))
|
(cond ((null? lsts) (f))
|
||||||
((atom? (car lsts)) (car lsts))
|
((atom? (car lsts)) (car lsts))
|
||||||
(#t (cons (apply f (map car lsts))
|
(#t (cons (apply f (map car lsts))
|
||||||
(mapcar- (map cdr lsts)))))))
|
(mapcar- f (map cdr lsts)))))))
|
||||||
lsts))
|
f lsts))
|
||||||
|
|
||||||
(define (transpose M) (apply mapcar (cons list M)))
|
(define (transpose M) (apply mapcar (cons list M)))
|
||||||
|
|
||||||
|
@ -473,10 +473,10 @@
|
||||||
(define ι iota)
|
(define ι iota)
|
||||||
|
|
||||||
(define (for-each f l)
|
(define (for-each f l)
|
||||||
(when (pair? l)
|
(if (pair? l)
|
||||||
(begin (f (car l))
|
(begin (f (car l))
|
||||||
(for-each f (cdr l))))
|
(for-each f (cdr l)))
|
||||||
#t)
|
#t))
|
||||||
|
|
||||||
(define (error . args) (raise (cons 'error args)))
|
(define (error . args) (raise (cons 'error args)))
|
||||||
|
|
||||||
|
@ -593,11 +593,11 @@
|
||||||
(define (string.map f s)
|
(define (string.map f s)
|
||||||
(let ((b (buffer))
|
(let ((b (buffer))
|
||||||
(n (length s)))
|
(n (length s)))
|
||||||
(let loop ((i 0))
|
(let ((i 0))
|
||||||
(if (< i n)
|
(while (< i n)
|
||||||
(begin (io.putc b (f (string.char s i)))
|
(begin (io.putc b (f (string.char s i)))
|
||||||
(loop (string.inc s i)))
|
(set! i (string.inc s i)))))
|
||||||
(io.tostring! b)))))
|
(io.tostring! b)))
|
||||||
|
|
||||||
(define (print-to-string v)
|
(define (print-to-string v)
|
||||||
(let ((b (buffer)))
|
(let ((b (buffer)))
|
||||||
|
|
Loading…
Reference in New Issue