env.stk 10.5 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
;;;;
;;;; env.stk				-- R5RS environments
;;;; 
;;;; Copyright © 2006 Erick Gallesio - I3S-CNRS/ESSI <eg@essi.fr>
;;;; 
;;;; 
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;; 
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, 
;;;; USA.
;;;; 
;;;;           Author: Erick Gallesio [eg@essi.fr]
;;;;    Creation date: 29-Nov-2006 22:33 (eg)
24
;;;; Last file update: 19-Dec-2006 12:13 (eg)
25 26 27 28 29 30 31 32 33 34
;;;;


;;=============================================================================
;; 	interaction-environment ...			
;;=============================================================================
#|
<doc interaction-environment
 * (interaction-environment)
 *
35 36
 * This procedure returns the environment in the expression are
 * evaluated by default (the ,(stklos) module).
37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56
doc>
|#
(define (interaction-environment)
  (find-module 'STklos))  


;;=============================================================================
;; 	null-environment ...			
;;=============================================================================
(define-module NULL-MODULE)		;; The module for null-environment

; Patch the import-list to nil => This module will not implicitly
; import STklos
(%module-imports-set! (find-module 'NULL-MODULE) '())

#|
<doc null-environment
 * (null-environment)
 * (null-environment version)
 *
57 58 59 60 61 62
 * Returns a specifier for an environment that is empty except for
 * the (syntactic) bindings for all syntactic keywords defined in
 * the R5RS report.
 * £
 * ,(bold "Note"): In STklos, |null-environment| function can be called
 * without the version number (defaults to 5).
63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309
doc>
|#
(define (null-environment :optional (version 5))
  (unless (eq? version 5)
    (error "this version is not supported ~S" version))
  (find-module 'NULL-MODULE))

;;=============================================================================
;; 	scheme-report-environment ...			
;;=============================================================================
(define-module R5RS
  (import SCHEME)
  
  (define * *)
  (define + +)
  (define - -)
  (define / /)
  (define < <)
  (define <= <=)
  (define = =)
  (define > >)
  (define >= >=)
  (define abs abs)
  (define acos acos)
  (define append append)
  (define apply apply)
  (define asin asin)
  (define assoc assoc)
  (define assq assq)
  (define assv assv)
  (define atan atan)
  (define boolean? boolean?)
  (define caar caar)
  (define cadr cadr)
  (define call-with-current-continuation call-with-current-continuation)
  (define call-with-input-file call-with-input-file)
  (define call-with-output-file call-with-output-file)
  (define call-with-values call-with-values)
  (define call/cc call/cc)
  (define car car)
  (define cdr cdr)
  (define caar caar)
  (define cadr cadr)
  (define cdar cdar)
  (define cddr cddr)
  (define caaar caaar)
  (define caadr caadr)
  (define cadar cadar)
  (define caddr caddr)
  (define cdaar cdaar)
  (define cdadr cdadr)
  (define cddar cddar)
  (define cdddr cdddr)
  (define caaaar caaaar)
  (define caaadr caaadr)
  (define caadar caadar)
  (define caaddr caaddr)
  (define cadaar cadaar)
  (define cadadr cadadr)
  (define caddar caddar)
  (define cadddr cadddr)
  (define cdaaar cdaaar)
  (define cdaadr cdaadr)
  (define cdadar cdadar)
  (define cdaddr cdaddr)
  (define cddaar cddaar)
  (define cddadr cddadr)
  (define cdddar cdddar)
  (define cddddr cddddr)
  (define ceiling ceiling)
  (define char->integer char->integer)
  (define char-alphabetic? char-alphabetic?)
  (define char-ci<=? char-ci<=?)
  (define char-ci<? char-ci<?)
  (define char-ci=? char-ci=?)
  (define char-ci>=? char-ci>=?)
  (define char-ci>? char-ci>?)
  (define char-downcase char-downcase)
  (define char-lower-case? char-lower-case?)
  (define char-numeric? char-numeric?)
  (define char-ready? char-ready?)
  (define char-upcase char-upcase)
  (define char-upper-case? char-upper-case?)
  (define char-whitespace? char-whitespace?)
  (define char<=? char<=?)
  (define char<? char<?)
  (define char=? char=?)
  (define char>=? char>=?)
  (define char>? char>?)
  (define char? char?)
  (define close-input-port close-input-port)
  (define close-output-port close-output-port)
  (define complex? complex?)
  (define cons cons)
  (define cos cos)
  (define current-input-port current-input-port)
  (define current-output-port current-output-port)
  (define denominator denominator)
  (define display display)
  (define dynamic-wind dynamic-wind)
  (define eof-object? eof-object?)
  (define eq? eq?)
  (define equal? equal?)
  (define eqv? eqv?)
  (define error error)
  (define even? even?)
  (define exact->inexact exact->inexact)
  (define exact? exact?)
  (define exp exp)
  (define expt expt)
  (define floor floor)
  (define for-each for-each)
  (define force force)
  (define gcd gcd)
  (define imag-part imag-part)
  (define inexact->exact inexact->exact)
  (define inexact? inexact?)
  (define input-port? input-port?)
  (define integer->char integer->char)
  (define integer? integer?)
  (define lcm lcm)
  (define length length)
  (define list list)
  (define list->string list->string)
  (define list->vector list->vector)
  (define list-ref list-ref)
  (define list-tail list-tail)
  (define list? list?)
  (define load load)
  (define log log)
  (define magnitude magnitude)
  (define make-polar make-polar)
  (define make-rectangular make-rectangular)
  (define make-string make-string)
  (define make-vector make-vector)
  (define map map)
  (define max max)
  (define member member)
  (define memq memq)
  (define memv memv)
  (define min min)
  (define modulo modulo)
  (define negative? negative?)
  (define newline newline)
  (define not not)
  (define null? null?)
  (define number->string number->string)
  (define number? number?)
  (define numerator numerator)
  (define odd? odd?)
  (define open-input-file open-input-file)
  (define open-output-file open-output-file)
  (define output-port? output-port?)
  (define pair? pair?)
  (define peek-char peek-char)
  (define positive? positive?)
  (define procedure? procedure?)
  (define quotient quotient)
  (define rational? rational?)
  (define rationalize rationalize)
  (define read read)
  (define read-char read-char)
  (define real-part real-part)
  (define real? real?)
  (define remainder remainder)
  (define reverse reverse)
  (define round round)
  (define set-car! set-car!)
  (define set-cdr! set-cdr!)
  (define sin sin)
  (define sqrt sqrt)
  (define string string)
  (define string->list string->list)
  (define string->number string->number)
  (define string->symbol string->symbol)
  (define string-append string-append)
  (define string-ci<=? string-ci<=?)
  (define string-ci<? string-ci<?)
  (define string-ci=? string-ci=?)
  (define string-ci>=? string-ci>=?)
  (define string-ci>? string-ci>?)
  (define string-copy string-copy)
  (define string-fill! string-fill!)
  (define string-length string-length)
  (define string-ref string-ref)
  (define string-set! string-set!)
  (define string<=? string<=?)
  (define string<? string<?)
  (define string=? string=?)
  (define string>=? string>=?)
  (define string>? string>?)
  (define string? string?)
  (define substring substring)
  (define symbol->string symbol->string)
  (define symbol? symbol?)
  (define tan tan)
  (define truncate truncate)
  (define values values)
  (define vector vector)
  (define vector->list vector->list)
  (define vector-fill! vector-fill!)
  (define vector-length vector-length)
  (define vector-ref vector-ref)
  (define vector-set! vector-set!)
  (define vector? vector?)
  (define with-input-from-file with-input-from-file)
  (define with-output-to-file with-output-to-file)
  (define write write)
  (define write-char write-char)
  (define zero? zero?)

  (export * + - / < <= = > >= abs acos append apply asin assoc
	  assq assv atan boolean? caar cadr call-with-current-continuation
	  call-with-input-file call-with-output-file call-with-values
	  call/cc car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar
	  cdadr cddar cdddr caaaar caaadr caadar caaddr cadaar cadadr
	  caddar cadddr cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar
	  cddddr ceiling char->integer char-alphabetic? char-ci<=?
	  char-ci<? char-ci=? char-ci>=? char-ci>? char-downcase
	  char-lower-case? char-numeric? char-ready? char-upcase
	  char-upper-case? char-whitespace? char<=? char<? char=? char>=?
	  char>? char? close-input-port close-output-port complex? cons cos
	  current-input-port current-output-port denominator display
	  dynamic-wind eof-object? eq? equal? eqv? error even?
	  exact->inexact exact? exp expt floor for-each force gcd imag-part
	  inexact->exact inexact? input-port? integer->char integer? lcm
	  length list list->string list->vector list-ref list-tail list?
	  load log magnitude make-polar make-rectangular make-string
	  make-vector map max member memq memv min modulo negative? newline
	  not null? number->string number? numerator odd? open-input-file
	  open-output-file output-port? pair? peek-char positive?
	  procedure? quotient rational? rationalize read read-char
	  real-part real? remainder reverse round set-car! set-cdr! sin
	  sqrt string string->list string->number string->symbol
	  string-append string-ci<=? string-ci<? string-ci=? string-ci>=?
	  string-ci>? string-copy string-fill! string-length string-ref
	  string-set! string<=? string<? string=? string>=? string>?
	  string? substring symbol->string symbol? tan truncate values
	  vector vector->list vector-fill! vector-length vector-ref
	  vector-set! vector? with-input-from-file with-output-to-file
	  write write-char zero?))

#|
<doc scheme-report-environment
 * (scheme-report-environment)
 * (scheme-report-environment version)
 *
310 311 312 313 314
 * Returns a specifier for an environment that contains the bindings defined
 * in the R5RS report.
 * £
 * ,(bold "Note"): In STklos, |scheme-report-environment| function can be called
 * without the version number (defaults to 5).
315 316 317 318 319 320 321 322 323
doc>
|#
(define (scheme-report-environment :optional (version 5))
  (unless (eq? version 5)
    (error "this version is not supported ~S" version))
  (find-module 'R5RS))


(provide "env")