* boot-9.scm: Removed the old printer code.

* r4rs.scm (apply, call-with-current-continuation): Added comment
explaining why apply and call/cc need to be closures.

* boot-9.scm (apply, call-with-current-continuation): Bugfix:
Removed. These definitions are already present in r4rs.scm.

ice-9/ChangeLog

@@ -1,5 +1,13 @@
 Sat Mar  1 15:24:39 1997  Mikael Djurfeldt  <mdj@mdj.nada.kth.se>
 
+	* boot-9.scm: Removed the old printer code.
+
+	* r4rs.scm (apply, call-with-current-continuation): Added comment
+	explaining why apply and call/cc need to be closures.
+
+	* boot-9.scm (apply, call-with-current-continuation): Bugfix:
+	Removed. These definitions are already present in r4rs.scm.
+
 	* debug.scm (trace-entry, trace-exit): Check that we're on a repl
  	stack before printing traced frames; Re-enable trace flag at end
  	of handlers.

ice-9/boot-9.scm

@@ -70,18 +70,6 @@
       (newline)
       (car (last-pair stuff)))))
 
-
-;;; {apply and call-with-current-continuation}
-;;;
-;;; These turn syntax, @apply and @call-with-current-continuation,
-;;; into procedures.   
-;;;
-
-(set! apply (lambda (fun . args) (@apply fun (apply:nconc2last args))))
-(define (call-with-current-continuation proc)
-  (@call-with-current-continuation proc))
-
-
 
 ;;; {Trivial Functions}
 ;;;
@@ -309,111 +297,6 @@
   (let ((rem (member kw args)))
     (and rem (pair? (cdr rem)) (cadr rem))))
 
-
-;;; {Print}
-;;; MDJ 960919 <djurfeldt@nada.kth.se>: This code will probably be
-;;; removed before the first release of Guile.  Later releases may
-;;; contain more fancy printing code.
-
-(define (print obj . args)
-  (let ((default-args (list (current-output-port) 0 0 default-print-style #f)))
-    (apply-to-args (append args (list-cdr-ref default-args (length args)))
-      (lambda (port depth length style table)
-	(cond
-	 ((and table (print-table-ref table obj))
-	  ((print-style-tag-hook style 'eq-val) 
-	   obj port depth length style table))
-	 (else
-	  (and table (print-table-add! table obj))
-	  (cond
-	   ((print-style-max-depth? style depth)
-	    ((print-style-excess-depth-hook style)))
-	   ((print-style-max-length? style length)
-	    ((print-style-excess-length-hook style)))
-	   (else
-	    ((print-style-hook style obj)
-	     obj port depth length style table)))))))))
-
-(define (make-print-style) (make-vector 59 '()))
-
-(define (extend-print-style! style utag printer)
-  (hashq-set! style utag printer))
-
-(define (print-style-hook style obj)
-  (let ((type-tag (tag obj)))
-    (or (hashq-ref style type-tag)
-	(hashq-ref style (logand type-tag 255))
-	print-obj)))
-
-(define (print-style-tag-hook style type-tag)
-  (or (hashq-ref style type-tag)
-      print-obj))
-
-(define (print-style-max-depth? style d) #f)
-(define (print-style-max-length? style l) #f)
-(define (print-style-excess-length-hook style)
-  (hashq-ref style 'excess-length-hook))
-(define (print-style-excess-depth-hook style)
-  (hashq-ref style 'excess-depth-hook))
-
-(define (make-print-table) (make-vector 59 '()))
-(define (print-table-ref table obj) (hashq-ref table obj))
-(define (print-table-add! table obj) (hashq-set! table obj (gensym 'ref)))
-
-(define (print-obj obj port depth length style table) (write obj port))
-
-(define (print-pair pair port depth length style table)
-  (if (= 0 length)
-      (display #\( port))
-
-  (print (car pair) port (+ 1 depth) 0 style table)
-
-  (cond
-   ((and (pair? (cdr pair))
-	 (or (not table)
-	     (not (print-table-ref table (cdr pair)))))
-
-    (display #\space port)
-    (print (cdr pair) port depth (+ 1 length) style table))
-
-   ((null? (cdr pair))		(display #\) port))
-   
-   (else			(display " . " port)
-				(print (cdr pair) port (+ 1 depth) 0
-				       style table)
-				(display #\) port))))
-
-(define (print-vector obj port depth length style table)
-  (if (= 0 length)
-      (cond
-       ((weak-key-hash-table? obj)	(display "#wh(" port))
-       ((weak-value-hash-table? obj)	(display "#whv(" port))
-       ((doubly-weak-hash-table? obj)	(display "#whd(" port))
-       (else		  		(display "#(" port))))
-	  
-  (if (< length (vector-length obj))
-      (print (vector-ref obj length) port (+ 1 depth) 0 style table))
-
-  (cond
-   ((>= (+ 1 length) (vector-length obj))	(display #\) port))
-   (else					(display #\space port)
-						(print obj port depth
-						       (+ 1 length)
-						       style table))))
-
-(define default-print-style (make-print-style))
-
-(extend-print-style! default-print-style utag_vector print-vector)
-(extend-print-style! default-print-style utag_wvect print-vector)
-(extend-print-style! default-print-style utag_pair print-pair)
-(extend-print-style! default-print-style 'eq-val
-		     (lambda (obj port depth length style table)
-		       (if (symbol? obj)
-			   (display obj)
-			   (begin
-			     (display "##" port)
-			     (display (print-table-ref table obj))))))
-
 
 ;;; {Records}
 ;;;

ice-9/r4rs.scm

@@ -20,9 +20,9 @@
 
 ;;;; apply and call-with-current-continuation
 
-;;; These turn syntax, @apply and @call-with-current-continuation,
-;;; into procedures.  If someone knows why they have to be syntax to
-;;; begin with, please fix this comment.
+;;; We want these to be tail-recursive, so instead of using primitive
+;;; procedures, we define them as closures in terms of the primitive
+;;; macros @apply and @call-with-current-continuation.
 (set! apply (lambda (fun . args) (@apply fun (apply:nconc2last args))))
 (define (call-with-current-continuation proc)
   (@call-with-current-continuation proc))