summaryrefslogtreecommitdiff
path: root/lang
diff options
context:
space:
mode:
authorwiz <wiz>2006-07-13 10:51:19 +0000
committerwiz <wiz>2006-07-13 10:51:19 +0000
commit02fbec7a521c9c549ba7b91abadf54f1441073c0 (patch)
tree08065ce130dbcea7fe761399ac982fa131a3320d /lang
parent67273fa027e0ca443a50272e6dd92d28bf984f0e (diff)
downloadpkgsrc-02fbec7a521c9c549ba7b91abadf54f1441073c0.tar.gz
Not needed in 1.6.8.
Diffstat (limited to 'lang')
-rw-r--r--lang/guile/patches/patch-ak344
1 files changed, 0 insertions, 344 deletions
diff --git a/lang/guile/patches/patch-ak b/lang/guile/patches/patch-ak
deleted file mode 100644
index 0abb642a1cd..00000000000
--- a/lang/guile/patches/patch-ak
+++ /dev/null
@@ -1,344 +0,0 @@
-$NetBSD: patch-ak,v 1.2 2005/10/30 14:55:46 gdt Exp $
-
---- ice-9/slib.scm.orig 2004-08-11 21:04:21.000000000 -0400
-+++ ice-9/slib.scm
-@@ -55,336 +55,6 @@
- require)
- :no-backtrace)
-
--
--
--(define (eval-load <filename> evl)
-- (if (not (file-exists? <filename>))
-- (set! <filename> (string-append <filename> (scheme-file-suffix))))
-- (call-with-input-file <filename>
-- (lambda (port)
-- (let ((old-load-pathname *load-pathname*))
-- (set! *load-pathname* <filename>)
-- (do ((o (read port) (read port)))
-- ((eof-object? o))
-- (evl o))
-- (set! *load-pathname* old-load-pathname)))))
--
--
--
--(define-public slib:exit quit)
--(define-public slib:error error)
--(define-public slib:warn warn)
--(define-public slib:eval (lambda (x) (eval x slib-module)))
--(define defmacro:eval (lambda (x) (eval x (interaction-environment))))
--(define logical:logand logand)
--(define logical:logior logior)
--(define logical:logxor logxor)
--(define logical:lognot lognot)
--(define logical:ash ash)
--(define logical:logcount logcount)
--(define logical:integer-length integer-length)
--(define logical:bit-extract bit-extract)
--(define logical:integer-expt integer-expt)
--(define logical:ipow-by-squaring ipow-by-squaring)
--(define-public slib:eval-load eval-load)
--(define-public slib:tab #\tab)
--(define-public slib:form-feed #\page)
--
--(define slib-module (current-module))
--
--(define (defined? symbol)
-- (module-defined? slib-module symbol))
--
--(define slib:features
-- (append '(source
-- eval
-- abort
-- alist
-- defmacro
-- delay
-- dynamic-wind
-- full-continuation
-- hash
-- hash-table
-- line-i/o
-- logical
-- multiarg/and-
-- multiarg-apply
-- promise
-- rev2-procedures
-- rev4-optional-procedures
-- string-port
-- with-file)
--
-- (if (defined? 'getenv)
-- '(getenv)
-- '())
--
-- (if (defined? 'current-time)
-- '(current-time)
-- '())
--
-- (if (defined? 'system)
-- '(system)
-- '())
--
-- (if (defined? 'char-ready?)
-- '(char-ready?)
-- '())
--
-- (if (and (string->number "0.0") (inexact? (string->number "0.0")))
-- '(inexact)
-- '())
--
-- (if (rational? (string->number "1/19"))
-- '(rational)
-- '())
--
-- (if (real? (string->number "0.0"))
-- '(real)
-- ())
--
-- (if (complex? (string->number "1+i"))
-- '(complex)
-- '())
--
-- (let ((n (string->number "9999999999999999999999999999999")))
-- (if (and n (exact? n))
-- '(bignum)
-- '()))))
--
--
--;; The array module specified by slib 3a1 is not the same as what guile
--;; provides, so we must remove `array' from the features list.
--;;
--;; The main difference is `create-array' which is similar to
--;; `make-uniform-array', but the `Ac64' etc prototype procedures incorporate
--;; an initial fill element into the prototype.
--;;
--;; Believe the array-for-each module will need to be taken from slib when
--;; the array module is taken from there, since what the array module creates
--;; won't be understood by the guile functions. So remove `array-for-each'
--;; from the features list too.
--;;
--;; Also, slib 3a1 array-for-each specifies an `array-map' which is not in
--;; guile (but could be implemented quite easily).
--;;
--;; ENHANCE-ME: It'd be nice to implement what's necessary, since the guile
--;; functions should be more efficient than the implementation in slib.
--;;
--;; FIXME: Since the *features* variable is shared by slib and the guile
--;; core, removing these feature symbols has the unhappy effect of making it
--;; look like they aren't in the core either. Let's assume that arrays have
--;; been present unconditionally long enough that no guile-specific code will
--;; bother to test. An alternative would be to make a new separate
--;; *features* variable which the slib stuff operated on, leaving the core
--;; mechanism alone. That might be a good thing anyway.
--;;
--(set! *features* (delq 'array *features*))
--(set! *features* (delq 'array-for-each *features*))
--
--
--;;; FIXME: Because uers want require to search the path, this uses
--;;; load-from-path, which probably isn't a hot idea. slib
--;;; doesn't expect this function to search a path, so I expect to get
--;;; bug reports at some point complaining that the wrong file gets
--;;; loaded when something accidentally appears in the path before
--;;; slib, etc. ad nauseum. However, the right fix seems to involve
--;;; changing catalog:get in slib/require.scm, and I don't expect
--;;; Aubrey will integrate such a change. So I'm just going to punt
--;;; for the time being.
--(define (slib:load name)
-- (save-module-excursion
-- (lambda ()
-- (set-current-module slib-module)
-- (let ((errinfo (catch 'system-error
-- (lambda ()
-- (load-from-path name)
-- #f)
-- (lambda args args))))
-- (if (and errinfo
-- (catch 'system-error
-- (lambda ()
-- (load-from-path
-- (string-append name ".scm"))
-- #f)
-- (lambda args args)))
-- (apply throw errinfo))))))
--
--(define-public slib:load-source slib:load)
--(define defmacro:load slib:load)
--
--(define slib-parent-dir
-- (let* ((path (%search-load-path "slib/require.scm")))
-- (if path
-- (substring path 0 (- (string-length path) 17))
-- (error "Could not find slib/require.scm in " %load-path))))
--
--(define (implementation-vicinity)
-- (string-append slib-parent-dir "/"))
--(define (library-vicinity)
-- (string-append (implementation-vicinity) "slib/"))
--(define home-vicinity
-- (let ((home-path (getenv "HOME")))
-- (lambda () home-path)))
--(define (scheme-implementation-type) 'guile)
--(define (scheme-implementation-version) "")
--
--;; legacy from r3rs, but slib says all implementations provide these
--;; ("Legacy" section of the "Miscellany" node in the manual)
--(define-public t #t)
--(define-public nil #f)
--
--(define-public (output-port-width . arg) 80)
--(define-public (output-port-height . arg) 24)
--(define (identity x) x)
--
--;; slib 3a1 and up, straight from Template.scm
--(define-public (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))
--
--;; slib (version 3a1) requires open-file accept a symbol r, rb, w or wb for
--;; MODES, so extend the guile core open-file accordingly.
--;;
--;; slib (version 3a1) also calls open-file with strings "rb" or "wb", not
--;; sure if that's intentional, but in any case this extension continues to
--;; accept strings to make that work.
--;;
--(define-public open-file
-- (let ((guile-core-open-file open-file))
-- (lambda (filename modes)
-- (if (symbol? modes)
-- (set! modes (symbol->string modes)))
-- (guile-core-open-file filename modes))))
--
--;; returning #t/#f instead of throwing an error for failure
--(define-public delete-file
-- (let ((guile-core-delete-file delete-file))
-- (lambda (filename)
-- (catch 'system-error
-- (lambda () (guile-core-delete-file filename) #t)
-- (lambda args #f)))))
--
--;; Nothing special to do for this, so straight from Template.scm. Maybe
--;; "sensible-browser" for a debian system would be worth trying too (and
--;; would be good on a tty).
--(define-public (browse-url url)
-- (define (try cmd end) (zero? (system (string-append cmd url end))))
-- (or (try "netscape-remote -remote 'openURL(" ")'")
-- (try "netscape -remote 'openURL(" ")'")
-- (try "netscape '" "'&")
-- (try "netscape '" "'")))
--
--;;; {Random numbers}
--;;;
--(define (make-random-state . args)
-- (let ((seed (if (null? args) *random-state* (car args))))
-- (cond ((string? seed))
-- ((number? seed) (set! seed (number->string seed)))
-- (else (let ()
-- (require 'object->string)
-- (set! seed (object->limited-string seed 50)))))
-- (seed->random-state seed)))
--
--;;; {rev2-procedures}
--;;;
--
--(define <? <)
--(define <=? <=)
--(define =? =)
--(define >? >)
--(define >=? >=)
--
--;;; {system}
--;;;
--
--;; If the program run is killed by a signal, the shell normally gives an
--;; exit code of 128+signum. If the shell itself is killed by a signal then
--;; we do the same 128+signum here.
--;;
--;; "stop-sig" shouldn't arise here, since system shouldn't be calling
--;; waitpid with WUNTRACED, but allow for it anyway, just in case.
--;;
--(if (defined? 'system)
-- (define-public system
-- (let ((guile-core-system system))
-- (lambda (str)
-- (let ((st (guile-core-system str)))
-- (or (status:exit-val st)
-- (+ 128 (or (status:term-sig st)
-- (status:stop-sig st)))))))))
--
--;;; {Time}
--;;;
--
--(define-public difftime -)
--(define-public offset-time +)
--
--
--(define %system-define define)
--
--(define define
-- (procedure->memoizing-macro
-- (lambda (exp env)
-- (if (= (length env) 1)
-- `(define-public ,@(cdr exp))
-- `(%system-define ,@(cdr exp))))))
--
--;;; Hack to make syncase macros work in the slib module
--(if (nested-ref the-root-module '(app modules ice-9 syncase))
-- (set-object-property! (module-local-variable (current-module) 'define)
-- '*sc-expander*
-- '(define)))
--
--(define (software-type)
-- "Return a symbol describing the current platform's operating system.
--This may be one of AIX, VMS, UNIX, COHERENT, WINDOWS, MS-DOS, OS/2,
--THINKC, AMIGA, ATARIST, MACH, or ACORN.
--
--Note that most varieties of Unix are considered to be simply \"UNIX\".
--That is because when a program depends on features that are not present
--on every operating system, it is usually better to test for the presence
--or absence of that specific feature. The return value of
--@code{software-type} should only be used for this purpose when there is
--no other easy or unambiguous way of detecting such features."
-- 'UNIX)
--
--(slib:load (in-vicinity (library-vicinity) "require.scm"))
--
--(define require require:require)
--
--;; {Extensions to the require system so that the user can add new
--;; require modules easily.}
--
--(define *vicinity-table*
-- (list
-- (cons 'implementation (implementation-vicinity))
-- (cons 'library (library-vicinity))))
--
--(define (install-require-vicinity name vicinity)
-- (let ((entry (assq name *vicinity-table*)))
-- (if entry
-- (set-cdr! entry vicinity)
-- (set! *vicinity-table*
-- (acons name vicinity *vicinity-table*)))))
--
--(define (install-require-module name vicinity-name file-name)
-- (if (not *catalog*) ;Fix which loads catalog in slib
-- (catalog:get 'random)) ;(doesn't load the feature 'random)
-- (let ((entry (assq name *catalog*))
-- (vicinity (cdr (assq vicinity-name *vicinity-table*))))
-- (let ((path-name (in-vicinity vicinity file-name)))
-- (if entry
-- (set-cdr! entry path-name)
-- (set! *catalog*
-- (acons name path-name *catalog*))))))
--
--(define (make-exchanger obj)
-- (lambda (rep) (let ((old obj)) (set! obj rep) old)))
-+;; Load slib's init routine.
-+(load (string-append (assoc-ref %guile-build-info 'pkgdatadir)
-+ "/slib/guile.init"))