Repositories / ecl.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 0359b79)
predlib: fix bogs expand-deftype
authorDaniel Kochmański <daniel@turtleware.eu>
Tue, 18 Aug 2015 10:07:35 +0000 (12:07 +0200)
committerDaniel Kochmański <daniel@turtleware.eu>
Tue, 18 Aug 2015 10:07:35 +0000 (12:07 +0200)
Signed-off-by: Daniel Kochmański <daniel@turtleware.eu>
src/lsp/predlib.lsp patch | blob | blame | history

diff --git a/src/lsp/predlib.lsp b/src/lsp/predlib.lsp
index d0e6595..10a9242 100644 (file)
--- a/src/lsp/predlib.lsp
+++ b/src/lsp/predlib.lsp
@@ -652,25 +652,22 @@ Returns T if X belongs to TYPE; NIL otherwise."
         ((progn
            (setq tp (car type) i (cdr type))
            (setq fd (get-sysprop tp 'DEFTYPE-DEFINITION)))
-         (normalize-type (apply fd i)))
+         (normalize-type (funcall fd i nil)))
         ((and (eq tp 'INTEGER) (consp (cadr i)))
          (values tp (list (car i) (1- (caadr i)))))
         (t (values tp i))))
 
 (defun expand-deftype (type)
-  (cond ((symbolp type)
-         (let ((fd (get-sysprop type 'DEFTYPE-DEFINITION)))
-           (if fd
-               (expand-deftype (funcall fd))
-               type)))
-        ((and (consp type)
-              (symbolp type))
-         (let ((fd (get-sysprop (first type) 'DEFTYPE-DEFINITION)))
-           (if fd
-               (expand-deftype (funcall fd (rest type)))
-               type)))
-        (t
-         type)))
+  (let (base args)
+    (if (atom type)
+        (setf base type
+              args nil)
+        (setf base (car type)
+              args (cdr type)))
+    (let ((fn (get-sysprop base 'SI::DEFTYPE-DEFINITION)))
+      (if fn
+          (expand-deftype (funcall fn args nil))
+          type))))
 
 ;;************************************************************
 ;;                      COERCE
Embeddable Common Lisp (Official: https://gitlab.com/embeddable-common-lisp/ecl)