Path: ...!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
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=
Bytes: 2002

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)))