recursive autoload bug fix

This commit is contained in:
ESL 2024-07-10 01:40:02 -04:00
parent c30ed2217d
commit 1b113e59ec
2 changed files with 27 additions and 20 deletions

View file

@ -131,10 +131,10 @@
(let ([a (car al)])
(if (eq? x (cdr a)) a (rassq x (cdr al))))))
(define (remove! x l pred?) ; applies (pred? (car l) x)
(define (remove! x l pred?) ; applies (pred? x (car l))
(let loop ([f #f] [l #f] [r l])
(cond [(not (pair? r)) (if l (begin (set-cdr! l r) f) r)]
[(pred? (car r) x) (loop f l (cdr r))]
[(pred? x (car r)) (loop f l (cdr r))]
[l (set-cdr! l r) (loop f r (cdr r))]
[else (loop r r (cdr r))])))
@ -1756,9 +1756,12 @@
(let ([val (mkdefval name)]) ; check if it didn't fail:
(cond [(not val) #f] ; mkdefval rejected the idea
[(location? val) val] ; found good location elsewhere
[else (let ([loc (make-location val)]) ; ok, put it in:
(vector-set! nr i (cons (cons name loc) al))
loc)]))]
[else (let ([al (vector-ref nr i)] [p (if (pair? name) (assoc name al) (assq name al))])
; note: have to refetch both cause mkdefval call could've change them!
(if p (x-error "recursive library dependence on" name)
(let ([loc (make-location val)]) ; ok, put it in:
(vector-set! nr i (cons (cons name loc) al))
loc)))]))]
[else #f])))
(define (name-install! nr name loc) ;=> same|modified|added
@ -1770,7 +1773,7 @@
(define (name-remove! nr name)
(let* ([n-1 (- (vector-length nr) 1)] [i (if (pair? name) n-1 (immediate-hash name n-1))])
(vector-set! nr i (remove! name (vector-ref nr i) (lambda (p name) (equal? (car p) name))))))
(vector-set! nr i (remove! name (vector-ref nr i) (lambda (name p) (equal? (car p) name))))))
; public registry for all non-hidden skint names
(define *root-name-registry* (make-name-registry 300))
@ -2109,8 +2112,9 @@
(let ([res (env eal 'import)])
(unless res ; this env does not support import
(x-error "failed to import to env, import is not supported:" env eal))
(when (and *verbose* (sexp-match? '(<number> <number> <number>) res))
(display "IMPORT: ")
(when (and (or (not *quiet*) *verbose*)
(sexp-match? '(<number> <number> <number>) res))
(if *verbose* (display "IMPORT: ") (display "; import: "))
(write (car res)) (display " bindings are the same, ")
(write (cadr res)) (display " modified, ")
(write (caddr res)) (display " added\n")))

27
t.c
View file

@ -75,7 +75,7 @@ char *t_code[] = {
"%2.1p?{.1a,.0d,.2q?{.0]3}.2d,.2,@(y5:rassq)[32}f]2",
"P", "remove!",
"%3.1,f,f,,#0.0,.7,.6,&3{%3.2p~?{.1?{.2,.2sd.0]3}.2]3}${:0,.5a,:1[02}?{"
"%3.1,f,f,,#0.0,.7,.6,&3{%3.2p~?{.1?{.2,.2sd.0]3}.2]3}${.4a,:0,:1[02}?{"
".2d,.2,.2,:2^[33}.1?{.2,.2sd.2d,.3,.2,:2^[33}.2d,.3,.4,:2^[33}.!0.0^_1"
"[33",
@ -1014,7 +1014,9 @@ char *t_code[] = {
"P", "name-lookup",
"%3'1,.1V3-,.2p?{.0}{.0,.3H2},.0,.3V4,.4p?{.0,.5A5}{.0,.5A3},.0?{.0d]7}"
".6?{${.7,.9[01},.0~?{f]8}.0Y2?{.0]8}.0b,.3,.1,.9cc,.5,.8V5.0]9}f]7",
".6?{${.7,.9[01},.0~?{f]8}.0Y2?{.0]8}.6p?{.2,.7A5}{.2,.7A3},.4,.7V4,.1?"
"{.8,'(s31:recursive library dependence on),@(y7:x-error)[(i10)2}.2b,.1"
",.1,.(i11)cc,.7,.(i10)V5.0](i11)}f]7",
"P", "name-install!",
"%3'1,.1V3-,.2p?{.0}{.0,.3H2},.0,.3V4,.4p?{.0,.5A5}{.0,.5A3},.0?{.6,.1d"
@ -1022,7 +1024,7 @@ char *t_code[] = {
":added)]7",
"P", "name-remove!",
"%2'1,.1V3-,.2p?{.0}{.0,.3H2},${&0{%2.1,.1ae]2},.3,.6V4,.7,@(y7:remove!"
"%2'1,.1V3-,.2p?{.0}{.0,.3H2},${&0{%2.0,.2ae]2},.3,.6V4,.7,@(y7:remove!"
")[03},.1,.4V5]4",
"C", 0,
@ -1323,15 +1325,16 @@ char *t_code[] = {
"5PoW6]5}]5}'(y6:import),.1q?{${t,.5,.5d,.6a,@(y12:xform-import)[04},.0"
"da,'0,.1V4,'1,.2V4,${'(y6:import),.3,.(i10)[02},.0~?{${.3,.(i10),'(s49"
":failed to import to env, import is not supported:),@(y7:x-error)[03}}"
"@(y9:*verbose*)?{${.2,'(l3:y8:<number>;y8:<number>;y8:<number>;),@(y11"
":sexp-match?)[02}}{f}?{Po,'(s8:IMPORT: )W4Po,.1aW5Po,'(s24: bindings a"
"re the same, )W4Po,.1daW5Po,'(s11: modified, )W4Po,.1ddaW5Po,'(s7: add"
"ed%0a)W4}_1.1,@(y30:repl-compile-and-run-core-expr)[71}.0K0?{.2,${.5,."
"5,.5[02},@(y18:repl-eval-top-form)[32}.0U0?{${.4,.4d,.4,@(y16:xform-in"
"tegrable)[03},@(y30:repl-compile-and-run-core-expr)[31}.0Y0?{${.4,.4,f"
",@(y5:xform)[03},@(y30:repl-compile-and-run-core-expr)[31}${.4,.4d,.4,"
"@(y10:xform-call)[03},@(y30:repl-compile-and-run-core-expr)[31}${.3,.3"
",f,@(y5:xform)[03},@(y30:repl-compile-and-run-core-expr)[21",
"@(y7:*quiet*)~,.0?{.0}{@(y9:*verbose*)}_1?{${.2,'(l3:y8:<number>;y8:<n"
"umber>;y8:<number>;),@(y11:sexp-match?)[02}}{f}?{@(y9:*verbose*)?{Po,'"
"(s8:IMPORT: )W4}{Po,'(s10:; import: )W4}Po,.1aW5Po,'(s24: bindings are"
" the same, )W4Po,.1daW5Po,'(s11: modified, )W4Po,.1ddaW5Po,'(s7: added"
"%0a)W4}_1.1,@(y30:repl-compile-and-run-core-expr)[71}.0K0?{.2,${.5,.5,"
".5[02},@(y18:repl-eval-top-form)[32}.0U0?{${.4,.4d,.4,@(y16:xform-inte"
"grable)[03},@(y30:repl-compile-and-run-core-expr)[31}.0Y0?{${.4,.4,f,@"
"(y5:xform)[03},@(y30:repl-compile-and-run-core-expr)[31}${.4,.4d,.4,@("
"y10:xform-call)[03},@(y30:repl-compile-and-run-core-expr)[31}${.3,.3,f"
",@(y5:xform)[03},@(y30:repl-compile-and-run-core-expr)[21",
"P", "repl-read",
"%2.1?{PoW6Po,.2W4Po,'(s1: )W4}.0,@(y14:read-code-sexp)[21",