mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-21 03:51:47 -08:00
Code Issues Projects Releases Packages Wiki Activity

Fixed a couple of typos in the new type propagations for special functions

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-07-12 23:46:45 +02:00
parent fb5306016c
commit f5c03a9638
1 changed files with 13 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

26
src/cmp/cmpnum.lsp
View file

@ -157,33 +157,33 @@
(unless (eql simplified-exponent 'integer)
(setf simplified-exponent (ensure-nonrational-type simplified-exponent)))
(multiple-value-bind (result-type base aux)
(maximum-number-type result-type base simplified-exponent)
(maximum-number-type base simplified-exponent)
(values (list base exponent) result-type))))
(def-type-propagator abs (fname arg)
(multiple-value-bind (output arg)
(ensure-number-type arg)
(values (list arg)
(or (getf '((FIXNUM (INTEGER 0 #.MOST-POSITIVE-FIXNUM))
(INTEGER (INTEGER 0 *))
(RATIONAL (RATIONAL 0 *))
(SHORT-FLOAT (SHORT-FLOAT 0 *))
(SINGLE-FLOAT (SINGLE-FLOAT 0 *))
(DOUBLE-FLOAT (DOUBLE-FLOAT 0 *))
(LONG-FLOAT (LONG-FLOAT 0 *))
(REAL (REAL 0 *))
(NUMBER (REAL 0 *)))
output)
(or (cdr (assoc output
'((FIXNUM . (INTEGER 0 #.MOST-POSITIVE-FIXNUM))
(INTEGER . (INTEGER 0 *))
(RATIONAL . (RATIONAL 0 *))
(SHORT-FLOAT . (SHORT-FLOAT 0 *))
(SINGLE-FLOAT . (SINGLE-FLOAT 0 *))
(DOUBLE-FLOAT . (DOUBLE-FLOAT 0 *))
(LONG-FLOAT . (LONG-FLOAT 0 *))
(REAL . (REAL 0 *))
(NUMBER . (REAL 0 *)))))
output))))
(def-type-propagator sqrt (fname arg)
(multiple-value-bind (output arg)
(ensure-nonrational-type arg)
(values (list arg)
(if (type<= arg '(REAL 0 *)) output 'NUMBER))))
(if (type>= '(REAL 0 *) arg) output 'NUMBER))))
(def-type-propagator isqrt (fname arg)
(if (type<= arg '#1=(integer 0 #.MOST-POSITIVE-FIXNUM))
(if (type>= '#1=(integer 0 #.MOST-POSITIVE-FIXNUM) arg)
(values '(#1#) #1#)
(values '(#2=(integer 0 *)) #2#)))