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* ((x16352 (car-safe val)) (x16353 (cdr-safe val)))
		 (cond
		  ((let* ((name x16352))
		     (get name 'cl-deftype-handler))
		   (let ((name x16352) (args x16353))
		     (ignore name)
		     (list 'cl-typep val
			   (list 'quote
				 (apply (get name 'cl-deftype-handler)
					args)))))
		  ((memq x16352 '(number real float integer))
		   (ignore (consp x16353))
		   (let*
		       ((x16354 (car-safe x16353))
			(x16355 (cdr-safe x16353)))
		     (progn
		       (ignore (consp x16355))
		       (let*
			   ((x16356 (car-safe x16355))
			    (x16357 (cdr-safe x16355)))
			 (progn
			   (ignore (null x16357))
			   (let
			       ((name x16352) (min x16354)
				(max x16356))
			     (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 x16352 'not)
		   (if (consp x16353)
		       (let*
			   ((x16358 (car-safe x16353))
			    (x16359 (cdr-safe x16353)))
			 (if (null x16359)
			     (let ((type x16358))
			       (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 x16352 '(or and))
		   (let ((name x16352) (types x16353))
		     (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 x16352 'eql)
		   (if (consp x16353)
		       (let*
			   ((x16360 (car-safe x16353))
			    (x16361 (cdr-safe x16353)))
			 (if (null x16361)
			     (let ((v x16360))
			       (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 x16352 'member)
		   (let ((args x16353))
		     (list 'and (list 'memql val (list 'quote args)) t)))
		  ((not (eq x16352 'satisfies))
		   (let ((type val)) (error "Bad type spec: %S" type)))
		  ((consp x16353)
		   (let*
		       ((x16362 (car-safe x16353))
			(x16363 (cdr-safe x16353)))
		     (if (null x16363)
			 (let ((pred x16362))
			   (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)]