[Larceny-users] first steps with Larceny

[Michele Simionato]

On Mon, Apr 20, 2009 at 1:47 AM, Derick Eddington
<derick.eddington at gmail.com> wrote:
> I know of your
>  http://www.phyast.pitt.edu/~micheles/scheme/sweet-macros.zip
> but that looks older than the version you described.  Is your latest
> version online or would you email it to me?

Here is the code I am using:

$ cat helper1.larceny.sls
#!r6rs
(library (sweet-macros helper1)
(export guarded-syntax-case)
(import (rnrs))

(define-syntax guarded-syntax-case
  (let ((add-clause
         (lambda (clause acc)
           (syntax-case clause ()
             ((pattern skeleton . rest)
                (syntax-case #'rest ()
                  ((cond? else1 else2 ...)
                   (cons*
                    #'(pattern cond? skeleton)
                    #'(pattern (begin else1 else2 ...))
                    acc))
                  ((cond?)
                   (cons #'(pattern cond? skeleton) acc))
                  (()
                   (cons #'(pattern skeleton) acc))
                  ))))))
    (lambda (x)
      (syntax-case x ()
        ((guarded-syntax-case y (literal ...) clause ...)
         (with-syntax (((c ...) (fold-right add-clause '() #'(clause ...))))
           #'(syntax-case y (literal ...) c ...)))))))
)

$ cat helper2.larceny.sls
#!r6rs
(library (sweet-macros helper2)
(export syntax-match)
(import (rnrs) (for (rnrs) (meta -1))
        (for (sweet-macros helper1) expand run (meta -1)))

(define-syntax syntax-match
  (lambda (y)
    (guarded-syntax-case y (sub)

      ((self (literal ...) (sub patt skel rest ...) ...)
       #'(lambda (x) (self x (literal ...) (sub patt skel rest ...) ...)))

      ((self x (literal ...) (sub patt skel rest ...) ...)
       #'(guarded-syntax-case x (<literals> <patterns> literal ...)
           ((ctx <literals>) #''(literal ...))
           ((ctx <patterns>) #''((... (... patt)) ...))
           (patt skel rest ...)
           ...)
       (for-all identifier? #'(literal ...))
       (syntax-violation 'syntax-match "Found non identifier" #'(literal ...)
                         (remp identifier? #'(literal ...))))
      )))
)

Here is a test that breaks with the "too many ... 's" error:

$ cat test.ss
(import (rnrs) (for (sweet-macros helper2) expand))

(define-syntax m
 (syntax-match ()
    (sub (_ u ...) #'(list u ...))))

The code runs on Ikarus, Ypsilon and PLT Scheme.
This time I am not surprise, though, since porting
sweet-macros to another R6RS implementation
is *always* an odissey ...  :-/