[bpt/guile.git] / ice-9 / safe-r5rs.scm

;;;; 	Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc.
;;;; 
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2.1 of the License, or (at your option) any later version.
;;;; 
;;;; This library 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
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;; 
\f
;;;; Safe subset of R5RS bindings

(define-module (ice-9 safe-r5rs)
  :re-export (eqv? eq? equal?
	      number?	complex? real? rational? integer?
	      exact? inexact?
	      = < > <= >=
	      zero? positive?	negative? odd? even?
	      max min
	      + * - /
	      abs
	      quotient remainder modulo
	      gcd lcm
	      numerator denominator
	      rationalize
	      floor ceiling truncate round
	      exp log sin cos tan asin acos atan
	      sqrt
	      expt
	      make-rectangular make-polar real-part imag-part magnitude angle
	      exact->inexact inexact->exact
	      
	      number->string string->number
	   
	      boolean?
	      not
	   
	      pair?
	      cons car cdr
	      set-car! set-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
	      null?
	      list?
	      list
	      length
	      append
	      reverse
	      list-tail list-ref
	      memq memv member
	      assq assv assoc
	   
	      symbol?
	      symbol->string string->symbol
	   
	      char?
	      char=? char<? char>? char<=? char>=?
	      char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=?
	      char-alphabetic? char-numeric? char-whitespace?
	      char-upper-case? char-lower-case?
	      char->integer integer->char
	      char-upcase
	      char-downcase
	   
	      string?
	      make-string
	      string
	      string-length
	      string-ref string-set!
	      string=? string-ci=?
	      string<? string>? string<=? string>=?
	      string-ci<? string-ci>? string-ci<=? string-ci>=?
	      substring
	      string-length
	      string-append
	      string->list list->string
	      string-copy string-fill!
	   
	      vector?
	      make-vector
	      vector
	      vector-length
	      vector-ref vector-set!
	      vector->list list->vector
	      vector-fill!
	   
	      procedure?
	      apply
	      map
	      for-each
	      force
	   
	      call-with-current-continuation
	   
	      values
	      call-with-values
	      dynamic-wind
	   
	      eval

	      input-port? output-port?
	      current-input-port current-output-port
	   
	      read
	      read-char
	      peek-char
	      eof-object?
	      char-ready?
	   
	      write
	      display
	      newline
	      write-char

	      ;;transcript-on
	      ;;transcript-off
	      )

  :export (null-environment))

(define null-interface (resolve-interface '(ice-9 null)))

(module-use! %module-public-interface null-interface)

(define (null-environment n)
  (if (not (= n 5))
      (scm-error 'misc-error 'null-environment
		 "~A is not a valid version"
		 (list n)
		 '()))
  ;; Note that we need to create a *fresh* interface
  (let ((interface (make-module 31)))
    (set-module-kind! interface 'interface)
    (module-use! interface null-interface)
    interface))
Commit	Line	Data
72b4bea4	1	;;;; Copyright (C) 2000, 2001, 2004 Free Software Foundation, Inc.
affb914f	2	;;;;
73be1d9e MV	3	;;;; This library is free software; you can redistribute it and/or
	4	;;;; modify it under the terms of the GNU Lesser General Public
	5	;;;; License as published by the Free Software Foundation; either
	6	;;;; version 2.1 of the License, or (at your option) any later version.
affb914f	7	;;;;
73be1d9e	8	;;;; This library is distributed in the hope that it will be useful,
affb914f	9	;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
73be1d9e MV	10	;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
73be1d9e MV	11	;;;; Lesser General Public License for more details.
affb914f	12	;;;;
73be1d9e MV	13	;;;; You should have received a copy of the GNU Lesser General Public
73be1d9e MV	14	;;;; License along with this library; if not, write to the Free Software
92205699	15	;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
affb914f MD	16	;;;;
	17	\f
	18	;;;; Safe subset of R5RS bindings
	19
1a179b03 MD	20	(define-module (ice-9 safe-r5rs)
	21	:re-export (eqv? eq? equal?
	22	number? complex? real? rational? integer?
	23	exact? inexact?
	24	= < > <= >=
	25	zero? positive? negative? odd? even?
	26	max min
	27	+ * - /
	28	abs
	29	quotient remainder modulo
	30	gcd lcm
72b4bea4 KR	31	numerator denominator
72b4bea4 KR	32	rationalize
1a179b03 MD	33	floor ceiling truncate round
	34	exp log sin cos tan asin acos atan
	35	sqrt
	36	expt
	37	make-rectangular make-polar real-part imag-part magnitude angle
	38	exact->inexact inexact->exact
	39
	40	number->string string->number
e9965e8f	41
1a179b03 MD	42	boolean?
1a179b03 MD	43	not
e9965e8f	44
1a179b03 MD	45	pair?
	46	cons car cdr
	47	set-car! set-cdr!
	48	caar cadr cdar cddr
	49	caaar caadr cadar caddr cdaar cdadr cddar cdddr
	50	caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
	51	cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr
	52	null?
	53	list?
	54	list
	55	length
	56	append
	57	reverse
	58	list-tail list-ref
	59	memq memv member
	60	assq assv assoc
e9965e8f	61
1a179b03 MD	62	symbol?
1a179b03 MD	63	symbol->string string->symbol
e9965e8f	64
1a179b03 MD	65	char?
	66	char=? char<? char>? char<=? char>=?
	67	char-ci=? char-ci<? char-ci>? char-ci<=? char-ci>=?
	68	char-alphabetic? char-numeric? char-whitespace?
	69	char-upper-case? char-lower-case?
	70	char->integer integer->char
	71	char-upcase
	72	char-downcase
e9965e8f	73
1a179b03 MD	74	string?
	75	make-string
	76	string
	77	string-length
	78	string-ref string-set!
	79	string=? string-ci=?
	80	string<? string>? string<=? string>=?
	81	string-ci<? string-ci>? string-ci<=? string-ci>=?
	82	substring
	83	string-length
	84	string-append
	85	string->list list->string
	86	string-copy string-fill!
e9965e8f	87
1a179b03 MD	88	vector?
	89	make-vector
	90	vector
	91	vector-length
	92	vector-ref vector-set!
	93	vector->list list->vector
	94	vector-fill!
e9965e8f	95
1a179b03 MD	96	procedure?
	97	apply
	98	map
	99	for-each
	100	force
e9965e8f	101
1a179b03	102	call-with-current-continuation
e9965e8f	103
1a179b03 MD	104	values
	105	call-with-values
	106	dynamic-wind
e9965e8f	107
1a179b03	108	eval
e9965e8f	109
1a179b03 MD	110	input-port? output-port?
1a179b03 MD	111	current-input-port current-output-port
e9965e8f	112
1a179b03 MD	113	read
	114	read-char
	115	peek-char
	116	eof-object?
	117	char-ready?
e9965e8f	118
1a179b03 MD	119	write
	120	display
	121	newline
	122	write-char
	123
	124	;;transcript-on
	125	;;transcript-off
	126	)
e9965e8f	127
1a179b03	128	:export (null-environment))
e9965e8f	129
1a179b03 MD	130	(define null-interface (resolve-interface '(ice-9 null)))
	131
	132	(module-use! %module-public-interface null-interface)
affb914f	133
affb914f MD	134	(define (null-environment n)
	135	(if (not (= n 5))
	136	(scm-error 'misc-error 'null-environment
	137	"~A is not a valid version"
	138	(list n)
	139	'()))
c7c6b0cb MD	140	;; Note that we need to create a fresh interface
	141	(let ((interface (make-module 31)))
	142	(set-module-kind! interface 'interface)
	143	(module-use! interface null-interface)
	144	interface))