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*
		  ((x37999
		    (car-safe val))
		   (x38000
		    (cdr-safe val)))
		(cond
		 ((let*
		      ((name x37999))
		    (get name 'cl-deftype-handler))
		  (let
		      ((name x37999)
		       (args x38000))
		    (ignore name)
		    (list 'cl-typep val
			  (list 'quote
				(apply
				 (get name 'cl-deftype-handler)
				 args)))))
		 ((memq x37999
			'(number real float integer))
		  (ignore
		   (consp x38000))
		  (let*
		      ((x38001
			(car-safe x38000))
		       (x38002
			(cdr-safe x38000)))
		    (progn
		      (ignore
		       (consp x38002))
		      (let*
			  ((x38003
			    (car-safe x38002))
			   (x38004
			    (cdr-safe x38002)))
			(progn
			  (ignore
			   (null x38004))
			  (let
			      ((name x37999)
			       (min x38001)
			       (max x38003))
			    (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 x37999 'not)
		  (if
		      (consp x38000)
		      (let*
			  ((x38005
			    (car-safe x38000))
			   (x38006
			    (cdr-safe x38000)))
			(if
			    (null x38006)
			    (let
				((type x38005))
			      (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 x37999
			'(or and))
		  (let
		      ((name x37999)
		       (types x38000))
		    (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 x37999 'eql)
		  (if
		      (consp x38000)
		      (let*
			  ((x38007
			    (car-safe x38000))
			   (x38008
			    (cdr-safe x38000)))
			(if
			    (null x38008)
			    (let
				((v x38007))
			      (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 x37999 'member)
		  (let
		      ((args x38000))
		    (list 'and
			  (list 'memql val
				(list 'quote args))
			  t)))
		 ((not
		   (eq x37999 'satisfies))
		  (let
		      ((type val))
		    (error "Bad type spec: %S" type)))
		 ((consp x38000)
		  (let*
		      ((x38009
			(car-safe x38000))
		       (x38010
			(cdr-safe x38000)))
		    (if
			(null x38010)
			(let
			    ((pred x38009))
			  (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)))))