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*
	       ((pcase-3
		 #'(lambda (type) (ignore type)
		     (list 'funcall
			   (list 'function
				 (get type 'cl-deftype-satisfies))
			   val)))
		(pcase-2
		 #'(lambda (name args) (ignore name)
		     (list 'cl-typep val
			   (list 'quote
				 (apply (get name 'cl-deftype-handler)
					args)))))
		(pcase-1
		 #'(lambda (name types)
		     (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))))))))))
		(pcase-0
		 #'(lambda (args)
		     (list 'and (list 'memql val (list 'quote args)) t)))
		(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
	      ((symbolp val)
	       (cond
		((let* ((type val)) (get type 'cl-deftype-satisfies))
		 (funcall pcase-3 val))
		((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))))))
		((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)))))
	      ((consp val)
	       (let* ((x7641 (car-safe val)) (x7642 (cdr-safe val)))
		 (cond
		  ((null x7642)
		   (cond
		    ((let* ((type x7641))
		       (get type 'cl-deftype-satisfies))
		     (funcall pcase-3 x7641))
		    ((let* ((name x7641))
		       (get name 'cl-deftype-handler))
		     (funcall pcase-2 x7641 x7642))
		    (t (ignore (memq x7641 '(number float integer)))
		       (cond
			((memq x7641 '(or and))
			 (funcall pcase-1 x7641 x7642))
			((eq x7641 'member) (funcall pcase-0 x7642))
			(t
			 (let ((type val))
			   (error "Bad type spec: %S" type)))))))
		  ((let* ((name x7641))
		     (get name 'cl-deftype-handler))
		   (funcall pcase-2 x7641 x7642))
		  ((memq x7641 '(number float integer))
		   (ignore (consp x7642))
		   (let*
		       ((x7643 (car-safe x7642))
			(x7644 (cdr-safe x7642)))
		     (progn
		       (ignore (consp x7644))
		       (let*
			   ((x7645 (car-safe x7644))
			    (x7646 (cdr-safe x7644)))
			 (progn
			   (ignore (null x7646))
			   (let ((name x7641) (min x7643) (max x7645))
			     (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 x7641 'not)
		   (if (consp x7642)
		       (let*
			   ((x7647 (car-safe x7642))
			    (x7648 (cdr-safe x7642)))
			 (if (null x7648)
			     (let ((type x7647))
			       (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 x7641 '(or and))
		   (funcall pcase-1 x7641 x7642))
		  ((eq x7641 'eql)
		   (if (consp x7642)
		       (let*
			   ((x7649 (car-safe x7642))
			    (x7650 (cdr-safe x7642)))
			 (if (null x7650)
			     (let ((v x7649))
			       (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 x7641 'member) (funcall pcase-0 x7642))
		  ((not (eq x7641 'satisfies))
		   (let ((type val)) (error "Bad type spec: %S" type)))
		  ((consp x7642)
		   (let*
		       ((x7651 (car-safe x7642))
			(x7652 (cdr-safe x7642)))
		     (if (null x7652)
			 (let ((pred x7651))
			   (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))))))
	      (t (let ((type val)) (error "Bad type spec: %S" type)))))))
       (if (eq val exp) body
	 (macroexp-let* (list (list val exp)) body)))))
  (t)]