Skip to content

Instantly share code, notes, and snippets.

@kosh04
Created Oct 20, 2015
Embed
What would you like to do?
;;; dotassoc.lsp
;; 連想リストの Key-Value 参照をドット記法で
;;; Example:
;; (let ((student '((id 1332412)
;; (name ((first "Student")
;; (last "Example"))))))
;; (with-dotassoc
;; (upper-case student.name.first)))
;;=> "STUDENT"
;; 読取り時に変換する (リーダマクロのようなもの)
;; (reader-event 'dotassoc-transform)
;; student.name.first
;; ~> (lookup 'first (lookup 'name student))
;; => "Student"
;; (setq json (json-parse (get-url "http://httpbin.org/get")))
;;
;; json.headers.User-Agent
;;=> "newLISP v10603"
;;
;; setf による代入も一応可能
;; (setf json.headers.Host "localhost")
;;=> "localhost"
;; Original (emacs-lisp):
;; - https://gist.github.com/skeeto/7edbedfdec3444925451
;;; Code:
(define (dotassoc-transform-symbol symbol)
(let ((names (parse (term symbol) ".")))
(if (= 1 (length names))
symbol
(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)
(cond
((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