Home     |     .Net Programming    |     cSharp Home    |     Sql Server Home    |     Javascript / Client Side Development     |     Ajax Programming

Ruby on Rails Development     |     Perl Programming     |     C Programming Language     |     C++ Programming     |     IT Jobs

Python Programming Language     |     Laptop Suggestions?    |     TCL Scripting     |     Fortran Programming     |     Scheme Programming Language


 
 
Cervo Technologies
The Right Source to Outsource

MS Dynamics CRM 3.0

Scheme Programming Language

Disaster! macro expansion not working! Do I have to macro expand my whole problem?


Ok, macro expansion run into deep trouble combined with amb.

Here is the whole story:

(require (lib "defmacro.ss"))
(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))))

(display "---------------")(newline)
(define-macro (bag n)
  (define (iota n) (do ((n (- n 1) (- n 1)) (v '() (cons n v)))
((negative? n) v)))
   `(bag-of (list ,@(map (lambda (n)
                           '(number-between 0 1))
                         (iota n)))))
(bag 1)
(bag 2)
(bag 3)
(display "---------------")(newline)

(display "---------------")(newline)
(define-macro (make-list_ n x)
  (define (iota n) (do ((n (- n 1) (- n 1)) (v '() (cons n v)))
((negative? n) v)))
  `(list ,@(map (lambda (n) x) (iota n)))
)
(make-list_ 2 (number-between 0 1))
(amb)
(amb)
(amb)
(bag-of (make-list_ 1 (number-between 0 1)))
(bag-of (make-list_ 2 (number-between 0 1)))
(bag-of (make-list_ 3 (number-between 0 1)))
(display "---------------")(newline)

(define (solve-gen tt)
    (define hd 2)
    (let ((n (number-between 1 tt))
          (v (number-between 1 tt))
          (l (number-between 1 tt))
         )
      (assert       (= (+ n l v) tt) )
      (let ((g (number-between 1 l))
            (c (number-between 0 1))
           )
         (assert       (= (+ g c) l)  )
         (list n v l g c)
         ;; all dimensions are locked in
         (let ((glob_terms (make-list_ g (make-list_ n (number-between
0 hd))))
              )
              (list n v l g c glob_terms)
         )
      )
    )
)
(bag-of (solve-gen 3))
(bag-of (solve-gen 4))
(bag-of (solve-gen 5))

As you can see, macro expansion sorta work...
But combined with amb, it's not working.
Do I have to macro expand the whole program now?!

> > > > > > > > --------------->
> > ((0) (1))
> ((0 0) (0 1) (1 0) (1 1))
> ((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))
> --------------->
> --------------->
> > (0 0)
> (0 1)
> (1 0)
> (1 1)
> ((0) (1))
> ((0 0) (0 1) (1 0) (1 1))
> ((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))
> --------------->
> -: expects type <number> as 1st argument, given: g; other arguments were: 1

 === context ===
repl-loop

On Apr 17, 3:05 am, dillog@gmail.com wrote:

Ok, someone from haskell group helps me fix it.
I still don't know why macro did not do its job.

(define (solve-part tt)
    (define hd 1)
    (let ((n (number-between 1 tt))
          (v (number-between 1 tt))
          (l (number-between 1 tt))
         )
      (assert       (= (+ n l v) tt) )
      (let ((g (number-between 1 l))
            (c (number-between 0 1))
           )
         (assert       (= (+ g c) l)  )
         (list n v l g c)
         ;; all dimensions are locked in
         (let ((glob-terms (map (lambda (y) (map (lambda (y) (number-
between 0 hd)) (iota n)))

(iota g)
                           )
               )
              )
              (list 'n n v l 'g g c glob-terms)
              ;; more asserts later on
         )
      )
    )
)
(bag-of (solve-part 4))

((n 1 1 2 g 1 1 ((0))) (n 1 1 2 g 1 1 ((1))) (n 1 1 2 g 2 0 ((0) (0)))
(n 1 1 2 g 2 0 ((0) (1))) (n 1 1 2 g 2 0 ((1) (0))) (n 1 1 2 g 2 0
((1) (1))) (n 1 2 1 g 1 0 ((0))) (n 1 2 1 g 1 0 ((1))) (n 2 1 1 g 1 0
((0 0))) (n 2 1 1 g 1 0 ((0 1))) (n 2 1 1 g 1 0 ((1 0))) (n 2 1 1 g 1
0 ((1 1))))

Add to del.icio.us | Digg this | Stumble it | Powered by Megasolutions Inc