[gambit-list] define-macro bug?

dillo gimp dillogimp at gmail.com
Fri Apr 27 05:01:33 EDT 2007


On 4/27/07, dillo gimp <dillogimp at gmail.com> wrote:
> Ok, this is going to be a bit long:
> (The same code works for petite and mzscheme.)
> (The same code cause error in gsi and gsc compiled code.)
>
> # cat top.sc
> (define (top)
>     ( (lambda (input)
>               (cond ((equal? input ''done) (display 'Goodbye) (newline))
>                     (else (display (eval input))(newline) (top) ))
>       ) (read) ))
> (display "Welcome to toy scheme")(newline)
> (top)
>
> # compile top.sc -> ./top
>
> cat bug.sc | ./top
> ....
> *** ERROR IN solve-confs-248 -- (Argument 2) REAL expected
> (> #!unbound 1)
>
> cat bug.sc | /usr/4.0b22/bin/gsi top.sc
> ....
> *** ERROR IN solve-confs-248 -- (Argument 2) REAL expected
> (> #!unbound 1)
>
> cat bug.sc
> ;; --------------------------------------------------------------
> ;; http://www.ccs.neu.edu/home/dorai/t-y-scheme/t-y-scheme-Z-H-1.html
> ;;
> (define amb-fail '*)
> (define initialize-amb-fail
>   (lambda ()
>     (set! amb-fail
>       (lambda ()
>         (error "amb tree exhausted")))))
> (define-macro amb
>   (lambda alts...
>     `(let ((+prev-amb-fail amb-fail))
>        (call/cc
>         (lambda (+sk)
>           ,@(map (lambda (alt)
>                    `(call/cc
>                      (lambda (+fk)
>                        (set! amb-fail
>                          (lambda ()
>                            (set! amb-fail +prev-amb-fail)
>                            (+fk 'fail)))
>                        (+sk ,alt))))
>                  alts...)
>           (+prev-amb-fail))))))
> (define number-between
>   (lambda (lo hi)
>     (let loop ((i lo))
>       (if (> i hi) (amb)
>           (amb i (loop (+ i 1)))))))
> (define assert
>   (lambda (pred)
>     (if (not pred) (amb))))
> (define-macro bag-of
>   (lambda (e)
>     `(let ((+prev-amb-fail amb-fail)
>            (+results '()))
>        (if (call/cc
>             (lambda (+k)
>               (set! amb-fail (lambda () (+k #f)))
>               (let ((+v ,e))
>                 (set! +results (cons +v +results))
>                 (+k #t))))
>            (amb-fail))
>        (set! amb-fail +prev-amb-fail)
>        (reverse! +results))))
>
> (define (nreverse rev-it)
>   (cond ((null? rev-it) rev-it)
>         ((not (list? rev-it))
>          (error "nreverse: Not a list in arg1" rev-it))
>         (else (do ((reved '() rev-it)
>                    (rev-cdr (cdr rev-it) (cdr rev-cdr))
>                    (rev-it rev-it rev-cdr))
>                   ((begin (set-cdr! rev-it reved) (null? rev-cdr)) rev-it)))))
> (define reverse! nreverse)
>
> (define square (lambda (x) (* x x)))
> (define divides? (lambda (a b) (= (remainder b a) 0)))
> (define find-divisor (lambda (n test-divisor)
>   (cond ((> (square test-divisor) n) n)
>         ((divides? test-divisor n) test-divisor)
>         (else (find-divisor n (+ test-divisor 1))))))
> (define smallest-divisor (lambda (n) (find-divisor n 2)))  ;; excluding "1"
> (define prime? (lambda (x) (= x (smallest-divisor x))))
>
> (define gen-prime
>   (lambda (hi)
>     (let ((i (number-between 2 hi)))
>       (assert (prime? i))
>       i)))
> (bag-of (gen-prime 20))
>
> (display "===========================")(newline)
> (define (solve-partition-n n)
>     (let ((x (number-between 1 n))
>           (y (number-between 1 n))
>           (z (number-between 1 n))
>          )
>       (assert
>        (= (+ x y z) n)
>       )
>       (list x y z)
>     )
> )
> (bag-of (solve-partition-n 6))
>
> (define (solve-confs-248)
>     (let ((n (number-between 1 8))
>           (d (number-between 1 256))
>          )
>          (define m (expt (+ d 1) n))
>          (define v (if (> m n) m n))
>          (define t (+ n m v))
>          (assert (<= t 248))
>          (list n d m v t )
>     )
> )
>
> (define all-confs-248 (bag-of (solve-confs-248)))
> all-confs-248
>
> 'done
> (exit)
>

For petite and mzscheme:
cat bug.sc|mzscheme -f define-macro.ss -f top.sc
cat bug.sc|petite define-macro.sc top.sc

# cat define-macro.sc
(case-sensitive #t)
(define-syntax (define-macro stx)
  (syntax-case stx ()
   ((_ (macro . args) . body)
    (syntax (define-macro macro (lambda args . body))))
   ((_ macro transformer)
    (syntax
     (define-syntax (macro stx2)
       (let ((v (syntax-object->datum stx2)))
         (datum->syntax-object
          ; we need the *identifier* of the macro call
          ; (there is probably a smarter way of extracting that ...)
          (syntax-case stx2 () ((name . more) (syntax name)))
          (apply transformer (cdr v)))))))))

# cat define-macro.ss
(define-syntax (define-macro stx)
  (syntax-case stx ()
   ((_ (macro . args) . body)
    (syntax (define-macro macro (lambda args . body))))
   ((_ macro transformer)
    (syntax
     (define-syntax (macro stx2)
       (let ((v (syntax-object->datum stx2)))
         (datum->syntax-object
          ; we need the *identifier* of the macro call
          ; (there is probably a smarter way of extracting that ...)
          (syntax-case stx2 () ((name . more) (syntax name)))
          (apply transformer (cdr v)))))))))

They both work fine,
define-macro is the same for mzscheme and petite



More information about the Gambit-list mailing list