File: level-0.scm

package info (click to toggle)
scsh-0.6 0.6.7-3
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k
  • size: 15,124 kB
  • ctags: 16,788
  • sloc: lisp: 82,839; ansic: 23,112; sh: 3,116; makefile: 829
file content (30 lines) | stat: -rw-r--r-- 1,277 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.


; Redefinitions of some usual Scheme things so as to make the new
; exception system kick in when it needs to.

(define (number? n)
  (or ((structure-ref true-scheme number?) n)
      (extended-number? n)))

;(define (integer? n)
;  (if ((structure-ref true-scheme number?) n)
;      ((structure-ref true-scheme integer?) n)
;      (and (extended-number? n)
;           ... raise exception ...)))

(define (+ x y) ((structure-ref true-scheme +) x y))
(define (* x y) ((structure-ref true-scheme *) x y))
(define (- x y) ((structure-ref true-scheme -) x y))
(define (/ x y) ((structure-ref true-scheme /) x y))
(define (= x y) ((structure-ref true-scheme =) x y))
(define (< x y) ((structure-ref true-scheme <) x y))
(define (make-vector x y) ((structure-ref true-scheme make-vector) x y))
(define (make-string x y) ((structure-ref true-scheme make-string) x y))
(define (apply x y) ((structure-ref true-scheme apply) x y))

(define (read-char x) ((structure-ref true-scheme read-char) x))
(define (peek-char x) ((structure-ref true-scheme peek-char) x))
(define (char-ready? x) ((structure-ref true-scheme char-ready?) x))
(define (write-char x y) ((structure-ref true-scheme write-char) x y))