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
