mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-24 20:30:28 +02:00
Fix type inferencing for 'nil?' and 'null?' predicates.
Fixes <https://bugs.gnu.org/33036>. Reported by <calcium@disroot.org>. * module/language/cps/types.scm (define-simple-type-inferrer): Apply (logand (&type val) <>) uniformly. Previously, this was done only in the false branch. Rename local variable to 'type*', to allow the macro operand 'type' to be an arbitrary expression. (*type-inferrers*)<null?>: Add &nil to the set of possible types. (*type-inferrers*)<nil?>: Add &false and &null to the set the possible types. * module/language/cps/type-fold.scm (*branch-folders*)<null?>: Add &nil to the set of possible types. (*branch-folders*)<nil?>: Add &false and &null to the set the possible types. * test-suite/tests/compiler.test: Add tests.
This commit is contained in:
parent
c2a654b7d2
commit
c3e14b74e8
3 changed files with 60 additions and 10 deletions
|
@ -1,5 +1,5 @@
|
|||
;;; Abstract constant folding on CPS
|
||||
;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
|
||||
;;; Copyright (C) 2014, 2015, 2018 Free Software Foundation, Inc.
|
||||
;;;
|
||||
;;; This library is free software: you can redistribute it and/or modify
|
||||
;;; it under the terms of the GNU Lesser General Public License as
|
||||
|
@ -69,8 +69,8 @@
|
|||
|
||||
;; All the cases that are in compile-bytecode.
|
||||
(define-unary-type-predicate-folder pair? &pair)
|
||||
(define-unary-type-predicate-folder null? &null)
|
||||
(define-unary-type-predicate-folder nil? &nil)
|
||||
(define-unary-type-predicate-folder null? (logior &nil &null))
|
||||
(define-unary-type-predicate-folder nil? (logior &false &nil &null))
|
||||
(define-unary-type-predicate-folder symbol? &symbol)
|
||||
(define-unary-type-predicate-folder variable? &box)
|
||||
(define-unary-type-predicate-folder vector? &vector)
|
||||
|
|
|
@ -529,13 +529,14 @@ minimum, and maximum."
|
|||
|
||||
(define-syntax-rule (define-simple-predicate-inferrer predicate type)
|
||||
(define-predicate-inferrer (predicate val true?)
|
||||
(let ((type (if true?
|
||||
type
|
||||
(logand (&type val) (lognot type)))))
|
||||
(restrict! val type -inf.0 +inf.0))))
|
||||
(let ((type* (logand (&type val)
|
||||
(if true?
|
||||
type
|
||||
(lognot type)))))
|
||||
(restrict! val type* -inf.0 +inf.0))))
|
||||
(define-simple-predicate-inferrer pair? &pair)
|
||||
(define-simple-predicate-inferrer null? &null)
|
||||
(define-simple-predicate-inferrer nil? &nil)
|
||||
(define-simple-predicate-inferrer null? (logior &nil &null))
|
||||
(define-simple-predicate-inferrer nil? (logior &false &nil &null))
|
||||
(define-simple-predicate-inferrer symbol? &symbol)
|
||||
(define-simple-predicate-inferrer variable? &box)
|
||||
(define-simple-predicate-inferrer vector? &vector)
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
;;;; compiler.test --- tests for the compiler -*- scheme -*-
|
||||
;;;; Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2008-2014, 2018 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -251,3 +251,52 @@
|
|||
|
||||
(pass-if-equal "test flonum" 0.0 (test-proc #t))
|
||||
(pass-if-equal "test complex" 0.0+0.0i (test-proc #f)))
|
||||
|
||||
(with-test-prefix "null? and nil? inference"
|
||||
(pass-if-equal "nil? after null?"
|
||||
'((f . f) ; 3
|
||||
(f . f) ; #t
|
||||
(f . t) ; #f
|
||||
(t . t) ; #nil
|
||||
(t . t)) ; ()
|
||||
(map (compile '(lambda (x)
|
||||
(if (null? x)
|
||||
(cons 't (if (nil? x) 't 'f))
|
||||
(cons 'f (if (nil? x) 't 'f)))))
|
||||
'(3 #t #f #nil ())))
|
||||
|
||||
(pass-if-equal "nil? after truth test"
|
||||
'((t . f) ; 3
|
||||
(t . f) ; #t
|
||||
(f . t) ; #f
|
||||
(f . t) ; #nil
|
||||
(t . t)) ; ()
|
||||
(map (compile '(lambda (x)
|
||||
(if x
|
||||
(cons 't (if (nil? x) 't 'f))
|
||||
(cons 'f (if (nil? x) 't 'f)))))
|
||||
'(3 #t #f #nil ())))
|
||||
|
||||
(pass-if-equal "null? after nil?"
|
||||
'((f . f) ; 3
|
||||
(f . f) ; #t
|
||||
(t . f) ; #f
|
||||
(t . t) ; #nil
|
||||
(t . t)) ; ()
|
||||
(map (compile '(lambda (x)
|
||||
(if (nil? x)
|
||||
(cons 't (if (null? x) 't 'f))
|
||||
(cons 'f (if (null? x) 't 'f)))))
|
||||
'(3 #t #f #nil ())))
|
||||
|
||||
(pass-if-equal "truth test after nil?"
|
||||
'((f . t) ; 3
|
||||
(f . t) ; #t
|
||||
(t . f) ; #f
|
||||
(t . f) ; #nil
|
||||
(t . t)) ; ()
|
||||
(map (compile '(lambda (x)
|
||||
(if (nil? x)
|
||||
(cons 't (if x 't 'f))
|
||||
(cons 'f (if x 't 'f)))))
|
||||
'(3 #t #f #nil ()))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue