Re: Lisp newbie needs help

B. Pym wrote:

B. Pym wrote:
 

B. Pym wrote:
 

B. Pym wrote:
 

(defun my-test ()
   (loop for number = (1+ (random 6))
         as sum = number then (+ sum number)
         until (= number 1)
         do (format t "~&~D thrown. Sum: ~D" number sum)
         finally (format t "~&One thrown.")))

 
Gauche Scheme
 
(use srfi-1)  ;; unfold
(use srfi-27) ;; random-integer
 
(define (my-test)
  (fold
    (^(n sum) (print n " thrown.  Sum: " (inc! sum n)) sum)
    0
    (cdr (unfold zero? ($ + 1 $) (^_ (random-integer 6)) -1)))
  (print "One thrown."))
 
 
gosh> (my-test)
2 thrown.  Sum: 2
2 thrown.  Sum: 4
6 thrown.  Sum: 10
One thrown.
 
gosh> (my-test)
One thrown.
 
 
Explanation of "unfold":
 
Function: unfold end-test key gen-next-seed seed :optional tail-gen
 
(unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7)
  ===>
(807 806 805 804 803 802 801)
 
(unfold zero? (lambda(n) (+ 800 n)) (lambda(n) (- n 1)) 7
  (lambda(n) (list "The number" n "ended the unfolding.")))
  ===>
(807 806 805 804 803 802 801 "The number" 0 "ended the unfolding.")

 
Using "do" is a bit tricky, but the result is shorter.
 
(define (my-test)
  (do ((n #f (+ 1 (random-integer 6)))
       (sum 0))
    ((eqv? 1 n) (print "One thrown."))
    (if n (print n " thrown.  Sum: " (inc! sum n)))))

 
It seems to me that "do*" is more appropriate for this,
but this version is 2 characters longer!
 
(define (my-test)
  (do* ((n #f (+ 1 (random-integer 6)))
        (sum 0 (+ n sum)))
    ((eqv? 1 n) (print "One thrown."))
    (if n (print n " thrown.  Sum: " sum))))
 
I don't know why Common Lisp has "do*", but Gauche, Racket,
and Chicken Scheme don't.
 
Here's a version that I cobbled together.  (A macro guru
may give us a better one.)  "do" is to "do*" as "let" is
to "let*".
 
(define-syntax do*-aux
  (syntax-rules ()
    [(do* (inits ...) ((var update) ...) (test expr ...) stuff ...)
     (let* (inits ...)
       (if test
         (begin expr ...)
         (begin
           (begin stuff ...)
           (let loop ()
             (begin (set! var update) ...)
             (if test
               (begin expr ...)
               (begin  stuff ...
                 (loop)))))))]))
 
(define-syntax do*
  (syntax-rules (!!!)
    [(do* !!! (inits ...) (updates ...)
       ((var init update) more ...) until body ...)
     (do* !!! (inits ... (var init)) (updates ... (var update))
       (more ...) until body ...)]
    [(do* !!! (inits ...) (updates ...)
       ((var init) more ...) until body ...)
     (do* !!! (inits ... (var init)) (updates ... )
       (more ...) until body ...)]
    [(do* !!! inits updates () until body ...)
     (do*-aux inits updates until body ...)]
    [(do* inits-updates until stuff ...)
     (do* !!! () () inits-updates until stuff ...)]))
 
(do* ((x 0 (+ 1 x))
      (y 922))
  ((= 9 x) (print 'ok))
  (print x " " y))
 
0 922
1 922
2 922
3 922
4 922
5 922
6 922
7 922
8 922
ok
 

 
Another way:
 
(define (my-test)
  (let1 r (cut  + 1 (random-integer 6))
    (do* ((n (r) (r))
          (sum n (+ n sum)))
      ((eqv? 1 n) (print "One thrown."))
      (print n " thrown.  Sum: " sum))))

Use ":for" when the same expression is to be assigned
to the variable every time.

(define-syntax do@-aux
  (syntax-rules ()
    [(do* (inits ...) ((var update) ...) (test expr ...) stuff ...)
     (let* (inits ...)
       (if test
         (begin expr ...)
         (begin
           (begin stuff ...)
           (let loop ()
             (begin (set! var update) ...)
             (if test
               (begin expr ...)
               (begin  stuff ...
                 (loop)))))))]))

(define-syntax do@
  (syntax-rules (:for  !!!)
    [(do@ !!! (inits ...) (updates ...)
       ((:for var expr) more ...) until body ...)
     (do@ !!! (inits ... (var expr)) (updates ... (var expr))
       (more ...) until body ...)]
    [(do@ !!! (inits ...) (updates ...)
       ((var init update) more ...) until body ...)
     (do@ !!! (inits ... (var init)) (updates ... (var update))
       (more ...) until body ...)]
    [(do@ !!! (inits ...) (updates ...)
       ((var init) more ...) until body ...)
     (do@ !!! (inits ... (var init)) (updates ... )
       (more ...) until body ...)]
    [(do@ !!! inits updates () until body ...)
     (do@-aux inits updates until body ...)]
    [(do@ inits-updates until stuff ...)
     (do@ !!! () () inits-updates until stuff ...)]))

(define (my-test)
  (do@ ((:for n (+ 1 (random-integer 6)))
        (sum n (+ n sum)))
    ((= 1 n) (print "One thrown."))
    (print n " thrown.  Sum: " sum)))