Rocksolid Light

News from da outaworlds

mail  files  register  groups  login

Message-ID:  

BOFH excuse #75: There isn't any problem


comp / comp.lang.lisp / Re: macros vs HOFs (was: O'Caml)

SubjectAuthor
o Re: macros vs HOFs (was: O'Caml)B. Pym

1
Subject: Re: macros vs HOFs (was: O'Caml)
From: B. Pym
Newsgroups: comp.lang.lisp, comp.lang.scheme
Organization: A noiseless patient Spider
Date: Sun, 15 Sep 2024 11:52 UTC
Path: eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Nobody447095@here-nor-there.org (B. Pym)
Newsgroups: comp.lang.lisp,comp.lang.scheme
Subject: Re: macros vs HOFs (was: O'Caml)
Date: Sun, 15 Sep 2024 11:52:03 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 58
Message-ID: <vc6hp1$25976$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Sun, 15 Sep 2024 13:52:03 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="cf2f6c5e362479a949b22d2df66d5449";
logging-data="2270438"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX1/DzarfnSPY4RuEgffELVgV"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:J2y159Q9c+cFhyAHztdNWnzartQ=
View all headers

Matthew Danish wrote:

> If you want to have some fun, why not write a nice higher-order function
> to do:
>
> (defun silly-loop (string &optional (increment 1) (final-char nil))
> (loop for n from 0 by increment
> for char across string
> until (eql char final-char)
> collect char into char-bag
> sum n into sum
> finally (return (values char-bag sum n))))
>
> Try to make it half as readable. And as efficient.

Gauche Scheme

(use gauche.sequence) ;; map [generic]

(define (silly str :optional (incr 1) (ender #f))
(let@ (0 n sum)
(values
(map (^(char) (inc! sum n) (inc! n incr) char)
(if ender
(car (string-split str ender))
str))
sum n)))

(silly "catch" 37 #\h)
===>
(#\c #\a #\t #\c)
222
148

(silly "catch")
===>
(#\c #\a #\t #\c #\h)
10
5

Given:

(define-syntax let@-aux
(syntax-rules ()
[(let@-aux (0 var ...) (pairs ...) stuff)
(let@-aux () (pairs ... (var 0) ...) stuff)]
[(let@-aux ('() var ...) (pairs ...) stuff)
(let@-aux () (pairs ... (var '()) ...) stuff)]
[(let@-aux (var val more ...) (pairs ...) stuff)
(let@-aux (more ...) (pairs ... (var val)) stuff)]
[(let@-aux (var) pairs stuff)
(let@-aux (var '()) pairs stuff)]
[(let@-aux () ((var val) ...) (stuff ...))
(let* ((var val) ...) stuff ...)]))
(define-syntax let@
(syntax-rules ()
[(let@ things stuff ...)
(let@-aux things () (stuff ...))]))

1

rocksolid light 0.9.8
clearnet tor