[plt-scheme] Re: adventure game code ported to PLT 4 ?

On Oct 20, 2008, at 8:45 AM, Felix Klock's PLT scheme proxy wrote:

>
> On Oct 20, 2008, at 4:12 AM, Noel Welsh wrote:
>
>> On Mon, Oct 20, 2008 at 3:24 AM, Fred G. Martin <fredm at cs.uml.edu>  
>> wrote:
>>> Well, this was actually pretty easy, with one exception... the  
>>> "show" procedure.
>>>
>>> It seems to use MIT Scheme-specific features (environment->package,
>>> fluid-let, environment-bindings)... Is this portable to PLT?
>>
>> Look at namespaces and parameters for the PLT equivalent (well,  
>> nearest match).
>
> Its probably going to need more than that; it looks to me like that  
> selectors like procedure-environment are extracting the lexical  
> environment that procedure objects are closed over.  Namespaces  
> model global environments; I do not know if PLT has anything for  
> reifying the local bindings.
>
> However, it also looks to me like the show procedure may only be  
> there for, mmm, "debugging" purposes?  (Or at least for easy  
> interactive inspection of "object" structure at the REPL; the point  
> is, show is not called from game.scm or world.scm...)

I was inspired this morning to try to hack up an approximation of  
this.  After some messing around (trying to do the hard stuff myself),  
SamTH pointed me at the key.  (I asked him "how do I get the free  
variables of locally expanded code" and he said "Use free-vars from  
syntax/free-vars; look in the Help Desk.")

Fred: in particular, you may be able to adapt this to get similar  
inspection routines of the "objects" in the Adventure Game code,  
although I do not immediately see a "good" way to extract the implicit  
environment frame structure.

Enjoy!  (Sorry that the documentation is longer than the code!)

-Felix


#lang scheme

#|
    This code is a big ol' hack to emulate MIT Scheme's ability
    to inspect the lexical environment of procedure objects.

    One big distinction is that it only allows you to
    inspect the free lexical variables of procedures defined
    via the LAMBDA/INSPECTABLE form (defined below); you cannot
    use it to inspect arbitrary closures generated from other
    code.  (Felix does not think PLT offers an interface to
    get at that information, justifiably so.)

    Another big distinction between this and the environment
    objects of MIT Scheme is that this currently does not tell
    you anything about the frame structure; all of the free
    (but lexically bound) variables of a lambda/inspectable
    expression are given equal treatment, as opposed to giving
    the client the ability to observe how many frames up a
    free variable is bound.

    Also, on a related note, only referenced variables of
    a lambda/inspectable expression are captured, *not*
    all "available" variables.  E.g. x is not free in:
      (lambda () 3)
    so the implicit environment [x := 5] is not captured by
      ((lambda (x) (lambda/inspectable () 3)) 5)
    even though it is captured by
      ((lambda (x) (lambda/inspectable () x)) 5)

    Finally, this code exposes the free variables as symbols
    rather than identifier objects, with the obvious ambiguity
    problems.  Sorry; I went with "Worse is Better" here.

    Example usage:

    > (define g (lambda/inspectable (x) (lambda/inspectable (y) (+ x  
y))))
    > (define add3 (g 3))
    > (define add7 (g 7))
    > (add3 10)
    13
    > (add7 10)
    17
    > (procedure? g)
    #t
    > (procedure? add3)
    #t
    > (annotated-proc? g)
    #t
    > (annotated-proc-free-vars g)
    ()
    > (annotated-proc-free-vars add3)
    (x)
    > (annotated-proc-free-vars add7)
    (x)
    > ((annotated-proc-var-ref add3) 'x)
    3
    > ((annotated-proc-var-ref add7) 'x)
    7
|#

(require (for-syntax syntax/free-vars))

(define-struct annotated-proc (base free-vars var-ref)
   #:property prop:procedure (struct-field-index base))

(define-syntax lambda/inspectable
   (lambda (stx)
     (syntax-case stx ()
       ((_ ARGL BODY ...)
        (let* ((free-vars (lambda (stx)
                            (call-with-values
                             (lambda ()
                               (syntax-local-expand-expression stx))
                             (lambda (expanded opaque)
                              (free-vars expanded)))))
               (fv (free-vars #'(lambda ARGL BODY ...)))
               (var-symbols (map syntax->datum fv))
               (var-syntaxs fv))
          #`(let* ((clos (lambda ARGL BODY ...))
                   (names (quote #,var-symbols))
                   (entries
                    (list #,@(map (lambda (var-sym var-stx)
                                    #`(list (quote #,var-sym)
                                            (lambda () #,var-stx)))
                                  var-symbols
                                  var-syntaxs))))
              (make-annotated-proc clos
                                   names
                                   (lambda (var)
                                     ((cadr (assoc var  
entries)))))))))))