diff --git a/s48/module-system/overlapping-imports.scm b/s48/module-system/overlapping-imports.scm new file mode 100644 index 0000000..a1d64b2 --- /dev/null +++ b/s48/module-system/overlapping-imports.scm @@ -0,0 +1,26 @@ +(define (overlapping-imports? forms package) + (let ((table (make-symbol-table)) + (dups '())) + (for-each + (lambda (structure) + (for-each-export + (lambda (name want-type binding) + (let ((structs (table-ref table name))) + (cond ((not structs) + (table-set! table name (list (structure-name structure)))) + ((member (structure-name structure) structs) + #f);seems to happen in real life... + (else (set! dups (cons name dups)) + (table-set! table + name + (cons (structure-name structure) + (table-ref table name))))))) + structure)) + (package-opens package)) + (if (not (null? dups)) + (apply warn "package has overlapping imports" + package + (map (lambda (name) (list name (table-ref table name))) dups))) + forms)) + +(set-optimizer! 'overlapping-imports? overlapping-imports?) diff --git a/s48/module-system/packages.scm b/s48/module-system/packages.scm new file mode 100644 index 0000000..bd0d269 --- /dev/null +++ b/s48/module-system/packages.scm @@ -0,0 +1,7 @@ +(define-structure overlapping-imports? (export) + (open scheme + optimizer + signals + general-tables + packages-internal) + (files overlapping-imports)) \ No newline at end of file