[gambit-list] define-macro bug?
dillo gimp
dillogimp at gmail.com
Fri Apr 27 04:48:09 EDT 2007
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)
More information about the Gambit-list
mailing list