keith/objective-lisp
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

2.0 syntax

Browse source
This commit is contained in:
~keith 2021-11-22 23:29:25 +00:00
parent d02322ce73
commit d5b91b7fd2
Signed by: keith
GPG key ID: 5BEBEEAB2C73D520
3 changed files with 56 additions and 124 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

65
README.md
View file

@ -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.

4
objective-lisp.asd
View file

@ -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")))

109
objective-lisp.lisp
View file

@ -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)
;; 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."
(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
; 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)))
)))
; 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))
))))
(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)