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: further reduce complexity

Browse source 
use return-from for catching forms of illegal number of arguments.
This commit is contained in:
Daniel Kochmanski 2017-08-10 20:55:11 +02:00
parent 8293fb6eb4
commit bf310ef23a
1 changed files with 24 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

57
src/cmp/cmparray.lsp
View file

@ -95,40 +95,31 @@
(with-clean-symbols (value vector index dimension)
(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)))
(return-from expand-vector-push
whole))
(let ((len (length args)))
(when (or (< len 2)
(> len (if extend 3 2)))
(cmpwarn "Wrong number of arguments passed to function ~A in form: ~A" (first whole) whole)
(return-from expand-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))))))))
"Wrong number of arguments passed to function ~A in form: ~A" ',(first whole) ',whole))))
`(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))