summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-06-21 23:17:25 +0200
committerAndy Wingo <wingo@pobox.com>2016-06-21 23:17:25 +0200
commit0472af4c580f378d75862cb30978bd13e101a89d (patch)
tree76db7a8f8b84fb39469868888ffde0553a4b9269
parent25468496425360edbf2cd7cb9d92648f61dd7d16 (diff)
downloadguile-0472af4c580f378d75862cb30978bd13e101a89d.tar.gz
Fix (< 'foo) compilation
* module/language/tree-il/primitives.scm (expand-chained-comparisons): Fix (< 'foo) compilation. * test-suite/tests/compiler.test ("regression tests"): Add test case.
-rw-r--r--module/language/tree-il/primitives.scm7
-rw-r--r--test-suite/tests/compiler.test6
2 files changed, 11 insertions, 2 deletions
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 724f38416..0a88f1476 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -579,7 +579,12 @@
(define (expand-chained-comparisons prim)
(case-lambda
((src) (make-const src #t))
- ((src a) (make-const src #t))
+ ((src a)
+ ;; (< x) -> (begin (< x 0) #t). Residualizes side-effects from x
+ ;; and, for numeric comparisons, checks that x is a number.
+ (make-seq src
+ (make-primcall src prim (list a (make-const src 0)))
+ (make-const src #t)))
((src a b) #f)
((src a b . rest)
(make-conditional src (make-primcall src prim (list a b))
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index b29491296..bdae9a75d 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -209,4 +209,8 @@
'(begin
(define x (list 1))
(define x (car x))
- x))))
+ x)))
+
+ (pass-if "Chained comparisons"
+ (not (compile
+ '(false-if-exception (< 'not-a-number))))))