; -*- Mode: Lisp; Syntax: Common-Lisp; Package: REVISED^4-SCHEME; -*-

; This file was generated by Pseudoscheme 2.13
;  running in CMU Common Lisp 16-Aug-1993

(ps:in-package "REVISED^4-SCHEME")
(BEGIN-TRANSLATED-FILE)
(DEFUN .< (&REST SCHEME::X) (TRUE? (APPLY #'< SCHEME::X)))
(DEFUN .<= (&REST SCHEME::X) (TRUE? (APPLY #'<= SCHEME::X)))
(DEFUN .= (&REST SCHEME::X) (TRUE? (APPLY #'= SCHEME::X)))
(DEFUN .> (&REST SCHEME::X) (TRUE? (APPLY #'> SCHEME::X)))
(DEFUN .>= (&REST SCHEME::X) (TRUE? (APPLY #'>= SCHEME::X)))
(DEFUN BOOLEAN? (SCHEME::X) (TRUE? (BOOLEANP SCHEME::X)))
(DEFUN CALL-WITH-CURRENT-CONTINUATION (SCHEME::PROC)
  (BLOCK SCHEME::CONTINUATION
    (FUNCALL SCHEME::PROC
             #'(LAMBDA (&REST SCHEME::VALS)
                 (RETURN-FROM SCHEME::CONTINUATION
                   (VALUES-LIST SCHEME::VALS))))))
(DEFUN CHAR-READY? (&REST SCHEME::X) (TRUE? (APPLY #'LISTEN SCHEME::X)))
(DEFUN COMPLEX? (SCHEME::X) (TRUE? (NUMBERP SCHEME::X)))
(DEFUN CURRENT-INPUT-PORT () *STANDARD-INPUT*)
(DEFUN CURRENT-OUTPUT-PORT () *STANDARD-OUTPUT*)
(DEFUN EOF-OBJECT? (SCHEME::OBJ) (TRUE? (EQ SCHEME::OBJ EOF-OBJECT)))
(DEFUN EQ? (SCHEME::X SCHEME::Y) (TRUE? (EQ SCHEME::X SCHEME::Y)))
(DEFUN EQV? (SCHEME::X SCHEME::Y) (TRUE? (EQL SCHEME::X SCHEME::Y)))
(DEFUN EXACT? (SCHEME::X) (TRUE? (RATIONALP SCHEME::X)))
(DEFUN INEXACT? (SCHEME::X) (TRUE? (FLOATP SCHEME::X)))
(DEFUN INPUT-PORT? (SCHEME::X) (TRUE? (INPUT-PORT-P SCHEME::X)))
(DEFUN INTEGER? (SCHEME::X) (TRUE? (INTEGERP SCHEME::X)))
(DEFUN MAKE-POLAR (SCHEME::R SCHEME::TH) (* SCHEME::R (CIS SCHEME::TH)))
(DEFUN NULL? (SCHEME::X) (TRUE? (NULL SCHEME::X)))
(DEFUN NUMBER? (SCHEME::X) (TRUE? (NUMBERP SCHEME::X)))
(DEFUN OPEN-INPUT-FILE (SCHEME::STRING)
  (OPEN (MERGE-PATHNAMES SCHEME::STRING) :DIRECTION :INPUT))
(DEFUN OPEN-OUTPUT-FILE (SCHEME::STRING)
  (OPEN (MERGE-PATHNAMES SCHEME::STRING) :DIRECTION :OUTPUT))
(DEFUN OUTPUT-PORT? (SCHEME::X) (TRUE? (OUTPUT-PORT-P SCHEME::X)))
(DEFUN PAIR? (SCHEME::X) (TRUE? (CONSP SCHEME::X)))
(DEFUN PROCEDURE? (SCHEME::X) (TRUE? (PROCEDUREP SCHEME::X)))
(DEFUN QUOTIENT (SCHEME::N1 SCHEME::N2)
  (VALUES (TRUNCATE SCHEME::N1 SCHEME::N2)))
(DEFUN RATIONAL? (SCHEME::X) (TRUE? (RATIONALP SCHEME::X)))
(DEFUN REAL? (SCHEME::X) (TRUE? (REALP SCHEME::X)))
(DEFUN SET-CAR! (SCHEME::PAIR SCHEME::OBJ)
  (SETF (CAR SCHEME::PAIR) SCHEME::OBJ)
  UNSPECIFIC)
(DEFUN SET-CDR! (SCHEME::PAIR SCHEME::OBJ)
  (SETF (CDR SCHEME::PAIR) SCHEME::OBJ)
  UNSPECIFIC)
(DEFUN STRING->SYMBOL (SCHEME::STRING)
  (VALUES (INTERN SCHEME::STRING SCHEME-PACKAGE)))
(DEFUN STRING-LENGTH (SCHEME::S) (LENGTH (THE SIMPLE-STRING SCHEME::S)))
(DEFUN STRING-REF (SCHEME::S SCHEME::K)
  (CHAR (THE SIMPLE-STRING SCHEME::S) SCHEME::K))
(DEFUN STRING-SET! (SCHEME::S SCHEME::K SCHEME::OBJ)
  (SETF (CHAR (THE SIMPLE-STRING SCHEME::S) SCHEME::K) SCHEME::OBJ)
  UNSPECIFIC)
(DEFUN STRING? (SCHEME::X) (TRUE? (SIMPLE-STRING-P SCHEME::X)))
(DEFUN SYMBOL? (SCHEME::X) (TRUE? (SCHEME-SYMBOL-P SCHEME::X)))
(DEFUN TRANSCRIPT-ON (SCHEME::FILESPEC) (DRIBBLE SCHEME::FILESPEC) UNSPECIFIC)
(DEFUN TRANSCRIPT-OFF () (DRIBBLE) UNSPECIFIC)
(DEFUN VECTOR-LENGTH (SCHEME::VEC) (LENGTH (THE SIMPLE-VECTOR SCHEME::VEC)))
(DEFUN VECTOR-SET! (SCHEME::VEC SCHEME::K SCHEME::OBJ)
  (SETF (SVREF SCHEME::VEC SCHEME::K) SCHEME::OBJ)
  UNSPECIFIC)
(DEFUN .ASSOC (SCHEME::OBJ SCHEME::LIST)
  (TRUE? (ASSOC SCHEME::OBJ SCHEME::LIST :TEST #'SCHEME-EQUAL-P)))
(DEFUN ASSQ (SCHEME::OBJ SCHEME::LIST)
  (TRUE? (ASSOC SCHEME::OBJ SCHEME::LIST :TEST #'EQ)))
(DEFUN ASSV (SCHEME::X SCHEME::Y) (TRUE? (ASSOC SCHEME::X SCHEME::Y)))
(DEFUN CALL-WITH-INPUT-FILE (SCHEME::STRING SCHEME::PROC)
  (WITH-OPEN-FILE
      (SCHEME::PORT (MERGE-PATHNAMES SCHEME::STRING) :DIRECTION :INPUT)
    (FUNCALL SCHEME::PROC SCHEME::PORT)))
(DEFUN CALL-WITH-OUTPUT-FILE (SCHEME::STRING SCHEME::PROC)
  (WITH-OPEN-FILE
      (SCHEME::PORT (MERGE-PATHNAMES SCHEME::STRING) :DIRECTION :OUTPUT
       :IF-EXISTS :NEW-VERSION)
    (FUNCALL SCHEME::PROC SCHEME::PORT)))
(DEFUN CHAR-ALPHABETIC? (SCHEME::X) (TRUE? (ALPHA-CHAR-P SCHEME::X)))
(DEFUN CHAR-CI<=? (&REST SCHEME::X)
  (TRUE? (APPLY #'CHAR-NOT-GREATERP SCHEME::X)))
(DEFUN CHAR-CI<? (&REST SCHEME::X) (TRUE? (APPLY #'CHAR-LESSP SCHEME::X)))
(DEFUN CHAR-CI=? (&REST SCHEME::X) (TRUE? (APPLY #'CHAR-EQUAL SCHEME::X)))
(DEFUN CHAR-CI>=? (&REST SCHEME::X) (TRUE? (APPLY #'CHAR-NOT-LESSP SCHEME::X)))
(DEFUN CHAR-CI>? (&REST SCHEME::X) (TRUE? (APPLY #'CHAR-GREATERP SCHEME::X)))
(DEFUN CHAR-LOWER-CASE? (SCHEME::X) (TRUE? (LOWER-CASE-P SCHEME::X)))
(DEFUN CHAR-NUMERIC? (SCHEME::X) (TRUE? (DIGIT-CHAR-P SCHEME::X)))
(DEFUN CHAR-UPPER-CASE? (SCHEME::X) (TRUE? (UPPER-CASE-P SCHEME::X)))
(DEFUN CHAR-WHITESPACE? (SCHEME::X) (TRUE? (CHAR-WHITESPACE-P SCHEME::X)))
(DEFUN CHAR<=? (&REST SCHEME::X) (TRUE? (APPLY #'CHAR<= SCHEME::X)))
(DEFUN CHAR<? (&REST SCHEME::X) (TRUE? (APPLY #'CHAR< SCHEME::X)))
(DEFUN CHAR=? (&REST SCHEME::X) (TRUE? (APPLY #'CHAR= SCHEME::X)))
(DEFUN CHAR>=? (&REST SCHEME::X) (TRUE? (APPLY #'CHAR>= SCHEME::X)))
(DEFUN CHAR>? (&REST SCHEME::X) (TRUE? (APPLY #'CHAR> SCHEME::X)))
(DEFUN CHAR? (SCHEME::X) (TRUE? (CHARACTERP SCHEME::X)))
(DEFUN EQUAL? (SCHEME::X SCHEME::Y)
  (TRUE? (SCHEME-EQUAL-P SCHEME::X SCHEME::Y)))
(DEFUN EVEN? (SCHEME::X) (TRUE? (EVENP SCHEME::X)))
(DEFUN LIST->STRING (SCHEME::L) (COERCE (THE LIST SCHEME::L) 'SIMPLE-STRING))
(DEFUN LIST->VECTOR (SCHEME::L) (COERCE (THE LIST SCHEME::L) 'SIMPLE-VECTOR))
(DEFUN LIST-REF (SCHEME::LIST SCHEME::N) (NTH SCHEME::N SCHEME::LIST))
(DEFUN LIST-TAIL (SCHEME::LIST SCHEME::N) (NTHCDR SCHEME::N SCHEME::LIST))
(DEFUN .MEMBER (SCHEME::OBJ SCHEME::LIST)
  (TRUE? (MEMBER SCHEME::OBJ SCHEME::LIST :TEST #'SCHEME-EQUAL-P)))
(DEFUN MEMQ (SCHEME::OBJ SCHEME::LIST)
  (TRUE? (MEMBER SCHEME::OBJ SCHEME::LIST :TEST #'EQ)))
(DEFUN MEMV (SCHEME::X SCHEME::Y) (TRUE? (MEMBER SCHEME::X SCHEME::Y)))
(DEFUN NEGATIVE? (SCHEME::X) (TRUE? (MINUSP SCHEME::X)))
(DEFUN ODD? (SCHEME::X) (TRUE? (ODDP SCHEME::X)))
(DEFUN POSITIVE? (SCHEME::X) (TRUE? (PLUSP SCHEME::X)))
(DEFUN STRING->LIST (SCHEME::STRING)
  (COERCE (THE SIMPLE-STRING SCHEME::STRING) 'LIST))
(DEFUN STRING-CI<=? (SCHEME::X SCHEME::Y)
  (TRUE? (STRING-NOT-GREATERP SCHEME::X SCHEME::Y)))
(DEFUN STRING-CI<? (SCHEME::X SCHEME::Y)
  (TRUE? (STRING-LESSP SCHEME::X SCHEME::Y)))
(DEFUN STRING-CI=? (SCHEME::X SCHEME::Y)
  (TRUE? (STRING-EQUAL SCHEME::X SCHEME::Y)))
(DEFUN STRING-CI>=? (SCHEME::X SCHEME::Y)
  (TRUE? (STRING-NOT-LESSP SCHEME::X SCHEME::Y)))
(DEFUN STRING-CI>? (SCHEME::X SCHEME::Y)
  (TRUE? (STRING-GREATERP SCHEME::X SCHEME::Y)))
(DEFUN STRING-FILL! (SCHEME::S SCHEME::VAL)
  (FILL (THE SIMPLE-STRING SCHEME::S) SCHEME::VAL))
(DEFUN STRING<=? (SCHEME::X SCHEME::Y) (TRUE? (STRING<= SCHEME::X SCHEME::Y)))
(DEFUN STRING<? (SCHEME::X SCHEME::Y) (TRUE? (STRING< SCHEME::X SCHEME::Y)))
(DEFUN STRING=? (SCHEME::X SCHEME::Y) (TRUE? (STRING= SCHEME::X SCHEME::Y)))
(DEFUN STRING>=? (SCHEME::X SCHEME::Y) (TRUE? (STRING>= SCHEME::X SCHEME::Y)))
(DEFUN STRING>? (SCHEME::X SCHEME::Y) (TRUE? (STRING> SCHEME::X SCHEME::Y)))
(DEFUN VECTOR->LIST (SCHEME::VEC)
  (COERCE (THE SIMPLE-VECTOR SCHEME::VEC) 'LIST))
(DEFUN VECTOR-FILL! (SCHEME::VEC SCHEME::VAL)
  (FILL (THE SIMPLE-VECTOR SCHEME::VEC) SCHEME::VAL))
(DEFUN WITH-INPUT-FROM-FILE (SCHEME::STRING SCHEME::THUNK)
  (WITH-OPEN-FILE
      (*STANDARD-INPUT* (MERGE-PATHNAMES SCHEME::STRING) :DIRECTION :INPUT)
    (FUNCALL SCHEME::THUNK)))
(DEFUN WITH-OUTPUT-TO-FILE (SCHEME::STRING SCHEME::THUNK)
  (WITH-OPEN-FILE
      (*STANDARD-OUTPUT* (MERGE-PATHNAMES SCHEME::STRING) :DIRECTION :OUTPUT
       :IF-EXISTS :NEW-VERSION)
    (FUNCALL SCHEME::THUNK)))
(DEFUN ZERO? (SCHEME::X) (TRUE? (ZEROP SCHEME::X)))
(DEFUN CALL-WITH-VALUES (SCHEME::THUNK SCHEME::PROC)
  (MULTIPLE-VALUE-CALL SCHEME::PROC (FUNCALL SCHEME::THUNK)))
(LOCALLY (DECLARE (SPECIAL .UNSPECIFIC)) (SETQ .UNSPECIFIC UNSPECIFIC))
(SET-FUNCTION-FROM-VALUE '.UNSPECIFIC)
(MAPC #'SET-VALUE-FROM-FUNCTION
      '(.< .<=
           .=
           .>
           .>=
           BOOLEAN?
           CALL-WITH-CURRENT-CONTINUATION
           CHAR-READY?
           COMPLEX?
           CURRENT-INPUT-PORT
           CURRENT-OUTPUT-PORT
           EOF-OBJECT?
           EQ?
           EQV?
           EXACT?
           INEXACT?
           INPUT-PORT?
           INTEGER?
           MAKE-POLAR
           NULL?
           NUMBER?
           OPEN-INPUT-FILE
           OPEN-OUTPUT-FILE
           OUTPUT-PORT?
           PAIR?
           PROCEDURE?
           QUOTIENT
           RATIONAL?
           REAL?
           SET-CAR!
           SET-CDR!
           STRING->SYMBOL
           STRING-LENGTH
           STRING-REF
           STRING-SET!
           STRING?
           SYMBOL?
           TRANSCRIPT-ON
           TRANSCRIPT-OFF
           VECTOR-LENGTH
           VECTOR-SET!
           .ASSOC
           ASSQ
           ASSV
           CALL-WITH-INPUT-FILE
           CALL-WITH-OUTPUT-FILE
           CHAR-ALPHABETIC?
           CHAR-CI<=?
           CHAR-CI<?
           CHAR-CI=?
           CHAR-CI>=?
           CHAR-CI>?
           CHAR-LOWER-CASE?
           CHAR-NUMERIC?
           CHAR-UPPER-CASE?
           CHAR-WHITESPACE?
           CHAR<=?
           CHAR<?
           CHAR=?
           CHAR>=?
           CHAR>?
           CHAR?
           EQUAL?
           EVEN?
           LIST->STRING
           LIST->VECTOR
           LIST-REF
           LIST-TAIL
           .MEMBER
           MEMQ
           MEMV
           NEGATIVE?
           ODD?
           POSITIVE?
           STRING->LIST
           STRING-CI<=?
           STRING-CI<?
           STRING-CI=?
           STRING-CI>=?
           STRING-CI>?
           STRING-FILL!
           STRING<=?
           STRING<?
           STRING=?
           STRING>=?
           STRING>?
           VECTOR->LIST
           VECTOR-FILL!
           WITH-INPUT-FROM-FILE
           WITH-OUTPUT-TO-FILE
           ZERO?
           CALL-WITH-VALUES))
(MAPC
 #'(LAMBDA (SCHEME::Z)
     (LET ((SCHEME::OUR-SYM (CAR SCHEME::Z)) (SCHEME::CL-SYM (CADR SCHEME::Z)))
       (SETF (SYMBOL-FUNCTION SCHEME::OUR-SYM)
             (SYMBOL-FUNCTION SCHEME::CL-SYM))
       (SET-VALUE-FROM-FUNCTION SCHEME::OUR-SYM)))
 '((.* *) (.+ +) (.- -) (./ /) (.APPLY APPLY) (CHAR->INTEGER CHAR-CODE)
   (CLOSE-INPUT-PORT CLOSE) (CLOSE-OUTPUT-PORT CLOSE) (.CONS CONS)
   (.DENOMINATOR DENOMINATOR) (EXACT->INEXACT FLOAT) (IMAG-PART IMAGPART)
   (INEXACT->EXACT RATIONALIZE) (INTEGER->CHAR CODE-CHAR) (MAGNITUDE ABS)
   (MAKE-RECTANGULAR COMPLEX) (MODULO MOD) (NEWLINE TERPRI)
   (.NUMERATOR NUMERATOR) (REAL-PART REALPART) (REMAINDER REM)
   (VECTOR-REF SVREF) (.WRITE-CHAR WRITE-CHAR) (.APPEND APPEND) (.ABS ABS)
   (.ACOS ACOS) (ANGLE PHASE) (.ASIN ASIN) (.ATAN ATAN) (.CAAAAR CAAAAR)
   (.CAAADR CAAADR) (.CAADAR CAADAR) (.CAADDR CAADDR) (.CAAAR CAAAR)
   (.CAADR CAADR) (.CAAR CAAR) (.CADAAR CADAAR) (.CADADR CADADR)
   (.CADDAR CADDAR) (.CADDDR CADDDR) (.CADAR CADAR) (.CADDR CADDR) (.CADR CADR)
   (.CDAAAR CDAAAR) (.CDAADR CDAADR) (.CDADAR CDADAR) (.CDADDR CDADDR)
   (.CDAAR CDAAR) (.CDADR CDADR) (.CDAR CDAR) (.CDDAAR CDDAAR) (.CDDADR CDDADR)
   (.CDDDAR CDDDAR) (.CDDDDR CDDDDR) (.CDDAR CDDAR) (.CDDDR CDDDR) (.CDDR CDDR)
   (.CEILING CEILING) (.CHAR-DOWNCASE CHAR-DOWNCASE) (.CHAR-UPCASE CHAR-UPCASE)
   (.COS COS) (.EXP EXP) (.EXPT EXPT) (.FLOOR FLOOR) (FOR-EACH MAPC) (.GCD GCD)
   (.LCM LCM) (.LIST LIST) (.LOG LOG) (.LENGTH LENGTH) (.MAP MAPCAR) (.MAX MAX)
   (.MIN MIN) (.REVERSE REVERSE) (.ROUND ROUND) (.SIN SIN) (.SQRT SQRT)
   (STRING-COPY COPY-SEQ) (SUBSTRING SUBSEQ) (.TAN TAN) (.TRUNCATE TRUNCATE)
   (.VECTOR VECTOR) (.VALUES VALUES)))