diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-08-06 16:32:24 +0200 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-08-06 16:32:24 +0200 |
| commit | 676e99eaf8991168cf33c24921b8d63b381fea20 (patch) | |
| tree | a964b35442038c9d14fa96fcb706d6429339dd03 /Lisp/method-invocation.lisp | |
| parent | 4cdb467706500d621769ffef0286be58d7bfc8da (diff) | |
Put name conversion routines into their own file.
darcs-hash:5634f866252465787558f61b05f4bc3006d48f37
Diffstat (limited to 'Lisp/method-invocation.lisp')
| -rw-r--r-- | Lisp/method-invocation.lisp | 44 |
1 files changed, 15 insertions, 29 deletions
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index 6461743..b446015 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -65,35 +65,21 @@ if as the second **argument** to __invoke-by-name__. __invoke-by-name__" - (flet ((message-component->string (symbol) - (let* ((components (split-sequence #\- (symbol-name symbol) - :remove-empty-subseqs t)) - (acc-string - (reduce #'(lambda (x y) (concatenate 'string x y)) - (mapcar #'(lambda (x) - (concatenate 'string - (string (char x 0)) - (string-downcase (subseq x 1)))) - (subseq components 1)) - :initial-value (string-downcase (first components))))) - (if (eql (find-package '#:keyword) - (symbol-package symbol)) - (concatenate 'string acc-string ":") - acc-string)))) - (do* ((components-left (cons message-start message-components) - (cddr components-left)) - (message-string (message-component->string message-start) - (concatenate 'string - message-string - (message-component->string (first components-left)))) - (arglist (if (null (rest components-left)) - nil - (list (second components-left))) - (if (null (rest components-left)) - arglist - (cons (second components-left) arglist)))) - ((null (cddr components-left)) - (apply #'invoke-by-name receiver message-string (nreverse arglist)))))) + (do* ((components-left (cons message-start message-components) + (cddr components-left)) + (message-list (list message-start) + (cons (first components-left) message-list)) + (arglist (if (null (rest components-left)) + nil + (list (second components-left))) + (if (null (rest components-left)) + arglist + (cons (second components-left) arglist)))) + ((null (cddr components-left)) + (apply #'invoke-by-name + receiver + (symbol-list->message-name (nreverse message-list)) + (nreverse arglist))))) (defun invoke-by-name (receiver method-name &rest args) |