+ (,(ecase class
+ (:unsigned 'unsigned-byte)
+ (:signed 'signed-byte))
+ ,width)
+ (foldable flushable movable)
+ :derive-type (make-modular-fun-type-deriver
+ ',prototype ',class ,width))))
+
+(defun %define-good-modular-fun (name class)
+ (setf (gethash name (modular-class-funs (find-modular-class class))) :good)
+ name)
+
+(defmacro define-good-modular-fun (name class)
+ (check-type name symbol)
+ (check-type class (member :unsigned :signed))
+ `(%define-good-modular-fun ',name ',class))
+
+(defmacro define-modular-fun-optimizer
+ (name ((&rest lambda-list) class &key (width (gensym "WIDTH")))
+ &body body)
+ (check-type name symbol)
+ (check-type class (member :unsigned :signed))
+ (dolist (arg lambda-list)
+ (when (member arg lambda-list-keywords)
+ (error "Lambda list keyword ~S is not supported for ~
+ modular function lambda lists." arg)))
+ (with-unique-names (call args)
+ `(setf (gethash ',name (modular-class-funs (find-modular-class ',class)))
+ (lambda (,call ,width)
+ (declare (type basic-combination ,call)
+ (type (integer 0) width))
+ (let ((,args (basic-combination-args ,call)))
+ (when (= (length ,args) ,(length lambda-list))
+ (destructuring-bind ,lambda-list ,args
+ (declare (type lvar ,@lambda-list))
+ ,@body)))))))