;;; simply.scm version 2.23 (7/12/93)

;;; This file uses Scheme features we don't talk about in _Simply_Scheme_.
;;; Read at your own risk.

(if (equal? 'foo (symbol->string 'foo))
    (error "Simply.scm already loaded!!")
    #f)

(define (end-of-line-char? c)
  (char=? c #\newline))

(cond ((inexact? 42)	;; If PC Scheme...
       (eval '(define *standard-user-error-handler* *user-error-handler*))

       (eval '(set! (access *user-error-handler* user-global-environment)
		    (lambda (error-num error-msg irritant sys-error-handler)
		      (newline)
		      (display error-msg)
		      (print irritant)
		      (reset))))

       (eval '(define (enable-inspect)
		(set! (access *user-error-handler* user-global-environment)
		      *standard-user-error-handler*)))

       (set! pcs-integrate-integrables #f)
       (set! pcs-integrate-primitives #f)

       (eval '(define (list? x)
		;; Helper function so recursive calls don't show up in TRACE
		(define (list-helper x)
		  (cond ((null? x) #t)
			((not (real-pair? x)) #f)
			(else (list-helper (cdr x)))))
		(list-helper x)))

       ;; We can't just say #\return because some versions of Scheme
       ;; can't *read* #\return.  (Like Gambit.)
       (eval `(define (char-whitespace? c)
		(or (eq? c ,(integer->char 9))
		    (eq? c ,(integer->char 32))
		    (eq? c ,(integer->char 13))
		    (eq? c ,(integer->char 10)))))

       (set! end-of-line-char?
	     (lambda (c) (or (char=? c #\newline)
			     (char=? c (integer->char 13)))))

       (set! number->string
	     (let ((old number->string))
	       (lambda (n) (old n '(heur)))))

       (set! string->number
	     (let ((realsn string->number))
	       (lambda (s)
		 (if (reasonable-number? s)
		     (realsn s 'i 'd)
		     #f))))

       (eval '(define (reasonable-number? s)
		(define (sw str minus pointok pointseen eok eseen endok)
		  (cond ((null? str) endok)
			((and minus (equal? (car str) #\-))
			 (sw (cdr str) #f #f pointseen #f eseen #f))
			((and pointok (not pointseen) (equal? (car str) #\.))
			 (sw (cdr str) #f #f #t #t eseen #t))
			((and eok (not eseen) (equal? (car str) #\e))
			 (sw (cdr str) #t #f #t #f #t #f))
			((member (car str)
				 '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
			 (sw (cdr str) #f #t pointseen #t eseen #t))
			(else #f)))
		(if (string-null? s)
		    #f
		    (sw  (string->list s)  #t #f #f #f #f #f))))
       ))

;; Make number->string remove leading "+" if necessary

(if (char=? #\+ (string-ref (number->string 1.0) 0))
    (let ((old-ns number->string))
      (set! number->string
	    (lambda (number)
	      (let ((result (old-ns number)))
		(if (char=? #\+ (string-ref result 0))
		    (substring result 1 (string-length result))
		    result)))))
    'no-problem)

;; ROUND returns an inexact integer if its argument is inexact,
;; but we think it should always return an exact integer.
;; (It matters because some Schemes print inexact integers as "+1.0".)
;; The (exact 1) test is for PC Scheme, in which nothing is exact.
(if (and (inexact? (round (sqrt 2))) (exact? 1))
    (let ((old-round round))
      (set! round
	    (lambda (number)
	      (inexact->exact (old-round number)))))
    'no-problem)

;; Remainder and quotient blow up if their argument isn't an integer.
;; Unfortunately, in SCM, (* 365.25 24 60 60) *isn't* an integer.

(if (inexact? (* .25 4))
    (let ((rem remainder)
	  (quo quotient))
      (set! remainder
	    (lambda (x y)
	      (rem (if (integer? x) (inexact->exact x) x)
		   (if (integer? y) (inexact->exact y) y))))
      (set! quotient
	    (lambda (x y)
	      (quo (if (integer? x) (inexact->exact x) x)
		   (if (integer? y) (inexact->exact y) y)))))
    'done)


;; Get strings in error messages to print nicely (especially "")

(define (error-printform x)
  (if (string? x)
      (string-append "\"" x "\"")
      x))

(define e-p error-printform)

;;; Logo-style word/sentence implementation

(define real-pair? pair?)

(define (word? x)
  (or (symbol? x) (real-number? x) (string? x)))

(define (sentence? x)
  (define (list-of-words? l)
    (cond ((null? l) #t)
	  ((pair? l)
	   (and (word? (car l)) (list-of-words? (cdr l))))
	  (else #f)))
  (list-of-words? x))

(define (empty? x)
  (or (null? x)
      (and (string? x) (string=? x ""))))

(define char-rank
  ;; 0 Letter in good case or special initial
  ;; 1 ., + or -
  ;; 2 Digit
  ;; 3 Letter in bad case or weird character
  (let ((*the-char-ranks* (make-vector 256 3)))
    (define (give-rank char rank)
      (vector-set! *the-char-ranks* (char->integer char) rank))
    (for-each (lambda (c) (give-rank c 0))
	      (string->list (symbol->string 'abcdefghijklmnopqrstuvwxyz)))
    (for-each (lambda (c) (give-rank c 0))
	      (string->list "!$%&*/:<=>?~_^"))
    (for-each (lambda (c) (give-rank c 1))
	      (string->list "+-."))
    (for-each (lambda (c) (give-rank c 2))
	      (string->list "0123456789"))

    ;; value of char-rank
    (lambda (char)
      (vector-ref *the-char-ranks* (char->integer char)))))

(define (string->word string)
  (define (subsequents? string i length)
    (cond ((= i length) #t)
	  ((<= (char-rank (string-ref string i)) 2)
	   (subsequents? string (+ i 1) length))
	  (else #f)))
  (define (special-id? string)
    (or (string=? string "+")
	(string=? string "-")
	(string=? string "...")))
  (define (ok-symbol? string)
    (if (string=? string "")
	#f
	(let ((rank1 (char-rank (string-ref string 0))))
	  (cond ((= rank1 0) (subsequents? string 1 (string-length string)))
		((= rank1 1) (special-id? string))
		(else #f)))))
  (define (narrow-number? string)
    (if (string=? string "")
	#f
	(let* ((c0 (string-ref string 0))
	       (start 0)
	       (len (string-length string))
	       (cn (string-ref string (- len 1))))
	  (if (and (char=? c0 #\-) (not (= len 1)))
	      (begin
	       (set! start 1)
	       (set! c0 (string-ref string 1)))
	      #f)
	  (cond ((not (= (char-rank cn) 2)) #f)  ; Rejects "-" among others
		((char=? c0 #\.) #f)
		((char=? c0 #\0)
		 (cond ((= len 1) #t)  ; Accepts "0" but not "-0"
		       ((= len 2) #f)  ; Rejects "-0" and "03"
		       ((char=? (string-ref string (+ start 1)) #\.)
			(nn-helper string (+ start 2) len #t))
		       (else #f)))
		(else (nn-helper string start len #f)))))) 
  (define (nn-helper string i len seen-point?)
    (cond ((= i len)
	   (if seen-point?
	       (not (char=? (string-ref string (- len 1)) #\0))
	       #t))
	  ((char=? #\. (string-ref string i))
	   (cond (seen-point? #f)
		 ((= (+ i 2) len) #t)  ; Accepts "23.0"
		 (else (nn-helper string (+ i 1) len #t))))
	  ((= 2 (char-rank (string-ref string i)))
	   (nn-helper string (+ i 1) len seen-point?))
	  (else #f)))

  ;; The body of string->word:
  (cond ((narrow-number? string) (string->number string))
	((ok-symbol? string) (string->symbol string))
	(else string)))

(define (char->word char)
  (let ((rank (char-rank char))
	(string (make-string 1 char)))
    (cond ((= rank 0) (string->symbol string))
	  ((= rank 2) (string->number string))
	  ((char=? char #\+) '+)
	  ((char=? char #\-) '-)
	  (else string))))

(define (word->string wd)
  (cond ((string? wd) wd)
	((real-number? wd) (number->string wd))
	(else (symbol->string wd))))

(define (first x)
  (define (word-first wd)
    (char->word (string-ref (word->string wd) 0)))
  (cond ((real-pair? x) (car x))
	((empty? x) (error "Invalid argument to FIRST: " (e-p x)))
	((word? x) (word-first x))
	(else (error "Invalid argument to FIRST: " (e-p x)))))

(define (last x)
  (define (word-last wd)
    (let ((s (word->string wd)))
      (char->word (string-ref s (- (string-length s) 1)))))
  (define (list-last lst)      
    (if (empty? (cdr lst))
	(car lst)
	(list-last (cdr lst))))
  (cond ((real-pair? x) (list-last x))
	((empty? x) (error "Invalid argument to LAST: " (e-p x)))
	((word? x) (word-last x))
	(else (error "Invalid argument to LAST: " (e-p x)))))

(define (bf x)
  (define (string-bf s)
    (substring s 1 (string-length s)))
  (define (word-bf wd)
    (string->word (string-bf (word->string wd))))
  (cond ((real-pair? x) (cdr x))
	((empty? x) (error "Invalid argument to BUTFIRST: " (e-p x)))
	((word? x) (word-bf x))
	(else (error "Invalid argument to BUTFIRST: " (e-p x)))))

(define butfirst bf)

(define (bl x)
  (define (list-bl list)
    (if (null? (cdr list))
	'()
	(cons (car list) (list-bl (cdr list)))))
  (define (string-bl s)
    (substring s 0 (- (string-length s) 1)))  
  (define (word-bl wd)
    (string->word (string-bl (word->string wd))))
  (cond ((real-pair? x) (list-bl x))
	((empty? x) (error "Invalid argument to BUTLAST: " (e-p x)))
	((word? x) (word-bl x))
	(else (error "Invalid argument to BUTLAST: " (e-p x)))))

(define butlast bl)

(define (se . args)
  (define (paranoid-append a original-a b)
    (cond ((null? a) b)
	  ((word? (car a))
	   (cons (car a) (paranoid-append (cdr a) original-a b)))
	  (else (error "Argument to SENTENCE not a word or sentence"
		       original-a ))))
  (define (combine-two a b)                ;; Note: b is always a list
    (cond ((pair? a) (paranoid-append a a b))
	  ((null? a) b)
	  ((word? a) (cons a b))
	  (else (error "Argument to SENTENCE not a word or sentence:" a))))
  ;; Helper function so recursive calls don't show up in TRACE
  (define (real-se args)
    (if (null? args)
	'()
	(combine-two (car args) (real-se (cdr args)))))
  (real-se args))

(define sentence se)

(define (word . x)
  (let ((bad (filter (lambda (arg) (not (word? arg))) x)))
    (if (null? bad)
	(string->word (apply string-append (map word->string x)))
	(error "Invalid argument to WORD: " (e-p (car bad))))))

(define (member? x stuff)
  (define (real-member? x lst)
    (if (member x lst) #t #f))
  (define (word-member? small big)
    (let ((one-letter-str (word->string small)))
      (if (> (string-length one-letter-str) 1)
	  (error "Invalid arguments to MEMBER?: " (e-p small) (e-p big))
	  (let ((big-str (word->string big)))
	    (char-in-string? (string-ref one-letter-str 0)
		 	     big-str
			     (- (string-length big-str) 1))))))
  (define (char-in-string? char string i)
    (cond ((< i 0) #f)
	  ((char=? char (string-ref string i)) #t)
	  (else (char-in-string? char string (- i 1)))))
  (cond ((empty? stuff) #f)
	((word? stuff) (word-member? x stuff))
	((string? (car stuff)) (real-member? (word->string x) stuff))
	(else (real-member? x stuff))))

(define (item n stuff)
  (define (word-item n wd)
    (char->word (string-ref (word->string wd) (- n 1))))
  (cond ((not (integer? n))
	 (error "Invalid first argument to ITEM (must be an integer): "
		(e-p n)))
	((< n 1)
	 (error "Invalid first argument to ITEM (must be positive): "
		(e-p n)))
	((> n (count stuff))
	 (error "No such item: " (e-p n) (e-p stuff)))
	((word? stuff) (word-item n stuff))
	((list? stuff) (list-ref stuff (- n 1)))
	(else (error "Invalid second argument to ITEM: " (e-p stuff)))))

(define (before? wd1 wd2)
  (string<? (word->string wd1) (word->string wd2)))

(define (count stuff)
  (if (word? stuff)
      (string-length (word->string stuff))
      (length stuff)))

(define equal?
  (let ((old equal?))
    (lambda (x y)
      (cond ((and (string? x) (symbol? y))
	     (old x (symbol->string y)))
	    ((and (string? y) (symbol? x))
	     (old (symbol->string x) y))
	    (else (old x y))))))

;; Random
;; If your version of Scheme has RANDOM, you should take this out.
;; (It gives the same sequence of random numbers every time.) 

(define random
  (let ((*seed* 1))
    (lambda (x)
      (let* ((hi (quotient *seed* 127773))
	     (low (modulo *seed* 127773))
	     (test (- (* 16807 low) (* 2836 hi))))
	(if (> test 0)
	    (set! *seed* test)
	    (set! *seed* (+ test 2147483647))))
      (modulo *seed* x))))


;;; Higher Order Functions

(define (filter pred l)
  ;; Helper function so recursive calls don't show up in TRACE
  (define (real-filter l)
    (cond ((empty? l) '())
	  ((pred (car l))
	   (cons (car l) (real-filter (cdr l))))
	  (else (real-filter (cdr l)))))
  (real-filter l))

(define (keep pred w-or-s)
  (define (keep-string in i out out-len len)
    (cond ((= i len) (substring out 0 out-len))
	  ((pred (char->word (string-ref in i)))
	   (string-set! out out-len (string-ref in i))
	   (keep-string in (+ i 1) out (+ out-len 1) len))
	  (else (keep-string in (+ i 1) out out-len len))))
  (define (keep-word wd)
    (let* ((string (word->string wd))
	   (len (string-length string)))
      (string->word
       (keep-string string 0 (make-string len) 0 len))))

  (cond ((not (procedure? pred))
	 (error "Invalid first argument to KEEP (not a procedure): "
		(e-p pred)))
	((real-pair? w-or-s) (filter pred w-or-s))
	((word? w-or-s) (keep-word w-or-s))
	((null? w-or-s) '())
	(else (error "Invalid second argument to KEEP (not a word or sentence): "
		     (e-p w-or-s)))))

(define (appearances item aggregate)
  (count (keep (lambda (element) (equal? item element)) aggregate)))

(define (every fn stuff)
  (define (string-every string i length)
    (if (= i length)
	'()
	(se (fn (char->word (string-ref string i)))
	    (string-every string (+ i 1) length))))
  (define (sent-every sent)
    ;; This proc. can't be optimized or else it will break the
    ;; exercise where we ask them to reimplement sentences as
    ;; vectors and then see if every still works.
    ;; However, you *could* put in a check to make sure that every
    ;; element of the sentence is a word, to avoid, e.g.,
    ;; (every car '((a 1) (b 2) (c 3))).  But it's not worth the trouble
    (if (empty? sent)
	sent		; Can't be '() or exercise breaks.
	(se (fn (first sent))    
	    (every fn (bf sent)))))
  (if (word? stuff)
      (let ((string (word->string stuff)))
	(string-every string 0 (string-length string)))
      (sent-every stuff)))

(define (accumulate combiner stuff)
  (define (real-accumulate stuff)
    (if (empty? (bf stuff))
	(first stuff)
	(combiner (first stuff) (real-accumulate (bf stuff)))))
  (cond
   ((not (empty? stuff)) (real-accumulate stuff))
   ((member combiner (list + * word se append))
    (combiner))
   (else (error "Can't accumulate empty input with that combiner"))))

(define (reduce combiner stuff)
  (define (real-reduce stuff)
    (if (null? (cdr stuff))
	(car stuff)
	(combiner (car stuff) (real-reduce (cdr stuff)))))
  (cond
   ((not (null? stuff)) (real-reduce stuff))
   ((member combiner (list + * word se list))
    (combiner))
   (else (error "Can't reduce empty input with that combiner"))))

(define (repeated fn number)
  (if (= number 0)
      (lambda (x) x)
      (lambda (x)
	((repeated fn (- number 1)) (fn x)))))


;; Tree stuff

(define (make-node datum children)
  (cons datum children))

(define (datum node)
  (car node))

(define (children node)
  (cdr node))

;; I/O
        
(define show
  (let ((= =))
    (lambda args
      (cond
       ((= (length args) 1)
	(display (car args))
	(newline))
       ((= (length args) 2)
	(if (not (output-port? (cadr args)))
	    (error "Invalid second argument to SHOW (not an output port): "
		   (e-p (cadr args))))
	(apply display args)
	(newline (cadr args)))
       (else (error "Incorrect number of arguments to procedure SHOW"))))))


(define (read-line . args)
  (define (read-line-helper port)
    (let ((next (get-token port)))
      (if (end-of-line-char? next)
	  '()
	  (cons next (read-line port)))))
  (define (get-token port)
    (let ((char (read-char port)))
      (cond ((or (eof-object? char) (end-of-line-char? char))
	     #\newline)
	    ((char-whitespace? char)
	     (gobble-space port)
	     (get-token port))
	    (else (make-token (list char) port)))))
  (define (make-token sofar port)
    (if (char-whitespace? (peek-char port))
	(string->word (list->string (reverse sofar)))
	(make-token (cons (read-char port) sofar) port)))

  (define (gobble-space port)
    (if (and (not (end-of-line-char? (peek-char port)))
	     (char-whitespace? (peek-char port)))
	(begin (read-char port)
	       (gobble-space port))
	'done))
  (if (>= (length args) 2)
      (error "Too many arguments to read-line")
      (let ((port (if (null? args) (current-input-port) (car args))))
	(if (eof-object? (peek-char port))
	    (read-char port)
	    (read-line-helper port)))))

(define (show-line line . args)
  (if (>= (length args) 2)
      (error "Too many arguments to show-line")
      (let ((port (if (null? args) (current-output-port) (car args))))
	(cond ((not (list? line))
	       (error "Invalid argument to SHOW-LINE (not a list):" line))
	      ((null? line) #f)
	      (else
	       (display (car line) port)
	       (for-each (lambda (wd) (display " " port) (display wd port))
			 (cdr line))))
	(newline port))))

(define (format obj width . rest)
  (define (format-number)
    (let* ((sign (< obj 0))
	   (num (abs obj))
	   (prec (if (null? rest) 0 (car rest)))
	   (big (round (* num (expt 10 prec))))
	   (cvt (number->string big))
	   (pos-str (if (>= (string-length cvt) prec)
			cvt
			(string-append
			 (make-string (- prec (string-length cvt)) #\0)
			 cvt)))
	   (string (if sign (string-append "-" pos-str) pos-str))
	   (length (+ (string-length string)
		      (if (= prec 0) 0 1)))
	   (left (- length (+ 1 prec)))
	   (result (if (= prec 0)
		       string
		       (string-append
			(substring string 0 left)
			"."
			(substring string left (- length 1))))))
      (cond ((= length width) result)
	    ((< length width)
	     (string-append (make-string (- width length) #\space) result))
	    (else (let ((new (substring result 0 width)))
		    (string-set! new (- width 1) #\+)
		    new)))))
  (define (format-word string)
    (let ((length (string-length string)))
      (cond ((= length width) string)
	    ((< length width)
	     (string-append string (make-string (- width length) #\space)))
	    (else (let ((new (substring string 0 width)))
		    (string-set! new (- width 1) #\+)
		    new)))))
  (if (number? obj)
      (format-number)
      (format-word (word->string obj))))

(define (read-string . args)
  (define (read-string-helper chars port)
    (let ((char (read-char port)))
      (if (or (eof-object? char) (end-of-line-char? char))
	  (list->string (reverse chars))
	  (read-string-helper (cons char chars) port))))
  (if (>= (length args) 2)
      (error "Too many arguments to read-string")
      (let ((port (if (null? args) (current-input-port) (car args))))
	(if (eof-object? (peek-char port))
	    (read-char port)
	    (read-string-helper '() port)))))

(define *the-open-inports* '())
(define *the-open-outports* '())

(define open-output-file
  (let ((oof open-output-file))
    (lambda (filename)
      (let ((port (oof filename)))
	(set! *the-open-outports* (cons port *the-open-outports*))
	port))))

(define open-input-file
  (let ((oif open-input-file))
    (lambda (filename)
      (let ((port (oif filename)))
	(set! *the-open-inports* (cons port *the-open-inports*))
	port))))

(define (remove! thing lst)
  (define (r! prev)
    (cond ((null? (cdr prev)) lst)
	  ((eq? thing (cadr prev))
	   (set-cdr! prev (cddr prev))
	   lst)
	  (else (r! (cdr prev)))))
  (cond ((null? lst) lst)
	((eq? thing (car lst)) (cdr lst))
	(else (r! lst))))

(define close-input-port
  (let ((cip close-input-port)
	(remove! remove!))
    (lambda (port)
      (set! *the-open-inports* (remove! port *the-open-inports*))
      (cip port))))

(define close-output-port
  (let ((cop close-output-port)
	(remove! remove!))
    (lambda (port)
      (set! *the-open-outports* (remove! port *the-open-outports*))
      (cop port))))

(define (close-all-ports)
  (for-each close-input-port *the-open-inports*)
  (for-each close-output-port *the-open-outports*)
  'okay)


;; Make arithmetic work on numbers in string form:

;; Before we change number?, store old version...
(define real-number? number?)

(define (maybe-num arg)
  (if (string? arg)
      (let ((num (string->number arg)))
	(if num num arg))
      arg))

(define (logoize fn)
  (lambda args
    (apply fn (map maybe-num args))))

;; special case versions of logoize, since (lambda args ...) is expensive

(define (logoize-1 fn)
  (lambda (x) (fn (maybe-num x))))

(define (logoize-2 fn)
  (lambda (x y) (fn (maybe-num x) (maybe-num y))))

(define strings-are-numbers
  (let ((are-they? #f)
        (real-* *)
        (real-+ +)
        (real-- -)
        (real-/ /)
        (real-< <)
        (real-<= <=)
        (real-= =)
        (real-> >)
        (real->= >=)
        (real-abs abs)
        (real-acos acos)
        (real-asin asin)
        (real-atan atan)
        (real-ceiling ceiling)
        (real-cos cos)
        (real-equal? equal?)
        (real-even? even?)
        (real-exp exp)
        (real-expt expt)
        (real-floor floor)
	(real-format format)
        (real-gcd gcd)
        (real-integer? integer?)
        (real-item item)
        (real-lcm lcm)
        (real-list-ref list-ref)
        (real-log log)
        (real-make-vector make-vector)
        (real-max max)
        (real-min min)
        (real-modulo modulo)
        (real-negative? negative?)
        (real-number? number?)
        (real-odd? odd?)
        (real-positive? positive?)
        (real-quotient quotient)
        (real-random random)
        (real-remainder remainder)
        (real-repeated repeated)
        (real-round round)
        (real-sin sin)
        (real-sqrt sqrt)
        (real-tan tan)
        (real-truncate truncate)
        (real-vector-ref vector-ref)
        (real-vector-set! vector-set!)
        (real-zero? zero?)
	)
    (lambda (yesno)
      (cond ((and are-they? (eq? yesno #t))
	     (show "Strings are already numbers"))
	    ((eq? yesno #t)
	     (set! are-they? #t)
	     (set! * (logoize real-*))
	     (set! + (logoize real-+))
	     (set! - (logoize real--))
	     (set! / (logoize real-/))
	     (set! < (logoize real-<))
	     (set! <= (logoize real-<=))
	     (set! = (logoize real-=))
	     (set! > (logoize real->))
	     (set! >= (logoize real->=))
	     (set! abs (logoize-1 real-abs))
	     (set! acos (logoize-1 real-acos))
	     (set! asin (logoize-1 real-asin))
	     (set! atan (logoize real-atan))
	     (set! ceiling (logoize-1 real-ceiling))
	     (set! cos (logoize-1 real-cos))
	     (set! equal?
		   (lambda (x y)
		     (real-equal? (if (number? x) (number->string x) x)
				  (if (number? y) (number->string y) y))))
	     (set! even? (logoize-1 real-even?))
	     (set! exp (logoize-1 real-exp))
	     (set! expt (logoize-2 real-expt))
	     (set! floor (logoize-1 real-floor))
	     (set! format (logoize format))
	     (set! gcd (logoize real-gcd))
	     (set! integer? (logoize-1 real-integer?))
	     (set! lcm (logoize real-lcm))
	     (set! list-ref (lambda (lst k) 
			      (real-list-ref lst (maybe-num k))))
	     (set! log (logoize-1 real-log))
	     (set! max (logoize real-max))
	     (set! min (logoize real-min))
	     (set! modulo (logoize-2 real-modulo))
	     (set! negative? (logoize-1 real-negative?))
	     (set! number? (logoize-1 real-number?))
	     (set! odd? (logoize-1 real-odd?))
	     (set! positive? (logoize-1 real-positive?))
	     (set! quotient (logoize-2 real-quotient))
	     (set! random (logoize real-random))
	     (set! remainder (logoize-2 real-remainder))
	     (set! round (logoize-1 real-round))
	     (set! sin (logoize-1 real-sin))
	     (set! sqrt (logoize-1 real-sqrt))
	     (set! tan (logoize-1 real-tan))
	     (set! truncate (logoize-1 real-truncate))
	     (set! zero? (logoize-1 real-zero?))
	     (set! vector-ref
		   (lambda (vec i) (real-vector-ref vec (maybe-num i))))
	     (set! vector-set!
		   (lambda (vec i val)
		     (real-vector-set! vec (maybe-num i) val)))
	     (set! make-vector
		   (lambda args
		     (if (null? args)
			 (apply real-make-vector args)	; Just for error msg
			 (apply real-make-vector (cons (maybe-num (car args))
						       (cdr args))))))
	     (set! list-ref
		   (lambda (lst i) (real-list-ref lst (maybe-num i))))
	     (set! item
		   (lambda (stuff i) (real-item stuff (maybe-num i))))
	     (set! repeated
		   (lambda (fn n) (real-repeated fn (maybe-num n)))))
	    ((and (not are-they?) (not yesno))
	     (show "Strings are already not numbers"))
	    ((not yesno)
	     (set! are-they? #f) (set! * real-*) (set! + real-+)
	     (set! - real--) (set! / real-/) (set! < real-<)
	     (set! <= real-<=) (set! = real-=) (set! > real->)
	     (set! >= real->=) (set! abs real-abs) (set! acos real-acos)
	     (set! asin real-asin) (set! atan real-atan)
	     (set! ceiling real-ceiling) (set! cos real-cos)
	     (set! equal? real-equal?)  (set! even? real-even?)
	     (set! exp real-exp) (set! expt real-expt)
	     (set! floor real-floor) (set! format real-format)
	     (set! gcd real-gcd) (set! integer? real-integer?)
	     (set! lcm real-lcm) (set! list-ref real-list-ref)
	     (set! log real-log) (set! max real-max) (set! min real-min)
	     (set! modulo real-modulo) (set! odd? real-odd?)
	     (set! quotient real-quotient) (set! random real-random)
	     (set! remainder real-remainder) (set! round real-round)
	     (set! sin real-sin) (set! sqrt real-sqrt) (set! tan real-tan)
	     (set! truncate real-truncate) (set! zero? real-zero?)
	     (set! positive? real-positive?) (set! negative? real-negative?)
	     (set! number? real-number?) (set! vector-ref real-vector-ref)
	     (set! vector-set! real-vector-set!)
	     (set! make-vector real-make-vector)
	     (set! list-ref real-list-ref) (set! item real-item)
	     (set! repeated real-repeated))
	    (else (error "Strings-are-numbers: give a #t or a #f")))
	    are-they?)))


;; By default, strings are numbers:
;; (except for Matt and Brian)
;; (strings-are-numbers #t)