Use help-function-arglist in imalison:compose

This allows use to automatically detect the signature of a
function/macro and take arguments accordingly in the composition.
This commit is contained in:
Ivan Malison 2016-06-22 18:43:09 -07:00
parent d61a6cf1b1
commit 6a7670f4c3

View File

@ -5,6 +5,7 @@ This README is a literate commentary on my emacs configuration, but it also serv
This makes it so that the file that is produced from tangling this file uses lexical scoping This makes it so that the file that is produced from tangling this file uses lexical scoping
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
;;; -*- lexical-binding: t -*- ;;; -*- lexical-binding: t -*-
(setq lexical-binding t)
#+END_SRC #+END_SRC
** User Info ** User Info
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
@ -19,6 +20,7 @@ This makes it so that the file that is produced from tangling this file uses lex
This is here because it needs to be activated as early as possible This is here because it needs to be activated as early as possible
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(use-package auto-compile (use-package auto-compile
:ensure t
:config :config
(progn (progn
(auto-compile-on-load-mode) (auto-compile-on-load-mode)
@ -389,17 +391,17 @@ The packages in this section provide no functionality on their own, but provide
thing thing
(list thing))) (list thing)))
(defmacro imalison:compose (&rest funcs) (defmacro imalison:compose-with-apply (&rest funcs)
"Build a new function with NAME that is the composition of FUNCS." "Build a new function with NAME that is the composition of FUNCS."
`(lambda (&rest args) `(lambda (&rest args)
(imalison:compose-helper ,funcs))) (imalison:compose-with-apply-helper ,funcs)))
(defmacro imalison:compose-helper (funcs) (defmacro imalison:compose-with-apply-helper (funcs)
"Builds funcalls of FUNCS applied to the arg." "Builds funcalls of FUNCS applied to the arg."
(if (equal (length funcs) 0) (if (equal (length funcs) 0)
(quote args) (quote args)
`(apply ,(car funcs) `(apply ,(car funcs)
(imalison:make-list (imalison:compose-helper ,(cdr funcs)))))) (imalison:make-list (imalison:compose-with-apply-helper ,(cdr funcs))))))
#+END_SRC #+END_SRC
**** Simpler Unary version **** Simpler Unary version
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
@ -416,25 +418,35 @@ The packages in this section provide no functionality on their own, but provide
#+END_SRC #+END_SRC
**** A Version Supporting Macros **** A Version Supporting Macros
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defmacro imalison:compose-2 (arguments &rest funcs) (defun imalison:args-expander (function-name)
(when (numberp arguments) (lambda (args)
(setq arguments (apply function-name args)))
(cl-loop for i from 97 to (+ arguments 96)
collect (intern (char-to-string i)))))
`(imalison:compose-2-argspec ,arguments ,arguments ,@funcs))
(defmacro imalison:compose-2-argspec (defmacro imalison:compose (&rest funcs)
(let* ((last-function (car (last funcs)))
(arguments (help-function-arglist last-function))
(call-arguments (delq '&optional arguments)))
(when (memq '&rest arguments)
(setq arguments '(&rest args))
(setq call-arguments '(args))
(setq funcs
(-replace-at (- (length arguments) 1)
(imalison:args-expander last-function)
funcs)))
`(imalison:compose-argspec ,arguments ,call-arguments ,@funcs)))
(defmacro imalison:compose-argspec
(arguments call-arguments &rest funcs) (arguments call-arguments &rest funcs)
"Build a new function with NAME that is the composition of FUNCS." "Build a new function with NAME that is the composition of FUNCS."
`(lambda ,arguments `(lambda ,arguments
(imalison:compose-2-helper ,funcs ,call-arguments))) (imalison:compose-helper ,funcs ,call-arguments)))
(defmacro imalison:compose-2-helper (funcs arguments) (defmacro imalison:compose-helper (funcs arguments)
"Builds funcalls of FUNCS applied to the arg." "Builds funcalls of FUNCS applied to the arg."
(if (equal (length funcs) 1) (if (equal (length funcs) 1)
`(,(car funcs) ,@arguments) `(,(car funcs) ,@arguments)
`(,(car funcs) `(,(car funcs)
(imalison:compose-2-helper ,(cdr funcs) ,arguments)))) (imalison:compose-helper ,(cdr funcs) ,arguments))))
#+END_SRC #+END_SRC
*** Prefix Alternatives *** Prefix Alternatives
Prefix alternatives is a macro that builds a function that selects one of a collection of functions that are provided to the macro based on the value of the prefix argument. Prefix alternatives is a macro that builds a function that selects one of a collection of functions that are provided to the macro based on the value of the prefix argument.
@ -492,7 +504,7 @@ imalison:named-build is a way to invoke a macro in such a way that the lambda th
For composing functions with an apply so that they can be used with the ~:around~ keyword of advice-add For composing functions with an apply so that they can be used with the ~:around~ keyword of advice-add
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defmacro imalison:advice-add-around-builder (&rest functions) (defmacro imalison:advice-add-around-builder (&rest functions)
`(imalison:compose-2-argspec `(imalison:compose-argspec
(function &rest args) (function args) ,@functions apply)) (function &rest args) (function args) ,@functions apply))
#+END_SRC #+END_SRC
**** Kill New **** Kill New
@ -642,7 +654,7 @@ Get route information
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defun imalison:muni-get-route-ids (route-name &optional direction) (defun imalison:muni-get-route-ids (route-name &optional direction)
(delete-dups (delete-dups
(mapcar (imalison:compose-2 1 intern car) (mapcar (imalison:compose intern car)
(s-match-strings-all (s-match-strings-all
"^\\([[:digit:]]\\{1,10\\}\\)" "^\\([[:digit:]]\\{1,10\\}\\)"
(shell-command-to-string (shell-command-to-string
@ -784,13 +796,12 @@ A macro for composing functions together to build an interactive command to copy
(defmacro imalison:compose-copy-builder (name &rest funcs) (defmacro imalison:compose-copy-builder (name &rest funcs)
`(imalison:named-build ,name `(imalison:named-build ,name
imalison:make-interactive imalison:make-interactive
(imalison:compose-2 0 kill-new ,@funcs))) (imalison:compose kill-new ,@funcs)))
#+END_SRC #+END_SRC
*** Copy portions of the buffer file name *** Copy portions of the buffer file name
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defmacro imalison:copy-buffer-file-path-builder (&rest args) (defmacro imalison:copy-buffer-file-path-builder (&rest args)
`(imalison:compose-copy-builder ,@args 'buffer-file-name)) `(imalison:compose-copy-builder ,@args buffer-file-name))
(imalison:copy-buffer-file-path-builder imalison:copy-buffer-file-path-full) (imalison:copy-buffer-file-path-builder imalison:copy-buffer-file-path-full)
(imalison:copy-buffer-file-path-builder imalison:copy-buffer-file-name (imalison:copy-buffer-file-path-builder imalison:copy-buffer-file-name