* multiple imports of the same binding into the same context now work.
This commit is contained in:
parent
880a6f8efd
commit
c26ef04965
Binary file not shown.
|
@ -14,14 +14,14 @@
|
||||||
;;; You should have received a copy of the GNU General Public License
|
;;; You should have received a copy of the GNU General Public License
|
||||||
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(import (only (ikarus) import))
|
||||||
(import (except (ikarus) assembler-output)
|
(import (except (ikarus) assembler-output))
|
||||||
(ikarus compiler)
|
(import (ikarus compiler))
|
||||||
(except (psyntax system $bootstrap)
|
(import (except (psyntax system $bootstrap)
|
||||||
eval-core
|
eval-core
|
||||||
current-primitive-locations
|
current-primitive-locations
|
||||||
compile-core-expr-to-port))
|
compile-core-expr-to-port))
|
||||||
|
(import (ikarus compiler)) ; just for fun
|
||||||
|
|
||||||
(define scheme-library-files
|
(define scheme-library-files
|
||||||
;;; Listed in the order in which they're loaded.
|
;;; Listed in the order in which they're loaded.
|
||||||
|
|
|
@ -108,23 +108,29 @@
|
||||||
;;; #<rib list-of-symbols list-of-list-of-marks list-of-labels #f>
|
;;; #<rib list-of-symbols list-of-list-of-marks list-of-labels #f>
|
||||||
|
|
||||||
(define (extend-rib! rib id label)
|
(define (extend-rib! rib id label)
|
||||||
(define (find sym mark* sym* mark**)
|
(define (find sym mark* sym* mark** label*)
|
||||||
(and (pair? sym*)
|
(and (pair? sym*)
|
||||||
(or (and (eq? sym (car sym*))
|
(if (and (eq? sym (car sym*)) (same-marks? mark* (car mark**)))
|
||||||
(same-marks? mark* (car mark**)))
|
(car label*)
|
||||||
(find sym mark* (cdr sym*) (cdr mark**)))))
|
(find sym mark* (cdr sym*) (cdr mark**) (cdr label*)))))
|
||||||
(when (rib-sealed/freq rib)
|
(when (rib-sealed/freq rib)
|
||||||
(error 'extend-rib! "rib is sealed" rib))
|
(error 'extend-rib! "rib is sealed" rib))
|
||||||
(let ((sym (id->sym id)) (mark* (stx-mark* id)))
|
(let ((sym (id->sym id))
|
||||||
|
(mark* (stx-mark* id)))
|
||||||
(let ((sym* (rib-sym* rib)))
|
(let ((sym* (rib-sym* rib)))
|
||||||
(when (and (memq sym (rib-sym* rib))
|
(cond
|
||||||
(find sym mark* sym* (rib-mark** rib)))
|
[(and (memq sym (rib-sym* rib))
|
||||||
|
(find sym mark* sym* (rib-mark** rib) (rib-label* rib)))
|
||||||
|
=>
|
||||||
|
(lambda (label^)
|
||||||
|
(unless (eq? label label^)
|
||||||
;;; signal an error if the identifier was already
|
;;; signal an error if the identifier was already
|
||||||
;;; in the rib.
|
;;; in the rib.
|
||||||
(stx-error id "cannot redefine"))
|
(stx-error id "cannot redefine")))]
|
||||||
|
[else
|
||||||
(set-rib-sym*! rib (cons sym sym*))
|
(set-rib-sym*! rib (cons sym sym*))
|
||||||
(set-rib-mark**! rib (cons mark* (rib-mark** rib)))
|
(set-rib-mark**! rib (cons mark* (rib-mark** rib)))
|
||||||
(set-rib-label*! rib (cons label (rib-label* rib))))))
|
(set-rib-label*! rib (cons label (rib-label* rib)))]))))
|
||||||
|
|
||||||
;;; A rib can be sealed once all bindings are inserted. To seal
|
;;; A rib can be sealed once all bindings are inserted. To seal
|
||||||
;;; a rib, we convert the lists sym*, mark**, and label* to vectors
|
;;; a rib, we convert the lists sym*, mark**, and label* to vectors
|
||||||
|
@ -2629,7 +2635,8 @@
|
||||||
(let ([name (car x)])
|
(let ([name (car x)])
|
||||||
(datum->stx ctxt name)))
|
(datum->stx ctxt name)))
|
||||||
subst)
|
subst)
|
||||||
(map cdr subst)))]))
|
(map cdr subst)))]
|
||||||
|
[_ (stx-error e "invalid import form")]))
|
||||||
(let-values (((id* lab*)
|
(let-values (((id* lab*)
|
||||||
(if (module-import? e)
|
(if (module-import? e)
|
||||||
(module-import e r)
|
(module-import e r)
|
||||||
|
|
Loading…
Reference in New Issue