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

expand-vector-push: reduce complexity (one nesting level less)

Browse source 
catch the infinite recursion and do return-form instead of setting
`whole'.
This commit is contained in:
Daniel Kochmanski 2017-08-10 20:44:35 +02:00
parent 7320c9049c
commit 8293fb6eb4
1 changed files with 36 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

73
src/cmp/cmparray.lsp
View file

@ -93,43 +93,42 @@
(defun expand-vector-push (whole env extend &aux (args (rest whole)))
(declare (si::c-local))
(with-clean-symbols (value vector index dimension)
(unless (or (eq (first args) 'value) ; No infinite recursion
(not (policy-open-code-aref/aset)))
(setf whole
(if (or (< (length args) 2)
(and (not extend)
(> (length args) 2))
(and extend
(> (length args) 3)))
(progn
(cmpwarn "Wrong number of arguments passed to function ~S"
(symbol-function
(if extend
'vector-push-extend
'vector-push)))
`(si::simple-program-error
"Wrong number of arguments passed to function ~S"
(symbol-function
',(if extend
'vector-push-extend
'vector-push))))
`(let* ((value ,(car args))
(vector ,(second args)))
(declare (:read-only value vector)
(optimize (safety 0)))
(optional-type-assertion vector vector)
(let ((index (fill-pointer vector))
(dimension (array-total-size vector)))
(declare (fixnum index dimension)
(:read-only index dimension))
(cond ((< index dimension)
(sys::fill-pointer-set vector (truly-the fixnum (+ 1 index)))
(sys::aset vector index value)
index)
(t ,(if extend
`(vector-push-extend value vector ,@(cddr args))
nil)))))))))
whole)
(when (or (eq (first args) 'value) ; No infinite recursion
(not (policy-open-code-aref/aset)))
(return-from expand-vector-push whole))
(if (or (< (length args) 2)
(and (not extend)
(> (length args) 2))
(and extend
(> (length args) 3)))
(progn
(cmpwarn "Wrong number of arguments passed to function ~S"
(symbol-function
(if extend
'vector-push-extend
'vector-push)))
`(si::simple-program-error
"Wrong number of arguments passed to function ~S"
(symbol-function
',(if extend
'vector-push-extend
'vector-push))))
`(let* ((value ,(car args))
(vector ,(second args)))
(declare (:read-only value vector)
(optimize (safety 0)))
(optional-type-assertion vector vector)
(let ((index (fill-pointer vector))
(dimension (array-total-size vector)))
(declare (fixnum index dimension)
(:read-only index dimension))
(cond ((< index dimension)
(sys::fill-pointer-set vector (truly-the fixnum (+ 1 index)))
(sys::aset vector index value)
index)
(t ,(if extend
`(vector-push-extend value vector ,@(cddr args))
nil))))))))
(define-compiler-macro vector-push (&whole whole &rest args &environment env)
(expand-vector-push whole env nil))