extend0.arc
(= extensions* (table)) (mac extend (name label test func) `(do (unless (extensions* ',name) (= (extensions* ',name) `((original (nil ,,name))))) (aif (assoc ',label (extensions* ',name)) (do (prn "*** redefining " ',name " extension " ',label) (= (cadr it) (list ,test ,func))) (push (list ',label (list ,test ,func)) (extensions* ',name))) (= ,name (fn args ((afn (al) (let (label (test func)) (car al) (if (or (no test) (apply test args)) (apply func args) (self (cdr al))))) (or (extensions* ',name) (err "no extension defined for" ',name)))))))
(extend name label test replacement)
Extends the function name. Replaces name with a new definition so that when name is called later, test is first called with the same arguments. If test returns true, the replacement function is called instead of the original definition of name. If test returns false, the original definition of name is called as if the function hadn't been extended.
For example,
(extend + table (fn (x . _) (is (type x) 'table)) (fn ts (listtab (apply + (map tablist ts))))) arc> (+ (obj a 1) (obj b 2)) #hash((a . 1) (b . 2))
You can extend a function several times and the extensions will be chained together. Each extension in turn (starting with the last defined) will be asked if it wants to handle this call, and if its test function returns false, the next extension is tried, and then finally the original function is called if none of the extensions step in.
The label is used during development to distinguish between extensions. If you call extend again with the same label on the same function name, it replaces the extension on the function instead of adding it to the function’s chain. As you develop an extension this avoids having your earlier, buggy implementations left on the extension chain.
Suppose we wanted to treat an op that was a number specially, so that instead of “http://mysite.com/item?id=1234” we could use “http://mysite.com/1234”.
(def digit (c) (<= #\0 c #\9)) (def isid (op) (all digit (string op)))
The point in srv.arc where it figures out which function to call given the URL is in the function respond:
(def respond (str op args cooks ip)
(w/stdout str
(aif (srvops* op)
(let req (inst 'request 'args args 'cooks cooks 'ip ip)
(if (redirector* op)
(do (prn rdheader*)
(prn "Location: " (it str req))
(prn))
(do (prn header*)
...
So let’s make our own function to handle the response in the case where the URL is a number:
(def respond-id (str op args cooks ip)
(w/stdout str
(prn header*)
(prn "this is the page for the item with id " op)))
And a function to decide if we’re going to handle this response:
(def id-test (str op args cooks ip) (isid op))
Extending respond:
(extend respond id id-test respond-id)
And that’s all we need to implement our extension:
$ curl http://localhost:8080/1234 this is the page for the item with id 1234
Notice however how our implementation of respond-id needs to set up stdout, which is done for us if we’re using a defop, and we’ not getting a req object, which is passed into a defop for us. This is because Arc’s implementation of respond is doing two things: setting up to handle the request and creating the req object, and figuring out which function to call to handle the request. If Arc’s implementation were factored into two functions, something like this:
(def respond (str op args cooks ip)
(w/stdout str
(let req (inst 'request 'args args 'cooks cooks 'ip ip 'op op 'str str)
(choose-response req))))
(def choose-response (req)
(aif (srvops* req!op)
(if (redirector* req!op)
...
then our extension becomes even simpler:
(def id-test (req) (isid req!op)) (def respond-id (req) (prn header*) (prn) (prn "this is the page for the item with id " req!op)) (extend choose-response id id-test respond-id)
Arc’s MzScheme implementation of ac in ac.scm looks like:
(define (ac s env)
(cond ((string? s) (string-copy s))
((literal? s) s)
((eqv? s 'nil) (list 'quote 'nil))
...
if we rename this to ac-impl:
(define (ac-impl s env)
(cond ((string? s) (string-copy s))
((literal? s) s)
...
and make an Arc function arc-ac which is implemented by this:
(xdef 'arc-ac ac-impl)
and have the MzScheme ac procedure call Arc’s arc-ac:
(define (ac s env) ((namespace-variable-value '_arc-ac) s env))
The Arc compiler is now available in Arc. Normally when an Arc variable refers to an MzScheme procedure, changing the variable doesn't effect anything in MzScheme, but since we're arranged for MzScheme to call Arc’s arc-ac function, we can change the behavior of Arc’s compiler. We do need to keep in mind that despite being an Arc function, arc-ac is passed MzScheme values and needs to return an MzScheme value.
To prove that we can really change Arc’s compiler, let’s try replacing it with an obstinate one:
arc> (def arc-ac (s env) (mz ''nope)) #<procedure: arc-ac> arc> 1 nope arc> (+ 3 (/ 10 4)) nope arc> (quit) nope arc> ^C
It worked! (I’m using my mz patch to let me easily return an MzScheme value).
Here’s an extension to Arc’s compiler so that reading an end-of-file character (^D in Unix) exits Arc:
(extend arc-ac eof (fn (s env) (mz (eof-object? s))) (fn (s env) (quit))) arc> ^D $
wget http://hacks.catdancer.ws/extend0.arc mzscheme -m -f as.scm (load "extend0.arc")