Implementing multi list comprehensions in Racket - macros

Im implementing a macro to do list comprehensions
(define-syntax list-comp
(syntax-rules (for in if)
[(list-comp <expr> for <var> in <list>)
(map (lambda (<var>) <expr>) <list>)]
[(list-comp <expr> for <var> in <list> if <cond>)
(map (lambda (<var>) <expr>)
(filter (lambda (<var>) <cond>) <list>))]))
I wanna modify this macro so it can accept any number of lists.
so for example
(+ l1 l2) for in List1 List2 would return the sum of adding each element in each list
and should also work with (+ l1 l2 l3...) for in list1 list2 list3 and so on...

Since map can map over several lists at once, the multi variable case is a natural extension of the one variable case.
(define-syntax list-comp
(syntax-rules (for in if)
[(list-comp <expr> for (<var> ...) in <list> ...) ;
(map (lambda (<var> ...) <expr>) <list> ...)]
[(list-comp <expr> for <var> in <list>)
(map (lambda (<var>) <expr>) <list>)]
[(list-comp <expr> for <var> in <list> if <cond>)
(map (lambda (<var>) <expr>)
(filter (lambda (<var>) <cond>) <list>))]))
(define xs '( 1 2 3))
(define ys '(10 20 30))
(list-comp (+ x y) for (x y) in xs ys)
(list-comp x for x in xs)
If you want to read more on list comprehensions, I can recommend chapter 7 of the book "The Implementation of Functional languages". You can can read the chapter online here:
http://research.microsoft.com/en-us/um/people/simonpj/papers/slpj-book-1987/PAGES/127.HTM
The syntax is different from Scheme, but the rewrite rules can be translated directly into syntax-rules macros.

Related

How to insert literal identifier from input pattern as symbol in syntax-rules macro

I have code like this:
(define-syntax macron
(syntax-rules ()
((_ name)
(lambda (x)
(eval (cons 'name x) (interaction-environment))))))
(define x (map (macron lambda)
'(((x) (display x)) ((a b) (+ a b)))))
(let ((square (car x))
(sum (cadr x)))
(display (square 10))
(newline)
(display (sum 1 2 3))
(newline))
the code is working it use macro as value by wrapping it with lambda. My question is how can I put inside syntax-rule macro literal symbol 'name instead of (cons 'lambda ...) so the output code is:
(lambda (x)
(eval (cons 'name x) (interaction-environment)))
so it work with code like this:
(define (name x)
(display x)
(newline))
(for-each (macron lambda) ;; lambda can be anything
'((1) (2) (3)))
and it print all the numbers.
I know that I can change the name in pattern into something else, but I want to know more about syntax-rules and it's edge cases. So is it possible to have name if I use it as input pattern?
I'm looking for answers with R7RS, that have more of this type of edge cases covered.
All macros happens in compile time so runtime stuff might not exist. That means that you should think of it as syntax sugar and use it as susch. eg.
(for-each (macron something) '((1) (2) (3)))
Should then have an expansion based on that. Your current expansion is that it turns into this:
(for-each (lambda (x)
(eval (cons 'someting x) (interaction-environment))
'((1) (2) (3)))
For something being a macro this will apply the macro in runtime. It is bad. It also removes the need for the macro in the first place. You could do this instead:
(define (macron-proc name)
(lambda (x)
(eval (cons name x) (interaction-environment))))
(for-each (macron-proc 'something) '((1) (2) (3)))
I made a programming language that had passable macros:
(define xor (flambda (a b) `(if ,a (not ,b) ,b)))
(define (fold comb init lst)
(if (null? lst)
init
(fold comb (comb (car lst) init) (cdr lst))))
(fold xor #f '(#t #t)) ; ==> #f
It's not a very good approach if you are targeting an efficient compiled end product. The first macros were indeed like this and they removed it in LISP 1.5 before Common Lisp. Scheme avoided macros for many years and opted for syntax-rules in R4RS as an optional feature. R6RS is the only version that has full power macros.
With a procedure instead of macros this is actually the same as the following code with the bad eval removed:
(for-each (lambda (x)
(apply something x))
'((1) (2) (3)))
Which means you can implement macron much easier:
(define-syntax macron
(syntax-rules ()
((_ name)
(lambda (x)
(apply name x)))))
But from looking at this now you don't need a macro at all. This is partial application.
(define (partial proc arg)
(lambda (lst)
(apply proc arh lst)))
(map (partial + 3) '((1 2) (3 4) (4 5)))
; ==> (6 10 12)
There is actually a SRFI-26 called cut/cute which allows us to do something similar where it wraps it in a lambda:
(map (cut apply + 3 <>) '((1 2) (3 4) (4 5)))
The syntax-rules are the macros with the least power. You cannot do anything unhygienic and you cannot make new identifiers based on other ones. Eg. it' impossible to implement a racket style struct where you can do (struct complex [real imag]) and have the macro create complex?, complex-real, and complex-imag as procedures. You need to do as SRFI-57 does and require th euser to specify all the names such that you don't need to concatenate to new identifiers.
Right now R7RS-small only has syntax-rules. I think it was a mistake not to have a more powerful macro as an alternative since now the R7RS-large cannot be implemented with R7RS-small.

Macro to record evaluation steps and intermediate values in Racket?

As an exercise in learning the Racket macro system, I've been implementing a unit testing framework, based on the C++ catch framework. One of the features of that framework is that if I write a check like this:
CHECK(x == y); // (check x y)
When the check is violated the error message will print out the values of x and y, even though the macro used is completely generic, unlike other test frameworks that require you to use macros like CHECK_EQUALS, CHECK_GREATER, etc. This is possible through some hackery involving expression templates and operator overloading.
It occurs to me that in Racket you should be able to do an even better job. In the C++ version the macro can't see inside subexpressions, so if you write something like:
CHECK(f(x, g(y)) == z); // (check (= (f x (g y)) z))
When the check is violated you only find out the values of the left and right hand side of the equal sign, and not the values of x, y, or g(y). In racket I expect it should be possible to recurse into subexpressions and print a tree showing each step of the evaluation.
Problem is I have no idea what the best way to do this is:
I've gotten fairly familiar with syntax-parse, but this seems beyond its abilities.
I read about customizing #%app which almost seems like what I want, but if for example f is a macro, I don't want to print out every evaluation of the expressions that are in the expansion, just the evaluations of the expressions that were visible when the user invoked the check macro. Also not sure if I can use it without defining a language.
I could use syntax-parameterize to hijack the meaning of the basic operators but that won't help with function calls like g(y).
I could use syntax->datum and manually walk the AST, calling eval on subexpressions myself. This seems tricky.
The trace library almost looks like what it does what I want, but you have to give it a list of functions upfront, and it doesn't appear to give you any control over where the output goes (I only want to print anything if the check fails, not if it succeeds, so I need to save the intermediate values to the side as execution proceeds).
What would be the best or at least idiomatic way to implement this?
Here is something to get you started.
#lang racket
(require (for-syntax syntax/parse racket/list))
(begin-for-syntax
(define (expression->subexpressions stx)
(define expansion (local-expand stx 'expression '()))
(syntax-parse expansion
#:datum-literals (#%app quote)
[x:id (list #'x)]
[b:boolean (list #'b)]
[n:number (list #'n)]
; insert other atoms here
[(quote literal) (list #'literal)]
[(#%app e ...)
(cons stx
(append-map expression->subexpressions (syntax->list #'(e ...))))]
; other forms in fully expanded syntax goes here
[else
(raise-syntax-error 'expression->subexpressions
"implement this construct"
stx)])))
(define-syntax (echo-and-eval stx)
(syntax-parse stx
[(_ expr)
#'(begin
(display "] ") (displayln (syntax->datum #'expr))
(displayln expr))]))
(define-syntax (echo-and-eval-subexpressions stx)
(syntax-parse stx
[(_ expr)
(define subs (expression->subexpressions #'expr))
(with-syntax ([(sub ...) subs])
#'(begin
; sub expressions
(echo-and-eval sub)
...
; original expression
(echo-and-eval expr)))]))
(echo-and-eval-subexpressions (+ 1 2 (* 4 5)))
The output:
] (+ 1 2 (* 4 5))
23
] +
#<procedure:+>
] 1
1
] 2
2
] (#%app * '4 '5)
20
] *
#<procedure:*>
] 4
4
] 5
5
] (+ 1 2 (* 4 5))
23
An alternative to printing everything is to add a marker for stuff that should be shown. Here's a rough simple sketch:
#lang racket
(require racket/stxparam)
(define-syntax-parameter ?
(λ(stx) (raise-syntax-error '? "can only be used in a `test' context")))
(define-syntax-rule (test expr)
(let ([log '()])
(define (log! stuff) (set! log (cons stuff log)))
(syntax-parameterize ([? (syntax-rules ()
[(_ E) (let ([r E]) (log! `(E => ,r)) r)])])
(unless expr
(printf "Test failure: ~s\n" 'expr)
(for ([l (in-list (reverse log))])
(for-each display
`(" " ,#(add-between (map ~s l) " ") "\n")))))))
(define x 11)
(define y 22)
(test (equal? (? (* (? x) 2)) (? y)))
(test (equal? (? (* (? x) 3)) (? y)))
which results in this output:
Test failure: (equal? (? (* (? x) 3)) (? y))
x => 11
(* (? x) 3) => 33
y => 22

Mapcar in-place: destructively modify a list of lists

I have a list of lists: (setq xs (list (list 1 2 3) (list 4 5 6) (list 7 8 9))). I want to remove a first element from each list to get ((2 3) (5 6) (8 9)). It's easy to do it non-destructively: (mapcar 'cdr xs). But I want mutate the original list. I tried:
(mapcar (lambda (x) (setf x (cdr x))) xs)
(mapcar (lambda (x) (pop x)) xs)
But it doesn't work. How to change each list of xs variable in-place, without creating any temporary lists, as efficiently as possible?
Use MAP-INTO:
CL-USER 16 > (let ((s (list (list 1 2 3)
(list 4 5 6)
(list 7 8 9))))
(map-into s #'rest s))
((2 3) (5 6) (8 9))
#Rainer Joswig's answer is correct, use map-into. The link gives example implementation using loop macro. If you want to implement map-into from scratch, or you use Emacs Lisp, you can also do it using dotimes. In Emacs Lisp dotimes is implemented in subr.el and doesn't require CL package. This is map-into with 1 sequence to map into the result sequence:
(defun map-into (r f xs)
(dotimes (i (min (length r) (length xs)) r)
(setf (elt r i)
(funcall f (elt xs i)))))
For version with variable amount of sequences we must sprinkle our code with apply and mapcar:
(defun map-into (r f &rest xss)
(dotimes (i (apply 'min (length r) (mapcar 'length xss)) r)
(setf (elt r i)
(apply f (mapcar (lambda (s) (elt s i))
xss)))))
We see, however, that elt inside dotimes makes our algorithm work in O(n2). We can optimize it to work in O(n) by using mapl (thanks #Joshua Taylor).
(defun map-into (rs f xs)
(mapl (lambda (r x) (setf (car r) (funcall f (car x)))) rs xs))
(defun map-into (rs f &rest xss)
(mapl (lambda (r xs)
(setf (car r)
(apply f (car xs))))
rs
(apply 'mapcar 'list xss))) ;; transpose a list of lists
The reason setf doesn't work inside mapcar is that setf is a complex macro that expands into expression that can manipulate the data it mutates. In a lambda scope inside mapcar it has access only to a variable, local to this lambda, not to the sequence passed to mapcar itself, so how should it know, where to put a modified value back? That's why mapcar code in the question returns modified list of lists but doesn't mutate it in-place. Just try (macroexpand '(setf (elt xs 0) (funcall 'cdr (elt xs 0)))) and see for yourself.

Stumbling over syntax-quote-unsplicing, template variables, and ellipses in syntax-case

What I want to be able to do is transform e.g.
(define count-suits (symbol-map-function hearts diamonds clubs spades))
into
(define count-suits (λ (#:hearts hearts
#:diamonds diamonds
#:clubs clubs
#:spades spades)
(make-hash (cons 'hearts hearts)
(cons 'diamonds diamonds)
(cons 'clubs clubs)
(cons 'spades spades))))
I have the body of the lambda working with
(define-syntax (generate-symbol-map stx)
(syntax-case stx ()
((gen...map enumerations ...)
#'(make-hash (cons (quote enumerations) enumerations) ...))))
but I'm having a devil of a time generating
(λ (#:hearts hearts
#:diamonds diamonds
#:clubs clubs
#:spades spades)
This is what I have so far
;; e.g. (weave '(1 3 5 7) '(2 4 6 8)) = '(1 2 3 4 5 6 7 8)
;; tested, works.
(define-for-syntax (weave list1 list2)
(cond ((empty? list1) list2)
((empty? list2) list1)
(else (list* (car list1)
(car list2)
(weave (cdr list1)
(cdr list2))))))
(define-syntax (symbol-map-function stx)
(syntax-case stx ()
((sym...ion symbols ...)
; What I'm trying to do here is splice the result of weaving the keywords,
; generated by format-id, with the symbols themselves, e.g. in the case of
; (symbol-map-function foo bar baz):
; #`(λ (#,#(weave '(#:foo #:bar #:baz) '(foo bar baz)))
; --> #`(λ (#,#'(#:foo foo #:bar bar #:baz baz))
; --> #`(λ (#:foo foo #:bar bar #:baz baz)
; I am using syntax-unquote-splicing because I am in syntax-quasiquote and the
; result of the expression is a list that I want to be spliced into the arguments.
#`(λ (#,#(weave (list (syntax-e (format-id #'symbols
"#:~a"
(syntax-e #'symbols))) ...)
(list #'(symbols ...))))
(generate-symbol-map symbols ...)))))
(list (syntax-e (format-id #'symbols "#:~a" (syntax-e #'symbols))) ...) is meant to result in
(list (syntax-e (format-id #'foo "#:~a" (syntax-e #'foo)))
(syntax-e (format-id #'bar "#:~a" (syntax-e #'bar)))
(syntax-e (format-id #'baz "#:~a" (syntax-e #'baz))))
but I'm told I'm missing ellipses after #'symbols. I've tried playing around with the code in different ways, but not with any real purpose or insight, and I haven't stumbled into anything that works.
The ... cannot appear outside of a template, which means they must appear inside the #' part that precedes symbols. You can write #'(symbols ...) but not #'symbols ....
After this, you will probably want to use syntax->list, which turns your syntax object into a list of syntax objects.
Also, you cannot use format-id to generate keywords, because format-id will enforce the result to be a symbol, and will this enclose the generated id within pipes:
> (require racket/syntax)
> (format-id #'here "#:~a" 'auie)
#<syntax |#:auie|>
So you need to use syntax->datum, symbol->string, and then string->keyword to do what you want here.
Here is a working example:
#lang racket
(require (for-syntax racket/syntax racket/list))
(define-syntax (foo stx)
(syntax-case stx ()
[(_ (sym ...) body ...)
(with-syntax ([kws (flatten
(map (λ(k)
(list
(string->keyword
(symbol->string
(syntax->datum k)))
k))
(syntax->list #'(sym ...))))]
)
#'(λ kws body ...))]))
; Test:
((foo (aa bb)
(list aa bb))
#:bb 'bbb
#:aa 'aaa)
; -> '(aaa bbb)
Here's a working implementation of symbol-map-function:
(require (for-syntax racket/list))
(define-syntax (symbol-map-function stx)
(define (id->keyword id)
(datum->syntax id (string->keyword (symbol->string (syntax-e id)))))
(syntax-case stx ()
((_ id ...)
(andmap identifier? (syntax->list #'(id ...)))
(with-syntax ((lambda-list (append-map (lambda (id)
(list (id->keyword id) id))
(syntax->list #'(id ...)))))
#'(lambda lambda-list
(make-hash `((id . ,id) ...)))))))
I wish I know a better way to assemble the lambda list than using append-map; improvements welcome. :-)

Mutable versions of cadr, caddr, etc

I'm wondering how to implement mutable versions of cadr, caddr, and the likes in Racket without defining each one separately? ie. not
(define (mcadr exp)
(mcar (mcdr exp)))
It seems that for mutable lists or pairs, Racket only supports mcar and mcdr but not the "expanded" versions. Do I need to know and be good at macros to be able to do this?
Here's a macro solution:
#lang racket/base
(require racket/mpair (for-syntax racket/base))
(define-syntax (define-combinations stx)
(syntax-case stx ()
[(_ n) (integer? (syntax-e #'n))
(let ([n (syntax-e #'n)])
(define options (list (cons "a" #'mcar) (cons "d" #'mcdr)))
(define (add-options r)
(apply append
(map (λ (opt)
(map (λ (l) (cons (string-append (car opt) (car l))
(list (cdr opt) (cdr l))))
r))
options)))
(define combinations
(cdddr
(let loop ([n n] [r '(("" . x))])
(if (zero? n) r (append r (loop (sub1 n) (add-options r)))))))
(define (make-name combo)
(let ([s (string->symbol (string-append "mc" (car combo) "r"))])
(datum->syntax stx s stx)))
(with-syntax ([(body ...) (map cdr combinations)]
[(name ...) (map make-name combinations)])
#'(begin (define (name x) body) ...)))]))
(define-combinations 4)
(mcaddr (mlist 1 2 3 4 5))
You could do:
(define mcaar (compose mcar mcar))
(define mcadr (compose mcar mcdr))
;; ...
(define mcddddr (compose mcdr mcdr mcdr mcdr))
But there is no real getting around the repetition. Even in the Racket source (look in racket/src/list.c), the repetition is there, albeit prettified a little with C macros.