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