On 4/27/07, dillo gimp dillogimp@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