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* ((x3021 (car-safe val)) (x3022 (cdr-safe val)))
		 (cond
		  ((null x3022)
		   (cond
		    ((let* ((type x3021))
		       (get type 'cl-deftype-satisfies))
		     (funcall pcase-3 x3021))
		    ((let* ((name x3021))
		       (get name 'cl-deftype-handler))
		     (funcall pcase-2 x3021 x3022))
		    (t (ignore (memq x3021 '(number float integer)))
		       (cond
			((memq x3021 '(or and))
			 (funcall pcase-1 x3021 x3022))
			((eq x3021 'member) (funcall pcase-0 x3022))
			(t
			 (let ((type val))
			   (error "Bad type spec: %S" type)))))))
		  ((let* ((name x3021))
		     (get name 'cl-deftype-handler))
		   (funcall pcase-2 x3021 x3022))
		  ((memq x3021 '(number float integer))
		   (ignore (consp x3022))
		   (let*
		       ((x3023 (car-safe x3022))
			(x3024 (cdr-safe x3022)))
		     (progn
		       (ignore (consp x3024))
		       (let*
			   ((x3025 (car-safe x3024))
			    (x3026 (cdr-safe x3024)))
			 (progn
			   (ignore (null x3026))
			   (let ((name x3021) (min x3023) (max x3025))
			     (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 x3021 'not)
		   (if (consp x3022)
		       (let*
			   ((x3027 (car-safe x3022))
			    (x3028 (cdr-safe x3022)))
			 (if (null x3028)
			     (let ((type x3027))
			       (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 x3021 '(or and))
		   (funcall pcase-1 x3021 x3022))
		  ((eq x3021 'eql)
		   (if (consp x3022)
		       (let*
			   ((x3029 (car-safe x3022))
			    (x3030 (cdr-safe x3022)))
			 (if (null x3030)
			     (let ((v x3029))
			       (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 x3021 'member) (funcall pcase-0 x3022))
		  ((not (eq x3021 'satisfies))
		   (let ((type val)) (error "Bad type spec: %S" type)))
		  ((consp x3022)
		   (let*
		       ((x3031 (car-safe x3022))
			(x3032 (cdr-safe x3022)))
		     (if (null x3032)
			 (let ((pred x3031))
			   (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)]