I want to auto-generate a bunch of test functions from a list. The advantage being I can change the list (e.g. by reading in a CSV data table) and the program will auto-generate different tests on the next program execution.
For example, say I am trying to identify oxyanions in a string containing a chemical formula.
My list may be something like:
(define *oxyanion-tests*
; name cation
(list (list "aluminate" "Al")
(list "borate" "B")
(list "gallate" "Ga")
(list "germanate" "Ge")
(list "phosphate" "P")
(list "sulfate" "S")
(list "silicate" "Si")
(list "titanate" "Ti")
(list "vanadate" "V")
(list "stannate" "Sn")
(list "carbonate" "C")
(list "molybdate" "Mo")
(list "tungstate" "W")))
I'm reasonably confident that the chemical formula contains one of these oxyanions if there is a cation followed by an oxygen within parentheses (e.g. "(C O3)" ), or if the cation is followed by 2 or more oxygens (e.g. "C O3"). Note that this isn't perfect, since it will miss hypochlorite anions (e.g. "Cl O"), but it's good enough for my application.
(define ((*ate? elem) s-formula)
(or (regexp-match? (regexp (string-append "\\(" elem "[0-9.]* O[0-9.]*\\)")) s-formula)
(regexp-match? (regexp (string-append "(^| )" elem "[0-9.]* O[2-9][0-9.]*")) s-formula)))
I think I need a macro to do this, but I don't really understand how they work from reading the documentation. I'm asking here so that I have a good example to look at that is immediately useful to me.
Here is what I kind of think the macro should look like, but it doesn't work and I don't really have a mental model for figuring out how to fix it.
(require (for-syntax racket))
(define-syntax-rule (define-all/ate? oxyanion-tests)
(for ([test oxyanion-tests])
(match test
[(list name cation) (syntax->datum (syntax (define ((string->symbol (string-append name "?")) s-formula)
((*ate? cation) s-formula))))])))
Thanks for any guidance you can give me!
P.S. Here are a few tests that should pass:
(define-all/ate? *oxyanion-tests*)
(module+ test
(require rackunit)
(check-true (borate? "B O3"))
(check-true (carbonate? "C O3"))
(check-true (silicate? "Si O4")))
I see a couple of errors in your code:
Your *oxyanion-tests* is a runtime value, but you need its values to use as function name identifiers, so it must be available at compile time.
The syntax around the result of syntax-rules is implicit. So with syntax-rules, you only get the macro template language (see the docs for syntax for more info). Thus you can't do the datum->syntax that you are trying to do. You have to use syntax-case instead, which allows you to use all of Racket to compute the syntax objects you want.
Here's what I came up with:
#lang racket
(require (for-syntax racket/syntax)) ; for format-id
(define-for-syntax *oxyanion-tests*
; name cation
(list (list "aluminate" "Al")
(list "borate" "B")
(list "gallate" "Ga")
(list "germanate" "Ge")
(list "phosphate" "P")
(list "sulfate" "S")
(list "silicate" "Si")
(list "titanate" "Ti")
(list "vanadate" "V")
(list "stannate" "Sn")
(list "carbonate" "C")
(list "molybdate" "Mo")
(list "tungstate" "W")))
(define ((*ate? elem) s-formula)
(or (regexp-match?
(regexp (string-append "\\(" elem "[0-9.]* O[0-9.]*\\)"))
s-formula)
(regexp-match?
(regexp (string-append "(^| )" elem "[0-9.]* O[2-9][0-9.]*"))
s-formula)))
(define-syntax (define-all/ate? stx)
(syntax-case stx ()
[(_)
(let ([elem->fn-id
(λ (elem-str)
(format-id
stx "~a?"
(datum->syntax stx (string->symbol elem-str))))])
(with-syntax
([((ate? cation) ...)
(map
(λ (elem+cation)
(define elem (car elem+cation))
(define cation (cadr elem+cation))
(list (elem->fn-id elem) cation))
*oxyanion-tests*)])
#`(begin
(define (ate? sform) ((*ate? cation) sform))
...)))]))
(define-all/ate?)
(module+ test
(require rackunit)
(check-true (borate? "B O3"))
(check-true (carbonate? "C O3"))
(check-true (silicate? "Si O4")))
The key is the elem->fn-id function, which turns a string into a function identifier. It uses datum->syntax with stx as the context, meaning the defined function will be available in the context where the macro is invoked.
Related
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).
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)))))
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 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)))))
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))