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
;; Closure converted to defun by helpful.
(defun cl-typep--inliner
    (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*
		  ((x11385
		    (car-safe val))
		   (x11386
		    (cdr-safe val)))
		(cond
		 ((let*
		      ((name x11385))
		    (get name 'cl-deftype-handler))
		  (let
		      ((name x11385)
		       (args x11386))
		    (ignore name)
		    (list 'cl-typep val
			  (list 'quote
				(apply
				 (get name 'cl-deftype-handler)
				 args)))))
		 ((memq x11385
			'(number real float integer))
		  (ignore
		   (consp x11386))
		  (let*
		      ((x11387
			(car-safe x11386))
		       (x11388
			(cdr-safe x11386)))
		    (progn
		      (ignore
		       (consp x11388))
		      (let*
			  ((x11389
			    (car-safe x11388))
			   (x11390
			    (cdr-safe x11388)))
			(progn
			  (ignore
			   (null x11390))
			  (let
			      ((name x11385)
			       (min x11387)
			       (max x11389))
			    (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 x11385 'not)
		  (if
		      (consp x11386)
		      (let*
			  ((x11391
			    (car-safe x11386))
			   (x11392
			    (cdr-safe x11386)))
			(if
			    (null x11392)
			    (let
				((type x11391))
			      (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 x11385
			'(or and))
		  (let
		      ((name x11385)
		       (types x11386))
		    (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 x11385 'eql)
		  (if
		      (consp x11386)
		      (let*
			  ((x11393
			    (car-safe x11386))
			   (x11394
			    (cdr-safe x11386)))
			(if
			    (null x11394)
			    (let
				((v x11393))
			      (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 x11385 'member)
		  (let
		      ((args x11386))
		    (list 'and
			  (list 'memql val
				(list 'quote args))
			  t)))
		 ((not
		   (eq x11385 'satisfies))
		  (let
		      ((type val))
		    (error "Bad type spec: %s" type)))
		 ((consp x11386)
		  (let*
		      ((x11395
			(car-safe x11386))
		       (x11396
			(cdr-safe x11386)))
		    (if
			(null x11396)
			(let
			    ((pred x11395))
			  (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))
		(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))))))))))
      (if
	  (eq val exp)
	  body
	(macroexp-let*
	 (list
	  (list val exp))
	 body)))))