Re: [Chicken-users] Problem accessing macro from module

[Abdulaziz Ghuloum]

On Jan 22, 2007, at 1:27 PM, John Cowan wrote:

> Abdulaziz Ghuloum scripsit:
>
> > The problem is that chicken does not have proper integration of  
> > psyntax.
> > This shows up in many places (try changing the value of memv and use
> > case when syntax-case is loaded; or try changing lambda and use let).
> > This behavior is found in not only chicken but in almost all systems
> > that use psyntax (other than Chez and Ikarus).
>
> IIRC, Chez does not use psyntax but its own implementation that is
> maintained in parallel.  So your compiler is unique.

I don't think this is true (why would Kent maintain a some 5000 line of
non-trivial code separately?)  Also, the comment at the top of  
psyntax.ss
clearly says where psyntax.ss comes from:

;;; Portable implementation of syntax-case
;;; Extracted from Chez Scheme Version 7.1 (Aug 01, 2006)
;;; Authors: R. Kent Dybvig, Oscar Waddell, Bob Hieb, Carl Bruggeman


> > For compilable macros to work, a few minor changes need to be made to
> > the psyntax implementation (egg) in chicken.  Mainly, the ctem and  
> > rtem
> > values need to be set to appropriate values when evaluating in the  
> > repl
> > and when compiling a file. (described in psyntax.ss under
> >  /Initial mode sets/.)
>
> Can you work with Felix to make this happen?  It would be very nice if
> this nuisance went away.

The change should be pretty straightforward.  Let me assume the  
following
scenario.  I assume that chicken has the following procedures:

1. (interpret-core-form core-expr) => value
2. (compile-core-form core-expr) => "some native/C code"
3. (interpret expr) == (interpret-core-form (sc-expand expr))
4. (compile expr) == (compile-core-form (sc-expand expr))

What I did was define a parameter (chicken has parameters, no?[1])  
called
expand-mode:

(define expand-mode
  (make-parameter
    'compile
    (lambda (x)
      (unless (memq x '(eval compile bootstrap))
        (error 'expand-mode "~s is not a valid mode" x))
      x)))

then changes sc-expand from:

(set! sc-expand
  (let ((ctem '(E)) (rtem '(E)))
    (lambda (x)
      (let ((env (interaction-environment)))
        (if (and (pair? x) (equal? (car x) noexpand))
            (cadr x)
            (chi-top* x null-env
              (env-wrap env)
              ctem rtem #f
              (env-top-ribcage env)))))))

to:

(set! sc-expand
  (let ()
    (define get-modes
      (lambda ()
        (case (expand-mode)
          [(eval)      (values '(E)   '(E))]
          [(compile)   (values '(L C) '(L))]
          [(bootstrap) (values '(L)   '(L))])))
    (lambda (x)
      (let ((env (interaction-environment)))
        (let-values ([(ctem rtem) (get-modes)])
          (if (and (pair? x) (equal? (car x) noexpand))
              (cadr x)
              (chi-top* x null-env
                (env-wrap env)
                ctem rtem #f
                (env-top-ribcage env))))))))

then changed the definitions of compile and interpret to be:
3. (interpret expr)
   ==  (interpret-core-form
         (parameterize ([expand-mode 'eval])
           (sc-expand expr)))
4. (compile expr)
   ==  (compile-core-form
         (parameterize ([expand-mode 'compile])
           (sc-expand expr)))

** you can also pass 'eval or 'compile as an extra (optional) argument
to sc-expand for the same effect **

I would be happy to answer any psyntax-related questions (if I know the
answer that is).

Aziz,,,


[1]: parameterize from ikarus-scheme/src/psyntax-7.1.ss:

(define-syntax parameterize
  (lambda (x)
    (syntax-case x ()
      [(_ () b b* ...) #'(let () b b* ...)]
      [(_ ([olhs* orhs*] ...) b b* ...)
       (with-syntax ([(lhs* ...) (generate-temporaries #'(olhs* ...))]
                     [(rhs* ...) (generate-temporaries #'(orhs* ...))])
        #'(let ([lhs* olhs*] ...
                [rhs* orhs*] ...)
            (let ([swap
                   (lambda ()
                     (let ([t (lhs*)])
                       (lhs* rhs*)
                       (set! rhs* t)) ...)])
              (dynamic-wind
                swap
                (lambda () b b* ...)
                swap))))])))