-
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmain.lisp
30 lines (26 loc) · 1.21 KB
/
main.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
(in-package #:enhanced-typep)
(declaim (inline typep %make-typep-wrapper)
(ftype (function (t &optional t t)
t)
typep))
(defun typep (object-or-type &optional (type nil type-supplied-p) environment)
(if type-supplied-p
(cl:typep object-or-type type environment)
(lambda (object)
(cl:typep object object-or-type))))
(defun %typep-lambda (type &optional compile-time-environment)
(let* ((object-var (gensym (string '#:object)))
(type-var (unless (constantp type compile-time-environment)
(gensym (string '#:type))))
(main `(lambda (,object-var)
(cl:typep ,object-var ,(or type-var type)))))
(if type-var
`(let ((,type-var ,type))
,main)
main)))
(define-compiler-macro typep (object-or-type &optional (type nil type-supplied-p) (environment nil environment-supplied-p)
&environment compile-time-environment)
(if type-supplied-p
`(cl:typep ,object-or-type ,type ,@(when environment-supplied-p
(list environment)))
(%typep-lambda object-or-type compile-time-environment)))