* can now load fresh compiler

This commit is contained in:
Abdulaziz Ghuloum 2007-05-15 10:45:31 -04:00
parent 2b96460a77
commit 9ded62b5e5
2 changed files with 25 additions and 10 deletions

Binary file not shown.

View File

@ -1,14 +1,14 @@
#!/usr/bin/env ikarus -b ikarus.boot --r6rs-script #!/usr/bin/env ikarus -b ikarus.boot --r6rs-script
#;(import (except (ikarus) assembler-output) (import (except (ikarus) assembler-output)
(ikarus compiler) (ikarus compiler)
(except (ikarus system $bootstrap) (except (ikarus system $bootstrap)
eval-core eval-core
current-primitive-locations current-primitive-locations
compile-core-expr-to-port)) compile-core-expr-to-port))
(import (ikarus) (ikarus system $bootstrap)) ;(import (ikarus) (ikarus system $bootstrap))
(define scheme-library-files (define scheme-library-files
;;; Listed in the order in which they're loaded. ;;; Listed in the order in which they're loaded.
@ -131,6 +131,18 @@
[$boot (ikarus system $bootstrap) #f] [$boot (ikarus system $bootstrap) #f]
)) ))
(define bootstrap-collection
(let ([ls (map
(lambda (x)
(find-library-by-name (cadr x)))
library-legend)])
(case-lambda
[() ls]
[(x) (unless (memq x ls)
(set! ls (cons x ls)))])))
(define ikarus-macros-map (define ikarus-macros-map
'([define i r] '([define i r]
[define-syntax i r] [define-syntax i r]
@ -787,18 +799,21 @@
(lambda () (lambda ()
(let-values ([(core* locs) (let-values ([(core* locs)
(time-it "macro expansion" (time-it "macro expansion"
(lambda () (expand-all scheme-library-files)))]) (lambda ()
(parameterize ([current-primitive-locations (parameterize ([current-library-collection
(lambda (x) bootstrap-collection])
(cond (expand-all scheme-library-files))))])
[(assq x locs) => cdr] (current-primitive-locations
[else (lambda (x)
(error 'bootstrap "no location for ~s" x)]))]) (cond
[(assq x locs) => cdr]
[else
(error 'bootstrap "no location for ~s" x)])))
(let ([p (open-output-file "ikarus.boot" 'replace)]) (let ([p (open-output-file "ikarus.boot" 'replace)])
(for-each (for-each
(lambda (x) (compile-core-expr-to-port x p)) (lambda (x) (compile-core-expr-to-port x p))
core*) core*)
(close-output-port p)))))) (close-output-port p)))))
(printf "Happy Happy Joy Joy\n") (printf "Happy Happy Joy Joy\n")