I'm trying to use the tinsel HTML template library to delete a node if the user is nil, but I'm having a hard time figuring out how to evaluate the conditional, since everything is based on macros.
This version doesn't work because it evaluates user to a form 'user during compile time, which is not nil, so hard-sets the true branch, and never re-evaluates. (Feel free to correct my terminology if that was not quite correct).
(tc/deftemplate folder-list
(tc/html-document (slurp "resources/templates/folders.html"))
[user]
(tc/id= :mnuUsers)
(fn [node] (do (prn 'user) (if 'user node nil))))
Here's the closest I've got, which does in fact print the user at render time rather than compile time, and branches correctly, but throws an error saying Unable to resolve symbol node.
(tc/deftemplate folder-list
(tc/html-document (slurp "resources/templates/folders.html"))
[user]
(tc/id= :mnuUsers)
(fn [node] '(do (prn user) (if user node nil))))
I've not ever used Tinsel, but I'll take a shot in the dark...does this work?
(t/deftemplate folder-list
[[:h1#mnuUsers "header"]]
[user]
(t/id= :mnuUsers)
(fn [node]
(list 'if 'user node nil)))
My normal approach would be to use syntax quotes and unquoting. However, I couldn't get that to work. The above builds an expression out of a list of symbols...it seems ugly but it might do the trick.
EDIT
Version that uses syntax quoting instead:
(t/deftemplate folder-list2
[[:h1#mnuUsers "header"]]
[user]
(t/id= :mnuUsers)
(fn [node]
`(if ~'user ~node nil)))
Related
Short version:
I want to change the #+ and #- reader macros to apply to all immediately subsequent tokens starting with ##, in addition to the following token. Therefore, the following code...
#+somefeature
##someattribute1
##someattribute2
(defun ...)
...would, in the absence of somefeature, result in no code.
Long version:
I have written my own readtable-macros which apply transformations to subsequent code. For example:
##traced
(defun ...)
This yields a function that writes its arguments and return values to a file, for debugging.
This fails, however, when used in conjunction with the #+ reader macro:
#+somefeature
##traced
(defun ...)
In the absence of somefeature, the function continues to be defined, albeit without the ##traced modification. This is obviously not the desired outcome.
One possible solution would be to use progn, as follows:
#+somefeature
(progn
##traced
(defun ...))
But that's kind of ugly.
I would like to modify the #+ and #- reader macros, such that they may consume more than one token. Something like this:
(defun conditional-syntax-reader (stream subchar arg)
; If the conditional fails, consume subsequent tokens while they
; start with ##, then consume the next token.
)
(setf *readtable* (copy-readtable))
(set-dispatch-macro-character #\# #\+ #'conditional-syntax-reader)
(set-dispatch-macro-character #\# #\- #'conditional-syntax-reader)
The problem is, I don't know how to "delegate" to the original reader macros; and I don't understand enough about how they were implemented to re-implement them myself in their entirety.
A naive approach would be:
(defun consume-tokens-recursively (stream)
(let ((token (read stream t nil t)))
(when (string= "##" (subseq (symbol-string token) 0 2))
(consume-tokens-recursively stream)))) ; recurse
(defun conditional-syntax-reader (stream subchar arg)
(unless (member (read stream t nil t) *features*)
(consume-tokens-recursively stream)))
However, I'm given to believe that this wouldn't be sufficient:
The #+ syntax operates by first reading the feature specification and then skipping over the form if the feature is false. This skipping of a form is a bit tricky because of the possibility of user-defined macro characters and side effects caused by the #. and #, constructions. It is accomplished by binding the variable read-suppress to a non-nil value and then calling the read function.
This seems to imply that I can just let ((*read-suppress* t)) when using read to solve the issue. Is that right?
EDIT 1
Upon further analysis, it seems the problem is caused by not knowing how many tokens to consume. Consider the following attributes:
##export expects one argument: the (defun ...) to export.
##traced expects two arguments: the debug level and the (defun ...) to trace.
Example:
#+somefeature
##export
##traced 3
(defun ...)
It turns out that #+ and #- are capable of suppressing all these tokens; but there is a huge problem!
When under a suppressing #+ or #-, (read) returns NIL!
Example:
(defun annotation-syntax-reader (stream subchar arg)
(case (read stream t nil t)
('export
(let ((defun-form (read stream t nil t)))))
; do something
('traced
(let* ((debug-level (read stream t nil t))
(defun-form (read stream t nil t)))))))
; do something
(setf *readtable* (copy-readtable))
(set-dispatch-macro-character #\# #\# #'annotation-syntax-reader)
#+(or) ##traced 3 (defun ...)
The ##traced token is being suppressed by the #+. In this situation, all the (read) calls in (annotation-syntax-reader) consume real tokens but return NIL!
Therefore, the traced token is consumed, but the case fails. No additional tokens are thus consumed; and control leaves the scope of the #+.
The (defun ...) clause is executed as normal, and the function comes into being. Clearly not the desired outcome.
The standard readtable
Changing the macros for #+ and #- is a bit excessive solution I think, but in any case remember to not actually change the standard readtable (as you did, but its important to repeat in the answer)
The consequences are undefined if an attempt is made to modify the standard readtable. To achieve the effect of altering or extending standard syntax, a copy of the standard readtable can be created; see the function copy-readtable.
§2.1.1.2 The Standard Readtable
Now, maybe I'm missing something (please give us a hint about how your reader macro is defined if so), but I think it is possible to avoid that and write your custom macros in a way that works for your use case.
Reader macro
Let's define a simple macro as follows:
CL-USER> (defun my-reader (stream char)
(declare (ignore char))
(let ((name (read stream)
(form (read stream))
(unless *read-suppress*
`(with-decoration ,name ,form)))
MY-READER
[NB: This was edited to take into account *read-suppress*: the code always read two forms, but returns nil in case it is being ignored. In the comments you say that you may need to read an indefinite number of forms based on the name of the decoration, but with *read-suppress* the recursive calls to read return nil for symbols, so you don't know which decoration is being applied. In that case it might be better to wrap some arguments in a literal list, or parse the stream manually (read-char, etc.). Also, since you are using a dispatching macro, maybe you can add a numerical argument if you want the decoration to be applied to more than one form (#2#inline), but that could be a bad idea when later the decorated code is being modified.]
Here the reader does a minimal job, namely build a form that is intended to be macroexpanded later. I don't even need to define with-decoration for now, as I'm interested in the read step. The intent is to read the next token (presumably a symbol that indicates what decoration is being applied, and a form to decorate).
I'm binding this macro to a unused character:
CL-USER> (set-macro-character #\§ 'my-reader)
T
Here when I test the macro it wraps the following form:
CL-USER> (read-from-string "§test (defun)")
(WITH-DECORATION TEST (DEFUN))
13 (4 bits, #xD, #o15, #b1101)
And here it works with a preceding QUOTE too, the apostrophe reader grabs the next form, which recursively reads two forms:
CL-USER> '§test (defun)
(WITH-DECORATION TEST (DEFUN))
Likewise, a conditional reader macro will ignore all the next lines:
CL-USER> #+(or) t
; No values
CL-USER> #+(or) §test (defun)
; No values
CL-USER> #+(or) §one §two §three (defun)
; No values
Decoration macro
If you use this syntax, you'll have nested decorated forms:
CL-USER> '§one §two (defun test ())
(WITH-DECORATION ONE (WITH-DECORATION TWO (DEFUN TEST ())))
With respect to defun in toplevel positions, you can arrange for your macros to unwrap the nesting (not completely tested, there might be bugs):
(defun unwrap-decorations (form stack)
(etypecase form
(cons (destructuring-bind (head . tail) form
(case head
(with-decoration (destructuring-bind (token form) tail
(unwrap-decorations form (cons token stack))))
(t `(with-decorations ,(reverse stack) ,form)))))))
CL-USER> (unwrap-decorations ** nil)
(WITH-DECORATIONS (ONE TWO) (DEFUN TEST ()))
And in turn, with-decorations might know about DEFUN forms and how to annotate them as necessary.
For the moment, our original macro is only the following (it needs more error checking):
(defmacro with-decoration (&whole whole &rest args)
(unwrap-decorations whole nil))
For the sake of our example, let's define a generic annotation mechanism:
CL-USER> (defgeneric expand-decoration (type name rest))
#<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::EXPAND-DECORATION (0)>
It is used in with-decorations to dispatch on an appropriate expander for each decoration. Keep in mind that all the efforts here are to keep defun in a top-level positions (under a progn), a recursive annotation would let evaluation happens (in the case of defun, it would result in the name of the function being defined), and the annotation could be done on the result.
The main macro is then here, with a kind of fold (reduce) mechanism where the forms are decorated using the resulting expansion so far. This allows for expanders to place code before or after the main form (or do other fancy things):
(defmacro with-decorations ((&rest decorations) form)
(etypecase form
(cons (destructuring-bind (head . tail) form
(ecase head
(defun (destructuring-bind (name args . body) tail
`(progn
,#(loop
for b = `((defun ,name ,args ,#body)) then forms
for d in decorations
for forms = (expand-decoration d name b)
finally (return forms))))))))))
(nb. here above we only care about defun but the loop should probably be done outside of the dispatching thing, along with a way to indicate to expander methods that a function is being expanded; well, it could be better)
Say, for example, you want to declare a function as inline, then the declaration must happen before (so that the compiler can know the source code must be kept):
(defmethod expand-decoration ((_ (eql 'inline)) name rest)
`((declaim (inline ,name)) ,#rest))
Likewise, if you want to export the name of the function being defined, you can export it after the function is defined (order is not really important here):
(defmethod expand-decoration ((_ (eql 'export)) name rest)
`(,#rest (export ',name)))
The resulting code allows you to have a single (progn ...) form with a defun in toplevel position:
CL-USER> (macroexpand '§inline §export (defun my-test-fn () "hello"))
(PROGN
(DECLAIM (INLINE MY-TEST-FN))
(DEFUN MY-TEST-FN () "hello")
(EXPORT 'MY-TEST-FN))
I recently discovered that all of my implementations of Scheme throw an error when I try to use (cadaddr (list 1 3 (list 5 7) 9)). Apparently, by default Scheme does not allow any car and cdr combinations in the single-function form that use more than four abbreviated car and cdrcalls. I originally blamed this on Scheme's minimalism, but then I discovered that Common Lisp also shares this defect.
Can this be solved with a macro? Can we write a macro that allows an arbitrary amount of a and d in its c[...]r calls and returns the expected result, while also having the Common Lisp-like compatibility with macros like setf? If not, why not? And if so, has a reason ever been given for this is not a default feature in any lisp that I've seen?
Such a macro is described in Let Over Lambda for common lisp. You must wrap your code with (with-cxrs ...) to bring them all into scope, but it walks your code to see which combinators you need. I wrote a Clojure port of it years ago for fun, though of course nobody (including me) has ever wanted to use it for real. You could port it to Scheme if you liked.
(defn cxr-impl [name]
(when-let [op (second (re-matches #"c([ad]+)r" name))]
`(comp ~#(map {\a `first \d `rest} op))))
(defmacro with-cxrs [& body]
(let [symbols (remove coll? (tree-seq coll? seq body))]
`(let [~#(for [sym symbols
:let [impl (cxr-impl (name sym))]
:when impl
thing [sym impl]]
thing)]
~#body)))
user> (macroexpand-1 '(with-cxrs (inc (caadaaddadr x))))
(let [caadaaddadr (comp first first rest first first rest rest first rest)]
(inc (caadaaddadr x)))
https://groups.google.com/g/clojure/c/CanBrJPJ4aI/m/S7wMNqmj_Q0J
As noted in the mailing list thread, there are some bugs you'd have to work out if you wanted to use this for real.
I am trying to write a super-tiny Object-oriented system with syntax-rules, mostly just to learn it. Anyway, I am trying to introduce a "this" variable. Here is what I would like to be able to do:
(oo-class Counter
(
(attr value 0)
(attr skip 1)
)
(
(method (next) (set! value (+ value skip)) value)
(method (nextnext) (this 'next) (this 'next))
(method (set-value newval) (set! value newval))
(method (set-skip newskip) (set! skip newskip))
)
)
(define c (Counter))
((c 'set-value) 23)
((c 'next))
((c 'nextnext))
I can get everything to work except "this". It seems like syntax-rules doesn't allow variable introduction. I thought I could get it by defining it as one of the literals in syntax-rules, but this does not seem to work.
Below is my object-oriented system:
(define-syntax oo-class
(syntax-rules (attr method this)
(
(oo-class class-name
((attr attr-name initial-val) ...)
((method (meth-name meth-arg ...) body ...) ...))
(define class-name
(lambda ()
(letrec
(
(this #f)
(attr-name initial-val)
...
(funcmap
(list
(cons (quote meth-name) (cons (lambda (meth-arg ...) body ...) '()))
...
)
)
)
(set! this (lambda (methname)
(cadr (assoc methname funcmap))
))
this
)
)
)
)
)
)
This works for everything except 'nextnext, which errors out when it tries to reference "this".
Is this the right way to do this? Is there some other way to do this? I recognize that this is slightly unhygienic, but isn't that at least part of the point of specifying literals?
I've tried this in Chicken Scheme as well as DrRacket in R5RS mode (other modes get complainy about "this").
Below is the whole file. You can run it on Chicken with just "csi object.scm"
https://gist.github.com/johnnyb/211e105882248e892fa485327039cc90
I also tried to use let-syntax and use (this) as a syntax specifier to refer to the (this) variable. But, as far as I could tell, it wasn't letting me directly access a variable of my own making within the syntax rewriting.
BONUS QUESTION: What is an easy way to see the result of a syntax-rules transformation for debugging? Is there some way to get chicken (or something else) to do the transformation and spit out the result? I tried some stuff on DrRacket, but it doesn't work in R5RS mode.
I recognize that this is slightly unhygienic, but isn't that at least part of the point of specifying literals?
No, the literals exist so you can match literally on keywords, like for example the => or the else in a cond clause. It's still hygienic because if => or else is lexically bound to some value, that has precedence:
(let ((else #f))
(cond (else (display "hi!\n")))) ;; Will not print
Now, you could write a very tedious macro that matches this at any possible place and nesting level in the expansion, but that will never be complete, and it would not nest lexically, either.
It is possible to do what you're trying to do using what has become known as Petrofsky extraction, but it's a total and utter hack and abuse of syntax-rules and it does not work (consistently) in the presence of modules across implementations (for example, exactly in CHICKEN we've had a complaint that we accidentally "broke" this feature).
What I'd suggest is writing a syntax-rules macro that accepts an identifier in its input which will be bound to the current object, then write one trivial unhygienic macro that calls that other macro with the hardcoded identifier this as input.
What is an easy way to see the result of a syntax-rules transformation for debugging? Is there some way to get chicken (or something else) to do the transformation and spit out the result? I tried some stuff on DrRacket, but it doesn't work in R5RS mode.
In csi, you can use ,x (macro-call), but it will only do one level of expansion.
A common trick that works in every Scheme implementation is to change your macro definition to quote its output. So, it expands not to (foo) but to '(foo). That way, you can just call the macro in the REPL and see its result immediately.
I get this error:
Error: Class named ENTITY not found.
While executing: FIND-CLASS, in process Listener(4).
Type cmd-/ to continue, cmd-. to abort, cmd-\ for a list of available restarts.
If continued: Try finding the class again
Type :? for other options.
When I load/compile a file with this macro in it:
(defmacro def-post-entity (entity)
(let* ((repository-var-name (cl-ddd::repository-var entity))
(base-url (string-downcase (concatenate 'string "/api/" (string entity))))
(progn-statement '(progn)))
(loop
for slot in (ccl:class-slots (find-class entity))
append `(setf (,(ccl:slot-definition-name slot) new-entity)
(cdr (assoc ,(string (ccl:slot-definition-name slot)) params :test #'string=)))
into progn-statement)
`(setf (ningle:route cl::*app* ,base-url :method :post)
(lambda (params)
(let ((new-entity (make-instance ,entity)))
(,progn-statement))))))
As I understand lisp macros (I'm new), there's no reason for find-class to expect entity to be a classname, it's a parameter to the macro. The error message indicates that find-class is being executed, but it's not. I'm just loading the file containing this macro via (ql:quickload "filename") or compile it directly.
Any help would be appreciated in helping me to understand what's happening, and to fix it.
The problem was the macro AFTer this one, where I call def-post-entity. It's a macro as well, and I forgot that that would mean def-post-entity gets expanded there as well.
Coredumps comment helped me figure it out.
I've been playing with LISP lately, and I want to attempted to optimize a terribly inefficient recursive function by caching it's output so it only runs each combination of parameters once. I want to save the results into hash table, using either (LIST a b) or (CONS a b) as the key. My question is, is that even possible? Documentation I've read would lead me to believe it is, as the document I read defines the key as an 'object', and defines 'object' as something that was constructed with cons. So I gave this a try.
(defparameter *table* (make-hash-table))
(setf (gethash (list 1 2) *table*) 123)
(format t "~S~%" (gethash (list 1 2) *table*))
And it gives me NIL, when I would expect 123. If i replace the (list 1 2) with a cons it still doesn't work, but when I use an plain integer, it works fine.
I'm using GCL 2.6.12
(make-hash-table :test #'equal)
Solutions for caching results of functions has been already implemented for Common Lisp. One is library fare-memoization, the second is function-cache and both are accessible with the Quicklisp. Using the former is as easy as defining normal function:
(define-memo-function your-time-consuming-function (arg)
(code arg))
For reference please check https://github.com/fare/fare-memoization.