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