Skip to content

Instantly share code, notes, and snippets.

Created October 20, 2015 13:54
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save kosh04/b0669f75152d082d02a4 to your computer and use it in GitHub Desktop.
;;; dotassoc.lsp
;; 連想リストの Key-Value 参照をドット記法で
;;; Example:
;; (let ((student '((id 1332412)
;; (name ((first "Student")
;; (last "Example"))))))
;; (with-dotassoc
;; (upper-case
;;=> "STUDENT"
;; 読取り時に変換する (リーダマクロのようなもの)
;; (reader-event 'dotassoc-transform)
;; ~> (lookup 'first (lookup 'name student))
;; => "Student"
;; (setq json (json-parse (get-url "")))
;; json.headers.User-Agent
;;=> "newLISP v10603"
;; setf による代入も一応可能
;; (setf json.headers.Host "localhost")
;;=> "localhost"
;; Original (emacs-lisp):
;; -
;;; Code:
(define (dotassoc-transform-symbol symbol)
(let ((names (parse (term symbol) ".")))
(if (= 1 (length names))
(let (reduce (lambda (f seq)
(apply f seq 2)))
(reduce (lambda (obj key)
(letex (~obj obj ~key key ~strkey (string key))
'(or (lookup '~key ~obj)
(lookup '~strkey ~obj))))
(map sym names))))))
(define (dotassoc-transform expr)
;;(println ";;=> " expr)
((list? expr) (map dotassoc-transform expr))
((symbol? expr) (dotassoc-transform-symbol expr))
(true expr)))
;; @syntax (with-dotassoc BODY*)
(define-macro (with-dotassoc)
(eval (cons 'begin (dotassoc-transform (args)))))
;;; eof
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment