objective-lisp/objective-lisp.lisp

52 lines
1.7 KiB
Common Lisp

;; objective-lisp: Object-oriented syntactic sugar for Lisp
;; ~keith
(defpackage objective-lisp
(:use common-lisp)
(:export +open-char+ +close-char+
read-construct-item
read-construct
read-unexpected))
(in-package objective-lisp)
(defconstant +open-char+ #\[)
(defconstant +close-char+ #\])
(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))
))))
(defun read-construct (stream char)
"Read an objective-lisp construct."
(declare (ignore 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-char+ 'read-construct)
(set-macro-character +close-char+ 'read-unexpected)