Commit 03afa98d authored by Juan Jose Garcia Ripoll's avatar Juan Jose Garcia Ripoll
Browse files

Since not always the compiler macros are applied, we are forced to have type...

Since not always the compiler macros are applied, we are forced to have type propagators that handle the 1, 2 and more argument cases for +, *, / and -.
parent 759fa298
......@@ -77,35 +77,30 @@
(when (and (null t2-eq) (type>= i t2))
(setf t2-eq i output i)))))
(defun prod/plus-propagator (op1 op2)
(multiple-value-bind (result-type op1-type op2-type)
(maximum-number-type (c1form-primary-type op1)
(c1form-primary-type op2))
(when (and (eq op1-type 'FIXNUM)
(eq op2-type 'FIXNUM))
(setf result-type 'INTEGER))
(values (list op1-type op2-type) result-type)))
(defun arithmetic-propagator (op1 others integer-result)
(loop with op1-type = (c1form-primary-type op1)
with result-type = (maximum-number-type op1-type op1-type)
with arg-types = (list (setf op1-type result-type))
for op2 in others
for op2-type = (c1form-primary-type op2)
do (progn
(multiple-value-setq (result-type op1-type op2-type)
(maximum-number-type op1-type op2-type))
(when (and (or (eq op1-type 'FIXNUM) (eq op1-type 'INTEGER))
(or (eq op2-type 'FIXNUM) (eq op2-type 'INTEGER)))
(setf result-type integer-result))
(setf arg-types (cons op2-type arg-types)
op1-type result-type))
finally (return (values (nreverse arg-types) result-type))))
(def-type-propagator * (fname op1 op2)
(prod/plus-propagator op1 op2))
(def-type-propagator * (fname op1 &rest others)
(arithmetic-propagator op1 others 'integer))
(def-type-propagator + (fname op1 op2)
(prod/plus-propagator op1 op2))
(def-type-propagator + (fname op1 &rest others)
(arithmetic-propagator op1 others 'integer))
(def-type-propagator - (fname op1 &optional (op2 nil op2-p))
(let* ((t1 (c1form-primary-type op1))
(t2 (if op2-p (c1form-primary-type op2) t1)))
(values (if op2-p (list t1 t2) (list t1))
(maximum-number-type t1 t2))))
(def-type-propagator - (fname op1 &rest others)
(arithmetic-propagator op1 others 'integer))
(def-type-propagator / (fname op1 &optional (op2 nil op2-p))
(multiple-value-bind (output t1 t2)
(let ((t1 (c1form-primary-type op1)))
(if op2-p
(maximum-number-type t1 (c1form-primary-type op2))
(maximum-number-type 'FIXNUM t1)))
(when (and (member t1 '(FIXNUM INTEGER))
(member t2 '(FIXNUM INTEGER)))
(setf output 'RATIONAL))
(values (if op2-p (list t1 t2) (list t1))
output)))
(def-type-propagator / (fname op1 &rest others)
(arithmetic-propagator op1 others 'rational))
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment