Changeset 12101 in project


Ignore:
Timestamp:
10/02/08 13:22:49 (12 years ago)
Author:
felix winkelmann
Message:

declaration processing did not handle expanded names

Location:
chicken/trunk
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/TODO

    r12088 r12101  
    66* bugs
    77** compiler
     8*** declarations that refer to identifiers may only be partially stripped
     9    strip-syntax only declaration-specifier, not arguments
    810*** pre-optimization
    911**** changes call-sites and makes them invalid for later pre-optimization
     
    3840*** emit <sourcefile>.inline file with "-inline-global" (?)
    3941*** "-inline-global" slurps *.inline files include-path (?)
    40 ** compiler syntax
    41 *** hygienic macro-expansion with "escape" option (expand orig. form normally)
     42** remove "custom-declare" + stuff?
    4243
    4344* tests
  • chicken/trunk/compiler.scm

    r12088 r12101  
    10691069                          `(,(macro-alias 'begin se)
    10701070                             ,@(map (lambda (d)
    1071                                       (process-declaration
    1072                                        (##sys#strip-syntax d)
    1073                                        se))
     1071                                      (process-declaration d se))
    10741072                                    (cdr x) ) )
    10751073                          '() #f) )
     
    12331231      (if (or (< n minlen) (> n (optional maxlen 99999)))
    12341232          (syntax-error "invalid declaration" spec) ) ) ) 
     1233  (define (stripa x)                    ; global aliasing
     1234    (##sys#strip-syntax x se #t))
     1235  (define (strip x)                     ; raw symbol
     1236    (##sys#strip-syntax x se))
    12351237  (call-with-current-continuation
    12361238   (lambda (return)
    12371239     (unless (pair? spec)
    12381240       (syntax-error "invalid declaration specification" spec) )
    1239      (case (car spec)
     1241     (pp `(DECLARE: ,(strip spec)))
     1242     (case (##sys#strip-syntax (car spec)) ; no global aliasing
    12401243       ((uses)
    1241         (let ((us (cdr spec)))
     1244        (let ((us (strip (cdr spec))))
    12421245          (apply register-feature! us)
    12431246          (when (pair? us)
     
    12471250       ((unit)
    12481251        (check-decl spec 1 1)
    1249         (let* ([u (cadr spec)]
     1252        (let* ([u (strip (cadr spec))]
    12501253               [un (string->c-identifier (stringify u))] )
    12511254          (##sys#hash-table-set! file-requirements 'unit u)
     
    12561259        (if (null? (cdr spec))
    12571260            (set! standard-bindings default-standard-bindings)
    1258             (set! standard-bindings (append (cdr spec) standard-bindings)) ) )
     1261            (set! standard-bindings (append (stripa (cdr spec)) standard-bindings)) ) )
    12591262       ((extended-bindings)
    12601263        (if (null? (cdr spec))
    12611264            (set! extended-bindings default-extended-bindings)
    1262             (set! extended-bindings (append (cdr spec) extended-bindings)) ) )
     1265            (set! extended-bindings (append (stripa (cdr spec)) extended-bindings)) ) )
    12631266       ((usual-integrations)     
    12641267        (cond [(null? (cdr spec))
     
    12661269               (set! extended-bindings default-extended-bindings) ]
    12671270              [else
    1268                (let ([syms (cdr spec)])
     1271               (let ([syms (stripa (cdr spec))])
    12691272                 (set! standard-bindings (lset-intersection eq? syms default-standard-bindings))
    12701273                 (set! extended-bindings (lset-intersection eq? syms default-extended-bindings)) ) ] ) )
    12711274       ((number-type)
    12721275        (check-decl spec 1 1)
    1273         (set! number-type (cadr spec)))
     1276        (set! number-type (strip (cadr spec))))
    12741277       ((fixnum fixnum-arithmetic) (set! number-type 'fixnum))
    12751278       ((generic) (set! number-type 'generic))
    1276        ((unsafe)
    1277         (set! unsafe #t))
     1279       ((unsafe) (set! unsafe #t))
    12781280       ((safe) (set! unsafe #f))
    12791281       ((no-bound-checks) (set! no-bound-checks #t))
     
    12841286       ((disable-warning)
    12851287        (set! disabled-warnings
    1286           (append (cdr spec) disabled-warnings)))
     1288          (append (strip (cdr spec)) disabled-warnings)))
    12871289       ((always-bound)
    1288         (set! always-bound (append (cdr spec) always-bound)))
     1290        (set! always-bound (append (stripa (cdr spec)) always-bound)))
    12891291       ((safe-globals) (set! safe-globals-flag #t))
    12901292       ((no-procedure-checks-for-usual-bindings)
     
    12941296          (append default-standard-bindings default-extended-bindings always-bound)) )
    12951297       ((bound-to-procedure)
    1296         (let ((vars (cdr spec)))
     1298        (let ((vars (stripa (cdr spec))))
    12971299          (set! always-bound-to-procedure (append vars always-bound-to-procedure))
    12981300          (set! always-bound (append vars always-bound)) ) )
     
    13071309            (process-custom-declaration (cadr spec) (cddr spec)) ) )
    13081310       ((c-options)
    1309         (emit-control-file-item `(c-options ,@(cdr spec))) )
     1311        (emit-control-file-item `(c-options ,@(strip (cdr spec)))) )
    13101312       ((link-options)
    1311         (emit-control-file-item `(link-options ,@(cdr spec))) )
     1313        (emit-control-file-item `(link-options ,@(strip (cdr spec))) ) )
    13121314       ((post-process)
    13131315        (emit-control-file-item
     
    13211323       ((not)
    13221324        (check-decl spec 1)
    1323         (case (second spec)
     1325        (case (strip (second spec))
    13241326          [(standard-bindings)
    13251327           (if (null? (cddr spec))
     
    13271329               (set! standard-bindings
    13281330                 (lset-difference eq? default-standard-bindings
    1329                                   (cddr spec)))) ]
     1331                                  (stripa (cddr spec))))) ]
    13301332          [(extended-bindings)
    13311333           (if (null? (cddr spec))
     
    13331335               (set! extended-bindings
    13341336                 (lset-difference eq? default-extended-bindings
    1335                                   (cddr spec)) )) ]
     1337                                  (stripa (cddr spec))) )) ]
    13361338          [(inline)
    13371339           (if (null? (cddr spec))
    13381340               (set! inline-max-size -1)
    13391341               (set! not-inline-list (lset-union eq? not-inline-list
    1340                                                  (cddr spec))) ) ]
     1342                                                 (stripa (cddr spec)))) ) ]
    13411343          [(usual-integrations)     
    13421344           (cond [(null? (cddr spec))
     
    13441346                  (set! extended-bindings '()) ]
    13451347                 [else
    1346                   (let ([syms (cddr spec)])
     1348                  (let ([syms (stripa (cddr spec))])
    13471349                    (set! standard-bindings (lset-difference eq? default-standard-bindings syms))
    13481350                    (set! extended-bindings (lset-difference eq? default-extended-bindings syms)) ) ] ) ]
    13491351          [else
    13501352           (check-decl spec 1 1)
    1351            (let ((id (cadr spec)))
     1353           (let ((id (strip (cadr spec))))
    13521354             (case id
    13531355               [(interrupts-enabled) (set! insert-timer-checks #f)]
    1354                [(safe)
    1355                 (set! unsafe #t)]
     1356               [(safe) (set! unsafe #t)]
    13561357               [else (compiler-warning 'syntax "illegal declaration specifier `~s'" id)]))]))
    13571358       ((compile-syntax)
    13581359        (set! ##sys#enable-runtime-macros #t))
    13591360       ((block-global hide)
    1360         (let ([syms (cdr spec)])
     1361        (let ([syms (stripa (cdr spec))])
    13611362          (when export-list
    13621363            (set! export-list (lset-difference eq? export-list syms)) )
    13631364          (set! block-globals (lset-union eq? syms block-globals)) ) )
    13641365       ((export)
    1365         (let ((syms (cdr spec)))
     1366        (let ((syms (stripa (cdr spec))))
    13661367          (set! block-globals (lset-difference eq? block-globals syms))
    13671368          (set! export-list (lset-union eq? syms (or export-list '())))))
     
    13731374            (unless (> inline-max-size -1)
    13741375              (set! inline-max-size default-inline-max-size) )
    1375             (set! inline-list (lset-union eq? inline-list (cdr spec)))) )
     1376            (set! inline-list (lset-union eq? inline-list (stripa (cdr spec)))) ) )
    13761377       ((inline-limit)
    13771378        (check-decl spec 1 1)
     
    14011402                          'syntax
    14021403                          "invalid import-library specification: ~s" il))))
    1403                 (cdr spec)))))
     1404                (strip (cdr spec))))))
    14041405       ((profile)
    14051406        (set! profiled-procedures
    1406           (append (cdr spec)
     1407          (append (stripa (cdr spec))
    14071408                  (or profiled-procedures '()))))
    14081409       (else (compiler-warning 'syntax "illegal declaration specifier `~s'" spec)) )
  • chicken/trunk/eval.scm

    r12021 r12101  
    729729                         [(##core#declare)
    730730                          (if (memq #:compiling ##sys#features)
    731                               (for-each (lambda (d) (##compiler#process-declaration (cadr d))) (cdr x))
     731                              (for-each (lambda (d) (##compiler#process-declaration d se)) (cdr x))
    732732                              (##sys#warn "declarations are ignored in interpreted code" x) )
    733733                          (compile '(##core#undefined) e #f tf cntr se) ]
  • chicken/trunk/expand.scm

    r11919 r12101  
    9393       se))
    9494
    95 (define (##sys#strip-syntax exp #!optional se)
     95(define (##sys#strip-syntax exp #!optional se alias)
    9696  ;; if se is given, retain bound vars
    9797  (let walk ((x exp))
     
    100100                         (lookup x se)
    101101                         (get x '##core#macro-alias) ) ) )
    102              (cond ((not x2) x)
     102             (cond ((and alias (not (assq x se)))
     103                    (##sys#alias-global-hook x #f))
     104                   ((not x2) x)
    103105                   ((pair? x2) x)
    104106                   (else x2))))
    105107          ((pair? x)
    106            (cons (walk (##sys#slot x 0))
     108           (cons (walk (car x))
    107109                 (walk (cdr x))))
    108110          ((vector? x)
  • chicken/trunk/optimizer.scm

    r10377 r12101  
    391391                   [(and (or (not (test var 'global))
    392392                             block-compilation
    393                              (and export-list (not (memq var export-list))) )
     393                             (and export-list (not (memq var export-list)))
     394                             (memq var block-globals))
    394395                         (not (test var 'references))
    395396                         (not (expression-has-side-effects? (first subs) db)) )
Note: See TracChangeset for help on using the changeset viewer.