ice-9/slib.scm

   1 ;;; installed-scm-file
   2 (define-module #/ice-9/slib)
   3
   4 \f
   5
   6 (define (eval-load <filename> evl)
   7   (if (not (file-exists? <filename>))
   8       (set! <filename> (string-append <filename> (scheme-file-suffix))))
   9   (call-with-input-file <filename>
  10     (lambda (port)
  11       (let ((old-load-pathname *load-pathname*))
  12         (set! *load-pathname* <filename>)
  13         (do ((o (read port #t read-sharp) (read port #t read-sharp)))
  14             ((eof-object? o))
  15           (evl o))
  16         (set! *load-pathname* old-load-pathname)))))
  17
  18 \f
  19
  20 (define slib:exit quit)
  21 (define slib:error error)
  22 (define slib:eval eval)
  23 (define defmacro:eval eval)
  24 (define logical:logand logand)
  25 (define logical:logior logior)
  26 (define logical:logxor logxor)
  27 (define logical:lognot lognot)
  28 (define logical:ash ash)
  29 (define logical:logcount logcount)
  30 (define logical:integer-length integer-length)
  31 (define logical:bit-extract bit-extract)
  32 (define logical:integer-expt integer-expt)
  33 (define logical:ipow-by-squaring ipow-by-squaring)
  34 (define slib:eval-load eval-load)
  35 (define slib:tab #\tab)
  36 (define slib:form-feed #\page)
  37
  38 (define slib:features
  39   (append '(source
  40             eval
  41             abort
  42             alist
  43             defmacro
  44             delay
  45             dynamic-wind
  46             full-continuation
  47             hash
  48             hash-table
  49             line-i/o
  50             logical
  51             multiarg/and-
  52             multiarg-apply
  53             promise
  54             rev2-procedures
  55             rev4-optional-procedures
  56             string-port
  57             with-file)
  58
  59           (if (defined? getenv)
  60               '(getenv)
  61               '())
  62
  63           (if (defined? current-time)
  64               '(current-time)
  65               '())
  66
  67           (if (defined? system)
  68               '(system)
  69               '())
  70
  71           (if (defined? array?)
  72               '(array)
  73               '())
  74
  75           (if (defined? char-ready?)
  76               '(char-ready?)
  77               '())
  78
  79           (if (defined? array-for-each)
  80               '(array-for-each)
  81               '())
  82
  83           (if (and (string->number "0.0") (inexact? (string->number "0.0")))
  84               '(inexact)
  85               '())
  86
  87           (if (rational? (string->number "1/19"))
  88               '(rational)
  89               '())
  90
  91           (if (real? (string->number "0.0"))
  92               '(real)
  93               ())
  94
  95           (if (complex? (string->number "1+i"))
  96               '(complex)
  97               '())
  98
  99           (let ((n (string->number "9999999999999999999999999999999")))
 100             (if (and n (exact? n))
 101                 '(bignum)
 102                 '()))))
 103
 104
 105 (define slib-module (current-module))
 106
 107 (define (slib:load name)
 108   (save-module-excursion
 109    (lambda ()
 110      (set-current-module slib-module)
 111      (load name))))
 112
 113 (define slib:load-source slib:load)
 114 (define defmacro:load slib:load)
 115
 116 (define (library-vicinity) (string-append (implementation-vicinity) "slib/"))
 117 (define (scheme-implementation-type) 'guile)
 118 (define (scheme-implementation-version) "")
 119
 120 (define (output-port-width . arg) 80)
 121 (define (output-port-height . arg) 24)
 122
 123
 124 ;;; {Time}
 125 ;;;
 126
 127 (define difftime -)
 128 (define offset-time +)
 129
 130 \f
 131 (define %system-define define)
 132
 133 (define define
 134   (procedure->memoizing-macro
 135    (lambda (exp env)
 136      (if (= (length env) 1)
 137          `(define-public ,@(cdr exp))
 138          `(%system-define ,@(cdr exp))))))
 139
 140 (define (software-type) 'UNIX)
 141
 142 (slib:load "require.scm")
 143
 144 (define-public require require:require)