after macro for Nu plus a few handy functions

after.nu

;; drops the first element from a list and returns it
(macro shift! (l)
     `(let (e (car ,l))
           (set ,l (cdr ,l))
           e))

;; drops the first cell from a list if it is equal to e
(macro cond-shift! (l e) `(if (eq (car ,l) ,e) (shift! ,l)))

;; appends e to the list l
(macro push! (l e) `(set ,l (append ,l '(,(unquote e)))))

;; returns the elements of list l joined by *s; *s is optional and defaults to ""
(function join (l *s) ((apply array l) componentsJoinedByString: (or (*s 0) "")))

;; quotes the elements of list l: (lquote '((1 2) (3 4))) => '( '(1 2) '(3 4))
(function lquote (l) (l map: (do (e) (list quote e))))

;; workaround to use operators as functions
(macro &: (sym) `(do (_) (,sym _)))

;; transposes a list of lists
(function transpose (ll)
     (if (any ll) (cons (ll map: (&:car))
                        (transpose (ll map: (&:cdr))))))

;; parallel assignment: (lset (a b) '(1 2)) => (set a 1), (set b 2)
(macro lset (names values)
     `(apply progn
             ',((transpose (list names (eval values)))
                map: (do (nv)
                         (set name  (car nv))
                         (set value (car (cdr nv)))
                         `(set ,name ',value)))))

;; parse a method declaration
(function parse-mdecl (mdecl)
     (function get-type ()
          (if (list? (car mdecl))
              (then (car (shift! mdecl)))
              (else ('id))))

     (function scan-ahead? () (and mdecl (!= (car mdecl) 'is)))

     (set selector-components nil)
     (set arg-types           nil)
     (set arg-names           nil)
     (set return-type         (get-type))
     (push! selector-components (shift! mdecl))
     (while (scan-ahead?)
            (push! arg-types get-type)
            (push! arg-names (shift! mdecl))
            (if (scan-ahead?)
                (push! selector-components (shift! mdecl))))

     (assert (eq 'is (cond-shift! mdecl 'is)))
     (set method-body mdecl)

     (list return-type selector-components arg-types arg-names method-body))


;; the amazing after macro
(macro -after (*mdecl)
     (lset (return-type selector-components arg-types arg-names after-method-body) (parse-mdecl *mdecl))
     (set original-selector (join (selector-components mapSelector: "stringValue")))
     (let (selector-rest (cdr selector-components))
          (let (first-selector-component (cond ((null? selector-rest) '__sel) (else '__sel:)))
               (set selector-components (cons first-selector-component selector-rest))))
     (set swizzle-selector (join (selector-components mapSelector: "stringValue")))

     (set new-mdecl
          (cons
               (list return-type)
               (cond ((null? arg-names) selector-components)
                     (else (apply append (lquote (transpose (list selector-components (arg-types map: (&:list)) arg-names))))))))
     (set mcall
          (cond ((null? arg-names) selector-components)
                (else (apply append (lquote (transpose (list selector-components arg-names)))))))

     `(progn
            (- ,@new-mdecl is
               (self ,@mcall)
               ,after-method-body)
            (_class exchangeInstanceMethod: ,original-selector withMethod: ,swizzle-selector)))


(class Foo is NSObject
     (- (id) foo is (NSLog "in foo"))
     (-after (id) foo is (NSLog "after foo"))
     (- (id) a:(id) aa b:(id) bb is (NSLog "in a:#{aa} b:#{bb}"))
     (-after (id) a:(id) aa b:(id) bb is (NSLog "after a:#{aa} b:#{bb}")))


((Foo new) foo)
((Foo new) a: "A" b: "B")

;; bonus:
;; apply redefined with macro-1 instead of macro-0
(macro apply (ƒ *a) `(eval (cons ,ƒ ,*a)))
;; map redefined as a function (depends on transpose, might not work identically)
(function map (ƒ *ls) ((transpose *ls) map: (do (l) (apply ƒ l))))

Mind you, I have no idea what I'm doing.