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.
Related
I tried to implement the cons* (https://scheme.com/tspl4/objects.html#./objects:s44).
Examples:
(cons* '()) -> ()
(cons* '(a b)) -> (a b)
(cons* 'a 'b 'c) -> (a b . c)
(cons* 'a 'b '(c d)) -> (a b c d)
this is what I did do far but I don't know how to replace the ?? to make the third example (the dot notion) work
(define cons*
(lambda x
(if
(null? x)
x
(if (list? (car (reverse x)))
(fold-right cons (car (reverse x)) (reverse (cdr (reverse x))))
???
)
)
)
)
Here's a lo-fi way using lambda -
(define cons*
(lambda l
(cond ((null? l) null)
((null? (cdr l)) (car l))
(else (cons (car l) (apply cons* (cdr l)))))))
Here's a way you can do it using match (Racket)
(define (cons* . l)
(match l
((list) null) ; empty list
((list a) a) ; singleton list
((list a b ...) (cons a (apply cons* b))))) ; two or elements
Often times patterns and order can be rearranged and still produce correct programs. It all depends on how you're thinking about the problem -
(define (cons* . l)
(match l
((list a) a) ; one element
((list a b) (cons a b)) ; two elements
((list a b ...) (cons a (apply cons* b))))) ; more
Or sugar it up with define/match -
(define/match (cons* . l)
[((list)) null]
[((list a)) a]
[((list a b ...)) (cons a (apply cons* b))])
All four variants produce the expected output -
(cons* '())
(cons* '(a b))
(cons* 'a 'b 'c)
(cons* 'a 'b '(c d))
'()
'(a b)
'(a b . c)
'(a b c d)
Personally, I'd use a macro instead of a function to transform a cons* into a series of cons calls:
(define-syntax cons*
(syntax-rules ()
((_ arg) arg)
((_ arg1 rest ...) (cons arg1 (cons* rest ...)))))
(define (writeln x)
(write x)
(newline))
(writeln (cons* '())) ;; -> '()
(writeln (cons* '(a b))) ;; -> '(a b)
(writeln (cons* 'a 'b 'c)) ;; -> (cons 'a (cons 'b 'c)) -> '(a b . c)
(writeln (cons* 'a 'b '(c d))) ;; -> (cons 'a (cons 'b '(c d))) -> '(a b c d)
A Simple Procedure
I think that you are making this more complicated than it needs to be. It seems best not to use lambda x here, since that would allow calls like (cons*) with no arguments. Instead, I would use (x . xs), and I would even just use the define syntax:
(define (cons* x . xs)
(if (null? xs)
x
(cons x (apply cons*
(car xs)
(cdr xs)))))
If there is only one argument to cons*, then xs is empty, i.e., (null? xs) is true, and that single argument x should be returned. Otherwise you should cons the first argument to the result of calling cons* again, with the first element of xs as the first argument, followed by the remaining arguments from xs. The trick here is that (cdr xs) returns a list, which will itself be put into a list thanks to the (x . xs) syntax. This is the reason for using apply, which will apply cons* to the arguments in the list.
This works for all of the test cases:
> (cons* '())
()
> (cons* '(a b))
(a b)
> (cons* 'a 'b 'c)
(a b . c)
> (cons* 'a 'b '(c d))
(a b c d)
Using Mutation
Taking a closer look at what a proper list really is suggests another approach to solving the problem. Consider a list like (a b c d). This is really a chain of cons cells that look like this:
(a . (b . (c . (d . ()))))
We would like to transform this list to an improper, or dotted, list:
(a . (b . (c . (d . ())))) --> (a . (b . (c . d)))
This transformed list is equivalent to (abc.d), which is what we would like the call to (cons* 'a 'b 'c 'd) to return.
We could mutate the proper list to an improper list by setting the cdr of the next-to-last pair to the car of the last pair; that is, by setting the cdr of (c . (d .()) to d. We can use the list-tail procedure to get at the next-to-last pair, list-ref to get at the car of the last pair, and set-cdr! to set the cdr of the next-to-last pair to the new value. After this, the list is no longer terminated by an empty list (unless the car of the final pair is itself an empty list!).
Here is a procedure proper->improper! that mutates a proper list to an improper list. Note that the input must be a proper list to avoid an error. If the input list contains only a single element, then that element is simply returned and no mutation takes place.
(define (proper->improper! xs)
(cond ((null? (cdr xs))
(car xs))
(else
(set-cdr! (list-tail xs (- (length xs) 2))
(list-ref xs (- (length xs) 1)))
xs)))
Now cons* can be defined simply in terms of proper->improper!:
(define (cons* . xs)
(proper->improper! xs))
Here, the arguments to cons* are packed up into a fresh list and passed to proper->improper! which effectively removes the terminal empty list from its input, returning a chain of pairs whose last cdr is the last argument to cons*; or if only one argument is provided, that argument is returned. This works just like the other solution:
> (cons* '())
()
> (cons* 'a)
a
> (cons* 'a 'b 'c 'd)
(a b c . d)
> (cons* 'a 'b '(c d))
(a b c d)
Real Life
In real life, at least in Chez Scheme, cons* is not implemented like any of these solutions, or even in Scheme at all. Instead Chez opted to make cons* a primitive procedure, implemented in C (I believe).
In "The Scheme Programming Language 4th Edition" section 3.3 Continuations the following example is given:
(define product
(lambda (ls)
(call/cc
(lambda (break)
(let f ([ls ls])
(cond
[(null? ls) 1]
[(= (car ls) 0) (break 0)]
[else (* (car ls) (f (cdr ls)))]))))))
I can confirm it works in chezscheme as written:
> (product '(1 2 3 4 5))
120
What is 'f' in the above let? Why is the given ls being assigned to itself? It doesn't seem to match what I understand about (let ...) as described in 4.4 local binding:
syntax: (let ((var expr) ...) body1 body2 ...)
If 'f' is being defined here I would expect it inside parenthesis/square brackets:
(let ([f some-value]) ...)
This is 'named let', and it's a syntactic convenience.
(let f ([x y] ...)
...
(f ...)
...)
is more-or-less equivalent to
(letrec ([f (λ (x ...)
...
(f ...)
...)])
(f y ...))
or, in suitable contexts, to a local define followed by a call:
(define (outer ...)
(let inner ([x y] ...)
...
(inner ...)
...))
is more-or-less equivalent to
(define (outer ...)
(define (inner x ...)
...
(inner ...)
...)
(inner y ...))
The nice thing about named let is that it puts the definition and the initial call of the local function in the same place.
Cavemen like me who use CL sometimes use macros like binding, below, to implement this (note this is not production code: all its error messages are obscure jokes):
(defmacro binding (name/bindings &body bindings/decls/forms)
;; let / named let
(typecase name/bindings
(list
`(let ,name/bindings ,#bindings/decls/forms))
(symbol
(unless (not (null bindings/decls/forms))
(error "a syntax"))
(destructuring-bind (bindings . decls/forms) bindings/decls/forms
(unless (listp bindings)
(error "another syntax"))
(unless (listp decls/forms)
(error "yet another syntax"))
(multiple-value-bind (args inits)
(loop for binding in bindings
do (unless (and (listp binding)
(= (length binding) 2)
(symbolp (first binding)))
(error "a more subtle syntax"))
collect (first binding) into args
collect (second binding) into inits
finally (return (values args inits)))
`(labels ((,name/bindings ,args
,#decls/forms))
(,name/bindings ,#inits)))))
(t
(error "yet a different syntax"))))
f is bound to a procedure that has the body of let as a body and ls as a parameter.
http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-14.html#node_sec_11.16
Think of this procedure:
(define (sum lst)
(define (helper lst acc)
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc))))
(helper lst 0))
(sum '(1 2 3)) ; ==> 6
We can use named let instead of defining a local procedure and then use it like this:
(define (sum lst-arg)
(let helper ((lst lst-arg) (acc 0))
(if (null? lst)
acc
(helper (cdr lst)
(+ (car lst) acc)))))
Those are the exact same code with the exception of some duplicate naming situations. lst-arg can have the same name lst and it is never the same as lst inside the let.
Named let is easy to grasp. call/ccusually takes some maturing. I didn't get call/cc before I started creating my own implementations.
I am trying to write by myself the cons function in scheme. I have written this code:
(define (car. z)
(z (lambda (p q) p)))
and I am trying to run :
(car. '(1 2 3))
I expect to get the number 1, but it does not work properly.
When you implement language data structures you need to supply constructors and accessors that conform to the contract:
(car (cons 1 2)) ; ==> 1
(cdr (cons 1 2)) ; ==> 2
(pair? (cons 1 2)) ; ==> 2
Here is an example:
(define (cons a d)
(vector a d))
(define (car p)
(vector-ref p 0))
(define (cdr p)
(vector-ref p 1))
Now if you make an implementation you would implement read to be conformant to this way of doing pairs so that '(1 2 3) would create the correct data structure the simple rules above is still the same.
From looking at car I imagine cons looks like this:
(define (cons a d)
(lambda (p) (p a d)))
It works with closures. Now A stack machine implementation of Scheme would analyze the code for free variables living passed their scope and thus create them as boxes. Closures containing a, and d aren't much different than vectors.
I urge you to implement a minimalistic Scheme interpreter. First in Scheme since you can use the host language, then a different than a lisp language. You can even do it in an esoteric language, but it is very time consuming.
Sylwester's answer is great. Here's another possible implementation of null, null?, cons, car, cdr -
(define null 'null)
(define (null? xs)
(eq? null xs))
(define (cons a b)
(define (dispatch message)
(match message
('car a)
('cdr b)
(_ (error 'cons "unsupported message" message))
dispatch)
(define (car xs)
(if (null? xs)
(error 'car "cannot call car on an empty pair")
(xs 'car)))
(define (cdr xs)
(if (null? xs)
(error 'cdr "cannot call cdr on an empty pair")
(xs 'cdr)))
It works like this -
(define xs (cons 'a (cons 'b (cons 'c null))))
(printf "~a -> ~a -> ~a\n"
(car xs)
(car (cdr xs))
(car (cdr (cdr xs))))
;; a -> b -> c
It raises errors in these scenarios -
(cdr null)
; car: cannot call car on an empty pair
(cdr null)
; cdr: cannot call cdr on an empty pair
((cons 'a 'b) 'foo)
;; cons: unsupported dispatch: foo
define/match adds a little sugar, if you like sweet things -
(define (cons a b)
(define/match (dispatch msg)
(('car) a)
(('cdr) b)
(('pair?) #t)
((_) (error 'cons "unsupported dispatch: ~a" msg)))
dispatch)
((cons 1 2) 'car) ;; 1
((cons 1 2) 'cdr) ;; 2
((cons 1 2) 'pair?) ;; #t
((cons 1 2) 'foo) ;; cons: unsupported dispatch: foo
I have a little noob question. I have to do a homework on genetic programming in scheme and the first step is to finish some given functions.
I got to a point where i have to execute a randomly generated function with all the possible parameters in a range (using map). The "function" is list like '(* (+ 1 x) (- x (* 2 3))).
How can i execute it with a given parameter? (for example x = 2). By the way, the generated function has a maximum of 1 parameter (it's x or none).
Thanks!
Here's my solution:
(define (execute expr)
(lambda (x)
(let recur ((expr expr))
(case expr
((x) x)
((+) +)
((-) -)
((*) *)
((/) /)
(else
(if (list? expr)
(apply (recur (car expr)) (map recur (cdr expr)))
expr))))))
Example usage:
> (define foo (execute '(* (+ 1 x) (- x (* 2 3)))))
> (foo 42)
=> 1548
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))