Changeset 5503 in project


Ignore:
Timestamp:
08/18/07 12:00:21 (12 years ago)
Author:
Jim Ursetto
Message:

syntactic-closures: move line-number updates to function; reformat a little

File:
1 edited

Legend:

Unmodified
Added
Removed
  • syntactic-closures/syntactic-closures.scm

    r4672 r5503  
    193193;;;  of syntactic binding to be implemented.
    194194
     195(define (update-line-number-database! old-form new-form)
     196  (define (bucket exp)
     197    (and (symbol? (car exp))
     198         (##sys#hash-table-ref ##sys#line-number-database (car exp))))
     199  (define (bucket-ref exp)
     200    (let ((bucket (bucket exp)))
     201      (and bucket (assq exp bucket))))
     202  (define (add-entry! exp line)
     203    (and (symbol? (car exp))
     204         (##sys#hash-table-set! ##sys#line-number-database
     205                                (car exp)
     206                                (alist-cons exp line (or (bucket exp) '())))))
     207  (define (update-entry! old new)
     208    (cond ((bucket-ref old)
     209           => (lambda (cell) (set-car! cell new)))))
     210  (and ##sys#line-number-database
     211       (if (eq? (car old-form) (car new-form))  ;was identifier renamed?
     212           (update-entry! old-form new-form) ;lossless unless a macro dup'd us
     213           (cond ((bucket-ref old-form)
     214                  => (lambda (cell) (add-entry! new-form (cdr cell))))))))
     215
    195216(define (classify/form form environment definition-environment)
    196217  (cond ((identifier? form)
     
    198219        ((syntactic-closure? form)
    199220         (let ((form (syntactic-closure/form form))
    200                (environment
    201                 (filter-syntactic-environment
    202                  (syntactic-closure/free-names form)
    203                  environment
    204                  (syntactic-closure/environment form))))
    205            (classify/form form
    206                           environment
    207                           definition-environment)))
     221               (environment (filter-syntactic-environment
     222                             (syntactic-closure/free-names form)
     223                             environment
     224                             (syntactic-closure/environment form))))
     225           (classify/form form environment definition-environment)))
    208226        ((pair? form)
    209          (let ((item
    210                 (classify/subexpression (car form) environment)))
     227         (let ((item (classify/subexpression (car form) environment)))
    211228           (cond ((keyword-item? item)
    212                   ((keyword-item/classifier item) form
    213                                                   environment
    214                                                   definition-environment))
     229                  ((keyword-item/classifier item)
     230                   form environment definition-environment))
    215231                 ((list? (cdr form))
    216                   (let ((items
    217                          (classify/subexpressions (cdr form)
    218                                                   environment)))
     232                  (let ((items (classify/subexpressions (cdr form) environment)))
    219233                    (make-expression-item
    220 ;;                   (lambda ()
    221 ;;                     (output/combination
    222 ;;                      (compile-item/expression item)
    223 ;;                      (map! compile-item/expression items)))
    224 ;;                      (lambda () form)
    225                      ;; XXXX preserve line-number info (ashinn 2006/12/11)
    226234                     (lambda ()
    227                        (let ((new
    228                               (output/combination
    229                                (compile-item/expression item)
    230                                (map compile-item/expression items))))
    231                          (if (and ##sys#line-number-database
    232                                   (symbol? (car new)))
    233                            (if (eq? (car form) (car new))
    234                              ;; same symbol, just overwrite the old
    235                              ;; cell (the old form should never be
    236                              ;; used, unless the macro is duplicating
    237                              ;; user code in multiple places, which is
    238                              ;; bad-style so we don't care if they
    239                              ;; lose line-number info in that case)
    240                              (let ((bucket
    241                                     (##sys#hash-table-ref
    242                                      ##sys#line-number-database
    243                                      (car form))))
    244                                (if bucket
    245                                  (let ((cell (assq form bucket)))
    246                                    (if cell
    247                                      (set-car! cell new)))))
    248                              ;; renamed symbol, add a new entry
    249                              (let ((line (get-line-number form)))
    250                                (if line
    251                                  (let* ((name (car new))
    252                                         (old (or (##sys#hash-table-ref
    253                                                   ##sys#line-number-database name) '())))
    254                                    (##sys#hash-table-set! ##sys#line-number-database name (alist-cons new line old)))))))
    255                          new))
     235                       (let ((combo (output/combination
     236                                     (compile-item/expression item)
     237                                     (map compile-item/expression items))))
     238                         (update-line-number-database! form combo)
     239                         combo))
    256240                     form)))
    257                  (else
    258                   (syntax-error "combination must be a proper list"
    259                                 form)))))
     241                 (else       ;e.g. (+ . 1)
     242                  (syntax-error "combination must be a proper list" form)))))
    260243        (else
    261          (make-expression-item ;don't quote literals evaluating to themselves
    262            (if (or (boolean? form) (char? form) (number? form) (string? form)
    263                    (null? form))
    264                (lambda () (output/literal-unquoted form))
    265                (lambda () (output/literal-quoted form))) form))))
     244         (make-expression-item
     245          (if (or (boolean? form) (char? form) (number? form) (string? form)
     246                  (null? form))   ;don't quote self-evaluating literals
     247              (lambda () (output/literal-unquoted form))
     248              (lambda () (output/literal-quoted form)))
     249          form))))
    266250
    267251(define (classify/subform form environment definition-environment)
    268   (classify/form form
    269                  environment
    270                  definition-environment))
     252  (classify/form form environment definition-environment))
    271253
    272254(define (classify/subforms forms environment definition-environment)
     
    287269  (let ((illegal
    288270         (lambda (item name)
    289            (let ((decompiled (decompile-item item))) (newline)
    290            (error (string-append name " may not be used as an expression")
    291                   decompiled)))))
     271           (let ((decompiled (decompile-item item)))
     272             (newline)
     273             (error (string-append name " may not be used as an expression")
     274                    decompiled)))))
    292275    (cond ((variable-item? item)
    293276           (output/variable (variable-item/name item)))
    294277          ((expression-item? item)
    295278           ((expression-item/compiler item)))
    296           ((body-item? item)
     279          ((body-item? item)         
    297280           (let ((items (flatten-body-items (body-item/components item))))
    298281             (if (null? items)
    299                  (illegal item "empty sequence")
     282                 (illegal item "empty sequence")   ;e.g. (+ 1 (begin))
    300283                 (output/sequence (map compile-item/expression items)))))
    301284          ((definition-item? item)
     
    320303         '()
    321304         (let items-loop
    322              ((items
    323                (item->list
    324                 (classify/subform (car forms)
    325                                   environment
    326                                   environment))))
     305             ((items (item->list
     306                      (classify/subform (car forms) environment environment))))
    327307           (cond ((null? items)
    328308                  (forms-loop (cdr forms)))
     
    334314                              (definition-item/value (car items))))
    335315                            (items-loop (cdr items)))
    336                       (items-loop (cdr items))))
     316                      (items-loop (cdr items))))  ;e.g. (define x letrec) ignored
    337317                 (else
    338318                  (cons (compile-item/expression (car items))
Note: See TracChangeset for help on using the changeset viewer.