Find file
Fetching contributors…
Cannot retrieve contributors at this time
72 lines (69 sloc) 3.18 KB
; make-fns-from-args consolidates double-defkey for defkey recursive uses
(defun make-functions-from-args (parts)
(defkey ,(a (join-under (ll parts))) ,parts)
(defkey ,(a (join-colon (ll parts))) ,parts)))
; (caps? $A) -> true
; (caps? $e) -> false
(defun caps?
((x) (when (andalso (is_integer x) (>= x 65) (=< x 90))) 'true)
((_) 'false))
; (extract-caps (a b C d E f)) -> (C E)
(defun extract-caps
([()] '())
([(x . xs)] (let* ((first-character (car (l x))))
((caps? first-character) (cons x (extract-caps xs)))
(else (extract-caps xs))))))
; (listize-parts (a b C d E f) (C E)) -> (#b("a") #b("b") C #b("d") E #b("f"))
(defun listize-parts
([() _] '())
([(x . xs) caps-parts] (cond
; if x in caps-parts, don't turn it into a list.
((: lists member x caps-parts)
(cons x (listize-parts xs caps-parts)))
; else, turn x into a list and recurse.
; NB: we convert to binary because LFE
; currently has a problem converting
; to lists. It wants to execute them
; after they are constructed (it's not quoting).
(cons (b x)
(listize-parts xs caps-parts)))))))
; (defkey rambo (a b C d E f)) generates equivalent of:
; rambo(C, E) -> eru:er_key(<<"a">>, <<"b">>, C, <<"d">>, E, <<"f">>).
; i.e. anything starting with caps is an argument and everything else
; is presented to the key generator as-is.
; also works with one arg: (defkey (site N)) makes: site:N(N) and site_N(N)
; counter keys auto-generate counter accessors:
; (defkey (counter bob)) => counter:bob(), counter_bob(), bob:N(N), bob_N(N)
; normal usage of defining a function name and its components:
; (defkey zomboid (rabbit Hole)) => zomboid(Hole) = rabbit:[Hole]
; normal usage of auto-making function name based on component names:
; (defkey (rabbit Hole)) => rabbit(Hole) = rabbit:Hole
(defmacro defkey
([('counter . (name))] `(progn
,(make-functions-from-args (list 'counter name))
(defkey (,name N))))
([parts] (when (is_list parts)) (make-functions-from-args parts))
([name parts] (let* ((variable-parts (extract-caps parts))
(listize-parts parts variable-parts)))
`(defun ,name ,variable-parts
(: eru er_key ,@adjusted-list-parts)))))
; (defkey-suite post (to tags last_update authors (comment Comment))) creates:
; counter:post(), counter_post()
; post:N:to(N), post_N_to(N)
; post:N:tags(N), post_N_tags(N)
; post:N:last_update(N), post_N_last_update(N)
; post:N:authors(N), post_N_authors(N)
; post:N:comment:Comment(N, Comment), post_N_comment_Comment(N, Comment)
(defmacro defkey-suite (key subkeys)
(defkey (counter ,key))
,@(: lists map
([subkey] (when (is_atom subkey)) `(defkey (,key N ,subkey)))
([subkey] (when (is_list subkey)) `(defkey (,key N ,@subkey))))