objective-lisp 1.0
This commit is contained in:
parent
8269830cfa
commit
99b959a2d5
68
README.md
68
README.md
|
@ -1,3 +1,69 @@
|
||||||
# objective-lisp
|
# 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.
|
||||||
|
|
|
@ -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")))
|
|
@ -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)
|
Loading…
Reference in New Issue