After some more testing I've got a revised and hopefully better patchset. Please review with care, Lemonboy
On 10 May 2017 at 11:00, Evan Hanson <ev...@foldling.org> wrote: > Hey Lemonboy, > > On 2017-05-09 16:20, lemonboy wrote: >> since both `##sys#macro-environment` and `##sys#current-environment` >> are alists whose keys are unqualified symbol names it doesn't make >> sense to use `var` as lookup key since after the initial lookup of >> `var0` against the environment we possibly get back a fully-qualified >> symbol thus making the lookup fail. > > Good catch, thanks. > > Just repeating what I said on IRC: could you add a small test that > checks for one of each of these warnings? There are already some tests > that check the compiler's output, and even just adding the example you > gave to one of those would be fine. > >> I don't know if the same treatment should be applied to the `keyword?` >> test below, if it can be folded inside the `cond` > > Keywords are never bound in the environment so it doesn't matter, but if > you want to use the same variable as is used in the other checks for > consistency's sake, that makes sense to me. Pulling it up makes sense > too. > > Cheers, > > Evan
From 1e0578bea0b0c499ee72f1be9fa6fe276521ed4a Mon Sep 17 00:00:00 2001 From: LemonBoy <thatle...@gmail.com> Date: Mon, 15 May 2017 19:58:17 +0200 Subject: [PATCH 1/4] Small code cleanup in the expander Merge ##sys#undefine-macro! with ##sys#unregister-macro since the latter was just a wrapper around the former. --- expand.scm | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/expand.scm b/expand.scm index 4397d22a..3a727b7f 100644 --- a/expand.scm +++ b/expand.scm @@ -204,18 +204,14 @@ (and-let* ((l (lookup sym (##sys#macro-environment)))) (pair? l)))) -(define (##sys#unregister-macro name) +(define (##sys#undefine-macro! name) (##sys#macro-environment ;; this builds up stack, but isn't used often anyway... - (let loop ((me (##sys#macro-environment)) (me2 '())) + (let loop ((me (##sys#macro-environment))) (cond ((null? me) '()) ((eq? name (caar me)) (cdr me)) (else (cons (car me) (loop (cdr me)))))))) -(define (##sys#undefine-macro! name) - (##sys#unregister-macro name) ) - - ;; The basic macro-expander (define (##sys#expand-0 exp dse cs?) -- 2.13.0
From f77874a59e016706ca73f6acec0ea03dc71fc54a Mon Sep 17 00:00:00 2001 From: LemonBoy <thatle...@gmail.com> Date: Mon, 15 May 2017 20:14:42 +0200 Subject: [PATCH 2/4] Use the raw variable name in env lookups and errors The current-environment and the macro-environment are alists whose keys are the raw variable names. Also reword the error messages a little. --- core.scm | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) diff --git a/core.scm b/core.scm index 8f68e3fa..5af0cd7c 100644 --- a/core.scm +++ b/core.scm @@ -1107,24 +1107,25 @@ (set! val `(let ((,var ,val)) (##core#debug-event "C_DEBUG_GLOBAL_ASSIGN" ',var) - ,var)))) - (cond ((##sys#macro? var) - (warning - (sprintf "~aassigned global variable `~S' is syntax" - (if ln (sprintf "(~a) - " ln) "") - var)) - (when undefine-shadowed-macros (##sys#undefine-macro! var))) - ((and ##sys#notices-enabled - (assq var (##sys#current-environment))) - (##sys#notice - (sprintf "~aassignment to imported value binding `~S'" - (if ln (sprintf "(~a) - " ln) "") - var)))) - (when (keyword? var) - (warning - (sprintf "~aassignment to keyword `~S'" - (if ln (sprintf "(~a) - " ln) "") - var))) + ,var))) + ;; We use `var0` instead of `var` because the {macro,current}-environment + ;; are keyed by the raw and unqualified name + (cond ((##sys#macro? var0 se) + (warning + (sprintf "~aassignment to syntax `~S'" + (if ln (sprintf "(~a) - " ln) "") + var0)) + (when undefine-shadowed-macros (##sys#undefine-macro! var0))) + ((assq var0 (##sys#current-environment)) + (warning + (sprintf "~aassignment to imported value binding `~S'" + (if ln (sprintf "(~a) - " ln) "") + var0))) + ((keyword? var0) + (warning + (sprintf "~aassignment to keyword `~S'" + (if ln (sprintf "(~a) - " ln) "") + var0))))) `(set! ,var ,(walk val e se var0 (memq var e) h ln #f)))))) ((##core#debug-event) -- 2.13.0
From 97e1c92eee2558b283aca15ca23a28766ce11079 Mon Sep 17 00:00:00 2001 From: LemonBoy <thatle...@gmail.com> Date: Mon, 15 May 2017 20:17:02 +0200 Subject: [PATCH 3/4] Add some unit tests --- distribution/manifest | 2 ++ tests/msgs-test.scm | 13 +++++++++++++ tests/msgs.expected | 6 ++++++ tests/runtests.sh | 4 ++++ tests/scrutiny.expected | 2 +- 5 files changed, 26 insertions(+), 1 deletion(-) create mode 100644 tests/msgs-test.scm create mode 100644 tests/msgs.expected diff --git a/distribution/manifest b/distribution/manifest index 7e9c3adb..8d03aa8a 100644 --- a/distribution/manifest +++ b/distribution/manifest @@ -234,6 +234,8 @@ tests/reverser/tags/1.1/reverser.scm tests/rev-app.scm tests/user-pass-tests.scm tests/version-tests.scm +tests/msgs-test.scm +tests/msgs.expected tweaks.scm Makefile Makefile.android diff --git a/tests/msgs-test.scm b/tests/msgs-test.scm new file mode 100644 index 00000000..dd7baf31 --- /dev/null +++ b/tests/msgs-test.scm @@ -0,0 +1,13 @@ +(module boo * + (import scheme) + (define var 42)) +(module foo * + (import scheme chicken boo) +(define-syntax bar + (syntax-rules ())) +(set! bar 42) ;; set!-ing a macro +(set! var 42) ;; set!-ing an imported identifier +(let ((var #f)) (set! var 42)) ;; set!-ing a local variable +(letrec-values ((bar (values)))) ;; shadow a syntax item +(let-syntax ((m (syntax-rules ()))) (set! m 42)) +) diff --git a/tests/msgs.expected b/tests/msgs.expected new file mode 100644 index 00000000..3d77e187 --- /dev/null +++ b/tests/msgs.expected @@ -0,0 +1,6 @@ + +Warning: (msgs-test.scm:8) - assignment to syntax `bar' + +Warning: (msgs-test.scm:9) - assignment to imported value binding `var' + +Warning: (msgs-test.scm:12) - assignment to syntax `m' diff --git a/tests/runtests.sh b/tests/runtests.sh index 16fcb97f..4e7c243a 100755 --- a/tests/runtests.sh +++ b/tests/runtests.sh @@ -62,6 +62,10 @@ echo "======================================== version tests ..." $compile version-tests.scm ./a.out +echo "======================================== compiler messages tests ..." +$compile -A msgs-test.scm 2>msgs.out +diff $DIFF_OPTS msgs.expected msgs.out + echo "======================================== compiler tests ..." $compile compiler-tests.scm ./a.out diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected index 581aa45b..0641540f 100644 --- a/tests/scrutiny.expected +++ b/tests/scrutiny.expected @@ -1,5 +1,5 @@ -Note: (scrutiny-tests.scm:31) - assignment to imported value binding `car' +Warning: (scrutiny-tests.scm:31) - assignment to imported value binding `car' Note: in local procedure `c', in local procedure `b', -- 2.13.0
From b71b30cd4881479894715c6a4e3f984fe42dce94 Mon Sep 17 00:00:00 2001 From: LemonBoy <thatle...@gmail.com> Date: Mon, 15 May 2017 20:19:37 +0200 Subject: [PATCH 4/4] Keep the module module-defined-syntax-list updated When a macro is shadowed via a set! it is also removed from the macro-environment but not from the current module's export list. This leads to a compile-time error during the module finalization phase. --- core.scm | 4 +++- modules.scm | 6 ++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/core.scm b/core.scm index 5af0cd7c..a03cdf17 100644 --- a/core.scm +++ b/core.scm @@ -1115,7 +1115,9 @@ (sprintf "~aassignment to syntax `~S'" (if ln (sprintf "(~a) - " ln) "") var0)) - (when undefine-shadowed-macros (##sys#undefine-macro! var0))) + (when undefine-shadowed-macros + (##sys#undefine-macro! var0) + (##sys#unregister-syntax-export var0 (##sys#current-module)))) ((assq var0 (##sys#current-environment)) (warning (sprintf "~aassignment to imported value binding `~S'" diff --git a/modules.scm b/modules.scm index 2bf32c6c..a994aabd 100644 --- a/modules.scm +++ b/modules.scm @@ -223,6 +223,12 @@ mod (cons (cons sym val) (module-defined-syntax-list mod)))))) +(define (##sys#unregister-syntax-export sym mod) + (when mod + (set-module-defined-syntax-list! mod + (delete sym (module-defined-syntax-list mod) + (lambda (x y) (eq? x (car y))))))) + (define (register-undefined sym mod where) (when mod (let ((ul (module-undefined-list mod))) -- 2.13.0
_______________________________________________ Chicken-hackers mailing list Chicken-hackers@nongnu.org https://lists.nongnu.org/mailman/listinfo/chicken-hackers