This is part 3 in my
terse hashes in emacs lisp series
Since emacs 23.2 was released the hash creation part of my _h macro is now obsolete. (or maybe not – perhaps allowing nested braces would make usage cleaner at the cost of significant complexity)? However, I suspect that is only one part of what would make emacs lisp nested data structures pleasant to use.
The other piece of the puzzle is dereferencing.
We don’t need a macro to implement the set and get functionality that _h includes so far. It was only required to prevent the braces from being evaluated.
Previously I mentioned extending the _h macro to allow for easier, or at least terser, nested hash dereferencing. The syntax I suggested would still need a macro. And I might as well leave the braces hash creation. It is unlikely my firm will upgrade to 23.2 in the next few months.
Given this nested %hash
(defvar %hash)
(setq %hash (_h { 1 2
'h (_h { 3 4
5 6
'h2 (_h { 1 2
3 [5 6 7]
'vh (vector (_h { 1 2 })
(_h { 3 4 }))
})
})
}))
I want (_h %hash -> 'h 'h2 'vh [1] 3) to return 4.
(It might be nice to add a nested assignment such as
(_h %hash -> 'h 'h2 'vh [1] 3 := "hello")
but the dereference will do for now.)
(defsubst h/vref (num)
(cons 'vecpos num))
(defmacro _h (arg1 arg2 &rest args)
(declare (indent defun))
(cond ((eq arg1 '{) ...)
((eq arg2 '->)
(let (str new-args)
(dolist (elem args)
(setq str (prin1-to-string elem))
(if (string-match "\\[\\([0-9]+\\)\\]" str)
(let ((pair (h/vref (string-to-number
(match-string 1 str)))))
(push (cons 'quote (list pair)) new-args))
(push elem new-args)))
(setq new-args (reverse new-args))
`(h/get-value (quote, arg1) ,arg1 ,@new-args)))
((null args) ...)
(t ...)))
That might be a little over the top, but it demonstrates that the macro facility does pretty much have access to the full power of the language.
The new functionality relies on a helper function, h/get-value.
(defun h/get-value (var-name variable &rest args)
(let (retval param previous-param)
(when (<= (length args) 0)
(error "(_h %s -> ...) was not passed any arguments" var-name))
(setq retval variable)
(while args
(setq param (pop args))
(cond ((and (consp param) (eq 'vecpos (car param)))
(let ((ref (cdr param)))
(setq param (intern (concat "[" (number-to-string ref) "]")))
(if (vectorp retval)
(setq retval (aref retval ref))
(error "%s not a vector @ %s (%s)"
var-name param previous-param))))
((hash-table-p retval)
(setq retval (gethash param retval 'missing-key))
(when (eq retval 'missing-key)
(error "Can't find nested hash value %s in %s (%s)"
param var-name previous-param)))
(t (error "value %s returned for param %s is not a hash in %s"
retval previous-param var-name)))
(setq previous-param param))
retval))
(macroexpand '(_h %hash -> 'h 'h2 'vh [0]))
--> (h/get-value (quote %hash) %hash (quote h) (quote h2) (quote vh) (quote (vecpos . 0)))
The problem with extending syntax like that is what if we want to use a variable to reference the vector rather than hardcoding a value like [0]. The obvious solution doesn’t work.
(defvar test-var)
(setq test-var 1)
(defsubst vec-ref (num)
(intern (concat "[" (number-to-string num) "]")))
(_h %hash -> 'h 'h2 'vh (vec-ref test-var))
Debugger entered--Lisp error: (error "value [#<hash-table 'eql nil 1/65 0x1438680> #<hash-table 'eql nil 1/65 0x1438200>] returned for param vh is not a hash in %hash")
signal(error ("value [#<hash-table 'eql nil 1/65 0x1438680> #<hash-table 'eql nil 1/65 0x1438200>] returned for param vh is not a hash in %hash"))
(the error message indicates there is a problem with h/get-value too but no time to fix before we went to press)
It is easier to go down to the next level – the code that the macro generates. The following performs as required.
(_h %hash -> 'h 'h2 'vh (h/vref test-var) 3)
Hopefully I didn’t offend too many senses of aesthetics there.
For reference, the full _h
(defmacro _h (arg1 arg2 &rest args)
(cond ((eq arg1 '{)
;; check for empty case
(if (eq arg2 '})
(make-hash-table)
;; (_h { k1 v1 k2 v2 ... })
(let ((rest (cons arg2 args))
elem tmp)
(while (not (null rest))
(setq elem (pop rest))
(when (not (or (eq elem '}) (eq elem '=>)))
(push elem tmp)))
(setq tmp (reverse tmp))
`(literal-hash ,@tmp))))
((eq arg2 '->)
(let (str new-args)
(dolist (elem args)
(setq str (prin1-to-string elem))
(if (string-match "\\[\\([0-9]+\\)\\]" str)
(let ((pair (h/vref (string-to-number
(match-string 1 str)))))
(push (cons 'quote (list pair)) new-args))
(push elem new-args)))
(setq new-args (reverse new-args))
`(h/get-value (quote, arg1) ,arg1 ,@new-args)))
((null args)
`(gethash ,arg2 ,arg1))
(t (let ((val (car args)))
`(puthash ,arg2 ,val ,arg1)))))
Read Full Post »
