* 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
#;(import (except (ikarus) assembler-output)
(import (except (ikarus) assembler-output)
(ikarus compiler)
(except (ikarus system $bootstrap)
eval-core
current-primitive-locations
compile-core-expr-to-port))
(import (ikarus) (ikarus system $bootstrap))
;(import (ikarus) (ikarus system $bootstrap))
(define scheme-library-files
;;; Listed in the order in which they're loaded.
@ -131,6 +131,18 @@
[$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 i r]
[define-syntax i r]
@ -787,18 +799,21 @@
(lambda ()
(let-values ([(core* locs)
(time-it "macro expansion"
(lambda () (expand-all scheme-library-files)))])
(parameterize ([current-primitive-locations
(lambda (x)
(cond
[(assq x locs) => cdr]
[else
(error 'bootstrap "no location for ~s" x)]))])
(lambda ()
(parameterize ([current-library-collection
bootstrap-collection])
(expand-all scheme-library-files))))])
(current-primitive-locations
(lambda (x)
(cond
[(assq x locs) => cdr]
[else
(error 'bootstrap "no location for ~s" x)])))
(let ([p (open-output-file "ikarus.boot" 'replace)])
(for-each
(lambda (x) (compile-core-expr-to-port x p))
core*)
(close-output-port p))))))
(close-output-port p)))))
(printf "Happy Happy Joy Joy\n")