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

When extracting primary types from (VALUES), use NULL.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2011-12-28 16:32:48 +01:00
parent 3f17b631a0
commit d1b82f3e8d
1 changed files with 17 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

32
src/cmp/cmptype-arith.lsp
View file

@ -107,13 +107,11 @@
(cmpwarn "Unsupported CONS type ~S. Replacing it with T." t2)
t1)
((null tag1)
(setf c::*compiler-break-enable* t)
;(break)
;(setf c::*compiler-break-enable* t) (break)
(cmpnote "Unknown type ~S. Assuming it is T." t1)
t2)
(t
(setf c::*compiler-break-enable* t)
;(break)
;(setf c::*compiler-break-enable* t) (break)
(cmpnote "Unknown type ~S. Assuming it is T." t2)
t1))))
@ -129,18 +127,22 @@
(values l l)))))
(defun-equal-cached values-type-primary-type (type)
;; Extract the type of the first value returned by this form. We are
;; pragmatic and thus (VALUES) => NULL [CHECKME!]
(when (and (consp type) (eq (first type) 'VALUES))
(let ((subtype (second type)))
(when (or (eq subtype '&optional) (eq subtype '&rest))
(setf type (cddr type))
(when (or (null type)
(eq (setf subtype (first type)) '&optional)
(eq subtype '&rest))
(cmperr "Syntax error in type expression ~S" type))
;; An &optional or &rest output value might be missing
;; If this is the case, the the value will be NIL.
(setf subtype (type-or 'null subtype)))
(setf type subtype)))
(if (null (rest type))
(setf type 'null)
(let ((subtype (second type)))
(when (or (eq subtype '&optional) (eq subtype '&rest))
(setf type (cddr type))
(when (or (null type)
(eq (setf subtype (first type)) '&optional)
(eq subtype '&rest))
(cmperr "Syntax error in type expression ~S" type))
;; An &optional or &rest output value might be missing
;; If this is the case, the the value will be NIL.
(setf subtype (type-or 'null subtype)))
(setf type subtype))))
type)
(defun-equal-cached values-type-to-n-types (type length)