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

Cut down bootstrap time by 10% by caching the values of scheme-stx. 

Macroexpansion time is reduced by 25%.
This commit is contained in:
Abdulaziz Ghuloum 2008-03-12 18:12:57 -04:00
parent 1943212436
commit a3f6e3e039
2 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/last-revision
View File

@ -1 +1 @@
1411 1412

29
scheme/psyntax.expander.ss
View File

@ -811,19 +811,26 @@
;;; (psyntax system $all) library, it creates a fresh identifier ;;; (psyntax system $all) library, it creates a fresh identifier
;;; that maps only the symbol to its label in that library. ;;; that maps only the symbol to its label in that library.
;;; Symbols not in that library become fresh. ;;; Symbols not in that library become fresh.
(define scheme-stx-hashtable (make-eq-hashtable))
(define scheme-stx (define scheme-stx
(lambda (sym) (lambda (sym)
(let ((subst (or (hashtable-ref scheme-stx-hashtable sym #f)
(library-subst (let* ((subst
(find-library-by-name '(psyntax system $all))))) (library-subst
(cond (find-library-by-name '(psyntax system $all))))
((assq sym subst) => (stx (mkstx sym top-mark* '() '()))
(lambda (x) (stx
(let ((name (car x)) (label (cdr x))) (cond
(add-subst ((assq sym subst) =>
(make-rib (list name) (list top-mark*) (list label) #f) (lambda (x)
(mkstx sym top-mark* '() '()))))) (let ((name (car x)) (label (cdr x)))
(else (mkstx sym top-mark* '() '())))))) (add-subst
(make-rib (list name)
(list top-mark*) (list label) #f)
stx))))
(else stx))))
(hashtable-set! scheme-stx-hashtable sym stx)
stx))))
;;; macros ;;; macros
(define lexical-var car) (define lexical-var car)