320 | | `(,@(if (and (pair? ifs) (pair? sexports)) |
321 | | `((scheme#eval '(import-syntax ,@(strip-syntax ifs)))) |
322 | | '()) |
323 | | ,@(if (and (pair? mifs) (pair? sexports)) |
324 | | `((import-syntax ,@(strip-syntax mifs))) |
325 | | '()) |
326 | | ,@(if (or (getp mname '##core#functor) (pair? sexports)) |
327 | | (##sys#fast-reverse (strip-syntax (module-meta-expressions mod))) |
328 | | '()) |
329 | | (##sys#register-compiled-module |
330 | | ',(module-name mod) |
331 | | ',(module-library mod) |
332 | | (scheme#list ; iexports |
333 | | ,@(map (lambda (ie) |
334 | | (if (symbol? (cdr ie)) |
335 | | `'(,(car ie) . ,(cdr ie)) |
336 | | `(scheme#list ',(car ie) '() ,(cdr ie)))) |
337 | | (module-iexports mod))) |
338 | | ',(module-vexports mod) ; vexports |
339 | | (scheme#list ; sexports |
340 | | ,@(map (lambda (sexport) |
341 | | (let* ((name (car sexport)) |
342 | | (a (assq name dlist))) |
343 | | (cond ((pair? a) |
344 | | `(scheme#cons ',(car sexport) ,(strip-syntax (cdr a)))) |
345 | | (else |
346 | | (dm "re-exported syntax" name mname) |
| 320 | `((##sys#with-environment |
| 321 | (lambda () |
| 322 | ,@(if (and (pair? ifs) (pair? sexports)) |
| 323 | `((scheme#eval '(import-syntax ,@(strip-syntax ifs)))) |
| 324 | '()) |
| 325 | ,@(if (and (pair? mifs) (pair? sexports)) |
| 326 | `((import-syntax ,@(strip-syntax mifs))) |
| 327 | '()) |
| 328 | ,@(if (or (getp mname '##core#functor) (pair? sexports)) |
| 329 | (##sys#fast-reverse (strip-syntax (module-meta-expressions mod))) |
| 330 | '()) |
| 331 | (##sys#register-compiled-module |
| 332 | ',(module-name mod) |
| 333 | ',(module-library mod) |
| 334 | (scheme#list ; iexports |
| 335 | ,@(map (lambda (ie) |
| 336 | (if (symbol? (cdr ie)) |
| 337 | `'(,(car ie) . ,(cdr ie)) |
| 338 | `(scheme#list ',(car ie) '() ,(cdr ie)))) |
| 339 | (module-iexports mod))) |
| 340 | ',(module-vexports mod) ; vexports |
| 341 | (scheme#list ; sexports |
| 342 | ,@(map (lambda (sexport) |
| 343 | (let* ((name (car sexport)) |
| 344 | (a (assq name dlist))) |
| 345 | (cond ((pair? a) |
| 346 | `(scheme#cons ',(car sexport) ,(strip-syntax (cdr a)))) |
| 347 | (else |
| 348 | (dm "re-exported syntax" name mname) |
348 | | sexports)) |
349 | | (scheme#list ; sdefs |
350 | | ,@(if (null? sexports) |
351 | | '() ; no syntax exported - no more info needed |
352 | | (let loop ((sd (module-defined-syntax-list mod))) |
353 | | (cond ((null? sd) '()) |
354 | | ((assq (caar sd) sexports) (loop (cdr sd))) |
355 | | (else |
356 | | (let ((name (caar sd))) |
357 | | (cons `(scheme#cons ',(caar sd) ,(strip-syntax (cdar sd))) |
358 | | (loop (cdr sd))))))))))))) |
| 350 | sexports)) |
| 351 | (scheme#list ; sdefs |
| 352 | ,@(if (null? sexports) |
| 353 | '() ; no syntax exported - no more info needed |
| 354 | (let loop ((sd (module-defined-syntax-list mod))) |
| 355 | (cond ((null? sd) '()) |
| 356 | ((assq (caar sd) sexports) (loop (cdr sd))) |
| 357 | (else |
| 358 | (let ((name (caar sd))) |
| 359 | (cons `(scheme#cons ',(caar sd) ,(strip-syntax (cdar sd))) |
| 360 | (loop (cdr sd))))))))))))))) |
568 | | (parameterize ((##sys#current-module #f) |
569 | | (##sys#current-environment '()) |
570 | | (##sys#current-meta-environment |
571 | | (##sys#current-meta-environment)) |
572 | | (##sys#macro-environment |
573 | | (##sys#meta-macro-environment))) |
574 | | (fluid-let ((##sys#notices-enabled #f)) ; to avoid re-import warnings |
575 | | (load il) |
576 | | (##sys#find-module mname 'import))))) |
| 579 | (##sys#with-environment |
| 580 | (lambda () |
| 581 | (fluid-let ((##sys#notices-enabled #f)) ; to avoid re-import warnings |
| 582 | (load il) |
| 583 | (##sys#find-module mname 'import)))))) |