New upstream version 21.3

1 files changed, 218 insertions, 14 deletions

diff --git a/tools/tmap.scm b/tools/tmap.scm
index 6faecb4..9db5bed 100644
--- a/tools/tmap.scm
+++ b/tools/tmap.scm
@@ -313,26 +313,14 @@
   (fe13 1))
 
 
+;;; --------------------------------------------------------------------------------
 ;;; this is a revision of some code posted in comp.lang.lisp by melzzzzz for euler project 512
 
-#|
-(define (make-boolean-vector n)
-  (make-int-vector (ceiling (/ n 63))))
-
-(define-expansion (boolean-vector-ref v n)
-  `(logbit? (int-vector-ref ,v (quotient ,n 63)) (remainder ,n 63)))
-
-(define-expansion (boolean-vector-set! v n)
-  `(int-vector-set! ,v (quotient ,n 63)
-		    (logior (int-vector-ref ,v (quotient ,n 63))
-			    (ash 1 (remainder ,n 63)))))
-|#
-;;; this is slightly faster (using int-vector is better for the largest cases)
+;;; using int-vector is better for the largest cases
 (define (make-boolean-vector n) (make-vector n #f))
 (define boolean-vector-ref vector-ref)
 (define-expansion (boolean-vector-set! v j) `(vector-set! ,v ,j #t))
 
-
 (define (odd-get n)
   (let* ((visited-range (+ (ash n -1) 1))
 	 (visited (make-boolean-vector visited-range))
@@ -386,6 +374,222 @@
 ;;; (getr 50000000)   506605921933035    6 
 ;;; (getr 500000000)  50660591862310323  67 (32M, mutable_do)
 
+;;; --------------------------------------------------------------------------------
+;;; some coverage cases
+
+(define fsize 200000)
+(define (f1 lst)
+  (for-each (lambda (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    lst))
+
+(define lst (make-list fsize ()))
+(f1 lst)
+
+(define (f2 v)
+  (for-each (lambda (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    v))
+
+(define fv (make-float-vector fsize 1.0))
+(f2 fv)
+
+(define (f3 v)
+  (for-each (lambda (p)
+	      (if (pair? p)
+		  (display 'oops)))
+	    v))
+
+(define iv (make-int-vector fsize 1))
+(f3 iv)
+
+(define (f4 v)
+  (for-each (lambda (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    v))
+
+(define v (make-vector fsize ()))
+(f4 v)
+
+(define (f5 lst)
+  (for-each (lambda (p)
+	      (if (integer? p)
+		  (throw 'oops p)))
+	    lst))
+(f5 lst)
+
+(define (f11 lst)
+  (map (lambda (p)
+	 (if (integer? p)
+	     (display 'oops)))
+       lst))
+(f11 lst)
+
+(define (f12 v)
+  (map (lambda (p)
+	 (if (integer? p)
+	     (display 'oops)))
+       v))
+(f12 fv)
+
+(define (f13 v)
+  (map (lambda (p)
+	 (if (pair? p)
+	     (display 'oops)))
+       v))
+(f13 iv)
+
+(define (f14 v)
+  (map (lambda (p)
+	 (if (integer? p)
+	     (display 'oops)))
+       v))
+(f14 v)
+
+(define (f15 lst)
+  (map (lambda (p)
+	 (if (integer? p)
+	     (throw 'oops p)))
+       lst))
+(f15 lst)
+
+
+
+(define gsize 1000000)
+
+(define (g1 lst)
+  (for-each (lambda* (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    lst))
+
+(define glst (make-list gsize ()))
+(g1 glst)
+
+(define (g2 v)
+  (for-each (lambda* (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    v))
+
+(define gfv (make-float-vector gsize 1.0))
+(g2 gfv)
+
+(define (g3 v)
+  (for-each (lambda* (p)
+	      (if (pair? p)
+		  (display 'oops)))
+	    v))
+
+(define giv (make-int-vector gsize 1))
+(g3 giv)
+
+(define (g4 v)
+  (for-each (lambda* (p)
+	      (if (integer? p)
+		  (display 'oops)))
+	    v))
+
+(define gv (make-vector gsize ()))
+(g4 gv)
+
+(define (g5 lst)
+  (for-each (lambda* (p)
+	      (if (integer? p)
+		  (throw 'oops p)))
+	    lst))
+(g5 glst)
+
+(define (g11 lst)
+  (map (lambda* (p)
+	 (if (integer? p)
+	     (display 'oops)
+             0))
+       lst))
+(g11 glst)
+
+(define (g12 v)
+  (map (lambda* (p)
+	 (if (integer? p)
+	     (display 'oops)
+             0))
+       v))
+(g12 gfv)
+
+(define (g13 v)
+  (map (lambda* (p)
+	 (if (pair? p)
+	     (display 'oops)
+             0))
+       v))
+(g13 giv)
+
+(define (g14 v)
+  (map (lambda* (p)
+	 (if (integer? p)
+	     (display 'oops)
+             0))
+       v))
+(g14 gv)
+
+(define (g15 lst)
+  (map (lambda* (p)
+	 (if (integer? p)
+	     (throw 'oops p)
+             0))
+       lst))
+(g15 glst)
+
+(define (g6 lst)
+  (for-each (lambda (p)
+	      (if (integer? p)
+		  (display 'oops))
+	      (if (pair? p)
+		  (display 'oops)))
+	    lst))
+(g6 gv)
+
+(define (g6 lst)
+  (for-each (lambda (p)
+	      (for-each (lambda (q)
+			  (if (integer? q)
+			      (display 'oops)))
+			p))
+	    lst))
+
+(define glst1 (make-list 100 (make-list 100 #\a)))
+(g6 glst1)
+
+(define (g16 lst)
+  (map (lambda (p)
+	 (map (lambda (q)
+		(if (integer? q)
+		    (display 'oops)
+		    0))
+	      p))
+       lst))
+(g16 glst1)
+
+(define fstr (make-string gsize #\a))
+(define (f7 str)
+  (for-each (lambda (p)
+	      (if (not (char? p))
+		  (display 'oops)))
+	    str))
+(f7 fstr)
+
+(define (f17 str)
+  (map (lambda (p)
+	 (if (not (char? p))
+	     (display 'oops)
+	     p))
+       str))
+(f17 fstr)
+
+
 (when (> (*s7* 'profile) 0)
   (show-profile 200))
 (exit)