diff options
| author | Stas Boukarev <stassats@gmail.com> | 2024-09-29 20:15:24 +0300 |
|---|---|---|
| committer | Stas Boukarev <stassats@gmail.com> | 2024-09-29 23:11:51 +0300 |
| commit | 4a0cf7bfb8faa5c7596391cab66788f2b16527ae (patch) | |
| tree | 7d2a7627c2bb3c4fd7cab594f79941faca67958e /src/compiler/constraint-back.lisp | |
| parent | 459d99c027db1a630174e3269d49188832e57dca (diff) | |
Add constraint-propagate-back for ABS.
Diffstat (limited to 'src/compiler/constraint-back.lisp')
| -rw-r--r-- | src/compiler/constraint-back.lisp | 22 |
1 files changed, 22 insertions, 0 deletions
diff --git a/src/compiler/constraint-back.lisp b/src/compiler/constraint-back.lisp index 7396fafcb..a7d8bdb7f 100644 --- a/src/compiler/constraint-back.lisp +++ b/src/compiler/constraint-back.lisp @@ -244,6 +244,28 @@ (typep (-constraint-propagate-back nil x (specifier-type '(eql 0)) (lvar-type x) kind constraint gen consequent)))) +(defoptimizer (abs constraint-propagate-back) ((x) node nth-value kind constraint gen consequent alternative) + (declare (ignore nth-value alternative)) + (case kind + (typep + (flet ((add (lvar type) + (let ((var (and lvar + (ok-lvar-lambda-var lvar gen)))) + (when var + (conset-add-constraint-to-eql gen 'typep var type nil consequent))))) + (cond ((csubtypep constraint (specifier-type 'integer)) + (let ((int (type-approximate-interval constraint t))) + (add x (specifier-type (if (and int + (typep (interval-high int) 'unsigned-byte)) + `(integer ,(- (interval-high int)) + ,(interval-high int)) + 'integer))) + t)) + ((csubtypep constraint (specifier-type 'rational)) + (add x (specifier-type 'rational))) + ((csubtypep constraint (specifier-type 'float)) + (add x (specifier-type '(or complex float))))))))) + (defoptimizer (char-code constraint-propagate-back) ((x) node nth-value kind constraint gen consequent alternative) (declare (ignore nth-value)) (case kind |