diff --git a/femtolisp/read.c b/femtolisp/read.c index 8cb086a..e59468d 100644 --- a/femtolisp/read.c +++ b/femtolisp/read.c @@ -2,8 +2,7 @@ enum { TOK_NONE, TOK_OPEN, TOK_CLOSE, TOK_DOT, TOK_QUOTE, TOK_SYM, TOK_NUM, TOK_BQ, TOK_COMMA, TOK_COMMAAT, TOK_COMMADOT, TOK_SHARPDOT, TOK_LABEL, TOK_BACKREF, TOK_SHARPQUOTE, TOK_SHARPOPEN, - TOK_OPENB, TOK_CLOSEB, TOK_SHARPSYM, TOK_GENSYM, TOK_DOUBLEQUOTE, - TOK_SHARPSEMI + TOK_OPENB, TOK_CLOSEB, TOK_SHARPSYM, TOK_GENSYM, TOK_DOUBLEQUOTE }; #define F value2c(ios_t*,readstate->source) @@ -160,6 +159,8 @@ static int read_token(char c, int digits) return issym; } +static value_t do_read_sexpr(value_t label); + static u_int32_t peek() { char c, *end; @@ -267,7 +268,9 @@ static u_int32_t peek() return peek(); } else if (c == ';') { - toktype = TOK_SHARPSEMI; + // datum comment + (void)do_read_sexpr(UNBOUND); // skip + return peek(); } else if (c == ':') { // gensym @@ -331,8 +334,6 @@ static u_int32_t peek() return toktype; } -static value_t do_read_sexpr(value_t label); - static value_t read_vector(value_t label, u_int32_t closer) { value_t v=alloc_vector(4, 1), elt; @@ -521,10 +522,6 @@ static value_t do_read_sexpr(value_t label) case TOK_SHARPQUOTE: // femtoLisp doesn't need symbol-function, so #' does nothing 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: PUSH(NIL); read_list(&Stack[SP-1], label); diff --git a/femtolisp/rule30.lsp b/femtolisp/rule30.lsp index 713d01b..19b8231 100644 --- a/femtolisp/rule30.lsp +++ b/femtolisp/rule30.lsp @@ -15,15 +15,16 @@ (if (<= n 0) () (cons zero (nestlist f (f zero) (- n 1))))) -(define (make-string k ch) - (cond ((<= k 0) "") - ((= k 1) (string ch)) - ((= k 2) (string ch ch)) - ((odd? k) (string ch (make-string (- k 1) ch))) - (else (let ((half (make-string (/ k 2) ch))) - (string half half))))) +(define (string.rep s k) + (cond ((< k 4) + (cond ((<= k 0) "") + ((= k 1) (string s)) + ((= k 2) (string s s)) + (else (string s s s)))) + ((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) (string.map (lambda (c) (case c diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp index 1c34da2..ad2d311 100644 --- a/femtolisp/system.lsp +++ b/femtolisp/system.lsp @@ -281,12 +281,12 @@ (define (mapcar f . lsts) ((label mapcar- - (lambda (lsts) + (lambda (f lsts) (cond ((null? lsts) (f)) ((atom? (car lsts)) (car lsts)) - (#t (cons (apply f (map car lsts)) - (mapcar- (map cdr lsts))))))) - lsts)) + (#t (cons (apply f (map car lsts)) + (mapcar- f (map cdr lsts))))))) + f lsts)) (define (transpose M) (apply mapcar (cons list M))) @@ -473,10 +473,10 @@ (define ι iota) (define (for-each f l) - (when (pair? l) - (begin (f (car l)) - (for-each f (cdr l)))) - #t) + (if (pair? l) + (begin (f (car l)) + (for-each f (cdr l))) + #t)) (define (error . args) (raise (cons 'error args))) @@ -593,11 +593,11 @@ (define (string.map f s) (let ((b (buffer)) (n (length s))) - (let loop ((i 0)) - (if (< i n) - (begin (io.putc b (f (string.char s i))) - (loop (string.inc s i))) - (io.tostring! b))))) + (let ((i 0)) + (while (< i n) + (begin (io.putc b (f (string.char s i))) + (set! i (string.inc s i))))) + (io.tostring! b))) (define (print-to-string v) (let ((b (buffer)))