Import Debian changes 3a1-4.2debian/3a1-4.2

slib (3a1-4.2) unstable; urgency=low

  * Non-maintainer upload.
  * Add guile.init.local for use within the build dir, since otherwise we
    have an (earlier unnoticed) circular build-dep due to a difference
    between scm and guile.

slib (3a1-4.1) unstable; urgency=low

  * Non-maintainer upload.
  * Build-depend on guile-1.6 instead of scm, since the new version of
    scm is wedged in unstable (closes: #281809).

slib (3a1-4) unstable; urgency=low

  * Also check for expected creation on slibcat. (Closes: #240096)

slib (3a1-3) unstable; urgency=low

  * Also check for /usr/share/guile/1.6/slib before installing for guile
    1.6. (Closes: #239267)

slib (3a1-2) unstable; urgency=low

  * Add format.scm back into slib until gnucash stops using it.
  * Call guile-1.6 new-catalog (Closes: #238231)

slib (3a1-1) unstable; urgency=low

  * New upstream release
  * Remove Info section from doc-base file (Closes: #186950)
  * Remove period from end of description (linda, lintian)
  * html gen fixed upstream (Closes: #111778)

slib (2d4-2) unstable; urgency=low

  * Fix url for upstream source (Closes: #144981)
  * Fix typo in slib.texi (enquque->enqueue) (Closes: #147475)
  * Add build depends.

slib (2d4-1) unstable; urgency=low

  * New upstream.

slib (2d3-1) unstable; urgency=low

  * New upstream.
  * Remove texi2html call in debian/rules.  Now done upstream.  Add make
    html instead.
  * Changes to rules and doc-base to conform to upstream html gen
  * Clean up upstream makefile to make sure it cleans up after itself.

1 files changed, 187 insertions, 118 deletions

diff --git a/mitscheme.init b/mitscheme.init
index afec48e..934de62 100644
--- a/mitscheme.init
+++ b/mitscheme.init
@@ -8,45 +8,49 @@
 (define getenv get-environment-variable)
 
 ;;; (software-type) should be set to the generic operating system type.
-(define (software-type) (if (getenv "HOMEDRIVE") 'MS-DOS 'UNIX))
+(define (software-type)
+  (if (eq? 'unix microcode-id/operating-system) 'UNIX 'MS-DOS))
 
 ;;; (scheme-implementation-type) should return the name of the scheme
 ;;; implementation loading this file.
-
 (define (scheme-implementation-type) 'MITScheme)
 
 ;;; (scheme-implementation-home-page) should return a (string) URI
 ;;; (Uniform Resource Identifier) for this scheme implementation's home
 ;;; page; or false if there isn't one.
-
 (define (scheme-implementation-home-page)
-  "http://swissnet.ai.mit.edu/scheme-home.html")
+  "http://www.swiss.ai.mit.edu/projects/scheme/")
 
 ;;; (scheme-implementation-version) should return a string describing
 ;;; the version the scheme implementation loading this file.
-
 (define (scheme-implementation-version)
-  (let* ((str (with-output-to-string identify-world))
-	 (beg (+ (string-search-forward "Release " str) 8))
-	 (rst (substring str beg (string-length str)))
-	 (end (string-find-next-char-in-set
-	       rst
-	       (predicate->char-set char-whitespace?))))
-    (substring rst 0 end)))
+  (get-subsystem-version-string "Release"))
+
+(define (mit-scheme-release>= major minor)
+  (let ((version (scheme-implementation-version)))
+    (let ((components (burst-string version #\. #f))
+	  (lose
+	   (lambda ()
+	     (error "Malformed release version string:" version))))
+      (let ((major*
+	     (or (and (pair? components)
+		      (string->number (car components)))
+		 (lose))))
+	(or (> major* major)
+	    (and (= major* major)
+		 (>= (or (and (pair? (cdr components))
+			      (string->number (cadr components)))
+			 (lose))
+		     minor)))))))
 
 ;;; (implementation-vicinity) should be defined to be the pathname of
 ;;; the directory where any auxillary files to your Scheme
 ;;; implementation reside.
-
 (define (implementation-vicinity)
-  (case (software-type)
-    ((MS-DOS)	"c:\\scheme\\")
-    ((UNIX)	 "/usr/local/lib/mit-scheme/")
-    ((VMS)	"scheme$src:")))
+  (->namestring (system-library-directory-pathname #f)))
 
 ;;; (library-vicinity) should be defined to be the pathname of the
 ;;; directory where files of Scheme library functions reside.
-
 (define library-vicinity
   (let ((library-path
 	 (or (getenv "SCHEME_LIBRARY_PATH")
@@ -54,22 +58,18 @@
 	     (case (software-type)
 	       ((MS-DOS) "c:\\slib\\")
 	       ((UNIX) "/usr/local/lib/slib/")
-	       ((VMS) "lib$scheme:")
 	       (else "")))))
     (lambda () library-path)))
 
 ;;; (home-vicinity) should return the vicinity of the user's HOME
 ;;; directory, the directory which typically contains files which
 ;;; customize a computer environment for a user.
-
-(define home-vicinity
-  (let ((home-path (getenv "HOME")))
-    (lambda () home-path)))
+(define (home-vicinity)
+  (->namestring (user-homedir-pathname)))
 
 ;;; *features* should be set to a list of symbols describing features
 ;;; of this implementation.  See Template.scm for the list of feature
 ;;; names.
-
 (define *features*
       '(
 	source				;can load scheme source files
@@ -79,11 +79,14 @@
 
 		       ;; Scheme report features
 
-	rev5-report			;conforms to
-	eval				;R5RS two-argument eval
+; **** no, for several reasons
+;	r5rs				;conforms to
+; **** no -- special arguments not supported
+;	eval				;R5RS two-argument eval
+; **** sort of -- not integrated with continuations
 	values				;R5RS multiple values
 	dynamic-wind			;R5RS dynamic-wind
-	macro				;R5RS high level macros
+	fluid-let
 	delay				;has DELAY and FORCE
 	multiarg-apply			;APPLY can take more than 2 args.
 	char-ready?
@@ -93,11 +96,12 @@
 					;STRING-FILL!, LIST->VECTOR,
 					;VECTOR->LIST, and VECTOR-FILL!
 
-	rev4-report			;conforms to
+	r4rs				;conforms to
 
-	ieee-p1178			;conforms to
+; **** no -- #F and '() are identical
+;	ieee-p1178			;conforms to
 
-;	rev3-report			;conforms to
+;	r3rs				;conforms to
 
 	rev2-procedures			;SUBSTRING-MOVE-LEFT!,
 					;SUBSTRING-MOVE-RIGHT!,
@@ -108,7 +112,7 @@
 
 	multiarg/and-			;/ and - can take more than 2 args.
 	with-file			;has WITH-INPUT-FROM-FILE and
-					;WITH-OUTPUT-FROM-FILE
+					;WITH-OUTPUT-TO-FILE
 	transcript			;TRANSCRIPT-ON and TRANSCRIPT-OFF
 	ieee-floating-point		;conforms to IEEE Standard 754-1985
 					;IEEE Standard for Binary
@@ -118,16 +122,14 @@
 			;; Other common features
 
 ;	srfi				;srfi-0, COND-EXPAND finds all srfi-*
-	sicp				;runs code from Structure and
-					;Interpretation of Computer
-					;Programs by Abelson and Sussman.
 	defmacro			;has Common Lisp DEFMACRO
 	record				;has user defined data structures
 	string-port			;has CALL-WITH-INPUT-STRING and
 					;CALL-WITH-OUTPUT-STRING
-;	sort
+	sort
 	pretty-print
 	object->string
+; **** limited subset with (load-option 'format)
 ;	format				;Common-lisp output formatting
 	trace				;has macros: TRACE and UNTRACE
 	compiler			;has (COMPILER)
@@ -143,6 +145,19 @@
 	Xwindows
 	))
 
+; **** MIT Scheme has SORT, but SORT! accepts only vectors.
+(define sort! sort)
+
+(define mit-scheme-has-r4rs-macros?
+  (mit-scheme-release>= 7 7))
+(if mit-scheme-has-r4rs-macros?
+    (set! *features* (cons 'macro *features*)))
+
+(if (get-subsystem-version-string "6.001")
+    ;; Runs code from "Structure and Interpretation of Computer
+    ;; Programs" by Abelson and Sussman.
+    (set! *features* (cons 'sicp *features*)))
+
 (define current-time current-file-time)
 (define difftime -)
 (define offset-time +)
@@ -151,19 +166,16 @@
 (define output-port-width output-port/x-size)
 
 ;;; (OUTPUT-PORT-HEIGHT <port>)
-(define (output-port-height . arg) 24)
+(define (output-port-height port)
+  (or (output-port/y-size port)
+      24))
 
 ;;; (CURRENT-ERROR-PORT)
-(define current-error-port
-  (let ((port console-output-port))
-    (lambda () port)))
+(define current-error-port nearest-cmdl/port)
 
 ;;; (TMPNAM) makes a temporary file name.
-(define tmpnam
-  (let ((cntr 100))
-    (lambda () (set! cntr (+ 1 cntr))
-	    (let ((tmp (string-append "slib_" (number->string cntr))))
-	      (if (file-exists? tmp) (tmpnam) tmp)))))
+(define (tmpnam)
+  (->namestring (temporary-file-pathname)))
 
 ;;; FORCE-OUTPUT flushes any pending output on optional arg output port.
 (define force-output flush-output)
@@ -172,21 +184,31 @@
 
 ;;; CALL-WITH-INPUT-STRING and CALL-WITH-OUTPUT-STRING are the string
 ;;; port versions of CALL-WITH-*PUT-FILE.
-(define (call-with-output-string proc)
-  (let ((co (current-output-port)))
-    (with-output-to-string
-      (lambda ()
-	(let ((port (current-output-port)))
-	  (with-output-to-port co
-	    (lambda () (proc port))))))))
+(define call-with-output-string with-string-output-port)
 
 (define (call-with-input-string string proc)
-  (let ((ci (current-input-port)))
-    (with-input-from-string string
-      (lambda ()
-	(let ((port (current-input-port)))
-	  (with-input-from-port ci
-	    (lambda () (proc port))))))))
+  (proc (string->input-port string)))
+
+(define (make-exchanger obj)
+  (lambda (rep) (let ((old obj)) (set! obj rep) old)))
+(define (open-file filename modes)
+  (case modes
+    ((r) (open-input-file filename))
+    ((r+) (open-i/o-file filename))
+    ((w) (open-output-file filename))
+    ((rb) (open-binary-input-file filename))
+    ((r+b rb+) (open-binary-i/o-file filename))
+    ((wb) (open-binary-output-file filename))
+    (else (slib:error 'open-file 'mode? modes))))
+(define (call-with-open-ports . ports)
+  (define proc (car ports))
+  (cond ((procedure? proc) (set! ports (cdr ports)))
+	(else (set! ports (reverse ports))
+	      (set! proc (car ports))
+	      (set! ports (reverse (cdr ports)))))
+  (let ((ans (apply proc ports)))
+    (for-each close-port ports)
+    ans))
 
 (define object->string write-to-string)
 (define object->limited-string write-to-string)
@@ -199,61 +221,113 @@
   (find-ratio (/ (+ x y) 2) (/ (- x y) 2)))
 
 ;;; CHAR-CODE-LIMIT is one greater than the largest integer which can
-;;; be returned by CHAR->INTEGER.  It is defined incorrectly (65536)
-;;; by MITScheme version 8.0.
-(define char-code-limit 256)
+;;; be returned by CHAR->INTEGER.
+;;;
+;;; [Note that this definition conflicts with MIT Scheme's definition
+;;; of the same name.]
+;;;
+;;; Can't use correct value because "jacal/types.scm" assumes that
+;;; every possible character can be stored into a string.  In MIT
+;;; Scheme, only 8-bit characters fit in strings, while the character
+;;; object supports 16 bits of character code with 5 bucky bits.  So
+;;; instead provide the limit that is appropriate for string
+;;; characters.
+(define char-code-limit
+  ;;char-integer-limit
+  256)
 
 ;;; MOST-POSITIVE-FIXNUM is used in modular.scm
-(define most-positive-fixnum #x03FFFFFF)
+(define most-positive-fixnum
+  (let loop ((n 1))
+    (if (fix:fixnum? n)
+	(loop (* n 2))
+	(- n 1))))
 
 ;;; Return argument
-(define (identity x) x)
+(define identity identity-procedure)
 
 ;;; SLIB:EVAL is single argument eval using the top-level (user) environment.
-;(define (slib:eval form) (eval form (repl/environment (nearest-repl))))
+;(define (slib:eval form) (eval form (nearest-repl/environment)))
 (define (slib:eval form) (eval form user-initial-environment))
 
 (define *macros* '(defmacro))
 (define (defmacro? m) (and (memq m *macros*) #t))
 
-(syntax-table-define system-global-syntax-table 'defmacro
-  (macro defmacargs
-    (let ((macname (car defmacargs)) (macargs (cadr defmacargs))
-				     (macbdy (cddr defmacargs)))
-      `(begin
-	 (set! *macros* (cons ',macname *macros*))
-	 (syntax-table-define system-global-syntax-table ',macname
-	   (macro ,macargs ,@macbdy))))))
-
-(define (macroexpand-1 e)
-  (if (pair? e) (let ((a (car e)))
-		  (if (and (symbol? a) (defmacro? a))
-		      (apply (syntax-table-ref system-global-syntax-table a)
-			     (cdr e))
-		      e))
-      e))
-
-(define (macroexpand e)
-  (if (pair? e) (let ((a (car e)))
-		  (if (and (symbol? a) (defmacro? a))
-		      (macroexpand
-		       (apply (syntax-table-ref system-global-syntax-table a)
-			      (cdr e)))
-		      e))
-      e))
-
-(define gentemp
-  (let ((*gensym-counter* -1))
-    (lambda ()
-      (set! *gensym-counter* (+ *gensym-counter* 1))
-      (string->symbol
-       (string-append "slib:G" (number->string *gensym-counter*))))))
+(if mit-scheme-has-r4rs-macros?
+    (environment-define-macro user-initial-environment 'defmacro
+      (non-hygienic-macro-transformer->expander
+       (lambda arguments
+	 (let ((name (car arguments)))
+	   `(begin
+	      (set! *macros* (cons ',name *macros*))
+	      (environment-define-macro user-initial-environment ',name
+		(non-hygienic-macro-transformer->expander
+		 (lambda ,@(cdr arguments))
+		 user-initial-environment)))))
+       user-initial-environment))
+    (syntax-table-define system-global-syntax-table 'defmacro
+      (macro defmacargs
+	(let ((macname (car defmacargs)) (macargs (cadr defmacargs))
+					 (macbdy (cddr defmacargs)))
+	  `(begin
+	     (set! *macros* (cons ',macname *macros*))
+	     (syntax-table-define system-global-syntax-table ',macname
+	       (macro ,macargs ,@macbdy)))))))
+
+(define macroexpand-1)
+(define macroexpand)
+(let ((finish
+       (lambda (get-transformer apply-transformer)
+	 (set! macroexpand-1
+	       (lambda (form)
+		 (let ((transformer (get-transformer form)))
+		   (if transformer
+		       (apply-transformer transformer form)
+		       form))))
+	 (set! macroexpand
+	       (lambda (form)
+		 (let ((transformer (get-transformer form)))
+		   (if transformer
+		       (macroexpand (apply-transformer transformer form))
+		       form)))))))
+  (if mit-scheme-has-r4rs-macros?
+      (let ((e (->environment '(runtime syntactic-closures))))
+	(let ((transformer-item/expander (access transformer-item/expander e))
+	      (expander-item/expander (access expander-item/expander e))
+	      (expander-item/environment (access expander-item/environment e)))
+	  (finish
+	   (lambda (form)
+	     (and (pair? form)
+		  (let ((a (car form)))
+		    (and (symbol? a)
+			 (defmacro? a)
+			 (environment-lookup-macro user-initial-environment
+						   a)))))
+	   (lambda (item form)
+	     (let ((item (transformer-item/expander item)))
+	       ((expander-item/expander item)
+		form
+		user-initial-environment
+		(expander-item/environment item)))))))
+      (finish
+       (lambda (form)
+	 (and (pair? form)
+	      (let ((a (car form)))
+		(and (symbol? a)
+		     (defmacro? a)
+		     (syntax-table-ref system-global-syntax-table a)))))
+       (apply-transformer
+	(lambda (transformer form)
+	  (apply transformer (cdr form)))))))
+
+(define gentemp generate-uninterned-symbol)
 
 (define defmacro:eval slib:eval)
 (define defmacro:load load)
-;;; If your implementation provides R4RS macros:
-;(define macro:eval slib:eval)
-;(define macro:load load)
+(if mit-scheme-has-r4rs-macros?
+    (begin
+      (environment-define (the-environment) 'macro:eval slib:eval)
+      (environment-define (the-environment) 'macro:load load)))
 
 (define (slib:eval-load <pathname> evl)
   (if (not (file-exists? <pathname>))
@@ -261,31 +335,30 @@
   (call-with-input-file <pathname>
     (lambda (port)
       (let ((old-load-pathname *load-pathname*))
-	(set! *load-pathname* <pathname>)
-	(do ((o (read port) (read port)))
-	    ((eof-object? o))
-	  (evl o))
-	(set! *load-pathname* old-load-pathname)))))
+	(fluid-let ((*load-pathname* <pathname>))
+	  (do ((o (read port) (read port)))
+	      ((eof-object? o))
+	    (evl o)))))))
 
-(define record-modifier record-updater)	;some versions need this?
+;; Older implementations need this definition.
+(if (lexical-unreferenceable? (the-environment) 'record-modifier)
+    (local-assignment (the-environment) 'record-modifier record-updater))
 
-(define slib:warn
-  (lambda args
-    (let ((cep (current-error-port)))
-      (if (provided? 'trace) (print-call-stack cep))
-      (display "Warn: " cep)
-      (for-each (lambda (x) (display x cep)) args))))
+(define (slib:warn . args)
+  (if (provided? 'trace) (print-call-stack (notification-output-port)))
+  (apply warn args))
 
 ;; define an error procedure for the library
 (define (slib:error . args)
   (if (provided? 'trace) (print-call-stack (current-error-port)))
-  (apply error-procedure (append args (list (the-environment)))))
+  (apply error args))
 
 ;; define these as appropriate for your system.
-(define slib:tab (integer->char 9))
-(define slib:form-feed (integer->char 12))
+(define slib:tab (name->char "tab"))
+(define slib:form-feed (name->char "page"))
 
-(define in-vicinity string-append)
+(define (in-vicinity vicinity file-name)
+  (->namestring (merge-pathnames file-name vicinity)))
 
 ;;; Define SLIB:EXIT to be the implementation procedure to exit or
 ;;; return if exitting not supported.
@@ -297,22 +370,18 @@
 	  (else (exit 1)))))
 
 ;;; Here for backward compatability
-
 (define (scheme-file-suffix) ".scm")
 
 ;;; (SLIB:LOAD-SOURCE "foo") should load "foo.scm" or with whatever
 ;;; suffix all the module files in SLIB have.  See feature 'SOURCE.
-
 (define slib:load-source load)
 
 ;;; (SLIB:LOAD-COMPILED "foo") should load the file that was produced
 ;;; by compiling "foo.scm" if this implementation can compile files.
 ;;; See feature 'COMPILED.
-
 (define slib:load-compiled load)
 
 ;;; At this point SLIB:LOAD must be able to load SLIB files.
-
 (define slib:load slib:load-source)
 
 (slib:load (in-vicinity (library-vicinity) "require.scm"))