I have difficulties understanding the new macro system of Scheme. Somewhere along the path I began to write my "macro" as a function first, and then later apply it as a macro.
So my mission is to turn the following structure:
;; highlight-rules: rule id, color and the regexp matches
(define highlight-rules
`((important ,(with-esc "[1;33m") ("foo"
"bob"))
(unimportant ,(with-esc "[1;30m") ("case of unimport"))
(urgent ,(with-esc "[1;31m") ("urgents"))))
Into this kind of cond series with match strings compiled to regexpes:
;; just an example. `line` is an argument bound by the function application
(cond
((string-match (regexp ".*sudo:session.*") line)
(with-color *important* line))
(else line))
I have written a function that seems to do the trick:
;; (cdar highlight-rules) -> (colorstring list-of-rules)
(define (parse-highlight-rules rules)
;; aux function to do one 'class' of patterns
(define (class-of-rules colorstr rulelist)
(map (lambda (rule)
`((string-match ,(regexp rule)) (with-color ,colorstr line)))
rulelist))
(define (do-loop accumulator rules)
(let* ((highlight-group (cdar rules))
(colorstr (car highlight-group))
(grouprules (cadr highlight-group))
(acc* (append (class-of-rules colorstr grouprules) accumulator))
(rest (cdr rules)))
(if (null? rest)
acc*
(do-loop acc* rest))))
; wrap the list in cond.
`(apply cond ,(do-loop '() rules)))
With given highlight-rules the function returns correct-looking list (well apart from applying the apply -- in clojure one would use splicing):
CSI> (parse-highlight-rules highlight-rules)
(apply cond (((string-match #<regexp>) (with-color "\x1b[1;31m" line))
((string-match #<regexp>) (with-color "\x1b[1;30m" line))
((string-match #<regexp>) (with-color #0="\x1b[1;33m" line))
((string-match #<regexp>) (with-color #0# line))))
But how to proceed with this? I've been stuck with this for a while. Chicken Scheme is my dialect.
The easiest way of transforming your function into a macro is by using Chicken's explicit-renaming macro facility, which works similarly to Clojure's defmacro (except that an explicit-renaming macro takes some additional arguments that can be used to preserve hygiene).
Splicing works basically the same way as it does in Clojure. The syntax is ,#. Therefore, the following should work:
(define-for-syntax (parse-highlight-rules rules)
;; ... insert missing code here ...
`(cond ,#(do-loop '() rules)))
(define-syntax highlight
(er-macro-transformer
(lambda (form rename compare)
(parse-highlight-rules (cdr form)))))
Related
I have macro that I've written in 2010, it was for managing structures like in Common Lips using Alists (here is whole file including functions https://jcubic.pl/struct.txt).
(define-macro (defstruct name . fields)
"Macro implementing structures in guile based on assoc list."
(let ((names (map (lambda (symbol) (gensym)) fields))
(struct (gensym))
(field-arg (gensym)))
`(if (not (every-unique ',fields))
(error 'defstruct "Fields must be unique")
(begin
(define (,(make-name name) ,#names)
(map cons ',fields (list ,#names)))
,#(map (lambda (field)
`(define (,(make-getter name field) ,struct)
(cdr (assq ',field ,struct)))) fields)
,#(map (lambda (field)
`(define (,(make-setter name field) ,struct ,field-arg)
(assq-set! ,struct ',field ,field-arg)
,field-arg)) fields)
(define (,(make-predicate name) ,struct)
(and (struct? ,struct)
(let ((result #t))
(for-each (lambda (x y)
(if (not (eq? x y)) (set! result #f)))
',fields
(map car ,struct))
result)))))))
It was working fine. I've recently updated this macro for my LIPS in JavaScript (it's based on scheme) and when I call it, it was returning false and wanted to know if this is how it would work in guile. But it turns out it don't work in guile at all. It shows this error:
While compiling expression: ERROR: Syntax error: unknown location:
definition in expression context, where definitions are not allowed,
in form (define (make-point #{ g746}# #{ g747}#) (map cons (quote (x
y)) (list #{ g746}# #{ g747}#))
Why I've got this error and how to fix it, so it work in guile again? I was long ago I don't remember how I was testing this code but opening guile using load function or copy paste the code into interpreter all give same error.
I'm using guile 2.0.14 on GNU/Linux.
PS: I prefer to use lisp macros IMO they are superior to weird scheme hygienic macros.
It looks like modern guile scheme does not see the begin in the if as a valid option to start a new definition context. This is perhaps a bug or better alignment of the scheme spec donough. But the following example code shows the technique to fix your code for more recent guile (you might need to create define-values as it is a more recent addition to guile. P.S. using lisps macros in guile is a clludge and it will get you into trouble if you plan to scheme a lot, the macros is like the parens, if you get used to it will feel natural.
Here is the code,
(define-macro (defstruct name . fields)
"Macro implementing structures in guile based on assoc list."
(let* ((names (map (lambda (symbol) (gensym)) fields))
(struct (gensym))
(field-arg (gensym))
(sname (make-name name))
(predname (make-predicate name))
(getnames (map (lambda (f) (make-getter name f)) fields))
(setnames (map (lambda (f) (make-setter name f)) fields)))
`(define-values (,sname ,predname ,#getnames ,#setnames)
(if (not (every-unique ',fields))
(error 'defstruct "Fields must be unique")
(let ()
(define (,sname ,#names)
(map cons ',fields (list ,#names)))
,#(map (lambda (field)
`(define (,(make-getter name field) ,struct)
(cdr (assq ',field ,struct)))) fields)
,#(map (lambda (field)
`(define (,(make-setter name field) ,struct ,field-arg)
(assq-set! ,struct ',field ,field-arg)
,field-arg)) fields)
(define (,predname ,struct)
(and (struct? ,struct)
(let ((result #t))
(for-each (lambda (x y)
(if (not (eq? x y)) (set! result #f)))
',fields
(map car ,struct))
result)))
(values ,sname ,predname ,#getnames ,#setnames))))))
Here is a version of define-values (look at the code after #' to see what it does)
(define-syntax define-values
(lambda (x)
(syntax-case x ()
((_ (f ...) code ...)
(with-syntax (((ff ...) (generate-temporaries #'(f ...))))
#'(begin
(define f #f)
...
(call-with-values (lambda () code ...)
(lambda (ff ...)
(set! f ff)
...))))))))
I'm just starting to learn the concept of macro functions.
My teacher has asked us to create a macro function that would function exactly the same way as incf.
Here is an example he has given us for pop
(defmacro mypop (nom)
(list 'prog1 (list 'car nom) (list 'setq nom (list 'cdr nom))) )
Here is the regular function I'm trying to turn into a macro:
(defun iincf (elem &optional num )
(cond
((not num) (setq elem (+ 1 elem)))
(t (setq elem (+ num elem))) ) )
Here is my attempt at turning it into a macro :
(defmacro myincf (elem &optional num )
(list 'cond
((list 'not num) (list 'setq elem (list '+ 1 elem)))
(t (list 'setq elem (list '+ num elem))) ) )
However, I get this error and I don't know why:
*** - system::%expand-form: (list 'not num) should be a lambda expression
Also, I'm not sure whether my function would actually change the value of the variable at the top level.
So here are my 2 questions:
Why do I get this error?
Is the function I'm trying to turn into a macro fine? (if successfully turning it into a macro function, would it do what I intend to?)
PS: I know this exercise would probably infringe many common rules in lisp, but this is just for practice. Thanks! :)
The reason for the error is that your syntax is invalid:
((list ...) ...)
(t (list ...))
The first element should be a function name or a lambda expression, so you would need to change it to something like
(list (list ...) ...)
(list t (list ...))
Although the macro isn't a very good one yet. First of all, the backquote syntax would make the code much more readable. It allows you to write a template where only the specified forms are evaluated. For example, the given MYPOP macro would look like
(defmacro mypop (nom)
`(prog1 (car ,nom)
(setq ,nom (cdr ,nom))))
Only the forms with a comma before them are evaluated. Same with your macro:
(defmacro myincf (elem &optional num)
`(cond
((not ,num) (setq ,elem (+ 1 ,elem)))
(t (setq ,elem (+ ,num ,elem)))))
The COND shouldn't really be part of the expansion though. It should be evaluated during macroexpansion, and only the SETQ form from one of the branches returned.
(defmacro myincf (elem &optional num)
(cond
((not num) `(setq ,elem (+ 1 ,elem)))
(t `(setq ,elem (+ ,num ,elem)))))
The only difference between the two branches is that the first one defaults to 1 for NUM. A simpler way to achieve the same would be to give NUM a default value.
(defmacro myincf (elem &optional (num 1))
`(setq ,elem (+ ,num ,elem)))
Of course, the standard INCF is a bit more complex, since it works for all sorts of places (not just variables) and ensures that the subforms of the place are evaluated only once. However, since the MYPOP example doesn't handle those, I don't think you have to either.
If you want to, a simple way to define such a macro would be
(define-modify-macro myincf (&optional (num 1)) +)
Or you could do the same manually with something like
(defmacro myincf (place &optional (num 1) &environment env)
(multiple-value-bind (dummies vals store setter getter)
(get-setf-expansion place env)
`(let* (,#(mapcar #'list dummies vals)
(,(first store) (+ ,getter ,num)))
,setter)))
But using DEFINE-MODIFY-MACRO would be preferrable in a real program (shorter code, less bugs). You could read about GET-SETF-EXPANSION and DEFINE-MODIFY-MACRO if you're interested.
In Python, I am able to use yield to build up a list without having to define a temporary variable:
def get_chars_skipping_bar(word):
while word:
# Imperative logic which can't be
# replaced with a for loop.
if word[:3] == 'bar':
word = word[3:]
else:
yield foo[0]
foo = foo[1:]
In elisp, I can't see any way of doing this, either built-in or using any pre-existing libraries. I'm forced to manually build a up a list and call nreverse on it. Since this is a common pattern, I've written my own macro:
(require 'dash)
(require 'cl)
(defun replace-calls (form x func)
"Replace all calls to X (a symbol) in FORM,
calling FUNC to generate the replacement."
(--map
(cond
((consp it)
(if (eq (car it) x)
(funcall func it)
(replace-calls it x func)))
(:else it))
form))
(defmacro with-results (&rest body)
"Execute BODY, which may contain forms (yield foo).
Return a list built up from all the values passed to yield."
(let ((results (gensym "results")))
`(let ((,results (list)))
,#(replace-calls body 'yield
(lambda (form) `(push ,(second form) ,results)))
(nreverse ,results))))
Example usage:
(setq foo "barbazbarbarbiz")
(with-results
(while (not (s-equals? "" foo))
;; Imperative logic which can't be replaced with cl-loop's across.
(if (s-starts-with? "bar" foo)
(setq foo (substring foo 3))
(progn
(yield (substring foo 0 1))
(setq foo (substring foo 1))))))
There must be a better way of doing this, or an existing solution, somewhere in elisp, cl.el, or a library.
The Python function is actually a generator. In ANSI Common Lisp, we would usually reach for a lexical closure to simulate a generator, or else us a library to define generators directly, like Pygen. Maybe these approaches can be ported to Emacs Lisp.
AFAIK, people just use push+nreverse like you do. If you want to define your macro in a more robust way (e.g. so it doesn't misfire on something like (memq sym '(yield stop next))) you could do it as:
(defmacro with-results (&rest body)
"Execute BODY, which may contain forms (yield EXP).
Return a list built up from all the values passed to `yield'."
(let ((results (gensym "results")))
`(let ((,results '()))
(cl-macrolet ((yield (exp) `(push ,exp ,results)))
,#body)
(nreverse ,results))))
Maybe something like this:
(setq foo "barbaz")
(cl-loop for i from 0 to (1- (length foo))
collect (string (aref foo i)))
In any case, there's nothing wrong with push and nreverse.
Lisp is different from Python. yield is not used. I also see the use of coroutine-like constructs for this as a mistake. It's the equivalent of the come-from construct. Suddenly routines have multiple context dependent entry points.
In Lisp use functions/closures instead.
In Common Lisp, the LOOP macro allows efficient mappings over vectors. The following code can be abstracted to some mapping function, if preferred:
CL-USER 17 > (defun chars-without-substring (string substring)
(loop with i = 0
while (< i (length string))
when (and (>= (- (length string) i) (length substring))
(string= substring string
:start2 i
:end2 (+ i (length substring))))
do (incf i (length substring))
else
collect (prog1 (char string i) (incf i))))
CHARS-WITHOUT-SUBSTRING
CL-USER 18 > (chars-without-substring "barbazbarbarbiz" "bar")
(#\b #\a #\z #\b #\i #\z)
I'm reading Peter Norvig's Paradigms of AI. In chapter 6.2, the author uses code like below (not the original code, I picked out the troubling part):
Code Snippet:
(progv '(op arg) '(1+ 1)
(eval '(op arg)))
As the author's original intent, this code should return 2, but in sbcl 1.1.1, the interpreter is apparently not looking up op in the environment, throwing out op: undefined function.
Is this implementation specific? Since the code must have been tested on some other lisp.
p.s Original code
You probably mean
(progv '(op arg) '(1+ 1)
(eval '(funcall op arg)))
Edit(2013-08-21):
PAIP was written in pre-ANSI-Common-Lisp era, so it's possible the code
there contains a few noncompliances wrt the standard. We can make
the examples work with the following revision:
(defun match-if (pattern input bindings)
"Test an arbitrary expression involving variables.
The pattern looks like ((?if code) . rest)."
(and (eval (reduce (lambda (code binding)
(destructuring-bind (var . val) binding
(subst val var code)))
bindings :initial-value (second (first pattern))))
(pat-match (rest pattern) input bindings)))
;; CL-USER> (pat-match '(?x ?op ?y is ?z (?if (eql (?op ?x ?y) ?z))) '(3 + 4 is 7))
;; ((?Z . 7) (?Y . 4) (?OP . +) (?X . 3) (T . T))
;; CL-USER> (pat-match '(?x ?op ?y (?if (?op ?x ?y))) '(3 > 4))
;; NIL
Elements in first positions are not looked up as values, but as functions and there is no concept of dynamic binding in the function namespace.
I'd say after a quick look that the original code was designed to evaluate in a context like
(progv '(x y) '(12 34)
(eval '(> (+ x y) 99)))
i.e. evaluating a formula providing substitution for variables, not for function names.
The other answers so far are right, in that the actual form being evaluated is not the variables being bound by progv (simply (op arg)), but none have mentioned what is being evaluated. In fact, the comments in the code you linked to provide a (very) short explanation (this is the only code in that file that uses progv):
(defun match-if (pattern input bindings)
"Test an arbitrary expression involving variables.
The pattern looks like ((?if code) . rest)."
;; *** fix, rjf 10/1/92 (used to eval binding values)
(and (progv (mapcar #'car bindings)
(mapcar #'cdr bindings)
(eval (second (first pattern))))
(pat-match (rest pattern) input bindings)))
The idea is that a call to match-if gets called like
(match-if '((?if code) . rest) input ((v1 val1) (v2 val2) ...))
and eval is called with (second (first pattern)), which the value of code. However, eval is called within the progv that binds v1, v2, &c., to the corresponding val1, val2, &c., so that if any of those variables appear free in code, then they are bound when code is evaluated.
Problem
The problem that I see here is that, by the code we can't tell if the value is to be saved as the variable's symbol-value or symbol-function. Thus when you put a + as a value to some corresponding variable, say v, then it'll always be saved as the symbol-value of var, not it's symbol-function.
Therefore when you'll try to use it as, say (v 1 2) , it won't work. Because there is no function named v in the functions' namespace(see this).
So, what to do?
A probable solution can be explicit checking for the value that is to be bound to a variable. If the value is a function, then it should be bound to the variable's function value. This checking can be done via fboundp.
So, we can make a macro functioner and a modified version of match-if. functioner checks if the value is a function, and sets it aptly. match-if does the dynamic local bindings, and allows other code in the scope of the bound variables.
(defmacro functioner (var val)
`(if (and (symbolp ',val)
(fboundp ',val))
(setf (symbol-function ',var) #',val)
(setf ,var ,val)))
(defun match-if (pattern input bindings)
(eval `(and (let ,(mapcar #'(lambda (x) (list (car x))) bindings)
(declare (special ,# (mapcar #'car bindings)))
(loop for i in ',bindings
do (eval `(functioner ,(first i) ,(rest i))))
(eval (second (first ',pattern))))
(pat-match (rest ',pattern) ',input ',bindings))))
I am trying to write a macro that defines a special class of data structure with associated functions.
I know this is possible; it is done multiple times in the core language itself.
As a specific example, how would I define the define-struct macro in Scheme itself. It needs to create make-struct, struct-<<field>>, etc functions.
I tried doing this using define, however, this only defines the function in the macro's lexical scope.
How can I actually define a function in a macro?
The key for an answer is datum->syntax. The basic idea is that you want to take some random data and turn it into a syntax -- in this case, turn a symbol into an identifier. An identifier is basically a symbol with some lexical information that (very roughly) indicates how it is bound. Using datum->syntax you can do exactly that: it expects an existing piece of syntax which is where it copies the binding from, and a datum (a symbol here) which is the value that is contained in the syntax wrapper.
Here's an example that demonstrates a define-struct-like tool using this:
#lang scheme
;; implements a defstruct-like macro that uses association lists
(define-syntax (defstruct-lite stx)
(syntax-case stx ()
[(defstruct-lite name field ...)
(let ([make-id
(lambda (template . ids)
(let ([str (apply format template (map syntax->datum ids))])
(datum->syntax stx (string->symbol str))))])
(with-syntax ([make-name (make-id "make-~a" #'name)]
[name? (make-id "~a?" #'name)]
[(arg ...) (generate-temporaries #'(field ...))]
[(name-field ...)
(map (lambda (f) (make-id "~a-~a" #'name f))
(syntax->list #'(field ...)))])
#'(begin
(define (make-name arg ...) (list 'name (cons 'field arg) ...))
(define (name? x) (and (pair? x) (eq? 'name (car x))))
(define (name-field x)
(and (name? x) (cdr (assq 'field (cdr x)))))
...)))]))
And here's an example of using it:
(defstruct-lite point x y)
(point-y (make-point 1 2))