level-0.scm 1.3 KB

123456789101112131415161718192021222324252627282930313233
  1. ; Part of Scheme 48 1.9. See file COPYING for notices and license.
  2. ; Authors: Richard Kelsey, Jonathan Rees
  3. ; Redefinitions of some usual Scheme things so as to make the new
  4. ; exception system kick in when it needs to.
  5. (define (number? n)
  6. (or ((structure-ref true-scheme number?) n)
  7. (extended-number? n)))
  8. ;(define (integer? n)
  9. ; (if ((structure-ref true-scheme number?) n)
  10. ; ((structure-ref true-scheme integer?) n)
  11. ; (and (extended-number? n)
  12. ; ... raise exception ...)))
  13. (define (+ x y) ((structure-ref true-scheme +) x y))
  14. (define (* x y) ((structure-ref true-scheme *) x y))
  15. (define (- x y) ((structure-ref true-scheme -) x y))
  16. (define (/ x y) ((structure-ref true-scheme /) x y))
  17. (define (= x y) ((structure-ref true-scheme =) x y))
  18. (define (< x y) ((structure-ref true-scheme <) x y))
  19. (define (make-vector x y) ((structure-ref true-scheme make-vector) x y))
  20. (define (make-string x y) ((structure-ref true-scheme make-string) x y))
  21. (define (apply x y) ((structure-ref true-scheme apply) x y))
  22. (define (read-char x) ((structure-ref true-scheme read-char) x))
  23. (define (peek-char x) ((structure-ref true-scheme peek-char) x))
  24. (define (char-ready? x) ((structure-ref true-scheme char-ready?) x))
  25. (define (write-char x y) ((structure-ref true-scheme write-char) x y))