* build-system-library in makefile now constructs a proper

current-primitive-locations procedure.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-04 06:14:20 -04:00
parent 75bfaf49a0
commit 0700cdc1cb
2 changed files with 6 additions and 3 deletions

Binary file not shown.

View File

@ -125,14 +125,17 @@
[(null? r) '()] [(null? r) '()]
[else (add (car r) (f (cdr r)))]))) [else (add (car r) (f (cdr r)))])))
(define (build-system-library export-subst export-env) (define (build-system-library export-subst export-env primlocs)
(let-values ([(code empty-subst empty-env) (let-values ([(code empty-subst empty-env)
(boot-library-expand (boot-library-expand
`(library (ikarus primlocs) `(library (ikarus primlocs)
(export) ;;; must be empty (export) ;;; must be empty
(import (scheme)) (import (scheme))
(current-primitive-locations (current-primitive-locations
(lambda (x) #f)) (lambda (x)
(cond
[(assq x ',primlocs) => cdr]
[else #f])))
(install-library (install-library
',(gensym "system") ;;; id ',(gensym "system") ;;; id
'(system) ;;; name '(system) ;;; name
@ -163,7 +166,7 @@
(set! env (append export-env env)))))) (set! env (append export-env env))))))
files) files)
(let ([env (sanitize-export-env subst env)]) (let ([env (sanitize-export-env subst env)])
(let ([code (build-system-library subst env)]) (let ([code (build-system-library subst env '())])
(values (values
(reverse (list* (car code*) code (cdr code*))) (reverse (list* (car code*) code (cdr code*)))
subst env))))) subst env)))))