/lib/extend.arc
Unknown | 76 lines | 73 code | 3 blank | 0 comment | 0 complexity | 0c055178a8165e229ab6105e4a76021f MD5 | raw file
1; extend by CatDancer <cat@catdancer.ws> (http://hacks.catdancer.ws) 2; license: Public domain (http://creativecommons.org/licenses/publicdomain/) 3 4; CHANGELOG 5; 2010-02-15 Mark Huetsch <markhuetsch@gmail.com> 6; + moved to simpler extend from http://awwx.ws/extend0.arc simply 7; because the old versions don't seem to work with aw's new patches 8; and I don't have time to debug them. 9; 2009-08-20: Michael Arntzenius <daekharel@gmail.com> 10; + reloading the file will no longer wipe the extensions table. 11; + refactored 'extend macro into a function 'extend-add, a function 12; 'extend-fn, a macro 'extend-ensure, and a macro 'extend. 13; + remove unnecessary let in 'extend-wrap's afn 14; + add 'extend-pull fn, 'unextend macro 15 16;(unless (and bound!extensions* extensions*) 17; (= extensions* (table))) 18; 19;(defmemo extend-fn (name) 20; (fn args 21; ((afn (((label (test func)) . rest)) 22; (if (or (no test) (apply test args)) 23; (apply func args) 24; (self rest))) 25; (or (extensions* name) 26; (err "no extension defined for" name))))) 27; 28;(mac extend-ensure (name) 29; `(do 30; (unless (extensions* ',name) 31; (= (extensions* ',name) `((original (nil ,,name))))) 32; (= ,name (extend-fn ',name)))) 33; 34;(def extend-add (name label test func) 35; (aif (assoc label extensions*.name) 36; (do (prn "*** redefining " name " extension " label) 37; (= (cadr it) (list test func))) 38; (push `(,label (,test ,func)) extensions*.name))) 39; 40;(mac extend (name label test func) 41; `(do1 (extend-ensure ,name) 42; (extend-add ',name ',label ,test ,func))) 43; 44;(def extend-pull (name label) 45; (prn "*** undefining " name " extension " label) 46; (pull [is car._ label] extensions*.name)) 47; 48;(mac unextend (name label) 49; `(do (extend-pull ',name ',label) ,name)) 50; 51;; original 'extend from extend0.arc 52;(mac extend (name label test func) 53; `(do (unless (extensions* ',name) 54; (= (extensions* ',name) `((original (nil ,,name))))) 55; (aif (assoc ',label (extensions* ',name)) 56; (do (prn "*** redefining " ',name " extension " ',label) 57; (= (cadr it) (list ,test ,func))) 58; (push (list ',label (list ,test ,func)) (extensions* ',name))) 59; (= ,name (fn args 60; ((afn (al) 61; (let (label (test func)) (car al) 62; (if (or (no test) (apply test args)) 63; (apply func args) 64; (self (cdr al))))) 65; (or (extensions* ',name) 66; (err "no extension defined for" ',name))))))) 67 68; TODO re-add unextend support 69(mac extend (name arglist test . body) 70 (w/uniq args 71 `(let orig ,name 72 (= ,name 73 (fn ,args 74 (aif (apply (fn ,arglist ,test) ,args) 75 (apply (fn ,arglist ,@body) ,args) 76 (apply orig ,args)))))))