1. Forum
  2. Usenet
  3. COMP.LANG.SCHEME

  • anaphoric lambda

    From Robert L.@21:1/5 to All on Sun Mar 6 09:40:16 2022
    A limited anaphoric lambda implemented with syntax-rules.

    Examples:

    (append-map (& list u u) '(a b c d))
    ===>
    (a a b b c c d d)


    ((& / v (+ u u)) 2 88)
    ===>
    22


    (map (& string-append u (symbol->string v))
    '("foo" "back")
    '(bar track))
    ===>
    ("foobar" "backtrack")


    (for-each
    (& print (string-append u "-" v "-" w))
    '("tick" "nick")
    '("tock" "knock")
    '("tack" "knack"))
    ===>
    tick-tock-tack
    nick-knock-knack


    I'm not a macro guru, so this can probably be improved.


    (define-syntax &-aux
    (syntax-rules (u v w quote)
    [(_ whole shadow (param ...) () original)
    (lambda (param ...) original)]
    [(_ (u more ...) (x y ...) () ps original)
    (&-aux (more ...) (y ...) (x) ps original)]
    [(_ (v more ...) (x y ...) (a) ps original)
    (&-aux (more ...) (y ...) (a x) ps original)]
    [(_ (w more ...) (x y ...) (a b) ps original)
    (&-aux (more ...) (y ...) (a b x) ps original)]
    [(_ ((quote ...) more ...) (y z ...) params ps original)
    (&-aux (more ...) (z ...) params ps original)]
    [(_ ('x more ...) (y z ...) params ps original)
    (&-aux (more ...) (z ...) params ps original)]
    [(_ ((s ...) more ...) (y z ...) params ps original)
    (&-aux (s ... more ...) (s ... z ...) params ps original)]
    [(_ (x more ...) (y z ...) params ps original)
    (&-aux (more ...) (z ...) params ps original)]
    [(_ () shadow params (p ps ...) original)
    (&-aux original original params (ps ...) original)]))

    ;; Lambda with anaphoric parameters u, v, and w.
    (define-syntax &
    (syntax-rules ()
    [(& x ...)
    (&-aux (x ...) (x ...) () (1 2 3) (x ...))]))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From Robert L.@21:1/5 to Robert L. on Sun Mar 13 03:38:09 2022
    On 3/6/2022, Robert L. wrote:

    A limited anaphoric lambda implemented with syntax-rules.

    Examples:

    (append-map (& list u u) '(a b c d))
    ===>
    (a a b b c c d d)


    ((& / v (+ u u)) 2 88)
    ===>
    22


    (map (& string-append u (symbol->string v))
    '("foo" "back")
    '(bar track))
    ===>
    ("foobar" "backtrack")


    (for-each
    (& print (string-append u "-" v "-" w))
    '("tick" "nick")
    '("tock" "knock")
    '("tack" "knack"))
    ===>
    tick-tock-tack
    nick-knock-knack

    Somewhat shorter and simpler:

    (define-syntax &-aux
    (syntax-rules (u v w quote)
    [(_ () shadow (param ...) original)
    (lambda (param ...) original)]
    [(_ (u more ...) (x y ...) () original)
    (&-aux original original (x) original)]
    [(_ (v more ...) (x y ...) (a) original)
    (&-aux original original (a x) original)]
    [(_ (w more ...) (x y ...) (a b) original)
    (&-aux () () (a b x) original)]
    [(_ ((quote ...) more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]
    [(_ ('x more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]
    [(_ ((s ...) more ...) (y z ...) params original)
    (&-aux (s ... more ...) (s ... z ...) params original)]
    [(_ (x more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]))

    ;; Lambda with anaphoric parameters u, v, and w.
    (define-syntax &
    (syntax-rules ()
    [(& x ...)
    (&-aux (x ...) (x ...) () (x ...))]))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)
  • From Robert L.@21:1/5 to Robert L. on Thu Mar 24 07:53:14 2022
    On 3/6/2022, Robert L. wrote:

    A limited anaphoric lambda implemented with syntax-rules.

    Examples:

    (append-map (& list u u) '(a b c d))
    ===>
    (a a b b c c d d)


    ((& / v (+ u u)) 2 88)
    ===>
    22


    (map (& string-append u (symbol->string v))
    '("foo" "back")
    '(bar track))
    ===>
    ("foobar" "backtrack")


    (for-each
    (& print (string-append u "-" v "-" w))
    '("tick" "nick")
    '("tock" "knock")
    '("tack" "knack"))
    ===>
    tick-tock-tack
    nick-knock-knack


    I'm not a macro guru, so this can probably be improved.


    (define-syntax &-aux
    (syntax-rules (u v w quote)
    [(_ whole shadow (param ...) () original)
    (lambda (param ...) original)]
    [(_ (u more ...) (x y ...) () ps original)
    (&-aux (more ...) (y ...) (x) ps original)]
    [(_ (v more ...) (x y ...) (a) ps original)
    (&-aux (more ...) (y ...) (a x) ps original)]
    [(_ (w more ...) (x y ...) (a b) ps original)
    (&-aux (more ...) (y ...) (a b x) ps original)]
    [(_ ((quote ...) more ...) (y z ...) params ps original)
    (&-aux (more ...) (z ...) params ps original)]
    [(_ ('x more ...) (y z ...) params ps original)
    (&-aux (more ...) (z ...) params ps original)]
    [(_ ((s ...) more ...) (y z ...) params ps original)
    (&-aux (s ... more ...) (s ... z ...) params ps original)]
    [(_ (x more ...) (y z ...) params ps original)
    (&-aux (more ...) (z ...) params ps original)]
    [(_ () shadow params (p ps ...) original)
    (&-aux original original params (ps ...) original)]))

    ;; Lambda with anaphoric parameters u, v, and w.
    (define-syntax &
    (syntax-rules ()
    [(& x ...)
    (&-aux (x ...) (x ...) () (1 2 3) (x ...))]))

    (define-syntax &-aux
    (syntax-rules (u v w & lambda quote)
    [(_ () shadow (param ...) original)
    (lambda (param ...) original)]
    [(_ (u more ...) (x y ...) () original)
    (&-aux original original (x) original)]
    [(_ (v more ...) (x y ...) (a) original)
    (&-aux original original (a x) original)]
    [(_ (w more ...) (x y ...) (a b) original)
    (&-aux () () (a b x) original)]
    [(_ ((lambda x ...) more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]
    [(_ ((& x ...) more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]
    [(_ ((quote x ...) more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]
    [(_ ('x more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]
    [(_ ((s ...) more ...) (y z ...) params original)
    (&-aux (s ... more ...) (s ... z ...) params original)]
    [(_ (x more ...) (y z ...) params original)
    (&-aux (more ...) (z ...) params original)]))
    ;; Lambda with anaphoric parameters u, v, and w.
    (define-syntax &
    (syntax-rules ()
    [(& x ...)
    (&-aux (x ...) (x ...) () (x ...))]))

    --- SoupGate-Win32 v1.05
    * Origin: fsxNet Usenet Gateway (21:1/5)