linker.scm 1010 B

1234567891011121314151617181920212223242526272829303132333435
  1. ; Copyright (c) 1993-2008 by Richard Kelsey and Jonathan Rees. See file COPYING.
  2. (define (link-simple-system filename resumer-exp . structs)
  3. (link-system structs (lambda () resumer-exp) filename))
  4. (define (link-reified-system some filename make-resumer-exp . structs)
  5. (link-system (append structs (map cdr some))
  6. (lambda ()
  7. (display "Reifying") (newline)
  8. `(,make-resumer-exp
  9. (lambda ()
  10. ,(reify-structures some
  11. (lambda (loc) loc)
  12. `(lambda (loc) loc)))))
  13. filename))
  14. (define (link-system structs make-resumer filename)
  15. (for-each ensure-loaded structs)
  16. (let* ((p (make-simple-package structs eval #f))
  17. (r (eval (make-resumer) p)))
  18. ;; (check-package p)
  19. r))
  20. ;(define (check-package p)
  21. ; (let ((names (undefined-variables p)))
  22. ; (if (not (null? names))
  23. ; (begin (display "Undefined: ")
  24. ; (write names) (newline)))))
  25. (define-syntax struct-list
  26. (syntax-rules ()
  27. ((struct-list name ...) (list (cons 'name name) ...))))