Emacs Lisp Macro Talk by Ruy Ley-Wild on Sep 18, 2018 at Boston Emacs Meetup

emacs-lisp-macro.el

;; 2018 Sep 18
;; Emacs Meetup
;; Extensible MACroS
;; by Ruy Ley-Wild

(inert ;; programming vs metaprogramming

 input data     -program->     output data

 42             -double->      84


 input program  -metaprogram-> output program

 write metaprograms with macros

 )


(inert ;; strings and variables

 (setq x "foo")

 (insert "x")   ;; String

 (insert x)     ;; Variable

 )


(inert ;; strings and expressions and lists

 "(+ 1 2)"       ;; String

 (+ 1 2)         ;; Expression
3

 '(+ 1 2)
 (quote (+ 1 2)) ;; Quoted List

 (list '+ 1 2)   ;; Expanded List

 )


(inert ;; read, eval, apply, cf SICP

 (read "(+ 1 2)")         ;; String -> S-expression
(+ 1 2)

 (eval '(+ 1 2))          ;; S-expression -> S-expression
3

 (eval (read "(+ 1 2)"))  ;; read and evaluate
3

 (apply (lambda (x) (+ x 2))
	(list 1))         ;; apply a function to arguments
3

 )


(inert ;; metaprogramming

 (defun plus2-fun (n)
   ;; build an expression as a string
   ;; don't have access to n's structure
   (concat "(+ "n" 2)"))

 ;; have to encode argument as a string
 (plus2-fun "1")
"(+ 1 2)"

 (plus2-fun "(+ 1 3)")
"(+ (+ 1 3) 2)"


 (eval (read (plus2-fun "1")))
3


 (plus2-fun "4")
"(+ 4 2)"


 (defmacro plus2-macro (n)
   ;; build an expression as a list
   `(+ ,n 2))

 (macroexpand '(plus2-macro 1))
(+ 1 2)

 (plus2-macro 1)
 `(+ ,1 2)
 '(+ 1 2)
 (+ 1 2)
 3

 (macroexpand '(plus2-macro (+ 1 3)))
(+ (+ 1 3) 2)

 )


(inert ;; inspect expression

 (defmacro show-macro (e)
   (message "(the sexp is: %S)" e))

 (show-macro (+ 1 3))

 (show-macro (/ 1 0))


 ;; aside
 (car '(1 2 3...)) == 1
 (cdr '(1 2 3...)) == '(2 3...)


 (defmacro head-macro (e)
   (message "(the head sexp is: %S)" (car e)))

 (head-macro (+ 1 3))
"(the head sexp is: +)"

 (head-macro 3)
;; fails


 (defmacro minus-macro (e)
   (message "(the updated sexp is: %S)" (cons '- (cdr e))))

 (minus-macro (+ 1 3))
"(the updated sexp is: (- 1 3))"

 (minus-macro (0 1 3))
"(the updated sexp is: (- 1 3))"

 )


(inert ;; S-expressions

 x foo t        ;; Symbols

 "x" "foo"      ;; Strings

 3.14 42        ;; Numbers

 ()             ;; Empty list

 (cons t "foo") ;; Pairs
 (cons E1 E2)

 (list 1 2 3)   ;; Lists
 `(1 2 3)
 '(1 2 3)
 (quote (1 2 3))
 (cons 1 (cons 2 (cons 3 ())))


 ;; code is data
 '(defun foo () (message "hi"))


 ;; tests
 (symbolp `x)
 (stringp "x")
 (numberp 3.14)
 (null ())
 (consp (cons 1 2))

 )


(inert ;; quote and antiquote

 'x
 `x
 (quote x)
 (intern "x")
 x


 `"foo"
 (quote "foo")
 "foo"


 `(1 2 3)
 (quote (1 2 3))
 (list `1 `2 `3)
 (list 1 2 3)


 `(1 (2 3 (4 5)))
 (list `1 `(2 3 (4 5)))
 (list 1 (list `2 `3 `(4 5)))
 (list 1 (list 2 3 (list `4 `5)))
 (list 1 (list 2 3 (list 4 5)))


 `sym `sym
 `"foo" "foo"
 `3.14 3.14
 `(E1 E2 ...) (list `E1 `E2 ...)

 (equal (intern "sym") `sym) ;; t

 (intern "sym")         ;; String -> Symbol
sym
 (symbol-name 'foo)     ;; Symbol -> String
"foo"
 (gensym)               ;; Unit -> Symbol
G92966
G92965

 )


(inert ;; function vs macro

 ;; function
 (progn
   (defun never-fun (e)
     nil)
   (defun once-fun (e)
     e)
   (defun twice-fun (e)
     (progn e e))
   )

 ;; what will these do?
 (never-fun (insert "hi "))
 (once-fun (insert "hi "))
 (twice-fun (insert "hi "))


 ;; macro
 (progn
   (defmacro never-macro (e)
     nil)
   (defmacro once-macro (e)
     e)
   (defmacro twice-macro (e)
     `(progn ,e ,e)
     ;; "(progn "e" "e")"
     )
   (defmacro twice-macro2 (e)
     `(progn e e)
     ;; (list `progn `e `e)
     ;; "(progn e e)"
     )
   )

 (insert "hi ")

 (never-macro (insert "hi "))
 (once-macro (insert "hi "))
 (twice-macro (insert "hi "))

 (twice-macro2 (insert "hi "))
 `(progn e e)
 (list `progn `e `e)
 (progn e e)

 )


(inert ;; conditional

 ;; function
 (defun if-fun (etest etrue efalse)
   (if etest
       etrue
     efalse))

 (if-fun (= 0 1)
         (insert "yay ")
         (insert "nay "))
yay nay 
(if-fun nil nil nil)
(if nil nil nil)
nil

 ;; macro
 (defmacro if-macro (etest etrue efalse)
   `(if ,etest
        ,etrue
      ,efalse))

 (if-macro (= 0 1)
           (insert "yay ")
           (insert "nay "))

`(if ,(= 0 1)
     ,(insert "yay ")
   ,(insert "nay "))

(if (= 0 1)
    (insert "yay ")
  (insert "nay "))

(if nil
    (insert "yay ")
  (insert "nay "))

(insert "nay ")


 ;; a better function, more verbose
 (defun if2-fun (ftest ftrue ffalse)
   (if (apply ftest ())
       (apply ftrue ())
     (apply ffalse ())))

 (if2-fun (lambda () (= 0 1))
	  (lambda () (insert "yay "))
	  (lambda () (insert "nay ")))

 )


(inert ;; profiling

 (defmacro measure-time (&rest body)
   ;; http://lists.gnu.org/archive/html/help-gnu-emacs/2008-06/msg00087.html
   "Measure the time it takes to evaluate BODY."
   `(let ((time (current-time)))
      ,@body
      (message "%.06f" (float-time (time-since time)))))

 (measure-time
  (loop for i from 1 to 1000000 do (+ i i)))

 ;; aside: splicing
 `(a ,(list b c d) e)
 (list 'a (list 'b 'c 'd) 'e)

 `(a ,@(list b c d) e)
 `(a b c d e)

 ;; &rest parameters
 (measure-time a b c)
   where body is '(a b c)

 )


(inert ;; definitions

 ;; define f(x)
 (defun f (x)
   (+ x 2))

 (defmacro defunk (function-args &rest body)
   `(defun ,(car function-args) ,(cdr function-args)
      ,@body))

 ;; define (f x)
 (defunk (f x)
   (+ x 2))

 (f 3)

 5
 )


(inert ;; code generation

 (defun f1 (x1)       (+ (* 1 x1)                  ))
 (defun f2 (x1 x2)    (+ (* 1 x1) (* 2 x2)         ))
 (defun f3 (x1 x2 x3) (+ (* 1 x1) (* 2 x2) (* 3 x3)))
 ...

 (f1 1)
 (f2 1 2)
 (f3 1 2 3)

 (defun defN (num)
   (lexical-let* ((func-name (intern (format "f%d" num)))
                  (args (loop for i from 1 to num
                              collect (intern (format "x%d" i))))
                  (products (loop for i from 1 to num
                                  collect `(* ,i ,(intern (format "x%d" i)))))
                  (body `(+ ,@products)))
     ;; (list func-name args body)
     `(defun ,func-name ,args ,body)
     ))

 (defN 3)
(defun f3 (x1 x2 x3) (+ (* 1 x1) (* 2 x2) (* 3 x3)))

 (defN 8)
(defun f8 (x1 x2 x3 x4 x5 x6 x7 x8)
  (+ (* 1 x1) (* 2 x2) (* 3 x3) (* 4 x4) (* 5 x5) (* 6 x6) (* 7 x7) (* 8 x8)))

 (loop for i from 1 to 10
       do (defN i))

 )


(inert ;; power

 (defun pow-fun (n k) ;; k ^ n
   (expt k n))

 ;; specialized exponentiation
 ;; k^0      = 1
 ;; k^(2m+1) = k * (k^(2m))
 ;; k^(2m)   = (k * k)^m

 (defmacro pow-macro (n)
   (cond
    ((= n 0)
     `(lambda (k) 1))
    ;; why can't we do ,(pow-macro (- n 1))
    ((= (mod n 2) 1)
     `(lexical-let* ((fn (pow-macro ,(- n 1))))
        (lambda (k) (* k (apply* fn k)))))
    ((= (mod n 2) 0)
     `(lexical-let* ((fn (pow-macro ,(/ n 2))))
        (lambda (k) (apply* fn (* k k)))))
    )
   )

 (apply (pow-macro n) k) ;; k^n

 (apply (pow-macro 0) '(2))
 (apply (pow-macro 1) '(2))
 (apply (pow-macro 2) '(2))
 (apply (pow-macro 3) '(2))
 (apply (pow-macro 4) '(2))

 )


(inert ;; pick among choices

 (nth 2 (list "apple" "banana" "cherry"))
"cherry"

 ;; function
 (defun pick-fun (index &rest options)
   (nth index options))

 (pick-fun 2 "apple" "banana" "cherry")
"cherry"

 (defun ins (s)
   (insert s)
   s)

 (pick-fun 2
           (ins "apple")
           (ins "banana")
           (ins "cherry"))


 ;; macro
 (defmacro pick-macro (index &rest options)
   ;; avoid evaluating all
   (nth index options)
   )

 (pick-macro 2
             (ins "apple")
             (ins "banana")
             (ins "cherry"))

 )