From 54256c89eec80c2a909416dc86c1cc9e0ed0c046 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Sat, 26 Nov 2016 19:46:18 -0800
Subject: Expander warns about unbound variables.

* eval.c (eval_exception): New static function.
(eval_error): Reduced to wrapper around eval_exception.
(eval_warn): New function.
(me_op): Bind the rest symbol in a shadowing env to suppress
watnings about unbound rest.
(do_expand): Throw a warning when a bindable symbol is
traversed that has no binding.
(expand): Don't install atoms as last_form_expanded.

* lib.c (warning_s, restart_s, continue_s): New symbol
variables.
(obj_init): Initialize new symbol variables.

* lib.h (warning_s, restart_s, continue_s): Declared.

* lisplib.c (except_set_entries): New entries for
ignwarn and macro-time-ignwarn.

* parser.c (repl_warning): New static function.
(repl): Use repl_warning function as a handler for
warning exceptions: to print their message and then
continue by throwing a continue exception.

* parser.y (warning_continue): New static function.
(parse_once): Use warning_continue to ignore warnings.
In other words, we suppress warnings from Lisp that is
mixed into TXR pattern language code, because this
produces too many false positives.

* share/txr/stdlib/except.tl (ignwarn, macro-time-ignwarn):
New macros.

* share/txr/stdlib/place.tl (call-update-expander,
call-clobber-expander, call-delete-expander): Ignore warnings
around calls to sys:expand, because of some gensym-related
false positives (we expand code into which we inserted some
gensyms, without having inserted the constructs which
bind them.

* tests/011/macros-2.txr: Suppress unbound variable
warnings from a test case.

* tests/012/ifa.tl: Bind unbound x y variables in one
test case.

* tests/012/struct.tl: Suppress unbound variable
warnings in some test cases.

* uwind.c (uw_throw): If a warning is unhandled, then
print its message with a "warning" prefix and then
throw a continue exception.
(uw_register_subtype): Eliminate the check for sub
already being a subtype of sup. This allows us to
officially register new types against t.
(uw_late_init): Register continue exception type as a
subtype of the restart type.
Formally register warning type.

* txr.1: Documented ignwarn.
---
 tests/011/macros-2.txr | 15 ++++++++-------
 tests/012/ifa.tl       |  2 +-
 tests/012/struct.tl    | 10 +++++-----
 3 files changed, 14 insertions(+), 13 deletions(-)

(limited to 'tests')

diff --git a/tests/011/macros-2.txr b/tests/011/macros-2.txr
index 96045ca4..debc6eca 100644
--- a/tests/011/macros-2.txr
+++ b/tests/011/macros-2.txr
@@ -20,13 +20,14 @@
        (prinl i)))
 
    (prinl
-     (sys:expand
-       '(whilst ((< i 100))
-          (if (< (inc i) 20)
-            continue)
-          (if (> i 30)
-            break)
-          (prinl i))))
+     (ignwarn
+       (sys:expand
+         '(whilst ((< i 100))
+            (if (< (inc i) 20)
+              continue)
+            (if (> i 30)
+              break)
+            (prinl i)))))
 
    (let ((i 0))
      (whilst ((< i 5))
diff --git a/tests/012/ifa.tl b/tests/012/ifa.tl
index 91fa4512..d669244d 100644
--- a/tests/012/ifa.tl
+++ b/tests/012/ifa.tl
@@ -11,7 +11,7 @@
       7)
 
 ;; ambiguous: is "it" x or is "it" y?
-(test (ifa (> x y) (print it)) :error)
+(test (let (x y) (ifa (> x y) (print it))) :error)
 
 ;; "it" is (+ 3 (* 2 x))
 (test (let ((x 5))
diff --git a/tests/012/struct.tl b/tests/012/struct.tl
index cecdfb15..a22d32d0 100644
--- a/tests/012/struct.tl
+++ b/tests/012/struct.tl
@@ -24,7 +24,7 @@
 (test s
       #S(bar a 100 b 4))
 
-(test (sys:expand 'a.b.c.d)
+(test (ignwarn (sys:expand 'a.b.c.d))
       (slot (slot (slot a 'b)
                   'c) 'd))
 
@@ -36,11 +36,11 @@
       [(slot s 'a) b c])
 
 (set *gensym-counter* 0)
-(stest (sys:expand 's.(a))
+(stest (ignwarn (sys:expand 's.(a)))
        "(call (slot s 'a)\n                     \
        \      s)")
 (set *gensym-counter* 0)
-(stest (sys:expand 's.(a b c))
+(stest (ignwarn (sys:expand 's.(a b c)))
        "(call (slot s 'a)\n                     \
        \      s b c)")
 (test (sys:expand 's.[a].d)
@@ -48,11 +48,11 @@
 (test (sys:expand 's.[a b c].d)
       (slot [(slot s 'a) b c] 'd))
 (set *gensym-counter* 0)
-(stest (sys:expand 's.(a).d)
+(stest (ignwarn (sys:expand 's.(a).d))
        "(slot (call (slot s 'a)\n               \
        \            s) 'd)")
 (set *gensym-counter* 0)
-(stest (sys:expand 's.(a b c).d)
+(stest (ignwarn (sys:expand 's.(a b c).d))
        "(slot (call (slot s 'a)\n               \
        \            s b c)\n      'd)")
 
-- 
cgit v1.2.3