Ignore:
Timestamp:
11/28/08 09:28:12 (13 years ago)
Author:
felix winkelmann
Message:

support for lazy gensyms; some refactoring in get/put\!

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/lazy-gensyms/expand.scm

    r12612 r12629  
    6969(define (lookup id se)
    7070  (cond ((assq id se) => cdr)
    71         ((##sys#get id '##core#macro-alias))
     71        ((memq '##core#macro-alias (##sys#slot id 2)) => cadr)
    7272        (else #f)))
    7373
     
    9898  (let walk ((x exp))
    9999    (cond ((symbol? x)
    100            (let ((x2 (if se
    101                          (lookup x se)
    102                          (get x '##core#macro-alias) ) ) )
    103              (cond ((and alias (not (assq x se)))
    104                     (##sys#alias-global-hook x #f))
    105                    ((not x2) x)
    106                    ((pair? x2) x)
    107                    (else x2))))
     100           (if (and alias (not (assq x se)))
     101               (##sys#alias-global-hook x #f)
     102               (let ((x2 (if se
     103                             (lookup x se)
     104                             (##sys#get x '##core#macro-alias #f) ) ) )
     105                 (cond ((not x2) x)
     106                       ((pair? x2) x)
     107                       (else x2)))))
    108108          ((pair? x)
    109109           (cons (walk (car x))
     
    252252  (##sys#string->symbol
    253253   (string-append
    254     (##sys#slot prefix 1)               ;*** must be symbol with name!
     254    (##sys#slot prefix 1)               ;*** must be symbol with name, not uninst. gensym!
    255255    "#"
    256256    (##sys#symbol-name sym) ) ) )
     
    265265          (else sym)))
    266266  (cond ((##sys#qualified-symbol? sym) sym)
    267         ((##sys#get sym '##core#primitive) =>
     267        ((##sys#get sym '##core#primitive #f) =>
    268268         (lambda (p)
    269269           (dm "(ALIAS) primitive: " p)
    270270           p))
    271         ((##sys#get sym '##core#aliased)
     271        ((##sys#get sym '##core#aliased #f)
    272272         (dm "(ALIAS) marked: " sym)
    273273         sym)
     
    278278             (if (pair? sym2)           ; macro (*** can this be?)
    279279                 (mrename sym)
    280                  (or (##sys#get sym2 '##core#primitive) sym2)))))
     280                 (##sys#get sym2 '##core#primitive sym2)))))
    281281        (else (mrename sym))))
    282282
     
    690690      (let ((result
    691691             (if (and (symbol? s1) (symbol? s2))
    692                  (let ((ss1 (or (##sys#get s1 '##core#macro-alias)
     692                 (let ((ss1 (or (##sys#get s1 '##core#macro-alias #f)
    693693                                (lookup2 1 s1 dse)
    694694                                s1) )
    695                        (ss2 (or (##sys#get s2 '##core#macro-alias)
     695                       (ss2 (or (##sys#get s2 '##core#macro-alias #f)
    696696                                (lookup2 2 s2 dse)
    697697                                s2) ) )
    698698                   (cond ((symbol? ss1)
    699699                          (cond ((symbol? ss2)
    700                                  (eq? (or (##sys#get ss1 '##core#primitive) ss1)
    701                                       (or (##sys#get ss2 '##core#primitive) ss2)))
     700                                 (eq? (or (##sys#get ss1 '##core#primitive #f) ss1)
     701                                      (or (##sys#get ss2 '##core#primitive #f) ss2)))
    702702                                ((assq ss1 (##sys#macro-environment)) =>
    703703                                 (lambda (a) (eq? (cdr a) ss2)))
     
    15921592       (unless (memq u elist)
    15931593         (##sys#warn "reference to possibly unbound identifier" u)
    1594          (and-let* ((a (##sys#get u '##core#db)))
     1594         (and-let* ((a (##sys#get u '##core#db #f)))
    15951595           (let ((m (cadr a)))
    15961596             (unless (memq m suggest)
Note: See TracChangeset for help on using the changeset viewer.