Import Upstream version 5d6upstream/5d6

1 files changed, 79 insertions, 83 deletions

diff --git a/mkimpcat.scm b/mkimpcat.scm
index 57c29b0..f94f949 100644
--- a/mkimpcat.scm
+++ b/mkimpcat.scm
@@ -15,50 +15,57 @@
 ;; the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 ;;
 ;; As a special exception, the Free Software Foundation gives permission
-;; for additional uses of the text contained in its release of GUILE.
+;; for additional uses of the text contained in its release of SCM.
 ;;
-;; The exception is that, if you link the GUILE library with other files
+;; The exception is that, if you link the SCM library with other files
 ;; to produce an executable, this does not by itself cause the
 ;; resulting executable to be covered by the GNU General Public License.
 ;; Your use of that executable is in no way restricted on account of
-;; linking the GUILE library code into it.
+;; linking the SCM library code into it.
 ;;
 ;; This exception does not however invalidate any other reasons why
 ;; the executable file might be covered by the GNU General Public License.
 ;;
 ;; This exception applies only to the code released by the
-;; Free Software Foundation under the name GUILE.  If you copy
+;; Free Software Foundation under the name SCM.  If you copy
 ;; code from other Free Software Foundation releases into a copy of
-;; GUILE, as the General Public License permits, the exception does
+;; SCM, as the General Public License permits, the exception does
 ;; not apply to the code that you add in this way.  To avoid misleading
 ;; anyone as to the status of such modified files, you must delete
 ;; this exception notice from them.
 ;;
-;; If you write modifications of your own for GUILE, it is your choice
+;; If you write modifications of your own for SCM, it is your choice
 ;; whether to permit this exception to apply to your modifications.
 ;; If you do not wish that, delete this exception notice.
 
 ;;;; "mkimpcat.scm" Build SCM-specific catalog for SLIB.
 ;;; Author: Aubrey Jaffer.
 
-(let ((catname "implcat"))
-  (call-with-output-file (in-vicinity (implementation-vicinity) catname)
+(let ((catname "implcat")
+      (iv (implementation-vicinity)))
+  (define (in-implementation-vicinity . paths) (apply in-vicinity iv paths))
+  (call-with-output-file (in-implementation-vicinity catname)
     (lambda (op)
       (define (display* . args)
 	(for-each (lambda (arg) (display arg op)) args)
 	(newline op))
-      (define wb:vicinity (string-append (implementation-vicinity) "../wb/"))
-      (define x-scm:vicinity
-	(string-append (implementation-vicinity) "../xscm-2.01/"))
-      (define (add-link feature ofile . libs)
-	(cond ((file-exists? ofile)
-	       ;; remove #f from libs list
-	       (set! libs (let rem ((l libs))
-			    (cond ((null? l) l)
-				  ((car l) (cons (car l) (rem (cdr l))))
-				  (else (rem (cdr l))))))
+      (define (in-wb-vicinity . paths) (apply in-vicinity iv "../wb/" paths))
+      (define (in-xscm-vicinity . paths) (apply in-vicinity iv "../xscm-2.01/" paths))
+      (define (add-link feature . libs)
+	(define syms '())
+	;; remove #f from libs list
+	(set! libs (let rem ((l libs))
+		     (cond ((null? l) l)
+			   ((symbol? (car l))
+			    (set! syms (cons (car l) syms))
+			    (rem (cdr l)))
+			   ((car l) (cons (car l) (rem (cdr l))))
+			   (else (rem (cdr l))))))
+	(cond ((file-exists? (car libs))
 	       (display " " op)
-	       (write (cons feature (cons 'compiled (cons ofile libs))) op)
+	       (write
+		(cons feature (cons 'compiled (append syms libs)))
+		op)
 	       (newline op)
 	       #t)
 	      (else #f)))
@@ -72,95 +79,86 @@
 	(display* "(")
 	(begin
 	  (cond ((add-link 'i/o-extensions
-			   (in-vicinity (implementation-vicinity) "ioext"
-					link:able-suffix)
+			   (in-implementation-vicinity "ioext" link:able-suffix)
 			   (usr:lib "c"))
 		 (add-alias 'directory-for-each 'i/o-extensions)
 		 (add-alias 'line-i/o 'i/o-extensions)
 		 (add-alias 'pipe 'i/o-extensions)))
 	  (cond ((add-link 'rev2-procedures
-			   (in-vicinity (implementation-vicinity) "sc2"
-					link:able-suffix))
-		 (add-alias  'rev3-procedures 'rev2-procedures)))
+			   (in-implementation-vicinity "sc2"
+						       link:able-suffix))))
 	  (cond ((or
 		  (add-link 'db
-			    (in-vicinity wb:vicinity "db.so"))
+			    (in-wb-vicinity "db.so"))
 		  (add-link 'db
-			    (in-vicinity wb:vicinity "db" link:able-suffix)
-			    (in-vicinity wb:vicinity "handle" link:able-suffix)
-			    (in-vicinity wb:vicinity "blink" link:able-suffix)
-			    (in-vicinity wb:vicinity "prev" link:able-suffix)
-			    (in-vicinity wb:vicinity "ent" link:able-suffix)
-			    (in-vicinity wb:vicinity "sys" link:able-suffix)
-			    (in-vicinity wb:vicinity "del" link:able-suffix)
-			    (in-vicinity wb:vicinity "stats" link:able-suffix)
-			    (in-vicinity wb:vicinity "blkio" link:able-suffix)
-			    (in-vicinity wb:vicinity "scan" link:able-suffix)
+			    (in-wb-vicinity "db" link:able-suffix)
+			    (in-wb-vicinity "handle" link:able-suffix)
+			    (in-wb-vicinity "blink" link:able-suffix)
+			    (in-wb-vicinity "prev" link:able-suffix)
+			    (in-wb-vicinity "ent" link:able-suffix)
+			    (in-wb-vicinity "sys" link:able-suffix)
+			    (in-wb-vicinity "del" link:able-suffix)
+			    (in-wb-vicinity "stats" link:able-suffix)
+			    (in-wb-vicinity "blkio" link:able-suffix)
+			    (in-wb-vicinity "scan" link:able-suffix)
 			    (usr:lib "c")))
 		 (add-source 'wb-table
-			     (in-vicinity wb:vicinity "wbtab"))
+			     (in-wb-vicinity "wbtab"))
 		 (add-alias 'wb 'db)))
+	  (cond ((add-link 'mysql
+			   (in-implementation-vicinity "database"
+						       link:able-suffix)
+			   ;;(usr:lib "mysqlclient") ;?
+			   )))
 	  (cond ((add-link 'stringvector
-			   (in-vicinity x-scm:vicinity "strvec" link:able-suffix))
-		 (add-source 'x11   (in-vicinity x-scm:vicinity "x11"))
-		 (add-source 'xevent(in-vicinity x-scm:vicinity "xevent"))
-		 (add-source 'xt    (in-vicinity x-scm:vicinity "xt"))
-		 (add-source 'xm    (in-vicinity x-scm:vicinity "xm"))
-		 (add-source 'xmsubs(in-vicinity x-scm:vicinity "xmsubs"))
-		 (add-source 'xaw   (in-vicinity x-scm:vicinity "xaw"))
-		 (add-source 'xpm   (in-vicinity x-scm:vicinity "xpm"))))
+			   (in-xscm-vicinity "strvec" link:able-suffix))
+		 (add-source 'x11   (in-xscm-vicinity "x11"))
+		 (add-source 'xevent(in-xscm-vicinity "xevent"))
+		 (add-source 'xt    (in-xscm-vicinity "xt"))
+		 (add-source 'xm    (in-xscm-vicinity "xm"))
+		 (add-source 'xmsubs(in-xscm-vicinity "xmsubs"))
+		 (add-source 'xaw   (in-xscm-vicinity "xaw"))
+		 (add-source 'xpm   (in-xscm-vicinity "xpm"))))
 
 	  (add-link 'turtle-graphics
-		    (in-vicinity (implementation-vicinity) "turtlegr"
-				 link:able-suffix)
+		    (in-implementation-vicinity "turtlegr" link:able-suffix)
 		    (x:lib "X11")
 		    (usr:lib "m")
 		    (usr:lib "c"))
 	  (add-link 'Xlib
-		    (in-vicinity (implementation-vicinity) "x"
-				 link:able-suffix)
+		    (in-implementation-vicinity "x" link:able-suffix)
 		    (x:lib "X11")
 		    (usr:lib "c"))
 	  (add-link 'curses
-		    (in-vicinity (implementation-vicinity) "crs"
-				 link:able-suffix)
+		    (in-implementation-vicinity "crs" link:able-suffix)
 		    (usr:lib "ncurses")
 		    ;;(usr:lib "curses")
 		    ;;(usr:lib "termcap")
 		    (usr:lib "c"))
 	  (add-link 'edit-line
-		    (in-vicinity (implementation-vicinity) "edline"
-				 link:able-suffix)
+		    (in-implementation-vicinity "edline" link:able-suffix)
 		    (usr:lib "readline")
 		    (usr:lib "termcap")
 		    (usr:lib "c"))
 	  (add-link 'regex
-		    (in-vicinity (implementation-vicinity) "rgx"
-				 link:able-suffix)
+		    (in-implementation-vicinity "rgx" link:able-suffix)
 		    (usr:lib "c"))
 	  (add-link 'unix
-		    (in-vicinity (implementation-vicinity) "unix"
-				 link:able-suffix)
-		    (in-vicinity (implementation-vicinity) "ioext"
-				 link:able-suffix)
+		    'i/o-extensions
+		    (in-implementation-vicinity "unix" link:able-suffix)
 		    (usr:lib "c"))
 	  (add-link 'posix
-		    (in-vicinity (implementation-vicinity) "posix"
-				 link:able-suffix)
+		    (in-implementation-vicinity "posix" link:able-suffix)
 		    (usr:lib "c"))
 	  (add-link 'socket
-		    (in-vicinity (implementation-vicinity) "socket"
-				 link:able-suffix)
+		    (in-implementation-vicinity "socket" link:able-suffix)
 		    (usr:lib "c"))
 	  (add-link 'record
-		    (in-vicinity (implementation-vicinity) "record"
-				 link:able-suffix))
+		    (in-implementation-vicinity "record" link:able-suffix))
 	  (add-link 'generalized-c-arguments
-		    (in-vicinity (implementation-vicinity) "gsubr"
-				 link:able-suffix))
+		    (in-implementation-vicinity "gsubr" link:able-suffix))
 	  (add-link 'array-for-each
-		    (in-vicinity (implementation-vicinity) "ramap"
-				 link:able-suffix))
+		    (in-implementation-vicinity "ramap" link:able-suffix))
 	  )
 	(display* ")")
 	)
@@ -180,21 +178,19 @@
       (begin
 	;; Simple associations -- OK for all modes of dynamic-linking
 	(display* "(")
-	(add-alias 'hobbit (in-vicinity (implementation-vicinity) "hobbit"))
-	(add-alias 'scmhob (in-vicinity (implementation-vicinity) "scmhob"))
-	(add-alias 'regex-case
-		    (in-vicinity (implementation-vicinity) "rgxcase"))
-	(add-alias 'url-filename
-		    (in-vicinity (implementation-vicinity) "urlfile"))
-	(add-source 'disarm (in-vicinity
-			     (implementation-vicinity)
+	(add-alias '2rs 'r2rs)
+	(add-alias '3rs 'r3rs)
+	(add-alias '4rs 'r4rs)
+	(add-alias '5rs 'r5rs)
+	(add-alias 'hobbit (in-implementation-vicinity "hobbit"))
+	(add-alias 'scmhob (in-implementation-vicinity "scmhob"))
+	(add-alias 'regex-case (in-implementation-vicinity "rgxcase"))
+	(add-alias 'url-filename (in-implementation-vicinity "urlfile"))
+	(add-source 'disarm (in-implementation-vicinity
 			     (string-append "disarm" (scheme-file-suffix))))
-	(add-source 'build (in-vicinity
-			    (implementation-vicinity)
-			    (string-append "build" (scheme-file-suffix))))
-
-	;; (add-alias 'impl:callback '(identity))
-
+	(add-source 'build (in-implementation-vicinity "build"))
+	(add-source 'compile (in-implementation-vicinity
+			      (string-append "compile" (scheme-file-suffix))))
 	(display* ")")
 	)
 
@@ -203,7 +199,7 @@
 	(display* "#.(if (defined? renamed-identifier)")
 	(display* "      '(")
 	(display "       " op)
-	(add-source 'macro (in-vicinity (implementation-vicinity) "Macro"))
+	(add-source 'macro (in-implementation-vicinity "Macro"))
 	(display* "        )")
 	(display* "      '())")
 	)