[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