conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* makefile.ss is turned into an r6rs-script.

This commit is contained in:
Abdulaziz Ghuloum 2007-05-09 07:49:04 -04:00
parent 35a9aa6d20
commit 48244ec85e
2 changed files with 682 additions and 687 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

37
src/makefile.ss
View File

@ -1,12 +1,8 @@
#!/usr/bin/env ikarus -b ikarus.boot --script #!/usr/bin/env ikarus -b ikarus.boot --r6rs-script
(library (ikarus makefile) (import (ikarus system $bootstrap) (ikarus))
(export)
(import
(ikarus system $bootstrap)
(ikarus))
(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.
;;; ;;;
;;; Loading of the boot file may segfault if a library is ;;; Loading of the boot file may segfault if a library is
@ -65,7 +61,7 @@
"ikarus.timer.ss" "ikarus.timer.ss"
"ikarus.main.ss")) "ikarus.main.ss"))
(define ikarus-system-macros (define ikarus-system-macros
'([define (define)] '([define (define)]
[define-syntax (define-syntax)] [define-syntax (define-syntax)]
[module (module)] [module (module)]
@ -97,7 +93,7 @@
[and (macro . and)] [and (macro . and)]
[or (macro . or)])) [or (macro . or)]))
(define library-legend (define library-legend
'([i (ikarus) #t] '([i (ikarus) #t]
[r (r6rs) #t] [r (r6rs) #t]
[$all (ikarus system $all) #f] [$all (ikarus system $all) #f]
@ -119,7 +115,7 @@
[$boot (ikarus system $bootstrap) #f] [$boot (ikarus system $bootstrap) #f]
)) ))
(define ikarus-macros-map (define ikarus-macros-map
'([define i r] '([define i r]
[define-syntax i r] [define-syntax i r]
[module i ] [module i ]
@ -151,7 +147,7 @@
[and i r] [and i r]
[or i r])) [or i r]))
(define ikarus-procedures-map (define ikarus-procedures-map
'([void i] '([void i]
[not i] [not i]
[boolean? i] [boolean? i]
@ -553,7 +549,7 @@
[syntax-dispatch ] [syntax-dispatch ]
)) ))
(define (verify-map) (define (verify-map)
(define (f x) (define (f x)
(for-each (for-each
(lambda (x) (lambda (x)
@ -563,13 +559,13 @@
(for-each f ikarus-procedures-map) (for-each f ikarus-procedures-map)
(for-each f ikarus-macros-map)) (for-each f ikarus-macros-map))
(define (make-collection) (define (make-collection)
(let ([set '()]) (let ([set '()])
(case-lambda (case-lambda
[() set] [() set]
[(x) (set! set (cons x set))]))) [(x) (set! set (cons x set))])))
(define (make-system-data subst env) (define (make-system-data subst env)
(define who 'make-system-data) (define who 'make-system-data)
(let ([export-subst (make-collection)] (let ([export-subst (make-collection)]
[export-env (make-collection)] [export-env (make-collection)]
@ -609,7 +605,7 @@
(map car ikarus-procedures-map)) (map car ikarus-procedures-map))
(values (export-subst) (export-env) (export-primlocs)))) (values (export-subst) (export-env) (export-primlocs))))
(define (get-export-subset key subst) (define (get-export-subset key subst)
(let f ([ls subst]) (let f ([ls subst])
(cond (cond
[(null? ls) '()] [(null? ls) '()]
@ -629,7 +625,7 @@
;;; not going to any library? ;;; not going to any library?
(f (cdr ls))])))]))) (f (cdr ls))])))])))
(define (build-system-library export-subst export-env primlocs) (define (build-system-library export-subst export-env primlocs)
(define (build-library legend-entry) (define (build-library legend-entry)
(let ([key (car legend-entry)] (let ([key (car legend-entry)]
[name (cadr legend-entry)] [name (cadr legend-entry)]
@ -667,7 +663,7 @@
(boot-library-expand code)]) (boot-library-expand code)])
code))) code)))
(define (expand-all files) (define (expand-all files)
(let ([code* '()] (let ([code* '()]
[subst '()] [subst '()]
[env '()]) [env '()])
@ -689,9 +685,9 @@
(reverse (list* (car code*) code (cdr code*))) (reverse (list* (car code*) code (cdr code*)))
export-locs))))) export-locs)))))
(verify-map) (verify-map)
(time-it "the entire bootstrap process" (time-it "the entire bootstrap process"
(lambda () (lambda ()
(let-values ([(core* locs) (let-values ([(core* locs)
(time-it "macro expansion" (time-it "macro expansion"
@ -708,8 +704,7 @@
core*) core*)
(close-output-port p)))))) (close-output-port p))))))
(printf "Happy Happy Joy Joy\n")) (printf "Happy Happy Joy Joy\n")
(invoke (ikarus makefile))
;;; vim:syntax=scheme ;;; vim:syntax=scheme