(multiple-value-bind (whole wholeless-arglist)
(if (eq '&whole (car arglist))
(values (cadr arglist) (cddr arglist))
- (values (gensym) arglist))
+ (values (sb!xc:gensym) arglist))
(multiple-value-bind (forms decls)
(parse-body body :doc-string-allowed nil)
`(progn
(!cold-init-forms
- (setf (info :type :translator ',name)
- (lambda (,whole)
- (block ,name
- (destructuring-bind ,wholeless-arglist
- (rest ,whole) ; discarding NAME
- ,@decls
- ,@forms)))))
+ (let ((fun (lambda (,whole)
+ (block ,name
+ (destructuring-bind ,wholeless-arglist
+ (rest ,whole) ; discarding NAME
+ ,@decls
+ ,@forms)))))
+ #-sb-xc-host
+ (setf (%simple-fun-arglist (the simple-fun fun)) ',wholeless-arglist)
+ (setf (info :type :translator ',name) fun)))
',name))))
;;; DEFVARs for these come later, after we have enough stuff defined.
#!-sb-fluid (declaim (inline type-list-cache-hash))
(declaim (ftype (function (list) (unsigned-byte 8)) type-list-cache-hash))
(defun type-list-cache-hash (types)
- (logand (loop with res = 0
- for type in types
- for hash = (type-hash-value type)
- do (setq res (logxor res hash))
- finally (return res))
- #xFF))
+ (logand #xFF
+ (loop with res fixnum = 0
+ for type in types
+ for hash = (type-hash-value type)
+ do (setq res (logxor res hash))
+ finally (return res))))
\f
;;;; cold loading initializations