home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / xschm22 / xscheme.ini next >
Encoding:
Text File  |  1990-04-18  |  1.7 KB  |  74 lines
  1. ; xscheme.ini - initialization code for XScheme version 0.16
  2. ; Actually, version 0.22 (BCB, 4-7-90)
  3.  
  4. (load "macros.s")
  5. (load "qquote.s")
  6.  
  7. ; this version of EVAL knows about the optional enviroment parameter
  8. (define (eval x #!optional env)
  9.   ((if (default-object? env)
  10.      (compile x)
  11.      (compile x env))))
  12.  
  13. (define old-apply apply)
  14. (define (apply f . args)
  15.   (old-apply f (old-apply list* args)))
  16.  
  17. (define (autoload-from-file file syms #!optional env)
  18.   (map (lambda (sym) (put sym '%autoload file)) syms)
  19.   '())
  20.   
  21. (define (*unbound-handler* sym cont)
  22.   (let ((file (get sym '%autoload)))
  23.     (if file (load file))
  24.     (if (not (bound? sym))
  25.       (error "unbound variable" sym))
  26.     (cont '())))
  27.  
  28. (define head car)
  29. (define (tail x) (force (cdr x)))
  30. (define empty-stream? null?)
  31. (define the-empty-stream '())
  32.  
  33. (macro cons-stream
  34.   (lambda (x)
  35.     (list 'cons (cadr x) (list 'delay (caddr x)))))
  36.  
  37. (macro make-environment
  38.   (lambda (x)
  39.     (append '(let ()) (cdr x) '((the-environment)))))
  40.  
  41. (define initial-user-environment (the-environment))
  42.  
  43. (macro case
  44.   (lambda (form)
  45.     (let ((test (cadr form))
  46.           (sym (gensym)))
  47.       `(let ((,sym ,test))
  48.          (cond ,@(map (lambda (x)
  49.                         (cond ((eq? (car x) 'else)
  50.                                x)
  51.                   ((atom? (car x))
  52.                    `((eqv? ,sym ',(car x)) ,@(cdr x)))
  53.                   (else
  54.                                `((memv ,sym ',(car x)) ,@(cdr x)))))
  55.                       (cddr form)))))))
  56.  
  57. ; load the files mentioned on the command line
  58. (define (loader n)
  59.   (let ((arg (getarg n)))
  60.     (if arg
  61.       (begin
  62.         (display ";Loading ")
  63.         (write arg)
  64.         (newline)
  65.         (load arg)
  66.         (loader (1+ n))))))
  67. (loader 1)
  68.  
  69. ; (trace-on)
  70.  
  71. (define (*initialize*)
  72.   (loader 1)
  73.   (*toplevel*))
  74.