Ignore:
Timestamp:
06/09/09 16:59:58 (11 years ago)
Author:
felix winkelmann
Message:

merged trunk rev. 14940 into prerelease branch

Location:
chicken/branches/prerelease
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/prerelease

  • chicken/branches/prerelease/compiler.scm

    r13859 r14954  
    6969; (safe-globals)
    7070; (separate)
     71; (type (<symbol> <typespec>) ...)
    7172; (unit <unitname>)
    7273; (unsafe)
    7374; (unused <symbol> ...)
    7475; (uses {<unitname>})
     76; (scrutinize)
    7577;
    7678;   <type> = fixnum | generic
     
    8991;   ##compiler#unused -> BOOL
    9092;   ##compiler#foldable -> BOOL
     93;   ##compiler#rewrite -> PROCEDURE (see `apply-rewrite-rules!')
    9194
    9295; - Source language:
     
    142145; (define-compiled-syntax (<symbol> . <llist>) <expr> ...)
    143146; (##core#module <symbol> #t | (<name> | (<name> ...) ...) <body>)
    144 ; (##core#define-rewrite-rule <symbol> <expr>)
    145147
    146148; - Core language:
     
    294296  membership-test-operators membership-unfold-limit valid-compiler-options valid-compiler-options-with-argument
    295297  make-random-name final-foreign-type real-name-table real-name set-real-name! safe-globals-flag
    296   location-pointer-map literal-rewrite-hook inline-globally
    297   local-definitions export-variable variable-mark intrinsic?
     298  location-pointer-map inline-globally enable-inline-files
     299  local-definitions export-variable variable-mark intrinsic? do-scrutinize
    298300  undefine-shadowed-macros process-lambda-documentation emit-syntax-trace-info
    299301  generate-code make-variable-list make-argument-list generate-foreign-stubs foreign-type-declaration
     
    302304  big-fixnum? import-libraries unlikely-variables)
    303305
     306
     307(define (d arg1 . more)
     308  (if (null? more)
     309      (pp arg1)
     310      (apply print arg1 more)))
     311
     312(define-syntax d (syntax-rules () ((_ . _) (void))))
    304313
    305314(include "tweaks")
     
    368377(define inline-locally #f)
    369378(define inline-output-file #f)
     379(define do-scrutinize #f)
     380(define enable-inline-files #f)
    370381
    371382
     
    414425(define file-requirements #f)
    415426(define postponed-initforms '())
    416 (define literal-rewrite-hook #f)
    417427
    418428
     
    474484        x) )
    475485
    476   (define (resolve-variable x0 se dest)
     486  (define (resolve-variable x0 e se dest)
    477487    (let ((x (lookup x0 se)))
     488      (d `(RESOLVE-VARIABLE: ,x0 ,x ,(map car se)))
    478489      (cond ((not (symbol? x)) x0)      ; syntax?
    479490            [(and constants-used (##sys#hash-table-ref constant-table x))
    480              => (lambda (val) (walk (car val) se dest)) ]
     491             => (lambda (val) (walk (car val) e se dest)) ]
    481492            [(and inline-table-used (##sys#hash-table-ref inline-table x))
    482              => (lambda (val) (walk val se dest)) ]
     493             => (lambda (val) (walk val e se dest)) ]
    483494            [(assq x foreign-variables)
    484495             => (lambda (fv)
     
    490501                      (finish-foreign-result ft body)
    491502                      t)
    492                      se dest)))]
     503                     e se dest)))]
    493504            [(assq x location-pointer-map)
    494505             => (lambda (a)
     
    500511                      (finish-foreign-result ft body)
    501512                      t)
    502                      se dest))) ]
    503             ((not (assq x0 se)) (##sys#alias-global-hook x #f)) ; only if global
     513                     e se dest))) ]
    504514            ((##sys#get x '##core#primitive))
     515            ((not (memq x e)) (##sys#alias-global-hook x #f)) ; only if global
    505516            (else x))))
    506517 
     
    514525       '() ) ))
    515526
    516   (define (walk x se dest)
     527  (define (walk x e se dest)
    517528    (cond ((symbol? x)
    518529           (cond ((keyword? x) `(quote ,x))
     
    521532                   'var
    522533                   "reference to variable `~s' possibly unintended" x) ))
    523            (resolve-variable x se dest))
     534           (resolve-variable x e se dest))
    524535          ((not-pair? x)
    525536           (if (constant? x)
     
    538549                    (xexpanded (##sys#expand x se)))
    539550               (cond ((not (eq? x xexpanded))
    540                       (walk xexpanded se dest))
     551                      (walk xexpanded e se dest))
    541552                     
    542553                     [(and inline-table-used (##sys#hash-table-ref inline-table name))
    543554                      => (lambda (val)
    544                            (walk (cons val (cdr x)) se dest)) ]
     555                           (walk (cons val (cdr x)) e se dest)) ]
    545556                     
    546557                     [else
     
    551562                         (##sys#check-syntax 'if x '(if _ _ . #(_)) #f se)
    552563                         `(if
    553                            ,(walk (cadr x) se #f)
    554                            ,(walk (caddr x) se #f)
     564                           ,(walk (cadr x) e se #f)
     565                           ,(walk (caddr x) e se #f)
    555566                           ,(if (null? (cdddr x))
    556567                                '(##core#undefined)
    557                                 (walk (cadddr x) se #f) ) ) )
     568                                (walk (cadddr x) e se #f) ) ) )
    558569
    559570                        ((quote syntax)
     
    564575                         (if unsafe
    565576                             ''#t
    566                              (walk (cadr x) se dest) ) )
     577                             (walk (cadr x) e se dest) ) )
    567578
    568579                        ((##core#immutable)
     
    585596                         `(##core#inline_loc_ref
    586597                           ,(##sys#strip-syntax (cadr x))
    587                            ,(walk (caddr x) se dest)))
     598                           ,(walk (caddr x) e se dest)))
    588599
    589600                        ((##core#require-for-syntax)
     
    613624                                         'ext "extension `~A' is currently not installed" id))
    614625                                      `(begin ,exp ,(loop (cdr ids))) ) ) ) )
    615                             se dest) ) )
     626                            e se dest) ) )
    616627
    617628                        ((let ##core#let)
     
    624635                           `(let
    625636                             ,(map (lambda (alias b)
    626                                      (list alias (walk (cadr b) se (car b))) )
     637                                     (list alias (walk (cadr b) e se (car b))) )
    627638                                   aliases bindings)
    628639                             ,(walk (##sys#canonicalize-body (cddr x) se2)
     640                                    (append aliases e)
    629641                                    se2 dest) ) ) )
    630642
    631                          ((letrec ##core#letrec)
    632                           (##sys#check-syntax 'letrec x '(_ #((symbol _) 0) . #(_ 1)))
    633                           (let ((bindings (cadr x))
    634                                 (body (cddr x)) )
    635                             (walk
    636                              `(##core#let
    637                                ,(##sys#map (lambda (b)
    638                                              (list (car b) '(##core#undefined)))
    639                                            bindings)
    640                                ,@(##sys#map (lambda (b)
    641                                               `(##core#set! ,(car b) ,(cadr b)))
    642                                             bindings)
    643                                (##core#let () ,@body) )
    644                             se dest)))
     643                        ((letrec ##core#letrec)
     644                         (##sys#check-syntax 'letrec x '(_ #((symbol _) 0) . #(_ 1)))
     645                         (let ((bindings (cadr x))
     646                               (body (cddr x)) )
     647                           (walk
     648                            `(##core#let
     649                              ,(map (lambda (b)
     650                                      (list (car b) '(##core#undefined)))
     651                                    bindings)
     652                              ,@(map (lambda (b)
     653                                       `(##core#set! ,(car b) ,(cadr b)))
     654                                     bindings)
     655                              (##core#let () ,@body) )
     656                            e se dest)))
    645657
    646658                        ((lambda ##core#lambda)
     
    659671                                     (se2 (append (map cons vars aliases) se))
    660672                                     (body0 (##sys#canonicalize-body obody se2))
    661                                      (body (walk body0 se2 #f))
     673                                     (body (walk body0 (append aliases e) se2 #f))
    662674                                     (llist2
    663675                                      (build-lambda-list
     
    703715                           (walk
    704716                            (##sys#canonicalize-body (cddr x) se2)
    705                             se2
     717                            e se2
    706718                            dest) ) )
    707719                               
     
    722734                          (walk
    723735                           (##sys#canonicalize-body (cddr x) se2)
    724                            se2 dest)))
     736                           e se2 dest)))
    725737                               
    726738                       ((define-syntax)
     
    748760                                 (##sys#er-transformer ,body)) ;*** possibly wrong se?
    749761                               '(##core#undefined) )
    750                            se dest)) )
     762                           e se dest)) )
    751763
    752764                       ((define-compiled-syntax)
     
    773785                             (##sys#er-transformer
    774786                              ,body)) ;*** possibly wrong se?
    775                            se dest)))
    776 
    777                        ((##core#define-rewrite-rule)
    778                         (let ((name (##sys#strip-syntax (cadr x) se #t))
    779                               (re (caddr x)))
    780                           (##sys#put! name '##compiler#intrinsic 'rewrite)
    781                           (rewrite
    782                            name 8
    783                            (eval/meta re))
    784                           '(##core#undefined)))
     787                           e se dest)))
    785788
    786789                       ((##core#module)
     
    850853                                                 (cons (walk
    851854                                                        (car body)
     855                                                        e ;?
    852856                                                        (##sys#current-environment)
    853857                                                        #f)
     
    859863                                (map
    860864                                 (lambda (x)
    861                                    (walk x (##sys#current-meta-environment) #f) )
     865                                   (walk
     866                                    x
     867                                    e   ;?
     868                                    (##sys#current-meta-environment) #f) )
    862869                                 mreg))
    863870                              body)))))
    864871
    865872                       ((##core#named-lambda)
    866                         (walk `(,(macro-alias 'lambda se) ,@(cddr x)) se (cadr x)) )
     873                        (walk `(,(macro-alias 'lambda se) ,@(cddr x)) e se (cadr x)) )
    867874
    868875                       ((##core#loop-lambda)
     
    874881                                (walk
    875882                                 (##sys#canonicalize-body obody se2)
     883                                 (append aliases e)
    876884                                 se2 #f) ] )
    877885                          (set-real-names! aliases vars)
     
    898906                                               (,(third fv) ,type)
    899907                                               ,(foreign-type-check tmp type) ) )
    900                                            se #f))))
     908                                           e se #f))))
    901909                                 ((assq var location-pointer-map)
    902910                                  => (lambda (a)
     
    909917                                              ,(second a)
    910918                                              ,(foreign-type-check tmp type) ) )
    911                                           se #f))))
    912                                  (else
    913                                   (when (eq? var var0) ; global?
    914                                     (set! var (##sys#alias-global-hook var #t))
     919                                          e se #f))))
     920                                 (else
     921                                  (unless (memq var e) ; global?
     922                                    (set! var (or (##sys#get var '##core#primitive)
     923                                                  (##sys#alias-global-hook var #t)))
    915924                                    (when safe-globals-flag
    916925                                      (mark-variable var '##compiler#always-bound-to-procedure)
    917                                       (mark-variable var '##compiler#always-bound))
    918                                     (when (##sys#macro? var)
    919                                       (compiler-warning
    920                                        'var "assigned global variable `~S' is a macro ~A"
    921                                        var
    922                                        (if ln (sprintf "in line ~S" ln) "") )
    923                                       (when undefine-shadowed-macros (##sys#undefine-macro! var) ) ) )
     926                                      (mark-variable var '##compiler#always-bound)))
     927                                  (when (##sys#macro? var)
     928                                    (compiler-warning
     929                                     'var "assigned global variable `~S' is a macro ~A"
     930                                     var
     931                                     (if ln (sprintf "in line ~S" ln) "") )
     932                                    (when undefine-shadowed-macros (##sys#undefine-macro! var) ) )
    924933                                  (when (keyword? var)
    925934                                    (compiler-warning 'syntax "assignment to keyword `~S'" var) )
     
    927936                                    (syntax-error
    928937                                     'set! "assignment to syntactic identifier" var))
    929                                   `(set! ,var ,(walk val se var0))))))
     938                                  `(set! ,var ,(walk val e se var0))))))
    930939
    931940                        ((##core#inline)
    932                          `(##core#inline ,(unquotify (cadr x) se) ,@(mapwalk (cddr x) se)))
     941                         `(##core#inline ,(unquotify (cadr x) se) ,@(mapwalk (cddr x) e se)))
    933942
    934943                        ((##core#inline_allocate)
    935944                         `(##core#inline_allocate
    936945                           ,(map (cut unquotify <> se) (second x))
    937                            ,@(mapwalk (cddr x) se)))
     946                           ,@(mapwalk (cddr x) e se)))
    938947
    939948                        ((##core#inline_update)
    940                          `(##core#inline_update ,(cadr x) ,(walk (caddr x) se #f)) )
     949                         `(##core#inline_update ,(cadr x) ,(walk (caddr x) e se #f)) )
    941950
    942951                        ((##core#inline_loc_update)
    943952                         `(##core#inline_loc_update
    944953                           ,(cadr x)
    945                            ,(walk (caddr x) se #f)
    946                            ,(walk (cadddr x) se #f)) )
     954                           ,(walk (caddr x) e se #f)
     955                           ,(walk (cadddr x) e se #f)) )
    947956
    948957                        ((##core#compiletimetoo ##core#elaborationtimetoo)
    949958                         (let ((exp (cadr x)))
    950959                           (eval/meta exp)
    951                            (walk exp se dest) ) )
     960                           (walk exp e se dest) ) )
    952961
    953962                        ((##core#compiletimeonly ##core#elaborationtimeonly)
     
    963972                                      [r (cdr xs)] )
    964973                                  (if (null? r)
    965                                       (list (walk x se dest))
    966                                       (cons (walk x se #f) (fold r)) ) ) ) )
     974                                      (list (walk x e se dest))
     975                                      (cons (walk x e se #f) (fold r)) ) ) ) )
    967976                             '(##core#undefined) ) )
    968977
    969978                        ((foreign-lambda)
    970                          (walk (expand-foreign-lambda x) se dest) )
     979                         (walk (expand-foreign-lambda x #f) e se dest) )
    971980
    972981                        ((foreign-safe-lambda)
    973                          (walk (expand-foreign-callback-lambda x) se dest) )
     982                         (walk (expand-foreign-lambda x #t) e se dest) )
    974983
    975984                        ((foreign-lambda*)
    976                          (walk (expand-foreign-lambda* x) se dest) )
     985                         (walk (expand-foreign-lambda* x #f) e se dest) )
    977986
    978987                        ((foreign-safe-lambda*)
    979                          (walk (expand-foreign-callback-lambda* x) se dest) )
     988                         (walk (expand-foreign-lambda* x #t) e se dest) )
    980989
    981990                        ((foreign-primitive)
    982                          (walk (expand-foreign-primitive x) se dest) )
     991                         (walk (expand-foreign-primitive x) e se dest) )
    983992
    984993                        ((define-foreign-variable)
    985994                         (let* ([var (##sys#strip-syntax (second x))]
    986                                 [type (third x)]
     995                                [type (##sys#strip-syntax (third x))]
    987996                                [name (if (pair? (cdddr x))
    988997                                          (fourth x)
     
    9981007                        ((define-foreign-type)
    9991008                         (let ([name (second x)]
    1000                                [type (third x)]
     1009                               [type (##sys#strip-syntax (third x))]
    10011010                               [conv (cdddr x)] )
    10021011                           (cond [(pair? conv)
     
    10141023                                         ,ret
    10151024                                         ,(if (pair? (cdr conv)) (second conv) '##sys#values)) )
    1016                                      se dest) ) ]
     1025                                     e se dest) ) ]
    10171026                                 [else
    10181027                                  (##sys#hash-table-set! foreign-type-table name type)
     
    10351044                        ((##core#let-location)
    10361045                         (let* ([var (second x)]
    1037                                 [type (third x)]
     1046                                [type (##sys#strip-syntax (third x))]
    10381047                                [alias (gensym)]
    10391048                                [store (gensym)]
     
    10561065                                      '() )
    10571066                                ,(if init (fifth x) (fourth x)) ) )
    1058                             (alist-cons var alias se)
     1067                            e (alist-cons var alias se)
    10591068                            dest) ) )
    10601069
     
    10891098                                    (mark-variable var '##compiler#constant)
    10901099                                    (mark-variable var '##compiler#always-bound)
    1091                                     (walk `(define ,var ',val) se #f) ) ] ) ) )
     1100                                    (walk `(define ,var ',val) e se #f) ) ] ) ) )
    10921101
    10931102                        ((##core#declare)
     
    10971106                                      (process-declaration d se))
    10981107                                    (cdr x) ) )
    1099                           '() #f) )
     1108                          e '() #f) )
    11001109             
    11011110                        ((##core#foreign-callback-wrapper)
     
    11171126                                vars atypes) )
    11181127                             `(##core#foreign-callback-wrapper
    1119                                ,@(mapwalk args se)
     1128                               ,@(mapwalk args e se)
    11201129                               ,(walk `(##core#lambda
    11211130                                        ,vars
     
    11721181                                                (else (cddr lam)) ) )
    11731182                                           rtype) ) )
    1174                                       se #f) ) ) ) )
     1183                                      e se #f) ) ) ) )
    11751184
    11761185                        (else
    11771186                         (let ([handle-call
    11781187                                (lambda ()
    1179                                   (let* ([x2 (mapwalk x se)]
     1188                                  (let* ([x2 (mapwalk x e se)]
    11801189                                         [head2 (car x2)]
    11811190                                         [old (##sys#hash-table-ref line-number-database-2 head2)] )
     
    11951204                                                    (walk
    11961205                                                     `(##sys#make-locative ,(second a) 0 #f 'location)
    1197                                                      se #f) ) ]
     1206                                                     e se #f) ) ]
    11981207                                              [(assq sym external-to-pointer)
    1199                                                => (lambda (a) (walk (cdr a) se #f)) ]
     1208                                               => (lambda (a) (walk (cdr a) e se #f)) ]
    12001209                                              [(memq sym callback-names)
    12011210                                               `(##core#inline_ref (,(symbol->string sym) c-pointer)) ]
    12021211                                              [else
    1203                                                (walk `(##sys#make-locative ,sym 0 #f 'location) se #f) ] )
    1204                                         (walk `(##sys#make-locative ,sym 0 #f 'location) se #f) ) ) ]
     1212                                               (walk `(##sys#make-locative ,sym 0 #f 'location) e se #f) ] )
     1213                                        (walk `(##sys#make-locative ,sym 0 #f 'location) e se #f) ) ) ]
    12051214                                 
    12061215                                 [else (handle-call)] ) ) ) ) ] ) ) ) )
     
    12121221           (emit-syntax-trace-info x #f)
    12131222           (compiler-warning 'syntax "literal in operator position: ~S" x)
    1214            (mapwalk x se) )
     1223           (mapwalk x e se) )
    12151224
    12161225          ((and (pair? (car x))
     
    12241233               (if (and (proper-list? llist) (= (llist-length llist) (length args)))
    12251234                   (walk `(,(macro-alias 'let se)
    1226                            ,(map list llist args) ,@(cddr lexp)) se dest)
     1235                           ,(map list llist args) ,@(cddr lexp))
     1236                         e se dest)
    12271237                   (let ((var (gensym 't)))
    12281238                     (walk
     
    12301240                        ((,var ,(car x)))
    12311241                        (,var ,@(cdr x)) )
    1232                       se dest) ) ) ) ) )
     1242                      e se dest) ) ) ) ) )
    12331243         
    12341244          (else
    12351245           (emit-syntax-trace-info x #f)
    1236            (mapwalk x se)) ) )
     1246           (mapwalk x e se)) ) )
    12371247 
    1238   (define (mapwalk xs se)
    1239     (map (lambda (x) (walk x se #f)) xs) )
     1248  (define (mapwalk xs e se)
     1249    (map (lambda (x) (walk x e se #f)) xs) )
    12401250
    12411251  (when (memq 'c debugging-chicken) (newline) (pretty-print exp))
     
    12501260         (set! extended-bindings (append internal-bindings extended-bindings))
    12511261         exp) )
    1252    (##sys#current-environment)
     1262   '() (##sys#current-environment)
    12531263   #f) )
    12541264
     
    13791389                    (set! extended-bindings (lset-difference eq? default-extended-bindings syms)) ) ] ) ]
    13801390          ((inline-global)
     1391           (set! enable-inline-files #t)
    13811392           (if (null? (cddr spec))
    13821393               (set! inline-globally #f)
     
    14571468                (stripa (cdr spec))))))
    14581469       ((inline-global)
     1470        (set! enable-inline-files #t)
     1471        (set! inline-locally #t)
    14591472        (if (null? (cdr spec))
    14601473            (set! inline-globally #t)
     
    14621475             (cut mark-variable <> '##compiler#inline-global 'yes)
    14631476             (stripa (cdr spec)))))
     1477       ((type)
     1478        (for-each
     1479         (lambda (spec)
     1480           (cond ((and (list? spec) (symbol? (car spec)) (= 2 (length spec)))
     1481                  (##sys#put! (car spec) '##core#type (cadr spec))
     1482                  (##sys#put! (car spec) '##core#declared-type #t))
     1483                 (else
     1484                  (compiler-warning 'syntax "illegal `type' declaration item `~s'" spec))))
     1485         (cdr spec)))
     1486       ((scrutinize)
     1487        (set! do-scrutinize #t))
    14641488       (else (compiler-warning 'syntax "illegal declaration specifier `~s'" spec)) )
    14651489     '(##core#undefined) ) ) )
     
    14811505
    14821506(define (create-foreign-stub rtype sname argtypes argnames body callback cps)
    1483   (let* ([params (list-tabulate (length argtypes) (lambda (x) (gensym 'a)))]
     1507  (let* ((rtype (##sys#strip-syntax rtype))
     1508         (argtypes (##sys#strip-syntax argtypes))
     1509         [params (list-tabulate (length argtypes) (lambda (x) (gensym 'a)))]
    14841510         [f-id (gensym 'stub)]
    14851511         [bufvar (gensym)]
     
    15061532                     rtype) ) ) ) ) ) ) )
    15071533
    1508 (define (expand-foreign-lambda exp)
     1534(define (expand-foreign-lambda exp callback?)
    15091535  (let* ([name (third exp)]
    1510          [sname (cond ((symbol? name) (symbol->string name))
     1536         [sname (cond ((symbol? name) (symbol->string (##sys#strip-syntax name)))
    15111537                      ((string? name) name)
    15121538                      (else (quit "name `~s' of foreign procedure has wrong type" name)) ) ]
    15131539         [rtype (second exp)]
    15141540         [argtypes (cdddr exp)] )
    1515     (create-foreign-stub rtype sname argtypes #f #f #f #f) ) )
    1516 
    1517 (define (expand-foreign-callback-lambda exp)
    1518   (let* ([name (third exp)]
    1519          [sname (cond ((symbol? name) (symbol->string name))
    1520                       ((string? name) name)
    1521                       (else (quit "name `~s' of foreign procedure has wrong type" name)) ) ]
    1522          [rtype (second exp)]
    1523          [argtypes (cdddr exp)] )
    1524     (create-foreign-stub rtype sname argtypes #f #f #t #t) ) )
    1525 
    1526 (define (expand-foreign-lambda* exp)
     1541    (create-foreign-stub rtype sname argtypes #f #f callback? callback?) ) )
     1542
     1543(define (expand-foreign-lambda* exp callback?)
    15271544  (let* ([rtype (second exp)]
    15281545         [args (third exp)]
    15291546         [body (apply string-append (cdddr exp))]
    15301547         [argtypes (map car args)]
    1531          [argnames (map cadr args)] )
    1532     (create-foreign-stub rtype #f argtypes argnames body #f #f) ) )
    1533 
    1534 (define (expand-foreign-callback-lambda* exp)
    1535   (let* ([rtype (second exp)]
    1536          [args (third exp)]
    1537          [body (apply string-append (cdddr exp))]
    1538          [argtypes (map car args)]
    1539          [argnames (map cadr args)] )
    1540     (create-foreign-stub rtype #f argtypes argnames body #t #t) ) )
    1541 
     1548         ;; C identifiers aren't hygienically renamed inside body strings
     1549         [argnames (map cadr (##sys#strip-syntax args))] )
     1550    (create-foreign-stub rtype #f argtypes argnames body callback? callback?) ) )
     1551
     1552;; TODO: Try to fold this procedure into expand-foreign-lambda*
    15421553(define (expand-foreign-primitive exp)
    15431554  (let* ([hasrtype (and (pair? (cddr exp)) (not (string? (caddr exp))))]
    15441555         [rtype (if hasrtype (second exp) 'void)]
    1545          [args (if hasrtype (third exp) (second exp))]
     1556         [args (##sys#strip-syntax (if hasrtype (third exp) (second exp)))]
    15461557         [body (apply string-append (if hasrtype (cdddr exp) (cddr exp)))]
    15471558         [argtypes (map car args)]
    1548          [argnames (map cadr args)] )
     1559         ;; C identifiers aren't hygienically renamed inside body strings
     1560         [argnames (map cadr (##sys#strip-syntax args))] )
    15491561    (create-foreign-stub rtype #f argtypes argnames body #f #t) ) )
    15501562
Note: See TracChangeset for help on using the changeset viewer.