From Newsgroup: comp.lang.lisp

The ability in loop to do even complex things like:

(loop for x in '(1 2 3 4 5 6 7)
when (evenp x)
collect x into evens
else
collect x into odds
finally
(return (values evens odds)))

(2 4 6), (1 3 5 7)

Gauche Scheme:

(Do ((xs '(1 2 3 4 5 6 7))
odds evens)
((null? xs) @ (values evens odds))
(push-to-either! odds evens odd? (pop! xs)))

(2 4 6)
(1 3 5 7)

Given:

(define-syntax push-to-either!
(syntax-rules ()
[(_ a b pred x)
(let ((val x))
(if (pred val)
(set! a (cons val a))
(set! b (cons val b)))) ] ))

(define (reverse~ x) (if (pair? x) (reverse x) x))

(define-syntax Do-aux
(syntax-rules (<> @ values)
[(_ ((a b <>) d ...) (seen ...) z ...)
(Do-aux (d ...) (seen ... (a b b)) z ...) ]
[(_ ((a b c) d ...) (seen ...) z ...)
(Do-aux (d ...) (seen ... (a b c)) z ...) ]
[(_ ((a b) d ...) (seen ...) z ...)
(Do-aux (d ...) (seen ... (a b)) z ...) ]
[(_ ((a) d ...) (seen ...) z ...)
(Do-aux (d ...) (seen ... (a '())) z ...) ]
[(_ (a d ...) (seen ...) z ...)
(Do-aux (d ...) (seen ... (a '())) z ...) ]
[(_ () seen (a b ... @ (values x ...)) z ...)
(Do-aux () seen (a b ... (values (reverse~ x) ...)) z ...) ]
[(_ () seen (a b ... @ xs) z ...)
(Do-aux () seen (a b ... (reverse xs)) z ...) ]
[(_ () seen till body ...)
(do seen till body ...) ]))
(define-syntax Do
(syntax-rules ()
[(_ specs till body ...)
(Do-aux specs () till body ...) ]))
--
[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 --- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

Kent M. Pitman wrote:

(loop for x in '(1 2 3 4 5 6 7)
when (evenp x)
collect x into evens
else
collect x into odds
finally
(return (values evens odds)))

(2 4 6), (1 3 5 7)

It's much shorter if we use a Lispy language
instead of CL.

Gauche Scheme

"!" is similar to "do".

(! (x :in '(1 2 3 4 5 6 7)
evens cons x
odds cons x
:if-else (even? x))
#f @@ (values evens odds))

===>
(2 4 6)
(1 3 5 7)

Given:

(define-syntax !-aux
(syntax-rules (<> @ @@ + - : cons append :meld
cdr :in :across :along
:on :by :pop-or-nothing
:if :if-else ! :also? :also :to
:till :always
: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 ...) ]
;;
[(_ ((:pop-or-nothing x xs nil) z ...) stuff ...)
(!-aux (x (if (pair? xs)(pop! xs) nil) <> z ...) stuff ...) ]
;;
;;
[(_ (:always expr z ...) seen lets bool)
(!-aux (ok #t expr
:till (not ok)
z ...)
seen lets bool ok
) ]
[(_ (:always expr z ...) stuff ...)
(!-aux " * * * Bad usage of :always in !") ]
[(_ (:till expr z ...) seen lets #f stuff ...)
(!-aux (z ...) seen lets expr stuff ...) ]
[(_ (:till expr z ...) seen lets bool stuff ...)
(!-aux (z ...) seen lets (or expr bool) 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 ...) ]
;;
[(_ ((a b ...) :on lst :by kdr z ...) stuff ...)
(!-aux (:let xs lst
:let ys #f
exhausted (null? xs) <>
dummy (begin (set! ys xs)
(when (pair? xs) (set! xs (kdr xs)))) <>
(:pop-or-nothing a ys #f)
(:pop-or-nothing b ys #f) ...
:till exhausted
z ...) stuff ...) ]
[(_ ((a b ...) :on lst z ...) stuff ...)
(!-aux ((a b ...) :on lst :by cdr z ...) stuff ...) ]
;;
[(_ (x :in lst z ...) stuff ...)
(!-aux (:let xs lst
x (if (pair? xs)(pop! xs) !-aux) <>
:till (eq? x !-aux)
z ...) stuff ...) ]
;;
[(_ (x :across vec z ...) stuff ...)
(!-aux (:let v vec :let i 0
x (if (< i (vector-length v))
(begin0 (vector-ref v i) (inc! i))
!-aux) <>
:till (eq? x !-aux)
z ...) stuff ...) ]
[(_ (ch :along str z ...) stuff ...)
(!-aux (:let s str :let i 0
ch (and (< i (string-length s))
(begin0 (string-ref s i) (inc! i))) <>
:till (not ch)
z ...)
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 ...) stuff ...)
(!-aux (:let step inc :let high hi
n lo (+ n step)
:till (> n high)
z ...) stuff ...) ]
[(_ (n lo :to hi z ...) stuff ...)
(!-aux (n lo 1 :to hi z ...) stuff ...) ]
;;
[(_ (v init : kons u z ...) stuff ...)
(!-aux (v init (kons u v) z ...) stuff ...) ]
;;
[(_ (a cons b z ...) stuff ...)
(!-aux (a '() : cons b z ...) stuff ...) ]
[(_ (a append b z ...) stuff ...)
(!-aux (a '() : append b z ...) stuff ...) ]
[(_ (a :meld b z ...) stuff ...)
(!-aux (a '()
(if (pair? b) (append (reverse b) a)
(cons 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 ...) ]
;; Default action is print first variable.
[(_ () ((a b c) z ...) lets bool !)
(!-aux () ((a b c) z ...) lets bool ! print a) ]
;; (!-aux () ((a b c) z ...) lets bool ! begin (print a)(sys-sleep 1)) ]
[(_ () seen lets bool ! action ...)
(!-aux () seen lets bool #t (action ...)) ]
;; If result not specified, pick one.
[(_ () ((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 --- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

B. Pym wrote:

Kent M. Pitman wrote:

(loop for x in '(1 2 3 4 5 6 7)
when (evenp x)
collect x into evens
else
collect x into odds
finally
(return (values evens odds)))

(2 4 6), (1 3 5 7)

It's much shorter if we use a Lispy language
instead of CL.

Gauche Scheme

"!" is similar to "do".

(! (x :in '(1 2 3 4 5 6 7)
evens cons x
odds cons x
:if-else (even? x))
#f @@ (values evens odds))

===>
(2 4 6)
(1 3 5 7)

(loop for x in '(a b (c d) e f)
when (atom x)
collect x
else
append x)

(A B C D E F)

It's much shorter if we use a Lispy language instead
of CL.

Gauche Scheme

"!" is similar to "do".

(! (r :meld x
x :in '(a b (c d) e f))
@)

===>
(a b c d e 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 --- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

(loop for item in list
maximize (f item))

It's shorter in Gauche Scheme.

(use srfi-42) ;; max-ec

(max-ec (: x '(-8 2 0)) (abs x))
===>
8
--- Synchronet 3.21d-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

B. Pym wrote:

(loop for item in list
maximize (f item))

It's shorter in Gauche Scheme.

(use srfi-42) ;; max-ec

(max-ec (: x '(-8 2 0)) (abs x))
===>
8

(loop for x in '(1 2 3 4 5 6 7)
when (evenp x)
collect x into evens
else
collect x into odds
finally
(return (values evens odds)))

(2 4 6), (1 3 5 7)

It's shorter in Gauche Scheme.

(partition even? '(2 3 4 5 6 7))
===>
(2 4 6)
(3 5 7)

--- Synchronet 3.21d-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

B. Pym wrote:

B. Pym wrote:

(loop for item in list
maximize (f item))

It's shorter in Gauche Scheme.

(use srfi-42) ;; max-ec

(max-ec (: x '(-8 2 0)) (abs x))
===>
8

(loop for x in '(1 2 3 4 5 6 7)
when (evenp x)
collect x into evens
else
collect x into odds
finally
(return (values evens odds)))

(2 4 6), (1 3 5 7)

It's shorter in Gauche Scheme.

(partition even? '(2 3 4 5 6 7))
===>
(2 4 6)
(3 5 7)

(loop for x in '(a b (c d) e f)
when (atom x)
collect x
else
append x)

(A B C D E F)

It's shorter in Gauche Scheme.

(append-map
(lambda (x) (if (pair? x) x (list x)))
'(a b (c d) e f))
===>
(a b c d e f)
--- Synchronet 3.21d-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

M. Pitman wrote:

(loop with best-foo = nil ;untested
for foo in (list foo1 foo2)
when (or (not best-foo)
(> (weight foo) (weight best-foo)))
do (setq best-foo foo)
finally (return best-foo))

Gauche Scheme:

(use gauche.collection :only (find-max))

(find-max '((a 2) (b 8) (c 5)) :key last)

(b 8)
--- Synchronet 3.21d-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

B. Pym wrote:

B. Pym wrote:

B. Pym wrote:

(loop for item in list
maximize (f item))

It's shorter in Gauche Scheme.

(use srfi-42) ;; max-ec

(max-ec (: x '(-8 2 0)) (abs x))
===>
8

(loop for x in '(1 2 3 4 5 6 7)
when (evenp x)
collect x into evens
else
collect x into odds
finally
(return (values evens odds)))

(2 4 6), (1 3 5 7)

It's shorter in Gauche Scheme.

(partition even? '(2 3 4 5 6 7))
===>
(2 4 6)
(3 5 7)

Using collectors.

(let ((odds (mlistbag)) (evens (mlistbag)))
(dolist (x '(1 2 3 4 5 6 7))
(if (odd? x) (odds x) (evens x)))
(values (evens) (odds)))

===>
(2 4 6)
(1 3 5 7)


Given:

(define (mbag init func :optional (pass-through #f))
(let ((val init) (func func) (pass-through pass-through))
(lambda args
(if (null? args)
val
(begin
(set! val
;; A "kons" may have been supplied.
((if (null? (cdr args)) func (cadr args))
(car args) val))
(if pass-through
(car args)
val))))))
(define (mlistbag :optional (pass-through #t))
(let ((bag (mbag '() cons pass-through)))
(lambda args
(if (null? args)
(reverse (bag))
(apply bag args)))))
--- Synchronet 3.21d-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

B. Pym wrote:

M. Pitman wrote:

(loop with best-foo = nil ;untested
for foo in (list foo1 foo2)
when (or (not best-foo)
(> (weight foo) (weight best-foo)))
do (setq best-foo foo)
finally (return best-foo))

Gauche Scheme:

(use gauche.collection :only (find-max))

(find-max '((a 2) (b 8) (c 5)) :key last)

(b 8)

(use gauche.sequence) ;; size-of

(reduce
(lambda(word best)
(if (> (size-of word) (size-of best)) word best))
#f ;; Returned if list is empty.
'("a" "jut" "by" "cling" "saw"))

===>
"cling"
--- Synchronet 3.21d-Linux NewsLink 1.2