[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