I'm in the process of trying to update some old guile 1.8 code to guile 3.x. I'm struggling to find a good replacement for a particular construct.
Here's an example that represents the old 1.8 code:
(define h (make-hash-table 31))
(define (def-node name-args types)
(let ((name (car name-args))
(args (cdr name-args)))
(hashq-set! h name
(list name args types))))
(define define-node
(defmacro:syntax-transformer
(lambda arg-list
(apply def-node arg-list)
#f)))
(define (make-nodes)
(let ((def define-node))
(def (a b . c) (BT . CT))
(def (d e . f) (ET . FT))))
(make-nodes)
(display (hashq-ref h 'a))
(newline)
(display (hashq-ref h 'd))
(newline)
My hope is to update define-node and/or def-node while leaving make-nodes unchanged. So far I've rewritten define-node like this:
(define-syntax define-node
(lambda (x)
(syntax-case x ()
[(_ name-args arg-types)
#'(def-node 'name-args 'arg-types)])))
This seems to be a reasonable replacement for define-node, but it doesn't work with the current make-nodes, the let in make-nodes is not valid. I have to replace make-nodes with this:
(define (make-nodes)
(define-node (a b . c) (BT . CT))
(define-node (d e . f) (ET . FT)))
Which is OK, but I wonder if it's possible to find a solution where I don't have to modify make-nodes?
You'll need to change make-nodes. If you think about an expression like
(let ((def define-node))
(def (a b . c) (BT . CT))
(def (d e . f) (ET . FT))))
Which is the same as
((λ (def)
(def (a b . c) (BT . CT))
(def (d e . f) (ET . FT)))
define-node)
Then the evaluation of (def (a b . c) (BT . CT)) involves first evaluating the arguments ... which will fail.
It's not clear to me how this ever could have worked with a sane version of let.
So you'd need to use something like let-syntax to make a local macro. I don't know if Guile has that, but if not it should.
The following will work, I think, in an R5RS Scheme, if you add make-hasheqv and hash-set! I tested this using Racket in fact, but using the R5RS module language with a suitable #%require to get the hashy bits:
(define h (make-hasheqv))
(define (def-node name-args types)
(let ((name (car name-args))
(args (cdr name-args)))
(hash-set! h name
(list name args types))))
(define (make-nodes)
(let-syntax ((def (syntax-rules ()
((_ name-args types)
(def-node 'name-args 'types)))))
(def (a b . c) (BT . CT))
(def (d e . f) (ET . FT))))
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).
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.
How can I specifically check for dotted-lists in the form (a . b) Guile? The dotted-list of srfi-1 strangely returns #t also for e.g. Numbers (since when are numbers Lists too? https://www.gnu.org/software/guile/manual/html_node/SRFI_002d1-Predicates.html)! And pair? will evaluate to #t also for normal lists. Is there a way to differentiate the (a . b) construct from other things, whereas the b part (the cdr) could itself be any object including other association lists etc.?
This is what i didn't expect and can't understand:
(dotted-list? '(c . ((d . 3)
(e . 4)))) ; ===> #f
(dotted-list? 3) ; ===> #t
Note that (atom . (x1 ... xn)) is another way of writing (atom x1 ... xn), so (c . ((d . 3) (e . 4))) is just equivalent to (c (d . 3) (e . 4)) which is nothing more than a three element list (and for this reason dotted-list? returns false in this case).
If you don't like the definition of dotted-list? given in srf-1 then define your own version:
(define (my-dotted-list? l)
(and (dotted-list? l)
(pair? l)))
If you wanted a standalone definition (one that doesn't depend on an existing definition which you don't agree with), then I think this is reasonable:
(define (dotted-list? c)
(and (cons? c)
(cond [(cons? (cdr c))
(dotted-list? (cdr c))]
[(null? (cdr c))
#f]
[else #t])))
Note that like any simple-minded definition this fails to halt on circular lists.
I have a nested list structure of arbitrary length, with a depth of three. The first level has arbitrary length, as does the second level, but the third level is guaranteed to have a uniform length across the whole thing. An example of said structure would be '(((A B) (C D)) ((E F) (G H)) ((I J))).
I'm trying to write a function that would apply another function across the different levels of the structure (sorry, I don't really know how to phrase that). An example of the function mapping across the example structure would be in this order:
f A C = AC, f B D = BD, f E G = EG, f F H = FH, f I = I, f J = J,
yielding
'((AC BD) (EG FH) (I J))
but imagining that the third level of the list contains many more elements (say, around 32,000 in the final version).
Essentially, what I'm trying to do would be expressed in Haskell as something like f . transpose. I know I need something like (map car (map flatten (car ...))) to get the first part of the first section, but after that, I'm really lost with the logic here. I'm sorry if this is a really convoluted, poorly explained question. I'm just really lost.
How would I go about applying the function across the structure in this manner?
(define l '(((A B)
(C D))
((E F)
(G H))
((I J)))
)
(define zip (lambda lists (apply map list lists)))
(define (f values) (list 'f values))
(map (lambda (v) (map (lambda values (apply f values)) (apply zip v))) l)
prints
(((f (a c)) (f (b d))) ((f (e g)) (f (f h))) ((f (i)) (f (j))))
It would be much easier to define your f as a function that takes in a list of values. If not, then the last form is easy to add apply to, but it doesn't make it better. (Using a rest argument means that the language will have to create these lists anyway.)
#lang racket
(define data '(((A B) (C D)) ((E F) (G H)) ((I J))))
(define (f xs) (string->symbol (string-append* (map symbol->string xs))))
(map (λ (pairs)
(list (f (map first pairs))
(f (map second pairs))))
data)
(map (λ (pairs) (map f (apply map list pairs)))
data)
(for/list ([pairs (in-list data)])
(for/list ([xs (in-list (apply map list pairs))])
(f xs)))
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.