[Gcl-commits] gcl/lsp gcl_module.lsp gcl_setf.lsp

[Camm Maguire]

CVSROOT:        /cvsroot/gcl
Module name:    gcl
Changes by:     Camm Maguire <camm>     06/06/09 21:08:09

Modified files:
        lsp            : gcl_module.lsp gcl_setf.lsp 

Log message:
        Fix typing bug in c1flet/c1labels,make (values form) an efficient 
return,portable code turns &aux into let* to make the lambda funcallable (in 
preparation for automatic state/mutual recursion conversion),speed up 
proper-list type-or, give fdefinition a lisp definition to set up the prototype 
(removes a number of * returns)

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/gcl/lsp/gcl_module.lsp?cvsroot=gcl&r1=1.7&r2=1.8
http://cvs.savannah.gnu.org/viewcvs/gcl/lsp/gcl_setf.lsp?cvsroot=gcl&r1=1.19&r2=1.20

Patches:
Index: gcl_module.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/lsp/gcl_module.lsp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -b -r1.7 -r1.8
--- gcl_module.lsp      5 Jun 2006 22:02:45 -0000       1.7
+++ gcl_module.lsp      9 Jun 2006 21:08:09 -0000       1.8
@@ -63,7 +63,8 @@
         (setq object (function-name object)))
        ((typep object 'package)
         (setq object (find-symbol (package-name object) :keyword))))
-  (check-type object (and symbol (not null)))
+  (when object
+    (check-type object symbol)
   (ecase doc-type
     (variable (get object 'variable-documentation))
     (function (get object 'function-documentation))
@@ -72,14 +73,15 @@
     (setf (get object 'setf-documentation))
     (compiler-macro (get object 'compiler-macro-documentation))
     (method-combination (get object 'method-combination-documentation))
-    ((t) (when (find-package object) (get object 'package-documentation)))))
+      ((t) (when (find-package object) (get object 'package-documentation))))))
 
 (defun set-documentation (object doc-type value)
   (cond ((typep object 'function)
         (setq object (function-name object) doc-type 'function))
        ((typep object 'package)
         (setq object (find-symbol (package-name object) :keyword))))
-  (check-type object (and symbol (not null)))
+  (when object
+    (check-type object symbol)
   (ecase doc-type
     (variable (setf (get object 'variable-documentation) value))
     (function (setf (get object 'function-documentation) value))
@@ -88,7 +90,7 @@
     (setf (setf (get object 'setf-documentation) value))
     (compiler-macro (setf (get object 'compiler-macro-documentation) value))
     (method-combination (setf (get object 'method-combination-documentation) 
value))
-    ((t) (when (find-package object) (setf (get object 'package-documentation) 
value)))))
+      ((t) (when (find-package object) (setf (get object 
'package-documentation) value))))))
 
 (defun find-documentation (body)
   (if (or (endp body) (endp (cdr body)))

Index: gcl_setf.lsp
===================================================================
RCS file: /cvsroot/gcl/gcl/lsp/gcl_setf.lsp,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -b -r1.19 -r1.20
--- gcl_setf.lsp        9 Jun 2006 20:50:58 -0000       1.19
+++ gcl_setf.lsp        9 Jun 2006 21:08:09 -0000       1.20
@@ -627,7 +627,7 @@
        ((let ((z (get (cadr name) 'setf-function)))
           (cond ((not z) (error :undefined-function "function ~s is undefined" 
name))
                 ((functionp z) z)
-                ((fdefintion z)))))))
+                ((fdefinition z)))))))
                 
 
 (defun (setf fdefinition) (def fn)