Scheme rewrite let* as nested unary lets - scheme

I have written a function match-rewriter that is essentially match-lambda except that it returns its argument if no match is found:
(define-syntax match-rewriter
(syntax-rules ()
((_ (patt body) ...)
(λ (x) (match x (patt body) ... (_ x))))))
Now I would like to use match-rewriter to take strings representing source code for let* and rewrite it as nested unary lets:
(define let*→nested-unary-lets
(match-rewriter (`(let*((,<var> ,<val>) ...) ,<expr1> ,<expr2> ...)
I am really stumped over how to pattern match this. I need to return:
`(let((,<var1> ,<val1>)) let((,<var2> ,<val2>)) let((...)) ... )...) ,<expr1> . ,#<expr2>)
But the nesting has me stumped. Any advice is appreciated.
Okay, here is my best attempt:
(define let*→nested-unary-lets
(match-rewriter
(`(let* (()) ,<expr1> ,<expr2> ...)
(`(let () ,<expr1> . ,<expr2>)))
(`(let* ((,<var1> ,<val1>) (,<var2> ,<val2>) ...) ,<expr1> ,<expr2> ...)
`(let ((,<var1> ,<val1>) (let*→nested-unary-lets
'(let* ((,<var2> ,<val2>) ...) ,<expr1> . ,<expr2>)))))
))
But this is how it behaves:
(let*→nested-unary-lets '(let* ((a 1) (b (+ a 1)) (c (+ a b))) (displayln c)))
'(let ((a 1)
(let*→nested-unary-lets
'(let* (((b c) ((+ a 1) (+ a b)))
...)
(displayln c)))))
I am confused about the order of the arguments in:
(let* (((b c) ((+ a 1) (+ a b)))
It seems to me it should be:
(let* ((b (+ a 1)) (c (+ a b)))
Also, it would be nice if the call to let*→nested-unary-lets would execute instead of just printing as text.

Yes, you can do this; it shouldn't be too difficult. Specifically, the key idea you need here is not to try to handle the whole list at once. Instead, your patterns should separate the first binding from the rest, and then wrap one let around a recursive call to let*->nested-unary-lets.
Let me know if you have trouble formulating this.

Here is a definition of let* in syntax-rules-like pseudocode that you can use to write your own version:
(let* ((a b) (c d) ...) body ...) === (let ((a b)) (let* ((c d) ...) body ...))
(let* () body ...) === body
You should be able to turn that into a function using match or a macro using syntax-rules.

Related

How to write a self currying lambda macro in scheme? [duplicate]

This question already has answers here:
Is it possible to implement auto-currying to the Lisp-family languages?
(6 answers)
Closed 2 years ago.
I would like to write functions like this:
(define foo (\ (a b c) (+ a (+ b c))))
get it automatically transformed into this:
(define foo (lambda (a) (lambda (b) (lambda (c) (+ a (+ b c))))))
and use it like this (if possible):
(map (foo 1 2) (interval 1 10))
as if I was writing this:
(map ((foo 1) 2) (interval 1 10))
I don't know how to write macros in scheme, but I'd need to write a function that transforms a quoted expression
(f arg1 arg2 argn)
like this:
(define-macro clambda ;curried lambda
(lambda xs
(if (< (length xs) 2)
(if (eq? 1 (length xs))
(lambda () xs)
(lambda (head xs) (tail xs)))
(lambda (head xs) (clambda (tail xs))))))
How can I do this?
Here is my suggestion for your macro:
(define-syntax \
(syntax-rules ()
[(_ "build" (a) body)
(lambda (a . rest)
(if (null? rest)
body
(error "Too many arguments")))]
[(_ "build" (a b ...) body)
(lambda (a . rest)
(define impl (\ "build" (b ...) body))
(if (null? rest)
impl
(apply impl rest)))]
[(_ (a b ...) body)
(\ "build" (a b ...) body)]
[(_ . rest) (error "Wong use of \\")]))
(define test (\ (a b c) (+ a b c)))
(define partial (test 4 5))
(partial 6) ; ==> 15
This does make the resulting code have more overhead since every lambda will apply the next if it gets more arguments. It also will produce an error if you pass too many arguments since you'd otherwise get the unclear "application, not a procedure"
error you may need to implement.

evaluating forms during macro expansion in Racket

This Common Lisp macro and test function
(defmacro test (body)
`(let ,(mapcar #'(lambda (s)
`(,s ,(char-code (char-downcase (char (symbol-name s) 0)))))
'(a b))
,body))
(test (+ a b))
expands into
(let ((a 97) (b 98))
(+ a b))
and gives 195 when evaluated
Trying to do that in Racket
(define-syntax (test stx)
(syntax-case stx ()
[(_ body)
#`(let #,(map (lambda (x)
(list x
(char->integer (car (string->list (symbol->string x))))))
'(a b))
body)]))
(test (+ a b))
When I run the macroexpander, the macro form expands to:
(let ((a 97) (b 98)) (+ a b))))
which is what I thought I wanted.
But it fails with:
a: unbound identifier in context..
Disabling macro hiding gives a form that ends with:
(#%app:35
call-with-values:35
(lambda:35 ()
(let-values:36 (((a:37) (quote 97)) ((b:37) (quote 98)))
(#%app:38 + (#%top . a) b)))
(print-values:35)))
I don't understand why my nice expansion (let ((a 97) (b 98)) (+ a b)) doesn't work, and I'm puzzled by (#%top .a)... I wonder if it's trying to find a function called "a"?
When I copy the expanded form into the REPL, it works...
I'm grateful for any help!
Racket has hygienic macro. Consider:
(define-syntax-rule (or a b)
(let ([a-val a])
(if a-val a-val b)))
Then:
(let ([a-val 1])
(or #f a-val))
will roughly expand to:
(let ([a-val 1])
(let ([a-val2 #f])
(if a-val2 a-val2 a-val)))
which evaluates to 1. If macro is not hygienic, then it would result in #f, which is considered incorrect.
Notice that a-val is renamed to a-val2 automatically to avoid the collision. That's what happens to your case too.
One way to fix the problem in your case is to give a correct context to the generated identifiers so that the macroexpander understands that they should refer to the same variable.
(define-syntax (test stx)
(syntax-case stx ()
[(_ body)
#`(let #,(map (lambda (x)
(list (datum->syntax stx x) ; <-- change here
(char->integer (car (string->list (symbol->string x))))))
'(a b))
body)]))
(test (+ a b))
As a counterpart Sorawee Porncharoenwase's answer (which is the right answer) I think it's worth while thinking a bit about why your test macro is problematic in CL and why macros which do similar things are outright buggy.
Given your test macro, imagine some user looking at this code:
(let ((a 1) (b 2))
(test (+ a b)))
Well, I don't know about you, but what I would expect to happen is that the a and b inside test are the a and b I've just bound. But that's not the case at all, of course.
Well, perhaps the documentation for test describes in great detail that it binds two variables, and that this is what I should expect. And, of course, there are macros which do just that, and where it's fine:
(defmacro awhen (test &body forms)
`(let ((it ,test))
(when ,it ,#forms)))
And now:
(awhen (find-exploder thing)
(explode it))
And this is all fine, because the documentation for awhen will say that it binds it to the result of the test in its body.
But now consider this or macro stolen from the other answer:
(defmacro vel (a b)
`(let ((a-val ,a))
(if a-val a-val ,b)))
This is a disaster. It 'works', except it doesn't work at all:
> (let ((a-val 3))
(vel nil a-val))
nil
Now that's not just surprising in the way your test macro is: it's wrong.
Instead, you have to write vel like this in CL:
(defmacro vel (a b)
(let ((a-val-name (make-symbol "A-VAL")))
`(let ((,a-val-name ,a))
(if ,a-val-name ,a-val-name ,b))))
(You can of course use gensym instead of make-symbol, and most people do I think.)
And now
> (let ((a-val 3))
(vel nil a-val))
3
as you would expect.
This is all because the CL macro system is unhygenic – it relies on you to ensure that things like names do not clash. In CL you have to go slightly out of your way to write macros which are correct in many cases. The Racket macro system, on the other hand, is hygenic: it will by default ensure that names (and other things) don't clash. In Racket (and Scheme) you have to go out of your way to write macros which are either incorrect or do something slightly unexpected like introducing bindings visible from code which makes use of the macros.
Note that I'm not expressing a preference for either approach to macros: I've spent most of my life writing CL, and I'm very happy with its macro system. More recently I've written more Racket and I'm happy with its macro system as well, although I find it harder to understand.
Finally here is a variant of your macro which is less surprising in use (almost all of the noise in this code is sanity checking which syntax-parse supports in the form of the two #:fail-when clauses):
(define-syntax (with-char-codes stx)
(syntax-parse stx
[(_ (v:id ...) form ...)
#:fail-when (check-duplicate-identifier (syntax->list #'(v ...)))
"duplicate name"
#:fail-when (for/or ([name (syntax->list #'(v ...))])
(and (> (string-length (symbol->string
(syntax->datum name)))
1)
name))
"name too long"
#'(let ([v (char->integer (string-ref (symbol->string 'v) 0))] ...)
form ...)]))
And now
> (with-char-codes (a b)
(+ a b))
195

scheme - quotation and auxiliary syntax

For some reason the following macro will fail to work with quotation.
(define-syntax expand
(lambda (stx)
(syntax-case stx (break)
[(_ k () (ys ...)) (begin (println (syntax->datum #'(ys ...))) #'(ys ...))]
[(_ k ((break) xs ...) (ys ...)) #'(expand k (xs ...) (ys ... (k (void))))]
[(_ k ((es ...) xs ...) (ys ...)) #'(expand k (xs ...) (ys ... (expand k (es ...) ())))]
[(_ k (a xs ...) (ys ...)) #'(expand k (xs ...) (ys ... a))])))
(define-syntax loop
(syntax-rules ()
[(_ e es ...)
(call/cc (lambda (k)
(let l ()
(expand k (begin e es ...) ())
(l))))]))
(loop (list 1 (break)))
;; => works fine
(loop (quasiquote (1 (unquote (break)))))
;; => break: unbound identifier in module in: break
I am kind of surprised to see why the second case fails.
And the following debug information is printed for both cases.
;; case 1
'(begin (expand k (list 1 (break)) ()))
'(list 1 (k (void)))
;; case 2
'(begin (expand k `(1 ,(break)) ()))
'`(expand k (1 ,(break)) ())
Please note that in the output for case 2 after the quasiquote expansion, the rest (1 ,(break)) is somehow not expanded.
Not sure why this will happen.
Thanks
The problem is that the macro expander doesn't expand macro calls that appear under a quote or quasiquote. For example:
(define-syntax-rule (pipe) "|")
> (quote (pipe))
'(pipe) ; not "|"
> (quasiquote (pipe))
'(pipe) ; not "|"
This can be solved by doing recursion on the syntax object directly at compile time, instead of doing recursion by returning a syntax object with a macro call inside of it.
In general, translate code like this:
(define-syntax expand
(lambda (stx)
(syntax-case stx literals
cases
[pattern #'(.... (expand stuff) ...)]
cases)))
Into code like this:
(begin-for-syntax
(define (expand stx)
(syntax-case stx literals
cases
[pattern #`(.... #,(expand stuff) ...)]
cases)))
In your particular case, you probably want expand to be a 3-argument function, which runs and recurs completely at compile time.
(begin-for-syntax
(define (expand k xs ys)
(with-syntax ([(ys ...) ys])
(syntax-case xs (break)
[() (begin (println (syntax->datum #'(ys ...))) #'(ys ...))]
[((break) xs ...) (expand k #'(xs ...) #'(ys ... (k (void))))]
[((es ...) xs ...) (expand k #'(xs ...) #`(ys ... #,(expand k #'(es ...) #'())))]
[(a xs ...) (expand k #'(xs ...) #'(ys ... a))]))))
Then you can call this compile-time function in the implementation of the loop macro:
(define-syntax loop
(lambda (stx)
(syntax-case stx ()
[(_ e es ...)
#`(call/cc (lambda (k)
(let l ()
#,(expand #'k #'(begin e es ...) #'())
(l))))])))
However, this isn't the best way to do a looping macro.
I'm hoping the compile-time function above helps you understand what's possible with macros. However, for the loop macro it shouldn't be needed. A syntax-parameter provides a much easier way to do this.
(define-syntax-parameter break
(lambda (stx) (raise-syntax-error #f "cannot be used outside of loop" stx)))
(define-syntax loop
(syntax-rules ()
[(_ e es ...)
(call/cc (lambda (k)
(define (break-function) (k (void)))
(syntax-parameterize ([break (make-rename-transformer #'break-function)])
(let l ()
(begin e es ...)
(l)))))]))
In fact, a loop macro like this is one of the examples used in the paper Keeping it Clean with Syntax Parameters section 4, called forever, where it calls the breaking syntax parameter abort.

Scheme letrec infinite environment

I'm currently writing metacircular evaluator in Scheme, following the SICP book's steps.
In the exercise I am asked to implement letrec, which I do in the following way:
(define (letrec->let exp)
(define (make-unassigned var)
(list var '*unassigned*))
(define (make-assign binding)
(list 'set! (letrec-binding-var binding)
(letrec-binding-val binding)))
(let ((orig-bindings (letrec-bindings exp)))
(make-let
(map make-unassigned
(map letrec-binding-var orig-bindings))
(sequence->exp
(append
(map make-assign orig-bindings)
(letrec-body exp))))))
However, when I evaluate the expression as follows, it goes into infinite loop:
(letrec
((a (lambda () 1)))
(+ 1 (a)))
Do I miss anything?
(Full Source Code at GitHub).
I checked result transformation result of (let ((x 1)) x) and got:
((lambda (x) (x)) 1)
instead of:
((lambda (x) x) 1)
obviously problem is in let body processing. If I were you, I would use utility function:
(define (implicit-begin exps)
(if (= 1 (length x))
(car x)
(cons 'begin x)))
By the way: I would say, that your letrec implementation is not very correct. Your transformation returns:
(let ((x1 *unassigned*>) ... (xn *unassigned*))
(set! x1 ...)
...
(set! xn ...)
body)
It much more resembles letrec* which evaluates expressions for variable bindings in left-ro-right order (Scheme itself doesn't specify arguments evaluation order):
syntax: letrec* bindings body
Similar to ‘letrec’, except the INIT expressions are bound to their
variables in order.
‘letrec*’ thus relaxes the letrec restriction, in that later INIT
expressions may refer to the values of previously bound variables.
The more correct code would be:
(let ((x1 *unassigned*) ... (xn *unassigned*))
(let ((t1 ...) ... (tn ...))
(set! x1 t1)
...
(set! xn tn))
body)

curry in scheme

I have this curry function:
(define curry
(lambda (f) (lambda (a) (lambda (b) (f a b)))))
I think it's like (define curry (f a b)).
my assignment is to write a function consElem2All using curry,which should work like
(((consElem2All cons) 'b) '((1) (2 3) (4)))
>((b 1) (b 2 3) (b 4))
I have wrote this function in a regular way:
(define (consElem2All0 x lst)
(map (lambda (elem) (cons x elem)) lst))
but still don't know how to transform it with curry. Can anyone help me?
thanks in advance
bearzk
You should begin by reading about currying. If you don't understand what curry is about, it may be really hard to use it... In your case, http://www.engr.uconn.edu/~jeffm/Papers/curry.html may be a good start.
One very common and interesting use of currying is with functions like reduce or map (for themselves or their arguments).
Let's define two currying operators!
(define curry2 (lambda (f) (lambda (arg1) (lambda (arg2) (f arg1 arg2)))))
(define curry3 (lambda (f) (lambda (arg1) (lambda (arg2) (lambda (arg3) (f arg1 arg2 arg3))))))
Then a few curried mathematical functions:
(define mult (curry2 *))
(define double (mult 2))
(define add (curry2 +))
(define increment (add 1))
(define decrement (add -1))
And then come the curried reduce/map:
(define creduce (curry3 reduce))
(define cmap (curry2 map))
Using them
First reduce use cases:
(define sum ((creduce +) 0))
(sum '(1 2 3 4)) ; => 10
(define product (creduce * 1))
(product '(1 2 3 4)) ; => 24
And then map use cases:
(define doubles (cmap double))
(doubles '(1 2 3 4)) ; => (2 4 6 8)
(define bump (cmap increment))
(bump '(1 2 3 4)) ; => (2 3 4 5)
I hope that helps you grasp the usefulness of currying...
So your version of curry takes a function with two args, let's say:
(define (cons a b) ...)
and turns that into something you can call like this:
(define my-cons (curry cons))
((my-cons 'a) '(b c)) ; => (cons 'a '(b c)) => '(a b c)
You actually have a function that takes three args. If you had a curry3 that managed 3-ary functions, you could do something like:
(define (consElem2All0 the-conser x lst) ...)
(like you did, but allowing cons-like functions other than cons to be used!)
and then do this:
(define consElem2All (curry3 consElem2All0))
You don't have such a curry3 at hand. So you can either build one, or work around it by "manually" currying the extra variable yourself. Working around it looks something like:
(define (consElem2All0 the-conser)
(lambda (x lst) ...something using the-conser...))
(define (consElem2All the-conser)
(curry (consElem2All0 the-conser)))
Note that there's one other possible use of curry in the map expression itself, implied by you wrapping a lambda around cons to take the element to pass to cons. How could you curry x into cons so that you get a one-argument function that can be used directly to map?...
Perhaps better use a generalized version:
(define (my-curry f)
(lambda args
(cond ((= (length args) 1)
(lambda lst (apply f (cons (car args) lst))))
((>= (length args) 2)
(apply f (cons (car args) (cdr args)))))))
(define (consElem2All0 x lst)
  (map ((curry cons) x) lst))

Resources