Rocksolid Light

News from da outaworlds

mail  files  register  groups  login

Message-ID:  

Domestic happiness and faithful friends.


comp / comp.lang.lisp / Re: My LOOP is ugly

SubjectAuthor
o Re: My LOOP is uglyB. Pym

1
Subject: Re: My LOOP is ugly
From: B. Pym
Newsgroups: comp.lang.lisp
Organization: A noiseless patient Spider
Date: Sun, 18 Aug 2024 04:25 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
Subject: Re: My LOOP is ugly
Date: Sun, 18 Aug 2024 04:25:34 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 39
Message-ID: <v9rt3s$28v2d$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Sun, 18 Aug 2024 06:25:34 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="22a3744ada8faa388d29c0660601e227";
logging-data="2391117"; mail-complaints-to="abuse@eternal-september.org"; posting-account="U2FsdGVkX1/CMnott712eLeHOMMgK+Rf"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:Cy7dBIaIGFYeEeq3j6TizxXwW5g=
View all headers

Kenny Tilton wrote:

> (defun p2b (pairs &key ((:test test) #'eql))
> "((A 1) (A 2) (B 2) (C 2) (C 3)) ==> ((A 1 2) (B 2) (C 2 3))"
> (loop with bunch = nil
> for (one two) in pairs
> do (push two (cdr (or (assoc one bunch :test test)
> (car (push (list one) bunch)))))
> finally (return bunch)))

newLISP

;; Alter a value in or add a value to an association list.
(macro (ainc! Alist Key Value Function Deflt)
(local (E-Message Val Func Def)
(setq Func Function)
(if (true? Func)
(setq Val Value)
(begin (setq Func +) (setq Val (or Value 1))))
(setq Def Deflt)
(if (= nil Def) (setq Def 0))
(unless
(catch
(setf (assoc Key Alist)
(list ($it 0) (Func Val ($it 1))))
'E-Message)
(if (starts-with E-Message "ERR: no reference")
(setf Alist (cons (list Key (Func Val Def)) Alist))
(throw E-Message)))))

(define (p2b pairs)
(let (bunch '())
(dolist (xs pairs)
(ainc! bunch (xs 0) (xs 1) cons '()))
bunch))

(p2b '((A 1) (A 2) (B 2) (C 2) (C 3)))
===>
((C (3 2)) (B (2)) (A (2 1)))

1

rocksolid light 0.9.8
clearnet tor