summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthias Andreas Benkard <matthias@benkard.de>2008-08-03 10:43:56 +0200
committerMatthias Andreas Benkard <matthias@benkard.de>2008-08-03 10:43:56 +0200
commit4f4f0aad6db508de2a59d29b59cc738a6ece4c4d (patch)
treec00a079b9b3d6a86438a3dfa6c2659da16df5f58
parenta7343b3f21b008fa7822073ecb658063bd0e09a6 (diff)
Add DEFTYPE.
-rw-r--r--defun-1.lisp10
-rw-r--r--types.lisp27
2 files changed, 30 insertions, 7 deletions
diff --git a/defun-1.lisp b/defun-1.lisp
index 51e9db0..875b7a5 100644
--- a/defun-1.lisp
+++ b/defun-1.lisp
@@ -21,7 +21,7 @@
(export '(defmacro defun))
-(%defun* make-defun-body (lambda-list body)
+(%defun* make-defun-body (lambda-list body destructuring-p)
(let ((lambda-sym (gensym)))
`(,lambda-sym
(d-b ,lambda-list nil nil ,lambda-sym
@@ -29,7 +29,7 @@
(%defmacro* defun (name lambda-list . body)
`(%defun ,name
- ,@(make-defun-body lambda-list body)))
+ ,@(make-defun-body lambda-list body nil)))
(%defun* make-defmacro-body (lambda-list body)
(let ((arg-sym (gensym))
@@ -49,7 +49,11 @@
(%defmacro* lambda (lambda-list . body)
`(%lambda
- ,@(make-defun-body lambda-list body)))
+ ,@(make-defun-body lambda-list body nil)))
+
+(%defmacro* destructuring-lambda (lambda-list . body)
+ `(%lambda
+ ,@(make-defun-body lambda-list body t)))
(defun funcall (function &rest arguments)
(apply function arguments))
diff --git a/types.lisp b/types.lisp
index 24a962d..91c8ac9 100644
--- a/types.lisp
+++ b/types.lisp
@@ -26,7 +26,7 @@
array simple-array simple-vector simple-string
simple-bit-vector sequence two-way-stream stream echo-stream
broadcast-stream file-stream synonym-stream string-stream
- concatenated-stream))
+ concatenated-stream deftype))
(setq *subtype-supertypes-dict*
@@ -69,6 +69,10 @@
(send-by-name dict "setObject:forKey:" (cdr pair) (nullify (car pair))))))
+(setq *type-expanders* (send-by-name (find-objc-class "NSMutableDictionary")
+ "dictionary"))
+
+
(setq most-positive-fixnum 32767)
(setq most-negative-fixnum -32768)
@@ -107,10 +111,25 @@
(every1 function (rest list)))))
-(defun expand-type (type &optional environment)
- ;;FIXME: DEFTYPE
- type)
+(defmacro deftype (type-name lambda-list &body body)
+ `(send-by-name *type-expanders*
+ "setObject:forKey:"
+ (destructuring-lambda ,lambda-list ,@body)
+ ',type-name))
+(defun expand-type (type &optional environment)
+ (let* ((env (if rest (car rest) nil))
+ (expansion-1 (expand-type-1 object env))
+ (expansion-2 (expand-type-1 expansion-1 env)))
+ (if (list-eqp expansion-1 expansion-2)
+ expansion-1
+ (expand-type expansion-2))))
+
+(defun expand-type-1 (type &optional environment)
+ (let ((expander (send-by-name *type-expanders* "objectForKey:" (first type))))
+ (if expander
+ (apply expander (rest type))
+ type)))
(defun typep (thing typespec &optional environment)
;;FIXME: DEFTYPE