Groups | Search | Server Info | Login | Register

Groups > comp.lang.scheme > #6562

Re: different LOOP results

Cross-posted to 2 groups.

Show all headers | View raw

Pierre R. Mai wrote:

> Kent M. Pitman <pitman@world.std.com> writes:
> 
> > edi@agharta.de (Dr. Edmund Weitz) writes:
> >
> > > PS: For the sake of completeness, here's my take on LDIFF
> > >
> > >   (defun subdivide (list &key (incr 1))
> > >     (loop for sublist on list by #'(lambda (list)
> > >                                      (nthcdr incr list))
> > >           collect (ldiff sublist (nthcdr incr sublist))))
> > >
> > > As far as I can see this version is also in the O(2n) ballpark which I
> > > think you anticipated.
> >
> > I was thinking something more like the following.  Doing two identical
> > nthcdrs should make you suspicious...
> >
> > (defun subdivide (list &optional (increment 1))
> >   (loop with sublist = list
> >         while sublist
> >         for next = (nthcdr increment sublist)
> >         collect (ldiff sublist next)
> >         do (setq sublist next)))
> 
> Actually I think you are not allowed to do it this way:  LOOP requires
> that variable binding clauses appear before main-clauses like while.
> The MIT loop code does allow it, and deals with it correctly, and most
> independent implementations seem to also allow it, though some warn
> about this.  But sadly the standard doesn't require this (I think
> there were reservations about the exact semantics of mixing and
> matching such clauses).  I say sadly, because this forces portable
> code to sometimes be much more convoluted than would otherwise have
> been necessary.  Interleaving stepping and checking clauses is a very
> common idiom, which could have been supported by LOOP.

Gauche Scheme

"!" is similar to "do".

If the length of the list is not divisible by "stride",
there will be an error.

(define (subdivide List stride)
  (! (r cons  (take xs stride)
      xs List (drop xs stride))
    (null? xs) @))

(subdivide '(a b c d e f) 2)
  ===>
((a b) (c d) (e f))

Given:

(define-syntax !-aux
  (syntax-rules (<> @ @@  + -  cons append cdr  :in :across :along
                 :if :if-else  !  :also? :also :to
                 :let := )
    [(_ specs seen lets @)
     (!-aux specs seen lets #f @) ]
    [(_ (:let id val  z ...) seen (lets ...) stuff ...)
     (!-aux (z ...) seen (lets ... (id val)) stuff ...) ]
    [(_ (:= id val  z ...)  stuff ...)
     (!-aux (:let id #f  dummy #f (set! id val)  z ...)  stuff ...) ]
    ;;
    [(_ (:also? bool op x  z ...) (seen ... (v i update)) stuff ...)
     (!-aux (z ...)
       (seen ...  (v i (if bool (op x update) update)))
       stuff ...) ]
    [(_ (:also op x  z ...)  stuff ...)
     (!-aux (:also? #t op x  z ...)  stuff ...) ]
    ;;
    [(_ (:if bool  z ...) (seen ... (v i u)) stuff ...)
     (!-aux (z ...)
       (seen ... (v i (if bool u v))) stuff ...) ]
    ;;
    [(_ (:if-else bool  z ...) (seen ... (a b c)(d e f)) stuff ...)
     (!-aux (:let yes #f  z ...)
       (seen ... (a b (begin (set! yes bool) (if yes c a)))
                 (d e (if (not yes) f d)))  stuff ...) ]
    [(_ (x :in lst  z ...) seen lets bool stuff ...)
     (!-aux (:let xs lst  x (if (pair? xs)(pop! xs) !-aux) <>   z ...)
       seen lets (or (eq? x !-aux) bool)  stuff ...) ]
    [(_ (x :across vec  z ...) seen lets bool stuff ...)
     (!-aux (:let v vec  :let i 0
             x (if (< i (vector-length v))
                     (begin0 (vector-ref v i) (inc! i))
                     !-aux) <>
             z ...)
       seen lets (or (eq? x !-aux) bool) stuff ...) ]
    [(_ (ch :along str  z ...) seen lets bool stuff ...)
     (!-aux (:let s str  :let i 0
             ch (and (< i (string-length s))
                    (begin0 (string-ref s i) (inc! i))) <>
             z ...)
       seen lets (or (not ch) bool) stuff ...) ]
    [(_ (a b <>  z ...)  stuff ...)
     (!-aux (a b b  z ...)  stuff ...) ]
    ;;
    [(_ (a b +  z ...) stuff ...)
     (!-aux (a b (+ 1 a) z ...)  stuff ...) ]
    [(_ (a + n  z ...)  stuff ...)
     (!-aux (a 0 (+ n a) z ...)  stuff ...) ]
    [(_ (a b -  z ...)  stuff ...)
     (!-aux (a b (- a 1) z ...)  stuff ...) ]
    [(_ (n lo inc :to hi   z ...) seen lets bool stuff ...)
     (!-aux (:let i inc  :let high hi
             n lo (+ n i)
             z ...) seen lets
            (or (> n high) bool) stuff ...) ]
    [(_ (n lo :to hi   z ...) stuff ...)
     (!-aux (n lo 1 :to hi   z ...) stuff ...) ]
    ;;
    [(_ (a cons b   z ...) stuff ...)
     (!-aux (a '() (cons b a) z ...) stuff ...) ]
    [(_ (a append b   z ...) stuff ...)
     (!-aux (a '() (append b a) z ...) stuff ...) ]
    [(_ (a b cdr   z ...)  stuff ...)
     (!-aux (a b (cdr a) z ...)  stuff ...) ]
    [(_ (a b c  z ...) (seen ...) stuff ...)
     (!-aux (z ...) (seen ... (a b c)) stuff ...) ]
    [(_ (a b) (seen ...) stuff ...)
     (!-aux () (seen ... (a b)) stuff ...) ]
    [(_ (a) (seen ...) stuff ...)
     (!-aux () (seen ... (a '())) stuff ...) ]
    ;;
    [(_ () seen lets bool ! action ...)
     (!-aux () seen lets bool #t (action ...)) ]
    ;;
    [(_ () ((a b c) z ...) lets bool)
     (!-aux () ((a b c) z ...) lets bool a) ]
    [(_ () ((a b c) z ...) lets bool @)
     (!-aux () ((a b c) z ...) lets bool (reverse a)) ]
    [(_ () seen lets bool @ result stuff ...)
     (!-aux () seen lets bool (reverse result) stuff ...) ]
    ;;
    [(_ () seen lets bool @@ (what x ...) stuff ...)
     (!-aux () seen lets bool (what (reverse x) ...) stuff ...) ]
    [(_ () seen lets bool (what @ x z ...) stuff ...)
     (!-aux () seen lets bool (what (reverse x) z ...) stuff ...) ]
    [(_ () seen lets bool (what x @ y z ...) stuff ...)
     (!-aux () seen lets bool (what x (reverse y) z ...) stuff ...) ]
    ;;
    [(_ () ((a b c) z ...) lets 0 stuff ...)
     (!-aux () ((a b c) z ...) lets (= 0 a) stuff ...) ]
    [(_ () seen lets bool result stuff ...)
     (let lets (do seen (bool result) stuff ...)) ]
  ))
(define-syntax !
  (syntax-rules ()
    [(_ specs bool stuff ...)
     (!-aux specs () () bool stuff ...) ]
    [(_ specs) (! specs #f) ]
  ))

-- 
[T]he problem is that lispniks are as cultish as any other devout group and
basically fall down frothing at the mouth if they see [heterodoxy].
  --- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham

Back to comp.lang.scheme | Previous | Next | Find similar

Thread

Re: different LOOP results "B. Pym" <Nobody447095@here-nor-there.org> - 2025-08-27 02:04 +0000

csiph-web