From deda2c0fd8689349fea2a900199a76ff7ecb319e Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:26 -0800 Subject: Import Upstream version 5d6 --- mkimpcat.scm | 162 +++++++++++++++++++++++++++++------------------------------ 1 file changed, 79 insertions(+), 83 deletions(-) (limited to 'mkimpcat.scm') 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* " '())") ) -- cgit v1.2.3