Function: cl-typep--inliner

cl-typep--inliner is a function defined in cl-macs.el.gz.

Signature

(cl-typep--inliner INLINE--FORM VAL TYPE)

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/cl-macs.el.gz
;; Could not find source code, showing raw function object.
#[(inline--form val type)
  ((ignore inline--form)
   (catch 'inline--just-use
     (let*
	 ((exp val)
	  (val (if (macroexp-copyable-p exp) exp (make-symbol "val")))
	  (body
	   (let*
	       ((val
		 (cond
		  ((not
		    (or (macroexp-const-p type)
			(eq (car-safe type) 'function)))
		   (throw 'inline--just-use inline--form))
		  ((consp type) (car (cdr type))) (t type))))
	     (cond
	      ((consp val)
	       (let* ((x3526 (car-safe val)) (x3527 (cdr-safe val)))
		 (cond
		  ((let* ((name x3526))
		     (get name 'cl-deftype-handler))
		   (let ((name x3526) (args x3527))
		     (ignore name)
		     (list 'cl-typep val
			   (list 'quote
				 (apply (get name 'cl-deftype-handler)
					args)))))
		  ((memq x3526 '(number real float integer))
		   (ignore (consp x3527))
		   (let*
		       ((x3528 (car-safe x3527))
			(x3529 (cdr-safe x3527)))
		     (progn
		       (ignore (consp x3529))
		       (let*
			   ((x3530 (car-safe x3529))
			    (x3531 (cdr-safe x3529)))
			 (progn
			   (ignore (null x3531))
			   (let ((name x3526) (min x3528) (max x3530))
			     (list 'and
				   (list 'cl-typep val
					 (list 'quote name))
				   (if (memq min '(* nil)) t
				     (if (consp min)
					 (list '> val
					       (list 'quote (car min)))
				       (list '>= val (list 'quote min))))
				   (if (memq max '(* nil)) t
				     (if (consp max)
					 (list '< val
					       (list 'quote (car max)))
				       (list '<= val (list 'quote max)))))))))))
		  ((eq x3526 'not)
		   (if (consp x3527)
		       (let*
			   ((x3532 (car-safe x3527))
			    (x3533 (cdr-safe x3527)))
			 (if (null x3533)
			     (let ((type x3532))
			       (list 'not
				     (list 'cl-typep val
					   (list 'quote type))))
			   (let ((type val))
			     (error "Bad type spec: %S" type))))
		     (let ((type val))
		       (error "Bad type spec: %S" type))))
		  ((memq x3526 '(or and))
		   (let ((name x3526) (types x3527))
		     (cond ((null types) (list 'quote (eq name 'and)))
			   ((null (cdr types))
			    (list 'cl-typep val
				  (list 'quote (car types))))
			   (t
			    (let
				((head (car types))
				 (rest (cons name (cdr types))))
			      (cond
			       ((eq name 'and)
				(list 'and
				      (list 'cl-typep val
					    (list 'quote head))
				      (list 'cl-typep val
					    (list 'quote rest))))
			       (t
				(list 'or
				      (list 'cl-typep val
					    (list 'quote head))
				      (list 'cl-typep val
					    (list 'quote rest))))))))))
		  ((eq x3526 'eql)
		   (if (consp x3527)
		       (let*
			   ((x3534 (car-safe x3527))
			    (x3535 (cdr-safe x3527)))
			 (if (null x3535)
			     (let ((v x3534))
			       (list 'and
				     (list 'eql val (list 'quote v)) t))
			   (let ((type val))
			     (error "Bad type spec: %S" type))))
		     (let ((type val))
		       (error "Bad type spec: %S" type))))
		  ((eq x3526 'member)
		   (let ((args x3527))
		     (list 'and (list 'memql val (list 'quote args)) t)))
		  ((not (eq x3526 'satisfies))
		   (let ((type val)) (error "Bad type spec: %S" type)))
		  ((consp x3527)
		   (let*
		       ((x3536 (car-safe x3527))
			(x3537 (cdr-safe x3527)))
		     (if (null x3537)
			 (let ((pred x3536))
			   (list 'funcall (list 'function pred) val))
		       (let ((type val))
			 (error "Bad type spec: %S" type)))))
		  (t
		   (let ((type val)) (error "Bad type spec: %S" type))))))
	      ((not (symbolp val))
	       (let ((type val)) (error "Bad type spec: %S" type)))
	      ((let* ((type val)) (get type 'cl-deftype-handler))
	       (let ((type val))
		 (ignore type)
		 (list 'cl-typep val
		       (list 'quote
			     (funcall (get type 'cl-deftype-handler))))))
	      ((let* ((type val)) (get type 'cl-deftype-satisfies))
	       (let ((type val))
		 (ignore type)
		 (list 'funcall
		       (list 'function
			     (get type 'cl-deftype-satisfies))
		       val)))
	      ((memq val '(t nil))
	       (let ((type val)) (list 'quote type)))
	      (t
	       (let ((type val))
		 (macroexp-warn-and-return
		  (format-message "Unknown type: %S" type)
		  (let*
		      ((name (symbol-name type))
		       (namep (intern (concat name "p"))))
		    (cond
		     ((cl--macroexp-fboundp namep)
		      (list 'funcall (list 'function namep) val))
		     ((cl--macroexp-fboundp
		       (setq namep (intern (concat name "-p"))))
		      (list 'funcall (list 'function namep) val))
		     ((cl--macroexp-fboundp type)
		      (list 'funcall (list 'function type) val))
		     (t (error "Unknown type %S" type))))
		  nil nil type)))))))
       (if (eq val exp) body
	 (macroexp-let* (list (list val exp)) body)))))
  (t)]