Scheme define-macro and/or define-syntax - macros

I want to create an overloaded Scheme macro for a simple form of polymorphism. That is, a macro smart enough to expand differently when given params of different types, so that (look-up key container) does the "right" thing for different kinds of containers.
(define-macro (look-up key container)
(cond
((table? container) `(table-ref ,key ,container))
((pair? container) `(assoc ,container ,key))
etc.
(else `(error "Unknown type to look-up))))
Ideas?

Macros are compile-time, not run-time. So you won't be able to query whether container is a table or pair or what not at macro-expansion time. You'd have to use a procedure to do that.
So, why not just use a procedure?

I think that Chris is right in that this is not really a job for macros. A simple procedure might be what you're looking for:
(define (lookup key container)
(cond ((type1? container)
(type1-lookup key container))
. ; repeat for whichever types..
.
((typeN? container)
(typeN-lookup key container))
(else 'undefined-lookup))) ; or default value or ...
Or maybe you only need to find out what you're dealing with once so you can build build a more dedicated procedure on the fly. Your make-lookup procedure might look very similar to the code above, except you would return a procedure, rather than call the lookup right away:
(define (make-lookup container)
(cond ((type1? container)
type1-lookup)
. ; repeat for supported types..
.
((typeN? container)
typeN-lookup)
(else default-lookup-procedure)))
(define lookup (make-lookup container))
You could even add an optional argument to make-lookup that would take a procedure and use that rather than one of the type-specific lookups that you previously defined.

Related

Equivalent of WAR file in Common Lisp

I have a system written in Lisp that runs state machines. I'd like to dynamically load the definition of the state machine and any required assets (images, etc) from a directory, given just the name of the directory. There will be multiple different state machines. This is similar, but not identical, to Apache loading and running a WAR file.
My concern is that simply compiling and loading a file could run literally anything. Ideally I'd like to get just the state machine definition, configure it with the path to the assets, and have it available to execute. Right now I'm playing around with loading a class that implements a particular base class, but that's not straightforward. Is there a standard technique for this?
Thanks.
Are you saying you're worried about the possibilities of arbitrary code execution from reading in a file? I so you should look into redefining the read-table to exclude unwanted symbols.
For an example checkout this, look for 'SAFE-READ-FROM-STRING'.
It's not complete but then you can use #'read to get the datastructure, do some sanity check and compile if you need to.
If this isn't what you were looking for then my apologies, would you be able to explain further what you are looking for?
Given that you want to read definition of a state machine without executing arbitrary code, you may consider the following macro:
(defmacro def-state-machine (name (&rest assets) &rest states)
`(defparameter ,name
(list
:assets ',(remove-if-not #'legal-asset? assets)
:states ',(remove-if-not #'legal-state? states))))
which will create list of valid assets and states (since I don't know, how your machine looks like, I'm putting some abstract predicates here - they may check for legal syntax, or if argument is of the certain type, or e throw an error if asset or state are illegal).
Let's assume, you also need to define some function to run machine:
(defmacro def-transition (name args &body body)
`(defun ,name (,#args)
,#body))
Separate macro for defining function allows additional sanity checks. Finally, you may define reader function:
(defun load-toy-state-machine (directory)
(let ((path (cl-fad:merge-pathnames-as-file directory #P"machine.lisp"))
;(*readtable* (copy-readtable nil))
)
; (make-dispatch-macro-character #\#)
(with-open-file (stream path :direction :input)
(do ((form (read stream nil 'done)
(read stream nil 'done)))
((eql form 'done) T)
(if (member (car form) '(def-state-machine def-transition))
(eval form)
(error "malformed state machine definition file"))))))
Which will eval only allowed macros (def-state-machine and def-transition), which have fixed syntax, and may contain additional sanity checks. Neither of these executes code.

Hygienic macros: function parameter names?

I have a macro that produces a function. I understand that the best practice is to use gensyms to ensure naming conflicts don't happen. So I'm wondering if I need to follow this principle for the parameter names of the function the macro will define?
Here's my macro for reference:
(defmacro defroute
[routename uri meths handler]
`(defn ~routename
[~'req]
(let [req-meth# (:request-method ~'req)
bad-meth# (nil? (some #(= req-meth# %) ~meths))
any-meth# (= ~meths [:any])]
(if (:uri ~'req)
(if (and (route-matches ~uri ~'req) (and bad-meth# (not any-meth#)))
(method-not-allowed req-meth# (get-allowed ~meths))
(let [params# (route-matches ~uri ~'req)]
(if (nil? params#)
~'req
(~handler (assoc ~'req :route-params params#)))))
~'req))))
As you can see, I'm not using a gensym currently for the req parameter. I had originally and then wondered if it was necessary. Anyway, thanks for reading.
In this context the use of req is relatively safe because it establishes a local scope. As a function parameter, it will shadow any existing bindings to the symbol req in the calling namespace without damaging them. The cost of this is that if anyone tried to use the name req for any of the other parameters, such as handler, they could be in for a bit of a surprise. This code is not wrong in my view, though it does volate the principle of least supprise in some contexts. I don't see any reason not to use an auto-gensym for req considering it's only the work of adding a couple #s.

Common Lisp Macros: correct expansion of a generated list

I am building a mechanism to take an arbitrary CLOS object and return a hash from it (useful in my debugging experience).
However, I am not sure how to force a variable expansion. I sense that the solution lies with a correct use of gensym, but I'm not sure how.
;;helper macro
(defun class-slots-symbols (class-name)
"Returns a list of the symbols used in the class slots"
(mapcar 'closer-mop:slot-definition-name
(closer-mop:class-slots
(find-class class-name))))
;;macro that I am having difficulty with
(defmacro obj-to-hash (obj-inst)
"Reads an object, reflects over its slots, and returns a hash table of them"
`(let ((new-hash (make-hash-table))
(slot-list (class-slots-symbols (type-of ,obj-inst))))
;;The slot-list needs to expand out correctly in the with-slots form
(with-slots (slot-list) obj-inst
(loop for slot in slot-list do ;and also here
(format t "~a~&" slot)
(hashset new-hash (string slot) slot)))))
After a macroexpand-1, I find that that this expands into the following code (*bar* is a class object):
(macroexpand-1 '(obj-to-hash *bar*))
LET ((NEW-HASH (MAKE-HASH-TABLE))
(SLOT-LIST (CLASS-SLOTS-SYMBOLS (TYPE-OF *BAR*))))
(WITH-SLOTS (SLOT-LIST) ;; <-- this needs to be expanded to *bar*'s slots
*BAR*
(LOOP FOR SLOT IN SLOT-LIST ;;<-- not so important
DO (FORMAT T "~a~&" SLOT) (HASHSET NEW-HASH (STRING SLOT) SLOT))))
Obviously, the problem is that slot-list is not being expanded. Less obvious (to me) is the solution.
Followup: After Rainer pointed me in the right direction:
(defun class-slots-symbols (class-instance)
"Returns a list of the symbols used in the class slots"
(mapcar 'closer-mop:slot-definition-name
(closer-mop:class-slots
(class-of class-instance))))
(defun object-to-hash (obj)
"Reflects over the slots of `obj`, and returns a hash table mapping
slots to their values"
(let ((new-hash (make-hash-table))
(slot-list (class-slots-symbols obj)))
(loop for slot in slot-list do
(hashset new-hash (string slot)
(slot-value obj slot)))
new-hash))
Just looking at it I can see no reason why this should be a macro. Rewriting it as a function will save you a lot of trouble.
The use of WITH-SLOTS is not possible they way you try it. The object is not known in general until runtime. The compiler needs to know the slots of the object at compile time already. You need to use SLOT-VALUE and look up the slot value at runtime.
You are thinking in many ways too complicated and your code is slightly confused. You can get rid of some confusion by following simple rules and avoiding some wording.
Let's look at your code:
First, it is not a helper macro, since what follows is a function.
;;helper macro
(defun class-slots-symbols (class-name)
Why take a class name? Why not use the class itself? Classes are first class objects. Write function with obvious interfaces. Elementary functions should work on the basic data types.
"Returns a list of the symbols used in the class slots"
In the class slots no symbols are used. slots have names, one can get this symbol.
(mapcar 'closer-mop:slot-definition-name
(closer-mop:class-slots
(find-class class-name))))
It is no wonder you have a problem with this macro. It is simply because it should be a function, not a macro. Macros are for source transformation. All you need is a simple computation, so no macro is needed
;;macro that I am having difficulty with
(defmacro obj-to-hash (obj-inst)
Poor wording: obj-inst. Either name it object or instance. Not both.
"Reads an object, reflects over its slots, and returns a hash table of them"
Poor documentation: you don't READ anything. Read is an I/O operation and in your code is none. You are talking about an 'object', but above you have something like 'obj-inst'. Why talk about the same thing in two different ways? You may want to document what the hash table actual maps. From which keys to which values?
`(let ((new-hash (make-hash-table))
new-hash is also a poor name. Basically the thing is a hash-table.
(slot-list (class-slots-symbols (type-of ,obj-inst))))
Why TYPE-OF and then later in the helper function call FIND-CLASS? Common Lisp has CLASS-OF, which returns the class directly.
;;The slot-list needs to expand out correctly in the with-slots form
(with-slots (slot-list) obj-inst
Above won't work since WITH-SLOTS expects slot names at compile time, not a slot-list.
(loop for slot in slot-list do ;and also here
(format t "~a~&" slot)
(hashset new-hash (string slot) slot)
HASHSET is not needed, unless it does something special. The usual way to set values is via SETF. SETF takes the form to read a place and the form to compute a value. That's all. It works for all kinds of data structures. One never needs to remember again how the writer function looks like (name, parameter list, ...).
))))
Here is my version:
Note that I use the package CLOS, you may want to use your package CLOSER-MOP
(defun class-slots-symbols (class)
"Returns a list of the symbol names of the class slots"
(mapcar 'clos:slot-definition-name
(clos:class-slots class)))
Above is a simple function taking a class and returning the list of slot names.
Next, we have a simple function, which in this form has been written a million times in Common Lisp:
(defun object-to-hash (object)
"returns a hashtable with the object's slots as keys and slot-values as values"
(let ((hash-table (make-hash-table)))
(loop for slot-name in (class-slots-symbols (class-of object))
do (setf (gethash slot-name hash-table)
(string (slot-value object slot-name))))
hash-table))
We can also rewrite it to slightly older style Lisp:
(defun object-to-hash (object &aux (hash-table (make-hash-table)))
"returns a hashtable with the object's slots as keys
and string versions of the slot-values as values"
(dolist (slot-name (class-slots-symbols (class-of object)) hash-table)
(setf (gethash slot-name hash-table)
(string (slot-value object slot-name)))))
Above is much simpler and has the whole confusion about macros, generating code, compile time information vs. runtime, ... removed. It is much easier to understand, maintain and debug.

How can I check if a variable exists in Scheme?

Is there a way to check if a variable exists in Scheme? Even doing things like (if variable) or (null? variable) cause errors because the variable is not defined. Is there some function that returns whether or not a variable exists?
This feature is built into Mit-Scheme.
#lang scheme
(define x "hello world")
(environment-bound? (nearest-repl/environment) 'x)
(environment-bound? (nearest-repl/environment) 'not-x)
Here's an example in Racket:
#lang racket
(define x 1)
(define-namespace-anchor ns)
(define (is-bound? nm)
(define r (gensym))
(not (eq? r (namespace-variable-value nm #t
(lambda () r)
(namespace-anchor->namespace ns)))))
(is-bound? 'x)
(is-bound? 'not-bound-here)
You want to ask questions to the environment. This is not possible with R5RS, and I'm not sure about R6RS. I certainly would like to do that using just the Scheme standard (and this may be part of R7RS -- look for "Environment enquiries" in the list of items they are likely going to work on).
As far as I can tell there are currently only ad-hoc solutions to that so you'll have to read your implementation's documentation.
Chicken supports that with the oblist egg (it lets you obtain a list of all interned symbols), and also with the environments egg, which lets you specificaly ask if one symbol is bound.
Depending on your implementation if may be possible to test this by making a reference to the variable and catching an exception, then checking if it was a not-bound exception, or something similar to that.
According to R6RS, it's a syntax violation to make a call to an unbound variable.
http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-12.html#node_sec_9.1
However, depending on your implementation there should be a way (theoretically, at least) to query the environment and check if a variable is a member. You'd need to do some further reading for that, however.
http://www.r6rs.org/final/html/r6rs-lib/r6rs-lib-Z-H-17.html#node_idx_1268

How do I write a scheme macro that defines a variable and also gets the name of that variable as a string?

This is mostly a follow-up to this question. I decided to just keep YAGNI in mind and created a global variable (libpython). I set it to #f initially, then set! it when init is called. I added a function that should handle checking if that value has been initialized:
(define (get-cpyfunc name type)
(lambda args
(if libpython
(apply (get-ffi-obj name libpython type) args)
(error "Call init before using any Python C functions"))))
So now here's what I want to do. I want to define a macro that will take the following:
(define-cpyfunc Py_Initialize (_fun -> _void))
And convert it into this:
(define Py_Initialize (get-cpyfunc "Py_Initialize" (_fun -> _void)))
I've been reading through the macro documentation to try figuring this out, but I can't seem to figure out a way to make it work. Can anyone help me with this (or at least give me a general idea of what the macro would look like)? Or is there a way to do this without macros?
I've answered most of this question in the other one (I didn't see this one). It's fine to use a function that pulls out the bindings like this, but one possible problem here is that since you generate the binding only when the resulting function is called, this binding is re-created on each and every call. An easy way to solve this quickly is using promises, something like this:
(require scheme/promise)
(define (get-cpyfunc name type)
(define the-function
(delay (if libpython
(get-ffi-obj name libpython type)
(error "Call init before using any Python C functions"))))
(lambda args (apply (force the-function) args)))
But this is essentially almost the same as the code I posted in your previous question.
More random notes:
get-ffi-obj will accept a symbol as the name to bind to -- this is intentional, to make such macros (as in the last question) easy.
Using (symbol->string 'name) in a macro is fine. As I noted above in my comment reply to Nathan's comment, this means that it gets called at runtime, but mzscheme should be able to optimize that anyway, so there's no need to try and write some sophisticated macro that does the job at compile time.
Look inside the PLT directory -- you will find a collection called ffi. This is a collection of examples of bindings with various styles. Macros that create the bindings are very common in these examples.
Why don't you change the generated code to
(define Py_Initialize (get-cpyfunc 'Py_Initialize (_fun -> _void)))
and then have get-cpyfunc run (symbol->string name)?
Granted, there is probably a way to do this with syntax-case (I can never remember its syntax though), and definitely if you're using a Scheme with CL-esque define-macro.
It's not the complete answer, but I came up with a macro that meets both requirements (defines a variable and a string with the name of that variable):
> (define-syntax (my-syntax stx)
(syntax-case stx ()
[(_ id)
#'(define-values (id) (values (symbol->string (quote id))))]))
> (my-syntax y)
> y
"y"