Permalink
Browse files

[cl-backend] implemented indirect method calls - $foo."$bar"(...) works

  • Loading branch information...
1 parent e8b62fe commit 58cb2b5c8374b4b866fb03558a80477f80776b48 @pmurias pmurias committed Feb 16, 2011
Showing with 21 additions and 5 deletions.
  1. +12 −5 cl-backend/backend.lisp
  2. +9 −0 simple-tests/indirect-method.t
View
@@ -208,18 +208,25 @@
(defun nam-subcall (dunno-what-that-is thing &rest args) (apply thing args))
+
+; TODO: check if this needs to be optimised
(labels
- ((to-string (arg) (if (stringp arg)
- arg
+ ((known (arg) `(quote ,(intern arg)))
+ (to-method (arg) (if (stringp arg)
+ (known arg)
(if (eq (first arg) 'nam-str)
- (second arg)
- (format t "Can't handle that sort of method call yet")
+ (known (second arg))
+ `(intern ,arg)
))))
(nam-op methodcall (method-name dunno invocant &rest args)
- `(,(method-name (to-string method-name)) (FETCH ,(first args)) ,@(rest args))))
+ `(apply ,(to-method method-name) (list (FETCH ,(first args)) ,@(rest args)))))
(defun nam-obj_getbool (obj) (if (numberp obj) (not (equal obj 0)) obj))
+
+(defun nam-bif_str (obj) (FETCH obj))
+(defun nam-obj_getstr (obj) obj)
+
(nam-op ternary (cond if then) `(if ,cond ,if ,then))
(defun nam-null (type) nil)
@@ -0,0 +1,9 @@
+class Foo {
+ method method_with_arg($arg) {
+ say $arg;
+ }
+}
+say "1..1";
+my $foo = Foo.new();
+my $method = "method_with_arg";
+$foo."$method"("ok 1");

0 comments on commit 58cb2b5

Please sign in to comment.