objective-lisp/objective-lisp.lisp

;; objective-lisp: Object-oriented syntactic sugar for Lisp
;; ~keith

(defpackage objective-lisp
  (:use common-lisp)
  (:export O!))

(in-package objective-lisp)

(defconstant +open-char+ #\[)
(defconstant +close-char+ #\])

(defmacro O! (root &rest forms)
  (let ((expr root))
    (loop for entry on forms
          for form = (car entry)
          and prev-form = nil then form
          unless (eq prev-form :slot)
            do (setf expr
                     (cond ((consp form) `(,(car form) ,expr ,@(cdr form)))
                           ((eq form :slot) (prog1 `(slot-value ,expr ',(cadr entry))
                                              (unless (cadr entry)
                                                (error "Missing slot name"))))
                           ((symbolp form) `(,form ,expr))
                           (t (error "Unexpected form ~S" form)))))
    ;(format t "~S => ~S~%" `(O! ,root ,@forms) expr)
    expr))

(defun read-construct (stream char arg)
  "Read an objective-lisp construct."
  (declare (ignore char arg))
  (macroexpand-1 (cons 'O! (read-delimited-list +close-char+ stream))))

;(set-macro-character +open-char+ 'read-construct)
(set-dispatch-macro-character #\# +open-char+ #'read-construct)
(set-macro-character +close-char+ (get-macro-character #\)))