[Openmcl-cvs-notifications] r14577 - in /trunk/source: level-0/l0-def.lisp level-1/l1-utils.lisp level-1/sysutils.lisp

gb at clozure.com gb at clozure.com
Wed Jan 12 15:58:40 CST 2011


Author: gb
Date: Wed Jan 12 15:58:39 2011
New Revision: 14577

Log:
Typecheck the NAME argument in SYMBOL-FUNCTION; use FSET-SYMBOL
as SYMBOL-FUNCTION's SETF inverse.
Fixes ticket:808.

Modified:
    trunk/source/level-0/l0-def.lisp
    trunk/source/level-1/l1-utils.lisp
    trunk/source/level-1/sysutils.lisp

Modified: trunk/source/level-0/l0-def.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-0/l0-def.lisp (original)
+++ trunk/source/level-0/l0-def.lisp Wed Jan 12 15:58:39 2011
@@ -66,6 +66,10 @@
 =

 ;Redefined in sysutils.
 (%fhave 'fset #'bootstrapping-fset)
+
+(defun fset-symbol (name fn)
+  (fset (require-type name 'symbol) fn))
+
 =

 (defun bootstrapping-record-source-file (fn &optional type)
   (declare (ignore fn type))

Modified: trunk/source/level-1/l1-utils.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-utils.lisp (original)
+++ trunk/source/level-1/l1-utils.lisp Wed Jan 12 15:58:39 2011
@@ -739,13 +739,15 @@
 =

 ;;;;;FUNCTION BINDING Functions
 =

+(defun fdefinition (name)
+  (or (fboundp name) ;Our fboundp returns the binding
+      (prog1 (%err-disp $xfunbnd name))))
+
 (defun symbol-function (name)
   "Return the definition of NAME, even if it is a macro or a special form.
    Error if NAME doesn't have a definition."
-  (or (fboundp name) ;Our fboundp returns the binding
-      (prog1 (%err-disp $xfunbnd name))))
-
-(%fhave 'fdefinition #'symbol-function)
+  (fdefinition (require-type name 'symbol)))
+
 =

 (defun %make-function (name fn env)
   (compile-user-function fn name env))

Modified: trunk/source/level-1/sysutils.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/sysutils.lisp (original)
+++ trunk/source/level-1/sysutils.lisp Wed Jan 12 15:58:39 2011
@@ -406,7 +406,7 @@
     (funcall fhave name function)
     function))
 =

-(defsetf symbol-function fset)
+(defsetf symbol-function fset-symbol)
 (defsetf fdefinition fset)
 =

 (defun (setf macro-function) (macro-fun name &optional env)



More information about the Openmcl-cvs-notifications mailing list