[gambit-list] macro tricks

lowly coder lowlycoder at huoyanjinjing.com
Thu Aug 13 16:45:41 EDT 2009


Works perfectly. Thanks!

On Thu, Aug 13, 2009 at 5:56 AM, Marc Feeley<feeley at iro.umontreal.ca> wrote:
>
> On 13-Aug-09, at 7:22 AM, lowly coder wrote:
>
>> it looks like the stuff in lib/_eval.scm , especially with ##eval and
>> the ##*cte* stuff seems like it might work; but I can't quite get it;
>> anyone have experience?
>>
>> On Thu, Aug 13, 2009 at 4:09 AM, lowly
>> coder<lowlycoder at huoyanjinjing.com> wrote:
>>>
>>> (define-macro (foo)
>>>  (define x 20)
>>>  (define (magic-func var-name)
>>>   ...)
>>>
>>>  (pp (magic-func 'x)))
>>>
>>> (foo)
>>>
>>>
>>> Is there anyway I can define magic-func so that 20 is outputted?
>>
>
>
> With the code attached below, do:
>
> (define (magic-func var-name)
>  (env-ref (the-env) var-name))
>
> Marc
>
>
>
> (include "~~lib/_gambit#.scm")
>
> (define (the-env) ;; get the environment at the call site
>  (##continuation-capture
>   (lambda (cont)
>     (if (##interp-continuation? cont)
>         (let (($code (##interp-continuation-code cont))
>               (rte (##interp-continuation-rte cont)))
>           (cons (macro-code-cte $code) rte))
>         (error "the-env must be called from interpreted code")))))
>
> (define (env-ref env var) ;; fetch variable from an environment
>  (let loop1 ((c (car env))
>              (r (cdr env)))
>    (cond ((##cte-top? c)
>           (##global-var-ref (##make-global-var var)))
>          ((##cte-frame? c)
>           (let loop2 ((vars (##cte-frame-vars c))
>                       (i 1))
>             (if (pair? vars)
>                 (if (eq? var (##car vars))
>                     (vector-ref r i)
>                     (loop2 (cdr vars)
>                            (+ i 1)))
>                 (loop1 (##cte-parent-cte c)
>                        (macro-rte-up r)))))
>          (else
>           (loop1 (##cte-parent-cte c)
>                  r)))))
>
> (define (env-set! env var val) ;; modify variable in an environment
>  (let loop1 ((c (car env))
>              (r (cdr env)))
>    (cond ((##cte-top? c)
>           (##global-var-set! (##make-global-var var) val))
>          ((##cte-frame? c)
>           (let loop2 ((vars (##cte-frame-vars c))
>                       (i 1))
>             (if (pair? vars)
>                 (if (eq? var (##car vars))
>                     (vector-set! r i val)
>                     (loop2 (cdr vars)
>                            (+ i 1)))
>                 (loop1 (##cte-parent-cte c)
>                        (macro-rte-up r)))))
>          (else
>           (loop1 (##cte-parent-cte c)
>                  r)))))
>
> ;; test:
>
> (define (f var)
>  (let ((x 11))
>
>    (define (g y) (* y y))
>
>    (pp (env-ref (the-env) 'g))
>
>    (pp (env-ref (the-env) var))
>    (env-set! (the-env) var 22)
>    (pp (env-ref (the-env) var))
>
>    (pp (g x))))
>
> (f 'x)
>
>



More information about the Gambit-list mailing list