#lang whalesong/base

;; A module language that provides bindings for the Simply Scheme
;; language.

;; Much of this code was automatically generated by utilities
;; I (dyoo) wrote in private/, but I'm hand-massaging some of
;; the definitions here to support things like trace.



(define simply-scheme:* *)
(define simply-scheme:+ +)
(define simply-scheme:- -)
(define simply-scheme:/ /)
(define simply-scheme:< <)
(define simply-scheme:<= <=)
(define simply-scheme:= =)
(define simply-scheme:> >)
(define simply-scheme:>= >=)
(define simply-scheme:abs abs)
(define simply-scheme:acos acos)
(define simply-scheme:asin asin)
(define simply-scheme:atan atan)
(define simply-scheme:ceiling ceiling)
;(define simply-scheme:close-input-port close-input-port)
;(define simply-scheme:close-output-port close-output-port)
(define simply-scheme:cos cos)
(define simply-scheme:equal? equal?)
(define simply-scheme:even? even?)
(define simply-scheme:exp exp)
(define simply-scheme:expt expt)
(define simply-scheme:floor floor)
(define simply-scheme:gcd gcd)
(define simply-scheme:integer? integer?)
(define simply-scheme:lcm lcm)
(define simply-scheme:list-ref list-ref)
(define simply-scheme:log log)
(define simply-scheme:make-vector make-vector)
(define simply-scheme:max max)
(define simply-scheme:min min)
(define simply-scheme:modulo modulo)
(define simply-scheme:negative? negative?)
(define simply-scheme:number->string number->string)
(define simply-scheme:number? number?)
(define simply-scheme:odd? odd?)
#;(define simply-scheme:open-input-file open-input-file)
#;(define simply-scheme:open-output-file open-output-file)
(define simply-scheme:positive? positive?)
(define simply-scheme:quotient quotient)
(define simply-scheme:random random)
#;(define simply-scheme:read-line read-line)
#;(define simply-scheme:read-string read-string)
(define simply-scheme:remainder remainder)
(define simply-scheme:round round)
(define simply-scheme:sin sin)
(define simply-scheme:sqrt sqrt)
(define simply-scheme:tan tan)
(define simply-scheme:truncate truncate)
(define simply-scheme:vector-ref vector-ref)
(define simply-scheme:vector-set! vector-set!)
(define simply-scheme:zero? zero?)


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

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

(set! simply-scheme:number->string
      (let-values (((old-ns) simply-scheme:number->string) ((string?) string?))
        (lambda args (if (string? (car args)) (car args) (apply old-ns args)))))

(define-values
  (whoops)
  (let-values (((string?) string?)
               ((string-append) string-append)
               ((error) error)
               ((cons) cons)
               ((map) map)
               ((apply) apply))
    (letrec-values (((error-printform)
                     (lambda (x)
                       (if (string? x) (string-append "\"" x "\"") x))))
      (lambda (string . args)
        (apply error (cons string (map error-printform args)))))))

(void
 (if (if (inexact? (simply-scheme:round (simply-scheme:sqrt 2))) (exact? 1) #f)
     (let-values (((old-round) simply-scheme:round)
                  ((inexact->exact) inexact->exact))
       (set! simply-scheme:round
             (lambda (number) (inexact->exact (old-round number)))))
     'no-problem))

(void (if (inexact? (simply-scheme:* 0.25 4))
          (let-values (((rem) simply-scheme:remainder)
                       ((quo) simply-scheme:quotient)
                       ((inexact->exact) inexact->exact)
                       ((integer?) simply-scheme:integer?))
            (set! simply-scheme:remainder
                  (lambda (x y)
                    (rem
                     (if (integer? x) (inexact->exact x) x)
                     (if (integer? y) (inexact->exact y) y))))
            (set! simply-scheme:quotient
                  (lambda (x y)
                    (quo
                     (if (integer? x) (inexact->exact x) x)
                     (if (integer? y) (inexact->exact y) y)))))
          'done))


(set! simply-scheme:random
      (let-values (((*seed*) 1)
                   ((quotient) simply-scheme:quotient)
                   ((modulo) simply-scheme:modulo)
                   ((+) simply-scheme:+)
                   ((-) simply-scheme:-)
                   ((*) simply-scheme:*)
                   ((>) simply-scheme:>))
        (lambda (x)
          (let-values (((hi) (quotient *seed* 127773)))
            (let-values (((low) (modulo *seed* 127773)))
              (let-values (((test) (- (* 16807 low) (* 2836 hi))))
                (if (> test 0)
                    (set! *seed* test)
                    (set! *seed* (#%app + test (#%datum . 2147483647)))))))
          (modulo *seed* x))))

(define-values
  (word?)
  (let-values (((number?) simply-scheme:number?)
               ((symbol?) symbol?)
               ((string?) string?))
    (lambda (x)
      (let-values (((or-part) (symbol? x)))
        (if or-part
            or-part
            (let-values (((or-part) (number? x)))
              (if or-part or-part (string? x))))))))

(define-values
  (sentence?)
  (let-values (((null?) null?)
               ((pair?) pair?)
               ((word?) word?)
               ((car) car)
               ((cdr) cdr))
    (letrec-values (((list-of-words?)
                     (lambda (l)
                       (if (null? l)
                           (begin #t)
                           (if (pair? l)
                               (begin
                                 (if (word? (car l)) (list-of-words? (cdr l)) #f))
                               (begin #f))))))
      list-of-words?)))

(define-values
  (empty?)
  (let-values (((null?) null?) ((string?) string?) ((string=?) string=?))
    (lambda (x)
      (let-values (((or-part) (null? x)))
        (if or-part or-part (if (string? x) (string=? x "") #f))))))

(define-values
  (char-rank)
  (let-values (((*the-char-ranks*) (simply-scheme:make-vector 256 3))
               ((=) simply-scheme:=)
               ((+) simply-scheme:+)
               ((string-ref) string-ref)
               ((string-length) string-length)
               ((vector-set!) simply-scheme:vector-set!)
               ((char->integer) char->integer)
               ((symbol->string) symbol->string)
               ((vector-ref) simply-scheme:vector-ref))
    (letrec-values (((rank-string)
                     (lambda (str rank)
                       (letrec-values (((helper)
                                        (lambda (i len)
                                          (if (= i len)
                                              'done
                                              (begin
                                                (vector-set!
                                                 *the-char-ranks*
                                                 (char->integer
                                                  (string-ref str i))
                                                 rank)
                                                (helper (+ i 1) len))))))
                         (helper 0 (string-length str))))))
      (rank-string (symbol->string 'abcdefghijklmnopqrstuvwxyz) 0)
      (rank-string "!$%&*/:<=>?~_^" 0)
      (rank-string "+-." 1)
      (rank-string "0123456789" 2)
      (lambda (char) (vector-ref *the-char-ranks* (char->integer char))))))

(define-values
  (string->word)
  (let-values (((=) simply-scheme:=)
               ((<=) simply-scheme:<=)
               ((+) simply-scheme:+)
               ((-) simply-scheme:-)
               ((char-rank) char-rank)
               ((string-ref) string-ref)
               ((string-length) string-length)
               ((string=?) string=?)
               ((not) not)
               ((char=?) char=?)
               ((string->number) string->number)
               ((string->symbol) string->symbol))
    (lambda (string)
      (letrec-values (((subsequents?)
                       (lambda (string i length)
                         (if (= i length)
                             (begin #t)
                             (if (<= (char-rank (string-ref string i)) 2)
                                 (begin (subsequents? string (+ i 1) length))
                                 (begin #f)))))
                      ((special-id?)
                       (lambda (string)
                         (let-values (((or-part) (string=? string "+")))
                           (if or-part
                               or-part
                               (let-values (((or-part) (string=? string "-")))
                                 (if or-part
                                     or-part
                                     (string=? string "...")))))))
                      ((ok-symbol?)
                       (lambda (string)
                         (if (string=? string "")
                             #f
                             (let-values (((rank1)
                                           (char-rank (string-ref string 0))))
                               (if (= rank1 0)
                                   (begin
                                     (subsequents?
                                      string
                                      1
                                      (string-length string)))
                                   (if (= rank1 1)
                                       (begin (special-id? string))
                                       (begin #f)))))))
                      ((nn-helper)
                       (lambda (string i len seen-point?)
                         (if (= i len)
                             (begin
                               (if seen-point?
                                   (not (char=? (string-ref string (- len 1)) #\0))
                                   #t))
                             (if (char=? #\. (string-ref string i))
                                 (begin
                                   (if seen-point?
                                       (begin #f)
                                       (if (= (+ i 2) len)
                                           (begin #t)
                                           (begin (nn-helper string (+ i 1) len #t)))))
                                 (if (= 2 (char-rank (string-ref string i)))
                                     (begin
                                       (nn-helper string (+ i 1) len seen-point?))
                                     (begin #f))))))
                      ((narrow-number?)
                       (lambda (string)
                         (if (string=? string "")
                             #f
                             (let-values (((c0) (string-ref string 0)))
                               (let-values (((start) 0))
                                 (let-values (((len) (string-length string)))
                                   (let-values (((cn)
                                                 (string-ref string (- len 1))))
                                     (if (if (char=? c0 #\-) (not (= len 1)) #f)
                                         (begin
                                           (set! start (#%datum . 1))
                                           (set! c0
                                                 (#%app
                                                  string-ref
                                                  string
                                                  (#%datum . 1))))
                                         #f)
                                     (if (not (= (char-rank cn) 2))
                                         (begin #f)
                                         (if (char=? c0 #\.)
                                             (begin #f)
                                             (if (char=? c0 #\0)
                                                 (begin
                                                   (if (= len 1)
                                                       (begin #t)
                                                       (if (= len 2)
                                                           (begin #f)
                                                           (if (char=?
                                                                (string-ref
                                                                 string
                                                                 (+ start 1))
                                                                #\.)
                                                               (begin
                                                                 (nn-helper
                                                                  string
                                                                  (+ start 2)
                                                                  len
                                                                  #t))
                                                               (begin #f)))))
                                                 (begin
                                                   (nn-helper
                                                    string
                                                    start
                                                    len
                                                    #f)))))))))))))
        (if (narrow-number? string)
            (begin (string->number string))
            (if (ok-symbol? string)
                (begin (string->symbol string))
                (begin string)))))))

(define-values
  (char->word)
  (let-values (((=) simply-scheme:=)
               ((char-rank) char-rank)
               ((make-string) make-string)
               ((string->symbol) string->symbol)
               ((string->number) string->number)
               ((char=?) char=?))
    (lambda (char)
      (let-values (((rank) (char-rank char)) ((string) (make-string 1 char)))
        (if (= rank 0)
            (begin (string->symbol string))
            (if (= rank 2)
                (begin (string->number string))
                (if (char=? char #\+)
                    (begin '+)
                    (if (char=? char #\-) (begin '-) (begin string)))))))))

(define-values
  (word->string)
  (let-values (((number?) simply-scheme:number?)
               ((string?) string?)
               ((number->string) simply-scheme:number->string)
               ((symbol->string) symbol->string))
    (lambda (wd)
      (if (string? wd)
          (begin wd)
          (if (number? wd)
              (begin (number->string wd))
              (begin (symbol->string wd)))))))

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

(define-values
  (word)
  (let-values (((string->word) string->word)
               ((apply) apply)
               ((string-append) string-append)
               ((map) map)
               ((word?) word?)
               ((word->string) word->string)
               ((whoops) whoops))
    (lambda x
      (string->word
       (apply
        string-append
        (map
         (lambda (arg)
           (if (word? arg)
               (word->string arg)
               (whoops "Invalid argument to WORD: " arg)))
         x))))))

(define-values
  (se)
  (let-values (((pair?) pair?)
               ((null?) null?)
               ((word?) word?)
               ((car) car)
               ((cons) cons)
               ((cdr) cdr)
               ((whoops) whoops))
    (letrec-values (((paranoid-append)
                     (lambda (a original-a b)
                       (if (null? a)
                           (begin b)
                           (if (word? (car a))
                               (begin
                                 (cons
                                  (car a)
                                  (paranoid-append (cdr a) original-a b)))
                               (begin
                                 (whoops
                                  "Argument to SENTENCE not a word or sentence"
                                  original-a))))))
                    ((combine-two)
                     (lambda (a b)
                       (if (pair? a)
                           (begin (paranoid-append a a b))
                           (if (null? a)
                               (begin b)
                               (if (word? a)
                                   (begin (cons a b))
                                   (begin
                                     (whoops
                                      "Argument to SENTENCE not a word or sentence:"
                                      a)))))))
                    ((real-se)
                     (lambda (args)
                       (if (null? args)
                           '()
                           (combine-two (car args) (real-se (cdr args)))))))
      (lambda args (real-se args)))))

(define-values (sentence) se)

(define-values
  (first)
  (let-values (((pair?) pair?)
               ((char->word) char->word)
               ((string-ref) string-ref)
               ((word->string) word->string)
               ((car) car)
               ((empty?) empty?)
               ((whoops) whoops)
               ((word?) word?))
    (letrec-values (((word-first)
                     (lambda (wd)
                       (char->word (string-ref (word->string wd) 0)))))
      (lambda (x)
        (if (pair? x)
            (begin (car x))
            (if (empty? x)
                (begin (whoops "Invalid argument to FIRST: " x))
                (if (word? x)
                    (begin (word-first x))
                    (begin (whoops "Invalid argument to FIRST: " x)))))))))

(define-values
  (last)
  (let-values (((pair?) pair?)
               ((-) simply-scheme:-)
               ((word->string) word->string)
               ((char->word) char->word)
               ((string-ref) string-ref)
               ((string-length) string-length)
               ((empty?) empty?)
               ((cdr) cdr)
               ((car) car)
               ((whoops) whoops)
               ((word?) word?))
    (letrec-values (((word-last)
                     (lambda (wd)
                       (let-values (((s) (word->string wd)))
                         (char->word (string-ref s (- (string-length s) 1))))))
                    ((list-last)
                     (lambda (lst)
                       (if (empty? (cdr lst))
                           (car lst)
                           (list-last (cdr lst))))))
      (lambda (x)
        (if (pair? x)
            (begin (list-last x))
            (if (empty? x)
                (begin (whoops "Invalid argument to LAST: " x))
                (if (word? x)
                    (begin (word-last x))
                    (begin (whoops "Invalid argument to LAST: " x)))))))))

(define-values
  (bf)
  (let-values (((pair?) pair?)
               ((substring) substring)
               ((string-length) string-length)
               ((string->word) string->word)
               ((word->string) word->string)
               ((cdr) cdr)
               ((empty?) empty?)
               ((whoops) whoops)
               ((word?) word?))
    (letrec-values (((string-bf)
                     (lambda (s) (substring s 1 (string-length s))))
                    ((word-bf)
                     (lambda (wd)
                       (string->word (string-bf (word->string wd))))))
      (lambda (x)
        (if (pair? x)
            (begin (cdr x))
            (if (empty? x)
                (begin (whoops "Invalid argument to BUTFIRST: " x))
                (if (word? x)
                    (begin (word-bf x))
                    (begin (whoops "Invalid argument to BUTFIRST: " x)))))))))

(define-values (butfirst) bf)

(define-values
  (bl)
  (let-values (((pair?) pair?)
               ((-) simply-scheme:-)
               ((cdr) cdr)
               ((cons) cons)
               ((car) car)
               ((substring) substring)
               ((string-length) string-length)
               ((string->word) string->word)
               ((word->string) word->string)
               ((empty?) empty?)
               ((whoops) whoops)
               ((word?) word?))
    (letrec-values (((list-bl)
                     (lambda (list)
                       (if (null? (cdr list))
                           '()
                           (cons (car list) (list-bl (cdr list))))))
                    ((string-bl)
                     (lambda (s) (substring s 0 (- (string-length s) 1))))
                    ((word-bl)
                     (lambda (wd)
                       (string->word (string-bl (word->string wd))))))
      (lambda (x)
        (if (pair? x)
            (begin (list-bl x))
            (if (empty? x)
                (begin (whoops "Invalid argument to BUTLAST: " x))
                (if (word? x)
                    (begin (word-bl x))
                    (begin (whoops "Invalid argument to BUTLAST: " x)))))))))

(define-values (butlast) bl)

(define-values
  (item)
  (let-values (((>) simply-scheme:>)
               ((-) simply-scheme:-)
               ((<) simply-scheme:<)
               ((integer?) simply-scheme:integer?)
               ((list-ref) simply-scheme:list-ref)
               ((char->word) char->word)
               ((string-ref) string-ref)
               ((word->string) word->string)
               ((not) not)
               ((whoops) whoops)
               ((count) count)
               ((word?) word?)
               ((list?) list?))
    (letrec-values (((word-item)
                     (lambda (n wd)
                       (char->word (string-ref (word->string wd) (- n 1))))))
      (lambda (n stuff)
        (if (not (integer? n))
            (begin
              (whoops "Invalid first argument to ITEM (must be an integer): " n))
            (if (< n 1)
                (begin
                  (whoops "Invalid first argument to ITEM (must be positive): " n))
                (if (> n (count stuff))
                    (begin (whoops "No such item: " n stuff))
                    (if (word? stuff)
                        (begin (word-item n stuff))
                        (if (list? stuff)
                            (begin (list-ref stuff (- n 1)))
                            (begin
                              (whoops
                               "Invalid second argument to ITEM: "
                               stuff)))))))))))

(set! simply-scheme:equal?
      (let-values (((vector-length) vector-length)
                   ((=) simply-scheme:=)
                   ((vector-ref) simply-scheme:vector-ref)
                   ((+) simply-scheme:+)
                   ((string?) string?)
                   ((symbol?) symbol?)
                   ((null?) null?)
                   ((pair?) pair?)
                   ((car) car)
                   ((cdr) cdr)
                   ((eq?) eq?)
                   ((string=?) string=?)
                   ((symbol->string) symbol->string)
                   ((number?) simply-scheme:number?)
                   ((string->word) string->word)
                   ((vector?) vector?)
                   ((eqv?) eqv?))
        (letrec-values (((vector-equal?)
                         (lambda (v1 v2)
                           (let-values (((len1) (vector-length v1))
                                        ((len2) (vector-length v2)))
                             (letrec-values (((helper)
                                              (lambda (i)
                                                (if (= i len1)
                                                    #t
                                                    (if (simply-scheme:equal?
                                                         (vector-ref v1 i)
                                                         (vector-ref v2 i))
                                                        (helper (+ i 1))
                                                        #f)))))
                               (if (= len1 len2) (helper 0) #f))))))
          (lambda (x y)
            (if (null? x)
                (begin (null? y))
                (if (null? y)
                    (begin #f)
                    (if (pair? x)
                        (begin
                          (if (pair? y)
                              (if (simply-scheme:equal? (car x) (car y))
                                  (simply-scheme:equal? (cdr x) (cdr y))
                                  #f)
                              #f))
                        (if (pair? y)
                            (begin #f)
                            (if (symbol? x)
                                (begin
                                  (let-values (((or-part) (if (symbol? y) (eq? x y) #f)))
                                    (if or-part
                                        or-part
                                        (if (string? y) (string=? (symbol->string x) y) #f))))
                                (if (symbol? y)
                                    (begin (if (string? x) (string=? x (symbol->string y)) #f))
                                    (if (number? x)
                                        (begin
                                          (let-values (((or-part) (if (number? y) (= x y) #f)))
                                            (if or-part
                                                or-part
                                                (if (string? y)
                                                    (let-values (((possible-num) (string->word y)))
                                                      (if (number? possible-num)
                                                          (= x possible-num)
                                                          #f))
                                                    #f))))
                                        (if (number? y)
                                            (begin
                                              (if (string? x)
                                                  (let-values (((possible-num) (string->word x)))
                                                    (if (number? possible-num)
                                                        (= possible-num y)
                                                        #f))
                                                  #f))
                                            (if (string? x)
                                                (begin (if (string? y) (string=? x y) #f))
                                                (if (string? y)
                                                    (begin #f)
                                                    (if (vector? x)
                                                        (begin (if (vector? y) (vector-equal? x y) #f))
                                                        (if (vector? y)
                                                            (begin #f)
                                                            (begin (eqv? x y))))))))))))))))))

(define-values
  (member?)
  (let-values (((>) simply-scheme:>)
               ((-) simply-scheme:-)
               ((<) simply-scheme:<)
               ((null?) null?)
               ((symbol?) symbol?)
               ((eq?) eq?)
               ((car) car)
               ((not) not)
               ((symbol->string) symbol->string)
               ((string=?) string=?)
               ((cdr) cdr)
               ((equal?) simply-scheme:equal?)
               ((word->string) word->string)
               ((string-length) string-length)
               ((whoops) whoops)
               ((string-ref) string-ref)
               ((char=?) char=?)
               ((list?) list?)
               ((number?) simply-scheme:number?)
               ((empty?) empty?)
               ((word?) word?)
               ((string?) string?))
    (letrec-values (((symbol-in-list?)
                     (lambda (symbol string lst)
                       (if (null? lst)
                           (begin #f)
                           (let-values (((g174)
                                         (if (symbol? (car lst))
                                             (eq? symbol (car lst))
                                             #f)))
                             (if g174
                                 g174
                                 (if (string? (car lst))
                                     (begin
                                       (if (not string)
                                           (begin
                                             (symbol-in-list?
                                              symbol
                                              (symbol->string symbol)
                                              lst))
                                           (if (string=? string (car lst))
                                               (begin #t)
                                               (begin
                                                 (symbol-in-list?
                                                  symbol
                                                  string
                                                  (cdr lst))))))
                                     (begin
                                       (symbol-in-list?
                                        symbol
                                        string
                                        (cdr lst)))))))))
                    ((word-in-list?)
                     (lambda (wd lst)
                       (if (null? lst)
                           (begin #f)
                           (if (equal? wd (car lst))
                               (begin #t)
                               (begin (word-in-list? wd (cdr lst)))))))
                    ((word-in-word?)
                     (lambda (small big)
                       (let-values (((one-letter-str) (word->string small)))
                         (if (> (string-length one-letter-str) 1)
                             (whoops "Invalid arguments to MEMBER?: " small big)
                             (let-values (((big-str) (word->string big)))
                               (char-in-string?
                                (string-ref one-letter-str 0)
                                big-str
                                (- (string-length big-str) 1)))))))
                    ((char-in-string?)
                     (lambda (char string i)
                       (if (< i 0)
                           (begin #f)
                           (if (char=? char (string-ref string i))
                               (begin #t)
                               (begin (char-in-string? char string (- i 1))))))))
      (lambda (x stuff)
        (if (empty? stuff)
            (begin #f)
            (if (word? stuff)
                (begin (word-in-word? x stuff))
                (if (not (list? stuff))
                    (begin (whoops "Invalid second argument to MEMBER?: " stuff))
                    (if (symbol? x)
                        (begin (symbol-in-list? x #f stuff))
                        (if (let-values (((or-part) (number? x)))
                              (if or-part or-part (string? x)))
                            (begin (word-in-list? x stuff))
                            (begin
                              (whoops "Invalid first argument to MEMBER?: " x)))))))))))

(define-values
  (before?)
  (let-values (((not) not)
               ((word?) word?)
               ((whoops) whoops)
               ((string<?) string<?)
               ((word->string) word->string))
    (lambda (wd1 wd2)
      (if (not (word? wd1))
          (begin (whoops "Invalid first argument to BEFORE? (not a word): " wd1))
          (if (not (word? wd2))
              (begin
                (whoops "Invalid second argument to BEFORE? (not a word): " wd2))
              (begin (string<? (word->string wd1) (word->string wd2))))))))

(define-values
  (filter)
  (let-values (((null?) null?)
               ((car) car)
               ((cons) cons)
               ((cdr) cdr)
               ((not) not)
               ((procedure?) procedure?)
               ((whoops) whoops)
               ((list?) list?))
    (lambda (pred l)
      (letrec-values (((real-filter)
                       (lambda (l)
                         (if (null? l)
                             (begin '())
                             (if (pred (car l))
                                 (begin (cons (car l) (real-filter (cdr l))))
                                 (begin (real-filter (cdr l))))))))
        (if (not (procedure? pred))
            (begin
              (whoops
               "Invalid first argument to FILTER (not a procedure): "
               pred))
            (if (not (list? l))
                (begin
                  (whoops "Invalid second argument to FILTER (not a list): " l))
                (begin (real-filter l))))))))

(define-values
  (keep)
  (let-values (((+) simply-scheme:+)
               ((=) simply-scheme:=)
               ((pair?) pair?)
               ((substring) substring)
               ((char->word) char->word)
               ((string-ref) string-ref)
               ((string-set!) string-set!)
               ((word->string) word->string)
               ((string-length) string-length)
               ((string->word) string->word)
               ((make-string) make-string)
               ((procedure?) procedure?)
               ((whoops) whoops)
               ((word?) word?)
               ((null?) null?))
    (lambda (pred w-or-s)
      (letrec-values (((keep-string)
                       (lambda (in i out out-len len)
                         (if (= i len)
                             (begin (substring out 0 out-len))
                             (if (pred (char->word (string-ref in i)))
                                 (begin
                                   (string-set! out out-len (string-ref in i))
                                   (keep-string in (+ i 1) out (+ out-len 1) len))
                                 (begin
                                   (keep-string in (+ i 1) out out-len len))))))
                      ((keep-word)
                       (lambda (wd)
                         (let-values (((string) (word->string wd)))
                           (let-values (((len) (string-length string)))
                             (string->word
                              (keep-string
                               string
                               0
                               (make-string len)
                               0
                               len)))))))
        (if (not (procedure? pred))
            (begin
              (whoops "Invalid first argument to KEEP (not a procedure): " pred))
            (if (pair? w-or-s)
                (begin (filter pred w-or-s))
                (if (word? w-or-s)
                    (begin (keep-word w-or-s))
                    (if (null? w-or-s)
                        (begin '())
                        (begin
                          (whoops
                           "Bad second argument to KEEP (not a word or sentence): "
                           w-or-s))))))))))

(define-values
  (appearances)
  (let-values (((count) count) ((keep) keep) ((equal?) simply-scheme:equal?))
    (lambda (item aggregate)
      (count (keep (lambda (element) (equal? item element)) aggregate)))))

(define-values
  (every)
  (let-values (((=) simply-scheme:=)
               ((+) simply-scheme:+)
               ((se) se)
               ((char->word) char->word)
               ((string-ref) string-ref)
               ((empty?) empty?)
               ((first) first)
               ((bf) bf)
               ((not) not)
               ((procedure?) procedure?)
               ((whoops) whoops)
               ((word?) word?)
               ((word->string) word->string)
               ((string-length) string-length))
    (lambda (fn stuff)
      (letrec-values (((string-every)
                       (lambda (string i length)
                         (if (= i length)
                             '()
                             (se
                              (fn (char->word (string-ref string i)))
                              (string-every string (+ i 1) length)))))
                      ((sent-every)
                       (lambda (sent)
                         (if (empty? sent)
                             sent
                             (se (fn (first sent)) (sent-every (bf sent)))))))
        (if (not (procedure? fn))
            (begin
              (whoops "Invalid first argument to EVERY (not a procedure):" fn))
            (if (word? stuff)
                (begin
                  (let-values (((string) (word->string stuff)))
                    (string-every string 0 (string-length string))))
                (begin (sent-every stuff))))))))

(define-values
  (accumulate)
  (let-values (((not) not)
               ((empty?) empty?)
               ((bf) bf)
               ((first) first)
               ((procedure?) procedure?)
               ((whoops) whoops)
               ((member) member)
               ((list) list))
    (lambda (combiner stuff)
      (letrec-values (((real-accumulate)
                       (lambda (stuff)
                         (if (empty? (bf stuff))
                             (first stuff)
                             (combiner
                              (first stuff)
                              (real-accumulate (bf stuff)))))))
        (if (not (procedure? combiner))
            (begin
              (whoops
               "Invalid first argument to ACCUMULATE (not a procedure):"
               combiner))
            (if (not (empty? stuff))
                (begin (real-accumulate stuff))
                (if (member
                     combiner
                     (list simply-scheme:+ simply-scheme:* word se))
                    (begin (combiner))
                    (begin
                      (whoops
                       "Can't accumulate empty input with that combiner")))))))))

(define-values
  (reduce)
  (let-values (((null?) null?)
               ((cdr) cdr)
               ((car) car)
               ((not) not)
               ((procedure?) procedure?)
               ((whoops) whoops)
               ((member) member)
               ((list) list))
    (lambda (combiner stuff)
      (letrec-values (((real-reduce)
                       (lambda (stuff)
                         (if (null? (cdr stuff))
                             (car stuff)
                             (combiner (car stuff) (real-reduce (cdr stuff)))))))
        (if (not (procedure? combiner))
            (begin
              (whoops
               "Invalid first argument to REDUCE (not a procedure):"
               combiner))
            (if (not (null? stuff))
                (begin (real-reduce stuff))
                (if (member
                     combiner
                     (list simply-scheme:+ simply-scheme:* word se append))
                    (begin (combiner))
                    (begin
                      (whoops "Can't reduce empty input with that combiner")))))))))

(define-values
  (repeated)
  (let-values (((=) simply-scheme:=) ((-) simply-scheme:-))
    (lambda (fn number)
      (if (= number 0)
          (lambda (x) x)
          (lambda (x) ((repeated fn (- number 1)) (fn x)))))))

(define-values (make-node) cons)

(define-values (datum) car)

(define-values (children) cdr)

(define-values
  (show)
  (let-values (((=) simply-scheme:=)
               ((length) length)
               ((display) display)
               ((car) car)
               ((newline) newline)
               ((not) not)
               #;((output-port?) output-port?)
               ((apply) apply)
               ((whoops) whoops))
    (lambda args
      (if (= (length args) 1)
          (begin (display (car args)) (newline))
          (if (= (length args) 2)
              (begin
                #;(if (not (output-port? (car (cdr args))))
                    (whoops
                     "Invalid second argument to SHOW (not an output port): "
                     (car (cdr args)))
                    (void))
                (apply display args)
                (newline (car (cdr args))))
              (begin
                (whoops "Incorrect number of arguments to procedure SHOW")))))))

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

#;(set! simply-scheme:read-string
      (let-values (((read-char) read-char)
                   ((eqv?) eqv?)
                   ((apply) apply)
                   ((string-append) string-append)
                   ((substring) substring)
                   ((reverse) reverse)
                   ((cons) cons)
                   ((>=) simply-scheme:>=)
                   ((+) simply-scheme:+)
                   ((string-set!) string-set!)
                   ((length) length)
                   ((whoops) whoops)
                   ((null?) null?)
                   ((current-input-port) current-input-port)
                   ((car) car)
                   ((cdr) cdr)
                   ((eof-object?) eof-object?)
                   ((list) list)
                   ((make-string) make-string)
                   ((peek-char) peek-char))
        (letrec-values (((read-string-helper)
                         (lambda (chars all-length chunk-length port)
                           (let-values (((char) (read-char port))
                                        ((string) (car chars)))
                             (if (let-values (((or-part) (eof-object? char)))
                                   (if or-part or-part (eqv? char #\newline)))
                                 (begin
                                   (apply
                                    string-append
                                    (reverse
                                     (cons
                                      (substring (car chars) 0 chunk-length)
                                      (cdr chars)))))
                                 (if (>= chunk-length 80)
                                     (begin
                                       (let-values (((newstring) (make-string 80)))
                                         (string-set! newstring 0 char)
                                         (read-string-helper
                                          (cons newstring chars)
                                          (+ all-length 1)
                                          1
                                          port)))
                                     (begin
                                       (string-set! string chunk-length char)
                                       (read-string-helper
                                        chars
                                        (+ all-length 1)
                                        (+ chunk-length 1)
                                        port))))))))
          (lambda args
            (if (>= (length args) 2)
                (whoops "Too many arguments to read-string")
                (let-values (((port)
                              (if (null? args) (current-input-port) (car args))))
                  (if (eof-object? (peek-char port))
                      (read-char port)
                      (read-string-helper (list (make-string 80)) 0 0 port))))))))

#;(set! simply-scheme:read-line
      (let-values (((=) simply-scheme:=)
                   ((list) list)
                   ((string->word) string->word)
                   ((substring) substring)
                   ((char-whitespace?) char-whitespace?)
                   ((string-ref) string-ref)
                   ((+) simply-scheme:+)
                   ((string-length) string-length)
                   ((apply) apply)
                   ((read-string) simply-scheme:read-string))
        (lambda args
          (letrec-values (((tokenize)
                           (lambda (string)
                             (letrec-values (((helper)
                                              (lambda (i start len)
                                                (if (= i len)
                                                    (begin
                                                      (if (= i start)
                                                          '()
                                                          (list
                                                           (string->word
                                                            (substring
                                                             string
                                                             start
                                                             i)))))
                                                    (if (char-whitespace?
                                                         (string-ref string i))
                                                        (begin
                                                          (if (= i start)
                                                              (helper
                                                               (+ i 1)
                                                               (+ i 1)
                                                               len)
                                                              (cons
                                                               (string->word
                                                                (substring
                                                                 string
                                                                 start
                                                                 i))
                                                               (helper
                                                                (+ i 1)
                                                                (+ i 1)
                                                                len))))
                                                        (begin
                                                          (helper
                                                           (+ i 1)
                                                           start
                                                           len)))))))
                               (if (eof-object? string)
                                   string
                                   (helper 0 0 (string-length string)))))))
            (tokenize (apply read-string args))))))

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

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

(define-values
  (align)
  (let-values (((<) simply-scheme:<)
               ((abs) simply-scheme:abs)
               ((*) simply-scheme:*)
               ((expt) simply-scheme:expt)
               ((>=) simply-scheme:>=)
               ((-) simply-scheme:-)
               ((+) simply-scheme:+)
               ((=) simply-scheme:=)
               ((null?) null?)
               ((car) car)
               ((round) simply-scheme:round)
               ((number->string) simply-scheme:number->string)
               ((string-length) string-length)
               ((string-append) string-append)
               ((make-string) make-string)
               ((substring) substring)
               ((string-set!) string-set!)
               ((number?) simply-scheme:number?)
               ((word->string) word->string))
    (lambda (obj width . rest)
      (letrec-values (((align-number)
                       (lambda (obj width rest)
                         (let-values (((sign) (< obj 0)))
                           (let-values (((num) (abs obj)))
                             (let-values (((prec)
                                           (if (null? rest) 0 (car rest))))
                               (let-values (((big)
                                             (round (* num (expt 10 prec)))))
                                 (let-values (((cvt0) (number->string big)))
                                   (let-values (((cvt)
                                                 (if (< num 1)
                                                     (string-append "0" cvt0)
                                                     cvt0)))
                                     (let-values (((pos-str)
                                                   (if (>=
                                                        (string-length cvt0)
                                                        prec)
                                                       cvt
                                                       (string-append
                                                        (make-string
                                                         (-
                                                          prec
                                                          (string-length cvt0))
                                                         #\0)
                                                        cvt))))
                                       (let-values (((string)
                                                     (if sign
                                                         (string-append
                                                          "-"
                                                          pos-str)
                                                         pos-str)))
                                         (let-values (((length)
                                                       (+
                                                        (string-length string)
                                                        (if (= prec 0) 0 1))))
                                           (let-values (((left)
                                                         (-
                                                          length
                                                          (+ 1 prec))))
                                             (let-values (((result)
                                                           (if (= prec 0)
                                                               string
                                                               (string-append
                                                                (substring
                                                                 string
                                                                 0
                                                                 left)
                                                                "."
                                                                (substring
                                                                 string
                                                                 left
                                                                 (-
                                                                  length
                                                                  1))))))
                                               (if (= length width)
                                                   (begin result)
                                                   (if (< length width)
                                                       (begin
                                                         (string-append
                                                          (make-string
                                                           (- width length)
                                                           #\space)
                                                          result))
                                                       (begin
                                                         (let-values (((new)
                                                                       (substring
                                                                        result
                                                                        0
                                                                        width)))
                                                           (string-set!
                                                            new
                                                            (- width 1)
                                                            #\+)
                                                           new)))))))))))))))))
                      ((align-word)
                       (lambda (string)
                         (let-values (((length) (string-length string)))
                           (if (= length width)
                               (begin string)
                               (if (< length width)
                                   (begin
                                     (string-append
                                      string
                                      (make-string (- width length) #\space)))
                                   (begin
                                     (let-values (((new)
                                                   (substring string 0 width)))
                                       (string-set! new (- width 1) #\+)
                                       new))))))))
        (if (number? obj)
            (align-number obj width rest)
            (align-word (word->string obj)))))))

#;(set! simply-scheme:open-output-file
      (let-values (((oof) simply-scheme:open-output-file) ((cons) cons))
        (lambda (filename)
          (let-values (((port) (oof filename)))
            (set! *the-open-outports*
                  (#%app cons port (#%top . *the-open-outports*)))
            port))))

#;(set! simply-scheme:open-input-file
      (let-values (((oif) simply-scheme:open-input-file) ((cons) cons))
        (lambda (filename)
          (let-values (((port) (oif filename)))
            (set! *the-open-inports*
                  (#%app cons port (#%top . *the-open-inports*)))
            port))))

(define-values
  (remove)
  (let-values (((null?) null?)
               ((cdr) cdr)
               ((eq?) eq?)
               ((car) car))
    (lambda (thing lst)
      (letrec-values (((r)
                       (lambda (prev)
                         (if (null? (cdr prev))
                             (begin lst)
                             (if (eq? thing (car (cdr prev)))
                                 (begin (cons (car prev)
                                              (cdr (cdr prev))))
                                 (begin (cons (car prev)
                                              (r (cdr prev)))))))))
        (if (null? lst)
            (begin lst)
            (if (eq? thing (car lst)) 
                (begin (cdr lst))
                (begin (r lst))))))))

#;(set! simply-scheme:close-input-port
      (let-values (((cip) simply-scheme:close-input-port) ((remove) remove))
        (lambda (port)
          (set! *the-open-inports*
                (#%app remove port (#%top . *the-open-inports*)))
          (cip port))))

#;(set! simply-scheme:close-output-port
      (let-values (((cop) simply-scheme:close-output-port) ((remove) remove))
        (lambda (port)
          (set! *the-open-outports*
                (#%app remove port (#%top . *the-open-outports*)))
          (cop port))))

#;(define-values
  (close-all-ports)
  (let-values (((for-each) for-each)
               ((close-input-port) simply-scheme:close-input-port)
               ((close-output-port) simply-scheme:close-output-port))
    (lambda ()
      (for-each close-input-port *the-open-inports*)
      (for-each close-output-port *the-open-outports*)
      'closed)))

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

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

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

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

(define-values
  (strings-are-numbers)
  (let-values (((are-they?) #f)
               ((real-*) simply-scheme:*)
               ((real-+) simply-scheme:+)
               ((real--) simply-scheme:-)
               ((real-/) simply-scheme:/)
               ((real-<) simply-scheme:<)
               ((real-<=) simply-scheme:<=)
               ((real-=) simply-scheme:=)
               ((real->) simply-scheme:>)
               ((real->=) simply-scheme:>=)
               ((real-abs) simply-scheme:abs)
               ((real-acos) simply-scheme:acos)
               ((real-asin) simply-scheme:asin)
               ((real-atan) simply-scheme:atan)
               ((real-ceiling) simply-scheme:ceiling)
               ((real-cos) simply-scheme:cos)
               ((real-even?) simply-scheme:even?)
               ((real-exp) simply-scheme:exp)
               ((real-expt) simply-scheme:expt)
               ((real-floor) simply-scheme:floor)
               ((real-align) align)
               ((real-gcd) simply-scheme:gcd)
               ((real-integer?) simply-scheme:integer?)
               ((real-item) item)
               ((real-lcm) simply-scheme:lcm)
               ((real-list-ref) simply-scheme:list-ref)
               ((real-log) simply-scheme:log)
               ((real-make-vector) simply-scheme:make-vector)
               ((real-max) simply-scheme:max)
               ((real-min) simply-scheme:min)
               ((real-modulo) simply-scheme:modulo)
               ((real-negative?) simply-scheme:negative?)
               ((real-number?) simply-scheme:number?)
               ((real-odd?) simply-scheme:odd?)
               ((real-positive?) simply-scheme:positive?)
               ((real-quotient) simply-scheme:quotient)
               ((real-random) simply-scheme:random)
               ((real-remainder) simply-scheme:remainder)
               ((real-repeated) repeated)
               ((real-round) simply-scheme:round)
               ((real-sin) simply-scheme:sin)
               ((real-sqrt) simply-scheme:sqrt)
               ((real-tan) simply-scheme:tan)
               ((real-truncate) simply-scheme:truncate)
               ((real-vector-ref) simply-scheme:vector-ref)
               ((real-vector-set!) simply-scheme:vector-set!)
               ((real-zero?) simply-scheme:zero?)
               ((maybe-num) maybe-num)
               ((number->string) simply-scheme:number->string)
               ((cons) cons)
               ((car) car)
               ((cdr) cdr)
               ((eq?) eq?)
               ((show) show)
               ((logoize) logoize)
               ((logoize-1) logoize-1)
               ((logoize-2) logoize-2)
               ((not) not)
               ((whoops) whoops))
    (lambda (yesno)
      (if (if are-they? (eq? yesno #t) #f)
          (begin (show "Strings are already numbers"))
          (if (eq? yesno #t)
              (begin
                (set! are-they? (#%datum . #t))
                (set! simply-scheme:* (logoize real-*))
                (set! simply-scheme:+ (logoize real-+))
                (set! simply-scheme:- (logoize real--))
                (set! simply-scheme:/ (logoize real-/))
                (set! simply-scheme:< (logoize real-<))
                (set! simply-scheme:<= (logoize real-<=))
                (set! simply-scheme:= (logoize real-=))
                (set! simply-scheme:> (logoize real->))
                (set! simply-scheme:>= (logoize real->=))
                (set! simply-scheme:abs (logoize-1 real-abs))
                (set! simply-scheme:acos (logoize-1 real-acos))
                (set! simply-scheme:asin (logoize-1 real-asin))
                (set! simply-scheme:atan (logoize real-atan))
                (set! simply-scheme:ceiling (logoize-1 real-ceiling))
                (set! simply-scheme:cos (logoize-1 real-cos))
                (set! simply-scheme:even? (logoize-1 real-even?))
                (set! simply-scheme:exp (logoize-1 real-exp))
                (set! simply-scheme:expt (logoize-2 real-expt))
                (set! simply-scheme:floor (logoize-1 real-floor))
                (set! align (#%app logoize (#%top . align)))
                (set! simply-scheme:gcd (logoize real-gcd))
                (set! simply-scheme:integer? (logoize-1 real-integer?))
                (set! item
                      (lambda (n stuff) (#%app real-item (#%app maybe-num n) stuff)))
                (set! simply-scheme:lcm (logoize real-lcm))
                (set! simply-scheme:list-ref
                      (lambda (lst k) (real-list-ref lst (maybe-num k))))
                (set! simply-scheme:log (logoize-1 real-log))
                (set! simply-scheme:max (logoize real-max))
                (set! simply-scheme:min (logoize real-min))
                (set! simply-scheme:modulo (logoize-2 real-modulo))
                (set! simply-scheme:negative? (logoize-1 real-negative?))
                (set! simply-scheme:number? (logoize-1 real-number?))
                (set! simply-scheme:odd? (logoize-1 real-odd?))
                (set! simply-scheme:positive? (logoize-1 real-positive?))
                (set! simply-scheme:quotient (logoize-2 real-quotient))
                (set! simply-scheme:random (logoize real-random))
                (set! simply-scheme:remainder (logoize-2 real-remainder))
                (set! simply-scheme:round (logoize-1 real-round))
                (set! simply-scheme:sin (logoize-1 real-sin))
                (set! simply-scheme:sqrt (logoize-1 real-sqrt))
                (set! simply-scheme:tan (logoize-1 real-tan))
                (set! simply-scheme:truncate (logoize-1 real-truncate))
                (set! simply-scheme:zero? (logoize-1 real-zero?))
                (set! simply-scheme:vector-ref
                      (lambda (vec i) (real-vector-ref vec (maybe-num i))))
                (set! simply-scheme:vector-set!
                      (lambda (vec i val) (real-vector-set! vec (maybe-num i) val)))
                (set! simply-scheme:make-vector
                      (lambda (num . args)
                        (apply real-make-vector (cons (maybe-num num) args))))
                (set! simply-scheme:list-ref
                      (lambda (lst i) (real-list-ref lst (maybe-num i))))
                (set! repeated
                      (lambda (fn n) (#%app real-repeated fn (#%app maybe-num n)))))
              (if (if (not are-they?) (not yesno) #f)
                  (begin (show "Strings are already not numbers"))
                  (if (not yesno)
                      (begin
                        (set! are-they? (#%datum . #f))
                        (set! simply-scheme:* real-*)
                        (set! simply-scheme:+ real-+)
                        (set! simply-scheme:- real--)
                        (set! simply-scheme:/ real-/)
                        (set! simply-scheme:< real-<)
                        (set! simply-scheme:<= real-<=)
                        (set! simply-scheme:= real-=)
                        (set! simply-scheme:> real->)
                        (set! simply-scheme:>= real->=)
                        (set! simply-scheme:abs real-abs)
                        (set! simply-scheme:acos real-acos)
                        (set! simply-scheme:asin real-asin)
                        (set! simply-scheme:atan real-atan)
                        (set! simply-scheme:ceiling real-ceiling)
                        (set! simply-scheme:cos real-cos)
                        (set! simply-scheme:even? real-even?)
                        (set! simply-scheme:exp real-exp)
                        (set! simply-scheme:expt real-expt)
                        (set! simply-scheme:floor real-floor)
                        (set! align real-align)
                        (set! simply-scheme:gcd real-gcd)
                        (set! simply-scheme:integer? real-integer?)
                        (set! item real-item)
                        (set! simply-scheme:lcm real-lcm)
                        (set! simply-scheme:list-ref real-list-ref)
                        (set! simply-scheme:log real-log)
                        (set! simply-scheme:max real-max)
                        (set! simply-scheme:min real-min)
                        (set! simply-scheme:modulo real-modulo)
                        (set! simply-scheme:odd? real-odd?)
                        (set! simply-scheme:quotient real-quotient)
                        (set! simply-scheme:random real-random)
                        (set! simply-scheme:remainder real-remainder)
                        (set! simply-scheme:round real-round)
                        (set! simply-scheme:sin real-sin)
                        (set! simply-scheme:sqrt real-sqrt)
                        (set! simply-scheme:tan real-tan)
                        (set! simply-scheme:truncate real-truncate)
                        (set! simply-scheme:zero? real-zero?)
                        (set! simply-scheme:positive? real-positive?)
                        (set! simply-scheme:negative? real-negative?)
                        (set! simply-scheme:number? real-number?)
                        (set! simply-scheme:vector-ref real-vector-ref)
                        (set! simply-scheme:vector-set! real-vector-set!)
                        (set! simply-scheme:make-vector real-make-vector)
                        (set! simply-scheme:list-ref real-list-ref)
                        (set! item real-item)
                        (set! repeated real-repeated))
                      (begin (whoops "Strings-are-numbers: give a #t or a #f"))))))
      are-they?)))

(void (strings-are-numbers #t))
(require (for-syntax racket/base)
         (prefix-in whalesong: whalesong/lang/base))

(provide (except-out 
          (filtered-out (lambda (name)
                          (and (regexp-match? #rx"^whalesong:" name)
                               (regexp-replace #rx"^whalesong:" name "")))
                        (all-from-out whalesong/lang/base))
          whalesong:*
          whalesong:+
          whalesong:-
          whalesong:/
          whalesong:<
          whalesong:<=
          whalesong:=
          whalesong:>
          whalesong:>=
          whalesong:abs
          whalesong:acos
          whalesong:asin
          whalesong:atan
          whalesong:ceiling
          whalesong:count
          #;close-input-port
          #;close-output-port
          whalesong:cos
          whalesong:equal?
          whalesong:even?
          whalesong:exp
          whalesong:expt
          whalesong:floor
          whalesong:gcd
          whalesong:integer?
          whalesong:lcm
          whalesong:list-ref
          whalesong:log
          whalesong:make-vector
          whalesong:max
          whalesong:min
          whalesong:modulo
          whalesong:negative?
          whalesong:number->string
          whalesong:number?
          whalesong:odd?
          #;open-input-file
          #;open-output-file
          whalesong:positive?
          whalesong:quotient
          whalesong:random
          #;read-line
          #;read-string
          whalesong:remainder
          whalesong:round
          whalesong:sin
          whalesong:sqrt
          whalesong:tan
          whalesong:truncate
          whalesong:vector-ref
          whalesong:vector-set!
          whalesong:zero?)
         


         *the-open-inports*
         *the-open-outports*

         
         ;; The rest of these are the bindings that are defined
         ;; in this language module.
         accumulate
         align
         appearances
         before?
         bf
         bl
         butfirst
         butlast
         char->word
         char-rank
         children

         #;close-all-ports
         count
#|                  
         datum
         empty?
         every
         filter
         first
         item
         keep
         last
         logoize
         logoize-1
         logoize-2
         make-node
         maybe-num
         member?
         reduce
         remove
         repeated
         se
         sentence
         sentence?
         show
         show-line
         string->word
         strings-are-numbers
         whoops
         word
         word->string
         word?
|#       
         (rename-out [simply-scheme:* *]
                     [simply-scheme:+ +]
                     [simply-scheme:- -]
                     [simply-scheme:/ /]
                     [simply-scheme:< <]
                     [simply-scheme:<= <=]
                     [simply-scheme:= =]
                     [simply-scheme:> >]
                     [simply-scheme:>= >=]
                     [simply-scheme:abs abs]
                     [simply-scheme:acos acos]
                     [simply-scheme:asin asin]
                     [simply-scheme:atan atan]
                     [simply-scheme:ceiling ceiling]
                     #;[simply-scheme:close-input-port close-input-port]
                     #;[simply-scheme:close-output-port close-output-port]
                     [simply-scheme:cos cos]
                     [simply-scheme:equal? equal?]
                     [simply-scheme:even? even?]
                     [simply-scheme:exp exp]
                     [simply-scheme:expt expt]
                     [simply-scheme:floor floor]
                     [simply-scheme:gcd gcd]
                     [simply-scheme:integer? integer?]
                     [simply-scheme:lcm lcm]
                     [simply-scheme:list-ref list-ref]
                     [simply-scheme:log log]
                     [simply-scheme:make-vector make-vector]
                     [simply-scheme:max max]
                     [simply-scheme:min min]
                     [simply-scheme:modulo modulo]
                     [simply-scheme:negative? negative?]
                     [simply-scheme:number->string number->string]
                     [simply-scheme:number? number?]
                     [simply-scheme:odd? odd?]
                     #;[simply-scheme:open-input-file open-input-file]
                     #;[simply-scheme:open-output-file open-output-file]
                     [simply-scheme:positive? positive?]
                     [simply-scheme:quotient quotient]
                     [simply-scheme:random random]
                     #;[simply-scheme:read-line read-line]
                     #;[simply-scheme:read-string read-string]
                     [simply-scheme:remainder remainder]
                     [simply-scheme:round round]
                     [simply-scheme:sin sin]
                     [simply-scheme:sqrt sqrt]
                     [simply-scheme:tan tan]
                     [simply-scheme:truncate truncate]
                     [simply-scheme:vector-ref vector-ref]
                     [simply-scheme:vector-set! vector-set!]
                     [simply-scheme:zero? zero?]))