Path: ...!feeds.phibee-telecom.net!2.eu.feeder.erje.net!feeder.erje.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp,comp.lang.scheme
Subject: Re: Lisp newbie needs help
Date: Fri, 30 Aug 2024 05:51:09 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 174
Message-ID: <varmjt$cgmi$1@dont-email.me>
References: <vapdj5$3tkts$1@dont-email.me> <vapf1m$3tr94$1@dont-email.me> <vapmii$3uu2c$1@dont-email.me> <var6g1$6nq5$1@dont-email.me>
Injection-Date: Fri, 30 Aug 2024 07:51:10 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="abfbf0e8d1f6a5c18d0eb734601f646f";
	logging-data="410322"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX18VgzrimRR4syabTeHwMGlo"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:evtHE2+WA47yeoh5L2SLkBlH4+8=
Bytes: 6370

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)))