[gambit-list] macro tricks
lowly coder
lowlycoder at huoyanjinjing.com
Fri Aug 14 02:01:03 EDT 2009
This doesn't seem to work with namespaces
For example:
(namespace ("foo#"))
(##include "~~lib/gambit#.scm")
(##define-macro (macro-code-cte c)
`(##vector-ref ,c 2))
(##define-macro (macro-rte-up rte)
`(##vector-ref ,rte 0))
(define (the-env)
(##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)
(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 x 20)
(pp (env-ref (the-env) 'x))
--> gives me #!unbound
yet if I uncomment the first two lines, I get 20
Thanks!
On Thu, Aug 13, 2009 at 1:45 PM, lowly
coder<lowlycoder at huoyanjinjing.com> wrote:
> 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