share/guile/1.6.0/ice-9/safe-r5rs.scm

   1 ;;;;    Copyright (C) 2000, 2001 Free Software Foundation, Inc.
   2 ;;;;
   3 ;;;; This program is free software; you can redistribute it and/or modify
   4 ;;;; it under the terms of the GNU General Public License as published by
   5 ;;;; the Free Software Foundation; either version 2, or (at your option)
   6 ;;;; any later version.
   7 ;;;;
   8 ;;;; This program is distributed in the hope that it will be useful,
   9 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 ;;;; GNU General Public License for more details.
  12 ;;;;
  13 ;;;; You should have received a copy of the GNU General Public License
  14 ;;;; along with this software; see the file COPYING.  If not, write to
  15 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  16 ;;;; Boston, MA 02111-1307 USA
  17 ;;;;
  18 ;;;; As a special exception, the Free Software Foundation gives permission
  19 ;;;; for additional uses of the text contained in its release of GUILE.
  20 ;;;;
  21 ;;;; The exception is that, if you link the GUILE library with other files
  22 ;;;; to produce an executable, this does not by itself cause the
  23 ;;;; resulting executable to be covered by the GNU General Public License.
  24 ;;;; Your use of that executable is in no way restricted on account of
  25 ;;;; linking the GUILE library code into it.
  26 ;;;;
  27 ;;;; This exception does not however invalidate any other reasons why
  28 ;;;; the executable file might be covered by the GNU General Public License.
  29 ;;;;
  30 ;;;; This exception applies only to the code released by the
  31 ;;;; Free Software Foundation under the name GUILE.  If you copy
  32 ;;;; code from other Free Software Foundation releases into a copy of
  33 ;;;; GUILE, as the General Public License permits, the exception does
  34 ;;;; not apply to the code that you add in this way.  To avoid misleading
  35 ;;;; anyone as to the status of such modified files, you must delete
  36 ;;;; this exception notice from them.
  37 ;;;;
  38 ;;;; If you write modifications of your own for GUILE, it is your choice
  39 ;;;; whether to permit this exception to apply to your modifications.
  40 ;;;; If you do not wish that, delete this exception notice.
  41 ;;;;
  42 \f
  43 ;;;; Safe subset of R5RS bindings
  44
  45 (define-module (ice-9 safe-r5rs)
  46   :re-export (eqv? eq? equal?
  47               number?   complex? real? rational? integer?
  48               exact? inexact?
  49               = < > <= >=
  50               zero? positive?   negative? odd? even?
  51               max min
  52               + * - /
  53               abs
  54               quotient remainder modulo
  55               gcd lcm
  56               ;;numerator denominator XXX
  57               ;;rationalize           XXX
  58               floor ceiling truncate round
  59               exp log sin cos tan asin acos atan
  60               sqrt
  61               expt
  62               make-rectangular make-polar real-part imag-part magnitude angle
  63               exact->inexact inexact->exact
  64
  65               number->string string->number
  66
  67               boolean?
  68               not
  69
  70               pair?
  71               cons car cdr
  72               set-car! set-cdr!
  73               caar cadr cdar cddr
  74               caaar caadr cadar caddr cdaar cdadr cddar cdddr
  75               caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
  76               cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
  77               null?
  78               list?
  79               list
  80               length
  81               append
  82               reverse
  83               list-tail list-ref
  84               memq memv member
  85               assq assv assoc
  86
  87               symbol?
  88               symbol->string string->symbol
  89
  90               char?
  91               char=? char<? char>? char<=? char>=?
  92               char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=?
  93               char-alphabetic? char-numeric? char-whitespace?
  94               char-upper-case? char-lower-case?
  95               char->integer integer->char
  96               char-upcase
  97               char-downcase
  98
  99               string?
 100               make-string
 101               string
 102               string-length
 103               string-ref string-set!
 104               string=? string-ci=?
 105               string<? string>? string<=? string>=?
 106               string-ci<? string-ci>? string-ci<=? string-ci>=?
 107               substring
 108               string-length
 109               string-append
 110               string->list list->string
 111               string-copy string-fill!
 112
 113               vector?
 114               make-vector
 115               vector
 116               vector-length
 117               vector-ref vector-set!
 118               vector->list list->vector
 119               vector-fill!
 120
 121               procedure?
 122               apply
 123               map
 124               for-each
 125               force
 126
 127               call-with-current-continuation
 128
 129               values
 130               call-with-values
 131               dynamic-wind
 132
 133               eval
 134
 135               input-port? output-port?
 136               current-input-port current-output-port
 137
 138               read
 139               read-char
 140               peek-char
 141               eof-object?
 142               char-ready?
 143
 144               write
 145               display
 146               newline
 147               write-char
 148
 149               ;;transcript-on
 150               ;;transcript-off
 151               )
 152
 153   :export (null-environment))
 154
 155 (define null-interface (resolve-interface '(ice-9 null)))
 156
 157 (module-use! %module-public-interface null-interface)
 158
 159 (define (null-environment n)
 160   (if (not (= n 5))
 161       (scm-error 'misc-error 'null-environment
 162                  "~A is not a valid version"
 163                  (list n)
 164                  '()))
 165   ;; Note that we need to create a *fresh* interface
 166   (let ((interface (make-module 31)))
 167     (set-module-kind! interface 'interface)
 168     (module-use! interface null-interface)
 169     interface))