From Newsgroup: comp.lang.scheme

B. Pym wrote:

Peter Seibel wrote:

Kenny Tilton <ktilton@nyc.rr.com> writes:

Cool. Now here is a version using loop:

(defun remove-text (text-to-remove text)
(loop with remove-length = (length text-to-remove)
for i = (search text-to-remove text)
then (search text-to-remove text :start2 i)
while i
do (setq text (concatenate 'string
(subseq text 0 i)
(subseq text (+ i remove-length))))
finally (return text)))

Just to point out a useful LOOP idiom, here's another way:

(defun remove-text (text-to-remove text)
(with-output-to-string (s)
(loop
with remove-length = (length text-to-remove)
for prev-end = 0 then (+ start remove-length)
for start = (search text-to-remove text :start2 prev-end)
do (write-string text s :start prev-end :end start)
while start)))

It can be made shorter if we use a Lispy language instead of CL.

Gauche Scheme

(use srfi-13) ;; string-contains
(use gauche.sequence) ;; size-of (instead of string-length)

(define (remove-text trash text)
(with-output-to-string (^()
(while text
(let1 found (string-contains text trash)
(display (string-copy text 0 found))
(set! text
(and found (subseq text (+ found (size-of trash))))))))))


Paul Graham:

I consider Loop one of the worst flaws in CL, and an example
to be borne in mind by both macro writers and language designers.


Jeffrey M. Jacobs:

I think CL is the WORST thing that could possibly happen to LISP.
In fact, I consider it a language different from "true" LISP.


Daniel Weinreb, 24 Feb 2003:

Having separate "value cells" and "function cells" (to use
the "street language" way of saying it) was one of the most
unfortunate issues. We did not want to break pre-existing
programs that had a global variable named "foo" and a global
function named "foo" that were distinct. We at Symbolics
were forced to insist on this, in the face of everyone's
knowing that it was not what we would have done absent
compatibility constraints. It's hard for me to remember all
the specific things like this, but if we had had fewer
compatibility issues, I think it would have come out looking
more like Scheme in general.


Paul Graham, May 2001:

A hacker's language is terse and hackable. Common Lisp is not.

The good news is, it's not Lisp that sucks, but Common Lisp.
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.scheme

B. Pym wrote:

B. Pym wrote:

Peter Seibel wrote:

Kenny Tilton <ktilton@nyc.rr.com> writes:

Cool. Now here is a version using loop:

(defun remove-text (text-to-remove text)
(loop with remove-length = (length text-to-remove)
for i = (search text-to-remove text)
then (search text-to-remove text :start2 i)
while i
do (setq text (concatenate 'string
(subseq text 0 i)
(subseq text (+ i remove-length))))
finally (return text)))

Just to point out a useful LOOP idiom, here's another way:

(defun remove-text (text-to-remove text)
(with-output-to-string (s)
(loop
with remove-length = (length text-to-remove)
for prev-end = 0 then (+ start remove-length)
for start = (search text-to-remove text :start2 prev-end)
do (write-string text s :start prev-end :end start)
while start)))

It can be made shorter if we use a Lispy language instead of CL.

Gauche Scheme

(use srfi-13) ;; string-contains
(use gauche.sequence) ;; size-of (instead of string-length)

(define (remove-text trash text)
(with-output-to-string (^()
(while text
(let1 found (string-contains text trash)
(display (string-copy text 0 found))
(set! text
(and found (subseq text (+ found (size-of trash))))))))))

Shorter yet using a slightly modified do*.

;; The "<>" means repeat the preceding expression.
(define (remove-text trash text)
(with-output-to-string (^()
(do* ((start 0 (+ found (size-of trash)))
(found (string-contains text trash start) <>))
((begin (display (string-copy text start found))
(not found)))))))

Given:

(define-syntax do*-aux
(syntax-rules ( <> )
[ (do*-aux ((var init z ...) more ...) specs (lets ...) stuff ...)
(do*-aux (more ...) specs (lets ... (var init)) stuff ...) ]
[ (do*-aux () ((var init <>) z ...) stuff ...)
(do*-aux () ((var init init) z ...) stuff ...) ]
[ (do*-aux () ((var _ update) z ...) lets (sets ...) stuff ...)
(do*-aux () (z ...) lets (sets ... (set! var update)) stuff ...) ]
[ (do*-aux () ((var init) z ...) stuff ...)
(do*-aux () (z ...) stuff ...) ]
[ (do*-aux () () (lets ...) (sets ...) (bool more ...) body ...)
(let* (lets ...)
(if bool
(begin more ...)
(begin
body ...
(let go ()
sets ...
(if bool
(begin more ...)
(begin body ... (go))))))) ] ))

(define-syntax do*
(syntax-rules ( )
[ (do* specs till body ...)
(do*-aux specs specs () () till body ...) ] ))
--- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.scheme

B. Pym wrote:

B. Pym wrote:

B. Pym wrote:

Peter Seibel wrote:

Kenny Tilton <ktilton@nyc.rr.com> writes:

Cool. Now here is a version using loop:

(defun remove-text (text-to-remove text)
(loop with remove-length = (length text-to-remove)
for i = (search text-to-remove text)
then (search text-to-remove text :start2 i)
while i
do (setq text (concatenate 'string
(subseq text 0 i)
(subseq text (+ i remove-length))))
finally (return text)))

Just to point out a useful LOOP idiom, here's another way:

(defun remove-text (text-to-remove text)
(with-output-to-string (s)
(loop
with remove-length = (length text-to-remove)
for prev-end = 0 then (+ start remove-length)
for start = (search text-to-remove text :start2 prev-end)
do (write-string text s :start prev-end :end start)
while start)))

It can be made shorter if we use a Lispy language instead of CL.

Gauche Scheme

(use srfi-13) ;; string-contains
(use gauche.sequence) ;; size-of (instead of string-length)

(define (remove-text trash text)
(with-output-to-string (^()
(while text
(let1 found (string-contains text trash)
(display (string-copy text 0 found))
(set! text
(and found (subseq text (+ found (size-of trash))))))))))

Shorter yet using a slightly modified do*.

;; The "<>" means repeat the preceding expression.
(define (remove-text trash text)
(with-output-to-string (^()
(do* ((start 0 (+ found (size-of trash)))
(found (string-contains text trash start) <>))
((begin (display (string-copy text start found))
(not found)))))))

Given:

That was a mindless implementation of do*.
This seems better.

(define-syntax do*-aux
(syntax-rules ( <> @ :in )
[ (do*-aux s lets sets (bool more ... @ r) body ...)
(do*-aux s lets sets (bool more ... (reverse r)) body ...) ]
;;
[ (do*-aux ((x :in xs) z ...) lets sets (bool r ...) stuff ...)
(do*-aux ((xlist xs (cdr xlist))
(x (and (pair? xlist) (car xlist)) <> )
z ...)
lets sets
((or (null? xlist) bool) r ...)
stuff ...) ]
;;
[ (do*-aux ((var init <>) z ...) stuff ...)
(do*-aux ((var init init) z ...) stuff ...) ]
;;
[ (do*-aux ((var init update) z ...) (lets ...) (sets ...) stuff ...)
(do*-aux (z ...) (lets ... (var init))
(sets ... (set! var update)) stuff ...) ]
[ (do*-aux ((var init) z ...) (lets ...) stuff ...)
(do*-aux (z ...) (lets ... (var init)) stuff ...) ]
;;
;;
[ (do*-aux () (lets ...) (sets ...) (bool more ...) body ...)
(let* (lets ...)
(if bool
(begin more ...)
(begin
body ...
(let go ()
sets ...
(if bool
(begin more ...)
(begin body ... (go))))))) ] ))

(define-syntax do*
(syntax-rules ( )
[ (do* specs till body ...)
(do*-aux specs () () till body ...) ] ))


Example:

(use srfi-27) ;; random-integer

(do* ((accum '() (cons (list e '-- r) accum))
(e :in '(0 2 4))
(r (random-integer 99) <> ))
(#f @ accum))

===>
((0 -- 62) (2 -- 30) (4 -- 9))
--- Synchronet 3.21a-Linux NewsLink 1.2