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

* added a sealed/freq field to the rib record. The idea is to 

convert the rib data from lists to vectors once the rib is sealed
  (i.e. no more bindings will be added to it) and then sort it
  according to the frequency of references made to the individual
  bindings.
This commit is contained in:
Abdulaziz Ghuloum 2007-05-07 00:44:28 -04:00
parent c69f74fb05
commit de158ca4cd
2 changed files with 7 additions and 6 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.

13
src/ikarus.syntax.ss
View File

@ -84,21 +84,23 @@
[else (error 'gen-lexical "invalid arg ~s" sym)]))) [else (error 'gen-lexical "invalid arg ~s" sym)])))
(define gen-label (define gen-label
(lambda (_) (gensym))) (lambda (_) (gensym)))
(define-record rib (sym* mark** label*)) (define-record rib (sym* mark** label* sealed/freq))
(define make-full-rib (define make-full-rib
(lambda (id* label*) (lambda (id* label*)
(make-rib (map id->sym id*) (map stx-mark* id*) label*))) (make-rib (map id->sym id*) (map stx-mark* id*) label* #f)))
(define make-empty-rib (define make-empty-rib
(lambda () (lambda ()
(make-rib '() '() '()))) (make-rib '() '() '() #f)))
(define extend-rib! (define extend-rib!
(lambda (rib id label) (lambda (rib id label)
(if (rib? rib) (if (rib? rib)
(let ([sym (id->sym id)] [mark* (stx-mark* id)]) (let ([sym (id->sym id)] [mark* (stx-mark* id)])
(when (rib-sealed/freq rib)
(error 'extend-rib! "rib ~s is sealed" rib))
(set-rib-sym*! rib (cons sym (rib-sym* rib))) (set-rib-sym*! rib (cons sym (rib-sym* rib)))
(set-rib-mark**! rib (cons mark* (rib-mark** rib))) (set-rib-mark**! rib (cons mark* (rib-mark** rib)))
(set-rib-label*! rib (cons label (rib-label* rib)))) (set-rib-label*! rib (cons label (rib-label* rib))))
(error 'extend-rib! "~s is not an extensible rib" rib)))) (error 'extend-rib! "~s is not a rib" rib))))
(module (make-stx stx? stx-expr stx-mark* stx-subst*) (module (make-stx stx? stx-expr stx-mark* stx-subst*)
(define-record stx (expr mark* subst*))) (define-record stx (expr mark* subst*)))
(define datum->stx (define datum->stx
@ -280,7 +282,6 @@
(cond (cond
[(imported-label->binding x)] [(imported-label->binding x)]
[(assq x r) => cdr] [(assq x r) => cdr]
[(not x) (cons 'unbound #f)]
[else (cons 'displaced-lexical #f)]))) [else (cons 'displaced-lexical #f)])))
(define make-binding cons) (define make-binding cons)
(define binding-type car) (define binding-type car)
@ -543,7 +544,7 @@
(lambda (x) (lambda (x)
(let ([name (car x)] [label (cdr x)]) (let ([name (car x)] [label (cdr x)])
(add-subst (add-subst
(make-rib (list name) (list top-mark*) (list label)) (make-rib (list name) (list top-mark*) (list label) #f)
(stx sym top-mark* '()))))] (stx sym top-mark* '()))))]
[else (stx sym top-mark* '())])))) [else (stx sym top-mark* '())]))))
;;; macros ;;; macros