ecmascript-6common-lispes6-classparenscript

ES6 style classes in Parenscript


Is there a decent way to write a Parenscript class macro that outputs ES6 class definitions?

If the class definitions look like this:

class Person {
    sayHello() {
        alert('hello');
    }

    walk() {
        alert('I am walking!');
    }
}

class Student extends Person {
    sayGoodBye() {
        alert('goodBye');
    }

    sayHello() {
        alert('hi, I am a student');
    }
}

I want to write them somewhat like this in Parenscript:

(def-class -person ()
  (say-hello () (alert "hello"))
  (walk () (alert "I am walking!")))

(def-class -student (-person)
  (say-good-bye () (alert "goodBye"))
  (say-hello () (alert "hi, I am a student")))

I have tried a couple of approaches - attached as answers below - but neither of them is entirely satisfactory. Is there a better solution that does not involve re-engineering Parenscript?


Solution

  • Solution 1:

    (defpsmacro def-class (name (&optional extends) &body body)
      (multiple-value-bind (constructor others)
          (gadgets:splitfilter (lambda (x) (string-equal (car x) 'constructor)) body)
        (let ((constructor (case (length constructor)
                             (0 nil)
                             (1 (car constructor))
                             (otherwise
                              (error "Class can't have more than one constructor"))))
              (const-lambda-list nil)
              (const-body nil))
          (when constructor
            (setf const-lambda-list (second constructor))
            (set const-body (cddr constructor)))
          `(progn
             (defun ,name ,const-lambda-list
               ,@const-body)
             ,@(mapcar
                (lambda (item)
                  `(setf (@ ,name prototype ,(car item))
                         (lambda ,(second item) ,@(cddr item))))
                others)
             ,@(when extends
                     `((setf (@ ,name prototype) (chain -object (create (@ ,name prototype))))
                       (setf (@ ,name prototype constructor) ,name)))))))
    

    Problems: