I am currently porting Alex Shinn's canonical implementation of match for Scheme, which is used by almost all Scheme implementations, to another Lisp.
I've run into a total wall with match-letrec. In the simplified version of his implementation, it's defined as follows:
(define-syntax match-let
(syntax-rules ()
((_ ((pat expr)) . body)
(match expr (pat . body)))
((_ ((pat expr) ...) . body)
(match (list expr ...) ((pat ...) . body)))
((_ loop . rest)
(match-named-let loop () . rest))
))
(define-syntax match-letrec
(syntax-rules ()
((_ vars . body) (match-letrec-helper () vars . body))))
(define-syntax match-letrec-helper
(syntax-rules ()
((_ ((pat expr var) ...) () . body)
(letrec ((var expr) ...)
(match-let ((pat var) ...)
. body)))
((_ (v ...) ((pat expr) . rest) . body)
(match-letrec-helper (v ... (pat expr tmp)) rest . body))
))
Here's an example of how it looks when in use (Guile 1.8):
(match-letrec (((x y) (list 1 (lambda () (list a x))))
((a b) (list 2 (lambda () (list x a)))))
(append (y) (b))
=> (2 1 1 2)
I'm having great difficulty understanding how this actually works. When I expand this by hand as far as match, I get the following code (with automatic symbols indicated by #{g...}):
(letrec ((#{g1} (list 1 (lambda () (list a x))))
(#{g2} (list 2 (lambda () (list x a)))))
(match (list #{g1} #{g2}) (((x y) (a b)) (append (y) (b))))
The automatic symbols are generated by the tmp substitution in the second rule of match-letrec-helper. This expansion means that the lambda expressions are evaluated before x and a are bound, and therefore cannot capture them.
Can someone please explain how this syntax is supposed to be correctly expanded? What have I missed?
Your example
(match-letrec (((x y) (list 1 (lambda () (list a x))))
((a b) (list 2 (lambda () (list x a)))))
(append (y) (b))
=> (2 1 1 2)
is missing a close bracket.
After fixing that here's what happens:
> (match-letrec (((x y) (list 1 (lambda () (list a x))))
((a b) (list 2 (lambda () (list x a)))))
(append (y) (b)))
. match: syntax error in pattern in: ((x y) (a b))
Even match-let is not working
> (match-let (((x y) (list 1 2)))
x)
. match: syntax error in pattern in: (x y)
here's how to fix it:
(define-syntax match-let
(syntax-rules (list)
((_ ((pat expr)) . body)
(match expr (pat . body)))
((_ ((pat expr) ...) . body)
(match (list expr ...) ((pat ...) . body)))
((_ loop . rest)
(match-named-let loop () . rest))
))
now you can do this:
> (match-let (((list x y) (list 1 2)))
(list x y))
'(1 2)
letrec is still not working
> (match-letrec (((list x y) (list 1 (lambda () (list a x))))
((list a b) (list 2 (lambda () (list x a)))))
(append (y) (b)))
. match: syntax error in pattern in: ((list x y) (list a b))
but this should get you a step closer, feel free to ask a new question with working code example once you understand these changes.
I want to merge and sort two sorted association lists with Common Lisp.
I made code. But result is not same with my thought.
(defun MERGEALIST (K L)
(cond ((and (eq nil K) (eq nil L)) nil)
((eq nil K) L)
((eq nil L) K)
((<= (car (car K)) (car (car L)))
(cons K (MERGEALIST (cdr K) L)))
((> (car (car K)) (car (car L)))
(cons L (MERGEALIST K (cdr L))))))
Function's input K and L is sorted association lists.
For example,
K is ((1 . a) (3 . c) (5 . e))
L is ((2 . b) (4 . d)).
I expected that result is ((1 . a) (2 . b) (3 . c) (4 . d) (5 . e)).
But result is completely different.
Why this result is come out?
thanks.
You can simplify it a bit. The main change is like in the comment from jkiiski.
CL-USER 5 > (defun MERGEALIST (K L)
(cond ((and (null K) (null L)) nil)
((null K) L)
((null L) K)
((<= (caar K) (caar L))
(cons (car K) (MERGEALIST (cdr K) L)))
((> (caar K) (caar L))
(cons (car L) (MERGEALIST K (cdr L))))))
MERGEALIST
CL-USER 6 > (mergealist '((1 . a) (3 . c) (5 . e)) '((2 . b) (4 . d)))
((1 . A) (2 . B) (3 . C) (4 . D) (5 . E))
The built-in function merge does it:
CL-USER 9 > (merge 'list
'((1 . a) (3 . c) (5 . e))
'((2 . b) (4 . d))
#'<
:key #'car)
((1 . A) (2 . B) (3 . C) (4 . D) (5 . E))
(cons K (MERGEALIST (cdr K) L))
Here you put the complete list K in front of the "rest" of your computation. You only want the first element of it (that you just tested to "come before" the first element of L):
(cons (car K) (MERGEALIST (cdr K) L))
Though note that you could simplify that a lot:
(defun merge-alists (k l)
(cond
;; Common case first, if both alists are not empty, then select
;; the first element of that alist, whose car is less. Then, recurse.
((and (consp k) (consp l))
(if (<= (caar k) (caar l))
(cons (car k) (merge-alists (cdr k) l))
(cons (car l) (merge-alists k (cdr l)))))
;; One of the alists is empty, use either the not-empty one or ...
((consp k) k)
;; ... just the other (when k is empty or both are empty)
(t l)))
(The last two cond clauses could be simplified to (t (or k l)) ... but that could be a bit too concise to be clearly understandable.)
Or, as already pointed out, use merge.
I have macro let-- (like let* using lambdas) in guile:
(define (let-make-lambdas pairs body)
(if (null? pairs)
`((lambda () ,#body))
`((lambda (,(caar pairs))
,(let-make-lambdas (cdr pairs) body))
,(cadar pairs))))
(define-macro (let-- pairs . body)
(let-make-lambdas pairs body))
it works fine when I use an external function to do code generation, but the code below (with is just a macro) doesn't work:
(define-macro (let-- pairs . body)
(if (null? pairs)
`((lambda () ,#body))
`((lambda (,(caar pairs))
,(let-- (cdr pairs) body))
,(cadar pairs))))
why?
In the second, you don't want
,(let-- (cdr pairs) body)
but rather
(let-- ,(cdr pairs) ,#body)
That is, your direct macro implementation should be
(define-macro (let-- pairs . body)
(if (null? pairs)
`((lambda () ,#body))
`((lambda (,(caar pairs))
(let-- ,(cdr pairs) ,#body))
,(cadar pairs))))
You don't want to evaluate the inner (let-- ...) at macro expansion time; it's part of the source that should be generated. (Of course, it will be macroxpanded very shortly after.) To highlight this, consider a macro that turns
(plus a b c d)
into
(+ a (+ b (+ c d)))
It would need to expand like
(+ ,(car args) (plus ,#(cdr args)))
but not
(+ ,(car args) ,(plus (cdr args)))
because the latter will try to evaluate (plus '(b c d)), which won't work.
I think Joshua nailed the answer to you problem. I just want to point out that Scheme standard use syntax-rules and syntax-case. It could be something like like this with syntax-rules:
;; make let* with lambdas
(define-syntax let--
(syntax-rules ()
;; base case, last pair
((let-- ((key1 value1)) . body)
((lambda (key1) . body ) value1))
;; default case, several
((let-- ((key1 value1) . kv-pairs) . body)
((lambda (key1) (let-- kv-pairs . body)) value1))))
(let-- ((a 'a) (b a) (c b)) (list a b c)) ; ==> (a a a)
Here is a working Common Lisp version:
(defmacro let1-- (pairs . body)
(if (null pairs)
`((lambda () ,#body))
`((lambda (,(caar pairs))
(let-- ,(cdr pairs) . ,body))
,(cadar pairs))))
> (macroexpand '(let1-- ((a 1) (b 2)) (+ b a)))
((LAMBDA (A) (LET-- ((B 2)) (+ B A))) 1) ;
T
> (let1-- ((a 1) (b 2)) (+ b a))
3
The corresponding Scheme version is, I guess,
(define-macro (let-- pairs . body)
(if (null? pairs)
`((lambda () ,#body))
`((lambda (,(caar pairs))
(let-- ,(cdr pairs) . ,body))
,(cadar pairs))))
Trying to define resursive macro in elisp
(defmacro remacro (keys)
(if keys
`(func1 ,(car keys)
,(remacro (cdr keys)))
))
(macroexpand '(remacro '(a b c)))
But it is ended up in
Lisp nesting exceeds `max-lisp-eval-depth'
error.
Wanted to get result like
(func1 a (func1 b (func1 c nil nil) '(c)) '(b c))
from
(remacro '(a b c))
Please let me know how I can correct this definition.
One more thing could I defined `keys' as rest parameter like
(defmacro remacro (&rest keys)
(if keys
`(abc ,(car keys)
,(remacro `,#(cdr keys)))
))
tried this one but it is not working.
USE CASE:
Basically I wanted to define a function
to set a tree node that is arranged in alist way
(it is still not working, have to work on it)
(defmacro set-tree-node (tree e &rest keys)
`(setcdr
,(if keys
`(assoc (car keys)
(pushnew
(list ,(car keys))
(cdr
,(set-tree-node `(cdr ,xtree) e `,#(cdr keys)))
:key 'car))
tree)
e))
(setq egtree nil)
After running
(set-tree-node egtree new-node n b c)
should get
egtree eq
((n (b (c . new-node))))
or
(n (b (c . new-node)))
I had defined it as function
(defun set-tree-node (tree e &rest keys)
(setcdr
(reduce (lambda (xtree k)
(message "tree %s k %s" xtree k)
(assoc k (pushnew (list k) (cdr xtree) :key 'car)))
keys :initial-value (cons nil tree))
e))
But it could work only for existing list
It can successfully change (tree if full path exists)
egtree from
(setq egtree '((n (b (c . d)))))
to
egtree eq
'((n (b (c . replaced-d))))
after called like this
(set-tree-node jt 'replaced-d 'n 'b 'c)
But this function do not work with if list if complete path do not
exits
Write the macro as:
(defmacro remacro (keys)
(if keys
`(abc ,(car keys)
(remacro ,(cdr keys)))))
and call it:
(remacro (a b c))
You don't need to quote the argument because macro parameters are not evaluated.
To see the expansion, use:
(macroexpand-all '(remacro (a b c)))
(abc a (abc b (abc c nil)))
I don't see where add is supposed to come from in your example, I assume that was a typo for abc.
(defmacro tree-node (tree &rest keys)
(if keys
`(cdr
(assoc ',(car (last keys))
(pushnew
',(last keys)
(tree-node ,tree ,#(butlast keys))
:key 'car)))
tree))
(setq egtree nil)
(setf (tree-node egtree l1 l2 lx) 'value)
(push (tree-node egtree l1 l2 ly) 'element1)
(push (tree-node egtree l1 l2 ly) 'element2)
(defmacro set-tree-node (tree value &rest keys)
`(setf (tree-node ,tree ,#keys) ,value))
(set-tree-node egtree 'value l1 l2 lz)
wanted to make macro like this.
I have a list shaped like this:
'(("Alpha" . 1538)
("Beta" . 8036)
("Gamma" . 8990)
("Beta" . 10052)
("Alpha" . 12837)
("Beta" . 13634)
("Beta" . 14977)
("Beta" . 15719)
("Alpha" . 17075)
("Rho" . 18949)
("Gamma" . 21118)
("Gamma" . 26923)
("Alpha" . 31609))
How can I count the total number of occurrences of the terms in the car of each element in the list? Basically I want:
(("Alpha" . 4)
("Beta" . 5)
("Gamma" . 3)
("Rho" . 1))
No, this is not homework. I just don't have the "thinking in Lisp" thing quite yet.
In C#, I would use LINQ to do this. I can do it in lisp, too, using while loops and such but the way I am thinking of doing it seems overly complicated.
EDIT
This is what I have:
(defun count-uniq (list)
"Returns an alist, each item is a cons cell where the car is
a unique element of LIST, and the cdr is the number of occurrences of that
unique element in the list. "
(flet ((helper (list new)
(if (null list)
new
(let ((elt (assoc (car list) new)))
(helper (cdr list)
(if elt
(progn (incf (cdr elt)) new)
(cons (cons (car list) 1) new)))))))
(nreverse (helper list nil))))
(defun freqs (list &optional test key)
(let ((h (make-hash-table :test test)))
(dolist (x list)
(let ((key (if key (funcall key x) x)))
(puthash key (1+ (gethash key h 0)) h)))
(let ((r nil))
(maphash #'(lambda (k v) (push (cons k v) r)) h)
(sort r #'(lambda (x y) (< (cdr x) (cdr y)))))))
(freqs '(("Alpha" . 1538)
("Beta" . 8036)
("Gamma" . 8990)
("Beta" . 10052)
("Alpha" . 12837)
("Beta" . 13634)
("Beta" . 14977)
("Beta" . 15719)
("Alpha" . 17075)
("Rho" . 18949)
("Gamma" . 21118)
("Gamma" . 26923)
("Alpha" . 31609))
#'equal #'car)
Combining higher level Common Lisp functions:
(defun count-unique (alist)
(mapcar
(lambda (item)
(cons (car item)
(count (car item) alist :test #'equal :key #'car)))
(remove-duplicates alist :test #'equal :key #'car)))
It doesn't scale to large lists though. If you need O(n) performance use a hash table based solution instead, such as the less elegant:
(defun count-unique (alist)
(loop
with hash = (make-hash-table :test #'equal)
for (key . nil) in alist
do (incf (gethash key hash 0))
finally (return
(loop for key being each hash-key of hash
using (hash-value value)
collect (cons key value)))))
I dunno that this is the most elegant, but it seems reasonable:
(defun add-for-cheeso (data)
(let (result)
(dolist (elt data result)
(let ((sofar (assoc (car elt) result)))
(if sofar
(setcdr sofar (1+ (cdr sofar)))
(push (cons (car elt) 1) result))))))
Using Common Lisp extensions:
(require 'cl)
(loop with result = nil
for (key . dummy) in original-list
do (incf (cdr (or (assoc key result)
(first (push (cons key 0) result)))))
finally return (sort result
(lambda (a b) (string< (car a) (car b)))))
You can just say finally return result if you don't care about sorting the final result.
Every time you want to traverse a list and return some value afterwards, be it a new list or some aggregate result, you are thinking of a fold, also called "reduce" in Python and Lisps. Fold is a great abstraction, as it allows to write generic code, applicable for many use-cases just by tweaking some elements. What is similar between finding a sum of several numbers, finding a product, finding a minimum integer? They are all folds, because you run through the list and then return some result based on its content. In Emacs Lisp they would look like this:
(reduce '+ '(1 2 3 4 5)) ; 15
(reduce '* '(1 2 3 4 5)) ; 120
(reduce 'min '(1 2 3 4 5)) ; 1
But folds are even more general than this. What is similar between finding a sum, counting a number of even numbers in a list, removing every odd number, and building a list with every number increased by 5? Every such function can be implemented by taking some base value, successively transform it, until you get the result. You take this base value, metaphorical blob of clay, call it "accumulator", then take one element from a list and based on this element do something to this blob of clay, make it a draft of a magnificent sculpture. Then you take the next element from a list and do something new to your sculpture. You repeat that until the list is empty and you end up with a masterpiece. It's as if every element of a list is a single instruction in a large recipe. Just bear in mind, that you are completely free to do anything with the clay, you don't have to use the list elements in the result directly—technically, this means that the accumulator (and, thus, the result) may be of different type.
(reduce '+ '(1 2 3 4 5) :initial-value 0) ; 15
(reduce (lambda (acc x) (if (evenp x) (1+ acc) acc)) '(1 2 3 4 5) :initial-value 0) ; 2
(reduce (lambda (x acc) (if (oddp x) acc (cons x acc))) '(1 2 3 4 5) :initial-value '() :from-end t) ; (2 4)
(reduce (lambda (x acc) (cons (+ x 5) acc)) '(1 2 3 4 5) :initial-value '() :from-end t) ; (6 7 8 9 10)
Note about reducing from end: lists in Lisps are not smart arrays like in Python or Java, they are linked lists, therefore accessing or changing an element somewhere in a list is an O(n) operation, while "consing" to the beginning of a list is O(1). In other words, appending an element to the end of a list is expensive, therefore Lispers usually add elements to the beginning of a list and then finally reverse the list, which is called push/nreverse idiom. If we did the ordinary reduce in the last 2 functions, we would cons 1 to the accumulator and get (1), then cons 2 to accumulator and get (2 1), until we get the correct result but upside-down. We could use reverse function afterwards, but luckily Emacs's reduce supports :from-end keyword argument, so it conses 5, then 4, then 3, and so on.
It's clear now, that your operation is a fold, traverse the original alist and count occurrences of each key. Before writing our fold, let's talk about alists first. Alist in Lisp is a poor man's hash-table. You don't usually tinker with a programming language's hash-table implementation details, do you? You work with an API. In Python this API looks like square bracket syntax (d['a'] = 1) and dict methods (d.keys()). For alists API contains function assoc, which returns an item provided a key.
(assoc 'a '((a . 1) (b . 2))) ; (a . 1)
Why do I talk about implementation details? Because you work via assoc and you don't care how exactly this alist looks like, you abstract that away. Another piece of API is that if you want to add a new element or change an existing one, you simply cons a dotted pair to the alist. It's how you supposed to work with alists, regardless of their internal structure. Why does that work? For example, if I want to change value for key a to 10, I would simply run (cons '(a . 10) my-alist), and my-alist would end up being '((a . 10) (a . 1) (b . 2)). But it's no problem, because assoc returns only the first dotted pair and ignores the rest, so you can treat alist just like any other key-value data structure. With that in mind let's write our first serious fold.
(reduce (lambda (acc x)
(let* ((key (car x))
(pair (assoc key acc))
(count (cdr pair)))
(if pair
(cons (cons key (1+ count)) acc)
(cons (cons key 1) acc))))
my-alist
:initial-value '())
What happens here? We take your data and an empty list, which will soon become our desired result. At each step we take a pair from data and ask: does our result contain info about this pair? If not, then we add it to the result and put 1—we met this key for the first time. However, if we do find info about this pair in our result, then we must again add it to our result, but this time with a number increased by 1. Repeat that process for every item in your data, and you get:
(("Alpha" . 4) ("Gamma" . 3) ("Gamma" . 2) ("Rho" . 1) ("Alpha" . 3)
("Beta" . 5) ("Beta" . 4) ("Beta" . 3) ("Alpha" . 2) ("Beta" . 2)
("Gamma" . 1) ("Beta" . 1) ("Alpha" . 1))
Remember that assoc only cares about the first occurrence of a key? This alist would behave the same as if it was just (("Alpha" . 4) ("Gamma" . 3) ("Rho" . 1) ("Beta" . 5)), so we're good here. Still, could we change our fold as to get the latter, shorter result instead? Hold on, what's the need to over-complicate our fold, if we could just tweak the result afterwards? After all, what is computer programming, if not series of data transformations? There is no reason why you couldn't just remove all the "obsolete" pairs from your alist, just use cl-remove-duplicates with correct arguments, and you're done.
So we're proud of ourselves, we wrote a fold, a pillar of functional programming, yet careful examination exposes an inefficiency: we traverse the accumulator with assoc to find a pair and its value to increment. assoc takes O(n), reduce itself takes O(n), therefore our algorithm is O(n²) (read about order of growth, if you don't understand Big-O notation). It's clear that we should better work with a proper optimized hash-table instead, and convert it to an alist when we need. Rewrite our fold:
(reduce (lambda (acc x)
(cl-incf (gethash (car x) acc 0))
acc)
my-alist
:initial-value (make-hash-table :test 'equal))
(gethash k d 0) is equivalent to Python's d.get('k', 0), where the last argument is default. cl-incf (Common Lisp equivalent incf) is a smart macro that increments its argument in-place (read about setf to understand smart assignments). make-hash-table requires custom test function, because strings can't be compared with default eql function. To get an alist, just convert the result hash-table of our fold with ht->alist function, that we either take from Wilfred's ht.el library, or write ourselves:
(defun ht->alist (table)
(let (alist)
(maphash (lambda (k v)
(push (cons k v) alist))
table)
alist))
(require 'cl)
(defun count-uniq (list)
(let ((k 1) (list (sort (mapcar #'car list) #'string<)))
(loop for (i . j) on list
when (string= i (car j)) do (incf k)
else collect (cons i k) and do (setf k 1))))
Using high-order functions sort and reduce.
First sorting (using string<) then reducing (counting consecutive string= values in cons cells):
(reduce (lambda (r e)
(if (and r (string= (caar r) e))
(cons
(cons (caar r) (1+ (cdar r)))
(cdr r))
(cons (cons e 1) r)))
(sort (mapcar 'car alist) 'string<)
:initial-value nil)
This is pretty easy and very straightforward using the dash library:
(require 'dash)
(-frequencies (mapcar #'car my-list))
-frequencies was introduced in v2.20.0.
Here's what I think is an elegant functional solution using Emacs' alist functions, yielding a reusable frequencies function similar to Eli's answer:
(defun frequencies (vals)
(reduce
(lambda (freqs key)
(cons (cons key (+ 1 (or (cdr (assoc key freqs)) 0)))
(assq-delete-all-with-test key freqs 'equal)))
vals
:initial-value nil)))
(frequencies (mapcar 'car
'(("Alpha" . 1538)
("Beta" . 8036)
("Gamma" . 8990)
("Beta" . 10052)
("Alpha" . 12837)
("Beta" . 13634)
("Beta" . 14977)
("Beta" . 15719)
("Alpha" . 17075)
("Rho" . 18949)
("Gamma" . 21118)
("Gamma" . 26923)
("Alpha" . 31609))))
=> (("Alpha" . 4) ("Gamma" . 3) ("Rho" . 1) ("Beta" . 5))
Thanks to the support of cl-incf for alist-get:
;; (require 'cl-lib)
(defun simple-count (seq)
"Count each unique element in SEQ."
(let (counts)
(dolist (element seq)
(cl-incf (alist-get element counts 0 nil 'equal)))
counts))
Example:
(let ((data '(("Alpha" . 1538)
("Beta" . 8036)
("Gamma" . 8990)
("Beta" . 10052)
("Alpha" . 12837)
("Beta" . 13634)
("Beta" . 14977)
("Beta" . 15719)
("Alpha" . 17075)
("Rho" . 18949)
("Gamma" . 21118)
("Gamma" . 26923)
("Alpha" . 31609))))
(simple-count (mapcar 'car data)))
=> (("Rho" . 1) ("Gamma" . 3) ("Beta" . 5) ("Alpha" . 4))