* build-system-library in makefile now constructs a proper
current-primitive-locations procedure.
This commit is contained in:
parent
75bfaf49a0
commit
0700cdc1cb
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -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)))))
|
||||||
|
|
Loading…
Reference in New Issue