On Apr 11, 6:18 pm, Eduardo Cavazos <[email protected]> wrote:
> On 04/11/2010 09:25 AM, jhaase wrote:
>
>
>
> > (with-special-syntax ; unquoted vector
> > (let ((counter 345734817))
> > (lambda (stx)
> > (define (gensym)
> > (set! counter (+ counter 1))
> > (string->symbol (string-append "partial-app-gensym-"
> > (number->string counter))))
> > (define (last-pair ls)
> > (if (null? (cdr ls))
> > ls
> > (last-pair (cdr ls))))
> > (syntax-case stx ()
> > (#(f args ...)
> > (identifier? #'f)
> > (let loop ((oldargs #'(args ...))
> > (newargs '())
> > (lambdalist '()))
> > (syntax-case oldargs ()
> > ((x)
> > (let ((lambdalist (reverse lambdalist)))
> > (if (eq? (syntax->datum #'x) '_)
> > (let ((sym (gensym)))
> > (if (null? lambdalist)
> > (set! lambdalist sym)
> > (set-cdr! (last-pair lambdalist) sym))
> > #`(lambda #,lambdalist
> > (apply f #,@(reverse newargs) #,sym)))
> > #`(lambda #,lambdalist
> > (f #,@(reverse (cons #'x newargs)))))))
> > ((x y ...)
> > (if (eq? (syntax->datum #'x) '_)
> > (let ((sym (gensym)))
> > (loop #'(y ...)
> > (cons sym newargs)
> > (cons sym lambdalist)))
> > (loop #'(y ...)
> > (cons #'x newargs)
> > lambdalist)))))))))
>
> > (display (map #(+ _ 1) '(1 2 3 4)))
> > (newline)
> > (display (map #(* _ _) '(1 2 3 4) '(2 3 4 5)))
> > (newline)
> > (display (#(list _) 1 2 3 4))
> > (newline))
>
> Juergen,
>
> When I try the above example in Ikarus, it produces an error:
>
> Unhandled exception
> Condition components:
> 1. &who: walker
> 2. &message: "raw symbol encountered in output of macro"
> 3. &syntax:
> form: (walker (display (map #(+ _ 1) '(1 2 3 4))))
> subform: partial-app-gensym-345734818
> 4. &trace: #<syntax (walker (display (map #(+ _ 1) '(1 2 3 4))))>
> 5. &trace: #<syntax (with-special-syntax
>
> Any ideas?
>
> The dot and keyword examples worked fine by the way!
>
> Ed
Hi!
Here is a version that works in ikarus. I just forgot to datum->syntax
the generated symbols. Strangely this worked in plt-scheme ...
(with-special-syntax
(let ((counter 345734817))
(lambda (stx)
(define (gensym ctxt)
(set! counter (+ counter 1))
(datum->syntax ctxt
(string->symbol (string-append "partial-app-gensym-"
(number->string counter)))))
(define (last-pair ls)
(if (null? (cdr ls))
ls
(last-pair (cdr ls))))
(syntax-case stx ()
(#(f args ...)
(identifier? #'f)
(let loop ((oldargs #'(args ...))
(newargs '())
(lambdalist '()))
(syntax-case oldargs ()
((x)
(let ((lambdalist (reverse lambdalist)))
(if (eq? (syntax->datum #'x) '_)
(let ((sym (gensym #'f)))
(if (null? lambdalist)
(set! lambdalist sym)
(set-cdr! (last-pair lambdalist) sym))
#`(lambda #,lambdalist
(apply f #,@(reverse newargs) #,sym)))
#`(lambda #,lambdalist
(f #,@(reverse (cons #'x newargs)))))))
((x y ...)
(if (eq? (syntax->datum #'x) '_)
(let ((sym (gensym #'f)))
(loop #'(y ...)
(cons sym newargs)
(cons sym lambdalist)))
(loop #'(y ...)
(cons #'x newargs)
lambdalist)))))))))
(display (map #(+ _ 1) '(1 2 3 4)))
(newline)
(display (map #(* _ _) '(1 2 3 4) '(2 3 4 5)))
(newline)
(display (#(list _) 1 2 3 4))
(newline))
Have fun!
Juergen
