My lisp macro stops working in latest guile - macros

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)
...))))))))

Related

How to expand a macro in MIT Scheme

I have written a simple macro:
(define-syntax myif
(syntax-rules ()
((_ condition a b)
(if condition a b))))
Usage example: (myif #t "yes" "no").
In MIT Scheme, how do I show the macro expansion of the example above? Is there something similar to Common Lisp's macroexpand and macroexpand-1 or Racket's expand and expand-once?
(MIT Scheme version: 11.2)
% cat macro.scm
(define-syntax myif
(syntax-rules ()
((_ condition a b)
(if condition a b))))
% mit-scheme --silent
(sf "macro.scm")
;Generating SCode for file: "macro.scm" => "macro.bin"...
; This program does not have a USUAL-INTEGRATIONS declaration.
; Without this declaration, the compiler will be unable to perform
; many optimizations, and as a result the compiled program will be
; slower and perhaps larger than it could be. Please read the MIT
; Scheme User's Guide for more information about USUAL-INTEGRATIONS.
;... done
(pp (fasload "macro.bin"))
;Loading "macro.bin"... done
(define-syntax myif
(er-macro-transformer
(lambda (form rename compare)
(if (and (pair? form)
(let ((temp (cdr form)))
(and (pair? temp)
(let ((temp (cdr temp)))
(and (pair? temp)
(let ((temp (cdr temp)))
(and (pair? temp)
(null? (cdr temp)))))))))
(list (rename 'if)
(car (cdr form))
(car (cdr (cdr form)))
(car (cdr (cdr (cdr form)))))
(ill-formed-syntax form)))))
will print the Scode. This is enough for debugging.
As it's expressed in the warning of compilation, it is important not to activate the optimizations, otherwise you won't see any more the literal translation into Scode.
This is the starting point when I debug (not only macros).

Lisp - Passing unquoted list to macro

I'm currently experimenting with macro's in Lisp and I would like to write a macro which can handle syntax as follows:
(my-macro (args1) (args2))
The macro should take two lists which would then be available within my macro to do further processing. The catch, however, is that the lists are unquoted to mimic the syntax of some real Lisp/CLOS functions. Is this possible?
Currently I get the following error when attempting to do something like this:
Undefined function ARGS1 called with arguments ().
Thanks in advance!
I think you need to show what you have tried to do. Here is an example of a (silly) macro which has an argument pattern pretty much what yours is:
(defmacro stupid-let ((&rest vars) (&rest values) &body forms)
;; Like LET but with a terrible syntax
(unless (= (length vars) (length values))
(error "need exactly one value for each variable"))
(unless (every #'symbolp vars)
(error "not every variable is a symbol"))
`(let ,(mapcar #'list vars values) ,#forms))
Then
> (macroexpand '(stupid-let (a b c) (1 2 3) (+ a b c)))
(let ((a 1) (b 2) (c 3)) (+ a b c))
The above macro depends on defmacro's arglist-destructuring, but you don't have to do that:
(defun proper-list-p (l)
;; elaborate version with an occurs check, quadratic.
(labels ((plp (tail tails)
(if (member tail tails)
nil
(typecase tail
(null t)
(cons (plp (rest tail) (cons tail tails)))
(t nil)))))
(plp l '())))
(defmacro stupid-let (vars values &body forms)
;; Like LET but with a terrible syntax
(unless (and (proper-list-p vars) (proper-list-p values))
(error "need lists of variables and values"))
(unless (= (length vars) (length values))
(error "need exactly one value for each variable"))
(unless (every #'symbolp vars)
(error "not every variable is a symbol"))
`(let ,(mapcar #'list vars values) ,#forms))
As a slightly more useful example, here is a macro which is a bit like the CLOS with-slots / with-accessors macros:
(defmacro with-mindless-accessors ((&rest accessor-specifications) thing
&body forms)
"Use SYMBOL-MACROLET to define mindless accessors for THING.
Each accessor specification is either a symbol which names the symbol
macro and the accessor, or a list (macroname accessorname) which binds
macroname to a symbol macro which calls accessornam. THING is
evaluated once only."
(multiple-value-bind (accessors functions)
(loop for accessor-specification in accessor-specifications
if (symbolp accessor-specification)
collect accessor-specification into acs
and collect accessor-specification into fns
else if (and (proper-list-p accessor-specification)
(= (length accessor-specification) 2)
(every #'symbolp accessor-specification))
collect (first accessor-specification) into acs
and collect (second accessor-specification) into fns
else do (error "bad accessor specification ~A" accessor-specification)
end
finally (return (values acs fns)))
(let ((thingn (make-symbol "THING")))
`(let ((,thingn ,thing))
(symbol-macrolet ,(loop for accessor in accessors
for function in functions
collect `(,accessor (,function ,thingn)))
,#forms)))))
So now we can write this somewhat useless code:
> (with-mindless-accessors (car cdr) (cons 1 2)
(setf cdr 3)
(+ car cdr))
4
And this:
> (let ((l (list 1 2)))
(with-mindless-accessors (second) l
(setf second 4)
l))
(1 4)

How to write LISP macro with double quasi quotation in scheme

I need to write the lisp macro in scheme (please on hygienic macros and syntax-rules etc) that will have function call and Alist as argument
I want function and macro that call that function to have syntax like this:
(foo '(10 (a (lambda () (display "10")) b (lambda () (display "20"))))
or macro without quotes.
My last code is working, but not sure if this is how you suppose to write function/macro like this. It seems that I need double backquote but don't know how to write it. (I'm right now reading On Lips by Paul Graham and he said that double backquote is very hard and only need by macros defining macros, but It seems that this is what I need).
(define (foo expr)
`(list ,(car expr)
(,(string->symbol "quasiquote") ,(pair-map (lambda (a b)
(cons (symbol->string a)
(list 'unquote b)))
(cadr expr)))))
(define-macro (bar expr)
(foo expr))
(define xx (bar (10 (a 20 b (lambda () (display "x") (newline))))))
;; (list 10 `((a . ,20) (b . ,(lambda () (display "x") (newline))))
(define bfn (cdr (assoc "b" (cadr xx)))))
(bfn)
;; "x"
and here is definition of pair-map
(define (pair-map fn seq-list)
"(seq-map fn list)
Function call fn argument for pairs in a list and return combined list with
values returned from function fn. It work like the map but take two items from list"
(let iter ((seq-list seq-list) (result '()))
(if (null? seq-list)
result
(if (and (pair? seq-list) (pair? (cdr seq-list)))
(let* ((first (car seq-list))
(second (cadr seq-list))
(value (fn first second)))
(if (null? value)
(iter (cddr seq-list) result)
(iter (cddr seq-list) (cons value result))))))))
with (string->symbol "quasiquote") I was able not to use double backquote, can this be written with double backquote/quasiquote? How this should look like?
I'm asking if this can be written different way so I can fix few issues in my own lisp interpreter (not sure if is working correctly but it seems that this final version works the same in guile).
I came up with shorter quasiquote version, but still it require inserting symbols:
(define (foo expr)
`(list ,(car expr)
(,'quasiquote ,(pair-map (lambda (a b)
`(,(symbol->string a) . (,'unquote ,b)))
(cadr expr)))))

Macros That Write Macros - Compile Error

When I compile the following code, SBCL complains that g!-unit-value and g!-unit are undefined. I'm not sure how to debug this. As far as I can tell, flatten is failing.
When flatten reaches the unquoted part of defunits, it seems like the entire part is being treated as an atom. Does that sound correct?
The following uses code from the book Let over Lambda:
Paul Graham Utilities
(defun symb (&rest args)
(values (intern (apply #'mkstr args))))
(defun mkstr (&rest args)
(with-output-to-string (s)
(dolist (a args) (princ a s))))
(defun group (source n)
(if (zerop n) (error "zero length"))
(labels ((rec (source acc)
(let ((rest (nthcdr n source)))
(if (consp rest)
(rec rest (cons (subseq source 0 n) acc))
(nreverse (cons source acc))))))
(if source (rec source nil) nil)))
(defun flatten (x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
Let Over Lambda Utilities - Chapter 3
(defmacro defmacro/g! (name args &rest body)
(let ((g!-symbols (remove-duplicates
(remove-if-not #'g!-symbol-p
(flatten body)))))
`(defmacro ,name ,args
(let ,(mapcar
(lambda (g!-symbol)
`(,g!-symbol (gensym ,(subseq
(symbol-name g!-symbol)
2))))
g!-symbols)
,#body))))
(defun g!-symbol-p (symbol-to-test)
(and (symbolp symbol-to-test)
(> (length (symbol-name symbol-to-test)) 2)
(string= (symbol-name symbol-to-test)
"G!"
:start1 0
:end1 2)))
(defmacro defmacro! (name args &rest body)
(let* ((o!-symbols (remove-if-not #'o!-symbol-p args))
(g!-symbols (mapcar #'o!-symbol-to-g!-symbol o!-symbols)))
`(defmacro/g! ,name ,args
`(let ,(mapcar #'list (list ,#g!-symbols) (list ,#o!-symbols))
,(progn ,#body)))))
(defun o!-symbol-p (symbol-to-test)
(and (symbolp symbol-to-test)
(> (length (symbol-name symbol-to-test)) 2)
(string= (symbol-name symbol-to-test)
"O!"
:start1 0
:end1 2)))
(defun o!-symbol-to-g!-symbol (o!-symbol)
(symb "G!" (subseq (symbol-name o!-symbol) 2)))
Let Over Lambda - Chapter 5
(defun defunits-chaining (u units prev)
(if (member u prev)
(error "~{ ~a~^ depends on~}"
(cons u prev)))
(let ((spec (find u units :key #'car)))
(if (null spec)
(error "Unknown unit ~a" u)
(let ((chain (second spec)))
(if (listp chain)
(* (car chain)
(defunits-chaining
(second chain)
units
(cons u prev)))
chain)))))
(defmacro! defunits (quantity base-unit &rest units)
`(defmacro ,(symb 'unit-of- quantity)
(,g!-unit-value ,g!-unit)
`(* ,,g!-unit-value
,(case ,g!-unit
((,base-unit) 1)
,#(mapcar (lambda (x)
`((,(car x))
,(defunits-chaining
(car x)
(cons
`(,base-unit 1)
(group units 2))
nil)))
(group units 2))))))
This is kind of tricky:
Problem: you assume that backquote/comma expressions are plain lists.
You need to ask yourself this question:
What is the representation of a backquote/comma expression?
Is it a list?
Actually the full representation is unspecified. See here: CLHS: Section 2.4.6.1 Notes about Backquote
We are using SBCL. See this:
* (setf *print-pretty* nil)
NIL
* '`(a ,b)
(SB-INT:QUASIQUOTE (A #S(SB-IMPL::COMMA :EXPR B :KIND 0)))
So a comma expression is represented by a structure of type SB-IMPL::COMMA. The SBCL developers thought that this representation helps when such backquote lists need to be printed by the pretty printer.
Since your flatten treats structures as atoms, it won't look inside...
But this is the specific representation of SBCL. Clozure CL does something else and LispWorks again does something else.
Clozure CL:
? '`(a ,b)
(LIST* 'A (LIST B))
LispWorks:
CL-USER 87 > '`(a ,b)
(SYSTEM::BQ-LIST (QUOTE A) B)
Debugging
Since you found out that somehow flatten was involved, the next debugging steps are:
First: trace the function flatten and see with which data it is called and what it returns.
Since we are not sure what the data actually is, one can INSPECT it.
A debugging example using SBCL:
* (defun flatten (x)
(inspect x)
(labels ((rec (x acc)
(cond ((null x) acc)
((atom x) (cons x acc))
(t (rec (car x) (rec (cdr x) acc))))))
(rec x nil)))
STYLE-WARNING: redefining COMMON-LISP-USER::FLATTEN in DEFUN
FLATTEN
Above calls INSPECT on the argument data. In Common Lisp, the Inspector usually is something where one can interactively inspect data structures.
As an example we are calling flatten with a backquote expression:
* (flatten '`(a ,b))
The object is a proper list of length 2.
0. 0: SB-INT:QUASIQUOTE
1. 1: (A ,B)
We are in the interactive Inspector. The commands now available:
> help
help for INSPECT:
Q, E - Quit the inspector.
<integer> - Inspect the numbered slot.
R - Redisplay current inspected object.
U - Move upward/backward to previous inspected object.
?, H, Help - Show this help.
<other> - Evaluate the input as an expression.
Within the inspector, the special variable SB-EXT:*INSPECTED* is bound
to the current inspected object, so that it can be referred to in
evaluated expressions.
So the command 1 walks into the data structure, here a list.
> 1
The object is a proper list of length 2.
0. 0: A
1. 1: ,B
Walk in further:
> 1
The object is a STRUCTURE-OBJECT of type SB-IMPL::COMMA.
0. EXPR: B
1. KIND: 0
Here the Inspector tells us that the object is a structure of a certain type. That's what we wanted to know.
We now leave the Inspector using the command q and the flatten function continues and returns a value:
> q
(SB-INT:QUASIQUOTE A ,B)
For anyone else who is trying to get defmacro! to work on SBCL, a temporary solution to this problem is to grope inside the unquote structure during the flatten procedure recursively flatten its contents:
(defun flatten (x)
(labels ((flatten-recursively (x flattening-list)
(cond ((null x) flattening-list)
((eq (type-of x) 'SB-IMPL::COMMA) (flatten-recursively (sb-impl::comma-expr x) flattening-list))
((atom x) (cons x flattening-list))
(t (flatten-recursively (car x) (flatten-recursively (cdr x) flattening-list))))))
(flatten-recursively x nil)))
But this is horribly platform dependant. If I find a better way, I'll post it.
In case anyone's still interested in this one, here are my three cents. My objection to the above modification of flatten is that it might be more naturally useful as it were originally, while the problem with representations of unquote is rather endemic to defmacro/g!. I came up with a not-too-pretty modification of defmacro/g! using features to decide what to do. Namely, when dealing with non-SBCL implementations (#-sbcl) we proceed as before, while in the case of SBCL (#+sbcl) we dig into the sb-impl::comma structure, use its expr attribute when necessary and use equalp in remove-duplicates, as we are now dealing with structures, not symbols. Here's the code:
(defmacro defmacro/g! (name args &rest body)
(let ((syms (remove-duplicates
(remove-if-not #-sbcl #'g!-symbol-p
#+sbcl #'(lambda (s)
(and (sb-impl::comma-p s)
(g!-symbol-p (sb-impl::comma-expr s))))
(flatten body))
:test #-sbcl #'eql #+sbcl #'equalp)))
`(defmacro ,name ,args
(let ,(mapcar
(lambda (s)
`(#-sbcl ,s #+sbcl ,(sb-impl::comma-expr s)
(gensym ,(subseq
#-sbcl
(symbol-name s)
#+sbcl
(symbol-name (sb-impl::comma-expr s))
2))))
syms)
,#body))))
It works with SBCL. I have yet to test it thoroughly on other implementations.

How do I define functions using Racket macros?

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))