diff options
author | Andy Wingo <wingo@pobox.com> | 2016-06-21 23:17:25 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-06-21 23:17:25 +0200 |
commit | 0472af4c580f378d75862cb30978bd13e101a89d (patch) | |
tree | 76db7a8f8b84fb39469868888ffde0553a4b9269 | |
parent | 25468496425360edbf2cd7cb9d92648f61dd7d16 (diff) | |
download | guile-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.scm | 7 | ||||
-rw-r--r-- | test-suite/tests/compiler.test | 6 |
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)))))) |