Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Failed patch for ps-experiment:defun.ps 33f20554b984cd02d7734835fa9650dc7326dcf3
# This can be successed in Clozure CL but not in SBCL.
# So remain this patch only for reference.
diff --git a/ps-experiment.asd b/ps-experiment.asd
index 8ccfc92..7944b2f 100644
--- a/ps-experiment.asd
+++ b/ps-experiment.asd
@@ -19,7 +19,9 @@
:depends-on (:parenscript
:metabang-bind
:alexandria
- :anaphora)
+ :anaphora
+ :swank ; for swank-backend:arglist
+ )
:components ((:module "src"
:serial t
:components
diff --git a/src/defines.lisp b/src/defines.lisp
index 542ecc4..b2b723e 100644
--- a/src/defines.lisp
+++ b/src/defines.lisp
@@ -27,7 +27,22 @@
;; ----- .ps ----- ;;
-(def-ps-definer defun.ps (name args &body body) ()
+(def-ps-definer defun.ps (name args &body body)
+ (:before `(block define-cl-func
+ ;; Return if the function is defined in the same signature.
+ (when (and (fboundp ',name)
+ (equalp (swank-backend:arglist ',name)
+ ',args))
+ (return-from define-cl-func))
+ ;; Return if the symblo is defined in other package.
+ (when (and (symbol-package ',name)
+ (not (eq (symbol-package ',name) *package*)))
+ (format t "Note: Skip define empty CL function because the function \"~A\" is defined in other package" ',name)
+ (return-from define-cl-func))
+ (format t "Note: Define \"~A\" as an empty CL function~%" ',name)
+ (defun ,name ,args
+ (declare (ignore ,@args))
+ (error (format nil "The function \"~A\" is not implemented as CL function" ',name)))))
`(defun ,name ,args ,@body))
(def-ps-definer defvar.ps (name initial-value &optional (documentation "")) ()
diff --git a/t/defines.lisp b/t/defines.lisp
index f3036d3..6c0fbb5 100644
--- a/t/defines.lisp
+++ b/t/defines.lisp
@@ -9,7 +9,7 @@
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment