fixing bug in datum comment #;

improving some library functions

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);

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

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)))