shithub: femtolisp

Info  •  Files  •  Log

fixing bug in datum comment #;
improving some library functions

--- a/femtolisp/read.c

+++ b/femtolisp/read.c

@@ -2,8 +2,7 @@

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

     return issym;

 }

+static value_t do_read_sexpr(value_t label);

+

 static u_int32_t peek()

 {

     char c, *end;

@@ -267,7 +268,9 @@

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

     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;

@@ -520,10 +521,6 @@

         return POP();

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

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

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