objective-lisp 1.0

README.md

@@ -1,3 +1,69 @@
 # objective-lisp
 
-Syntactic sugar for object-oriented Lisp.
+Syntactic sugar for object-oriented Lisp.
+
+`objective-lisp` provides a simple, concise, and (slightly) more conventional
+syntax for accessing the slots and methods of objects. It defines a reader
+macro for the `[` and `]` characters (although you can change these in the
+code).
+
+## Usage
+
+**TL;DR:** `[object slot-name]` is like `object.slotName` in C++, and
+`[object (.method args)]` is like `object.method(args)` in C++.
+
+First, to enable `objective-lisp`'s syntax, just load the system:
+``` common-lisp
+(asdf:load-system 'objective-lisp)
+```
+
+`objective-lisp`'s syntax takes the form of a special S-expression, contained
+in square brackets rather than parentheses. Each form within treats the previous
+form as its subject, like a chain of `.` (dot) operators in C-like languages.
+```common-lisp
+[foo bar baz quux]
+;; C++: foo.bar.baz.quux
+```
+
+To access a slot, just put the slot name after the object:
+``` common-lisp
+[object slot-name]
+;; => (slot-value object 'slot-name)
+
+(setf [object slot-name] value)
+;; => (setf (slot-value object 'slot-name) value)
+```
+
+`slot-name` doesn't have to be an unquoted symbol:
+``` common-lisp
+(defun choose-slot (x)
+	(if (<= x 0) 'pos-slot 'neg-slot))
+(setf [object (choose-slot -1)] value)
+
+(defvar slot-var 'slot-name)
+(setf [object `,slot-var] value)
+```
+
+To call a method, write an S-expression as you normally would, but put a `.`
+(dot) before its name:
+``` common-lisp
+[object (.method arg-1 arg-2 ... arg-N)]
+;; => (method object arg-1 arg-2 ... arg-N)
+```
+
+Under the hood, this just passes `object` as the first argument to `method`, so
+you can do stuff like this (I won't kinkshame you, but your coworkers might):
+```common-lisp
+[object slot-name (.setf value)]
+```
+
+And, of course, you can chain multiple slot accesses and method calls together:
+``` common-lisp
+[object child (.method-of-child) (.method-of-return-value) slot-of-return-value]
+```
+
+## License
+`objective-lisp` is public domain. You can do whatever you want with it. I don't
+really care about credit, it's just a silly little thing I wrote in a few hours.
+
+But if you find it useful, *please* let me know. I'd love to hear about it.

objective-lisp.asd

@@ -0,0 +1,10 @@
+;; objective-lisp system definition
+;; ~keith
+
+(defsystem "objective-lisp"
+  :description "Syntactic sugar for object-oriented Lisp."
+  :version "1.0"
+  :author "~keith"
+  :homepage "https://bytes.keithhacks.cyou/keith/objective-lisp"
+  :license "Public Domain"
+  :components ((:file "objective-lisp")))

objective-lisp.lisp

@@ -0,0 +1,85 @@
+;; objective-lisp: Object-oriented syntactic sugar for Lisp
+;; ~keith
+
+(defpackage objective-lisp
+  (:use common-lisp)
+  (:export +open-construct-char+ +close-construct-char+ +method-char+
+           read-construct-contents
+           destructure-construct
+           read-method-name
+           read-open-construct
+           read-unexpected))
+
+(in-package objective-lisp)
+
+(defparameter +open-construct-char+ #\[)
+(defparameter +close-construct-char+ #\])
+(defparameter +method-char+ #\.)
+
+;; DONE
+;; (setf (slot-value object 'slot) value)
+;; => (setf [object slot] value)
+
+;; DONE
+;; (setf (slot-value (slot-value object 'slot-a) 'slot-b) value)
+;; => (setf [object slot-a slot-b] value)
+
+;; TODO
+;; (object-method object args...)
+;; => [object (.method args...)]
+
+(defun read-construct-contents (stream end-char)
+  "Read the contents of an objective-lisp construct."
+  (loop until (char= (peek-char t stream t nil t) end-char)
+        collect (read stream t nil t)
+        ; Skip over end-char
+        finally (read-char stream t nil t)))
+
+(defun quote-if-symbol (x)
+  "Quote x if it's a symbol, return it verbatim otherwise."
+  (if (symbolp x) `(quote ,x) x))
+
+(defun method-call-p (x)
+  "Check if x is a sexpr of the form (.method args...)"
+  (and (consp x) (consp (car x)) (eq (caar x) :method-call)))
+
+(defun destructure-construct (construct)
+  "Recursively destructure an objective-lisp construct."
+  (cond
+    ; Nothing left to destructure, return car
+    ((not (cdr construct))
+     (car construct))
+    ; Method call [object (.method args...)]
+    ;              => [object ((:method-call . method) args...)]
+    ((method-call-p (cadr construct))
+     (let ((method-call (cadr construct)))
+       (destructure-construct
+        (cons `(,(cdar method-call) ,(car construct) ,@(cdr method-call))
+              (cddr construct)))
+       ))
+    ; Slot access [object slot]
+    (t
+     (destructure-construct
+      (cons `(slot-value ,(car construct) ,(quote-if-symbol (cadr construct)))
+            (cddr construct)))
+     )))
+
+(defun read-method-name (stream char)
+  "Read an objective-lisp method name."
+  (declare (ignore char))
+  (cons :method-call (read stream t nil t)))
+
+(defun read-open-construct (stream char)
+  "Read an objective-lisp construct."
+  (declare (ignore char))
+  (let ((*readtable* (copy-readtable)))
+    (set-macro-character +method-char+ 'read-method-name
+                         t) ; non-terminating so (12.34) doesn't become (12 (:method-call . 34))
+    (destructure-construct (read-construct-contents stream +close-construct-char+))))
+
+(defun read-unexpected (stream char)
+  (declare (ignore stream))
+  (error "Unexpected character ~S" char))
+
+(set-macro-character +open-construct-char+ 'read-open-construct)
+(set-macro-character +close-construct-char+ 'read-unexpected)