diff --git a/README.md b/README.md index 25959f5..67fc44f 100644 --- a/README.md +++ b/README.md @@ -9,8 +9,7 @@ code). ## Usage -**TL;DR:** `[object slot-name]` is like `object.slotName` in C++, and -`[object (.method args)]` is like `object.method(args)` in C++. +**TL;DR:** `[object (method args)]` is like `object.method(args)` in C++. First, to enable `objective-lisp`'s syntax, just load the system: ``` common-lisp @@ -18,66 +17,44 @@ First, to enable `objective-lisp`'s syntax, just load the system: ``` `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. +in square brackets rather than parentheses. Each expression within acts upon the +result of the previous one, like a chain of `.` (dot) operators in C-like +languages. ```common-lisp -[foo bar baz quux] -;; C++: foo.bar.baz.quux +[foo (bar) (baz) (quux)] +;; C++: foo.bar().baz().quux() ``` -To access a slot, just put the slot name after the object: +To call a method, just write it 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) +[object (method args...)] +;; => (method object args...) ``` -`slot-name` doesn't have to be an unquoted symbol: +Slot accessors, and other methods that don't take additional arguments, can be +written without enclosing parentheses: ``` 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) +[object get-something] +;; => (get-something object) ``` 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)] -;; => [(slot-value object 'slot-name) (.setf value)] +[object (slot-value 'slot-name) (setf value)] +;; => [(slot-value object 'slot-name) (setf value)] ;; => (setf (slot-value object 'slot-name) value) ``` -And, of course, you can chain multiple slot accesses and method calls together: +To access slots directly, use the `:slot` keyword: ``` common-lisp -[object child (.method-of-child) (.method-of-return-value) slot-of-return-value] -;; => [(slot-value object 'child) (.method-of-child) ...] -;; => [(method-of-child (slot-value object 'child)) (.method-of-return-value) ...] -;; => [(method-of-return-value (method-of-child ...)) slot-of-return-value] -;; => (slot-value (method-of-return-value ...) 'slot-of-return-value) -``` - -**NEW:** You can also call slot accessors without wrapping them in a cons. (This -works for any method that takes no additional arguments, but that might cause -code readability issues.) -``` common-lisp -[object .slot-accessor] -;; => (slot-accessor object) +[object :slot slot-name] +;; => (slot-value object 'slot-name) ``` ## 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. +`objective-lisp` is public domain (CC0). 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. (And then rewrote just now because the syntax sucked.) But if you find it useful, *please* let me know. I'd love to hear about it. diff --git a/objective-lisp.asd b/objective-lisp.asd index 48df06d..573d57e 100644 --- a/objective-lisp.asd +++ b/objective-lisp.asd @@ -3,8 +3,8 @@ (defsystem "objective-lisp" :description "Syntactic sugar for object-oriented Lisp." - :version "1.0" + :version "2.0" :author "~keith" :homepage "https://bytes.keithhacks.cyou/keith/objective-lisp" - :license "Public Domain" + :license "Public Domain/CC0" :components ((:file "objective-lisp"))) diff --git a/objective-lisp.lisp b/objective-lisp.lisp index 92f50cc..6557c9a 100644 --- a/objective-lisp.lisp +++ b/objective-lisp.lisp @@ -3,94 +3,49 @@ (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 + (:export +open-char+ +close-char+ + read-construct-item + read-construct read-unexpected)) (in-package objective-lisp) -(defparameter +open-construct-char+ #\[) -(defparameter +close-construct-char+ #\]) -(defparameter +method-char+ #\.) +(defconstant +open-char+ #\[) +(defconstant +close-char+ #\]) -;; DONE -;; (setf (slot-value object 'slot) value) -;; => (setf [object slot] value) +(defun read-construct-item (sexpr stream) + "Recursively read and rewrite an objective-lisp construct." + (if (char= (peek-char t stream t nil t) +close-char+) + ; We've hit the end, return the sexpr we built + (progn (read-char stream t nil t) + sexpr) + (let ((item (read stream t nil t))) + (cond + ; Method call [object (method args...)] + ((consp item) + (read-construct-item `(,(car item) ,sexpr ,@(cdr item)) + stream)) + ; Slot access [object :slot slot-name] + ((eq item :slot) + (read-construct-item `(slot-value ,sexpr ',(read stream t nil t)) + stream)) + ; Consless method call [object method] + ((symbolp item) + (read-construct-item `(,item ,sexpr) + stream)) + ; Something else + (t (error "Unexpected item ~S" item)) + )))) -;; 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 consless-method-call-p (x) - "Check if x is of the form .method (no arguments)" - (and (consp x) (eq (car 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))) - )) - ; Consless method call [object .method] - ; => [object (:method-call . method)] - ((consless-method-call-p (cadr construct)) - (destructure-construct - (cons `(,(cdadr construct) ,(car construct)) - (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) +(defun read-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+)))) + (read-construct-item (read stream t nil t) ; 1st sexpr is the object, don't rewrite it + stream)) (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) +(set-macro-character +open-char+ 'read-construct) +(set-macro-character +close-char+ 'read-unexpected)