I've a macro defined in package "a" that defines a function "fun". I'd like to use this macro in package "b" expecting to get "fun" defined in "b" but it ends up getting defined in "a". Can someone please help?
Here's the sample code:
(defpackage #:a (:use #:cl) (:export makefun))
(in-package #:a)
(defmacro makefun (&optional (name (package-name *package*)))
`(defun fun ()
,(format nil "hello ~a" name)))
(defpackage #:b (:use #:cl #:a))
(in-package #:b)
(macroexpand-1 '(makefun)) ; expands to (DEFUN A::FUN () "hello B")
(makefun)
(fun) ; fails
(defpackage #:c (:use #:cl #:a))
(in-package #:c)
(macroexpand-1 '(makefun)) ; expands to (DEFUN A::FUN () "hello C")
(makefun)
(fun) ; fails
If what you really want to do is have it making the function name in the dynamically-current package you want to do something like this:
(defmacro makefun (&optional (name (package-name *package*)))
(let ((funn (intern (symbol-name 'fun) *package*)))
`(defun ,funn ()
,(format nil "hello ~a" name))))
However this smells like an XY problem to me: I don't know what the problem you're trying to solve is but there is very likely to be a better solution than lots of different functions all with the same name but in different packages.
Related
I tried to construct a function template that I can use in other packages with package-specific parameters. The gist of what I tried to achieve this is as follows:
;;; FSM
(in-package #:fsm)
(defmacro %cas (flag old new)
#+sbcl `(sb-ext:compare-and-swap ,flag ,old ,new)
#+ecl `(mp:compare-and-swap ,flag ,old ,new)
)
(defmacro control! (fsm task flag)
`(let ((*task-category* (tag ,task)))
(unless (%cas ,flag nil t)
(lambda () (submit-task (channel (cqueue-prio-out ,fsm)) (fn ,task))))))
;;; REPL
(in-package #:repl)
(defparameter *controller-active* nil)
(control! fsm control-task *controller-active*)
;;; USB-SP
(in-package #:usb-sp)
(defparameter *controller-active* nil)
(control! fsm control-task *controller-active*)
Apparently, this does not work:
Unhandled SIMPLE-ERROR in thread #<SB-THREAD:THREAD "main thread" RUNNING {1001640703}>:
Invalid place to CAS: CNC-HOST/FSM::FLAG -> CNC-HOST/FSM::FLAG
How is this construct properly done?
After receiving feedback on the freenode lisp channel, it became clear to me that the macro construct works as intended:
(defpackage #:fsm (:use #:cl) (:export #:control!! #:%cas))
(defpackage #:repl (:use #:cl #:fsm) (:export #:test-in-repl))
(defpackage #:usb-sp (:use #:cl #:fsm) (:export #:test-in-usb-sp))
;;; FSM
(in-package #:fsm)
(defmacro %cas (flag old new)
#+sbcl `(sb-ext:compare-and-swap ,flag ,old ,new)
#+ecl `(mp:compare-and-swap ,flag ,old ,new))
(defmacro control!! (flag pkg)
`(lambda () (if (%cas ,flag nil t)
(format nil "~A : skip task" ,pkg)
(format nil "~A : task run" ,pkg))))
;;; REPL
(in-package #:repl)
(defparameter *controller-active* nil)
(defun test-in-repl (pkg) (funcall (control!! *controller-active* pkg)))
(assert (string= "repl : task run" (test-in-repl "repl")))
(assert *controller-active*)
;;; USB-SP
(in-package #:usb-sp)
(defparameter *controller-active* nil)
(defun test-in-usb-sp (pkg) (funcall (control!! usb-sp::*controller-active* pkg)))
(assert (string= "usb-sp : task run" (test-in-usb-sp "usb-sp")))
(assert *controller-active*)
(in-package #:cl-user)
(assert (string= "repl : skip task" (repl:test-in-repl "repl")))
(assert (string= "usb-sp : skip task" (usb-sp:test-in-usb-sp "usb-sp")))
The compiler message made me think that I had an error in the macros - instead I overlooked that in my use case control!! should have returned the function call result instead of the lambda.
Suppose we have two packages, each defines a class and exports symbols for slots/generic methods with identical names.
(defpackage pkg1 (:export _class1 _slot _reader _method))
(in-package pkg1)
(defclass _class1 () ((_slot :initform "SLOT111" :initarg :slot :reader _reader)))
(defmethod _method ((self _class1)) (format t "SLOT-: ~a~%" (_reader self)))
(defpackage pkg2 (:export _class2 _slot _reader _method))
(in-package pkg2)
(defclass _class2 () ((_slot :initform "SLOT222" :initarg :slot :reader _reader)))
(defmethod _method ((self _class2)) (format t "SLOT=: ~a~%" (_reader self)))
How do we import those symbols in some third package, successfully merging (not shadowing) generics?
(defpackage test)
(in-package test)
... ; here we somehow import symbols _slot, _reader and _method
; from both packages, so they get merged (like in 'GNU Guile' or 'Gauche')
(defvar v1 (make-instance '_class1))
(defvar v2 (make-instance '_class2))
(_reader v1) (_method v1) ; both must work
(_reader v2) (_method v2) ; and these too
I'm really a noob when it comes to CLOS so I did the same experiment last year. My findings is that CL doesn't really export methods or merge methods. It exports symbols, that might have bindings. Thus you need to make a package with the symbols that they should share and perhaps put the documentation there:
;; common symbols and documantation
(defpackage interface (:export _slot _reader _method))
(in-package interface)
(defgeneric _method (self)
(:documentation "This does this functionality"))
(defgeneric _reader (self)
(:documentation "This does that functionality"))
(defpackage pkg1 (:use :cl :interface) (:export _class1 _slot _reader _method))
(in-package pkg1)
(defclass _class1 () ((_slot :initform "SLOT111" :initarg :slot :reader _reader)))
(defmethod _method ((self _class1)) (format t "SLOT-: ~a~%" (_reader self)))
(defpackage pkg2 (:use :cl :interface) (:export _class2 _slot _reader _method))
(in-package pkg2)
(defclass _class2 () ((_slot :initform "SLOT222" :initarg :slot :reader _reader)))
(defmethod _method ((self _class2)) (format t "SLOT=: ~a~%" (_reader self)))
(defpackage test (:use :cl :pkg1 :pkg2))
(in-package test)
(defvar v1 (make-instance '_class1))
(defvar v2 (make-instance '_class2))
(_reader v1) ; ==> "SLOT111"
(_method v1) ; ==> nil (outputs "SLOT-: SLOT111")
(_reader v2) ; ==> "SLOT222"
(_method v2) ; ==> nil (outputs "SLOT-: SLOT222")
You can from test check out what has happened:
(describe '_method)
_METHOD is the symbol _METHOD, lies in #<PACKAGE INTERFACE>, is accessible in
4 packages INTERFACE, PKG1, PKG2, TEST, names a function.
Documentation as a FUNCTION:
This does this functionality
#<PACKAGE INTERFACE> is the package named INTERFACE.
It imports the external symbols of 1 package COMMON-LISP and
exports 3 symbols to 2 packages PKG2, PKG1.
#<STANDARD-GENERIC-FUNCTION _METHOD> is a generic function.
Argument list: (INTERFACE::SELF)
Methods:
(_CLASS2)
(_CLASS1)
(describe '_reader)
_READER is the symbol _READER, lies in #<PACKAGE INTERFACE>, is accessible in
4 packages INTERFACE, PKG1, PKG2, TEST, names a function.
Documentation as a FUNCTION:
This does that functionality
#<PACKAGE INTERFACE> is the package named INTERFACE.
It imports the external symbols of 1 package COMMON-LISP and
exports 3 symbols to 2 packages PKG2, PKG1.
#<STANDARD-GENERIC-FUNCTION _READER> is a generic function.
Argument list: (INTERFACE::SELF)
Methods:
(_CLASS2)
(_CLASS1)
This has the side effect that importing pkg1 _method will work on pkg2 instances should you get such instance from a package that uses pkg2.
Now there is an elephant in this room. Why not define a base class in interface and add it as the parent class of both _class1 and _class2. You can easily do that with just a few changes, however that wasn't what you asked for.
After trying to solve this task via MOP I came up with a much simplier workaround:
(defmacro wrapping-import
(sym-name &rest sym-list)
`(defmethod ,sym-name
(&rest args)
(loop for sym in '(,#sym-list) do
(let ((gf (symbol-function sym)))
(if (compute-applicable-methods gf args)
(return (apply gf args)))))
(error "No applicable method found in ~A" ',sym-name)))
Example:
(defpackage p1 (:export say-type))
(in-package p1)
(defmethod say-type ((v integer)) "int")
(defpackage p2 (:export say-type))
(in-package p2)
(defmethod say-type ((v string)) "str")
(in-package cl-user)
(wrapping-import say-type p1:say-type p2:say-type)
(say-type "") ; -> "str"
(say-type 1) ; -> "int"
Also, here's the original solution:
(defmacro merging-import
(sym-name &rest sym-list)
(let ((gf-args (clos:generic-function-lambda-list
(symbol-function (first sym-list)))))
`(progn
(defgeneric ,sym-name ,gf-args)
(loop for sym in '(,#sym-list) do
(loop for meth
in (clos:generic-function-methods (symbol-function sym))
do
(add-method #',sym-name
(make-instance 'clos:standard-method
:lambda-list (clos:method-lambda-list meth)
:specializers (clos:method-specializers meth)
:function (clos:method-function meth))))))))
Note that wrapping-import works even when signatures of generic functions don't match, while merging-import requires their lambda-lists to be equal.
Now I wonder: why we have to invent such things in 2017? Why those aren't in the standard yet?
And just in case someone needs it - a macro, which works like from pkg import * in Python:
(defmacro use-all-from
(&rest pkg-list)
`(loop for pkg-name in '(,#pkg-list) do
(do-external-symbols
(sym (find-package pkg-name))
(shadowing-import (read-from-string (format nil "~a:~a"
pkg-name sym))))))
How can I substitute a symbol name into a function created in a macro? I think I am missing something obvious here. For example, I am trying to make a macro that defines some variables and functions similar to the following,
(cl-defmacro mac (pkg)
(let (
;; Define some variables
(sym (intern (concat pkg "-file")))
(sym-def "default-file.el")
(sym-doc (concat "A custom var from `" pkg "'."))
;; Define some functions
(symfn (intern (concat pkg "-fn")))
(symfn-doc (concat "A function for `" pkg "'.")))
`(list
(defcustom ,sym ,sym-def ,sym-doc
:group (quote ,(make-symbol pkg))
:type '(choice (const :tag "None" nil)
file))
(defun ,symfn ()
,symfn-doc
(interactive)
(fn ,sym)))))
The function returned makes a call out to another function (fn) with a signature like
(defun fn (var) (symbol-value var))
So, it is expecting a call like (fn 'some-var). And, I want to be able to use the macro like
(mac "pack")
And have the following work,
pack-file ; works: "default-file.el"
(pack-fn) ; error: not a symbol
I have tried things like (quote ,sym), symbol-name, and others... But can't seem to get it right.
You want the call to fn to be (fn ',sym) (which you mention you tried in the question, but I suspect got wrong somehow).
You probably also want the expansion of the macro to be (progn ...) instead of (list ...).
(This was originally a comment: I'm putting it here just so there's an answer.)
I try to write a macro, which given a name could be supplied in the function myfunc to create a class and make an instance of this class.
Here is the code:
(defmacro define-class (class-name)
`(eval
`(progn
(defclass ,,class-name () ())
(make-instance ,class-name))))
(defun myfunc (name)
(define-class name))
I can compile successfully the macro but not the function. In this case I get a warning at compilation time saying that:
undefined variable: CLASS-NAME
If I modify a bit the macro so that instead of writing
(make-instance ,class-name)
I write
(make-instance ,,class-name)
Then in this case I can compile both, but when running (myfunc 'toto) I get the following error:
The variable TOTO is unbound.
I try to figure out how the macro is expanded with macroexpand-1. With the first macro which is defined with (make-instance ,class-name) it gave me the following result:
(EVAL `(PROGN (DEFCLASS ,'TOTO NIL NIL) (MAKE-INSTANCE ,CLASS-NAME)))
Whereas in the second macro which is defined with *(make-instance ,,class-name) it gave me the following result:
(EVAL `(PROGN (DEFCLASS ,'TOTO NIL NIL) (MAKE-INSTANCE ,'TOTO)))
But I guess the right expansion in my case would be something like:
(EVAL `(PROGN (DEFCLASS ,'TOTO NIL NIL) (MAKE-INSTANCE 'TOTO)))
How could I modify or re-write the macro so that it works?
You want to write code like this:
(defun myfunc (name)
(define-class name))
This would actually be similar to this:
(defun myfunc (name)
(let ((name name))
(eval `(defclass ,name () ()))
(make-instance name)))
Thus the DEFINE-CLASS macro should generate something like above code.
(defmacro define-class (name)
(let ((name-sym (gensym "CLASS-NAME")))
`(let ((,name-sym ,name))
(eval `(defclass ,,name-sym () ()))
(make-instance ,name-sym))))
Using it:
CL-USER 21 > (pprint (macroexpand-1 '(define-class name)))
(LET ((#:CLASS-NAME22897 NAME))
(EVAL `(DEFCLASS ,#:CLASS-NAME22897 NIL NIL))
(MAKE-INSTANCE #:CLASS-NAME22897))
CL-USER 22 > (myfunc 'baz42)
#<BAZ42 40202BBE73>
But then, there is no reason that it should be a macro!
A normal function is just fine...
(defun create-class-and-instance (name)
(eval `(defclass ,name () ()))
(make-instance name))
The defclass macro generally expands into a call to the actual implementation-dependent function that creates the class. If you can call that function instead, you can get rid of eval. This is a little more direct and keeps the current lexical environment.
If you load the closer-mop system, you can write your function as follows:
(defun make-instance-from-new-class (class-name)
(make-instance (closer-mop:ensure-class class-name)))
I'm writing a toy interpreter for a Lisp language, in which I have the following CL code:
(defun mal-list (&rest args)
(make-mal :type 'list
:value args))
(register-fun '|list| #'mal-list)
(defun mal-list? (arg)
(eq (mal-type arg) 'list))
(register-fun '|list?| #'mal-list?)
However, I'd rather simply write something like this:
(defmal list (&rest args)
(make-mal :type 'list
:value args))
(defmal list? (arg)
(eq (mal-type arg) 'list))
I tried to write a macro to do this, but I had problems with the symbols with the bars (I'm pretty confused as to what this is!). This is what I tried:
(defmacro defmal (name args &body body )
(let ((funsym (intern (format nil "~{~a~}" `(mal- ,name)))))
`(register-fun `|,name| (defun ,funsym ,args ,#body))))
which didn't work out, because `|,name| literaly meant |,name|, and not |list|
I'm guessing this is an XY problem, but I'm not sure how to approach this otherwise.
The |...| syntax is just one of the ways that the Lisp printer can print symbols that have characters in their name that need to be escaped (and that the reader can read symbols with those kinds of characters in their names):
(print (intern "foo"))
;=> |foo|
There are other ways, too, including escaping individual characters:
(print '|FOO|)
;=> FOO
(print '\f\o\o)
;=> |foo|
What you're trying to do is simply create a symbol whose name includes lower case letters. That's easy enough, as shown above. Part of your issue, though, is that you're getting as input a symbol whose name is full of capital letters, so you'll need to downcase first:
CL-USER> (symbol-name 'FOO)
;=> "FOO"
CL-USER> (intern (symbol-name 'FOO))
;=> FOO
CL-USER> (string-downcase (symbol-name 'FOO))
;=> "foo"
CL-USER> (intern (string-downcase (symbol-name 'FOO)))
;=> |foo|
In fact, because string-downcase takes string designators, not just strings, you can pass the symbol in directly:
CL-USER> (intern (string-downcase 'BaR))
;=> |bar|
So, after all that string processing, we can move to the macro.
It sounds like you're looking for something like this:
(defmacro defmal (name lambda-list &body body)
(let ((mal-name (intern (concatenate 'string "MAL-" (symbol-name name))))
(mal-norm (intern (string-downcase name))))
`(progn
(defun ,mal-name ,lambda-list
,#body)
(register-function ',mal-norm #',mal-name))))
CL-USER> (pprint (macroexpand-1 '(defmal list? (arg)
(eq (mal-type arg) 'list))))
(PROGN
(DEFUN MAL-LIST? (ARG) (EQ (MAL-TYPE ARG) 'LIST))
(REGISTER-FUNCTION '|list?| #'MAL-LIST?))
It's generally a good idea to avoid using format in generating symbol names, because the specific output can change, depending on other variables. E.g.:
(loop for case in '(:upcase :downcase :capitalize)
collect (let ((*print-case* case))
(format nil "~a" 'foo)))
;=> ("FOO" "foo" "Foo")
Instead, you can use concatenate with a string (or the symbol name of a symbol). Because the reader can also have different settings for case sensitivity, sometimes I'll even do (but not everyone likes this):
(concatenate 'string (symbol-name '#:mal-) (symbol-name name))
This way, if the reader does anything unusual (e.g., preserves case, so that the symbol name of mal- is "mal-), you can preserve it in your own generated symbol, too.
In addition to Joshua's detailed answer, consider using a function from the Alexandria library:
format-symbol is like format, but inside with-standard-io-syntax. Here, t stands for the current package and name is downcased:
(format-symbol t "mal-~(~A~)" name)
=> |mal-list|
symbolicate concatenates and interns in current package:
(symbolicate '#:mal- name)
You can end-up with either |MAL-LIST| or |mal-list| if your current readtable preserves case or not. For completeness, note that readtable-case can be set to the following values: :upcase, :downcase, :preserve or :invert (this one I find quite interesting).