diff options
| author | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-08-04 17:56:15 +0200 |
|---|---|---|
| committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2007-08-04 17:56:15 +0200 |
| commit | cb4496f15f5fad35ab42c1061746ee7753e0d3f8 (patch) | |
| tree | 8f423cd66e00bf9ded3686c8a7d34afe9eb8c7ff /Lisp/method-invocation.lisp | |
| parent | 4bf7ff0fac043bbe1516e00fdd3567ed38fe6ff4 (diff) | |
Implement the public function INVOKE.
darcs-hash:682c1fbf416e7a5192560d02c9a3343a98eb5c02
Diffstat (limited to 'Lisp/method-invocation.lisp')
| -rw-r--r-- | Lisp/method-invocation.lisp | 32 |
1 files changed, 29 insertions, 3 deletions
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp index 63f3e24..c7e8810 100644 --- a/Lisp/method-invocation.lisp +++ b/Lisp/method-invocation.lisp @@ -4,9 +4,35 @@ ;;; (@* "Method invocation") (defun invoke (receiver message-start &rest message-components) "FIXME" - (flet ((message-component->string (component) - ())) - (do ((message-string ()))))) + (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)))))) (defun invoke-by-name (receiver method-name &rest args) |